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