1! { dg-do compile }
2! Tests the fix for PR25951, a regression caused by the assumed
3! size patch.
4! Test case provided by Mark Hesselink  <mhesseli@caltech.edu>
5PROGRAM loc_1
6  integer i(10)
7  call f (i)
8CONTAINS
9   SUBROUTINE f (x)
10      INTEGER, DIMENSION(*)   :: x
11      INTEGER                 :: address
12! The next line would cause:
13! Error: The upper bound in the last dimension must appear in the
14! reference to the assumed size array 'x' at (1)
15      address=LOC(x)
16   END SUBROUTINE f
17END PROGRAM loc_1