From d3d0b9e07f69bd21120ebdeac22d4e197b7dfd1c Mon Sep 17 00:00:00 2001 From: Mikael Morin Date: Fri, 31 Oct 2008 16:56:21 +0100 Subject: [PATCH] re PR fortran/35840 (ICE for character expression in I/O specifier) 2008-10-31 Mikael Morin PR fortran/35840 * expr.c (gfc_reduce_init_expr): New function, containing checking code from gfc_match_init_expr, so that checking can be deferred. (gfc_match_init_expr): Use gfc_reduce_init_expr. * io.c (check_io_constraints): Use gfc_reduce_init_expr instead of checking that the expression is a constant. * match.h (gfc_reduce_init_expr): Prototype added. 2008-10-31 Mikael Morin PR fortran/35840 * gfortran.dg/write_check4.f90: New test. From-SVN: r141497 --- gcc/fortran/ChangeLog | 10 ++++ gcc/fortran/expr.c | 63 +++++++++++++--------- gcc/fortran/io.c | 2 +- gcc/fortran/match.h | 1 + gcc/testsuite/ChangeLog | 7 ++- gcc/testsuite/gfortran.dg/write_check4.f90 | 17 ++++++ 6 files changed, 74 insertions(+), 26 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/write_check4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1075d98025f..f7f763f9767 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2008-10-31 Mikael Morin + + PR fortran/35840 + * expr.c (gfc_reduce_init_expr): New function, containing checking code + from gfc_match_init_expr, so that checking can be deferred. + (gfc_match_init_expr): Use gfc_reduce_init_expr. + * io.c (check_io_constraints): Use gfc_reduce_init_expr instead of + checking that the expression is a constant. + * match.h (gfc_reduce_init_expr): Prototype added. + 2008-10-31 Mikael Morin PR fortran/35820 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 73f2c40a36c..1a5e6db3c95 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2378,6 +2378,41 @@ check_init_expr (gfc_expr *e) return t; } +/* Reduces a general expression to an initialization expression (a constant). + This used to be part of gfc_match_init_expr. + Note that this function doesn't free the given expression on FAILURE. */ + +gfc_try +gfc_reduce_init_expr (gfc_expr *expr) +{ + gfc_try t; + + gfc_init_expr = 1; + t = gfc_resolve_expr (expr); + if (t == SUCCESS) + t = check_init_expr (expr); + gfc_init_expr = 0; + + if (t == FAILURE) + return FAILURE; + + if (expr->expr_type == EXPR_ARRAY + && (gfc_check_constructor_type (expr) == FAILURE + || gfc_expand_constructor (expr) == FAILURE)) + return FAILURE; + + /* Not all inquiry functions are simplified to constant expressions + so it is necessary to call check_inquiry again. */ + if (!gfc_is_constant_expr (expr) && check_inquiry (expr, 1) != MATCH_YES + && !gfc_in_match_data ()) + { + gfc_error ("Initialization expression didn't reduce %C"); + return FAILURE; + } + + return SUCCESS; +} + /* Match an initialization expression. We work by first matching an expression, then reducing it to a constant. */ @@ -2389,39 +2424,19 @@ gfc_match_init_expr (gfc_expr **result) match m; gfc_try t; + expr = NULL; + m = gfc_match_expr (&expr); if (m != MATCH_YES) return m; - gfc_init_expr = 1; - t = gfc_resolve_expr (expr); - if (t == SUCCESS) - t = check_init_expr (expr); - gfc_init_expr = 0; - - if (t == FAILURE) + t = gfc_reduce_init_expr (expr); + if (t != SUCCESS) { gfc_free_expr (expr); return MATCH_ERROR; } - if (expr->expr_type == EXPR_ARRAY - && (gfc_check_constructor_type (expr) == FAILURE - || gfc_expand_constructor (expr) == FAILURE)) - { - gfc_free_expr (expr); - return MATCH_ERROR; - } - - /* Not all inquiry functions are simplified to constant expressions - so it is necessary to call check_inquiry again. */ - if (!gfc_is_constant_expr (expr) && check_inquiry (expr, 1) != MATCH_YES - && !gfc_in_match_data ()) - { - gfc_error ("Initialization expression didn't reduce %C"); - return MATCH_ERROR; - } - *result = expr; return MATCH_YES; diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index fb5ef3e4d46..cb89eddbe16 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -2973,7 +2973,7 @@ if (condition) \ { static const char * asynchronous[] = { "YES", "NO", NULL }; - if (dt->asynchronous->expr_type != EXPR_CONSTANT) + if (gfc_reduce_init_expr (dt->asynchronous) != SUCCESS) { gfc_error ("ASYNCHRONOUS= specifier at %L must be an initialization " "expression", &dt->asynchronous->where); diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index ff9e8a8d174..81bf4213289 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -199,6 +199,7 @@ match gfc_match_literal_constant (gfc_expr **, int); /* expr.c -- FIXME: this one should be eliminated by moving the matcher to matchexp.c and a call to a new function in expr.c that only makes sure the init expr. is valid. */ +gfc_try gfc_reduce_init_expr (gfc_expr *expr); match gfc_match_init_expr (gfc_expr **); /* array.c. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d0d12425f3c..5d4dd1034be 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,4 +1,9 @@ -2008-10-16 Mikael Morin +2008-10-31 Mikael Morin + + PR fortran/35840 + * gfortran.dg/write_check4.f90: New test. + +2008-10-31 Mikael Morin PR fortran/35820 * gfortran.dg/nested_forall_1.f: New test. diff --git a/gcc/testsuite/gfortran.dg/write_check4.f90 b/gcc/testsuite/gfortran.dg/write_check4.f90 new file mode 100644 index 00000000000..f418ba8fbf0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/write_check4.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! +! PR fortran/35840 +! +! The asynchronous specifier for a data transfer statement shall be +! an initialization expression +! +! Contributed by Tobias Burnus +! + character(2) :: no + no = "no" + open (unit=10, asynchronous = no) ! Ok, it isn't a transfer stmt + write(*,*, asynchronous="Y"//"E"//trim("S ")) ! Ok, it is an init expr + write(*,*, asynchronous=no) ! { dg-error "must be an initialization expression" } + read (*,*, asynchronous="Y"//"e"//trim("S ")) + read (*,*, asynchronous=no) ! { dg-error "must be an initialization expression" } +end