1! { dg-do compile }
2! Tests the fix for the regression caused by the patch for PR20869
3! which itself is tested and described by intrinsic_external_1.f90
4!
5! reported to the fortran list by Dominique Dhumieres  dominiq@lps.ens.fr
6
7MODULE global
8   INTERFACE
9      SUBROUTINE foo(i, j)
10      IMPLICIT NONE
11      INTEGER :: j
12      integer, DIMENSION(j,*) :: i ! This constituted usage of j and so triggered....
13      INTENT (IN) j  ! Would give "Cannot change attributes of symbol at (1) after it has been used"
14      INTENT (INOUT) i
15      END SUBROUTINE foo
16   END INTERFACE
17END MODULE global
18