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
@@ -2145,6 +2145,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
@@ -2154,7 +2183,7 @@ static match
 variable_decl (int elem)
 {
   char name[GFC_MAX_SYMBOL_LEN + 1];
-  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;
@@ -2163,6 +2192,7 @@ variable_decl (int elem)
   match m;
   bool t;
   gfc_symbol *sym;
+  match cl_match;
 
   initializer = NULL;
   as = NULL;
@@ -2177,6 +2207,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)
@@ -2268,40 +2312,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