re PR fortran/33040 ([ISO_C_BINDING] ICE in gfc_trans_structure_assign)

2007-09-11  Christopher D. Rickett  <crickett@lanl.gov>

	PR fortran/33040
	* trans-expr.c (gfc_trans_structure_assign): Convert component
	C_NULL_PTR and C_NULL_FUNPTR component initializers to (void *).
	* trans-types.c (gfc_get_derived_type): Create a backend_decl for
	the c_address field of C_PTR and C_FUNPTR and ensure initializer
	is of proper type/kind for (void *).

2007-09-11  Christopher D. Rickett  <crickett@lanl.gov>

	PR fortran/33040
	* gfortran.dg/c_ptr_tests_11.f03: New test case.

From-SVN: r128385

gcc/fortran/ChangeLog

+2007-09-11  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/33040
+	* trans-expr.c (gfc_trans_structure_assign): Convert component
+	C_NULL_PTR and C_NULL_FUNPTR component initializers to (void *).
+	* trans-types.c (gfc_get_derived_type): Create a backend_decl for
+	the c_address field of C_PTR and C_FUNPTR and ensure initializer
+	is of proper type/kind for (void *).
+
 2007-09-11  Jan Hubicka <jh@suse.cz>
 
 	* f95-lang.c (gfc_expand_function): Kill.

gcc/fortran/trans-expr.c

@@ -3155,6 +3155,19 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr)
       if (!c->expr)
         continue;
 
+      /* Update the type/kind of the expression if it represents either
+	 C_NULL_PTR or C_NULL_FUNPTR.  This is done here because this may
+	 be the first place reached for initializing output variables that
+	 have components of type C_PTR/C_FUNPTR that are initialized.  */
+      if (c->expr->ts.type == BT_DERIVED && c->expr->ts.derived
+	  && c->expr->ts.derived->attr.is_iso_c)
+        {
+	  c->expr->expr_type = EXPR_NULL;
+	  c->expr->ts.type = c->expr->ts.derived->ts.type;
+	  c->expr->ts.f90_type = c->expr->ts.derived->ts.f90_type;
+	  c->expr->ts.kind = c->expr->ts.derived->ts.kind;
+	}
+      
       field = cm->backend_decl;
       tmp = build3 (COMPONENT_REF, TREE_TYPE (field), dest, field, NULL_TREE);
       tmp = gfc_trans_subcomponent_assign (tmp, cm, c->expr);

gcc/fortran/trans-types.c

@@ -1688,16 +1688,29 @@ gfc_get_derived_type (gfc_symbol * derived)
   /* See if it's one of the iso_c_binding derived types.  */
   if (derived->attr.is_iso_c == 1)
     {
+      if (derived->backend_decl)
+	return derived->backend_decl;
+
       if (derived->intmod_sym_id == ISOCBINDING_PTR)
 	derived->backend_decl = ptr_type_node;
       else
 	derived->backend_decl = pfunc_type_node;
+
+      /* Create a backend_decl for the __c_ptr_c_address field.  */
+      derived->components->backend_decl =
+	gfc_add_field_to_struct (&(derived->backend_decl->type.values),
+				 derived->backend_decl,
+				 get_identifier (derived->components->name),
+				 gfc_typenode_for_spec (
+				   &(derived->components->ts)));
+
       derived->ts.kind = gfc_index_integer_kind;
       derived->ts.type = BT_INTEGER;
       /* Set the f90_type to BT_VOID as a way to recognize something of type
          BT_INTEGER that needs to fit a void * for the purpose of the
          iso_c_binding derived types.  */
       derived->ts.f90_type = BT_VOID;
+      
       return derived->backend_decl;
     }
   
@@ -1742,6 +1755,13 @@ gfc_get_derived_type (gfc_symbol * derived)
           c->ts.type = c->ts.derived->ts.type;
           c->ts.kind = c->ts.derived->ts.kind;
           c->ts.f90_type = c->ts.derived->ts.f90_type;
+	  if (c->initializer)
+	    {
+	      c->initializer->ts.type = c->ts.type;
+	      c->initializer->ts.kind = c->ts.kind;
+	      c->initializer->ts.f90_type = c->ts.f90_type;
+	      c->initializer->expr_type = EXPR_NULL;
+	    }
         }
     }
 

