public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch] Fortran: Fix Bind(C) char-len check, add ptr-contiguous check
@ 2021-08-20 17:24 Tobias Burnus
  2021-08-25 18:58 ` *PING* – " Tobias Burnus
  0 siblings, 1 reply; 4+ messages in thread
From: Tobias Burnus @ 2021-08-20 17:24 UTC (permalink / raw)
  To: gcc-patches, fortran, Sandra Loosemore

[-- Attachment #1: Type: text/plain, Size: 2545 bytes --]

The following is about interoperability (BIND(C)) only.


* The patch adds a missing check for pointer + contiguous.
(Rejected to avoid copy-in issues? Or checking issues?)


* And it corrects an issue regarding len > 1 characters. While

  subroutine foo(x)
     character(len=2) :: x(*)

is valid Fortran code (the argument can be "abce" or ['a','b','c','d'] or ...)
– and would work also with bind(C) as the len=2 does not need to be passed
as hidden argument as len is a constant.
However, it is not valid nonetheless.


OK? Comments?

Tobias


PS: Referenced locations in the standard (F2018):

C1554 If proc-language-binding-spec is specified for a procedure,
each of its dummy arguments shall be an interoperable procedure (18.3.6)
or a variable that is interoperable (18.3.4, 18.3.5), assumed-shape,
assumed-rank, assumed-type, of type CHARACTER with assumed length,
or that has the ALLOCATABLE or POINTER attribute.

18.3.1: "... If the type is character, the length type parameter is
interoperable if and only if its value is one. ..."

"18.3.4 Interoperability of scalar variables":
"... A named scalar Fortran variable is interoperable ... if it
is of type character12its length is not assumed or declared by
an expression that is not a constant expression."

18.3.5: Likewise but for arrays.

18.3.6 "... Fortran procedure interface is interoperable with a C function prototype ..."
"(5) any dummy argument without the VALUE attribute corresponds
      to a formal parameter of the prototype that is of a pointer type, and either
      • the dummy argument is interoperable with an entity of the referenced type ..."
(Remark: those are passed as byte stream)
      "• the dummy argument is a nonallocatable nonpointer variable of type
         CHARACTER with assumed character length and the formal parameter is
         a pointer to CFI_cdesc_t,
       • the dummy argument is allocatable, assumed-shape, assumed-rank, or
         a pointer without the CONTIGUOUS attribute, and the formal parameter
         is a pointer to CFI_cdesc_t, or
(Remark: those two use an array descriptor, also for explicit-size/assumed-size
arrays or for scalars.)
       • the dummy argument is assumed-type ..."

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

[-- Attachment #2: bind-c-char-check.diff --]
[-- Type: text/x-patch, Size: 26029 bytes --]

Fortran: Fix Bind(C) char-len check, add ptr-contiguous check

Add F2018, 18.3.6 (5), pointer + contiguous is not permitted
check for dummies in BIND(C) procs.

Fix misreading of F2018, 18.3.4/18.3.5 + 18.3.6 (5) regarding
character dummies passed as byte stream to a bind(C) dummy arg:
Per F2018, 18.3.1 only len=1 is interoperable (since F2003).
F2008 added 'constant expression' for vars (F2018, 18.3.4/18.3.5),
applicable to dummy args per F2018, C1554. I misread this such
that len > 1 is permitted if len is a constant expr.

While the latter would work as character len=1 a(10) and len=2 a(5)
have the same storage sequence and len is fixed, it is still invalid.
Hence, it is now rejected again.

gcc/fortran/ChangeLog:

	* decl.c (gfc_verify_c_interop_param): Reject pointer with
	CONTIGUOUS attributes as dummy arg. Reject character len > 1
	when passed as byte stream.

gcc/testsuite/ChangeLog:

	* gfortran.dg/bind_c_char_6.f90:
	* gfortran.dg/bind_c_char_7.f90:
	* gfortran.dg/bind_c_char_8.f90:
	* gfortran.dg/bind_c_char_9.f90:
	* gfortran.dg/iso_c_binding_char_1.f90:
	* gfortran.dg/pr32599.f03:
	* gfortran.dg/bind_c_contiguous.f90: New test.

 gcc/fortran/decl.c                                 |  39 ++---
 gcc/testsuite/gfortran.dg/bind_c_char_6.f90        |  22 ++-
 gcc/testsuite/gfortran.dg/bind_c_char_7.f90        |  15 +-
 gcc/testsuite/gfortran.dg/bind_c_char_8.f90        |  12 +-
 gcc/testsuite/gfortran.dg/bind_c_char_9.f90        | 161 ++++++++++++---------
 gcc/testsuite/gfortran.dg/bind_c_contiguous.f90    |  33 +++++
 gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90 |   1 +
 gcc/testsuite/gfortran.dg/pr32599.f03              |   2 +-
 8 files changed, 164 insertions(+), 121 deletions(-)

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 05081c40f1e..3ecffe79d9f 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1551,11 +1551,15 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 			     sym->ns->proc_name->name);
 	    }
 
+	  /* Per F2018, 18.3.6 (5), pointer + contiguous is not permitted.  */
+	  if (sym->attr.pointer && sym->attr.contiguous)
+	    gfc_error ("Dummy argument %qs at %L may not be a pointer with "
+		       "CONTIGUOUS attribute as procedure %qs is BIND(C)",
+		       sym->name, &sym->declared_at, sym->ns->proc_name->name);
+
           /* Character strings are only C interoperable if they have a
-	     length of 1.  However, as argument they are either iteroperable
-	     when passed as descriptor (which requires len=: or len=*) or
-	     when having a constant length or are always passed by
-	     descriptor.  */
+	     length of 1.  However, as argument they are also iteroperable
+	     when passed as descriptor (which requires len=: or len=*).  */
 	  if (sym->ts.type == BT_CHARACTER)
 	    {
 	      gfc_charlen *cl = sym->ts.u.cl;
@@ -1607,7 +1611,8 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 	      else if (!cl || !cl->length)
 		{
 		  /* Assumed length; F2018, 18.3.6 (5)(2).
-		     Uses the CFI array descriptor.  */
+		     Uses the CFI array descriptor - also for scalars and
+		     explicit-size/assumed-size arrays.  */
 		  if (!gfc_notify_std (GFC_STD_F2018,
 				      "Assumed-length character dummy argument "
 				      "%qs at %L of procedure %qs with BIND(C) "
@@ -1629,7 +1634,8 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 		      retval = false;
 		    }
 		}
-	      else if (cl->length->expr_type != EXPR_CONSTANT)
+	      else if (cl->length->expr_type != EXPR_CONSTANT
+		       || mpz_cmp_si (cl->length->value.integer, 1) != 0)
 		{
 		  /* F2018, 18.3.6, (5), item 4.  */
 		  if (!sym->attr.dimension
@@ -1637,30 +1643,17 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 		      || sym->as->type == AS_EXPLICIT)
 		    {
 		      gfc_error ("Character dummy argument %qs at %L must be "
-				 "of constant length or assumed length, "
+				 "of constant length of one or assumed length, "
 				 "unless it has assumed shape or assumed rank, "
 				 "as procedure %qs has the BIND(C) attribute",
 				 sym->name, &sym->declared_at,
 				 sym->ns->proc_name->name);
 		      retval = false;
 		    }
-		  else if (!gfc_notify_std (GFC_STD_F2018,
-					    "Character dummy argument %qs at "
-					    "%L with nonconstant length as "
-					    "procedure %qs is BIND(C)",
-					    sym->name, &sym->declared_at,
-					    sym->ns->proc_name->name))
-		    retval = false;
+		  /* else: valid only sind F2018 - and an assumed-shape/rank
+		     array; however, gfc_notify_std is already called when
+		     those array type are used. Thus, silently accept F200x. */
 		}
-	     else if (mpz_cmp_si (cl->length->value.integer, 1) != 0
-		      && !gfc_notify_std (GFC_STD_F2008,
-					  "Character dummy argument %qs at %L "
-					  "with length greater than 1 for "
-					  "procedure %qs with BIND(C) "
-					  "attribute",
-					  sym->name, &sym->declared_at,
-					  sym->ns->proc_name->name))
-	       retval = false;
 	    }
 
 	  /* We have to make sure that any param to a bind(c) routine does
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_6.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_6.f90
index 23e1d92334b..6bab2956761 100644
--- a/gcc/testsuite/gfortran.dg/bind_c_char_6.f90
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_6.f90
@@ -9,11 +9,11 @@ subroutine s1 (x1) bind(C)
   character(len=1) :: x1
 end
 
-subroutine s2 (x2) bind(C) ! { dg-error "Fortran 2008: Character dummy argument 'x2' at .1. with length greater than 1 for procedure 's2' with BIND\\(C\\) attribute" }
+subroutine s2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's2' has the BIND\\(C\\) attribute" }
   character(len=2) :: x2
 end
 
-subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
+subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
   integer :: n
   character(len=n) :: xn
 end
@@ -28,19 +28,17 @@ subroutine as1 (x1) bind(C)  ! { dg-error "Fortran 2018: Assumed-shape array 'x1
   character(len=1) :: x1(:)
 end
 
-subroutine as2 (x2) bind(C) ! { dg-error "Fortran 2008: Character dummy argument 'x2' at .1. with length greater than 1 for procedure 'as2' with BIND\\(C\\) attribute" }
-                            ! { dg-error "Fortran 2018: Assumed-shape array 'x2' at .1. as dummy argument to the BIND\\(C\\) procedure 'as2' at .2." "" { target *-*-* } .-1 }
+subroutine as2 (x2) bind(C) ! { dg-error "Fortran 2018: Assumed-shape array 'x2' at .1. as dummy argument to the BIND\\(C\\) procedure 'as2' at .2." }
   character(len=2) :: x2(:,:)
 end
 
-subroutine as3 (xn, n) bind(C) ! { dg-error "Fortran 2018: Character dummy argument 'xn' at .1. with nonconstant length as procedure 'as3' is BIND\\(C\\)" }
-                            ! { dg-error "Fortran 2018: Assumed-shape array 'xn' at .1. as dummy argument to the BIND\\(C\\) procedure 'as3' at .2." "" { target *-*-* } .-1 }
+subroutine as3 (xn, n) bind(C) ! { dg-error "Fortran 2018: Assumed-shape array 'xn' at .1. as dummy argument to the BIND\\(C\\) procedure 'as3' at .2." }
   integer :: n
   character(len=n) :: xn(:,:,:)
 end
 
-subroutine as4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'as4' with BIND\\(C\\) attribute" }
-                            ! { dg-error "Fortran 2018: Assumed-shape array 'xstar' at .1. as dummy argument to the BIND\\(C\\) procedure 'as4' at .2." "" { target *-*-* } .-1 }
+subroutine as4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'as4' with BIND\\(C\\) attribute"  }
+                               ! { dg-error "Fortran 2018: Assumed-shape array 'xstar' at .1. as dummy argument to the BIND\\(C\\) procedure 'as4' at .2." "" { target *-*-* } .-1 }
   character(len=*) :: xstar(:,:,:,:)
 end
 
@@ -69,11 +67,11 @@ subroutine az1 (x1) bind(C)
   character(len=1) :: x1(*)
 end
 
-subroutine az2 (x2) bind(C) ! { dg-error "Fortran 2008: Character dummy argument 'x2' at .1. with length greater than 1 for procedure 'az2' with BIND\\(C\\) attribute" }
+subroutine az2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az2' has the BIND\\(C\\) attribute" }
   character(len=2) :: x2(*)
 end
                                              
-subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
+subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
   integer :: n
   character(len=n) :: xn(*)
 end
@@ -88,11 +86,11 @@ subroutine ae1 (x1) bind(C)
   character(len=1) :: x1(5)
 end
 
-subroutine ae2 (x2) bind(C) ! { dg-error "Fortran 2008: Character dummy argument 'x2' at .1. with length greater than 1 for procedure 'ae2' with BIND\\(C\\) attribute" }
+subroutine ae2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae2' has the BIND\\(C\\) attribute" }
   character(len=2) :: x2(7)
 end
 
-subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
+subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
   integer :: n
   character(len=n) :: xn(9)
 end
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_7.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_7.f90
index a9b8c3b2c20..5a20b8f1961 100644
--- a/gcc/testsuite/gfortran.dg/bind_c_char_7.f90
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_7.f90
@@ -9,11 +9,11 @@ subroutine s1 (x1) bind(C)
   character(len=1) :: x1
 end
 
-subroutine s2 (x2) bind(C)
+subroutine s2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's2' has the BIND\\(C\\) attribute" }
   character(len=2) :: x2
 end
 
-subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
+subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
   integer :: n
   character(len=n) :: xn
 end
@@ -32,8 +32,7 @@ subroutine as2 (x2) bind(C) ! { dg-error "Fortran 2018: Assumed-shape array 'x2'
   character(len=2) :: x2(:,:)
 end
 
-subroutine as3 (xn, n) bind(C) ! { dg-error "Fortran 2018: Character dummy argument 'xn' at .1. with nonconstant length as procedure 'as3' is BIND\\(C\\)" }
-                               ! { dg-error "Fortran 2018: Assumed-shape array 'xn' at .1. as dummy argument to the BIND\\(C\\) procedure 'as3' at .2." "" { target *-*-* } .-1 }
+subroutine as3 (xn, n) bind(C) ! { dg-error "Fortran 2018: Assumed-shape array 'xn' at .1. as dummy argument to the BIND\\(C\\) procedure 'as3' at .2." }
   integer :: n
   character(len=n) :: xn(:,:,:)
 end
@@ -68,11 +67,11 @@ subroutine az1 (x1) bind(C)
   character(len=1) :: x1(*)
 end
 
-subroutine az2 (x2) bind(C)
+subroutine az2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az2' has the BIND\\(C\\) attribute" }
   character(len=2) :: x2(*)
 end
 
-subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
+subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
   integer :: n
   character(len=n) :: xn(*)
 end
@@ -87,11 +86,11 @@ subroutine ae1 (x1) bind(C)
   character(len=1) :: x1(5)
 end
 
-subroutine ae2 (x2) bind(C)
+subroutine ae2 (x2) bind(C)  ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae2' has the BIND\\(C\\) attribute" }
   character(len=2) :: x2(7)
 end
 
-subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
+subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
   integer :: n
   character(len=n) :: xn(9)
 end
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_8.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_8.f90
index 1d566c0334d..c6f406f3c5c 100644
--- a/gcc/testsuite/gfortran.dg/bind_c_char_8.f90
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_8.f90
@@ -19,11 +19,11 @@ subroutine s1 (x1) bind(C)
   character(len=1) :: x1
 end
 
-subroutine s2 (x2) bind(C)
+subroutine s2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's2' has the BIND\\(C\\) attribute" }
   character(len=2) :: x2
 end
 
-subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
+subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
   integer :: n
   character(len=n) :: xn
 end
@@ -76,11 +76,11 @@ subroutine az1 (x1) bind(C)
   character(len=1) :: x1(*)
 end
 
-subroutine az2 (x2) bind(C)
+subroutine az2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az2' has the BIND\\(C\\) attribute" }
   character(len=2) :: x2(*)
 end
 
-subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
+subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
   integer :: n
   character(len=n) :: xn(*)
 end
@@ -95,11 +95,11 @@ subroutine ae1 (x1) bind(C)
   character(len=1) :: x1(5)
 end
 
-subroutine ae2 (x2) bind(C)
+subroutine ae2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae2' has the BIND\\(C\\) attribute" }
   character(len=2) :: x2(7)
 end
 
-subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
+subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
   integer :: n
   character(len=n) :: xn(9)
 end
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_9.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_9.f90
index d31862c89e8..64d73409df3 100644
--- a/gcc/testsuite/gfortran.dg/bind_c_char_9.f90
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_9.f90
@@ -18,12 +18,18 @@ subroutine s1 (x1) bind(C)
   x1 = 'A'
 end
 
-subroutine s2 (x2) bind(C)
-  character(kind=c_char, len=2) :: x2
-  if (len (x2) /= 2) stop
-  if (x2 /= '42') stop
-  x2 = '64'
-end
+! Valid as Fortran code - but with BIND(C)
+! 18.3.6 (5) (bullet 5) requires interoperability, i.e. len=1
+! which is not fullfilled.
+!
+! [It would work as with len=<const> the length is known
+!  and only a bytestream is passed around.]
+!subroutine s2 (x2) bind(C)
+!  character(kind=c_char, len=2) :: x2
+!  if (len (x2) /= 2) stop
+!  if (x2 /= '42') stop
+!  x2 = '64'
+!end
 
 ! Assumed-size array, nonallocatable/nonpointer
 
@@ -44,22 +50,28 @@ subroutine az1 (x1) bind(C)
             'h']
 end
 
-subroutine az2 (x2) bind(C)
-  character(kind=c_char, len=2) :: x2(*)
-  if (len(x2) /= 2) stop  
-  if (any (x2(:6) /= ['ab', &
-                      'fd', &
-                      'D4', &
-                      '54', &
-                      'ga', &
-                      'hg'])) stop
-  x2(:6) = ['ab', &
-            'hd', &
-            'fj', &
-            'a4', &
-            '4a', &
-            'hf']
-end
+! Valid as Fortran code - but with BIND(C)
+! 18.3.6 (5) (bullet 5) requires interoperability, i.e. len=1
+! which is not fullfilled.
+!
+! [It would work as with len=<const> the length is known
+!  and only a bytestream is passed around.]
+!subroutine az2 (x2) bind(C)
+!  character(kind=c_char, len=2) :: x2(*)
+!  if (len(x2) /= 2) stop  
+!  if (any (x2(:6) /= ['ab', &
+!                      'fd', &
+!                      'D4', &
+!                      '54', &
+!                      'ga', &
+!                      'hg'])) stop
+!  x2(:6) = ['ab', &
+!            'hd', &
+!            'fj', &
+!            'a4', &
+!            '4a', &
+!            'hf']
+!end
 
 ! Explicit-size array, nonallocatable/nonpointer
 
@@ -81,23 +93,29 @@ subroutine ae1 (x1) bind(C)
         'h']
 end
 
-subroutine ae2 (x2) bind(C)
-  character(kind=c_char, len=2) :: x2(6)
-  if (size(x2) /= 6) stop
-  if (len(x2) /= 2) stop  
-  if (any (x2 /= ['ab', &
-                  'fd', &
-                  'D4', &
-                  '54', &
-                  'ga', &
-                  'hg'])) stop
-  x2 = ['ab', &
-        'hd', &
-        'fj', &
-        'a4', &
-        '4a', &
-        'hf']
-end
+! Valid as Fortran code - but with BIND(C)
+! 18.3.6 (5) (bullet 5) requires interoperability, i.e. len=1
+! which is not fullfilled.
+!
+! [It would work as with len=<const> the length is known
+!  and only a bytestream is passed around.]
+!subroutine ae2 (x2) bind(C)
+!  character(kind=c_char, len=2) :: x2(6)
+!  if (size(x2) /= 6) stop
+!  if (len(x2) /= 2) stop  
+!  if (any (x2 /= ['ab', &
+!                  'fd', &
+!                  'D4', &
+!                  '54', &
+!                  'ga', &
+!                  'hg'])) stop
+!  x2 = ['ab', &
+!        'hd', &
+!        'fj', &
+!        'a4', &
+!        '4a', &
+!        'hf']
+!end
 
 end module m
 
@@ -116,9 +134,9 @@ program main
   call s1 (str1)
   if (str1 /= 'A') stop
 
-  str2 = '42'
-  call s2 (str2)
-  if (str2 /= '64') stop
+!  str2 = '42'
+!  call s2 (str2)
+!  if (str2 /= '64') stop
 
   ! assumed size - without array descriptor
 
@@ -135,19 +153,20 @@ program main
                       '3', &
                       '4', &
                       'h'])) stop
-  str2a6 = ['ab', &
-            'fd', &
-            'D4', &
-            '54', &
-            'ga', &
-            'hg']
-  call az2 (str2a6)
-  if (any (str2a6 /= ['ab', &
-                      'hd', &
-                      'fj', &
-                      'a4', &
-                      '4a', &
-                      'hf'])) stop
+!  str2a6 = ['ab', &
+!            'fd', &
+!            'D4', &
+!            '54', &
+!            'ga', &
+!            'hg']
+!  call az2 (str2a6)
+!  if (any (str2a6 /= ['ab', &
+!                      'hd', &
+!                      'fj', &
+!                      'a4', &
+!                      '4a', &
+!                      'hf'])) stop
+
   ! explicit size - without array descriptor
 
   str1a6 = ['g', &
@@ -163,26 +182,26 @@ program main
                       '3', &
                       '4', &
                       'h'])) stop
-  str2a6 = ['ab', &
-            'fd', &
-            'D4', &
-            '54', &
-            'ga', &
-            'hg']
-  call ae2 (str2a6)
-  if (any (str2a6 /= ['ab', &
-                      'hd', &
-                      'fj', &
-                      'a4', &
-                      '4a', &
-                      'hf'])) stop
+!  str2a6 = ['ab', &
+!            'fd', &
+!            'D4', &
+!            '54', &
+!            'ga', &
+!            'hg']
+!  call ae2 (str2a6)
+!  if (any (str2a6 /= ['ab', &
+!                      'hd', &
+!                      'fj', &
+!                      'a4', &
+!                      '4a', &
+!                      'hf'])) stop
 end
 
 ! All argument shall be passed without descriptor
 ! { dg-final { scan-tree-dump-not "dtype" "original" } }
 ! { dg-final { scan-tree-dump-times "void s1 \\(character\\(kind=1\\)\\\[1:1\\\] & restrict x1\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void s2 \\(character\\(kind=1\\)\\\[1:2\\\] & restrict x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-not "void s2 " "original" } }
 ! { dg-final { scan-tree-dump-times "void az1 \\(character\\(kind=1\\)\\\[0:\\\]\\\[1:1\\\] \\* restrict x1\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void az2 \\(character\\(kind=1\\)\\\[0:\\\]\\\[1:2\\\] \\* restrict x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-not "void az2 " "original" } }
 ! { dg-final { scan-tree-dump-times "void ae1 \\(character\\(kind=1\\)\\\[6\\\]\\\[1:1\\\] \\* restrict x1\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void ae2 \\(character\\(kind=1\\)\\\[6\\\]\\\[1:2\\\] \\* restrict x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-not "void ae2 " "original" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_contiguous.f90 b/gcc/testsuite/gfortran.dg/bind_c_contiguous.f90
new file mode 100644
index 00000000000..fc0d092d921
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_contiguous.f90
@@ -0,0 +1,33 @@
+module m
+  use iso_c_binding
+  implicit none (type, external)
+contains
+
+! All of the following use an array descriptor
+! F2018, 18.3.7 (5) applies:
+
+subroutine f1 (x) bind(c)  ! { dg-error "Dummy argument 'x' at .1. may not be a pointer with CONTIGUOUS attribute as procedure 'f1' is BIND\\(C\\)" }
+  character(len=:, kind=c_char), pointer, contiguous :: x(:)
+end
+
+subroutine f2 (x) bind(c)  ! { dg-error "Dummy argument 'x' at .1. may not be a pointer with CONTIGUOUS attribute as procedure 'f2' is BIND\\(C\\)" }
+  integer(c_int), pointer, contiguous :: x(:)
+end
+
+subroutine f3 (x) bind(c)
+  character(len=:, kind=c_char), pointer :: x(:)  ! OK - pointer but not contiguous
+end
+
+subroutine f4 (x) bind(c)
+  character(len=*, kind=c_char), contiguous :: x(:)  ! OK - contiguous but not a pointer
+end
+
+subroutine f5 (x) bind(c)
+  integer(c_int), pointer :: x(:)  !  OK - pointer but not contigous
+end
+
+subroutine f6 (x) bind(c)
+  integer(c_int), contiguous :: x(:)  !  OK - contiguous but not a pointer
+end
+
+end
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90 b/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90
index abe5cb71bfc..a2616568b2a 100644
--- a/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90
@@ -5,6 +5,7 @@
 ! Contributed by Thomas Koenig  <tkoenig@gcc.gnu.org>
 !
 subroutine bar(c,d) BIND(C) ! { dg-error "character dummy argument 'c' at .1. with assumed length is not yet supported for procedure 'bar' with BIND\\(C\\) attribute" }
+                            ! { dg-error "Character dummy argument 'd' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'bar' has the BIND\\(C\\) attribute" "" { target *-*-* } .-1 }
   character (len=*) c
   character (len=2) d
 end
diff --git a/gcc/testsuite/gfortran.dg/pr32599.f03 b/gcc/testsuite/gfortran.dg/pr32599.f03
index bf9bd8c1d68..819a2b83d57 100644
--- a/gcc/testsuite/gfortran.dg/pr32599.f03
+++ b/gcc/testsuite/gfortran.dg/pr32599.f03
@@ -14,7 +14,7 @@ module pr32599
        character(len=*,kind=c_char), intent(IN) :: path
      end subroutine destroy
 
-     subroutine create(path) BIND(C) ! { dg-error "Fortran 2008: Character dummy argument 'path' at .1. with length greater than 1 for procedure 'create' with BIND\\(C\\) attribute" }
+     subroutine create(path) BIND(C) ! { dg-error "Character dummy argument 'path' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'create' has the BIND\\(C\\) attribute" }
        use iso_c_binding
        implicit none
        character(len=5,kind=c_char), intent(IN) :: path

^ permalink raw reply	[flat|nested] 4+ messages in thread

* *PING* – Re: [Patch] Fortran: Fix Bind(C) char-len check, add ptr-contiguous check
  2021-08-20 17:24 [Patch] Fortran: Fix Bind(C) char-len check, add ptr-contiguous check Tobias Burnus
@ 2021-08-25 18:58 ` Tobias Burnus
  2021-08-29  7:35   ` *PING**2 " Tobias Burnus
  0 siblings, 1 reply; 4+ messages in thread
From: Tobias Burnus @ 2021-08-25 18:58 UTC (permalink / raw)
  To: gcc-patches, fortran, Sandra Loosemore

Early *PING*.
(I also should still review several Fortan patches... There are lots of
patches waiting for review :-/)

On 20.08.21 19:24, Tobias Burnus wrote:
> The following is about interoperability (BIND(C)) only.
>
>
> * The patch adds a missing check for pointer + contiguous.
> (Rejected to avoid copy-in issues? Or checking issues?)
>
>
> * And it corrects an issue regarding len > 1 characters. While
>
>  subroutine foo(x)
>     character(len=2) :: x(*)
>
> is valid Fortran code (the argument can be "abce" or ['a','b','c','d']
> or ...)
> – and would work also with bind(C) as the len=2 does not need to be
> passed
> as hidden argument as len is a constant.
> However, it is not valid nonetheless.
>
>
> OK? Comments?
>
> Tobias
>
>
> PS: Referenced locations in the standard (F2018):
>
> C1554 If proc-language-binding-spec is specified for a procedure,
> each of its dummy arguments shall be an interoperable procedure (18.3.6)
> or a variable that is interoperable (18.3.4, 18.3.5), assumed-shape,
> assumed-rank, assumed-type, of type CHARACTER with assumed length,
> or that has the ALLOCATABLE or POINTER attribute.
>
> 18.3.1: "... If the type is character, the length type parameter is
> interoperable if and only if its value is one. ..."
>
> "18.3.4 Interoperability of scalar variables":
> "... A named scalar Fortran variable is interoperable ... if it
> is of type character12its length is not assumed or declared by
> an expression that is not a constant expression."
>
> 18.3.5: Likewise but for arrays.
>
> 18.3.6 "... Fortran procedure interface is interoperable with a C
> function prototype ..."
> "(5) any dummy argument without the VALUE attribute corresponds
>      to a formal parameter of the prototype that is of a pointer type,
> and either
>      • the dummy argument is interoperable with an entity of the
> referenced type ..."
> (Remark: those are passed as byte stream)
>      "• the dummy argument is a nonallocatable nonpointer variable of
> type
>         CHARACTER with assumed character length and the formal
> parameter is
>         a pointer to CFI_cdesc_t,
>       • the dummy argument is allocatable, assumed-shape,
> assumed-rank, or
>         a pointer without the CONTIGUOUS attribute, and the formal
> parameter
>         is a pointer to CFI_cdesc_t, or
> (Remark: those two use an array descriptor, also for
> explicit-size/assumed-size
> arrays or for scalars.)
>       • the dummy argument is assumed-type ..."
>
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

^ permalink raw reply	[flat|nested] 4+ messages in thread

* *PING**2 – Re: [Patch] Fortran: Fix Bind(C) char-len check, add ptr-contiguous check
  2021-08-25 18:58 ` *PING* – " Tobias Burnus
