From 40cf80786fdd50c33b2517ea920b307687d59078 Mon Sep 17 00:00:00 2001 From: pault Date: Wed, 26 Oct 2005 05:20:19 +0000 Subject: [PATCH] 2005-10-26 Paul Thomas PR fortran/24158 * decl.c (gfc_match_data_decl): Correct broken bit of code that prevents undefined derived types from being used as components of another derived type. * resolve.c (resolve_symbol): Add backstop error when derived type variables arrive here with a type that has no components. 2005-10-26 Paul Thomas PR fortran/24158 gfortran.dg/derived_recursion.f90: New test. gfortran.dg/implicit_actual.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@105913 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 9 +++++++ gcc/fortran/decl.c | 20 +++++++++------ gcc/fortran/resolve.c | 18 +++++++++++++ gcc/testsuite/ChangeLog | 6 +++++ gcc/testsuite/gfortran.dg/derived_recursion.f90 | 24 +++++++++++++++++ gcc/testsuite/gfortran.dg/implicit_actual.f90 | 34 +++++++++++++++++++++++++ 6 files changed, 103 insertions(+), 8 deletions(-) create mode 100755 gcc/testsuite/gfortran.dg/derived_recursion.f90 create mode 100755 gcc/testsuite/gfortran.dg/implicit_actual.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 233f149..2cfea31 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2005-10-26 Paul Thomas + + PR fortran/24158 + * decl.c (gfc_match_data_decl): Correct broken bit of code + that prevents undefined derived types from being used as + components of another derived type. + * resolve.c (resolve_symbol): Add backstop error when derived + type variables arrive here with a type that has no components. + 2005-10-25 Jakub Jelinek * trans.h (gfc_conv_cray_pointee): Remove. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 5d4bd56..8c2895e 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2075,17 +2075,21 @@ gfc_match_data_decl (void) if (current_attr.pointer && gfc_current_state () == COMP_DERIVED) goto ok; - if (gfc_find_symbol (current_ts.derived->name, - current_ts.derived->ns->parent, 1, &sym) == 0) - goto ok; + gfc_find_symbol (current_ts.derived->name, + current_ts.derived->ns->parent, 1, &sym); - /* Hope that an ambiguous symbol is itself masked by a type definition. */ - if (sym != NULL && sym->attr.flavor == FL_DERIVED) + /* Any symbol that we find had better be a type definition + which has its components defined. */ + if (sym != NULL && sym->attr.flavor == FL_DERIVED + && current_ts.derived->components != NULL) goto ok; - gfc_error ("Derived type at %C has not been previously defined"); - m = MATCH_ERROR; - goto cleanup; + /* Now we have an error, which we signal, and then fix up + because the knock-on is plain and simple confusing. */ + gfc_error_now ("Derived type at %C has not been previously defined " + "and so cannot appear in a derived type definition."); + current_attr.pointer = 1; + goto ok; } ok: diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 6c03126..03206bb 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4339,6 +4339,24 @@ resolve_symbol (gfc_symbol * sym) } } + /* If a derived type symbol has reached this point, without its + type being declared, we have an error. Notice that most + conditions that produce undefined derived types have already + been dealt with. However, the likes of: + implicit type(t) (t) ..... call foo (t) will get us here if + the type is not declared in the scope of the implicit + statement. Change the type to BT_UNKNOWN, both because it is so + and to prevent an ICE. */ + if (sym->ts.type == BT_DERIVED + && sym->ts.derived->components == NULL) + { + gfc_error ("The derived type '%s' at %L is of type '%s', " + "which has not been defined.", sym->name, + &sym->declared_at, sym->ts.derived->name); + sym->ts.type = BT_UNKNOWN; + return; + } + /* Ensure that derived type components of a public derived type are not of a private type. */ if (sym->attr.flavor == FL_DERIVED diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f59875f..3ef1196 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2005-10-26 Paul Thomas + + PR fortran/24158 + gfortran.dg/derived_recursion.f90: New test. + gfortran.dg/implicit_actual.f90: New test. + 2005-10-25 Alexandre Oliva PR middle-end/24295, PR testsuite/24477 diff --git a/gcc/testsuite/gfortran.dg/derived_recursion.f90 b/gcc/testsuite/gfortran.dg/derived_recursion.f90 new file mode 100755 index 0000000..d52732f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/derived_recursion.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-O0" } +! Tests patch for PR24158 - The module would compile, in spite +! of the recursion between the derived types. This would cause +! an ICE in the commented out main program. The standard demands +! that derived type components be already defined, to break +! recursive derived type definitions. +! +! Contributed by Paul Thomas +! +module snafu + type :: a + integer :: v + type(b) :: i ! { dg-error "not been previously defined" } + end type a + type :: b + type(a) :: i + end type b + type (a) :: foo +end module snafu + +! use snafu +! foo%v = 1 +! end diff --git a/gcc/testsuite/gfortran.dg/implicit_actual.f90 b/gcc/testsuite/gfortran.dg/implicit_actual.f90 new file mode 100755 index 0000000..707df9c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implicit_actual.f90 @@ -0,0 +1,34 @@ +! { dg-do compile } +! { dg-options "-O0" } +! Tests patch for problem that was found whilst investigating +! PR24158. The call to foo would cause an ICE because the +! actual argument was of a type that was not defined. +! +! Contributed by Paul Thomas +! +module global + type :: t2 + type(t3), pointer :: d + end type t2 +end module global + +program snafu + use global + implicit type (t3) (z) + + call foo (zin) ! { dg-error "defined|Type/rank" } + +contains + + subroutine foo (z) + + type :: t3 + integer :: i + end type t3 + + type(t3) :: z + z%i = 1 + + end subroutine foo +end program snafu + -- 2.7.4