re PR fortran/34813 (ICE on incorrect nested type constructor (fold-const.c (fold_convert):2629))

2008-03-24  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	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

gcc/fortran/ChangeLog

+2008-03-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	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 Schlter  <tobi@gcc.gnu.org>
 
 	* trans.h: Use fold_build in build1_v, build2_v and build3_v

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

gcc/testsuite/ChangeLog

+2008-03-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	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  <tkoenig@gcc.gnu.org
 
 	PR libfortran/32972

gcc/testsuite/gfortran.dg/module_function_type_1.f90

+! { dg-do compile }
+! This checks the fix for PR33295 in which the A_type in initA was
+! not promoted to module level and so not recognised as being the
+! same as that emanating directly from module a. 
+!
+! Contributed by Janus Weil <jaydub66@gmail.com>
+!
+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" } }
+

gcc/testsuite/gfortran.dg/null_3.f90

+! { dg-do compile }
+! This checks the fix for PR34813 in which the error at line 17
+! was not detected.
+!
+! Contributed by Daniel Franke <dfranke@gcc.gnu.org>
+!
+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