On 16.07.21 14:55, Jerry D wrote:
Good to go Tobias.
Thanks for the review!
I have committed it as
r12-2431-gb3d4011ba10275fbd5d6ec5a16d5aaebbdfb5d3c (+ cherry picked it
to OG11).
The attached and committed version has split the 'Allocatable and
pointer' in two separate gfc_error and removed the hyphen in the array
types as spotted and remarked by Sandra.
Tobias
-----------------
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
commit b3d4011ba10275fbd5d6ec5a16d5aaebbdfb5d3c
Author: Tobias Burnus <tob...@codesourcery.com>
Date: Wed Jul 21 09:36:48 2021 +0200
Fortran: Fix bind(C) character length checks
gcc/fortran/ChangeLog:
* decl.c (gfc_verify_c_interop_param): Update for F2008 + F2018
changes; reject unsupported bits with 'Error: Sorry,'.
* trans-expr.c (gfc_conv_procedure_call): Fix condition to
For using CFI descriptor with characters.
gcc/testsuite/ChangeLog:
* gfortran.dg/iso_c_binding_char_1.f90: Update dg-error.
* gfortran.dg/pr32599.f03: Use -std=-f2003 + update comment.
* gfortran.dg/bind_c_char_10.f90: New test.
* gfortran.dg/bind_c_char_6.f90: New test.
* gfortran.dg/bind_c_char_7.f90: New test.
* gfortran.dg/bind_c_char_8.f90: New test.
* gfortran.dg/bind_c_char_9.f90: New test.
---
gcc/fortran/decl.c | 113 ++++-
gcc/fortran/trans-expr.c | 18 +-
gcc/testsuite/gfortran.dg/bind_c_char_10.f90 | 480 +++++++++++++++++++++
gcc/testsuite/gfortran.dg/bind_c_char_6.f90 | 262 +++++++++++
gcc/testsuite/gfortran.dg/bind_c_char_7.f90 | 261 +++++++++++
gcc/testsuite/gfortran.dg/bind_c_char_8.f90 | 249 +++++++++++
gcc/testsuite/gfortran.dg/bind_c_char_9.f90 | 188 ++++++++
gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90 | 2 +-
gcc/testsuite/gfortran.dg/pr32599.f03 | 8 +-
9 files changed, 1557 insertions(+), 24 deletions(-)
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 413c7a75e0c..05081c40f1e 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1552,20 +1552,115 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
}
/* Character strings are only C interoperable if they have a
- length of 1. */
- if (sym->ts.type == BT_CHARACTER && !sym->attr.dimension)
+ 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. */
+ if (sym->ts.type == BT_CHARACTER)
{
gfc_charlen *cl = sym->ts.u.cl;
- if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT
- || mpz_cmp_si (cl->length->value.integer, 1) != 0)
+
+ if (sym->attr.allocatable || sym->attr.pointer)
{
- gfc_error ("Character argument %qs at %L "
- "must be length 1 because "
- "procedure %qs is BIND(C)",
- sym->name, &sym->declared_at,
- sym->ns->proc_name->name);
+ /* F2018, 18.3.6 (6). */
+ if (!sym->ts.deferred)
+ {
+ if (sym->attr.allocatable)
+ gfc_error ("Allocatable character dummy argument %qs "
+ "at %L must have deferred length as "
+ "procedure %qs is BIND(C)", sym->name,
+ &sym->declared_at, sym->ns->proc_name->name);
+ else
+ gfc_error ("Pointer character dummy argument %qs at %L "
+ "must have deferred length as procedure %qs "
+ "is BIND(C)", sym->name, &sym->declared_at,
+ sym->ns->proc_name->name);
+ retval = false;
+ }
+ else if (!gfc_notify_std (GFC_STD_F2018,
+ "Deferred-length character dummy "
+ "argument %qs at %L of procedure "
+ "%qs with BIND(C) attribute",
+ sym->name, &sym->declared_at,
+ sym->ns->proc_name->name))
+ retval = false;
+ else if (!sym->attr.dimension)
+ {
+ /* FIXME: Use CFI array descriptor for scalars. */
+ gfc_error ("Sorry, deferred-length scalar character dummy "
+ "argument %qs at %L of procedure %qs with "
+ "BIND(C) not yet supported", sym->name,
+ &sym->declared_at, sym->ns->proc_name->name);
+ retval = false;
+ }
+ }
+ else if (sym->attr.value
+ && (!cl || !cl->length
+ || cl->length->expr_type != EXPR_CONSTANT
+ || mpz_cmp_si (cl->length->value.integer, 1) != 0))
+ {
+ gfc_error ("Character dummy argument %qs at %L must be "
+ "of length 1 as it has the VALUE attribute",
+ sym->name, &sym->declared_at);
retval = false;
}
+ else if (!cl || !cl->length)
+ {
+ /* Assumed length; F2018, 18.3.6 (5)(2).
+ Uses the CFI array descriptor. */
+ if (!gfc_notify_std (GFC_STD_F2018,
+ "Assumed-length character dummy argument "
+ "%qs at %L of procedure %qs with BIND(C) "
+ "attribute", sym->name, &sym->declared_at,
+ sym->ns->proc_name->name))
+ retval = false;
+ else if (!sym->attr.dimension
+ || sym->as->type == AS_ASSUMED_SIZE
+ || sym->as->type == AS_EXPLICIT)
+ {
+ /* FIXME: Valid - should use the CFI array descriptor, but
+ not yet handled for scalars and assumed-/explicit-size
+ arrays. */
+ gfc_error ("Sorry, character dummy argument %qs at %L "
+ "with assumed length is not yet supported for "
+ "procedure %qs with BIND(C) attribute",
+ sym->name, &sym->declared_at,
+ sym->ns->proc_name->name);
+ retval = false;
+ }
+ }
+ else if (cl->length->expr_type != EXPR_CONSTANT)
+ {
+ /* F2018, 18.3.6, (5), item 4. */
+ if (!sym->attr.dimension
+ || sym->as->type == AS_ASSUMED_SIZE
+ || sym->as->type == AS_EXPLICIT)
+ {
+ gfc_error ("Character dummy argument %qs at %L must be "
+ "of constant length 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 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/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9e0dcdefd25..b18a9ec9799 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5757,18 +5757,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
arg = arg->next, formal = formal ? formal->next : NULL, ++argc)
{
bool finalized = false;
- bool non_unity_length_string = false;
+ bool assumed_length_string = false;
tree derived_array = NULL_TREE;
e = arg->expr;
fsym = formal ? formal->sym : NULL;
parm_kind = MISSING;
- if (fsym && fsym->ts.type == BT_CHARACTER && fsym->ts.u.cl
- && (!fsym->ts.u.cl->length
- || fsym->ts.u.cl->length->expr_type != EXPR_CONSTANT
- || mpz_cmp_si (fsym->ts.u.cl->length->value.integer, 1) != 0))
- non_unity_length_string = true;
+ if (fsym && fsym->ts.type == BT_CHARACTER
+ && (!fsym->ts.u.cl || !fsym->ts.u.cl->length))
+ assumed_length_string = true;
/* If the procedure requires an explicit interface, the actual
argument is passed according to the corresponding formal
@@ -6002,8 +6000,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
else if (sym->attr.is_bind_c && e
&& (is_CFI_desc (fsym, NULL)
- || non_unity_length_string))
- /* Implement F2018, C.12.6.1: paragraph (2). */
+ || assumed_length_string))
+ /* Implement F2018, 18.3.6, list item (5), bullet point 2. */
gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
else if (fsym && fsym->attr.value)
@@ -6447,8 +6445,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
}
if (sym->attr.is_bind_c && e
- && (is_CFI_desc (fsym, NULL) || non_unity_length_string))
- /* Implement F2018, C.12.6.1: paragraph (2). */
+ && (is_CFI_desc (fsym, NULL) || assumed_length_string))
+ /* Implement F2018, 18.3.6, list item (5), bullet point 2. */
gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
else if (e->expr_type == EXPR_VARIABLE
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_10.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_10.f90
new file mode 100644
index 00000000000..35958515d38
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_10.f90
@@ -0,0 +1,480 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+
+! F2018 - examples with array descriptor
+
+module m
+ use iso_c_binding, only: c_char
+ implicit none (type, external)
+
+contains
+
+! Assumed-shape array, nonallocatable/nonpointer
+
+subroutine as1 (x1) bind(C)
+ character(kind=c_char, len=1) :: x1(:)
+ if (size(x1) /= 6) stop
+ if (len(x1) /= 1) stop
+ if (any (x1 /= ['g', &
+ 'd', &
+ 'f', &
+ 's', &
+ '3', &
+ '5'])) stop 1
+ x1 = ['1', &
+ 'h', &
+ 'f', &
+ '3', &
+ '4', &
+ 'h']
+end
+
+subroutine as2 (x2) bind(C)
+ character(kind=c_char, len=2) :: x2(:)
+ 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
+
+subroutine as3 (xn, n) bind(C)
+ integer :: n
+ character(kind=c_char, len=n) :: xn(:)
+ if (size(xn) /= 6) stop
+ if (len(xn) /= 5) stop
+ if (any (xn /= ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k'])) stop
+ xn = ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k']
+end
+
+subroutine as4 (xstar) bind(C)
+ character(kind=c_char, len=*) :: xstar(:)
+ if (size(xstar) /= 6) stop
+ if (len(xstar) /= 5) stop
+ if (any (xstar /= ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k'])) stop
+ xstar = ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k']
+end
+
+! Assumed-rank array, nonallocatable/nonpointer
+
+subroutine ar1 (x1) bind(C)
+ character(kind=c_char, len=1) :: x1(..)
+ if (size(x1) /= 6) stop
+ if (len(x1) /= 1) stop
+ select rank(x1)
+ rank(1)
+ if (any (x1 /= ['g', &
+ 'd', &
+ 'f', &
+ 's', &
+ '3', &
+ '5'])) stop
+ x1 = ['1', &
+ 'h', &
+ 'f', &
+ '3', &
+ '4', &
+ 'h']
+ rank default
+ stop
+ end select
+end
+
+subroutine ar2 (x2) bind(C)
+ character(kind=c_char, len=2) :: x2(..)
+ if (size(x2) /= 6) stop
+ if (len(x2) /= 2) stop
+ select rank(x2)
+ rank(1)
+ if (any (x2 /= ['ab', &
+ 'fd', &
+ 'D4', &
+ '54', &
+ 'ga', &
+ 'hg'])) stop
+ x2 = ['ab', &
+ 'hd', &
+ 'fj', &
+ 'a4', &
+ '4a', &
+ 'hf']
+ rank default
+ stop
+ end select
+end
+
+subroutine ar3 (xn, n) bind(C)
+ integer :: n
+ character(len=n) :: xn(..)
+ if (size(xn) /= 6) stop
+ if (len(xn) /= 5) stop
+ select rank(xn)
+ rank(1)
+ if (any (xn /= ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k'])) stop
+ xn = ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k']
+ rank default
+ stop
+ end select
+end
+
+subroutine ar4 (xstar) bind(C)
+ character(kind=c_char, len=*) :: xstar(..)
+ if (size(xstar) /= 6) stop
+ if (len(xstar) /= 5) stop
+ select rank(xstar)
+ rank(1)
+ if (any (xstar /= ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k'])) stop
+ xstar = ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k']
+ rank default
+ stop
+ end select
+end
+
+! ALLOCATABLE
+
+! Assumed-shape array, allocatable
+
+subroutine a5a (xcolon) bind(C)
+ character(kind=c_char, len=:), allocatable :: xcolon(:)
+ if (.not. allocated (xcolon)) stop
+ if (size(xcolon) /= 6) stop
+ if (len(xcolon) /= 5) stop
+ if (any (xcolon /= ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k'])) stop
+ xcolon = ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k']
+end
+
+! Assumed-rank array, allocatable
+
+subroutine a5ar (xcolon) bind(C)
+ character(kind=c_char, len=:), allocatable :: xcolon(..)
+ if (.not. allocated (xcolon)) stop
+ if (size(xcolon) /= 6) stop
+ if (len(xcolon) /= 5) stop
+ select rank(xcolon)
+ rank(1)
+ if (any (xcolon /= ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k'])) stop
+ xcolon = ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k']
+ rank default
+ stop
+ end select
+end
+
+! POINTER
+! Assumed-shape array, pointer
+
+subroutine a5p (xcolon) bind(C)
+ character(kind=c_char, len=:), pointer :: xcolon(:)
+ if (.not. associated (xcolon)) stop
+ if (size(xcolon) /= 6) stop
+ if (len(xcolon) /= 5) stop
+ if (any (xcolon /= ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k'])) stop
+ xcolon = ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k']
+end
+
+! Assumed-rank array, pointer
+
+subroutine a5pr (xcolon) bind(C)
+ character(kind=c_char, len=:), pointer :: xcolon(..)
+ if (.not. associated (xcolon)) stop
+ if (size(xcolon) /= 6) stop
+ if (len(xcolon) /= 5) stop
+ select rank(xcolon)
+ rank(1)
+ if (any (xcolon /= ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k'])) stop
+ xcolon = ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k']
+ rank default
+ stop
+ end select
+end
+end module m
+
+program main
+ use m
+ implicit none (type, external)
+ character(kind=c_char, len=1) :: str1a6(6)
+ character(kind=c_char, len=2) :: str2a6(6)
+ character(kind=c_char, len=5) :: str5a6(6)
+
+ character(kind=c_char, len=:), allocatable :: astr5a6(:)
+ character(kind=c_char, len=:), pointer :: pstr5a6(:)
+
+ allocate (character(kind=c_char, len=5) :: astr5a6(6), pstr5a6(6))
+
+ ! assumed shape - with array descriptor
+
+ str1a6 = ['g', &
+ 'd', &
+ 'f', &
+ 's', &
+ '3', &
+ '5']
+ call as1 (str1a6)
+ if (any (str1a6 /= ['1', &
+ 'h', &
+ 'f', &
+ '3', &
+ '4', &
+ 'h'])) stop
+ str2a6 = ['ab', &
+ 'fd', &
+ 'D4', &
+ '54', &
+ 'ga', &
+ 'hg']
+ call as2 (str2a6)
+ if (any (str2a6 /= ['ab', &
+ 'hd', &
+ 'fj', &
+ 'a4', &
+ '4a', &
+ 'hf'])) stop
+
+ str5a6 = ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k']
+ call as3 (str5a6, 5)
+ if (any (str5a6 /= ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k'])) stop
+
+ str5a6 = ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k']
+ call as4 (str5a6)
+ if (any (str5a6 /= ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k'])) stop
+
+ ! assumed rank - with array descriptor
+
+ str1a6 = ['g', &
+ 'd', &
+ 'f', &
+ 's', &
+ '3', &
+ '5']
+ call ar1 (str1a6)
+ if (any (str1a6 /= ['1', &
+ 'h', &
+ 'f', &
+ '3', &
+ '4', &
+ 'h'])) stop
+ str2a6 = ['ab', &
+ 'fd', &
+ 'D4', &
+ '54', &
+ 'ga', &
+ 'hg']
+ call ar2 (str2a6)
+ if (any (str2a6 /= ['ab', &
+ 'hd', &
+ 'fj', &
+ 'a4', &
+ '4a', &
+ 'hf'])) stop
+
+ str5a6 = ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k']
+ call ar3 (str5a6, 5)
+ if (any (str5a6 /= ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k'])) stop
+
+
+ str5a6 = ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k']
+ call ar4 (str5a6)
+ if (any (str5a6 /= ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k'])) stop
+
+ ! allocatable - with array descriptor
+ astr5a6(:) = ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k']
+ call a5a (astr5a6)
+ if (any (astr5a6 /= ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k'])) stop
+
+ astr5a6(:) = ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k']
+ call a5ar (astr5a6)
+ if (any (astr5a6 /= ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k'])) stop
+
+
+ ! pointer - with array descriptor
+ pstr5a6 = ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k']
+ call a5p (pstr5a6)
+ if (any (pstr5a6 /= ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k'])) stop
+
+ pstr5a6 = ['DDGhf', &
+ 'hdrh$', &
+ 'fDGSl', &
+ 'DFHs3', &
+ '43grG', &
+ 'hFG$k']
+ call a5pr (pstr5a6)
+ if (any (pstr5a6 /= ['FDGhf', &
+ 'hdrhg', &
+ 'fDgFl', &
+ 'DFHs3', &
+ '4a54G', &
+ 'hSs6k'])) stop
+ deallocate (astr5a6, pstr5a6)
+end
+
+! All arguments shall use array descriptors
+! { dg-final { scan-tree-dump-times "void as1 \\(struct array01_character\\(kind=1\\) & restrict x1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as2 \\(struct array01_character\\(kind=1\\) & restrict x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as4 \\(struct array01_character\\(kind=1\\) & restrict xstar\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as3 \\(struct array01_character\\(kind=1\\) & restrict xn, integer(kind=4) & restrict n)
+! { dg-final { scan-tree-dump-times "void ar1 \\(struct array15_character\\(kind=1\\) & restrict x1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ar2 \\(struct array15_character\\(kind=1\\) & restrict x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ar3 \\(struct array15_character\\(kind=1\\) & restrict xn, integer(kind=4) & restrict n)
+! { dg-final { scan-tree-dump-times "void ar4 \\(struct array15_character\\(kind=1\\) & restrict xstar\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5a \\(struct array01_character\\(kind=1\\) & restrict xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5ar \\(struct array15_character\\(kind=1\\) & restrict xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5p \\(struct array01_character\\(kind=1\\) & xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5pr \\(struct array15_character\\(kind=1\\) & xcolon\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_6.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_6.f90
new file mode 100644
index 00000000000..23e1d92334b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_6.f90
@@ -0,0 +1,262 @@
+! { dg-do compile }
+! { dg-additional-options "-std=f2003 -fimplicit-none" }
+
+! F2003 only permits length=1 character dummy args
+
+! Scalar, nonallocatable/nonpointer
+
+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" }
+ 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" }
+ integer :: n
+ character(len=n) :: xn
+end
+
+subroutine s4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 's4' with BIND\\(C\\) attribute" }
+ character(len=*) :: xstar
+end
+
+! Assumed-shape array, nonallocatable/nonpointer
+
+subroutine as1 (x1) bind(C) ! { dg-error "Fortran 2018: Assumed-shape array 'x1' at .1. as dummy argument to the BIND\\(C\\) procedure 'as1' at .2." }
+ 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 }
+ 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 }
+ 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 }
+ character(len=*) :: xstar(:,:,:,:)
+end
+
+! Assumed-rank array, nonallocatable/nonpointer
+
+subroutine ar1 (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
+ character(len=1) :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine ar2 (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
+ character(len=2) :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine ar3 (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
+ integer :: n
+ character(len=n) :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine ar4 (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
+ character(len=*) :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+! Assumed-size array, nonallocatable/nonpointer
+
+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" }
+ 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" }
+ integer :: n
+ character(len=n) :: xn(*)
+end
+
+subroutine az4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'az4' with BIND\\(C\\) attribute" }
+ character(len=*) :: xstar(*)
+end
+
+! Explicit-size array, nonallocatable/nonpointer
+
+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" }
+ 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" }
+ integer :: n
+ character(len=n) :: xn(9)
+end
+
+subroutine ae4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'ae4' with BIND\\(C\\) attribute" }
+ character(len=*) :: xstar(3)
+end
+
+! ALLOCATABLE
+! Scalar, allocatable
+
+subroutine s1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 's1a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x1' at .1. with ALLOCATABLE attribute in procedure 's1a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=1), allocatable :: x1
+end
+
+subroutine s2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 's2a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x2' at .1. with ALLOCATABLE attribute in procedure 's2a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=2), allocatable :: x2
+end
+
+subroutine s3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 's3a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xn' at .1. with ALLOCATABLE attribute in procedure 's3a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ integer :: n
+ character(len=n), allocatable :: xn
+end
+
+subroutine s4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 's4a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with ALLOCATABLE attribute in procedure 's4a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=*), allocatable :: xstar
+end
+
+subroutine s5a (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 's5a' with BIND\\(C\\) attribute" }
+ ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with ALLOCATABLE attribute in procedure 's5a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=:), allocatable :: xcolon
+end
+
+! Assumed-shape array, allocatable
+
+subroutine a1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 'a1a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x1' at .1. with ALLOCATABLE attribute in procedure 'a1a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=1), allocatable :: x1(:)
+end
+
+subroutine a2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 'a2a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x2' at .1. with ALLOCATABLE attribute in procedure 'a2a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=2), allocatable :: x2(:,:)
+end
+
+subroutine a3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 'a3a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xn' at .1. with ALLOCATABLE attribute in procedure 'a3a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ integer :: n
+ character(len=n), allocatable :: xn(:,:,:)
+end
+
+subroutine a4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with ALLOCATABLE attribute in procedure 'a4a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=*), allocatable :: xstar(:,:,:,:)
+end
+
+subroutine a5a (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 'a5a' with BIND\\(C\\) attribute" }
+ ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with ALLOCATABLE attribute in procedure 'a5a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=:), allocatable :: xcolon(:)
+end
+
+! Assumed-rank array, allocatable
+
+subroutine a1ar (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
+ character(len=1), allocatable :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a2ar (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
+ character(len=2), allocatable :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a3ar (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
+ integer :: n
+ character(len=n), allocatable :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a4ar (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
+ character(len=*), allocatable :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a5ar (xcolon) bind(C) ! { dg-error "Symbol 'xcolon' at .1. has no IMPLICIT type" }
+ character(len=:), allocatable :: xcolon(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+! POINTER
+! Scalar, pointer
+
+subroutine s1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 's1p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x1' at .1. with POINTER attribute in procedure 's1p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=1), pointer :: x1
+end
+
+subroutine s2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 's2p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x2' at .1. with POINTER attribute in procedure 's2p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=2), pointer :: x2
+end
+
+subroutine s3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 's3p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xn' at .1. with POINTER attribute in procedure 's3p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ integer :: n
+ character(len=n), pointer :: xn
+end
+
+subroutine s4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 's4p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with POINTER attribute in procedure 's4p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=*), pointer :: xstar
+end
+
+subroutine s5p (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 's5p' with BIND\\(C\\) attribute" }
+ ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with POINTER attribute in procedure 's5p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=:), pointer :: xcolon
+end
+
+! Assumed-shape array, pointer
+
+subroutine a1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 'a1p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x1' at .1. with POINTER attribute in procedure 'a1p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=1), pointer :: x1(:)
+end
+
+subroutine a2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 'a2p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x2' at .1. with POINTER attribute in procedure 'a2p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=2), pointer :: x2(:,:)
+end
+
+subroutine a3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 'a3p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xn' at .1. with POINTER attribute in procedure 'a3p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ integer :: n
+ character(len=n), pointer :: xn(:,:,:)
+end
+
+subroutine a4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with POINTER attribute in procedure 'a4p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=*), pointer :: xstar(:,:,:,:)
+end
+
+subroutine a5p (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 'a5p' with BIND\\(C\\) attribute" }
+ ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with POINTER attribute in procedure 'a5p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=:), pointer :: xcolon(:)
+end
+
+! Assumed-rank array, pointer
+
+subroutine a1pr (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
+ character(len=1), pointer :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a2pr (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
+ character(len=2), pointer :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a3pr (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
+ integer :: n
+ character(len=n), pointer :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a4pr (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
+ character(len=*), pointer :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a5pr (xcolon) bind(C) ! { dg-error "Symbol 'xcolon' at .1. has no IMPLICIT type" }
+ character(len=:), pointer :: xcolon(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_7.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_7.f90
new file mode 100644
index 00000000000..a9b8c3b2c20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_7.f90
@@ -0,0 +1,261 @@
+! { dg-do compile }
+! { dg-additional-options "-std=f2008 -fimplicit-none" }
+
+! F2008 permits constant character lengths for dummy arguments
+
+! Scalar, nonallocatable/nonpointer
+
+subroutine s1 (x1) bind(C)
+ character(len=1) :: x1
+end
+
+subroutine s2 (x2) bind(C)
+ 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" }
+ integer :: n
+ character(len=n) :: xn
+end
+
+subroutine s4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 's4' with BIND\\(C\\) attribute" }
+ character(len=*) :: xstar
+end
+
+! Assumed-shape array, nonallocatable/nonpointer
+
+subroutine as1 (x1) bind(C) ! { dg-error "Fortran 2018: Assumed-shape array 'x1' at .1. as dummy argument to the BIND\\(C\\) procedure 'as1' at .2." }
+ character(len=1) :: x1(:)
+end
+
+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 }
+ 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 }
+ character(len=*) :: xstar(:,:,:,:)
+end
+
+! Assumed-rank array, nonallocatable/nonpointer
+
+subroutine ar1 (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
+ character(len=1) :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine ar2 (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
+ character(len=2) :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine ar3 (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
+ integer :: n
+ character(len=n) :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine ar4 (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
+ character(len=*) :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+! Assumed-size array, nonallocatable/nonpointer
+
+subroutine az1 (x1) bind(C)
+ character(len=1) :: x1(*)
+end
+
+subroutine az2 (x2) bind(C)
+ 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" }
+ integer :: n
+ character(len=n) :: xn(*)
+end
+
+subroutine az4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'az4' with BIND\\(C\\) attribute" }
+ character(len=*) :: xstar(*)
+end
+
+! Explicit-size array, nonallocatable/nonpointer
+
+subroutine ae1 (x1) bind(C)
+ character(len=1) :: x1(5)
+end
+
+subroutine ae2 (x2) bind(C)
+ 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" }
+ integer :: n
+ character(len=n) :: xn(9)
+end
+
+subroutine ae4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'ae4' with BIND\\(C\\) attribute" }
+ character(len=*) :: xstar(3)
+end
+
+! ALLOCATABLE
+! Scalar, allocatable
+
+subroutine s1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 's1a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x1' at .1. with ALLOCATABLE attribute in procedure 's1a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=1), allocatable :: x1
+end
+
+subroutine s2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 's2a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x2' at .1. with ALLOCATABLE attribute in procedure 's2a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=2), allocatable :: x2
+end
+
+subroutine s3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 's3a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xn' at .1. with ALLOCATABLE attribute in procedure 's3a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ integer :: n
+ character(len=n), allocatable :: xn
+end
+
+subroutine s4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 's4a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with ALLOCATABLE attribute in procedure 's4a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=*), allocatable :: xstar
+end
+
+subroutine s5a (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 's5a' with BIND\\(C\\) attribute" }
+ ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with ALLOCATABLE attribute in procedure 's5a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=:), allocatable :: xcolon
+end
+
+! Assumed-shape array, allocatable
+
+subroutine a1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 'a1a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x1' at .1. with ALLOCATABLE attribute in procedure 'a1a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=1), allocatable :: x1(:)
+end
+
+subroutine a2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 'a2a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x2' at .1. with ALLOCATABLE attribute in procedure 'a2a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=2), allocatable :: x2(:,:)
+end
+
+subroutine a3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 'a3a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xn' at .1. with ALLOCATABLE attribute in procedure 'a3a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ integer :: n
+ character(len=n), allocatable :: xn(:,:,:)
+end
+
+subroutine a4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4a' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with ALLOCATABLE attribute in procedure 'a4a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=*), allocatable :: xstar(:,:,:,:)
+end
+
+subroutine a5a (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 'a5a' with BIND\\(C\\) attribute" }
+ ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with ALLOCATABLE attribute in procedure 'a5a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=:), allocatable :: xcolon(:)
+end
+
+! Assumed-rank array, allocatable
+
+subroutine a1ar (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
+ character(len=1), allocatable :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a2ar (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
+ character(len=2), allocatable :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a3ar (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
+ integer :: n
+ character(len=n), allocatable :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a4ar (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
+ character(len=*), allocatable :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a5ar (xcolon) bind(C) ! { dg-error "Symbol 'xcolon' at .1. has no IMPLICIT type" }
+ character(len=:), allocatable :: xcolon(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+! POINTER
+! Scalar, pointer
+
+subroutine s1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 's1p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x1' at .1. with POINTER attribute in procedure 's1p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=1), pointer :: x1
+end
+
+subroutine s2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 's2p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x2' at .1. with POINTER attribute in procedure 's2p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=2), pointer :: x2
+end
+
+subroutine s3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 's3p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xn' at .1. with POINTER attribute in procedure 's3p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ integer :: n
+ character(len=n), pointer :: xn
+end
+
+subroutine s4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 's4p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with POINTER attribute in procedure 's4p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=*), pointer :: xstar
+end
+
+subroutine s5p (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 's5p' with BIND\\(C\\) attribute" }
+ ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with POINTER attribute in procedure 's5p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=:), pointer :: xcolon
+end
+
+! Assumed-shape array, pointer
+
+subroutine a1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 'a1p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x1' at .1. with POINTER attribute in procedure 'a1p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=1), pointer :: x1(:)
+end
+
+subroutine a2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 'a2p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'x2' at .1. with POINTER attribute in procedure 'a2p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=2), pointer :: x2(:,:)
+end
+
+subroutine a3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 'a3p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xn' at .1. with POINTER attribute in procedure 'a3p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ integer :: n
+ character(len=n), pointer :: xn(:,:,:)
+end
+
+subroutine a4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4p' is BIND\\(C\\)" }
+ ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with POINTER attribute in procedure 'a4p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=*), pointer :: xstar(:,:,:,:)
+end
+
+subroutine a5p (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 'a5p' with BIND\\(C\\) attribute" }
+ ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with POINTER attribute in procedure 'a5p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+ character(len=:), pointer :: xcolon(:)
+end
+
+! Assumed-rank array, pointer
+
+subroutine a1pr (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
+ character(len=1), pointer :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a2pr (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
+ character(len=2), pointer :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a3pr (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
+ integer :: n
+ character(len=n), pointer :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a4pr (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
+ character(len=*), pointer :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a5pr (xcolon) bind(C) ! { dg-error "Symbol 'xcolon' at .1. has no IMPLICIT type" }
+ character(len=:), pointer :: xcolon(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_8.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_8.f90
new file mode 100644
index 00000000000..1d566c0334d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_8.f90
@@ -0,0 +1,249 @@
+! { dg-do compile }
+! { dg-additional-options "-fimplicit-none" }
+
+! F2018 only permittes len=*, len=: or len=<const> as dummy argument
+! but not len=<non-const-expr>
+! Additionally, for allocatable/pointer, len=: is required.
+
+! Scalar, nonallocatable/nonpointer
+
+subroutine val_s1(x1) bind(C)
+ character(len=1), value :: x1
+end
+
+subroutine val_s2(x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of length 1 as it has the VALUE attribute" }
+ character(len=2), value :: x2
+end
+
+subroutine s1 (x1) bind(C)
+ character(len=1) :: x1
+end
+
+subroutine s2 (x2) bind(C)
+ 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" }
+ integer :: n
+ character(len=n) :: xn
+end
+
+subroutine s4 (xstar) bind(C) ! { dg-error "Sorry, character dummy argument 'xstar' at .1. with assumed length is not yet supported for procedure 's4' with BIND\\(C\\) attribute" }
+ character(len=*) :: xstar
+end
+
+! Assumed-shape array, nonallocatable/nonpointer
+
+subroutine as1 (x1) bind(C)
+ character(len=1) :: x1(:)
+end
+
+subroutine as2 (x2) bind(C)
+ character(len=2) :: x2(:,:)
+end
+
+subroutine as3 (xn, n) bind(C)
+ integer :: n
+ character(len=n) :: xn(:,:,:)
+end
+
+subroutine as4 (xstar) bind(C)
+ character(len=*) :: xstar(:,:,:,:)
+end
+
+! Assumed-rank array, nonallocatable/nonpointer
+
+subroutine ar1 (x1) bind(C)
+ character(len=1) :: x1(..)
+end
+
+subroutine ar2 (x2) bind(C)
+ character(len=2) :: x2(..)
+end
+
+subroutine ar3 (xn, n) bind(C)
+ integer :: n
+ character(len=n) :: xn(..)
+end
+
+subroutine ar4 (xstar) bind(C)
+ character(len=*) :: xstar(..)
+end
+
+! Assumed-size array, nonallocatable/nonpointer
+
+subroutine az1 (x1) bind(C)
+ character(len=1) :: x1(*)
+end
+
+subroutine az2 (x2) bind(C)
+ 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" }
+ integer :: n
+ character(len=n) :: xn(*)
+end
+
+subroutine az4 (xstar) bind(C) ! { dg-error "Sorry, character dummy argument 'xstar' at .1. with assumed length is not yet supported for procedure 'az4' with BIND\\(C\\) attribute" }
+ character(len=*) :: xstar(*)
+end
+
+! Explicit-size array, nonallocatable/nonpointer
+
+subroutine ae1 (x1) bind(C)
+ character(len=1) :: x1(5)
+end
+
+subroutine ae2 (x2) bind(C)
+ 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" }
+ integer :: n
+ character(len=n) :: xn(9)
+end
+
+subroutine ae4 (xstar) bind(C) ! { dg-error "Sorry, character dummy argument 'xstar' at .1. with assumed length is not yet supported for procedure 'ae4' with BIND\\(C\\) attribute" }
+ character(len=*) :: xstar(3)
+end
+
+! ALLOCATABLE
+! Scalar, allocatable
+
+subroutine s1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 's1a' is BIND\\(C\\)" }
+ character(len=1), allocatable :: x1
+end
+
+subroutine s2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 's2a' is BIND\\(C\\)" }
+ character(len=2), allocatable :: x2
+end
+
+subroutine s3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 's3a' is BIND\\(C\\)" }
+ integer :: n
+ character(len=n), allocatable :: xn
+end
+
+subroutine s4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 's4a' is BIND\\(C\\)" }
+ character(len=*), allocatable :: xstar
+end
+
+subroutine s5a (xcolon) bind(C) ! { dg-error "Sorry, deferred-length scalar character dummy argument 'xcolon' at .1. of procedure 's5a' with BIND\\(C\\) not yet supported" }
+ character(len=:), allocatable :: xcolon
+end
+
+! Assumed-shape array, allocatable
+
+subroutine a1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 'a1a' is BIND\\(C\\)" }
+ character(len=1), allocatable :: x1(:)
+end
+
+subroutine a2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 'a2a' is BIND\\(C\\)" }
+ character(len=2), allocatable :: x2(:,:)
+end
+
+subroutine a3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 'a3a' is BIND\\(C\\)" }
+ integer :: n
+ character(len=n), allocatable :: xn(:,:,:)
+end
+
+subroutine a4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4a' is BIND\\(C\\)" }
+ character(len=*), allocatable :: xstar(:,:,:,:)
+end
+
+subroutine a5a (xcolon) bind(C)
+ character(len=:), allocatable :: xcolon(:)
+end
+
+! Assumed-rank array, allocatable
+
+subroutine a1ar (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 'a1ar' is BIND\\(C\\)" }
+ character(len=1), allocatable :: x1(..)
+end
+
+subroutine a2ar (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 'a2ar' is BIND\\(C\\)" }
+ character(len=2), allocatable :: x2(..)
+end
+
+subroutine a3ar (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 'a3ar' is BIND\\(C\\)" }
+ integer :: n
+ character(len=n), allocatable :: xn(..)
+end
+
+subroutine a4ar (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4ar' is BIND\\(C\\)" }
+ character(len=*), allocatable :: xstar(..)
+end
+
+subroutine a5ar (xcolon) bind(C)
+ character(len=:), allocatable :: xcolon(..)
+end
+
+! POINTER
+! Scalar, pointer
+
+subroutine s1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 's1p' is BIND\\(C\\)" }
+ character(len=1), pointer :: x1
+end
+
+subroutine s2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 's2p' is BIND\\(C\\)" }
+ character(len=2), pointer :: x2
+end
+
+subroutine s3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 's3p' is BIND\\(C\\)" }
+ integer :: n
+ character(len=n), pointer :: xn
+end
+
+subroutine s4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 's4p' is BIND\\(C\\)" }
+ character(len=*), pointer :: xstar
+end
+
+subroutine s5p (xcolon) bind(C) ! { dg-error "Sorry, deferred-length scalar character dummy argument 'xcolon' at .1. of procedure 's5p' with BIND\\(C\\) not yet supported" }
+ character(len=:), pointer :: xcolon
+end
+
+! Assumed-shape array, pointer
+
+subroutine a1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 'a1p' is BIND\\(C\\)" }
+ character(len=1), pointer :: x1(:)
+end
+
+subroutine a2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 'a2p' is BIND\\(C\\)" }
+ character(len=2), pointer :: x2(:,:)
+end
+
+subroutine a3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 'a3p' is BIND\\(C\\)" }
+ integer :: n
+ character(len=n), pointer :: xn(:,:,:)
+end
+
+subroutine a4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4p' is BIND\\(C\\)" }
+ character(len=*), pointer :: xstar(:,:,:,:)
+end
+
+subroutine a5p (xcolon) bind(C)
+ character(len=:), pointer :: xcolon(:)
+end
+
+! Assumed-rank array, pointer
+
+subroutine a1pr (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 'a1pr' is BIND\\(C\\)" }
+ character(len=1), pointer :: x1(..)
+end
+
+subroutine a2pr (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 'a2pr' is BIND\\(C\\)" }
+ character(len=2), pointer :: x2(..)
+end
+
+subroutine a3pr (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 'a3pr' is BIND\\(C\\)" }
+ integer :: n
+ character(len=n), pointer :: xn(..)
+end
+
+subroutine a4pr (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4pr' is BIND\\(C\\)" }
+ character(len=*), pointer :: xstar(..)
+end
+
+subroutine a5pr (xcolon) bind(C)
+ character(len=:), pointer :: xcolon(..)
+end
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_9.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_9.f90
new file mode 100644
index 00000000000..d31862c89e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_9.f90
@@ -0,0 +1,188 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+
+! F2018 - examples without array descriptor
+
+
+module m
+ use iso_c_binding, only: c_char
+ implicit none (type, external)
+
+contains
+
+! Scalar, nonallocatable/nonpointer
+subroutine s1 (x1) bind(C)
+ character(kind=c_char, len=1) :: x1
+ if (len (x1) /= 1) stop
+ if (x1 /= 'Z') stop
+ 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
+
+! Assumed-size array, nonallocatable/nonpointer
+
+subroutine az1 (x1) bind(C)
+ character(kind=c_char, len=1) :: x1(*)
+ if (len(x1) /= 1) stop
+ if (any (x1(:6) /= ['g', &
+ 'd', &
+ 'f', &
+ 's', &
+ '3', &
+ '5'])) stop 1
+ x1(:6) = ['1', &
+ 'h', &
+ 'f', &
+ '3', &
+ '4', &
+ '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
+
+! Explicit-size array, nonallocatable/nonpointer
+
+subroutine ae1 (x1) bind(C)
+ character(kind=c_char, len=1) :: x1(6)
+ if (size(x1) /= 6) stop
+ if (len(x1) /= 1) stop
+ if (any (x1 /= ['g', &
+ 'd', &
+ 'f', &
+ 's', &
+ '3', &
+ '5'])) stop 1
+ x1 = ['1', &
+ 'h', &
+ 'f', &
+ '3', &
+ '4', &
+ '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
+
+end module m
+
+program main
+ use m
+ implicit none (type, external)
+ character(kind=c_char, len=1) :: str1
+ character(kind=c_char, len=2) :: str2
+
+ character(kind=c_char, len=1) :: str1a6(6)
+ character(kind=c_char, len=2) :: str2a6(6)
+
+ ! Scalar - no array descriptor
+
+ str1 = 'Z'
+ call s1 (str1)
+ if (str1 /= 'A') stop
+
+ str2 = '42'
+ call s2 (str2)
+ if (str2 /= '64') stop
+
+ ! assumed size - without array descriptor
+
+ str1a6 = ['g', &
+ 'd', &
+ 'f', &
+ 's', &
+ '3', &
+ '5']
+ call az1 (str1a6)
+ if (any (str1a6 /= ['1', &
+ 'h', &
+ 'f', &
+ '3', &
+ '4', &
+ 'h'])) 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', &
+ 'd', &
+ 'f', &
+ 's', &
+ '3', &
+ '5']
+ call ae1 (str1a6)
+ if (any (str1a6 /= ['1', &
+ 'h', &
+ 'f', &
+ '3', &
+ '4', &
+ 'h'])) 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-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-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" } }
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 ebf9a248dac..abe5cb71bfc 100644
--- a/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90
@@ -4,7 +4,7 @@
!
! Contributed by Thomas Koenig <tkoe...@gcc.gnu.org>
!
-subroutine bar(c,d) BIND(C) ! { dg-error "must be length 1" }
+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" }
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 297b75a7444..bf9bd8c1d68 100644
--- a/gcc/testsuite/gfortran.dg/pr32599.f03
+++ b/gcc/testsuite/gfortran.dg/pr32599.f03
@@ -1,20 +1,20 @@
! { dg-do compile }
-! { dg-options "-std=f2008" }
+! { dg-options "-std=f2003" }
!
! PR fortran/32599
! Verifies that character string arguments to a bind(c) procedure have length
-! 1, or no len is specified. Note that the C interop extensions in F2018 allow
+! 1, or no len is specified. Note that the C interop extensions in F2008 allow
! string arguments of length greater than one to be passed to a C descriptor.
!
module pr32599
interface
- subroutine destroy(path) BIND(C) ! { dg-error "must be length 1" }
+ subroutine destroy(path) BIND(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'path' at .1. of procedure .destroy. with BIND\\(C\\) attribute" }
use iso_c_binding
implicit none
character(len=*,kind=c_char), intent(IN) :: path
end subroutine destroy
- subroutine create(path) BIND(C) ! { dg-error "must be length 1" }
+ 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" }
use iso_c_binding
implicit none
character(len=5,kind=c_char), intent(IN) :: path
