re PR fortran/33395 ([ISO_C_BINDING ?] ICE (segfault) in gfc_conv_initializer)

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

	PR fortran/33395
	* trans-expr.c (gfc_conv_initializer): Remove unnecessary test for
	intmod_sym_id and use derived symbol to set new kind of C_NULL_PTR
	and C_NULL_FUNPTR expressions.

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

	PR fortran/33395
	* gfortran.dg/c_ptr_tests_12.f03: New test case.

From-SVN: r128418

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 99c13c6a16280e55bfce1e7b1009ddaffa65906a..c17cac4c499c3f5e786b6970050ddfa5a8b6aa95 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2007-09-12  Christopher D. Rickett  <crickett@lanl.gov>
+
+       PR fortran/33395
+       * trans-expr.c (gfc_conv_initializer): Remove unnecessary test for
+       intmod_sym_id and use derived symbol to set new kind of C_NULL_PTR
+       and C_NULL_FUNPTR expressions.
+
 2007-09-11  Christopher D. Rickett  <crickett@lanl.gov>
 
        PR fortran/33040

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 1a4f42443dff1a35add52c5b772ff056c6cf2dcc..7e71a72201626f566f292447a32aefedb6c00cde 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2851,11 +2851,21 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type,
   if (!(expr || pointer))
     return NULL_TREE;
 
-  if (expr != NULL && expr->ts.type == BT_DERIVED
-      && expr->ts.is_iso_c && expr->ts.derived
-      && (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR
-         || expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_FUNPTR))
+  /* Check if we have ISOCBINDING_NULL_PTR or ISOCBINDING_NULL_FUNPTR
+     (these are the only two iso_c_binding derived types that can be
+     used as initialization expressions).  If so, we need to modify
+     the 'expr' to be that for a (void *).  */
+  if (expr->ts.type == BT_DERIVED && expr->ts.is_iso_c && expr->ts.derived)
+    {
+      gfc_symbol *derived = expr->ts.derived;
+
       expr = gfc_int_expr (0);
+
+      /* The derived symbol has already been converted to a (void *).  Use
+        its kind.  */
+      expr->ts.f90_type = derived->ts.f90_type;
+      expr->ts.kind = derived->ts.kind;
+    }
   
   if (array)
     {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 894533aee5702e465f793b163592024aed72b9f6..dc18e62e9f72678e78846f05756c3b53c1a26522 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-09-12  Christopher D. Rickett  <crickett@lanl.gov>
+
+       PR fortran/33395
+       * gfortran.dg/c_ptr_tests_12.f03: New test case.
+
 2007-09-12  Dorit Nuzman  <dorit@il.ibm.com>
 
        PR tree-optimization/33373

diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_12.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_12.f03
new file mode 100644 (file)
index 0000000..71e8170
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_12.f03
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! Verify that initialization of c_ptr components works.  This is based on 
+! code from fgsl: 
+! http://www.lrz-muenchen.de/services/software/mathematik/gsl/fortran/
+! and tests PR 33395.
+module fgsl
+  use, intrinsic :: iso_c_binding
+  implicit none
+!
+!
+! Kind and length parameters are default integer
+!
+  integer, parameter, public :: fgsl_double = c_double
+
+!
+! Types : Array support
+!
+  type, public :: fgsl_vector
+     private
+     type(c_ptr) :: gsl_vector = c_null_ptr
+  end type fgsl_vector
+
+contains
+  function fgsl_vector_align(p_x, f_x)
+    real(fgsl_double), pointer :: p_x(:)
+    type(fgsl_vector) :: f_x
+    integer :: fgsl_vector_align
+    fgsl_vector_align = 4
+  end function fgsl_vector_align
+end module fgsl
+
+module tmod
+  use fgsl
+  implicit none
+contains
+  subroutine expb_df() bind(c)
+    type(fgsl_vector) :: f_x
+    real(fgsl_double), pointer :: p_x(:)
+    integer :: status
+    status = fgsl_vector_align(p_x, f_x)
+  end subroutine expb_df
+end module tmod
+
+! { dg-final { cleanup-modules "fgsl tmod" } } 
+