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 6module impl 7 implicit REAL (A-Z) 8 volatile :: x 9end module impl 10 11module one 12 implicit none 13 logical :: l, lv 14 volatile :: lv 15contains 16 subroutine test1(cmp) 17 logical :: cmp 18 volatile :: l, lv 19 if (l .neqv. cmp) call abort() 20 if (lv .neqv. cmp) call abort() 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) call abort() 28 if (lv .neqv. cmp) call abort() 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 34end module one 35 36module two 37 use :: one 38 implicit none 39 volatile :: lv,l 40contains 41 subroutine test1t(cmp) 42 logical :: cmp 43 volatile :: l, lv 44 if (l .neqv. cmp) call abort() 45 if (lv .neqv. cmp) call abort() 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) call abort() 54 if (lv .neqv. cmp) call abort() 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 60end module two 61 62program 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.) 79contains 80 subroutine test1m(cmp) 81 use :: one 82 logical :: cmp 83 volatile :: lm,lmv 84 if(lm .neqv. cmp) call abort() 85 if(lmv .neqv. cmp) call abort() 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) call abort 111 if(lmv .neqv. cmp) call abort() 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 133end 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" } } 148