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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [g77/] [20010216-1.f] - Blame information for rev 841

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

Line No. Rev Author Line
1 149 jeremybenn
C Test for bug in reg-stack handling conditional moves.
2
C Reported by Tim Prince <tprince@computer.org>
3
C
4
C { dg-do run { target { { i[6789]86-*-* x86_64-*-* } && ilp32 } } }
5
C { dg-options "-ffast-math -march=pentiumpro" }
6
 
7
      double precision function foo(x, y)
8
         implicit none
9
         double precision x, y
10
         double precision a, b, c, d
11
         if (x /= y) then
12
             if (x * y >= 0) then
13
                 a = abs(x)
14
                 b = abs(y)
15
                 c = max(a, b)
16
                 d = min(a, b)
17
                 foo = 1 - d/c
18
             else
19
                 foo = 1
20
             end if
21
         else
22
             foo = 0
23
         end if
24
      end
25
 
26
      program test
27
      implicit none
28
 
29
      integer ntests
30
      parameter (ntests=7)
31
      double precision tolerance
32
      parameter (tolerance=1.0D-6)
33
 
34
C Each column is a pair of values to feed to foo,
35
C and its expected return value.
36
      double precision a(ntests), b(ntests), x(ntests)
37
      data a /1, -23, -1,   1,   9,  10,  -9/
38
      data b /1, -23, 12, -12,  10,   9, -10/
39
      data x /0,   0,  1,   1, 0.1, 0.1, 0.1/
40
 
41
      double precision foo
42
      double precision result
43
      integer i
44
 
45
      do i = 1, ntests
46
         result = foo(a(i), b(i))
47
         if (abs(result - x(i)) > tolerance) then
48
           print *, i, a(i), b(i), x(i), result
49
           call abort
50
         end if
51
      end do
52
      end

powered by: WebSVN 2.1.0

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