gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90

   1 ! { dg-do compile }
   2 !
   3 ! Testcases from PR32002.
   4 !
   5 PROGRAM test_pr32002
   6
   7   CALL test_1()                       ! scalar/vector
   8   CALL test_2()                       ! vector/vector
   9   CALL test_3()                       ! matrix/vector
  10   CALL test_4()                       ! matrix/matrix
  11
  12 CONTAINS
  13   ELEMENTAL FUNCTION f(x)
  14     INTEGER, INTENT(in) :: x
  15     INTEGER :: f
  16     f = x
  17   END FUNCTION
  18
  19   SUBROUTINE test_1()
  20     INTEGER :: a = 0, b(2) = 0
  21     a = f(b)                          ! { dg-error "Incompatible ranks" }
  22     b = f(a)                          ! ok, set all array elements to f(a)
  23   END SUBROUTINE
  24
  25   SUBROUTINE test_2()
  26     INTEGER :: a(2) = 0, b(3) = 0
  27     a = f(b)                          ! { dg-error "Different shape" }
  28     a = f(b(1:2))                     ! ok, slice, stride 1
  29     a = f(b(1:3:2))                   ! ok, slice, stride 2
  30   END SUBROUTINE
  31
  32   SUBROUTINE test_3()
  33     INTEGER :: a(4) = 0, b(2,2) = 0
  34     a = f(b)                          ! { dg-error "Incompatible ranks" }
  35     a = f(RESHAPE(b, (/ 4 /)))        ! ok, same shape
  36   END SUBROUTINE
  37
  38   SUBROUTINE test_4()
  39     INTEGER :: a(2,2) = 0, b(3,3) = 0
  40     a = f(b)                          ! { dg-error "Different shape" }
  41     a = f(b(1:3, 1:2))                ! { dg-error "Different shape" }
  42     a = f(b(1:3:2, 1:3:2))            ! ok, same shape
  43   END SUBROUTINE
  44 END PROGRAM