Commit 0313a84a by Paul Thomas

re PR fortran/92123 ([F2018/array-descriptor] Scalar allocatable/pointer with…

re PR fortran/92123 ([F2018/array-descriptor]  Scalar allocatable/pointer with array descriptor (via bind(C)): ICE with select rank or error scalar variable with POINTER or ALLOCATABLE in procedure with BIND(C) is not yet supported)

2019-11-10  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/92123
	*decl.c (gfc_verify_c_interop_param): Remove error asserting
	that pointer or allocatable variables in a bind C procedure are
	not supported. Delete some trailing spaces.
	* trans-stmt.c (trans_associate_var): Correct the attempt to
	treat scalar pointer or allocatable temporaries as if they are
	array descriptors.

2019-11-10  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/92123
	* gfortran.dg/bind_c_procs_3.f90 : New test.
	* gfortran.dg/ISO_Fortran_binding_15.c : New test.
	* gfortran.dg/ISO_Fortran_binding_15.f90 : Additional source.

From-SVN: r278025
parent 4b77a380
2019-11-10 Paul Thomas <pault@gcc.gnu.org>
PR fortran/92123
*decl.c (gfc_verify_c_interop_param): Remove error asserting
that pointer or allocatable variables in a bind C procedure are
not supported. Delete some trailing spaces.
* trans-stmt.c (trans_associate_var): Correct the attempt to
treat scalar pointer or allocatable temporaries as if they are
array descriptors.
2019-11-09 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/92321
......
......@@ -1560,15 +1560,6 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
sym->ns->proc_name->name))
retval = false;
if ((sym->attr.allocatable || sym->attr.pointer) && !sym->as)
{
gfc_error ("Scalar variable %qs at %L with POINTER or "
"ALLOCATABLE in procedure %qs with BIND(C) is not yet"
" supported", sym->name, &(sym->declared_at),
sym->ns->proc_name->name);
retval = false;
}
if (sym->attr.optional == 1 && sym->attr.value)
{
gfc_error ("Variable %qs at %L cannot have both the OPTIONAL "
......
......@@ -1841,10 +1841,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
if (rank > 0)
copy_descriptor (&se.post, se.expr, desc, rank);
else
{
tmp = gfc_conv_descriptor_data_get (desc);
gfc_conv_descriptor_data_set (&se.post, se.expr, tmp);
}
gfc_conv_descriptor_data_set (&se.post, se.expr, desc);
/* The dynamic type could have changed too. */
if (sym->ts.type == BT_CLASS)
......
2019-11-10 Paul Thomas <pault@gcc.gnu.org>
PR fortran/92123
* gfortran.dg/bind_c_procs_3.f90 : New test.
* gfortran.dg/ISO_Fortran_binding_15.c : New test.
* gfortran.dg/ISO_Fortran_binding_15.f90 : Additional source.
2019-11-09 Jan Hubicka <hubicka@ucw.cz>
* gcc.dg/tree-ssa/pr46076.c: Make tested code hot.
......
/* Test the fix for PR92123. */
/* Contributed by Vipul Parekh <parekhvs@gmail.com> */
#include <stdlib.h>
#include <stdio.h>
#include "../../../libgfortran/ISO_Fortran_binding.h"
// Prototype for Fortran functions
extern void Fsub(CFI_cdesc_t *);
int main()
{
/* Note: ISO C forbids zero-size array 'dim' [-Wpedantic]
Therefore, even though 'dat' represents a scalar, it is set rank 1/ */
CFI_CDESC_T(1) dat;
int irc = 0;
irc = CFI_establish((CFI_cdesc_t *)&dat, NULL,
CFI_attribute_allocatable,
CFI_type_int, 0, (CFI_rank_t)0, NULL);
if (irc != CFI_SUCCESS)
{
printf("CFI_establish failed: irc = %d.\n", irc);
return EXIT_FAILURE;
}
Fsub((CFI_cdesc_t *)&dat);
if (*(int *)dat.base_addr != 42)
{
printf("Fsub returned = %d.\n", *(int *)dat.base_addr);
return EXIT_FAILURE;
}
irc = CFI_deallocate((CFI_cdesc_t *)&dat);
if (irc != CFI_SUCCESS)
{
printf("CFI_deallocate for dat failed: irc = %d.\n", irc);
return EXIT_FAILURE;
}
return EXIT_SUCCESS;
}
! { dg-do run { target c99_runtime } }
! { dg-additional-sources ISO_Fortran_binding_15.c }
!
! Test the fix for PR921233. The additional source is the main program.
!
! Contributed by Vipul Parekh <parekhvs@gmail.com>
!
module m
use, intrinsic :: iso_c_binding, only : c_int
contains
subroutine Fsub( dat ) bind(C, name="Fsub")
integer(c_int), allocatable, intent(out) :: dat(..)
select rank (dat)
rank (0)
allocate( dat )
dat = 42
end select
return
end subroutine
end module m
! { dg-do run }
!
! Test the fix for PR92123, in which 'dat' caused an error with the message
! "Scalar variable 'dat' at ?? with POINTER or ALLOCATABLE in procedure Fsub
! with BIND(C) is not yet supported."
!
! Contributed by Vipul Parekh <parekhvs@gmail.com>
!
module m
use, intrinsic :: iso_c_binding, only : c_int
contains
subroutine Fsub( dat ) bind(C, name="Fsub")
!.. Argument list
integer(c_int), allocatable, intent(out) :: dat
dat = 42
return
end subroutine
end module m
use, intrinsic :: iso_c_binding, only : c_int
use m, only : Fsub
integer(c_int), allocatable :: x
call Fsub( x )
if (x .ne. 42) stop 1
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment