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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [alloc_comp_assign_8.f90] - Blame information for rev 312

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run }
2
!
3
! Test the fix for PR35824, in which the interface assignment and
4
! negation did not work correctly.
5
!
6
! Contributed by Rolf Roth 
7
!
8
module typemodule
9
  type alltype
10
     double precision :: a
11
     double precision,allocatable :: b(:)
12
  end type
13
  interface assignment(=)
14
    module procedure at_from_at
15
  end interface
16
  interface operator(-)
17
    module procedure  neg_at
18
  end interface
19
contains
20
  subroutine at_from_at(b,a)
21
    type(alltype), intent(in) :: a
22
    type(alltype), intent(out) :: b
23
    b%a=a%a
24
    allocate(b%b(2))
25
    b%b=a%b
26
  end subroutine at_from_at
27
  function neg_at(a) result(b)
28
    type(alltype), intent(in) :: a
29
    type(alltype) :: b
30
    b%a=-a%a
31
    allocate(b%b(2))
32
    b%b=-a%b
33
  end function neg_at
34
end module
35
  use typemodule
36
  type(alltype) t1,t2,t3
37
  allocate(t1%b(2))
38
  t1%a=0.5d0
39
  t1%b(1)=1d0
40
  t1%b(2)=2d0
41
  t2=-t1
42
  if (t2%a .ne. -0.5d0) call abort
43
  if (any(t2%b .ne. [-1d0, -2d0])) call abort
44
 
45
  t1=-t1
46
  if (t1%a .ne. -0.5d0) call abort
47
  if (any(t1%b .ne. [-1d0, -2d0])) call abort
48
end
49
 
50
! { dg-final { cleanup-modules "typemodule" } }

powered by: WebSVN 2.1.0

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