aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog11
-rw-r--r--gcc/fortran/trans-expr.c48
-rw-r--r--gcc/testsuite/ChangeLog7
-rw-r--r--gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.c12
-rw-r--r--gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.f9039
-rw-r--r--gcc/testsuite/gfortran.dg/ISO_Fortran_binding_14.f9041
6 files changed, 151 insertions, 7 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index dc1e19a..2da44e0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2019-10-05 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/91926
+ * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Correct the
+ assignment of the attribute field to account correctly for an
+ assumed shape dummy. Assign separately to the gfc and cfi
+ descriptors since the atribute can be different. Add btanch to
+ correctly handle missing optional dummies.
+
2019-10-04 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran.91959
@@ -65,7 +74,7 @@
character types are possible it can get the character length from
gfc_expr for character literals.
(gfc_dummy_typename): New functionfor gfc_typespec *, if no character
- length is present the character type is assumed and the appropriate
+ length is present the character type is assumed and the appropriate
string is return otherwise it calls gfc_typename for gfc_typespec *.
(gfc_typespec): for character types construct the type name with length
and kind (if it is not default kind).
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 61db4e3..965ab77 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5202,7 +5202,9 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
tree gfc_desc_ptr;
tree type;
tree cond;
+ tree desc_attr;
int attribute;
+ int cfi_attribute;
symbol_attribute attr = gfc_expr_attr (e);
stmtblock_t block;
@@ -5211,12 +5213,20 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
attribute = 2;
if (!e->rank || gfc_get_full_arrayspec_from_expr (e))
{
- if (fsym->attr.pointer)
+ if (attr.pointer)
attribute = 0;
- else if (fsym->attr.allocatable)
+ else if (attr.allocatable)
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;
+ else
+ cfi_attribute = attribute;
+
if (e->rank != 0)
{
parmse->force_no_tmp = 1;
@@ -5283,11 +5293,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
parmse->expr, attr);
}
- /* Set the CFI attribute field. */
- tmp = gfc_conv_descriptor_attribute (parmse->expr);
+ /* Set the CFI attribute field through a temporary value for the
+ gfc attribute. */
+ desc_attr = gfc_conv_descriptor_attribute (parmse->expr);
tmp = fold_build2_loc (input_location, MODIFY_EXPR,
- void_type_node, tmp,
- build_int_cst (TREE_TYPE (tmp), attribute));
+ void_type_node, desc_attr,
+ build_int_cst (TREE_TYPE (desc_attr), cfi_attribute));
gfc_add_expr_to_block (&parmse->pre, tmp);
/* Now pass the gfc_descriptor by reference. */
@@ -5305,6 +5316,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr);
gfc_add_expr_to_block (&parmse->pre, tmp);
+ /* Now set the gfc descriptor attribute. */
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+ void_type_node, desc_attr,
+ build_int_cst (TREE_TYPE (desc_attr), attribute));
+ gfc_add_expr_to_block (&parmse->pre, tmp);
+
/* The CFI descriptor is passed to the bind_C procedure. */
parmse->expr = cfi_desc_ptr;
@@ -5325,6 +5342,25 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
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
+ conditional on the dummy being present. */
+ if (fsym->attr.optional && e->expr_type == EXPR_VARIABLE
+ && e->symtree->n.sym->attr.optional)
+ {
+ cond = gfc_conv_expr_present (e->symtree->n.sym);
+ tmp = fold_build2 (MODIFY_EXPR, void_type_node,
+ cfi_desc_ptr,
+ build_int_cst (pvoid_type_node, 0));
+ tmp = build3_v (COND_EXPR, cond,
+ gfc_finish_block (&parmse->pre), tmp);
+ gfc_add_expr_to_block (&parmse->pre, tmp);
+ tmp = build3_v (COND_EXPR, cond,
+ gfc_finish_block (&parmse->post),
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&parmse->post, tmp);
+ }
}
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8a0a035..e40a167 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2019-10-05 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/91926
+ * gfortran.dg/ISO_Fortran_binding_13.f90 : New test.
+ * gfortran.dg/ISO_Fortran_binding_13.c : Additional source.
+ * gfortran.dg/ISO_Fortran_binding_14.f90 : New test.
+
2019-10-05 Jakub Jelinek <jakub@redhat.com>
PR c++/91369 - Implement P0784R7: constexpr new
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.c b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.c
new file mode 100644
index 0000000..1ac9fc8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.c
@@ -0,0 +1,12 @@
+/* Test the fix for PR91926. */
+
+/* Contributed by José Rui Faustino de Sousa <jrfsousa@hotmail.com> */
+
+#include <stdlib.h>
+
+int ifb_echo(void*);
+
+int ifb_echo(void *this)
+{
+ return this == NULL ? 1 : 2;
+}
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.f90
new file mode 100644
index 0000000..132a97c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.f90
@@ -0,0 +1,39 @@
+! { dg-do run { target c99_runtime } }
+! { dg-additional-sources ISO_Fortran_binding_13.c }
+!
+! Test the fix for PR91926. The additional source is the main program.
+!
+! Contributed by José Rui Faustino de Sousa <jrfsousa@hotmail.com>
+!
+program ifb_p
+
+ implicit none
+
+ integer :: i = 42
+
+ interface
+ integer function ifb_echo_aux(this) bind(c, name="ifb_echo")
+ implicit none
+ type(*), dimension(..), & ! removing assumed rank solves segmentation fault
+ optional, intent(in) :: this
+ end function ifb_echo_aux
+ end interface
+
+ if (ifb_echo_aux() .ne. 1) STOP 1 ! worked
+ if (ifb_echo() .ne. 1) stop 2 ! segmentation fault
+ if (ifb_echo_aux(i) .ne. 2) stop 3 ! worked
+ if (ifb_echo(i) .ne. 2) stop 4 ! worked
+
+ stop
+
+contains
+
+ integer function ifb_echo(this)
+ type(*), dimension(..), &
+ optional, intent(in) :: this
+
+ ifb_echo = ifb_echo_aux(this)
+ return
+ end function ifb_echo
+
+end program ifb_p
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_14.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_14.f90
new file mode 100644
index 0000000..388c543
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_14.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! Correct an error in the eveluation of the CFI descriptor attribute for
+! the case where the bind_C formal argument is not an assumed shape array
+! and not allocatable or pointer.
+!
+! Contributed by Gilles Gouaillardet <gilles@rist.or.jp>
+!
+MODULE FOO
+INTERFACE
+SUBROUTINE dummy(buf) BIND(C, name="sync")
+type(*), dimension(..) :: buf
+END SUBROUTINE
+END INTERFACE
+END MODULE
+
+PROGRAM main
+ USE FOO
+ IMPLICIT NONE
+ integer(8) :: before, after
+
+ INTEGER, parameter :: n = 1
+
+ INTEGER, ALLOCATABLE :: buf(:)
+ INTEGER :: buf2(n)
+ INTEGER :: i
+
+ ALLOCATE(buf(n))
+ before = LOC(buf(1))
+ CALL dummy (buf)
+ after = LOC(buf(1))
+
+ if (before .NE. after) stop 1
+
+ before = LOC(buf2(1))
+ CALL dummy (buf)
+ after = LOC(buf2(1))
+
+ if (before .NE. after) stop 2
+
+END PROGRAM
generated by cgit v1.1 at 2025-05-31 19:11:09 +0000