Message ID | f4763336-4cca-ae35-930d-1dda234d5dce@codesourcery.com |
---|---|
State | New |
Headers | show |
Series | [Fortran] Add missing diagnostic for F2018 C711 (TS29113 C407c) | expand |
On 24.09.21 01:19, Sandra Loosemore wrote: > Here's another missing-diagnostic patch for the Fortran front end, > this time for PR Fortran/101333. OK to commit? That's "C711 An assumed-type actual argument that corresponds to an assumed-rank dummy argument shall be assumed-shape or assumed-rank." LGTM. Thanks for the patch! Tobias > commit 53171e748e28901693ca4362ff658883dab97e13 > Author: Sandra Loosemore<sandra@codesourcery.com> > Date: Thu Sep 23 15:00:43 2021 -0700 > > Fortran: Add missing diagnostic for F2018 C711 (TS29113 C407c) > > 2021-09-23 Sandra Loosemore<sandra@codesourcery.com> > > PR Fortran/101333 > > gcc/fortran/ > * interface.c (compare_parameter): Enforce F2018 C711. > > gcc/testsuite/ > * gfortran.dg/c-interop/c407c-1.f90: Remove xfails. > > diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c > index dae4b95..a2fea0e 100644 > --- a/gcc/fortran/interface.c > +++ b/gcc/fortran/interface.c > @@ -2448,6 +2448,21 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, > return false; > } > > + /* TS29113 C407c; F2018 C711. */ > + if (actual->ts.type == BT_ASSUMED > + && symbol_rank (formal) == -1 > + && actual->rank != -1 > + && !(actual->symtree->n.sym->as > + && actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE)) > + { > + if (where) > + gfc_error ("Assumed-type actual argument at %L corresponding to " > + "assumed-rank dummy argument %qs must be " > + "assumed-shape or assumed-rank", > + &actual->where, formal->name); > + return false; > + } > + > /* F2008, 12.5.2.5; IR F08/0073. */ > if (formal->ts.type == BT_CLASS && formal->attr.class_ok > && actual->expr_type != EXPR_NULL > diff --git a/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90 > index e4da66a..c77e6ac 100644 > --- a/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90 > +++ b/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90 > @@ -44,7 +44,7 @@ subroutine s2 (x) > implicit none > type(*) :: x(*) > > - call g (x, 1) ! { dg-error "Assumed.type" "pr101333" { xfail *-*-* } } > + call g (x, 1) ! { dg-error "Assumed.type" } > end subroutine > > ! Check that a scalar gives an error. > @@ -53,7 +53,7 @@ subroutine s3 (x) > implicit none > type(*) :: x > > - call g (x, 1) ! { dg-error "Assumed.type" "pr101333" { xfail *-*-* } } > + call g (x, 1) ! { dg-error "Assumed.type" } > end subroutine > > ! Explicit-shape assumed-type actual arguments are forbidden implicitly ----------------- 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 53171e748e28901693ca4362ff658883dab97e13 Author: Sandra Loosemore <sandra@codesourcery.com> Date: Thu Sep 23 15:00:43 2021 -0700 Fortran: Add missing diagnostic for F2018 C711 (TS29113 C407c) 2021-09-23 Sandra Loosemore <sandra@codesourcery.com> PR Fortran/101333 gcc/fortran/ * interface.c (compare_parameter): Enforce F2018 C711. gcc/testsuite/ * gfortran.dg/c-interop/c407c-1.f90: Remove xfails. diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index dae4b95..a2fea0e 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2448,6 +2448,21 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, return false; } + /* TS29113 C407c; F2018 C711. */ + if (actual->ts.type == BT_ASSUMED + && symbol_rank (formal) == -1 + && actual->rank != -1 + && !(actual->symtree->n.sym->as + && actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE)) + { + if (where) + gfc_error ("Assumed-type actual argument at %L corresponding to " + "assumed-rank dummy argument %qs must be " + "assumed-shape or assumed-rank", + &actual->where, formal->name); + return false; + } + /* F2008, 12.5.2.5; IR F08/0073. */ if (formal->ts.type == BT_CLASS && formal->attr.class_ok && actual->expr_type != EXPR_NULL diff --git a/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90 index e4da66a..c77e6ac 100644 --- a/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90 +++ b/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90 @@ -44,7 +44,7 @@ subroutine s2 (x) implicit none type(*) :: x(*) - call g (x, 1) ! { dg-error "Assumed.type" "pr101333" { xfail *-*-* } } + call g (x, 1) ! { dg-error "Assumed.type" } end subroutine ! Check that a scalar gives an error. @@ -53,7 +53,7 @@ subroutine s3 (x) implicit none type(*) :: x - call g (x, 1) ! { dg-error "Assumed.type" "pr101333" { xfail *-*-* } } + call g (x, 1) ! { dg-error "Assumed.type" } end subroutine ! Explicit-shape assumed-type actual arguments are forbidden implicitly