OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [typebound_operator_12.f03] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! PR51634 - Handle allocatable components correctly in expressions
3
! involving typebound operators. See comment 2 of PR.
4
!
5
! Reported by Tobias Burnus  
6
!
7
module soop_stars_class
8
  implicit none
9
  type soop_stars
10
    real, dimension(:), allocatable :: position,velocity
11
  contains
12
    procedure :: total
13
    procedure :: product
14
    generic :: operator(+) => total
15
    generic :: operator(*) => product
16
  end type
17
contains
18
  type(soop_stars) function product(lhs,rhs)
19
    class(soop_stars) ,intent(in) :: lhs
20
    real ,intent(in) :: rhs
21
    product%position = lhs%position*rhs
22
    product%velocity = lhs%velocity*rhs
23
  end function
24
 
25
  type(soop_stars) function total(lhs,rhs)
26
    class(soop_stars) ,intent(in) :: lhs,rhs
27
    total%position = lhs%position + rhs%position
28
    total%velocity = lhs%velocity + rhs%velocity
29
  end function
30
end module
31
 
32
program main
33
  use soop_stars_class ,only : soop_stars
34
  implicit none
35
  type(soop_stars) :: fireworks
36
  real :: dt
37
  fireworks%position = [1,2,3]
38
  fireworks%velocity = [4,5,6]
39
  dt = 5
40
  fireworks = fireworks + fireworks*dt
41
  if (any (fireworks%position .ne. [6, 12, 18])) call abort
42
  if (any (fireworks%velocity .ne. [24, 30, 36])) call abort
43
end program
44
! { dg-final { cleanup-modules "soop_stars_class" } }
45
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.