re PR fortran/46974 (ICE with TRANSFER using a C_PTR entity)

2010-12-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/46974
        * target-memory.c (gfc_interpret_derived): Handle
        * C_PTR/C_FUNPTR.
        * trans-expr.c (gfc_trans_structure_assign): Ditto.
        (gfc_conv_expr): Avoid crashes using non-C_NULL_(FUN)PTR const expr.

2010-12-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/46974
        * gfortran.dg/c_ptr_tests_16.f90: New.

From-SVN: r168031

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 960a6e883db259a1f4fa276aa700f09ae4bc47d0..3c7b4f4d08cdd823d1bd3c2325500ee13aa9c78f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2010-12-18  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/46974
+       * target-memory.c (gfc_interpret_derived): Handle C_PTR/C_FUNPTR.
+       * trans-expr.c (gfc_trans_structure_assign): Ditto.
+       (gfc_conv_expr): Avoid crashes using non-C_NULL_(FUN)PTR const expr.
+
 2010-12-17  Janus Weil  <janus@gcc.gnu.org>
            Tobias Burnus <burnus@gcc.gnu.org>
 

diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index 01383c7758840c4a050d70e6d75e9515d06668b4..0a09f5a5e37683478742c5c650ecbeb769017a06 100644 (file)
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -442,9 +442,27 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu
   /* The attributes of the derived type need to be bolted to the floor.  */
   result->expr_type = EXPR_STRUCTURE;
 
-  type = gfc_typenode_for_spec (&result->ts);
   cmp = result->ts.u.derived->components;
 
+  if (result->ts.u.derived->from_intmod == INTMOD_ISO_C_BINDING
+      && (result->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR
+         || result->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR))
+    {
+      gfc_constructor *c;
+      gfc_expr *e;
+      /* Needed as gfc_typenode_for_spec as gfc_typenode_for_spec
+        sets this to BT_INTEGER.  */
+      result->ts.type = BT_DERIVED;
+      e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind, &result->where); 
+      c = gfc_constructor_append_expr (&result->value.constructor, e, NULL);
+      c->n.component = cmp;
+      gfc_target_interpret_expr (buffer, buffer_size, e);
+      e->ts.is_iso_c = 1;
+      return int_size_in_bytes (ptr_type_node);
+    }
+
+  type = gfc_typenode_for_spec (&result->ts);
+
   /* Run through the derived type components.  */
   for (;cmp; cmp = cmp->next)
     {
@@ -483,6 +501,7 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu
         sizes of the components are multiples of BITS_PER_UNIT,
         i.e. there are, e.g., no bit fields.  */
 
+      gcc_assert (cmp->backend_decl);
       ptr = TREE_INT_CST_LOW (DECL_FIELD_BIT_OFFSET (cmp->backend_decl));
       gcc_assert (ptr % 8 == 0);
       ptr = ptr/8 + TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl));

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index cf2cdb6005a8f9862e961522eb3b5df67fbcad51..3e994aa82c01bb15f471c6d921ec1604feb2076e 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4514,6 +4514,24 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr)
 
   gfc_start_block (&block);
   cm = expr->ts.u.derived->components;
+
+  if (expr->ts.u.derived->from_intmod == INTMOD_ISO_C_BINDING
+      && (expr->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR
+          || expr->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR))
+    {
+      gfc_se se, lse;
+
+      gcc_assert (cm->backend_decl == NULL);
+      gfc_init_se (&se, NULL);
+      gfc_init_se (&lse, NULL);
+      gfc_conv_expr (&se, gfc_constructor_first (expr->value.constructor)->expr);
+      lse.expr = dest;
+      gfc_add_modify (&block, lse.expr,
+                     fold_convert (TREE_TYPE (lse.expr), se.expr));
+
+      return gfc_finish_block (&block);
+    } 
+
   for (c = gfc_constructor_first (expr->value.constructor);
        c; c = gfc_constructor_next (c), cm = cm->next)
     {
@@ -4521,20 +4539,6 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr)
       if (!c->expr)
        continue;
 
-      /* Handle c_null_(fun)ptr.  */
-      if (c && c->expr && c->expr->ts.is_iso_c)
-       {
-         field = cm->backend_decl;
-         tmp = fold_build3_loc (input_location, COMPONENT_REF,
-                                TREE_TYPE (field),
-                                dest, field, NULL_TREE);
-         tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp),
-                                tmp, fold_convert (TREE_TYPE (tmp),
-                                                   null_pointer_node));
-         gfc_add_expr_to_block (&block, tmp);
-         continue;
-       }
-
       field = cm->backend_decl;
       tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
                             dest, field, NULL_TREE);
@@ -4664,8 +4668,10 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
   if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
       && expr->ts.u.derived->attr.is_iso_c)
     {
-      if (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR
-          || expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_FUNPTR)
+      if (expr->expr_type == EXPR_VARIABLE
+         && (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR
+             || expr->symtree->n.sym->intmod_sym_id
+                == ISOCBINDING_NULL_FUNPTR))
         {
          /* Set expr_type to EXPR_NULL, which will result in
             null_pointer_node being used below.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 711f3437e741a6c2f9da0b6354241536d97dab85..4209e44cb99e3256b8250d5029c8b068154bbc7f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-12-18  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/46974
+       * gfortran.dg/c_ptr_tests_16.f90: New.
+
 2010-12-18  Jakub Jelinek  <jakub@redhat.com>
 
        PR tree-optimization/46985

diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90
new file mode 100644 (file)
index 0000000..3a51d28
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90
@@ -0,0 +1,58 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-optimized -O" }
+!
+! PR fortran/46974
+
+program test
+  use ISO_C_BINDING
+  implicit none
+  type(c_ptr) :: m
+  integer(c_intptr_t) :: a
+  integer(transfer(transfer(4_c_intptr_t, c_null_ptr),1_c_intptr_t)) :: b
+  a = transfer (transfer("ABCE", m), 1_c_intptr_t)
+  if (1162035777 /= a) call i_do_not_exist()
+end program test
+
+! Examples contributed by Steve Kargl and James Van Buskirk
+
+subroutine bug1
+   use ISO_C_BINDING
+   implicit none
+   type(c_ptr) :: m
+   type mytype
+     integer a, b, c
+   end type mytype
+   type(mytype) x
+   print *, transfer(32512, x)  ! Works.
+   print *, transfer(32512, m)  ! Caused ICE.
+end subroutine bug1 
+
+subroutine bug6
+   use ISO_C_BINDING
+   implicit none
+   interface
+      function fun()
+         use ISO_C_BINDING
+         implicit none
+         type(C_FUNPTR) fun
+      end function fun
+   end interface
+   type(C_PTR) array(2)
+   type(C_FUNPTR) result
+   integer(C_INTPTR_T), parameter :: const(*) = [32512,32520]
+
+   result = fun()
+   array = transfer([integer(C_INTPTR_T)::32512,32520],array)
+!   write(*,*) transfer(result,const)
+!   write(*,*) transfer(array,const)
+end subroutine bug6
+
+function fun()
+   use ISO_C_BINDING
+   implicit none
+   type(C_FUNPTR) fun
+   fun = transfer(32512_C_INTPTR_T,fun)
+end function fun 
+
+! { dg-final { scan-tree-dump-times "i_do_not_exist" 0 "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }