159 lines
4.6 KiB
Diff
159 lines
4.6 KiB
Diff
From e4c3d25a9133224535b3142ed31e8a8be1ad356b Mon Sep 17 00:00:00 2001
|
|
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
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 <jim.macarthur@codethink.co.uk>
|
|
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 <francisco.marchena@codethink.co.uk>
|
|
|
|
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
|