gcc/testsuite/gfortran.dg/PR97046.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR94331
   4 !
   5 ! Contributed by Igor Gayday <igor.gayday@mu.edu>
   6 !
   7
   8 MODULE FOO
   9
  10   implicit none
  11
  12   INTEGER, parameter :: n = 11
  13
  14 contains
  15
  16   SUBROUTINE dummyc(x0) BIND(C)
  17     type(*), dimension(..) :: x0
  18     if(LBOUND(x0,1)/=1) stop 5
  19     if(UBOUND(x0,1)/=n) stop 6
  20     if(rank(x0)/=1)     stop 7
  21   END SUBROUTINE dummyc
  22
  23   SUBROUTINE dummy(x0)
  24     type(*), dimension(..) :: x0
  25     call dummyc(x0)
  26   END SUBROUTINE dummy
  27
  28 END MODULE
  29
  30 PROGRAM main
  31     USE FOO
  32     IMPLICIT NONE
  33     integer :: before(2), after(2)
  34
  35     DOUBLE PRECISION, ALLOCATABLE :: buf(:)
  36     DOUBLE PRECISION :: buf2(n)
  37
  38     ALLOCATE(buf(n))
  39     before(1) = LBOUND(buf,1)
  40     before(2) = UBOUND(buf,1)
  41     CALL dummy (buf)
  42     after(1) = LBOUND(buf,1)
  43     after(2) = UBOUND(buf,1)
  44     deallocate(buf)
  45
  46     if (before(1) .NE. after(1)) stop 1
  47     if (before(2) .NE. after(2)) stop 2
  48
  49     before(1) = LBOUND(buf2,1)
  50     before(2) = UBOUND(buf2,1)
  51     CALL dummy (buf2)
  52     after(1) = LBOUND(buf2,1)
  53     after(2) = UBOUND(buf2,1)
  54
  55     if (before(1) .NE. after(1)) stop 3
  56     if (before(2) .NE. after(2)) stop 4
  57
  58 END PROGRAM