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/] [array-1.f90] - Blame information for rev 199

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

Line No. Rev Author Line
1 149 jeremybenn
! { dg-do run }
2
! PR 15553 : the array used to be filled with garbage
3
! this problem disappeared between 2004-05-20 and 2004-09-15
4
program arrpack
5
  implicit none
6
 
7
  double precision x(10,10)
8
  integer i, j
9
 
10
  x = -1
11
  do i=1,6
12
     do j=1,5
13
        x(i,j) = i+j*10
14
     end do
15
  end do
16
  call pack (x, 6, 5)
17
 
18
  if (any(reshape(x(1:10,1:3), (/ 30 /)) &
19
          /= (/ 11, 12, 13, 14, 15, 16,  &
20
                21, 22, 23, 24, 25, 26,  &
21
                31, 32, 33, 34, 35, 36,  &
22
                41, 42, 43, 44, 45, 46,  &
23
                51, 52, 53, 54, 55, 56 /))) call abort ()
24
 
25
contains
26
 
27
  subroutine pack (arr, ni, nj)
28
    integer, intent(in) :: ni, nj
29
    double precision, intent(inout) :: arr(:,:)
30
    double precision :: tmp(ni,nj)
31
    tmp(:,:) = arr(1:ni, 1:nj)
32
    call copy (arr, tmp, ni, nj)
33
  end subroutine pack
34
 
35
  subroutine copy (dst, src, ni, nj)
36
    integer, intent(in) :: ni, nj
37
    double precision, intent(out) :: dst(ni, nj)
38
    double precision, intent(in)  :: src(ni, nj)
39
    dst = src
40
  end subroutine copy
41
 
42
end program arrpack

powered by: WebSVN 2.1.0

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