From e11449d15bda808658b71a0d6643192f0fc43947 Mon Sep 17 00:00:00 2001 From: Fritz Reese Date: Mon, 16 Jul 2018 18:24:50 +0000 Subject: [PATCH] Fix handling of invalid assumed-shape/size arrays in legacy initializer lists. 2018-07-16 Fritz Reese 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 --- gcc/fortran/ChangeLog | 8 +++ gcc/fortran/decl.c | 63 +++++++++++-------- gcc/testsuite/ChangeLog | 8 +++ gcc/testsuite/gfortran.dg/assumed_rank_14.f90 | 11 ++++ gcc/testsuite/gfortran.dg/assumed_rank_15.f90 | 11 ++++ .../gfortran.dg/dec_structure_23.f90 | 6 +- gcc/testsuite/gfortran.dg/dec_structure_8.f90 | 6 +- 7 files changed, 80 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/ChangeLog b/gcc/fortran/ChangeLog index 23781ae20d1..b8c60f5ad90 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2018-07-16 Fritz Reese + + 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 PR fortran/86417 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 09541da2577..1384bc717d8 100644 --- 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 854d28ef679..75cdf509531 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2018-07-16 Fritz Reese + + 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 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 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 78db344e0fc..d79ecc7ff21 100644 --- 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 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.30.2