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/] [dependency_24.f90] - Blame information for rev 414

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

Line No. Rev Author Line
1 302 jeremybenn 
! { dg-do run }
2 
! Check the fix for PR38863 comment #1, where defined assignment
3 
! to derived types was not treating components correctly that were
4 
! not set explicitly.
5 
!
6 
! Contributed by Mikael Morin
7 
!
8 
module m
9 
  type t
10 
    integer :: i,j
11 
  end type t
12 
  type ti
13 
    integer :: i,j = 99
14 
  end type ti
15 
  interface assignment (=)
16 
    module procedure i_to_t, i_to_ti
17 
  end interface
18 
contains
19 
  elemental subroutine i_to_ti (p, q)
20 
    type(ti), intent(out) :: p
21 
    integer, intent(in)  :: q
22 
    p%i = q
23 
  end subroutine
24 
  elemental subroutine i_to_t (p, q)
25 
    type(t), intent(out) :: p
26 
    integer, intent(in)  :: q
27 
    p%i = q
28 
  end subroutine
29 
end module
30 
 
31 
  use m
32 
  call test_t  ! Check original problem
33 
  call test_ti ! Default initializers were treated wrongly
34 
contains
35 
  subroutine test_t
36 
    type(t), target :: a(3)
37 
    type(t), target  :: b(3)
38 
    type(t), dimension(:), pointer :: p
39 
    logical :: l(3)
40 
 
41 
    a%i = 1
42 
    a%j = [101, 102, 103]
43 
    b%i = 3
44 
    b%j = 4
45 
 
46 
    p => b
47 
    l = .true.
48 
 
49 
    where (l)
50 
      a = p%i         ! Comment #1 of PR38863 concerned WHERE assignment
51 
    end where
52 
    if (any (a%j .ne. [101, 102, 103])) call abort
53 
 
54 
    a = p%i           ! Ordinary assignment was wrong too.
55 
    if (any (a%j .ne. [101, 102, 103])) call abort
56 
  end subroutine
57 
 
58 
  subroutine test_ti
59 
    type(ti), target :: a(3)
60 
    type(ti), target  :: b(3)
61 
    type(ti), dimension(:), pointer :: p
62 
    logical :: l(3)
63 
 
64 
    a%i = 1
65 
    a%j = [101, 102, 103]
66 
    b%i = 3
67 
    b%j = 4
68 
 
69 
    p => b
70 
    l = .true.
71 
 
72 
    where (l)
73 
      a = p%i
74 
    end where
75 
    if (any (a%j .ne. 99)) call abort
76 
 
77 
    a = p%i
78 
    if (any (a%j .ne. 99)) call abort
79 
  end subroutine
80 
end
81 
! { dg-final { cleanup-modules "m" } }

powered by: WebSVN 2.1.0

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