Hi all!
Proposed patch to:
Bug 93308 - bind(c) subroutine changes lower bound of array argument in
caller
Bug 93963 - Select rank mishandling allocatable and pointer arguments
with bind(c)
Bug 94327 - Bind(c) argument attributes are incorrectly set
Bug 94331 - Bind(C) corrupts array descriptors
Bug 97046 - Bad interaction between lbound/ubound, allocatable arrays
and bind(C) subroutine with dimension(..) parameter
Patch tested only on x86_64-pc-linux-gnu.
Fix attribute handling, which reflect a prior intermediate version of
the Fortran standard.
CFI descriptors, in most cases, should not be copied out has they can
corrupt the Fortran descriptor. Bounds will vary and the original
Fortran bounds are definitively lost on conversion.
Thank you very much.
Best regards,
José Rui
Fortran: Fix attributtes and bounds in ISO_Fortran_binding.
gcc/fortran/ChangeLog:
PR fortran/93308
PR fortran/93963
PR fortran/94327
PR fortran/94331
PR fortran/97046
* 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:
PR fortran/93308
PR fortran/93963
PR fortran/94327
PR fortran/94331
PR fortran/97046
* 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:
PR fortran/93308
PR fortran/93963
PR fortran/94327
PR fortran/94331
PR fortran/97046
* 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.
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 406b4ae..9fb4ef9 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4519,22 +4519,28 @@ convert_CFI_desc (gfc_wrapped_block * block, gfc_symbol *sym)
gfc_add_expr_to_block (_block, incoming);
incoming = gfc_finish_block (_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 (_block);
- gfc_init_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 (, outgoing);
+ outgoing = NULL_TREE;
+ if ((sym->attr.pointer || sym->attr.allocatable)
+ && !sym->attr.value
+ && sym->attr.intent != INTENT_IN)
+ {
+ gfc_init_block (_block);
+ gfc_init_block ();
- outgoing = build3_v (COND_EXPR, present,
- gfc_finish_block (),
- build_empty_stmt (input_location));
- gfc_add_expr_to_block (_block, outgoing);
- outgoing = gfc_finish_block (_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 (, outgoing);
+
+ outgoing = build3_v (COND_EXPR, present,
+ gfc_finish_block (),
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (_block, outgoing);
+ outgoing = gfc_finish_block (_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 cce18d0..1f84d57 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5460,13 +5460,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)
{
@@ -5574,10 +5573,15 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
gfc_prepend_expr_to_block (>post, tmp);
/* Transfer values
