From 5ab0eadfa39b7f79ae5f3e7d6dc7dad259522504 Mon Sep 17 00:00:00 2001 From: Daniel Franke Date: Mon, 23 Jul 2007 16:35:03 -0400 Subject: re PR fortran/25104 ([F2003] Non-initialization expr. as case-selector) gcc/fortran: 2007-07-23 Daniel Franke PR fortran/25104 PR fortran/31639 * expr.c (check_transformational): Reject valid transformational intrinsics to avoid ICE. (check_inquiry): Report error for assumed character lengths for all supported standards. (check_init_expr): Whitespace fix. gcc/testsuite: 2007-07-23 Daniel Franke PR fortran/31639 * gfortran.dg/initialization_9.f90: New test. From-SVN: r126858 --- gcc/fortran/expr.c | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) (limited to 'gcc/fortran/expr.c') diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 257349a..0028724 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1966,9 +1966,8 @@ check_inquiry (gfc_expr *e, int not_restricted) && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER && ap->expr->symtree->n.sym->ts.cl->length == NULL) { - if (gfc_notify_std (GFC_STD_GNU, "assumed character length " - "variable '%s' in constant expression at %L", - e->symtree->n.sym->name, &e->where) == FAILURE) + gfc_error ("assumed character length variable '%s' in constant " + "expression at %L", e->symtree->n.sym->name, &e->where); return MATCH_ERROR; } else if (not_restricted && check_init_expr (ap->expr) == FAILURE) @@ -2007,11 +2006,23 @@ check_transformational (gfc_expr *e) if (strcmp (trans_func_f95[i], name) == 0) break; + /* FIXME, F2003: implement translation of initialization + expressions before enabling this check. For F95, error + out if the transformational function is not in the list. */ +#if 0 if (trans_func_f95[i] == NULL && gfc_notify_std (GFC_STD_F2003, "transformational intrinsic '%s' at %L is not permitted " "in an initialization expression", name, &e->where) == FAILURE) return MATCH_ERROR; +#else + if (trans_func_f95[i] == NULL) + { + gfc_error("transformational intrinsic '%s' at %L is not permitted " + "in an initialization expression", name, &e->where); + return MATCH_ERROR; + } +#endif return check_init_expr_arguments (e); } @@ -2150,19 +2161,19 @@ check_init_expr (gfc_expr *e) gfc_error ("assumed size array '%s' at %L is not permitted " "in an initialization expression", e->symtree->n.sym->name, &e->where); - break; + break; case AS_ASSUMED_SHAPE: gfc_error ("assumed shape array '%s' at %L is not permitted " "in an initialization expression", e->symtree->n.sym->name, &e->where); - break; + break; case AS_DEFERRED: gfc_error ("deferred array '%s' at %L is not permitted " "in an initialization expression", e->symtree->n.sym->name, &e->where); - break; + break; default: gcc_unreachable(); -- cgit v1.1