diff options
author | Tobias Burnus <tobias@codesourcery.com> | 2021-09-03 16:28:04 +0200 |
---|---|---|
committer | Tobias Burnus <tobias@codesourcery.com> | 2021-09-03 16:28:04 +0200 |
commit | 943c65c4494145e993af43c821c82000013c6375 (patch) | |
tree | 260660a474fe8e3b4acd60cbbe450c874890f3c1 /gcc | |
parent | 2fcfc03459a907c0237ea6e2c6e4ce4871034bed (diff) | |
download | gcc-943c65c4494145e993af43c821c82000013c6375.zip gcc-943c65c4494145e993af43c821c82000013c6375.tar.gz gcc-943c65c4494145e993af43c821c82000013c6375.tar.bz2 |
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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/decl.c | 39 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/bind_c_char_6.f90 | 22 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/bind_c_char_7.f90 | 15 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/bind_c_char_8.f90 | 12 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/bind_c_char_9.f90 | 161 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/bind_c_contiguous.f90 | 33 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90 | 1 | ||||
-rw-r--r-- | 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 05081c4..2e49a67 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/gfortran.dg/bind_c_char_6.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_6.f90 index 23e1d92..6bab295 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 a9b8c3b..5a20b8f 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 1d566c0..c6f406f 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 d31862c..64d7340 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 0000000..fc0d092 --- /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 abe5cb7..a261656 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 bf9bd8c..819a2b8 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 |