gcc/testsuite/gfortran.dg/volatile10.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdump-tree-optimized -O3" }
   3 ! Test setting host-/use-associated variables as VOLATILE
   4 ! PR fortran/30522
   5
   6 module impl
   7   implicit REAL (A-Z)
   8   volatile :: x
   9 end module impl
  10
  11 module one
  12   implicit none
  13   logical :: l, lv
  14   volatile :: lv
  15 contains
  16   subroutine test1(cmp)
  17     logical  :: cmp
  18     volatile :: l, lv
  19     if (l  .neqv. cmp) STOP 1
  20     if (lv .neqv. cmp) STOP 2
  21     l = .false.
  22     lv = .false.
  23     if(l .or. lv) print *, 'one_test1' ! not optimized away
  24   end subroutine test1
  25   subroutine test2(cmp)
  26     logical  :: cmp
  27     if (l  .neqv. cmp) STOP 3
  28     if (lv .neqv. cmp) STOP 4
  29     l = .false.
  30     if(l)  print *, 'one_test2_1' ! optimized away
  31     lv = .false.
  32     if(lv) print *, 'one_test2_2' ! not optimized away
  33   end subroutine test2
  34 end module one
  35
  36 module two
  37   use :: one
  38   implicit none
  39   volatile :: lv,l
  40 contains
  41   subroutine test1t(cmp)
  42     logical  :: cmp
  43     volatile :: l, lv
  44     if (l  .neqv. cmp) STOP 5
  45     if (lv .neqv. cmp) STOP 6
  46     l = .false.
  47     if(l)  print *, 'two_test1_1' ! not optimized away
  48     lv = .false.
  49     if(lv) print *, 'two_test1_2' ! not optimized away
  50   end subroutine test1t
  51   subroutine test2t(cmp)
  52     logical  :: cmp
  53     if (l  .neqv. cmp) STOP 7
  54     if (lv .neqv. cmp) STOP 8
  55     l = .false.
  56     if(l)  print *, 'two_test2_1' ! not optimized away
  57     lv = .false.
  58     if(lv) print *, 'two_test2_2' ! not optimized away
  59   end subroutine test2t
  60 end module two
  61
  62 program main
  63   use :: two, only: test1t, test2t
  64   implicit none
  65   logical :: lm, lmv
  66   volatile :: lmv
  67   lm = .true.
  68   lmv = .true.
  69   call test1m(.true.)
  70   lm = .true.
  71   lmv = .true.
  72   call test2m(.true.)
  73   lm = .false.
  74   lmv = .false.
  75   call test1m(.false.)
  76   lm = .false.
  77   lmv = .false.
  78   call test2m(.false.)
  79 contains
  80   subroutine test1m(cmp)
  81     use :: one
  82     logical  :: cmp
  83     volatile :: lm,lmv
  84     if(lm  .neqv. cmp) STOP 9
  85     if(lmv .neqv. cmp) STOP 10
  86     l  = .false.
  87     lv = .false.
  88     call test1(.false.)
  89     l  = .true.
  90     lv = .true.
  91     call test1(.true.)
  92     lm  = .false.
  93     lmv = .false.
  94     if(lm .or. lmv) print *, 'main_test1_1' ! not optimized away
  95     l   = .false.
  96     if(l)  print *, 'main_test1_2'          ! optimized away
  97     lv  = .false.
  98     if(lv) print *, 'main_test1_3'          ! not optimized away
  99     l  = .false.
 100     lv = .false.
 101     call test2(.false.)
 102     l  = .true.
 103     lv = .true.
 104     call test2(.true.)
 105   end subroutine test1m
 106   subroutine test2m(cmp)
 107     use :: one
 108     logical  :: cmp
 109     volatile :: lv
 110     if(lm .neqv. cmp) STOP 1
 111     if(lmv .neqv. cmp) STOP 11
 112     l  = .false.
 113     lv = .false.
 114     call test1(.false.)
 115     l  = .true.
 116     lv = .true.
 117     call test1(.true.)
 118     lm  = .false.
 119     if(lm) print *, 'main_test2_1' ! not optimized away
 120     lmv = .false.
 121     if(lmv)print *, 'main_test2_2' ! not optimized away
 122     l   = .false.
 123     if(l)  print *, 'main_test2_3' ! optimized away
 124     lv  = .false.
 125     if(lv) print *, 'main_test2_4' ! not optimized away
 126     l  = .false.
 127     lv = .false.
 128     call test2(.false.)
 129     l  = .true.
 130     lv = .true.
 131     call test2(.true.)
 132   end subroutine test2m
 133 end program main
 134
 135 ! { dg-final { scan-tree-dump      "one_test1"   "optimized" } }
 136 ! TODO: dg-final { scan-tree-dump-not  "one_test2_1" "optimized" }
 137 ! { dg-final { scan-tree-dump      "one_test2_2" "optimized" } }
 138 ! { dg-final { scan-tree-dump      "one_test2_2" "optimized" } }
 139 ! { dg-final { scan-tree-dump      "two_test2_1" "optimized" } }
 140 ! { dg-final { scan-tree-dump      "two_test2_2" "optimized" } }
 141 ! { dg-final { scan-tree-dump      "main_test1_1" "optimized" } }
 142 ! TODO: dg-final { scan-tree-dump-not  "main_test1_2" "optimized" }
 143 ! { dg-final { scan-tree-dump      "main_test1_3" "optimized" } }
 144 ! { dg-final { scan-tree-dump      "main_test2_1" "optimized" } }
 145 ! { dg-final { scan-tree-dump      "main_test2_2" "optimized" } }
 146 ! TODO: dg-final { scan-tree-dump-not  "main_test2_3" "optimized" }
 147 ! { dg-final { scan-tree-dump      "main_test2_4" "optimized" } }