OSDN Git Service

2007-09-11 Christopher D. Rickett <crickett@lanl.gov>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 11 Sep 2007 15:53:22 +0000 (15:53 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 11 Sep 2007 15:53:22 +0000 (15:53 +0000)
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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@128385 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/trans-expr.c
gcc/fortran/trans-types.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03 [new file with mode: 0644]

index 348d2b0..99c13c6 100644 (file)
@@ -1,3 +1,12 @@
+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.
index 4111092..1a4f424 100644 (file)
@@ -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);
index b7c9c53..ba72466 100644 (file)
@@ -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;
+           }
         }
     }
 
index 953e6aa..c1d3755 100644 (file)
@@ -1,3 +1,8 @@
+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.
 
 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>
 
 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.
 
 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.
 
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03
new file mode 100644 (file)
index 0000000..9448f82
--- /dev/null
@@ -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" } } 
+