From: Paul Thomas Date: Mon, 24 Mar 2008 19:11:24 +0000 (+0000) Subject: re PR fortran/34813 (ICE on incorrect nested type constructor (fold-const.c (fold_con... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c1203a704d375608c84ec0f1f4af250025374e85;p=gcc.git re PR fortran/34813 (ICE on incorrect nested type constructor (fold-const.c (fold_convert):2629)) 2008-03-24 Paul Thomas PR fortran/34813 * resolve.c (resolve_structure_cons): It is an error to assign NULL to anything other than a pointer or allocatable component. PR fortran/33295 * resolve.c (resolve_symbol): If the symbol is a derived type, resolve the derived type. If the symbol is a derived type function, ensure that the derived type is visible in the same namespace as the function. 2008-03-24 Paul Thomas PR fortran/34813 * gfortran.dg/null_3.f90 : New test PR fortran/33295 * gfortran.dg/module_function_type_1.f90 : New test From-SVN: r133488 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1be96641c4a..54a8fcbadb7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2008-03-24 Paul Thomas + + PR fortran/34813 + * resolve.c (resolve_structure_cons): It is an error to assign + NULL to anything other than a pointer or allocatable component. + + PR fortran/33295 + * resolve.c (resolve_symbol): If the symbol is a derived type, + resolve the derived type. If the symbol is a derived type + function, ensure that the derived type is visible in the same + namespace as the function. + 2008-03-23 Tobias Schlüter * trans.h: Use fold_build in build1_v, build2_v and build3_v diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 3d8fd3c6f34..0d39b2df849 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -834,6 +834,16 @@ resolve_structure_cons (gfc_expr *expr) t = gfc_convert_type (cons->expr, &comp->ts, 1); } + if (cons->expr->expr_type == EXPR_NULL + && !(comp->pointer || comp->allocatable)) + { + t = FAILURE; + gfc_error ("The NULL in the derived type constructor at %L is " + "being applied to component '%s', which is neither " + "a POINTER nor ALLOCATABLE", &cons->expr->where, + comp->name); + } + if (!comp->pointer || cons->expr->expr_type == EXPR_NULL) continue; @@ -7973,6 +7983,29 @@ resolve_symbol (gfc_symbol *sym) return; } + /* Make sure that the derived type has been resolved and that the + derived type is visible in the symbol's namespace, if it is a + module function and is not PRIVATE. */ + if (sym->ts.type == BT_DERIVED + && sym->ts.derived->attr.use_assoc + && sym->ns->proc_name->attr.flavor == FL_MODULE) + { + gfc_symbol *ds; + + if (resolve_fl_derived (sym->ts.derived) == FAILURE) + return; + + gfc_find_symbol (sym->ts.derived->name, sym->ns, 1, &ds); + if (!ds && sym->attr.function + && gfc_check_access (sym->attr.access, sym->ns->default_access)) + { + symtree = gfc_new_symtree (&sym->ns->sym_root, + sym->ts.derived->name); + symtree->n.sym = sym->ts.derived; + sym->ts.derived->refs++; + } + } + /* Unless the derived-type declaration is use associated, Fortran 95 does not allow public entries of private derived types. See 4.4.1 (F95) and 4.5.1.1 (F2003); and related interpretation diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 50d7ded78c8..4ce37ec18d0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2008-03-24 Paul Thomas + + PR fortran/34813 + * gfortran.dg/null_3.f90 : New test + + PR fortran/33295 + * gfortran.dg/module_function_type_1.f90 : New test + 2007-03-23 Thomas Koenig +! +module A + type A_type + real comp + end type +end module A + +module B +contains + function initA() + use A + implicit none + type(A_type):: initA + initA%comp=1.0 + end function +end module B + +program C + use B + use A + implicit none + type(A_type):: A_var + A_var = initA() +end program C + +! { dg-final { cleanup-modules "A B" } } + diff --git a/gcc/testsuite/gfortran.dg/null_3.f90 b/gcc/testsuite/gfortran.dg/null_3.f90 new file mode 100644 index 00000000000..141af1f5bcb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/null_3.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! This checks the fix for PR34813 in which the error at line 17 +! was not detected. +! +! Contributed by Daniel Franke +! +SUBROUTINE kd_tree_init_default() + TYPE :: kd_tree_node + INTEGER :: dummy + END TYPE + + TYPE :: kd_tree + TYPE(kd_tree_node) :: root + END TYPE + + TYPE(kd_tree) :: tree + tree = kd_tree(null()) ! { dg-error "neither a POINTER nor ALLOCATABLE" } +END SUBROUTINE