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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [aliasing_dummy_4.f90] - Blame information for rev 154

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
! { dg-do run }
2
! This tests the fix for PR29315, in which array components of derived type arrays were
3
! not correctly passed to procedures because of a fault in the function that detects
4
! these references that do not have the span of a natural type.
5
!
6
! Contributed by Stephen Jeffrey  
7
!
8
program  test_f90
9
 
10
    integer, parameter :: N = 2
11
 
12
    type test_type
13
        integer a(N, N)
14
    end type
15
 
16
    type (test_type) s(N, N)
17
 
18
    forall (l = 1:N, m = 1:N) &
19
        s(l, m)%a(:, :) = reshape ([((i*l + 10*j*m +100, i = 1, N), j = 1, N)], [N, N])
20
 
21
    call test_sub(s%a(1, 1), 1000) ! Test the original problem.
22
 
23
    if ( any (s(1, 1)%a(:, :) /= reshape ([1111, 112, 121, 122], [2, 2]))) call abort ()
24
    if ( any (s(1, 2)%a(:, :) /= reshape ([1121, 122, 141, 142], [2, 2]))) call abort ()
25
    if ( any (s(2, 1)%a(:, :) /= reshape ([1112, 114, 122, 124], [2, 2]))) call abort ()
26
    if ( any (s(2, 2)%a(:, :) /= reshape ([1122, 124, 142, 144], [2, 2]))) call abort ()
27
 
28
    call test_sub(s(1, 1)%a(:, :), 1000)  ! Check "normal" references.
29
 
30
    if ( any (s(1, 1)%a(:, :) /= reshape ([2111,1112,1121,1122], [2, 2]))) call abort ()
31
    if ( any (s(1, 2)%a(:, :) /= reshape ([1121, 122, 141, 142], [2, 2]))) call abort ()
32
    if ( any (s(2, 1)%a(:, :) /= reshape ([1112, 114, 122, 124], [2, 2]))) call abort ()
33
    if ( any (s(2, 2)%a(:, :) /= reshape ([1122, 124, 142, 144], [2, 2]))) call abort ()
34
contains
35
  subroutine test_sub(array, offset)
36
    integer array(:, :), offset
37
 
38
    forall (i = 1:N, j = 1:N) &
39
        array(i, j) = array(i, j) + offset
40
  end subroutine
41
end program
42
 

powered by: WebSVN 2.1.0

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