diff options
| -rw-r--r-- | gcc/fortran/match.cc | 41 | ||||
| -rw-r--r-- | gcc/fortran/resolve.cc | 3 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr99139.f90 | 24 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr99368.f90 | 17 |
4 files changed, 80 insertions, 5 deletions
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index ca64e59..7335d98 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -5622,10 +5622,31 @@ gfc_match_namelist (void) gfc_error_check (); } else - /* If the type is not set already, we set it here to the - implicit default type. It is not allowed to set it - later to any other type. */ - gfc_set_default_type (sym, 0, gfc_current_ns); + { + /* Before the symbol is given an implicit type, check to + see if the symbol is already available in the namespace, + possibly through host association. Importantly, the + symbol may be a user defined type. */ + + gfc_symbol *tmp; + + gfc_find_symbol (sym->name, NULL, 1, &tmp); + if (tmp && tmp->attr.generic + && (tmp = gfc_find_dt_in_generic (tmp))) + { + if (tmp->attr.flavor == FL_DERIVED) + { + gfc_error ("Derived type %qs at %L conflicts with " + "namelist object %qs at %C", + tmp->name, &tmp->declared_at, sym->name); + goto error; + } + } + + /* Set type of the symbol to its implicit default type. It is + not allowed to set it later to any other type. */ + gfc_set_default_type (sym, 0, gfc_current_ns); + } } if (sym->attr.in_namelist == 0 && !gfc_add_in_namelist (&sym->attr, sym->name, NULL)) @@ -6805,8 +6826,20 @@ gfc_match_select_rank (void) gfc_current_ns = gfc_build_block_ns (ns); m = gfc_match (" %n => %e", name, &expr2); + if (m == MATCH_YES) { + /* If expr2 corresponds to an implicitly typed variable, then the + actual type of the variable may not have been set. Set it here. */ + if (!gfc_current_ns->seen_implicit_none + && expr2->expr_type == EXPR_VARIABLE + && expr2->ts.type == BT_UNKNOWN + && expr2->symtree && expr2->symtree->n.sym) + { + gfc_set_default_type (expr2->symtree->n.sym, 0, gfc_current_ns); + expr2->ts.type = expr2->symtree->n.sym->ts.type; + } + expr1 = gfc_get_expr (); expr1->expr_type = EXPR_VARIABLE; expr1->where = expr2->where; diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 8e018b6..f7cfdfc 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -13510,7 +13510,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) } } - if (sym->value == NULL && sym->attr.referenced) + if (sym->value == NULL && sym->attr.referenced + && !(sym->as && sym->as->type == AS_ASSUMED_RANK)) apply_default_init_local (sym); /* Try to apply a default initialization. */ /* Determine if the symbol may not have an initializer. */ diff --git a/gcc/testsuite/gfortran.dg/pr99139.f90 b/gcc/testsuite/gfortran.dg/pr99139.f90 new file mode 100644 index 0000000..a064103 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr99139.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-finit-local-zero" } +! +! Contributed by Gerhard Steinmetz <gscfq@t-online.de> +! +! Original implicitly typed 'x' gave a bad symbol ICE +subroutine s1(x) + target :: x(..) + select rank (y => x) + rank (1) + rank (2) + end select +end + +! Comment #2: Failed with above option +subroutine s2(x, z) + real, target :: x(..) + real :: z(10) + select rank (y => x) ! Error was:Assumed-rank variable y at (1) may only be + ! used as actual argument + rank (1) + rank (2) + end select +end diff --git a/gcc/testsuite/gfortran.dg/pr99368.f90 b/gcc/testsuite/gfortran.dg/pr99368.f90 new file mode 100644 index 0000000..9ba0425 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr99368.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! +! Contributed by Gerhard Steinmetz <gscfq@t-online.de> +! +program p + type y ! { dg-error "Derived type" } + end type +contains + subroutine s1 + namelist /x/ y ! { dg-error "conflicts with namelist object" } + character(3) y + end + subroutine s2 + namelist /z/ y ! { dg-error "conflicts with namelist object" } + character(3) y + end +end
\ No newline at end of file |