home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
progmisc
/
euphor10.zip
/
SANITY.EX
< prev
next >
Wrap
Text File
|
1993-06-15
|
15KB
|
739 lines
-- io test
-----------------------------------------
-- AUTOMATIC SELF-CHECKING SANITY TEST --
-- FOR Euphoria --
-----------------------------------------
with type_check
include get.e
include graphics.e
include sort.e
trace(0)
constant msg = 1 -- place to send messages
global object y, i, r
procedure make_sound()
-- test sound() built-in
for i = 500 to 5000 by 500 do
sound(i)
for j = 1 to 100000 do
end for
sound(0)
end for
end procedure
procedure abort()
-- force abort with trace back
puts(msg, "divide by 0 to get trace back...\n")
? 1/0
end procedure
procedure show(object x, object y)
-- show the mismatched values
puts(msg, "\n ---MISMATCH--- \n x is ")
? x
puts(msg, " y is ")
? y
abort()
end procedure
constant epsilon = 1e-10
procedure same(object x, object y)
-- object x must be identical to object y else abort program
atom ratio
if atom(x) and atom(y) then
if x = y then
return
else
if y = 0 then
show(x, y)
else
ratio = x / y
if ratio < 1 - epsilon or ratio > 1 + epsilon then
show(x, y)
end if
end if
end if
elsif length(x) = length(y) then
for i = 1 to length(x) do
same(x[i], y[i])
end for
else
show(x, y)
end if
end procedure
----------------------------------------------------------
function abs(atom x)
-- absolute value
if x < 0 then
return -x
else
return x
end if
end function
function built_in()
-- built-in tests
sequence d
d = date()
if d[1] < 93 or d[2] > 12 or d[3] < 1 or d[4] > 23 or d[5] > 59 or
d[6] >59 or d[7] > 7 or d[8] > 366 then
abort()
end if
d = power({-5, -4.5, -1, 0, 1, 2, 3.5, 4, 6},
{ 3, 2, -1,0.5, 0, 29, -2.5, 5, 8})
if d[1] != -125 or d[2] != 20.25 or d[3] != -1 or d[4] != 0 or
d[5] != 1 or d[6] != 536870912 or d[7] <.043 or d[7] > .044
or d[8] != 1024 or d[9] != 1679616 or power(2,3) != 8 or
power(16, 0.5) != 4 then
abort()
end if
d = remainder({5, 9, 15, -27}, {3, 4, 5, 6})
if d[1] != 2 or d[2] != 1 or d[3] != 0 or d[4] != -3 then
abort()
end if
d = remainder({11.5, -8.8, 3.5, 5.0}, {2, 3.5, -1.5, -100.0})
if d[1] != 1.5 or d[2] < -1.81 or d[2] > -1.79 or d[3] != 0.5 or d[4] != 5 then
abort()
end if
same(4, sqrt(16))
same(3, length("ABC"))
same({1, 1, 1, 1}, repeat(1, 4))
if rand(10) > 10 or rand(20) < 1 or not find(rand(5.5), {1,2,3,4,5}) then
abort()
end if
if time() < 0 then
abort()
end if
if abs(sin(3.1415)) > 0.02 then
abort()
end if
if cos(0) < .98 then
abort()
end if
if abs(tan(3.14/4) - 1) > .02 then
abort()
end if
if log(2.7) < 0.8 or log(2.7) > 1.2 then
abort()
end if
if floor(-3.3) != -4 then
abort()
end if
if floor(-999/3.000000001) != -333 then
abort()
end if
if floor(9.99/1) != 9 then
abort()
end if
for i = -9 to 2 do
if i = 1 then
return i
end if
end for
end function
procedure sub()
y = 200
end procedure
procedure overflow()
-- test overflows from integer into floating point
object two29, two30, maxint, prev_i
integer two30i, mtwo30i
two30 = 1
for i = 1 to 30 do
two30 = two30 * 2
end for
mtwo30i = -1
for i = 1 to 29 do
mtwo30i = mtwo30i * 2
end for
two30i = 1
for i = 1 to 29 do
two30i = two30i * 2
end for
if 2 * two30i != -2 * mtwo30i then
abort()
end if
if two30i*2 != two30 then
abort()
end if
two29 = floor(two30 / 2)
if two29 + two29 != two30 then
abort()
end if
maxint = floor(two30 - 1)
if maxint + 1 != two30 then
abort()
end if
if 2 + maxint != two30 + 1 then
abort()
end if
if (-maxint - 1) * -1 != two30 then
abort()
end if
prev_i = -maxint + 1
for i = -maxint to -maxint -5 by -1 do
if i != prev_i - 1 then
abort()
end if
prev_i = i
end for
prev_i = maxint - 5
for i = maxint - 3 to maxint + 3 by 2 do
if i != prev_i + 2 then
abort()
end if
prev_i = i
end for
if floor(two30) != two30 then
abort()
end if
if floor(two30 + two30 - 1) != two30 * 2 - 1 then
abort()
end if
end procedure
procedure atomic_ops()
-- test operations on atoms
object a, x, z
integer n
x = 100
sub() -- y = 200
z = 300
if x + y != z then
abort()
end if
if x != 100 then
abort()
end if
if 3 * 3 != 9 or
3 * 900000000 != 2700000000 or
15000 * 32000 != 480000000 or
32000 * 15000 != 480000000 or
1000 * 13000 != 13000000 or
13000 * 1000 != 13000000 then
abort()
end if
while x != 100 do
abort()
end while
if not (z - y = 100) then
abort()
end if
if x * 1000.5 != 100050 or x * y != 20000 or x / y != 0.5 then
abort()
end if
if y < x then
abort()
end if
if y <= x then
abort()
end if
if x > y then
abort()
end if
if x >= y then
abort()
end if
if -x != -100 then
printf(1, "x is %d\n", x)
abort()
end if
if x = x and y > z then
abort()
end if
x = 0
y = {"ten", "one", "two", "three", "four", "five", "six", "seven", "eight",
"nine", "ten", "ten"}
while x <= 11 do
if x = 1 then a = "one"
elsif x = 2 then a = "two"
elsif x = 3 then a = "three"
elsif x = 4 then a = "four"
elsif x = 5 then a = "five"
elsif x = 6 then a = "six"
elsif x = 7 then a = "seven"
if 1 + 1 = 2 then
same(a, "seven")
elsif 1 + 1 = 3 then
abort()
else
abort()
end if
elsif x = 8 then a = "eight"
elsif x = 9 then a = "nine"
else a = "ten"
end if
same(a, y[1+x])
x = x + 1
end while
y = 0
for xx = 100 to 0 by -2 do
y = y + xx
end for
same(y, 50 * 51)
for xx = 1 to 10 do
if xx = 6 then
x = 6
exit
end if
y = 1
while y < 25 do
y = y + 1
if y = 18 then
exit
end if
end while
same(y, 18)
end for
y = repeat(-99, 7)
for xx = +3 to -3 by -1 do
y[xx+4] = xx
end for
same(y, {-3, -2, -1, 0, +1, +2, +3})
y = {1,2,3}
for xx = 1.5 to +3.0 by .5 do
y[xx] = xx
end for
same(y, {1.5, 2.5, 3.0})
y = {}
for xx = -9.0 to -9.5 by -.25 do
y = y & xx
end for
same(y, {-9, -9.25, -9.5})
y = 5
n = 3
a = 2
for i = 1 to y by a do
n = n - 1
y = 15
a = 1
end for
same(n, 0)
end procedure
procedure floating_pt()
-- test floating-point operations
sequence x
x = {1.5, -3.5, 1e10, -1e20, 0.0, 0.0001}
y = repeat(x, 10)
if x[1]/x[2] > -0.42 or x[1]/x[2] < -0.43 then
abort()
end if
if find(1e10, x) != 3 then
abort()
end if
end procedure
function sequence_ops()
-- test operations on sequences
object i, w, x, y, z
x = "Hello "
y = "World"
i = 1
if not atom(i) then print(msg, 11) end if
if length(y) != 5 then print(msg, 12) end if
while i <= 5 do
x = append(x, y[i])
i = i + 1
end while
i = 1
while i <= 3 do
x = append(x, '.')
x = append(x, '\'')
i = i + 1
end while
same(x, "Hello World.'.'.'")
x = repeat(5, 19)
x = append(x, 20)
x[7] = 9
y = {9, 9, {9}}
y = prepend(y, 8)
y = prepend(y, {9, 9})
same(y, {{9, 9}, 8, 9, 9, {9}})
y = x
z = y * x + x + 1000
w = z > 1030 or x = 9
same(z, {1030, 1030, 1030, 1030, 1030, 1030, 1090, 1030, 1030, 1030,
1030, 1030, 1030, 1030, 1030, 1030, 1030, 1030, 1030, 1420})
same(w, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1})
x = {100, 200, {1, 2, {0, 0, 0}}, 300}
x[3][3][3] = 25
x = x * x
same(x, {10000, 40000, {1, 4, {0, 0, 625}}, 90000})
y = x / {1, 2, 3, 4}
same(y, {10000, 20000, {1/3, 4/3, {0, 0, 625/3}}, 22500})
-- & tests
same(2 & {5, 6,7}, {2, 5, 6, 7})
same({} & 3, {3})
same("ABC" & "DEF" & "GHIJ" & {}, "ABCDEFGHIJ")
same('A' & 'B' & 'C', "ABC")
-- slice tests
x = "ABCDEFGHIJKLMNOP"
same(x[1..4], "ABCD")
y = x[2..5]
same(y, "BCDE")
same(x[4..3], {})
same(x[4..4], "D")
x[3..5] = "000"
same(x, "AB000FGHIJKLMNOP")
x[6..9] = '8'
same(x, "AB0008888JKLMNOP")
same(floor({1, 2, -3, 4, -5} / 3), {0, 0, -1, 1, -2})
return y
end function
procedure sequence_ops2()
-- more tests of sequence operations
object x, y
x = "ABCDEFGHIJKLMNOP"
if find('D', x) != 4 then
abort()
end if
if match("EFGH", x) != 5 then
abort()
end if
if compare(x,x) != 0 then
abort()
end if
if compare({}, {}) != 0 then
abort()
end if
y = repeat(repeat(repeat(99, 5), 5), 5)
if y[3][3][3] != 99 then
abort()
end if
if compare(y[4][4][3..5], repeat(99, 3)) != 0 then
abort()
end if
y[3][2][1..4] = 88
if compare(y[3][2], {88, 88, 88, 88, 99}) != 0 then
abort()
end if
end procedure
procedure circularity()
-- test for circular references in internal garbage collector
object x, y
x = {{"abc", {0, 0, 0}}, "def", 1, 2}
x[3] = x
x[1..2] = x[2..3]
x = append(x, x)
x = prepend(x, x)
if compare(x, x) != 0 then
abort()
end if
y = "ABCDE"
y[2] = repeat(y, 3)
if compare(y, y) != 0 then
abort()
end if
end procedure
procedure I_O()
-- test I/O routines
integer file_no
object line
file_no = open("sanity.ex", "r")
if file_no < 0 then
abort()
end if
line = gets(file_no)
if compare(line, "-- io test\n") != 0 then
abort()
end if
close(file_no)
end procedure
procedure testgr()
-- test graphics operations
draw_line(1, 3, {{20, 100}, {600, 100}})
for i = 1 to 200 by 5 do
pixel(7, {i, i})
end for
end procedure
procedure testget()
-- test input of Euphoria objects
object gd
object x, i
object results
gd = open("get.tst", "r")
results = {
{0, {11, {33, {33}}, 4, 5}},
{0, {}},
{0, {}},
{0, 0.999},
{0, -0.999},
{0, 1.55},
{0, {11, 22, {33, 33}, 4, 5}},
{0, 10000},
{0, -123},
{0, 5.5},
{0, 99},
{0, 1001},
{0, {1, 2, 3}},
{0, 0.0001},
{0, {1.002e+23, -0.00059, 5.9e+31}},
{0, -1e-20},
{0, -1},
{0, "Rob""ert"},
{0, "Craig"},
{0, ""},
{0, "\n"},
{0, "\t\r"},
{0, "\'\""},
{0, 'A'},
{0, '\n'},
{0, '\"'},
{0, '\''},
{0, '\r'},
{0, {123, "ABC"}},
{0, {'A', 'B', '\n'}},
{-1, 0}
}
i = 1
while 1 do
x = get(gd)
if x[1] = -1 then
exit
end if
same(x, results[i])
i = i + 1
end while
if compare(results[i], {-1, 0}) != 0 then
puts(2, "wrong number of get values\n")
end if
end procedure
sequence list
list = {50, 100, 25, 2, 89, 93, 57, 22, 1, 5, 99, 87, 82, 84, 77, 76, 76,
33, 22, 11, 2, 3, 4, 98, 97, 82, 73, 55, 44, 29, 8, 7, 6, 5, 31,
42, 53, 54, 62, 69, 70, 80, 90, 96, 200, 300, 400, 1000, 999,
500, 600, 800, 700, 750, 444, 333, 222, 111, 888, 987, 901}
constant TRUE = 1, FALSE = 0
type positive_int(integer x)
return x >= 0
end type
global type sorted(sequence x)
-- return TRUE if x is in ascending order
positive_int n
n = length(x)
if n >= 2 then
for i = 1 to n-1 do
if compare(x[i], x[i+1]) > 0 then
return FALSE
end if
end for
end if
return TRUE
end type
global function merge_sort(sequence x)
-- put x into ascending order
-- using recursive merge sort
positive_int n
sorted x1, x2, newx
n = length(x)
if n = 0 or n = 1 then
return x
end if
x1 = merge_sort(x[1..n/2])
x2 = merge_sort(x[n/2+1..n])
newx = {}
while length(x1) > 0 and length(x2) > 0 do
if x1[1] < x2[1] then
newx = append(newx, x1[1])
x1 = x1[2..length(x1)]
else
newx = append(newx, x2[1])
x2 = x2[2..length(x2)]
end if
end while
newx = newx & x1 & x2 -- one will be empty
return newx
end function
global function bubble(sequence x)
-- put x into ascending order
-- using bubble sort
object temp
for i = 1 to length(x) - 1 do
for j = i + 1 to length(x) do
if x[j] < x[i] then
temp = x[j]
x[j] = x[i]
x[i] = temp
end if
end for
end for
return x
end function
-- Prime Sieve Benchmark --
constant SIZE = 8191,
ON = 1,
OFF = 0
sequence flags
function sieve()
positive_int count, prime
count = 0
-- turn flags on (non-zero)
flags = repeat(ON, SIZE)
for i = 1 to SIZE do
if flags[i] then
prime = i + i + 1
-- print(prime)
for k = i + prime to SIZE by prime do
flags[k] = OFF
end for
count = count + 1
end if
end for
return count
end function
function fib(integer n)
-- fibonacci
if n < 2 then
return n
else
return fib(n-1) + fib(n-2)
end if
end function
integer rp
procedure recursive_proc()
-- a recursively-called procedure
if rp > 0 then
rp = rp - 1
recursive_proc()
end if
end procedure
without profile
global procedure sanity()
graphics_mode(260)
clear_screen()
position(12, 20)
puts(msg, "Euphoria SANITY TEST ... ")
testget()
for j = 0 to 8 by 2 do
if not match("EUPHORIA", getenv("EUDIR")) then
abort()
end if
testgr()
make_sound()
same(built_in(), 1)
atomic_ops()
overflow()
floating_pt()
if compare(sequence_ops(), "BCDE") != 0 then
puts(msg, "sequence_ops failed\n")
end if
sequence_ops2()
circularity()
I_O()
rp = 100
recursive_proc()
if rp != 0 then
puts(msg, "recursive proc failed\n")
end if
if fib(20) != 6765 then
puts(msg, "fib failed\n")
end if
if sieve() != 1899 then
puts(msg, "sieve failed\n")
end if
if not sorted(merge_sort(list)) then
puts(msg, "merge_sort failed\n")
end if
if not sorted(bubble(list)) then
puts(msg, "bubble sort failed\n")
end if
if not sorted(sort(-500 + rand(repeat(1000, 1000)))) then
puts(msg, "standard sort failed\n")
end if
if not sorted(sort({"robert", "junko", "dave", "ken", "lurdes"})) then
puts(msg, "standard general sort failed\n")
end if
end for
printf(msg, "%s\n", {"PASSED (100%)\n\n <Enter> to continue"})
if atom(gets(0)) then
end if
graphics_mode(3)
end procedure
integer z
-- another for-loop test
z = 0
for j = 1 to 10 do
z = z + j
end for
if z != 55 then
abort()
end if
sanity()