From ebb479cd4d397e829eed460bd7ac9040204f8b5a Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 5 Oct 2008 18:53:19 +0000 Subject: [PATCH] re PR fortran/35680 (ICE on invalid transfer in variable declaration) 2008-10-05 Paul Thomas PR fortran/35680 * gfortran.h : Add 'error' bit field to gfc_expr structure. * expr.c (check_inquiry): When checking a restricted expression check that arguments are either variables or restricted. (check_restricted): Do not emit error if the expression has 'error' set. Clean up detection of host-associated variable. 2008-10-05 Paul Thomas PR fortran/35680 * gfortran.dg/transfer_array_intrinsic_5.f90: New test. From-SVN: r140892 --- gcc/fortran/ChangeLog | 9 ++++++ gcc/fortran/expr.c | 31 ++++++++++++------- gcc/fortran/gfortran.h | 10 ++++-- gcc/testsuite/ChangeLog | 5 +++ .../transfer_array_intrinsic_5.f90 | 24 ++++++++++++++ 5 files changed, 65 insertions(+), 14 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/transfer_array_intrinsic_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index df358b89c3d..53f3f0c1526 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2008-10-05 Paul Thomas + + PR fortran/35680 + * gfortran.h : Add 'error' bit field to gfc_expr structure. + * expr.c (check_inquiry): When checking a restricted expression + check that arguments are either variables or restricted. + (check_restricted): Do not emit error if the expression has + 'error' set. Clean up detection of host-associated variable. + 2008-10-05 Daniel Kraft PR fortran/37638 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 7b741b88050..7f6bf1b07e4 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2017,6 +2017,8 @@ check_init_expr_arguments (gfc_expr *e) return MATCH_YES; } +static gfc_try check_restricted (gfc_expr *); + /* F95, 7.1.6.1, Initialization expressions, (7) F2003, 7.1.7 Initialization expression, (8) */ @@ -2096,6 +2098,11 @@ check_inquiry (gfc_expr *e, int not_restricted) } else if (not_restricted && check_init_expr (ap->expr) == FAILURE) return MATCH_ERROR; + + if (not_restricted == 0 + && ap->expr->expr_type != EXPR_VARIABLE + && check_restricted (ap->expr) == FAILURE) + return MATCH_ERROR; } return MATCH_YES; @@ -2421,8 +2428,6 @@ gfc_match_init_expr (gfc_expr **result) } -static gfc_try check_restricted (gfc_expr *); - /* Given an actual argument list, test to see that each argument is a restricted expression and optionally if the expression type is integer or character. */ @@ -2561,14 +2566,17 @@ check_restricted (gfc_expr *e) that host associated dummy array indices are accepted (PR23446). This mechanism also does the same for the specification expressions of array-valued functions. */ - if (sym->attr.in_common - || sym->attr.use_assoc - || sym->attr.dummy - || sym->attr.implied_index - || sym->ns != gfc_current_ns - || (sym->ns->proc_name != NULL - && sym->ns->proc_name->attr.flavor == FL_MODULE) - || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns))) + if (e->error + || sym->attr.in_common + || sym->attr.use_assoc + || sym->attr.dummy + || sym->attr.implied_index + || (sym->ns && sym->ns == gfc_current_ns->parent) + || (sym->ns && gfc_current_ns->parent + && sym->ns == gfc_current_ns->parent->parent) + || (sym->ns->proc_name != NULL + && sym->ns->proc_name->attr.flavor == FL_MODULE) + || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns))) { t = SUCCESS; break; @@ -2576,7 +2584,8 @@ check_restricted (gfc_expr *e) gfc_error ("Variable '%s' cannot appear in the expression at %L", sym->name, &e->where); - + /* Prevent a repetition of the error. */ + e->error = 1; break; case EXPR_NULL: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 55cca728769..b032486abfd 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -637,10 +637,10 @@ typedef struct unsigned function:1, subroutine:1, procedure:1; unsigned generic:1, generic_copy:1; unsigned implicit_type:1; /* Type defined via implicit rules. */ - unsigned untyped:1; /* No implicit type could be found. */ + unsigned untyped:1; /* No implicit type could be found. */ - unsigned is_bind_c:1; /* say if is bound to C */ - unsigned extension:1; /* extends a derived type */ + unsigned is_bind_c:1; /* say if is bound to C. */ + unsigned extension:1; /* extends a derived type. */ /* These flags are both in the typespec and attribute. The attribute list is what gets read from/written to a module file. The typespec @@ -1547,6 +1547,10 @@ typedef struct gfc_expr and if we have decided not to allocate temporary data for that array. */ unsigned int inline_noncopying_intrinsic : 1, is_boz : 1; + /* Sometimes, when an error has been emitted, it is necessary to prevent + it from recurring. */ + unsigned int error : 1; + /* Used to quickly find a given constructor by its offset. */ splay_tree con_by_offset; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8ea4bef2bf3..df7ba0b1e96 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-10-05 Paul Thomas + + PR fortran/35680 + * gfortran.dg/transfer_array_intrinsic_5.f90: New test. + 2008-10-05 Daniel Kraft PR fortran/37638 diff --git a/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_5.f90 b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_5.f90 new file mode 100644 index 00000000000..c886b03f665 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_5.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! PR35680 - used to ICE because the argument of SIZE, being in a restricted +! expression, was not checked if it too is restricted or is a variable. Since +! it is neither, an error should be produced. +! +! Contributed by Francois-Xavier Coudert +! +program main + print *, foo (), bar (), foobar () +contains + function foo () + integer foo(size (transfer (x, [1]))) ! { dg-error "cannot appear" } + real x + end function + function bar() + real x + integer bar(size (transfer (x, [1]))) ! { dg-error "cannot appear" } + end function + function foobar() ! { dg-error "no IMPLICIT" } + implicit none + integer foobar(size (transfer (x, [1]))) ! { dg-error "used before" } + real x + end function +end program -- 2.30.2