@ 2021-08-29  7:35   ` Tobias Burnus
  2021-08-31  6:09     ` Paul Richard Thomas
  0 siblings, 1 reply; 4+ messages in thread
From: Tobias Burnus @ 2021-08-29  7:35 UTC (permalink / raw)
  To: gcc-patches, fortran; +Cc: Tobias Burnus

PING**2

On 25.08.21 20:58, Tobias Burnus wrote:
> Early *PING*.
> (I also should still review several Fortan patches... There are lots of
> patches waiting for review :-/)
>
> On 20.08.21 19:24, Tobias Burnus wrote:
>> The following is about interoperability (BIND(C)) only.
>>
>>
>> * The patch adds a missing check for pointer + contiguous.
>> (Rejected to avoid copy-in issues? Or checking issues?)
>>
>>
>> * And it corrects an issue regarding len > 1 characters. While
>>
>>  subroutine foo(x)
>>     character(len=2) :: x(*)
>>
>> is valid Fortran code (the argument can be "abce" or ['a','b','c','d']
>> or ...)
>> – and would work also with bind(C) as the len=2 does not need to be
>> passed
>> as hidden argument as len is a constant.
>> However, it is not valid nonetheless.
>>
>>
>> OK? Comments?
>>
>> Tobias
>>
>>
>> PS: Referenced locations in the standard (F2018):
>>
>> C1554 If proc-language-binding-spec is specified for a procedure,
>> each of its dummy arguments shall be an interoperable procedure (18.3.6)
>> or a variable that is interoperable (18.3.4, 18.3.5), assumed-shape,
>> assumed-rank, assumed-type, of type CHARACTER with assumed length,
>> or that has the ALLOCATABLE or POINTER attribute.
>>
>> 18.3.1: "... If the type is character, the length type parameter is
>> interoperable if and only if its value is one. ..."
>>
>> "18.3.4 Interoperability of scalar variables":
>> "... A named scalar Fortran variable is interoperable ... if it
>> is of type character12its length is not assumed or declared by
>> an expression that is not a constant expression."
>>
>> 18.3.5: Likewise but for arrays.
>>
>> 18.3.6 "... Fortran procedure interface is interoperable with a C
>> function prototype ..."
>> "(5) any dummy argument without the VALUE attribute corresponds
>>      to a formal parameter of the prototype that is of a pointer type,
>> and either
>>      • the dummy argument is interoperable with an entity of the
>> referenced type ..."
>> (Remark: those are passed as byte stream)
>>      "• the dummy argument is a nonallocatable nonpointer variable of
>> type
>>         CHARACTER with assumed character length and the formal
>> parameter is
>>         a pointer to CFI_cdesc_t,
>>       • the dummy argument is allocatable, assumed-shape,
>> assumed-rank, or
>>         a pointer without the CONTIGUOUS attribute, and the formal
>> parameter
>>         is a pointer to CFI_cdesc_t, or
>> (Remark: those two use an array descriptor, also for
>> explicit-size/assumed-size
>> arrays or for scalars.)
>>       • the dummy argument is assumed-type ..."
>>
> -----------------
> Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 
> 201, 80634 München; Gesellschaft mit beschränkter Haftung; 
> Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: 
> München; Registergericht München, HRB 106955

