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