From patchwork Sat Dec 18 19:36:07 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 76094 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id EDA87B70AF for ; Sun, 19 Dec 2010 06:36:20 +1100 (EST) Received: (qmail 14596 invoked by alias); 18 Dec 2010 19:36:18 -0000 Received: (qmail 14438 invoked by uid 22791); 18 Dec 2010 19:36:16 -0000 X-SWARE-Spam-Status: No, hits=1.0 required=5.0 tests=AWL, BAYES_00, KAM_STOCKTIP, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 18 Dec 2010 19:36:11 +0000 Received: from [192.168.178.22] (port-92-204-118-252.dynamic.qsc.de [92.204.118.252]) by mx02.qsc.de (Postfix) with ESMTP id 1BCD41E13B; Sat, 18 Dec 2010 20:36:07 +0100 (CET) Message-ID: <4D0D0D27.6080103@net-b.de> Date: Sat, 18 Dec 2010 20:36:07 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.13) Gecko/20101206 SUSE/3.1.7 Thunderbird/3.1.7 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR 46974: Handle C_(FUN)PTR variables in TRANSFER Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org The patch adds compile-time simplification support for C_PTR/C_FUNPTR variables. Those are special beasts as they are derived types in Fortran (gfc_expr/gfc_symbol) but for the middle end (tree) they are simple (function) pointers. The patch add special treatment to the -> C_(FUN)PTR-type conversion in target-memory.c - and it handles them explicitly in assignment. I removed the bits about C_NULL_PTR which seems to be dead code. I believe the function is never called for C_NULL_PTR as the conversion to an c_intptr_t-like integer happens earlier. Additionally, even if for C_NULL_PTR the code block would be entered, there were a segfault as the component->backend_decl is NULL. -- At least that's how I read gfc_get_derived_type. Build and regtested on x86-64-linux. OK for the trunk? Tobias PS: I wrote in the PR that one should try to avoid the special handling - obviously, I failed. However, the patch at least fixes the PR and allows compile-time simplification. 2010-12-18 Tobias Burnus 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 PR fortran/46974 * gfortran.dg/c_ptr_tests_16.f90: New. diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index 01383c7..878fb29 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -442,9 +442,28 @@ 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) { 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/gfortran.dg/c_ptr_tests_16.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90 new file mode 100644 index 0000000..eb27171 --- /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 Kargle 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" } }