From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1534) id 4292C3857C73; Mon, 13 Sep 2021 07:45:43 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 4292C3857C73 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Tobias Burnus To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/omp/gcc-11] Fortran: Fix Bind(C) char-len check, add ptr-contiguous check X-Act-Checkin: gcc X-Git-Author: Tobias Burnus X-Git-Refname: refs/heads/devel/omp/gcc-11 X-Git-Oldrev: 777e1baddca0ed779eab4f13ba79359124892490 X-Git-Newrev: 27847df17001465de663bab24aa2abf5f8d8850e Message-Id: <20210913074543.4292C3857C73@sourceware.org> Date: Mon, 13 Sep 2021 07:45:43 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 13 Sep 2021 07:45:43 -0000 https://gcc.gnu.org/g:27847df17001465de663bab24aa2abf5f8d8850e commit 27847df17001465de663bab24aa2abf5f8d8850e Author: Tobias Burnus 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 + + Backported from master: + 2021-08-03 Tobias Burnus + + * 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 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 + + Backported from master: + 2021-08-03 Tobias Burnus + + * 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 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= 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= 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= 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 ! 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