1! { dg-do compile }
2! { dg-options "-Warray-temporaries" }
3! PR 48231 - this used to create an unnecessary temporary.
4module UnitValue_Module
5  type :: UnitValue
6    real          :: Value = 1.0
7  end type
8
9  interface operator(*)
10    module procedure ProductReal_LV
11  end interface operator(*)
12
13  interface assignment(=)
14    module procedure Assign_LV_Real
15  end interface assignment(=)
16contains
17
18  elemental function ProductReal_LV(Multiplier, Multiplicand) result(P_R_LV)
19    real, intent(in)            :: Multiplier
20    type(UnitValue), intent(in) :: Multiplicand
21    type(UnitValue)             :: P_R_LV
22    P_R_LV%Value = Multiplier * Multiplicand%Value
23  end function ProductReal_LV
24
25  elemental subroutine Assign_LV_Real(LeftHandSide, RightHandSide)
26    real, intent(inout)         :: LeftHandSide
27    type(UnitValue), intent(in) :: RightHandSide
28    LeftHandSide = RightHandSide%Value
29  end subroutine Assign_LV_Real
30end module UnitValue_Module
31
32program TestProgram
33  use UnitValue_Module
34
35  type :: TableForm
36    real, dimension(:,:), allocatable :: RealData
37  end type TableForm
38
39  REAL :: CENTIMETER
40  type(TableForm), pointer :: Table
41
42  allocate(Table)
43  allocate(Table%RealData(10,5))
44
45  CENTIMETER = 42
46  Table%RealData = 1
47  Table%RealData(:,1) = Table%RealData(:,1) * CENTIMETER
48end program TestProgram
49