^ permalink raw reply	[flat|nested] 4+ messages in thread

* Re: *PING**2 – Re: [Patch] Fortran: Fix Bind(C) char-len check, add ptr-contiguous check
  2021-08-29  7:35   ` *PING**2 " Tobias Burnus
@ 2021-08-31  6:09     ` Paul Richard Thomas
  0 siblings, 0 replies; 4+ messages in thread
From: Paul Richard Thomas @ 2021-08-31  6:09 UTC (permalink / raw)
  To: Tobias Burnus; +Cc: gcc-patches, fortran, Tobias Burnus

Hi Tobias,

s/However, as argument they are also iteroperable/However, as an argument
they are also interoperable/

s/ /* else: valid only sind F2018 - and an assumed-shape/rank
    array; however, gfc_notify_std is already called when
    those array type are used. Thus, silently accept F200x. */ /
  /* else: valid only since F2018 - and an assumed-shape/rank
    array; however, gfc_notify_std is already called when
    those array types are used. Thus, silently accept F200x. */

Apart from those nits, it looks good to me. It even regtests OK :-)

Thanks for sorting out the standard-ese. OK for mainline and, I would
suggest 11-branch.

Cheers

Paul


On Sun, 29 Aug 2021 at 08:35, Tobias Burnus <burnus@net-b.de> wrote:

