Fix handling of invalid assumed-shape/size arrays in legacy initializer lists.

2018-07-16  Fritz Reese  <fritzoreese@gmail.com>

    Fix handling of invalid assumed-shape/size arrays in legacy initializer
    lists.

    gcc/fortran/ChangeLog:

	PR fortran/83184
	* decl.c (match_old_style_init): Initialize locus of variable expr when
	creating a data variable.
	(match_clist_expr): Verify array is explicit shape/size before
	attempting to allocate constant array constructor.

    gcc/testsuite/ChangeLog:

	PR fortran/83184
	* gfortran.dg/assumed_rank_14.f90: New testcase.
	* gfortran.dg/assumed_rank_15.f90: New testcase.
	* gfortran.dg/dec_structure_8.f90: Update error messages.
	* gfortran.dg/dec_structure_23.f90: Update error messages.

From-SVN: r262744

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 23781ae20d133af4593518dcdbe90f678e73bbe3..b8c60f5ad9072ecff986e89b8f831bbf11d4dee3 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2018-07-16  Fritz Reese  <fritzoreese@gmail.com>
+
+       PR fortran/83184
+       * decl.c (match_old_style_init): Initialize locus of variable expr when
+       creating a data variable.
+       (match_clist_expr): Verify array is explicit shape/size before
+       attempting to allocate constant array constructor.
+
 2018-07-16  Fritz Reese  <fritzoreese@gmail.com>
 
        PR fortran/86417

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 09541da2577909e9c46aec30fb14d308ed32ae46..1384bc717d8c753ab25b2515c9cc4d8f5aa3b925 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -534,6 +534,7 @@ match_old_style_init (const char *name)
   newdata = gfc_get_data ();
   newdata->var = gfc_get_data_variable ();
   newdata->var->expr = gfc_get_variable_expr (st);
+  newdata->var->expr->where = sym->declared_at;
   newdata->where = gfc_current_locus;
 
   /* Match initial value list. This also eats the terminal '/'.  */
@@ -659,7 +660,7 @@ match_clist_expr (gfc_expr **result, gfc_typespec *ts, gfc_array_spec *as)
 {
   gfc_constructor_base array_head = NULL;
   gfc_expr *expr = NULL;
-  match m;
+  match m = MATCH_ERROR;
   locus where;
   mpz_t repeat, cons_size, as_size;
   bool scalar;
@@ -667,18 +668,27 @@ match_clist_expr (gfc_expr **result, gfc_typespec *ts, gfc_array_spec *as)
 
   gcc_assert (ts);
 
-  mpz_init_set_ui (repeat, 0);
-  scalar = !as || !as->rank;
-
   /* We have already matched '/' - now look for a constant list, as with
      top_val_list from decl.c, but append the result to an array.  */
   if (gfc_match ("/") == MATCH_YES)
     {
       gfc_error ("Empty old style initializer list at %C");
-      goto cleanup;
+      return MATCH_ERROR;
     }
 
   where = gfc_current_locus;
+  scalar = !as || !as->rank;
+
+  if (!scalar && !spec_size (as, &as_size))
+    {
+      gfc_error ("Array in initializer list at %L must have an explicit shape",
+                as->type == AS_EXPLICIT ? &as->upper[0]->where : &where);
+      /* Nothing to cleanup yet.  */
+      return MATCH_ERROR;
+    }
+
+  mpz_init_set_ui (repeat, 0);
+
   for (;;)
     {
       m = match_data_constant (&expr);
@@ -708,7 +718,10 @@ match_clist_expr (gfc_expr **result, gfc_typespec *ts, gfc_array_spec *as)
 
           m = match_data_constant (&expr);
           if (m == MATCH_NO)
-            gfc_error ("Expected data constant after repeat spec at %C");
+           {
+             m = MATCH_ERROR;
+             gfc_error ("Expected data constant after repeat spec at %C");
+           }
           if (m != MATCH_YES)
             goto cleanup;
         }
@@ -751,6 +764,9 @@ match_clist_expr (gfc_expr **result, gfc_typespec *ts, gfc_array_spec *as)
         goto syntax;
     }
 
