1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
# testsuite_functions for BASIC256
# these are the functions used by testquite.kbs to do much of the testing
# Modification History
# date programmer description
# 2013-09-18 j.m.reneau split to seperate include
# 2014-04-16 j.m.reneau added npercent test
# 2014-05-29 j.m.reneau added unattended global - set to true for no stopping
# 2020-09-06 j.m.reneau added range
###################################################
## TEST SYSTEM FUNCTIONS
###################################################
global unattended
global currentsuite
unattended = false
currentsuite = ''
subroutine section(sec)
print "###########"
print sec
print "###########"
end subroutine
subroutine boolean(message, tf)
print '(';currentsuite;') ';message + " " + tf + " ";
if tf then
print "pass"
else
print "fail"
end
end if
end subroutine
subroutine q(message$)
# ask user to press y if test worked or n if it failed
if yn('(';currentsuite;') ';message$) then
print "pass"
else
print "fail"
end
end if
end subroutine
function yn(message$)
# ask user to press y to continue or n to fail
# return true for yes / false for no
print '(';currentsuite;') ';"question " + message$ + " ";
if not unattended then
return confirm(message$, true)
else
return true
endif
end function
subroutine same(message$,a,b)
# test that a and b are the same numerically or string (EXACTLY)
print '(';currentsuite;') ';"testing " + message$ + " (" + a + " = " + b + ") ";
if a = b then
print "pass"
else
print "fail"
end
end if
end subroutine
subroutine n(message$,a,b)
call same(message$,a,b)
end subroutine
subroutine s(message$,a,b)
call same(message$,a,b)
end subroutine
subroutine different(message$,a,b)
# test that a and b$ are not the same string
print '(';currentsuite;') ';"testing " + message$ + " ('" + a + "' <> '" + b + "') ";
if a <> b then
print "pass"
else
print "fail"
end
end if
end subroutine
subroutine sne(message$,a,b)
call different(message$,a,b)
end subroutine
subroutine npercent(message$,a,b,p)
# test that b-b*p <= a <= b+b*p (percent variance)
print '(';currentsuite;') ';"testing " + message$ + " (" + a + " = " + b + " within " + p*100 + "%) ";
if b-b*p <= a AND a <= b+b*p then
print "pass"
else
print "fail"
end
end if
end subroutine
subroutine nclose(message$,a,b)
# test that a and b are the same numerically ALMOST
print '(';currentsuite;') ';"testing " + message$ + " (" + a + " ~ " + b + ") ";
if abs(a - b) < .0001 then
print "pass"
else
print "fail"
end
end if
end subroutine
subroutine range(message$,a,lo,hi)
# test that a <= hi and a >= lo
print '(';currentsuite;') ';"testing " + message$ + " (" + a + " >= " + lo + " and " + a + " >= " + hi + ") ";
if a >= lo AND a <= hi then
print "pass"
else
print "fail"
end
end if
end subroutine
|
