gcc/testsuite/gfortran.dg/dependency_25.f90

   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
  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 ()
  93 end program TestProgram
  94
  95 ! { dg-final { cleanup-modules "UnitValue_Module" } }