+  /* If we break early from here out, we encountered an error.  */
+  m = MATCH_ERROR;
+
   /* Set up expr as an array constructor. */
   if (!scalar)
     {
@@ -763,25 +779,13 @@ match_clist_expr (gfc_expr **result, gfc_typespec *ts, gfc_array_spec *as)
 
       /* Validate sizes.  We built expr ourselves, so cons_size will be
         constant (we fail above for non-constant expressions).
-        We still need to verify that the array-spec has constant size.  */
-      cmp = 0;
+        We still need to verify that the sizes match.  */
       gcc_assert (gfc_array_size (expr, &cons_size));
-      if (!spec_size (as, &as_size))
-       {
-         gfc_error ("Expected constant array-spec in initializer list at %L",
-                    as->type == AS_EXPLICIT ? &as->upper[0]->where : &where);
-         cmp = -1;
-       }
-      else
-       {
-         /* Make sure the specs are of the same size.  */
-         cmp = mpz_cmp (cons_size, as_size);
-         if (cmp < 0)
-           gfc_error ("Not enough elements in array initializer at %C");
-         else if (cmp > 0)
-           gfc_error ("Too many elements in array initializer at %C");
-         mpz_clear (as_size);
-       }
+      cmp = mpz_cmp (cons_size, as_size);
+      if (cmp < 0)
+       gfc_error ("Not enough elements in array initializer at %C");
+      else if (cmp > 0)
+       gfc_error ("Too many elements in array initializer at %C");
       mpz_clear (cons_size);
       if (cmp)
        goto cleanup;
@@ -796,10 +800,11 @@ match_clist_expr (gfc_expr **result, gfc_typespec *ts, gfc_array_spec *as)
     expr->ts.u.cl->length_from_typespec = 1;
 
   *result = expr;
-  mpz_clear (repeat);
-  return MATCH_YES;
+  m = MATCH_YES;
+  goto done;
 
 syntax:
+  m = MATCH_ERROR;
   gfc_error ("Syntax error in old style initializer list at %C");
 
 cleanup:
@@ -807,8 +812,12 @@ cleanup:
     expr->value.constructor = NULL;
   gfc_free_expr (expr);
   gfc_constructor_free (array_head);
+
+done:
   mpz_clear (repeat);
-  return MATCH_ERROR;
+  if (!scalar)
+    mpz_clear (as_size);
+  return m;
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 854d28ef6798c85d3b5ef4bf5c1c0e0b42257280..75cdf509531aaa0b75619cfd8a4dafc9bc3fbde1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2018-07-16  Fritz Reese  <fritzoreese@gmail.com>
+
+       PR fortran/83184
+       * gfortran.dg/assumed_rank_14.f90: New testcase.
+       * gfortran.dg/assumed_rank_15.f90: New testcase.
+       * gfortran.dg/dec_structure_8.f90: Update error messages.
+       * gfortran.dg/dec_structure_23.f90: Update error messages.
+
 2018-07-16  Bernd Edlinger  <bernd.edlinger@hotmail.de>
 
        PR middle-end/86528

diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_14.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_14.f90
new file mode 100644 (file)
index 0000000..18271f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_14.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! PR fortran/83184
+!
+
+integer n1(..) /1/
+! { dg-error "Assumed-rank array.*must be a dummy argument" "" { target *-*-* } 7 }
+! { dg-error "Assumed-rank variable.*actual argument" "" { target *-*-* } 7 }
+
+end

diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_15.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_15.f90
new file mode 100644 (file)
index 0000000..efeb4a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_15.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-fdec-structure" }
+!
+! PR fortran/83184
+!
+
+structure /s/
+  integer n(..) /1/ ! { dg-error "must have an explicit shape" }
+end structure
+
+end

diff --git a/gcc/testsuite/gfortran.dg/dec_structure_23.f90 b/gcc/testsuite/gfortran.dg/dec_structure_23.f90
index 78db344e0fc859adfdbcf0d518830eeb03c8d8be..d79ecc7ff213e5a0c485b853b9a86a2c9ed4bb54 100644 (file)
--- a/gcc/testsuite/gfortran.dg/dec_structure_23.f90
+++ b/gcc/testsuite/gfortran.dg/dec_structure_23.f90
@@ -13,8 +13,8 @@ program p
   integer :: nn
   real :: rr
   structure /s/
-    integer x(n)    /1/   ! { dg-error "array with nonconstant bounds" }
-    integer xx(nn)  /1/   ! { dg-error "array with nonconstant bounds" }
-    integer xxx(rr) /1.0/ ! { dg-error "array with nonconstant bounds" }
+    integer x(n)    /1/   ! { dg-error "must have an explicit shape" }
+    integer xx(nn)  /1/   ! { dg-error "must have an explicit shape" }
+    integer xxx(rr) /1.0/ ! { dg-error "must have an explicit shape" }
   end structure
 end

diff --git a/gcc/testsuite/gfortran.dg/dec_structure_8.f90 b/gcc/testsuite/gfortran.dg/dec_structure_8.f90
index 160b92a8b96996984d446a2a83adf45ff62c7dfe..f84bf15686419503cab9830eb92b9a4fbcbc720d 100644 (file)
--- a/gcc/testsuite/gfortran.dg/dec_structure_8.f90
+++ b/gcc/testsuite/gfortran.dg/dec_structure_8.f90
@@ -6,7 +6,7 @@
 
 ! Old-style (clist) initialization
 integer,parameter :: as = 3
-structure /t1/
+structure /t1/              ! { dg-error "Type definition.*T1" }
   integer*1 a /300_2/       ! { dg-error "Arithmetic overflow" }
   integer   b //            ! { dg-error "Empty old style initializer list" }
   integer   c /2*3/         ! { dg-error "Repeat spec invalid in scalar" }
@@ -44,14 +44,14 @@ record /t1/            ! { dg-error "Invalid character in name" }
 
 structure /t2/
   ENTRY here           ! { dg-error "ENTRY statement.*cannot appear" }
-  integer a
+  integer a            ! { dg-error "Component.*already declared" }
   integer a            ! { dg-error "Component.*already declared" }
   structure $z         ! { dg-error "Invalid character in name" }
   structure //         ! { dg-error "Invalid character in name" }
   structure // x       ! { dg-error "Invalid character in name" }
   structure /t3/       ! { dg-error "Invalid character in name" }
   structure /t3/ x,$y  ! { dg-error "Invalid character in name" }
-  structure /t4/ y
+  structure /t4/ y     ! { dg-error "Type definition.*T4" }
     integer i, j, k
   end structure
   structure /t4/ z     ! { dg-error "Type definition.*T4" }