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

Subversion Repositories openrisc

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

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

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! { dg-options "-std=legacy" }
3
!
4
! Program to test character array constructors.
5
! PR17144
6
subroutine test1 (n, t, u)
7
  integer n
8
  character(len=n) :: s(2)
9
  character(len=*) :: t
10
  character(len=*) :: u
11
 
12
  ! A variable array constructor.
13
  s = (/t, u/)
14
  ! An array constructor as part of an expression.
15
  if (any (s .ne. (/"Hell", "Worl"/))) call abort
16
end subroutine
17
 
18
subroutine test2
19
  character*5 :: s(2)
20
 
21
  ! A constant array constructor
22
  s = (/"Hello", "World"/)
23
  if ((s(1) .ne. "Hello") .or. (s(2) .ne. "World")) call abort
24
end subroutine
25
 
26
subroutine test3
27
  character*1 s(26)
28
  character*26 t
29
  integer i
30
 
31
  ! A large array constructor
32
  s = (/'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', &
33
        'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z'/)
34
  do i=1, 26
35
    t(i:i) = s(i)
36
  end do
37
 
38
  ! Assignment with dependency
39
  s = (/(s(27-i), i=1, 26)/)
40
  do i=1, 26
41
    t(i:i) = s(i)
42
  end do
43
  if (t .ne. "zyxwvutsrqponmlkjihgfedcba") call abort
44
end subroutine
45
 
46
program string_ctor_1
47
  call test1 (4, "Hello", "World")
48
  call test2
49
  call test3
50
end program
51
 

powered by: WebSVN 2.1.0

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