[PATCH,fortran]: fix for PR 33040

Christopher D. Rickett crickett@lanl.gov
Mon Sep 10 22:37:00 GMT 2007


hi all,

the attached patch fixes the ICE caused by the sample code snippets for PR 
33040.  bootstrapped and regtested on x86 linux with no new failures.

thanks.
Chris

:ADDPATCH fortran:

ChangeLog entry:

2007-09-10  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-10  Christopher D. Rickett  <crickett@lanl.gov>

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



-------------- next part --------------
Index: gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03
===================================================================
--- gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03	(revision 0)
@@ -0,0 +1,42 @@
+! { 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" } } 
+
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 128347)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -3155,6 +3155,19 @@ gfc_trans_structure_assign (tree dest, g
       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);
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(revision 128347)
+++ gcc/fortran/trans-types.c	(working copy)
@@ -1688,16 +1688,29 @@ gfc_get_derived_type (gfc_symbol * deriv
   /* 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 * deriv
           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;
+	    }
         }
     }
 


More information about the Gcc-patches mailing list