50 lines · plain
1! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s2module overrides3 type realResult4 real a5 end type6 interface operator(*)7 procedure :: multHostDevice, multDeviceHost8 end interface9 interface assignment(=)10 procedure :: assignHostResult, assignDeviceResult11 end interface12 contains13 elemental function multHostDevice(x, y) result(result)14 real, intent(in) :: x15 real, intent(in), device :: y16 type(realResult) result17 result%a = x * y18 end19 elemental function multDeviceHost(x, y) result(result)20 real, intent(in), device :: x21 real, intent(in) :: y22 type(realResult) result23 result%a = x * y24 end25 elemental subroutine assignHostResult(lhs, rhs)26 real, intent(out) :: lhs27 type(realResult), intent(in) :: rhs28 lhs = rhs%a29 end30 elemental subroutine assignDeviceResult(lhs, rhs)31 real, intent(out), device :: lhs32 type(realResult), intent(in) :: rhs33 lhs = rhs%a34 end35end36 37program p38 use overrides39 real, device :: da, db40 real :: ha, hb41!CHECK: CALL assigndeviceresult(db,multhostdevice(2._4,da))42 db = 2. * da43!CHECK: CALL assigndeviceresult(db,multdevicehost(da,2._4))44 db = da * 2.45!CHECK: CALL assignhostresult(ha,multhostdevice(2._4,da))46 ha = 2. * da47!CHECK: CALL assignhostresult(ha,multdevicehost(da,2._4))48 ha = da * 2.49end50