Fortran: Add missing diagnostic for F2018 C711 (TS29113 C407c)

2021-09-24  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 dae4b959252f85286b4ba4c23537a15d386cfc75..a2fea0e97b8211be1c8a7336ba645a1a2cc9e3c1 100644 (file)
--- 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 e4da66adade351fc71e51a403040e0009d032082..c77e6ac3334c0b44e10b05f44da31d33705c59a8 100644 (file)
--- 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