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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! Test assignments of nested derived types with character allocatable
3
! components(PR 20541). Subroutine test_ab6 checks out a bug in a test
4
! version of gfortran's allocatable arrays.
5
!
6
! Contributed by Erik Edelmann  
7
!            and Paul Thomas  
8
!
9
  type :: a
10
    character(4), allocatable :: ch(:)
11
  end type a
12
 
13
  type :: b
14
    type (a), allocatable :: at(:)
15
  end type b
16
 
17
  type(a) :: x(2)
18
  type(b) :: y(2), z(2)
19
 
20
  character(4) :: chr1(4) = (/"abcd","efgh","ijkl","mnop"/)
21
  character(4) :: chr2(4) = (/"qrst","uvwx","yz12","3456"/)
22
 
23
  x(1) = a(chr1)
24
 
25
 ! Check constructor with character array constructors.
26
  x(2) = a((/"qrst","uvwx","yz12","3456"/))
27
 
28
  y(1) = b((/x(1),x(2)/))
29
  y(2) = b((/x(2),x(1)/))
30
 
31
  y(2) = y(1)
32
 
33
  if (any((/((y(2)%at(i)%ch(j),j=1,4),i=1,2)/) .ne. &
34
          (/chr1, chr2/))) call abort ()
35
 
36
  call test_ab6 ()
37
 
38
contains
39
 
40
  subroutine test_ab6 ()
41
! This subroutine tests the presence of a scalar derived type, intermediate
42
! in a chain of derived types with allocatable components.
43
! Contributed by Salvatore Filippone  
44
 
45
    type b
46
      type(a)  :: a
47
    end type b
48
 
49
    type c
50
      type(b), allocatable :: b(:)
51
    end type c
52
 
53
    type(c)    :: p
54
    type(b)   :: bv
55
 
56
    p = c((/b(a((/"Mary","Lamb"/)))/))
57
    bv = p%b(1)
58
 
59
    if (any ((bv%a%ch(:)) .ne. (/"Mary","Lamb"/))) call abort ()
60
 
61
end subroutine test_ab6
62
 
63
end

powered by: WebSVN 2.1.0

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