re PR fortran/91926 (assumed rank optional)

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-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  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/91926
	* runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Do not
	modify the bounds and offset for CFI_other.

From-SVN: r276624
This commit is contained in:
Paul Thomas 2019-10-05 08:17:55 +00:00
parent d56cbcc0a2
commit 980f185ce3
8 changed files with 160 additions and 9 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1,3 +1,9 @@
2019-10-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/91926
* runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Do not
modify the bounds and offset for CFI_other.
2019-10-01 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/91593
@ -14,7 +20,7 @@
formatted_transfer_scalar_read, formatted_transfer_scalar_write,
pre_position, next_record_r, next_record_w): Add and use
FORMATTED_UNSPECIFIED to enumeration.
2019-09-27 Maciej W. Rozycki <macro@wdc.com>
* configure: Regenerate.

View File

@ -63,7 +63,8 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
d->dtype.version = s->version;
GFC_DESCRIPTOR_RANK (d) = (signed char)s->rank;
d->dtype.attribute = (signed short)s->attribute;
if (d->dtype.attribute == CFI_attribute_other)
return;
if (s->rank)
{