1! { dg-do run } 2! Tests the fic for PR44582, where gfortran was found to 3! produce an incorrect result when the result of a function 4! was aliased by a host or use associated variable, to which 5! the function is assigned. In these cases a temporary is 6! required in the function assignments. The check has to be 7! rather restrictive. Whilst the cases marked below might 8! not need temporaries, the TODOs are going to be tough. 9! 10! Reported by Yin Ma <yin@absoft.com> and 11! elaborated by Tobias Burnus <burnus@gcc.gnu.org> 12! 13module foo 14 INTEGER, PARAMETER :: ONE = 1 15 INTEGER, PARAMETER :: TEN = 10 16 INTEGER, PARAMETER :: FIVE = TEN/2 17 INTEGER, PARAMETER :: TWO = 2 18 integer :: foo_a(ONE) 19 integer :: check(ONE) = TEN 20 LOGICAL :: abort_flag = .false. 21contains 22 function foo_f() 23 integer :: foo_f(ONE) 24 foo_f = -FIVE 25 foo_f = foo_a - foo_f 26 end function foo_f 27 subroutine bar 28 foo_a = FIVE 29! This aliases 'foo_a' by host association. 30 foo_a = foo_f () 31 if (any (foo_a .ne. check)) call myabort (0) 32 end subroutine bar 33 subroutine myabort(fl) 34 integer :: fl 35 print *, fl 36 abort_flag = .true. 37 end subroutine myabort 38end module foo 39 40function h_ext() 41 use foo 42 integer :: h_ext(ONE) 43 h_ext = -FIVE 44 h_ext = FIVE - h_ext 45end function h_ext 46 47function i_ext() result (h) 48 use foo 49 integer :: h(ONE) 50 h = -FIVE 51 h = FIVE - h 52end function i_ext 53 54subroutine tobias 55 use foo 56 integer :: a(ONE) 57 a = FIVE 58 call sub1(a) 59 if (any (a .ne. check)) call myabort (1) 60contains 61 subroutine sub1(x) 62 integer :: x(ONE) 63! 'x' is aliased by host association in 'f'. 64 x = f() 65 end subroutine sub1 66 function f() 67 integer :: f(ONE) 68 f = ONE 69 f = a + FIVE 70 end function f 71end subroutine tobias 72 73program test 74 use foo 75 implicit none 76 common /foo_bar/ c 77 integer :: a(ONE), b(ONE), c(ONE), d(ONE) 78 interface 79 function h_ext() 80 use foo 81 integer :: h_ext(ONE) 82 end function h_ext 83 end interface 84 interface 85 function i_ext() result (h) 86 use foo 87 integer :: h(ONE) 88 end function i_ext 89 end interface 90 91 a = FIVE 92! This aliases 'a' by host association 93 a = f() 94 if (any (a .ne. check)) call myabort (2) 95 a = FIVE 96 if (any (f() .ne. check)) call myabort (3) 97 call bar 98 foo_a = FIVE 99! This aliases 'foo_a' by host association. 100 foo_a = g () 101 if (any (foo_a .ne. check)) call myabort (4) 102 a = FIVE 103 a = h() ! TODO: Needs no temporary 104 if (any (a .ne. check)) call myabort (5) 105 a = FIVE 106 a = i() ! TODO: Needs no temporary 107 if (any (a .ne. check)) call myabort (6) 108 a = FIVE 109 a = h_ext() ! Needs no temporary - was OK 110 if (any (a .ne. check)) call myabort (15) 111 a = FIVE 112 a = i_ext() ! Needs no temporary - was OK 113 if (any (a .ne. check)) call myabort (16) 114 c = FIVE 115! This aliases 'c' through the common block. 116 c = j() 117 if (any (c .ne. check)) call myabort (7) 118 call aaa 119 call tobias 120 if (abort_flag) call abort 121contains 122 function f() 123 integer :: f(ONE) 124 f = -FIVE 125 f = a - f 126 end function f 127 function g() 128 integer :: g(ONE) 129 g = -FIVE 130 g = foo_a - g 131 end function g 132 function h() 133 integer :: h(ONE) 134 h = -FIVE 135 h = FIVE - h 136 end function h 137 function i() result (h) 138 integer :: h(ONE) 139 h = -FIVE 140 h = FIVE - h 141 end function i 142 function j() 143 common /foo_bar/ cc 144 integer :: j(ONE), cc(ONE) 145 j = -FIVE 146 j = cc - j 147 end function j 148 subroutine aaa() 149 d = TEN - TWO 150! This aliases 'd' through 'get_d'. 151 d = bbb() 152 if (any (d .ne. check)) call myabort (8) 153 end subroutine aaa 154 function bbb() 155 integer :: bbb(ONE) 156 bbb = TWO 157 bbb = bbb + get_d() 158 end function bbb 159 function get_d() 160 integer :: get_d(ONE) 161 get_d = d 162 end function get_d 163end program test 164