mirrors/gcc
0
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2025-01-17 01:04:11 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

Fortran: Fix bind(C) character length checks

Browse Source 
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.
This commit is contained in:
Tobias Burnus 2021-07-21 09:36:48 +02:00
parent 957952ce64
commit b3d4011ba1
9 changed files with 1557 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
gcc/fortran/decl.c
View File

@ -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

18
gcc/fortran/trans-expr.c
View File

@ -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

480
gcc/testsuite/gfortran.dg/bind_c_char_10.f90 Normal file
View File

@ -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" } }

262
gcc/testsuite/gfortran.dg/bind_c_char_6.f90 Normal file
View File

@ -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

261
gcc/testsuite/gfortran.dg/bind_c_char_7.f90 Normal file
View File

@ -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

249
gcc/testsuite/gfortran.dg/bind_c_char_8.f90 Normal file
View File

@ -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

188
gcc/testsuite/gfortran.dg/bind_c_char_9.f90 Normal file
View File

@ -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" } }

2
gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90
View File

@ -4,7 +4,7 @@
!
! Contributed by Thomas Koenig <tkoenig@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

8
gcc/testsuite/gfortran.dg/pr32599.f03
View File

@ -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