summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/dependency_25.f90
blob: 25769857d767226445e2b5843c9e49a88c574513 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
! { dg-do run }
! Test the fix for PR42736, in which an excessively rigorous dependency
! checking for the assignment generated an unnecessary temporary, whose
! rank was wrong.  When accessed by the scalarizer, a segfault ensued.
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
! Reported by Armelius Cameron <armeliusc@gmail.com>
!
module UnitValue_Module

  implicit none
  private

  public :: &
    operator(*), &
    assignment(=)

  type, public :: UnitValue
    real :: &
      Value = 1.0
    character(31) :: &
      Label
  end type UnitValue

  interface operator(*)
    module procedure ProductReal_LV
  end interface operator(*)

  interface assignment(=)
    module procedure Assign_LV_Real
  end interface assignment(=)

contains

  elemental function ProductReal_LV(Multiplier, Multiplicand) result(P_R_LV)

    real, intent(in) :: &
      Multiplier
    type(UnitValue), intent(in) :: &
      Multiplicand
    type(UnitValue) :: &
      P_R_LV

    P_R_LV%Value = Multiplier * Multiplicand%Value
    P_R_LV%Label = Multiplicand%Label

  end function ProductReal_LV


  elemental subroutine Assign_LV_Real(LeftHandSide, RightHandSide)

    real, intent(inout) :: &
      LeftHandSide
    type(UnitValue), intent(in) :: &
      RightHandSide

    LeftHandSide = RightHandSide%Value

  end subroutine Assign_LV_Real

end module UnitValue_Module

program TestProgram

  use UnitValue_Module

  implicit none

  type :: TableForm
    real, dimension(:,:), allocatable :: &
      RealData
  end type TableForm

  type(UnitValue) :: &
    CENTIMETER

  type(TableForm), pointer :: &
    Table

  allocate(Table)
  allocate(Table%RealData(10,5))

  CENTIMETER%value = 42
  Table%RealData = 1
  Table%RealData(:,1) = Table%RealData(:,1) * CENTIMETER
  Table%RealData(:,2) = Table%RealData(:,2) * CENTIMETER
  Table%RealData(:,3) = Table%RealData(:,3) * CENTIMETER
  Table%RealData(:,5) = Table%RealData(:,5) * CENTIMETER

!  print *, Table%RealData
  if (any (abs(Table%RealData(:,4) - 1) > epsilon(1.0))) call abort ()
  if (any (abs(Table%RealData(:,[1,2,3,5]) - 42) > epsilon(1.0))) call abort ()
end program TestProgram

! { dg-final { cleanup-modules "UnitValue_Module" } }