From e4c3d25a9133224535b3142ed31e8a8be1ad356b Mon Sep 17 00:00:00 2001 From: Jim MacArthur Date: Wed, 7 Oct 2015 17:04:06 -0400 Subject: [PATCH 10/23] Allow mixed string length and array specification in character declarations. --- 0010-Allow-mixed-string-length-and-array-specification-in.patch commit 05124ea7df2ee14620d5c24ffe972db3dcab4f4e Author: Jim MacArthur Date: Wed Oct 7 17:04:06 2015 -0400 Allow mixed string length and array specification in character declarations. Test written by: Francisco Redondo Marchena diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 6d3d28af127..c90f9de5a78 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2264,6 +2264,35 @@ check_function_name (char *name) } +static match +match_character_length_clause (gfc_charlen **cl, bool *cl_deferred, int elem) +{ + gfc_expr* char_len; + char_len = NULL; + + match m = match_char_length (&char_len, cl_deferred, false); + if (m == MATCH_YES) + { + *cl = gfc_new_charlen (gfc_current_ns, NULL); + (*cl)->length = char_len; + } + else if (m == MATCH_NO) + { + if (elem > 1 + && (current_ts.u.cl->length == NULL + || current_ts.u.cl->length->expr_type != EXPR_CONSTANT)) + { + *cl = gfc_new_charlen (gfc_current_ns, NULL); + (*cl)->length = gfc_copy_expr (current_ts.u.cl->length); + } + else + *cl = current_ts.u.cl; + + *cl_deferred = current_ts.deferred; + } + return m; +} + /* Match a variable name with an optional initializer. When this subroutine is called, a variable is expected to be parsed next. Depending on what is happening at the moment, updates either the @@ -2274,7 +2303,7 @@ variable_decl (int elem) { char name[GFC_MAX_SYMBOL_LEN + 1]; static unsigned int fill_id = 0; - gfc_expr *initializer, *char_len; + gfc_expr *initializer; gfc_array_spec *as; gfc_array_spec *cp_as; /* Extra copy for Cray Pointees. */ gfc_charlen *cl; @@ -2283,6 +2312,7 @@ variable_decl (int elem) match m; bool t; gfc_symbol *sym; + match cl_match; initializer = NULL; as = NULL; @@ -2335,6 +2365,20 @@ variable_decl (int elem) var_locus = gfc_current_locus; + + cl = NULL; + cl_deferred = false; + cl_match = MATCH_NO; + + /* Check for a character length clause before an array clause */ + if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) + && current_ts.type == BT_CHARACTER) + { + cl_match = match_character_length_clause (&cl, &cl_deferred, elem); + if (cl_match == MATCH_ERROR) + goto cleanup; + } + /* Now we could see the optional array spec. or character length. */ m = gfc_match_array_spec (&as, true, true); if (m == MATCH_ERROR) @@ -2453,40 +2497,12 @@ variable_decl (int elem) } } - char_len = NULL; - cl = NULL; - cl_deferred = false; - - if (current_ts.type == BT_CHARACTER) + /* Second chance for a character length clause */ + if (cl_match == MATCH_NO && current_ts.type == BT_CHARACTER) { - switch (match_char_length (&char_len, &cl_deferred, false)) - { - case MATCH_YES: - cl = gfc_new_charlen (gfc_current_ns, NULL); - - cl->length = char_len; - break; - - /* Non-constant lengths need to be copied after the first - element. Also copy assumed lengths. */ - case MATCH_NO: - if (elem > 1 - && (current_ts.u.cl->length == NULL - || current_ts.u.cl->length->expr_type != EXPR_CONSTANT)) - { - cl = gfc_new_charlen (gfc_current_ns, NULL); - cl->length = gfc_copy_expr (current_ts.u.cl->length); - } - else - cl = current_ts.u.cl; - - cl_deferred = current_ts.deferred; - - break; - - case MATCH_ERROR: - goto cleanup; - } + m = match_character_length_clause( &cl, &cl_deferred, elem ); + if (m == MATCH_ERROR) + goto cleanup; } /* The dummy arguments and result of the abreviated form of MODULE diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration.f new file mode 100644 index 00000000000..69b110edb25 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration.f @@ -0,0 +1,10 @@ +! { dg-do compile } +! { dg-options "-std=extra-legacy" } +! +! Test character declaration with mixed string length and array specification +! + PROGRAM character_declaration + CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/ + CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/ + if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1 + END