gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90

   1 !==================assumed_size_refs_1.f90==================
   2 ! { dg-do compile }
   3 ! Test the fix for PR25029, PR21256 in which references to
   4 ! assumed size arrays without an upper bound to the last
   5 ! dimension were generating no error. The first version of
   6 ! the patch failed in DHSEQR, as pointed out by Toon Moene
   7 ! in http://gcc.gnu.org/ml/fortran/2005-12/msg00466.html
   8 !
   9 ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
  10 !
  11 program assumed_size_test_1
  12   implicit none
  13   real a(2, 4)
  14
  15   a = 1.0
  16   call foo (a)
  17
  18 contains
  19   subroutine foo(m)
  20     real, target :: m(1:2, *)
  21     real x(2,2,2)
  22     real, external :: bar
  23     real, pointer :: p(:,:), q(:,:)
  24     allocate (q(2,2))
  25
  26 ! PR25029
  27     p => m                     ! { dg-error "upper bound in the last dimension" }
  28     q = m                      ! { dg-error "upper bound in the last dimension" }
  29
  30 ! PR21256( and PR25060)
  31     m = 1                      ! { dg-error "upper bound in the last dimension" }
  32
  33     m(1,1) = 2.0
  34     x = bar (m)
  35     x = fcn (m)                ! { dg-error "upper bound in the last dimension" }
  36     m(:, 1:2) = fcn (q)
  37     call sub (m, x)            ! { dg-error "upper bound in the last dimension" }
  38     call sub (m(1:2, 1:2), x)  ! { dg-error "Incompatible ranks in elemental procedure" }
  39     print *, p
  40
  41     call DHSEQR(x)
  42
  43   end subroutine foo
  44
  45   elemental function fcn (a) result (b)
  46     real, intent(in) :: a
  47     real :: b
  48     b = 2.0 * a
  49   end function fcn
  50
  51   elemental subroutine sub (a, b)
  52     real, intent(inout) :: a, b
  53     b = 2.0 * a
  54   end subroutine sub
  55
  56   SUBROUTINE DHSEQR( WORK )
  57     REAL WORK( * )
  58     EXTERNAL           DLARFX
  59     INTRINSIC          MIN
  60     WORK( 1 ) = 1.0
  61     CALL DLARFX( MIN( 1, 8 ), WORK )
  62   END SUBROUTINE DHSEQR
  63
  64 end program assumed_size_test_1