public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-11] Fortran: Fix Bind(C) char-len check, add ptr-contiguous check
@ 2021-09-13 7:45 Tobias Burnus
0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2021-09-13 7:45 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:27847df17001465de663bab24aa2abf5f8d8850e
commit 27847df17001465de663bab24aa2abf5f8d8850e
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Mon Sep 13 08:34:33 2021 +0200
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: Update dg-error.
* gfortran.dg/bind_c_char_7.f90: Likewise.
* gfortran.dg/bind_c_char_8.f90: Likewise.
* gfortran.dg/iso_c_binding_char_1.f90: Likewise.
* gfortran.dg/pr32599.f03: Likewise.
* gfortran.dg/bind_c_char_9.f90: Comment testcase bits which are
implementable but not valid F2018.
* gfortran.dg/bind_c_contiguous.f90: New test.
(cherry picked from commit 943c65c4494145e993af43c821c82000013c6375)
Diff:
---
gcc/fortran/ChangeLog.omp | 9 ++
gcc/fortran/decl.c | 39 ++---
gcc/testsuite/ChangeLog.omp | 14 ++
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 +-
10 files changed, 187 insertions(+), 121 deletions(-)
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index a2b67dedde5..c3a11ae579a 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,12 @@
+2021-08-13 Tobias Burnus <tobias@codesourcery.com>
+
+ Backported from master:
+ 2021-08-03 Tobias Burnus <tobias@codesourcery.com>
+
+ * decl.c (gfc_verify_c_interop_param): Reject pointer with
+ CONTIGUOUS attributes as dummy arg. Reject character len > 1
+ when passed as byte stream.
+
2021-08-23 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 2fa1dce92a1..e07a5f93e73 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 an 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 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. */
}
- 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/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 56917b4e634..586a6182327 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,17 @@
+2021-08-13 Tobias Burnus <tobias@codesourcery.com>
+
+ Backported from master:
+ 2021-08-03 Tobias Burnus <tobias@codesourcery.com>
+
+ * gfortran.dg/bind_c_char_6.f90: Update dg-error.
+ * gfortran.dg/bind_c_char_7.f90: Likewise.
+ * gfortran.dg/bind_c_char_8.f90: Likewise.
+ * gfortran.dg/iso_c_binding_char_1.f90: Likewise.
+ * gfortran.dg/pr32599.f03: Likewise.
+ * gfortran.dg/bind_c_char_9.f90: Comment testcase bits which are
+ implementable but not valid F2018.
+ * gfortran.dg/bind_c_contiguous.f90: New test.
+
2021-08-23 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
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] only message in thread
only message in thread, other threads:[~2021-09-13 7:45 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-09-13 7:45 [gcc/devel/omp/gcc-11] Fortran: Fix Bind(C) char-len check, add ptr-contiguous check Tobias Burnus
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).