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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [forall_4.f90] - Blame information for rev 823

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

Line No. Rev Author Line
1 149 jeremybenn
! { dg-do run }
2
! Tests the fix for PR25072, in which mask expressions
3
! that start with an internal or intrinsic function
4
! reference would give a syntax error.
5
!
6
! The fix for PR28119 is tested as well; here, the forall
7
! statement could not be followed by another statement on
8
! the same line.
9
!
10
! Contributed by Paul Thomas  
11
!
12
module foo
13
  integer, parameter :: n = 4
14
contains
15
  pure logical function foot (i)
16
    integer, intent(in) :: i
17
    foot = (i == 2) .or. (i == 3)
18
  end function foot
19
end module foo
20
 
21
  use foo
22
  integer :: i, a(n)
23
  logical :: s(n)
24
  s = (/(foot (i), i=1, n)/)
25
 
26
! Check that non-mask case is still OK and the fix for PR28119
27
  a = 0
28
  forall (i=1:n) a(i) = i ; if (any (a .ne. (/1,2,3,4/))) call abort ()
29
 
30
! Now a mask using a function with an explicit interface
31
! via use association.
32
  a = 0
33
  forall (i=1:n, foot (i)) a(i) = i
34
  if (any (a .ne. (/0,2,3,0/))) call abort ()
35
 
36
! Now an array variable mask
37
  a = 0
38
  forall (i=1:n, .not. s(i)) a(i) = i
39
  if (any (a .ne. (/1,0,0,4/))) call abort ()
40
 
41
! This was the PR - an internal function mask
42
  a = 0
43
  forall (i=1:n, t (i)) a(i) = i
44
  if (any (a .ne. (/0,2,0,4/))) call abort ()
45
 
46
! Check that an expression is OK - this also gave a syntax
47
! error
48
  a = 0
49
  forall (i=1:n, mod (i, 2) == 0) a(i) = i
50
  if (any (a .ne. (/0,2,0,4/))) call abort ()
51
 
52
! And that an expression that used to work is OK
53
  a = 0
54
  forall (i=1:n, s (i) .or. t(i)) a(i) = w (i)
55
  if (any (a .ne. (/0,3,2,1/))) call abort ()
56
 
57
contains
58
  pure logical function t(i)
59
    integer, intent(in) :: i
60
    t = (mod (i, 2) == 0)
61
  end function t
62
  pure integer function w(i)
63
    integer, intent(in) :: i
64
    w = 5 - i
65
  end function w
66
end
67
! { dg-final { cleanup-modules "foo" } }

powered by: WebSVN 2.1.0

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