procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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.
This commit is contained in:
Sandra Loosemore 2021-09-23 15:00:43 -07:00
parent 34947d4e97
commit 2364250ecc
2 changed files with 17 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
gcc/fortran/interface.c
View file

@ -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

4
gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90
View file

@ -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