gcc/testsuite/ChangeLog

+2007-09-11  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/33040
+	* gfortran.dg/c_ptr_tests_11.f03: New test case. 
+
 2007-09-11  Jakub Jelinek  <jakub@redhat.com>
 
 	* gcc.dg/va-arg-pack-len-1.c: New test.
@@ -25,15 +30,15 @@
 
 2007-09-10  Harsha Jagasia <harsha.jagasia@amd.com>
 
-        * gcc.dg/vect/costmodel/i386/costmodel-vect-31.c: 
+	* gcc.dg/vect/costmodel/i386/costmodel-vect-31.c: 
 	Change dg-final to expect 1 non-profitable loop and
 	3 profitable loops.
-        * gcc.dg/vect/costmodel/x86-64/costmodel-vect-31.c:
+	* gcc.dg/vect/costmodel/x86-64/costmodel-vect-31.c:
 	Change dg-final to expect 1 non-profitable loop and
 	3 profitable loops.
-        * gcc.dg/vect/costmodel/x86-64/costmodel-fast-math-vect-pr29925.c:
+	* gcc.dg/vect/costmodel/x86-64/costmodel-fast-math-vect-pr29925.c:
 	Change dg-final to expect 1 profitable loop.
-        * gcc.dg/vect/costmodel/i386/costmodel-fast-math-vect-pr29925.c:
+	* gcc.dg/vect/costmodel/i386/costmodel-fast-math-vect-pr29925.c:
 	Change dg-final to expect 1 profitable loop.	
 	
 2007-09-10  Richard Sandiford  <richard@codesourcery.com>
@@ -345,7 +350,7 @@
 
 2007-09-05  Sandra Loosemore  <sandra@codesourcery.com>
 	    David Ung  <davidu@mips.com>
-            Nigel Stephens <nigel@mips.com>
+	    Nigel Stephens <nigel@mips.com>
 
 	* gcc.c-torture/compile/mipscop-1.c: Add nomips16 attributes.
 	* gcc.c-torture/compile/mipscop-2.c: Likewise.
@@ -378,7 +383,7 @@
 
 2007-09-05  Sandra Loosemore  <sandra@codesourcery.com>
 	    David Ung  <davidu@mips.com>
-            Nigel Stephens <nigel@mips.com>
+	    Nigel Stephens <nigel@mips.com>
 
 	* gcc.target/mips/mips16-attributes.c: New.
 

gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03

+! { dg-do compile }
+! Verify that initialization of c_ptr components works.
+module fgsl
+  use, intrinsic :: iso_c_binding
+  implicit none
+  type, public :: fgsl_matrix
+     private
+     type(c_ptr) :: gsl_matrix = c_null_ptr
+  end type fgsl_matrix
+  type, public :: fgsl_multifit_fdfsolver
+     private
+     type(c_ptr) :: gsl_multifit_fdfsolver = c_null_ptr
+  end type fgsl_multifit_fdfsolver
+interface
+  function gsl_multifit_fdfsolver_jac(s) bind(c)
+    import :: c_ptr
+    type(c_ptr), value :: s
+    type(c_ptr) :: gsl_multifit_fdfsolver_jac
+  end function gsl_multifit_fdfsolver_jac
+end interface
+contains
+  function fgsl_multifit_fdfsolver_jac(s)
+    type(fgsl_multifit_fdfsolver), intent(in) :: s
+    type(fgsl_matrix) :: fgsl_multifit_fdfsolver_jac
+    fgsl_multifit_fdfsolver_jac%gsl_matrix = &
+         gsl_multifit_fdfsolver_jac(s%gsl_multifit_fdfsolver)
+  end function fgsl_multifit_fdfsolver_jac
+end module fgsl
+
+module m
+  use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr
+  implicit none
+  type t
+    type(c_ptr) :: matrix  = c_null_ptr
+  end type t
+contains
+  subroutine func(a)
+    type(t), intent(out) :: a
+  end subroutine func
+end module m
+! { dg-final { cleanup-modules "fgsl m" } } 
+