diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/decl.c | 14 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/c-interop/c516.f90 | 46 |
2 files changed, 58 insertions, 2 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index f2e8896..b3c65b7 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1557,6 +1557,20 @@ gfc_verify_c_interop_param (gfc_symbol *sym) "CONTIGUOUS attribute as procedure %qs is BIND(C)", sym->name, &sym->declared_at, sym->ns->proc_name->name); + /* Per F2018, C1557, pointer/allocatable dummies to a bind(c) + procedure that are default-initialized are not permitted. */ + if ((sym->attr.pointer || sym->attr.allocatable) + && sym->ts.type == BT_DERIVED + && gfc_has_default_initializer (sym->ts.u.derived)) + { + gfc_error ("Default-initialized %s dummy argument %qs " + "at %L is not permitted in BIND(C) procedure %qs", + (sym->attr.pointer ? "pointer" : "allocatable"), + sym->name, &sym->declared_at, + sym->ns->proc_name->name); + retval = false; + } + /* Character strings are only C interoperable if they have a length of 1. However, as an argument they are also iteroperable when passed as descriptor (which requires len=: or len=*). */ diff --git a/gcc/testsuite/gfortran.dg/c-interop/c516.f90 b/gcc/testsuite/gfortran.dg/c-interop/c516.f90 index 208eb84..d6a65af 100644 --- a/gcc/testsuite/gfortran.dg/c-interop/c516.f90 +++ b/gcc/testsuite/gfortran.dg/c-interop/c516.f90 @@ -27,6 +27,10 @@ module m2 interface + ! First test versions with optional attributes on the argument. + ! TS29113 removed the constraint disallowing optional arguments + ! that previously used to be in C516. + ! good, no default initialization, no pointer/allocatable attribute subroutine s1a (x) bind (c) use m1 @@ -52,16 +56,54 @@ module m2 end subroutine ! bad, default initialization + allocatable - subroutine s2b (x) bind (c) ! { dg-error "BIND\\(C\\)" "pr101320" { xfail *-*-* } } + subroutine s2b (x) bind (c) ! { dg-error "BIND\\(C\\)" } use m1 type(t2), allocatable, optional :: x end subroutine ! bad, default initialization + pointer - subroutine s2c (x) bind (c) ! { dg-error "BIND\\(C\\)" "pr101320" { xfail *-*-* } } + subroutine s2c (x) bind (c) ! { dg-error "BIND\\(C\\)" } use m1 type(t2), pointer, optional :: x end subroutine + ! Now do all the same tests without the optional attribute. + + ! good, no default initialization, no pointer/allocatable attribute + subroutine s3a (x) bind (c) + use m1 + type(t1) :: x + end subroutine + + ! good, no default initialization + subroutine s3b (x) bind (c) + use m1 + type(t1), allocatable :: x + end subroutine + + ! good, no default initialization + subroutine s3c (x) bind (c) + use m1 + type(t1), pointer :: x + end subroutine + + ! good, default initialization but no pointer/allocatable attribute + subroutine s4a (x) bind (c) + use m1 + type(t2) :: x + end subroutine + + ! bad, default initialization + allocatable + subroutine s4b (x) bind (c) ! { dg-error "BIND\\(C\\)" } + use m1 + type(t2), allocatable :: x + end subroutine + + ! bad, default initialization + pointer + subroutine s4c (x) bind (c) ! { dg-error "BIND\\(C\\)" } + use m1 + type(t2), pointer :: x + end subroutine + end interface end module |