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 <pault@gcc.gnu.org>
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
+2005-10-26 Paul Thomas <pault@gcc.gnu.org>
+
+ 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 <jakub@redhat.com>
* trans.h (gfc_conv_cray_pointee): Remove.
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:
}
}
+ /* 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
+2005-10-26 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/24158
+ gfortran.dg/derived_recursion.f90: New test.
+ gfortran.dg/implicit_actual.f90: New test.
+
2005-10-25 Alexandre Oliva <aoliva@redhat.com>
PR middle-end/24295, PR testsuite/24477
--- /dev/null
+! { 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 <pault@gcc.gnu.org>
+!
+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
--- /dev/null
+! { 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 <pault@gcc.gnu.org>
+!
+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
+