gcc/testsuite/gfortran.dg/contiguous_10.f90

   1 ! { dg-do run }
   2 ! { dg-additional-options "-fdump-tree-original" }
   3 !
   4 ! PR fortran/91640
   5 !
   6 ! Based on G. Steinmetz's test case
   7 !
   8 program p
   9    implicit none (type, external)
  10    real, target :: z(3) = 1.0
  11    real :: res(3)
  12    real, pointer :: xxx(:)
  13
  14    res = 42.0
  15    call sub (-z, res)
  16    if (any (abs (res - (-1.0)) > epsilon(res))) stop 1
  17    if (any (abs (z - 1.0) > epsilon(z))) stop 2
  18
  19    res = 43.0
  20    call sub (z*2.0, res)
  21    if (any (abs (res - 2.0) > epsilon(res))) stop 3
  22    if (any (abs (z - 1.0) > epsilon(z))) stop 4
  23
  24    res = 44.0
  25    call sub(get_var(), res)
  26    if (any (abs (res - 1.0) > epsilon(res))) stop 5
  27    if (any (abs (z - 1.0) > epsilon(z))) stop 6
  28
  29    call double(get_var())
  30    if (any (abs (z - 2.0) > epsilon(z))) stop 7
  31
  32    call double(get_var_cont())
  33    if (any (abs (z - 4.0) > epsilon(z))) stop 8
  34
  35    ! For cross check for copy-out:
  36    xxx => z
  37    if (any (abs (z - 4.0) > epsilon(z))) stop 10
  38    if (any (abs (xxx - 4.0) > epsilon(z))) stop 11
  39    call double (xxx)
  40    if (any (abs (z - 8.0) > epsilon(z))) stop 12
  41    if (any (abs (xxx - 8.0) > epsilon(z))) stop 13
  42
  43 contains
  44    subroutine sub (x, res)
  45       real, contiguous :: x(:)
  46       real :: res(3)
  47       res = x
  48    end
  49    subroutine double (x)
  50       real, contiguous :: x(:)
  51       x = x * 2.0
  52    end
  53    function get_var()
  54      real, pointer :: get_var(:)
  55      get_var => z
  56    end
  57    function get_var_cont()
  58      real, pointer, contiguous :: get_var_cont(:)
  59      get_var_cont => z
  60    end
  61 end
  62
  63 ! only 'xxx' should have a copy out:
  64 ! { dg-final { scan-tree-dump-times "D\\.\[0-9\].* = .*atmp\\.\[0-9\]*\\.data" 1 "original" } }
  65 ! { dg-final { scan-tree-dump-times "D\\.\[0-9\].*xxx\\.span.* = .*atmp\\.\[0-9\]*\\.data" 1 "original" } }
  66
  67 ! Only once 'z... = ' – for:   static real(kind=4) z[3] = {[0 ... 2]=1.0e+0};
  68 ! but don't match '(si)ze'
  69 ! { dg-final { scan-tree-dump-times "z\[^e\].* = " 1 "original" } }