re PR fortran/83184 (Out of memory or ICE with option -fdec)

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

    gcc/testsuite/ChangeLog:

	PR fortran/83184
	Backport from trunk.
	* 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.

    gcc/fortran/ChangeLog:

	PR fortran/83184
	Backport from trunk.
	* 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.

From-SVN: r262759

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8cb87ea823c0329fe57b856f7c235ff8424387a1..763f5f634a90cc385bd7feaf862516eaa4100fca 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2018-07-16  Fritz Reese  <fritzoreese@gmail.com>
+
+       PR fortran/83184
+       Backport from trunk.
+       * 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>
 
        Backport from trunk:

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index e73f2d76f4558040f2a89f38294ebb5ae12a5a4d..f3b3091e4246d60e0cc9eabff3aca1361290c196 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -509,6 +509,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 '/'.  */
@@ -634,27 +635,35 @@ 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, size;
+  mpz_t repeat, cons_size, as_size;
   bool scalar;
   int cmp;
 
   gcc_assert (ts);
 
-  mpz_init_set_ui (repeat, 0);
-  mpz_init (size);
-  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);
@@ -684,7 +693,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;
         }
@@ -727,6 +739,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)
     {
@@ -737,16 +752,18 @@ match_clist_expr (gfc_expr **result, gfc_typespec *ts, gfc_array_spec *as)
       expr->rank = as->rank;
       expr->shape = gfc_get_shape (expr->rank);
 
-      /* Validate sizes. */
-      gcc_assert (gfc_array_size (expr, &size));
-      gcc_assert (spec_size (as, &repeat));
-      cmp = mpz_cmp (size, repeat);
+      /* 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 sizes match.  */
+      gcc_assert (gfc_array_size (expr, &cons_size));
+      cmp = mpz_cmp (cons_size, as_size);
       if (cmp < 0)
-        gfc_error ("Not enough elements in array initializer at %C");
+       gfc_error ("Not enough elements in array initializer at %C");
       else if (cmp > 0)
-        gfc_error ("Too many elements in array initializer at %C");
+       gfc_error ("Too many elements in array initializer at %C");
+      mpz_clear (cons_size);
       if (cmp)
-        goto cleanup;
+       goto cleanup;
     }
 
   /* Make sure scalar types match. */
@@ -758,11 +775,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 (size);
-  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:
@@ -770,9 +787,12 @@ cleanup:
     expr->value.constructor = NULL;
   gfc_free_expr (expr);
   gfc_constructor_free (array_head);
-  mpz_clear (size);
+
+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 92f4e5454cee4e4b86d08fcd52efd960a7d8fa4e..9fcb2c719b51f2751411f589b89d1ed36f2d2bd0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2018-07-16  Fritz Reese  <fritzoreese@gmail.com>
+
+       PR fortran/83184
+       Backport from trunk.
+       * 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  Fritz Reese  <fritzoreese@gmail.com>
 
        Backport from trunk:

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
new file mode 100644 (file)
index 0000000..78db344
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_23.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-fdec-structure" }
+!
+! PR fortran/78240
+!
+! Test a regression where an ICE occurred attempting to create array variables
+! with non-constant array-specs in legacy clist initializers.
+!
+! Error message update with patch for PR fortran/83633
+!
+program p
+  implicit none
+  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" }
+  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" }