[PATCH, Fortran] Add missing diagnostic for F2018 C711 (TS29113 C407c)

[PATCH, Fortran] Add missing diagnostic for F2018 C711 (TS29113 C407c)

[Sandra Loosemore]

[-- Attachment #1: Type: text/plain, Size: 125 bytes --]

Here's another missing-diagnostic patch for the Fortran front end, this 
time for PR Fortran/101333.  OK to commit?

-Sandra

[-- Attachment #2: pr101333.patch --]
[-- Type: text/x-patch, Size: 2145 bytes --]

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

Re: [PATCH, Fortran] Add missing diagnostic for F2018 C711 (TS29113 C407c)

[Tobias Burnus]

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