> PING**2
>
> On 25.08.21 20:58, Tobias Burnus wrote:
> > Early *PING*.
> > (I also should still review several Fortan patches... There are lots of
> > patches waiting for review :-/)
> >
> > On 20.08.21 19:24, Tobias Burnus wrote:
> >> The following is about interoperability (BIND(C)) only.
> >>
> >>
> >> * The patch adds a missing check for pointer + contiguous.
> >> (Rejected to avoid copy-in issues? Or checking issues?)
> >>
> >>
> >> * And it corrects an issue regarding len > 1 characters. While
> >>
> >>  subroutine foo(x)
> >>     character(len=2) :: x(*)
> >>
> >> is valid Fortran code (the argument can be "abce" or ['a','b','c','d']
> >> or ...)
> >> – and would work also with bind(C) as the len=2 does not need to be
> >> passed
> >> as hidden argument as len is a constant.
> >> However, it is not valid nonetheless.
> >>
> >>
> >> OK? Comments?
> >>
> >> Tobias
> >>
> >>
> >> PS: Referenced locations in the standard (F2018):
> >>
> >> C1554 If proc-language-binding-spec is specified for a procedure,
> >> each of its dummy arguments shall be an interoperable procedure (18.3.6)
> >> or a variable that is interoperable (18.3.4, 18.3.5), assumed-shape,
> >> assumed-rank, assumed-type, of type CHARACTER with assumed length,
> >> or that has the ALLOCATABLE or POINTER attribute.
> >>
> >> 18.3.1: "... If the type is character, the length type parameter is
> >> interoperable if and only if its value is one. ..."
> >>
> >> "18.3.4 Interoperability of scalar variables":
> >> "... A named scalar Fortran variable is interoperable ... if it
> >> is of type character12its length is not assumed or declared by
> >> an expression that is not a constant expression."
> >>
> >> 18.3.5: Likewise but for arrays.
> >>
> >> 18.3.6 "... Fortran procedure interface is interoperable with a C
> >> function prototype ..."
> >> "(5) any dummy argument without the VALUE attribute corresponds
> >>      to a formal parameter of the prototype that is of a pointer type,
> >> and either
> >>      • the dummy argument is interoperable with an entity of the
> >> referenced type ..."
> >> (Remark: those are passed as byte stream)
> >>      "• the dummy argument is a nonallocatable nonpointer variable of
> >> type
> >>         CHARACTER with assumed character length and the formal
> >> parameter is
> >>         a pointer to CFI_cdesc_t,
> >>       • the dummy argument is allocatable, assumed-shape,
> >> assumed-rank, or
> >>         a pointer without the CONTIGUOUS attribute, and the formal
> >> parameter
> >>         is a pointer to CFI_cdesc_t, or
> >> (Remark: those two use an array descriptor, also for
> >> explicit-size/assumed-size
> >> arrays or for scalars.)
> >>       • the dummy argument is assumed-type ..."
> >>
> > -----------------
> > Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße
> > 201, 80634 München; Gesellschaft mit beschränkter Haftung;
> > Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft:
> > München; Registergericht München, HRB 106955
>


-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

^ permalink raw reply	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2021-08-31  6:09 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-08-20 17:24 [Patch] Fortran: Fix Bind(C) char-len check, add ptr-contiguous check Tobias Burnus
2021-08-25 18:58 ` *PING* – " Tobias Burnus
2021-08-29  7:35   ` *PING**2 " Tobias Burnus
2021-08-31  6:09     ` Paul Richard Thomas

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).