The attached patch fixes PR fortran/83184, which is actually two
distinct bugs as described in the PR. Passes regtests.
The patch is attached. OK for trunk and 7/8-branch?
>From 238f0a0e80c93209bb4e62ba2f719f74f5da164f Mon Sep 17 00:00:00 2001
From: Fritz Reese <fritzore...@gmail.com>
Date: Wed, 27 Jun 2018 16:16:31 -0400
Subject: [PATCH 2/3] PR fortran/83184
Fix handling of invalid assumed-shape/size arrays in legacy initializer
lists.
gcc/fortran/
* 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/
* 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/decl.c | 63 +++++++++++++++-----------
gcc/testsuite/gfortran.dg/assumed_rank_14.f90 | 11 +++++
gcc/testsuite/gfortran.dg/assumed_rank_15.f90 | 11 +++++
gcc/testsuite/gfortran.dg/dec_structure_23.f90 | 6 +--
gcc/testsuite/gfortran.dg/dec_structure_8.f90 | 6 +--
5 files changed, 64 insertions(+), 33 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/assumed_rank_14.f90
create mode 100644 gcc/testsuite/gfortran.dg/assumed_rank_15.f90
From 238f0a0e80c93209bb4e62ba2f719f74f5da164f Mon Sep 17 00:00:00 2001
From: Fritz Reese <fritzore...@gmail.com>
Date: Wed, 27 Jun 2018 16:16:31 -0400
Subject: [PATCH 2/3] PR fortran/83184
Fix handling of invalid assumed-shape/size arrays in legacy initializer
lists.
gcc/fortran/
* 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/
* 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/decl.c | 63 +++++++++++++++-----------
gcc/testsuite/gfortran.dg/assumed_rank_14.f90 | 11 +++++
gcc/testsuite/gfortran.dg/assumed_rank_15.f90 | 11 +++++
gcc/testsuite/gfortran.dg/dec_structure_23.f90 | 6 +--
gcc/testsuite/gfortran.dg/dec_structure_8.f90 | 6 +--
5 files changed, 64 insertions(+), 33 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/assumed_rank_14.f90
create mode 100644 gcc/testsuite/gfortran.dg/assumed_rank_15.f90
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index cb235343962..af724658d8d 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -521,6 +521,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 '/'. */
@@ -632,7 +633,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;
@@ -640,18 +641,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);
@@ -681,7 +691,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;
}
@@ -724,6 +737,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)
{
@@ -736,25 +752,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;
@@ -769,10 +773,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:
@@ -780,8 +785,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/gfortran.dg/assumed_rank_14.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_14.f90
new file mode 100644
index 00000000000..18271f91bad
--- /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
index 00000000000..efeb4a5f47b
--- /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 3c68489c4bd..bba72bc4f4e 100644
--- a/gcc/testsuite/gfortran.dg/dec_structure_23.f90
+++ b/gcc/testsuite/gfortran.dg/dec_structure_23.f90
@@ -12,8 +12,8 @@ program p
integer :: nn
real :: rr
structure /s/
- integer x(n) /1/ ! { dg-error "xpected constant" }
- integer xx(nn) /1/ ! { dg-error "xpected constant" }
- integer xxx(rr) /1.0/ ! { dg-error "xpected constant" }
+ 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 160b92a8b96..f84bf156864 100644
--- 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" }
--
2.12.2
