1! { dg-do run } 2! Test the fix for PR42736, in which an excessively rigorous dependency 3! checking for the assignment generated an unnecessary temporary, whose 4! rank was wrong. When accessed by the scalarizer, a segfault ensued. 5! 6! Contributed by Tobias Burnus <burnus@gcc.gnu.org> 7! Reported by Armelius Cameron <armeliusc@gmail.com> 8! 9module UnitValue_Module 10 11 implicit none 12 private 13 14 public :: & 15 operator(*), & 16 assignment(=) 17 18 type, public :: UnitValue 19 real :: & 20 Value = 1.0 21 character(31) :: & 22 Label 23 end type UnitValue 24 25 interface operator(*) 26 module procedure ProductReal_LV 27 end interface operator(*) 28 29 interface assignment(=) 30 module procedure Assign_LV_Real 31 end interface assignment(=) 32 33contains 34 35 elemental function ProductReal_LV(Multiplier, Multiplicand) result(P_R_LV) 36 37 real, intent(in) :: & 38 Multiplier 39 type(UnitValue), intent(in) :: & 40 Multiplicand 41 type(UnitValue) :: & 42 P_R_LV 43 44 P_R_LV%Value = Multiplier * Multiplicand%Value 45 P_R_LV%Label = Multiplicand%Label 46 47 end function ProductReal_LV 48 49 50 elemental subroutine Assign_LV_Real(LeftHandSide, RightHandSide) 51 52 real, intent(inout) :: & 53 LeftHandSide 54 type(UnitValue), intent(in) :: & 55 RightHandSide 56 57 LeftHandSide = RightHandSide%Value 58 59 end subroutine Assign_LV_Real 60 61end module UnitValue_Module 62 63program TestProgram 64 65 use UnitValue_Module 66 67 implicit none 68 69 type :: TableForm 70 real, dimension(:,:), allocatable :: & 71 RealData 72 end type TableForm 73 74 type(UnitValue) :: & 75 CENTIMETER 76 77 type(TableForm), pointer :: & 78 Table 79 80 allocate(Table) 81 allocate(Table%RealData(10,5)) 82 83 CENTIMETER%value = 42 84 Table%RealData = 1 85 Table%RealData(:,1) = Table%RealData(:,1) * CENTIMETER 86 Table%RealData(:,2) = Table%RealData(:,2) * CENTIMETER 87 Table%RealData(:,3) = Table%RealData(:,3) * CENTIMETER 88 Table%RealData(:,5) = Table%RealData(:,5) * CENTIMETER 89 90! print *, Table%RealData 91 if (any (abs(Table%RealData(:,4) - 1) > epsilon(1.0))) call abort () 92 if (any (abs(Table%RealData(:,[1,2,3,5]) - 42) > epsilon(1.0))) call abort () 93end program TestProgram 94