|
111
|
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 !
|
|
|
9 module 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
|
|
|
33 contains
|
|
|
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
|
|
|
61 end module UnitValue_Module
|
|
|
62
|
|
|
63 program 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
|
|
131
|
91 if (any (abs(Table%RealData(:,4) - 1) > epsilon(1.0))) STOP 1
|
|
|
92 if (any (abs(Table%RealData(:,[1,2,3,5]) - 42) > epsilon(1.0))) STOP 2
|
|
111
|
93 end program TestProgram
|
