+2021-08-13 Tobias Burnus <tobias@codesourcery.com>
+
+ Backported from master:
+ 2021-08-03 Tobias Burnus <tobias@codesourcery.com>
+
+ * decl.c (gfc_verify_c_interop_param): Reject pointer with
+ CONTIGUOUS attributes as dummy arg. Reject character len > 1
+ when passed as byte stream.
+
2021-08-23 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
sym->ns->proc_name->name);
}
+ /* Per F2018, 18.3.6 (5), pointer + contiguous is not permitted. */
+ if (sym->attr.pointer && sym->attr.contiguous)
+ gfc_error ("Dummy argument %qs at %L may not be a pointer with "
+ "CONTIGUOUS attribute as procedure %qs is BIND(C)",
+ sym->name, &sym->declared_at, sym->ns->proc_name->name);
+
/* Character strings are only C interoperable if they have a
- length of 1. However, as argument they are either iteroperable
- when passed as descriptor (which requires len=: or len=*) or
- when having a constant length or are always passed by
- descriptor. */
+ length of 1. However, as an argument they are also iteroperable
+ when passed as descriptor (which requires len=: or len=*). */
if (sym->ts.type == BT_CHARACTER)
{
gfc_charlen *cl = sym->ts.u.cl;
else if (!cl || !cl->length)
{
/* Assumed length; F2018, 18.3.6 (5)(2).
- Uses the CFI array descriptor. */
+ Uses the CFI array descriptor - also for scalars and
+ explicit-size/assumed-size arrays. */
if (!gfc_notify_std (GFC_STD_F2018,
"Assumed-length character dummy argument "
"%qs at %L of procedure %qs with BIND(C) "
retval = false;
}
}
- else if (cl->length->expr_type != EXPR_CONSTANT)
+ else if (cl->length->expr_type != EXPR_CONSTANT
+ || mpz_cmp_si (cl->length->value.integer, 1) != 0)
{
/* F2018, 18.3.6, (5), item 4. */
if (!sym->attr.dimension
|| sym->as->type == AS_EXPLICIT)
{
gfc_error ("Character dummy argument %qs at %L must be "
- "of constant length or assumed length, "
+ "of constant length of one or assumed length, "
"unless it has assumed shape or assumed rank, "
"as procedure %qs has the BIND(C) attribute",
sym->name, &sym->declared_at,
sym->ns->proc_name->name);
retval = false;
}
- else if (!gfc_notify_std (GFC_STD_F2018,
- "Character dummy argument %qs at "
- "%L with nonconstant length as "
- "procedure %qs is BIND(C)",
- sym->name, &sym->declared_at,
- sym->ns->proc_name->name))
- retval = false;
+ /* else: valid only since F2018 - and an assumed-shape/rank
+ array; however, gfc_notify_std is already called when
+ those array types are used. Thus, silently accept F200x. */
}
- else if (mpz_cmp_si (cl->length->value.integer, 1) != 0
- && !gfc_notify_std (GFC_STD_F2008,
- "Character dummy argument %qs at %L "
- "with length greater than 1 for "
- "procedure %qs with BIND(C) "
- "attribute",
- sym->name, &sym->declared_at,
- sym->ns->proc_name->name))
- retval = false;
}
/* We have to make sure that any param to a bind(c) routine does
+2021-08-13 Tobias Burnus <tobias@codesourcery.com>
+
+ Backported from master:
+ 2021-08-03 Tobias Burnus <tobias@codesourcery.com>
+
+ * gfortran.dg/bind_c_char_6.f90: Update dg-error.
+ * gfortran.dg/bind_c_char_7.f90: Likewise.
+ * gfortran.dg/bind_c_char_8.f90: Likewise.
+ * gfortran.dg/iso_c_binding_char_1.f90: Likewise.
+ * gfortran.dg/pr32599.f03: Likewise.
+ * gfortran.dg/bind_c_char_9.f90: Comment testcase bits which are
+ implementable but not valid F2018.
+ * gfortran.dg/bind_c_contiguous.f90: New test.
+
2021-08-23 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
character(len=1) :: x1
end
-subroutine s2 (x2) bind(C) ! { dg-error "Fortran 2008: Character dummy argument 'x2' at .1. with length greater than 1 for procedure 's2' with BIND\\(C\\) attribute" }
+subroutine s2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's2' has the BIND\\(C\\) attribute" }
character(len=2) :: x2
end
-subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
+subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
integer :: n
character(len=n) :: xn
end
character(len=1) :: x1(:)
end
-subroutine as2 (x2) bind(C) ! { dg-error "Fortran 2008: Character dummy argument 'x2' at .1. with length greater than 1 for procedure 'as2' with BIND\\(C\\) attribute" }
- ! { dg-error "Fortran 2018: Assumed-shape array 'x2' at .1. as dummy argument to the BIND\\(C\\) procedure 'as2' at .2." "" { target *-*-* } .-1 }
+subroutine as2 (x2) bind(C) ! { dg-error "Fortran 2018: Assumed-shape array 'x2' at .1. as dummy argument to the BIND\\(C\\) procedure 'as2' at .2." }
character(len=2) :: x2(:,:)
end
-subroutine as3 (xn, n) bind(C) ! { dg-error "Fortran 2018: Character dummy argument 'xn' at .1. with nonconstant length as procedure 'as3' is BIND\\(C\\)" }
- ! { dg-error "Fortran 2018: Assumed-shape array 'xn' at .1. as dummy argument to the BIND\\(C\\) procedure 'as3' at .2." "" { target *-*-* } .-1 }
+subroutine as3 (xn, n) bind(C) ! { dg-error "Fortran 2018: Assumed-shape array 'xn' at .1. as dummy argument to the BIND\\(C\\) procedure 'as3' at .2." }
integer :: n
character(len=n) :: xn(:,:,:)
end
-subroutine as4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'as4' with BIND\\(C\\) attribute" }
- ! { dg-error "Fortran 2018: Assumed-shape array 'xstar' at .1. as dummy argument to the BIND\\(C\\) procedure 'as4' at .2." "" { target *-*-* } .-1 }
+subroutine as4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'as4' with BIND\\(C\\) attribute" }
+ ! { dg-error "Fortran 2018: Assumed-shape array 'xstar' at .1. as dummy argument to the BIND\\(C\\) procedure 'as4' at .2." "" { target *-*-* } .-1 }
character(len=*) :: xstar(:,:,:,:)
end
character(len=1) :: x1(*)
end
-subroutine az2 (x2) bind(C) ! { dg-error "Fortran 2008: Character dummy argument 'x2' at .1. with length greater than 1 for procedure 'az2' with BIND\\(C\\) attribute" }
+subroutine az2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az2' has the BIND\\(C\\) attribute" }
character(len=2) :: x2(*)
end
-subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
+subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
integer :: n
character(len=n) :: xn(*)
end
character(len=1) :: x1(5)
end
-subroutine ae2 (x2) bind(C) ! { dg-error "Fortran 2008: Character dummy argument 'x2' at .1. with length greater than 1 for procedure 'ae2' with BIND\\(C\\) attribute" }
+subroutine ae2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae2' has the BIND\\(C\\) attribute" }
character(len=2) :: x2(7)
end
-subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
+subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
integer :: n
character(len=n) :: xn(9)
end
character(len=1) :: x1
end
-subroutine s2 (x2) bind(C)
+subroutine s2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's2' has the BIND\\(C\\) attribute" }
character(len=2) :: x2
end
-subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
+subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
integer :: n
character(len=n) :: xn
end
character(len=2) :: x2(:,:)
end
-subroutine as3 (xn, n) bind(C) ! { dg-error "Fortran 2018: Character dummy argument 'xn' at .1. with nonconstant length as procedure 'as3' is BIND\\(C\\)" }
- ! { dg-error "Fortran 2018: Assumed-shape array 'xn' at .1. as dummy argument to the BIND\\(C\\) procedure 'as3' at .2." "" { target *-*-* } .-1 }
+subroutine as3 (xn, n) bind(C) ! { dg-error "Fortran 2018: Assumed-shape array 'xn' at .1. as dummy argument to the BIND\\(C\\) procedure 'as3' at .2." }
integer :: n
character(len=n) :: xn(:,:,:)
end
character(len=1) :: x1(*)
end
-subroutine az2 (x2) bind(C)
+subroutine az2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az2' has the BIND\\(C\\) attribute" }
character(len=2) :: x2(*)
end
-subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
+subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
integer :: n
character(len=n) :: xn(*)
end
character(len=1) :: x1(5)
end
-subroutine ae2 (x2) bind(C)
+subroutine ae2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae2' has the BIND\\(C\\) attribute" }
character(len=2) :: x2(7)
end
-subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
+subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
integer :: n
character(len=n) :: xn(9)
end
character(len=1) :: x1
end
-subroutine s2 (x2) bind(C)
+subroutine s2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's2' has the BIND\\(C\\) attribute" }
character(len=2) :: x2
end
-subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
+subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
integer :: n
character(len=n) :: xn
end
character(len=1) :: x1(*)
end
-subroutine az2 (x2) bind(C)
+subroutine az2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az2' has the BIND\\(C\\) attribute" }
character(len=2) :: x2(*)
end
-subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
+subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
integer :: n
character(len=n) :: xn(*)
end
character(len=1) :: x1(5)
end
-subroutine ae2 (x2) bind(C)
+subroutine ae2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae2' has the BIND\\(C\\) attribute" }
character(len=2) :: x2(7)
end
-subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
+subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
integer :: n
character(len=n) :: xn(9)
end
x1 = 'A'
end
-subroutine s2 (x2) bind(C)
- character(kind=c_char, len=2) :: x2
- if (len (x2) /= 2) stop
- if (x2 /= '42') stop
- x2 = '64'
-end
+! Valid as Fortran code - but with BIND(C)
+! 18.3.6 (5) (bullet 5) requires interoperability, i.e. len=1
+! which is not fullfilled.
+!
+! [It would work as with len=<const> the length is known
+! and only a bytestream is passed around.]
+!subroutine s2 (x2) bind(C)
+! character(kind=c_char, len=2) :: x2
+! if (len (x2) /= 2) stop
+! if (x2 /= '42') stop
+! x2 = '64'
+!end
! Assumed-size array, nonallocatable/nonpointer
'h']
end
-subroutine az2 (x2) bind(C)
- character(kind=c_char, len=2) :: x2(*)
- if (len(x2) /= 2) stop
- if (any (x2(:6) /= ['ab', &
- 'fd', &
- 'D4', &
- '54', &
- 'ga', &
- 'hg'])) stop
- x2(:6) = ['ab', &
- 'hd', &
- 'fj', &
- 'a4', &
- '4a', &
- 'hf']
-end
+! Valid as Fortran code - but with BIND(C)
+! 18.3.6 (5) (bullet 5) requires interoperability, i.e. len=1
+! which is not fullfilled.
+!
+! [It would work as with len=<const> the length is known
+! and only a bytestream is passed around.]
+!subroutine az2 (x2) bind(C)
+! character(kind=c_char, len=2) :: x2(*)
+! if (len(x2) /= 2) stop
+! if (any (x2(:6) /= ['ab', &
+! 'fd', &
+! 'D4', &
+! '54', &
+! 'ga', &
+! 'hg'])) stop
+! x2(:6) = ['ab', &
+! 'hd', &
+! 'fj', &
+! 'a4', &
+! '4a', &
+! 'hf']
+!end
! Explicit-size array, nonallocatable/nonpointer
'h']
end
-subroutine ae2 (x2) bind(C)
- character(kind=c_char, len=2) :: x2(6)
- if (size(x2) /= 6) stop
- if (len(x2) /= 2) stop
- if (any (x2 /= ['ab', &
- 'fd', &
- 'D4', &
- '54', &
- 'ga', &
- 'hg'])) stop
- x2 = ['ab', &
- 'hd', &
- 'fj', &
- 'a4', &
- '4a', &
- 'hf']
-end
+! Valid as Fortran code - but with BIND(C)
+! 18.3.6 (5) (bullet 5) requires interoperability, i.e. len=1
+! which is not fullfilled.
+!
+! [It would work as with len=<const> the length is known
+! and only a bytestream is passed around.]
+!subroutine ae2 (x2) bind(C)
+! character(kind=c_char, len=2) :: x2(6)
+! if (size(x2) /= 6) stop
+! if (len(x2) /= 2) stop
+! if (any (x2 /= ['ab', &
+! 'fd', &
+! 'D4', &
+! '54', &
+! 'ga', &
+! 'hg'])) stop
+! x2 = ['ab', &
+! 'hd', &
+! 'fj', &
+! 'a4', &
+! '4a', &
+! 'hf']
+!end
end module m
call s1 (str1)
if (str1 /= 'A') stop
- str2 = '42'
- call s2 (str2)
- if (str2 /= '64') stop
+! str2 = '42'
+! call s2 (str2)
+! if (str2 /= '64') stop
! assumed size - without array descriptor
'3', &
'4', &
'h'])) stop
- str2a6 = ['ab', &
- 'fd', &
- 'D4', &
- '54', &
- 'ga', &
- 'hg']
- call az2 (str2a6)
- if (any (str2a6 /= ['ab', &
- 'hd', &
- 'fj', &
- 'a4', &
- '4a', &
- 'hf'])) stop
+! str2a6 = ['ab', &
+! 'fd', &
+! 'D4', &
+! '54', &
+! 'ga', &
+! 'hg']
+! call az2 (str2a6)
+! if (any (str2a6 /= ['ab', &
+! 'hd', &
+! 'fj', &
+! 'a4', &
+! '4a', &
+! 'hf'])) stop
+
! explicit size - without array descriptor
str1a6 = ['g', &
'3', &
'4', &
'h'])) stop
- str2a6 = ['ab', &
- 'fd', &
- 'D4', &
- '54', &
- 'ga', &
- 'hg']
- call ae2 (str2a6)
- if (any (str2a6 /= ['ab', &
- 'hd', &
- 'fj', &
- 'a4', &
- '4a', &
- 'hf'])) stop
+! str2a6 = ['ab', &
+! 'fd', &
+! 'D4', &
+! '54', &
+! 'ga', &
+! 'hg']
+! call ae2 (str2a6)
+! if (any (str2a6 /= ['ab', &
+! 'hd', &
+! 'fj', &
+! 'a4', &
+! '4a', &
+! 'hf'])) stop
end
! All argument shall be passed without descriptor
! { dg-final { scan-tree-dump-not "dtype" "original" } }
! { dg-final { scan-tree-dump-times "void s1 \\(character\\(kind=1\\)\\\[1:1\\\] & restrict x1\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void s2 \\(character\\(kind=1\\)\\\[1:2\\\] & restrict x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-not "void s2 " "original" } }
! { dg-final { scan-tree-dump-times "void az1 \\(character\\(kind=1\\)\\\[0:\\\]\\\[1:1\\\] \\* restrict x1\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void az2 \\(character\\(kind=1\\)\\\[0:\\\]\\\[1:2\\\] \\* restrict x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-not "void az2 " "original" } }
! { dg-final { scan-tree-dump-times "void ae1 \\(character\\(kind=1\\)\\\[6\\\]\\\[1:1\\\] \\* restrict x1\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void ae2 \\(character\\(kind=1\\)\\\[6\\\]\\\[1:2\\\] \\* restrict x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-not "void ae2 " "original" } }
--- /dev/null
+module m
+ use iso_c_binding
+ implicit none (type, external)
+contains
+
+! All of the following use an array descriptor
+! F2018, 18.3.7 (5) applies:
+
+subroutine f1 (x) bind(c) ! { dg-error "Dummy argument 'x' at .1. may not be a pointer with CONTIGUOUS attribute as procedure 'f1' is BIND\\(C\\)" }
+ character(len=:, kind=c_char), pointer, contiguous :: x(:)
+end
+
+subroutine f2 (x) bind(c) ! { dg-error "Dummy argument 'x' at .1. may not be a pointer with CONTIGUOUS attribute as procedure 'f2' is BIND\\(C\\)" }
+ integer(c_int), pointer, contiguous :: x(:)
+end
+
+subroutine f3 (x) bind(c)
+ character(len=:, kind=c_char), pointer :: x(:) ! OK - pointer but not contiguous
+end
+
+subroutine f4 (x) bind(c)
+ character(len=*, kind=c_char), contiguous :: x(:) ! OK - contiguous but not a pointer
+end
+
+subroutine f5 (x) bind(c)
+ integer(c_int), pointer :: x(:) ! OK - pointer but not contigous
+end
+
+subroutine f6 (x) bind(c)
+ integer(c_int), contiguous :: x(:) ! OK - contiguous but not a pointer
+end
+
+end
! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
!
subroutine bar(c,d) BIND(C) ! { dg-error "character dummy argument 'c' at .1. with assumed length is not yet supported for procedure 'bar' with BIND\\(C\\) attribute" }
+ ! { dg-error "Character dummy argument 'd' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'bar' has the BIND\\(C\\) attribute" "" { target *-*-* } .-1 }
character (len=*) c
character (len=2) d
end
character(len=*,kind=c_char), intent(IN) :: path
end subroutine destroy
- subroutine create(path) BIND(C) ! { dg-error "Fortran 2008: Character dummy argument 'path' at .1. with length greater than 1 for procedure 'create' with BIND\\(C\\) attribute" }
+ subroutine create(path) BIND(C) ! { dg-error "Character dummy argument 'path' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'create' has the BIND\\(C\\) attribute" }
use iso_c_binding
implicit none
character(len=5,kind=c_char), intent(IN) :: path
projects / thirdparty / gcc.git / commitdiff
