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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 449589b..33e0f18 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+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
@@ -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  <tkoenig@gcc.gnu.org>
 
        PR fortran/92113

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 7858973..affdbf6 100644 (file)
--- 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 e3ea38a..bce353e 100644 (file)
--- 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 1c9657f..34a31f0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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.

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 (file)
index 0000000..f5c83c7
--- /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  <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;
+}

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 (file)
index 0000000..d3096c8
--- /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  <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

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 (file)
index 0000000..d58289f
--- /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  <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