From: Paul Thomas Date: Sun, 10 Nov 2019 18:33:00 +0000 (+0000) Subject: re PR fortran/92123 ([F2018/array-descriptor] Scalar allocatable/pointer with array... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=0313a84a2faa8f685eb489fa787f1ea969f68560;p=gcc.git 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 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 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 449589ba65e..33e0f18aeef 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2019-11-10 Paul Thomas + + 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 PR fortran/92321 @@ -53,7 +63,7 @@ * io.c (check_format): Allow zero width for D, E, EN, and ES specifiers as default and when -std=F2018 is given. Retain existing errors when using the -fdec family of flags. - + 2019-11-03 Thomas Koenig PR fortran/92113 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 7858973cc20..affdbf6908d 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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 " @@ -7567,7 +7558,7 @@ gfc_match_entry (void) entry->attr.is_bind_c = 0; loc = entry->old_symbol != NULL - ? entry->old_symbol->declared_at : gfc_current_locus; + ? entry->old_symbol->declared_at : gfc_current_locus; gfc_error_now ("BIND(C) attribute at %L can only be used for " "variables or common blocks", &loc); } @@ -10313,7 +10304,7 @@ gfc_match_derived_decl (void) } /* In free source form, need to check for TYPE XXX as oppose to TYPEXXX. - But, we need to simply return for TYPE(. */ + But, we need to simply return for TYPE(. */ if (m == MATCH_NO && gfc_current_form == FORM_FREE) { char c = gfc_peek_ascii_char (); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index e3ea38a9aa1..bce353eafe9 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1c9657f3605..34a31f087c6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2019-11-10 Paul Thomas + + 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 * gcc.dg/tree-ssa/pr46076.c: Make tested code hot. diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.c b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.c new file mode 100644 index 00000000000..f5c83c74024 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.c @@ -0,0 +1,43 @@ +/* Test the fix for PR92123. */ + +/* Contributed by Vipul Parekh */ + +#include +#include +#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; +} diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.f90 new file mode 100644 index 00000000000..d3096c87e39 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.f90 @@ -0,0 +1,20 @@ +! { 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 +! +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 diff --git a/gcc/testsuite/gfortran.dg/bind_c_procs_3.f90 b/gcc/testsuite/gfortran.dg/bind_c_procs_3.f90 new file mode 100644 index 00000000000..d58289f7124 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind_c_procs_3.f90 @@ -0,0 +1,25 @@ +! { 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 +! +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