diff options
author | pbrook <pbrook@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-01-22 15:24:09 +0000 |
---|---|---|
committer | pbrook <pbrook@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-01-22 15:24:09 +0000 |
commit | e311e7c3ae9d2c65d64c920c0551e9dbca701af6 (patch) | |
tree | 2a3848c0ca3a85aeeedecdf1905a38e016a7dc5a /gcc/fortran/primary.c | |
parent | ea65f0839fed9f5a8ed08399afe2dbaa2bd7705a (diff) | |
download | gcc-e311e7c3ae9d2c65d64c920c0551e9dbca701af6.tar.gz |
2005-01-22 Paul Brook <paul@codesourcery.com>
* primary.c (gfc_match_rvalue): Only apply implicit type if variable
does not have an explicit type.
(gfc_match_variable): Resolve implicit derived types in all cases.
Resolve contained function types from their own namespace, not the
parent.
* resolve.c (resolve_contained_fntype): Remove duplicate sym->result
checking. Resolve from the contained namespace, not the parent.
testsuite/
* gfortran.dg/implicit_2.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@94066 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/primary.c')
-rw-r--r-- | gcc/fortran/primary.c | 30 |
1 files changed, 19 insertions, 11 deletions
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index da2b7c82b1a..6496bcd3478 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2011,6 +2011,7 @@ gfc_match_rvalue (gfc_expr ** result) resolution phase. */ if (gfc_peek_char () == '%' + && sym->ts.type == BT_UNKNOWN && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED) gfc_set_default_type (sym, 0, sym->ns); @@ -2188,29 +2189,18 @@ gfc_match_variable (gfc_expr ** result, int equiv_flag) case FL_UNKNOWN: if (gfc_add_flavor (&sym->attr, FL_VARIABLE, NULL) == FAILURE) return MATCH_ERROR; - - /* Special case for derived type variables that get their types - via an IMPLICIT statement. This can't wait for the - resolution phase. */ - - if (gfc_peek_char () == '%' - && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED) - gfc_set_default_type (sym, 0, sym->ns); - break; case FL_PROCEDURE: /* Check for a nonrecursive function result */ if (sym->attr.function && (sym->result == sym || sym->attr.entry)) { - /* If a function result is a derived type, then the derived type may still have to be resolved. */ if (sym->ts.type == BT_DERIVED && gfc_use_derived (sym->ts.derived) == NULL) return MATCH_ERROR; - break; } @@ -2221,6 +2211,24 @@ gfc_match_variable (gfc_expr ** result, int equiv_flag) return MATCH_ERROR; } + /* Special case for derived type variables that get their types + via an IMPLICIT statement. This can't wait for the + resolution phase. */ + + { + gfc_namespace * implicit_ns; + + if (gfc_current_ns->proc_name == sym) + implicit_ns = gfc_current_ns; + else + implicit_ns = sym->ns; + + if (gfc_peek_char () == '%' + && sym->ts.type == BT_UNKNOWN + && gfc_get_default_type (sym, implicit_ns)->type == BT_DERIVED) + gfc_set_default_type (sym, 0, implicit_ns); + } + expr = gfc_get_expr (); expr->expr_type = EXPR_VARIABLE; |