From 0cbf03689e3e7d9d6002b8e5d159ef3716d0404c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 26 Jul 2021 14:20:46 +0200 Subject: PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fortran: Fix attributes and bounds in ISO_Fortran_binding. 2021-07-26 José Rui Faustino de Sousa Tobias Burnus PR fortran/93308 PR fortran/93963 PR fortran/94327 PR fortran/94331 PR fortran/97046 gcc/fortran/ChangeLog: * trans-decl.c (convert_CFI_desc): Only copy out the descriptor if necessary. * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Updated attribute handling which reflect a previous intermediate version of the standard. Only copy out the descriptor if necessary. libgfortran/ChangeLog: * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Add code to verify the descriptor. Correct bounds calculation. (gfc_desc_to_cfi_desc): Add code to verify the descriptor. gcc/testsuite/ChangeLog: * gfortran.dg/ISO_Fortran_binding_1.f90: Add pointer attribute, this test is still erroneous but now it compiles. * gfortran.dg/bind_c_array_params_2.f90: Update regex to match code changes. * gfortran.dg/PR93308.f90: New test. * gfortran.dg/PR93963.f90: New test. * gfortran.dg/PR94327.c: New test. * gfortran.dg/PR94327.f90: New test. * gfortran.dg/PR94331.c: New test. * gfortran.dg/PR94331.f90: New test. * gfortran.dg/PR97046.f90: New test. --- gcc/fortran/trans-decl.c | 32 +++++++++++++++++++------------- gcc/fortran/trans-expr.c | 24 ++++++++++++++---------- 2 files changed, 33 insertions(+), 23 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index bf8783a..784f7b6 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -4539,22 +4539,28 @@ convert_CFI_desc (gfc_wrapped_block * block, gfc_symbol *sym) gfc_add_expr_to_block (&outer_block, incoming); incoming = gfc_finish_block (&outer_block); - /* Convert the gfc descriptor back to the CFI type before going out of scope, if the CFI type was present at entry. */ - gfc_init_block (&outer_block); - gfc_init_block (&tmpblock); - - tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr); - outgoing = build_call_expr_loc (input_location, - gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr); - gfc_add_expr_to_block (&tmpblock, outgoing); + outgoing = NULL_TREE; + if ((sym->attr.pointer || sym->attr.allocatable) + && !sym->attr.value + && sym->attr.intent != INTENT_IN) + { + gfc_init_block (&outer_block); + gfc_init_block (&tmpblock); - outgoing = build3_v (COND_EXPR, present, - gfc_finish_block (&tmpblock), - build_empty_stmt (input_location)); - gfc_add_expr_to_block (&outer_block, outgoing); - outgoing = gfc_finish_block (&outer_block); + tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr); + outgoing = build_call_expr_loc (input_location, + gfor_fndecl_gfc_to_cfi, 2, + tmp, gfc_desc_ptr); + gfc_add_expr_to_block (&tmpblock, outgoing); + + outgoing = build3_v (COND_EXPR, present, + gfc_finish_block (&tmpblock), + build_empty_stmt (input_location)); + gfc_add_expr_to_block (&outer_block, outgoing); + outgoing = gfc_finish_block (&outer_block); + } /* Add the lot to the procedure init and finally blocks. */ gfc_add_init_cleanup (block, incoming, outgoing); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b18a9ec..c4291cc 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5502,13 +5502,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) attribute = 1; } - /* If the formal argument is assumed shape and neither a pointer nor - allocatable, it is unconditionally CFI_attribute_other. */ - if (fsym->as->type == AS_ASSUMED_SHAPE - && !fsym->attr.pointer && !fsym->attr.allocatable) - cfi_attribute = 2; + if (fsym->attr.pointer) + cfi_attribute = 0; + else if (fsym->attr.allocatable) + cfi_attribute = 1; else - cfi_attribute = attribute; + cfi_attribute = 2; if (e->rank != 0) { @@ -5616,10 +5615,15 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) gfc_prepend_expr_to_block (&parmse->post, tmp); /* Transfer values back to gfc descriptor. */ - tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr); - tmp = build_call_expr_loc (input_location, - gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp); - gfc_prepend_expr_to_block (&parmse->post, tmp); + if (cfi_attribute != 2 /* CFI_attribute_other. */ + && !fsym->attr.value + && fsym->attr.intent != INTENT_IN) + { + tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr); + tmp = build_call_expr_loc (input_location, + gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp); + gfc_prepend_expr_to_block (&parmse->post, tmp); + } /* Deal with an optional dummy being passed to an optional formal arg by finishing the pre and post blocks and making their execution -- cgit v1.1