mirrors/gcc
0
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-12-04 01:04:26 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Tobias Burnus 2010-12-18 21:18:43 +01:00 committed by Tobias Burnus
parent a93bb2bc65
commit b5dca6ea71
5 changed files with 112 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -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>

21
gcc/fortran/target-memory.c
View File

@ -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));

38
gcc/fortran/trans-expr.c
View File

@ -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. */

5
gcc/testsuite/ChangeLog
View File

@ -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

58
gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90 Normal file
View File

@ -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" } }