From 42f172d025a5f4f44520b5b172d1786ea2a8fc24 Mon Sep 17 00:00:00 2001 From: kargl Date: Fri, 16 Sep 2016 17:55:38 +0000 Subject: 2016-09-16 Steven G. Kargl PR fortran/77612 * decl.c (char_len_param_value): Check parent namespace for seen_implicit_none. 2016-09-16 Steven G. Kargl PR fortran/77612 * gfortran.dg/pr77612.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@240191 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/decl.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index b5242394cef..c83e9d4d791 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -920,9 +920,10 @@ char_len_param_value (gfc_expr **expr, bool *deferred) t = gfc_reduce_init_expr (e); - if (!t && (e->ts.type == BT_UNKNOWN - && e->symtree->n.sym->attr.untyped == 1 - && e->symtree->n.sym->ns->seen_implicit_none == 1)) + if (!t && e->ts.type == BT_UNKNOWN + && e->symtree->n.sym->attr.untyped == 1 + && (e->symtree->n.sym->ns->seen_implicit_none == 1 + || e->symtree->n.sym->ns->parent->seen_implicit_none == 1)) { gfc_free_expr (e); goto syntax; -- cgit v1.2.1 From 891196d7325e4c55d92d5ac5cfe7161c4f36c0ce Mon Sep 17 00:00:00 2001 From: foreese Date: Mon, 19 Sep 2016 11:32:09 +0000 Subject: 2016-09-19 Fritz Reese PR fortran/77584 * gcc/fortran/decl.c (match_record_decl, gfc_match_decl_type_spec): Fixes to handling of structure/record from declaration-type-spec. * gcc/testsuite/gfortran.dg/dec_structure_15.f90: New testcase. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@240230 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/decl.c | 65 +++++++++++++++++++++++++++++------------------------- 1 file changed, 35 insertions(+), 30 deletions(-) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index c83e9d4d791..d9fae5753d0 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2909,12 +2909,14 @@ done: /* Matches a RECORD declaration. */ static match -match_record_decl (const char *name) +match_record_decl (char *name) { locus old_loc; old_loc = gfc_current_locus; + match m; - if (gfc_match (" record") == MATCH_YES) + m = gfc_match (" record /"); + if (m == MATCH_YES) { if (!gfc_option.flag_dec_structure) { @@ -2923,17 +2925,20 @@ match_record_decl (const char *name) "-fdec-structure"); return MATCH_ERROR; } - if (gfc_match (" /%n/", name) != MATCH_YES) - { - gfc_error ("Structure name expected after RECORD at %C"); - gfc_current_locus = old_loc; - return MATCH_ERROR; - } - return MATCH_YES; + m = gfc_match (" %n/", name); + if (m == MATCH_YES) + return MATCH_YES; } - gfc_current_locus = old_loc; + gfc_current_locus = old_loc; + if (gfc_option.flag_dec_structure + && (gfc_match (" record% ") == MATCH_YES + || gfc_match (" record%t") == MATCH_YES)) + gfc_error ("Structure name expected after RECORD at %C"); + if (m == MATCH_NO) return MATCH_NO; + + return MATCH_ERROR; } /* Matches a declaration-type-spec (F03:R502). If successful, sets the ts @@ -3128,26 +3133,26 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) else { /* Match nested STRUCTURE declarations; only valid within another - structure declaration. */ - m = gfc_match (" structure"); - if (m == MATCH_ERROR) - return MATCH_ERROR; - else if (m == MATCH_YES) - { - if ( gfc_current_state () != COMP_STRUCTURE - && gfc_current_state () != COMP_MAP) - return MATCH_ERROR; - - m = gfc_match_structure_decl (); - if (m == MATCH_YES) - { - /* gfc_new_block is updated by match_structure_decl. */ - ts->type = BT_DERIVED; - ts->u.derived = gfc_new_block; - return MATCH_YES; - } - return MATCH_ERROR; - } + structure declaration. */ + if (gfc_option.flag_dec_structure + && (gfc_current_state () == COMP_STRUCTURE + || gfc_current_state () == COMP_MAP)) + { + m = gfc_match (" structure"); + if (m == MATCH_YES) + { + m = gfc_match_structure_decl (); + if (m == MATCH_YES) + { + /* gfc_new_block is updated by match_structure_decl. */ + ts->type = BT_DERIVED; + ts->u.derived = gfc_new_block; + return MATCH_YES; + } + } + if (m == MATCH_ERROR) + return MATCH_ERROR; + } /* Match CLASS declarations. */ m = gfc_match (" class ( * )"); -- cgit v1.2.1