aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog7
-rw-r--r--gcc/fortran/target-memory.c21
-rw-r--r--gcc/fortran/trans-expr.c38
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/c_ptr_tests_16.f9058
5 files changed, 112 insertions, 17 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 960a6e8..3c7b4f4 100644
--- 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 01383c7..0a09f5a 100644
--- 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 cf2cdb6..3e994aa 100644
--- 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 711f343..4209e44 100644
--- 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
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" } }
generated by cgit v1.1 at 2025-06-05 17:18:00 +0000