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

gcc/fortran/ChangeLog

+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

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 ();

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)

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.c

+/* 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;
+}

gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.f90

+! { 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

gcc/testsuite/gfortran.dg/bind_c_procs_3.f90

+! { 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