Commit af51a144 authored by cvs2snv's avatar cvs2snv

This commit was manufactured by cvs2svn to create tag 'clean-2-1-0'.

parent 02f915da
definition module genLibTest
/*
Pieter Koopman 2002
Nijmegen University, The Netherlands
GAST: A Generic Automatic Software Test-system
*/
import StdGeneric
import StdClass
instance + String
(@) infixl 2 :: (a->b) a -> b
(@!)infixl 2 :: (a->b) !a -> b
generic genShow a :: String Bool a [String] -> [String]
generic gEq a :: a a -> Bool
generic gLess a :: a a -> Bool
derive genShow Int, Char, Bool, Real, String, UNIT, PAIR, EITHER, CONS, FIELD, OBJECT, [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), (,,,,,,,,), (,,,,,,,,,), (->), {}, {!}
derive gEq Int, Char, Bool, Real, String, UNIT, PAIR, EITHER, CONS, FIELD, OBJECT, [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), (,,,,,,,,), (,,,,,,,,,)
derive gLess Int, Char, Bool, Real, String, UNIT, PAIR, EITHER, CONS, FIELD, OBJECT, [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), (,,,,,,,,), (,,,,,,,,,)
show :: !a -> [String] | genShow{|*|} a
show1 :: !a -> String | genShow{|*|} a
(===) infix 4 :: !a !a -> Bool | gEq{|*|} a
(=/=) infix 4 :: !a !a -> Bool | gEq{|*|} a
(-<-) infix 4 :: !a !a -> Bool | gLess{|*|} a
(->-) infix 4 :: !a !a -> Bool | gLess{|*|} a
(-<=) infix 4 :: !a !a -> Bool | gLess{|*|} a
(=>-) infix 4 :: !a !a -> Bool | gLess{|*|} a
implementation module genLibTest
/*
Pieter Koopman 2002
Nijmegen University, The Netherlands
GAST: A Generic Automatic Software Test-system
*/
import StdEnv, StdGeneric
instance + String where (+) s t = s +++ t
(@)infixl 2 :: (a->b) a -> b
(@) f x = f x
(@!)infixl 2 :: (a->b) !a -> b
(@!) f x = f x
//--- show ---//
generic genShow a :: String Bool a [String] -> [String]
genShow{|Int|} sep p x rest = [toString x: rest]
genShow{|Char|} sep p x rest = ["'",toString x,"'": rest]
genShow{|Bool|} sep p x rest = [toString x: rest]
genShow{|Real|} sep p x rest = [toString x: rest]
genShow{|String|} sep p s rest = ["\"",s,"\"":rest]
genShow{|UNIT|} sep p _ rest = rest
genShow{|PAIR|} fx fy sep p (PAIR x y) rest = fx sep p x [sep: fy sep p y rest]
genShow{|EITHER|} fl fr sep p (LEFT x) rest = fl sep p x rest
genShow{|EITHER|} fl fr sep p (RIGHT x) rest = fr sep p x rest
genShow{|(->)|} fa fr sep p f rest = ["<function>": rest]
genShow{|{}|} fx sep p xs rest = ["{" :showList fx [x\\x<-:xs] ["}":rest]]
genShow{|{!}|} fx sep p xs rest = ["{!":showList fx [x\\x<-:xs] ["}":rest]]
//genShow{|{#}|} fx sep p xs rest = ["{#":showList fx [x\\x<-:xs] ["}":rest]]
genShow{|[]|} f sep p xs rest = ["[" :showList f xs ["]":rest]]
genShow{|(,)|} f1 f2 sep p (x1,x2) rest = ["(":f1 sep False x1 [",":f2 sep False x2 [")":rest]]]
genShow{|(,,)|} f1 f2 f3 sep p (x1,x2,x3) rest = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [")":rest]]]]
genShow{|(,,,)|} f1 f2 f3 f4 sep p (x1,x2,x3,x4) rest
= ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [")":rest]]]]]
genShow{|(,,,,)|} f1 f2 f3 f4 f5 sep p (x1,x2,x3,x4,x5) rest
= ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [")":rest]]]]]]
genShow{|(,,,,,)|} f1 f2 f3 f4 f5 f6 sep p (x1,x2,x3,x4,x5, x6) rest = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [",":f6 sep False x6 [")":rest]]]]]]]
genShow{|(,,,,,,)|}f1 f2 f3 f4 f5 f6 f7 sep p (x1,x2,x3,x4,x5,x6,x7) rest
= ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [",":f6 sep False x6 [",":f7 sep False x7 [")":rest]]]]]]]]
genShow{|(,,,,,,,)|}f1 f2 f3 f4 f5 f6 f7 f8 sep p (x1,x2,x3,x4,x5,x6,x7,x8) rest
= ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [",":f6 sep False x6 [",":f7 sep False x7 [",":f8 sep False x8 [")":rest]]]]]]]]]
genShow{|(,,,,,,,,)|}f1 f2 f3 f4 f5 f6 f7 f8 f9 sep p (x1,x2,x3,x4,x5,x6,x7,x8,x9) rest
= ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [",":f6 sep False x6 [",":f7 sep False x7 [",":f8 sep False x8 [",":f9 sep False x9 [")":rest]]]]]]]]]]
genShow{|(,,,,,,,,,)|}f1 f2 f3 f4 f5 f6 f7 f8 f9 f0 sep p (x1,x2,x3,x4,x5,x6,x7,x8,x9,x0) rest
= ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [",":f6 sep False x6 [",":f7 sep False x7 [",":f8 sep False x8 [",":f9 sep False x9 [",":f0 sep False x0 [")":rest]]]]]]]]]]]
genShow{|CONS of {gcd_name, gcd_arity, gcd_fields}|} fx sep p (CONS x) rest
| gcd_arity == 0
= [gcd_name: rest]
| isEmpty gcd_fields // ordinary constructor
| p // parentheses needed
= ["(",gcd_name," ":fx " " True x [")":rest]]
= [gcd_name," ":fx " " True x rest]
| otherwise // record
= ["{",{gcd_name.[i]\\i<-[1..size gcd_name-1]},"|":fx "," False x ["}":rest]]
genShow{|FIELD of {gfd_name}|} fx sep p (FIELD x) rest
= [gfd_name,"=":fx sep False x rest]
genShow{|OBJECT|} f sep p (OBJECT x) rest
= f sep p x rest
//showList :: (String Bool a [String] -> [String]) ![a] [String] -> [String]
showList :: (.String -> .(.Bool -> .(.a -> .(u:[v:String] -> w:[x:String])))) ![.a] z:[u0:String] -> w0:[x0:String], [w0 <= u,x0 <= v,z w <= w0,u0 x <= x0]
showList f [] rest = rest
showList f [x] rest = f "" False x rest
showList f [x:xs] rest = f "" False x [",":showList f xs rest]
show :: !a -> [String] | genShow{|*|} a
show x = genShow{|*|} "" False x []
show1 :: !a -> String | genShow{|*|} a
show1 x = glue (genShow{|*|} "" False x [])
where
glue :: [String] -> String
glue [] = ""
glue [x:xs]
= case xs of
[] = x
= x+glue xs
//--- equality ---//
generic gEq a :: a a -> Bool
gEq{|UNIT|} _ _ = True
gEq{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2) = fx x1 x2 && fy y1 y2
gEq{|EITHER|} fl fr (LEFT x) (LEFT y) = fl x y
gEq{|EITHER|} fl fr (RIGHT x) (RIGHT y) = fr x y
gEq{|EITHER|} _ _ _ _ = False
gEq{|CONS|} f (CONS x) (CONS y) = f x y
gEq{|FIELD|} f (FIELD x) (FIELD y) = f x y
gEq{|OBJECT|} f (OBJECT x) (OBJECT y) = f x y
gEq{|Int|} x y = x == y
gEq{|Char|} x y = x == y
gEq{|Bool|} x y = x == y
gEq{|Real|} x y = x == y
gEq{|String|} x y = x == y
//gEq{|(->)|} ea eb f g = ...
derive gEq [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), (,,,,,,,,), (,,,,,,,,,)
(===) infix 4 :: !a !a -> Bool | gEq{|*|} a
(===) x y = gEq{|*|} x y
(=/=) infix 4 :: !a !a -> Bool | gEq{|*|} a
(=/=) x y = not (x === y)
//--- comparision ---//
instance < Bool
where
(<) True b = not b
(<) False _ = False
generic gLess a :: a a -> Bool
gLess{|UNIT|} _ _ = True
gLess{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2) = fx x1 x2 && fy y1 y2
gLess{|EITHER|} fl fr (LEFT x) (LEFT y) = fl x y
gLess{|EITHER|} fl fr (RIGHT x) (RIGHT y) = fr x y
gLess{|EITHER|} fl fr (LEFT x) (RIGHT y) = True
gLess{|EITHER|} fl fr (RIGHT x) (LEFT y) = False
gLess{|CONS|} f (CONS x) (CONS y) = f x y
gLess{|FIELD|} f (FIELD x) (FIELD y) = f x y
gLess{|OBJECT|} f (OBJECT x) (OBJECT y) = f x y
gLess{|Int|} x y = x < y
gLess{|Char|} x y = x < y
gLess{|Bool|} x y = x < y
gLess{|Real|} x y = x < y
gLess{|String|} x y = x < y
derive gLess [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), (,,,,,,,,), (,,,,,,,,,)
(-<-) infix 4 :: !a !a -> Bool | gLess{|*|} a
(-<-) x y = gLess{|*|} x y
(->-) infix 4 :: !a !a -> Bool | gLess{|*|} a
(->-) x y = gLess{|*|} y x
(-<=) infix 4 :: !a !a -> Bool | gLess{|*|} a
(-<=) x y = not (gLess{|*|} y x)
(=>-) infix 4 :: !a !a -> Bool | gLess{|*|} a
(=>-) x y = not (gLess{|*|} x y)
This diff is collapsed.
Version: 1.4
Global
Built: True
Target: Everything
Exec: {Project}\properties.exe
CodeGen
CheckStacks: False
CheckIndexes: True
Application
HeapSize: 1048576
StackSize: 102400
ExtraMemory: 81920
IntialHeapSize: 204800
HeapSizeMultiplier: 4096
ShowExecutionTime: False
ShowGC: False
ShowStackSize: False
MarkingCollector: False
StandardRuntimeEnv: True
Profile
Memory: False
MemoryMinimumHeapSize: 0
Time: False
Stack: False
Output
Output: ShowConstructors
Font: Courier
FontSize: 9
WriteStdErr: False
Link
LinkMethod: Static
GenerateRelocations: False
GenerateLinkMap: False
LinkResources: False
ResourceSource:
GenerateDLL: False
ExportedNames:
Paths
Path: {Project}
Path: {Application}\Libraries\MersenneTwister 1.0.2
Precompile:
Postlink:
MainModule
Name: properties
Dir: {Project}
definition module stdProperty
import genLibTest
import testable
//from testable import ::Property, class Testable, class TestArg, generic generate
class (\/) infixr 2 a b :: !a b -> Property // Conditional or of arg1 and arg2
class (/\) infixr 3 a b :: !a b -> Property // Conditional and of arg1 and arg2
instance /\ Bool Bool
instance /\ Property Bool
instance /\ Bool Property
instance /\ Property Property
instance \/ Bool Bool
instance \/ Property Bool
instance \/ Bool Property
instance \/ Property Property
class (==>) infixr 1 b :: b p -> Property | Testable p
instance ==> Bool
instance ==> Property
//(<==>) infix 4 :: !Property !Property -> Property // True if properties are equivalent
(<==>) infix 4 :: !a !b -> Property | Testable a & Testable b // True if properties are equivalent
Exists :: (x->p) -> Property | Testable p & TestArg x
ForAll :: !(x->p) -> Property | Testable p & TestArg x
ForEach :: ![x] !(x->p) -> Property | Testable p & TestArg x
(For) infixl 0 :: !(x->p) ![x] -> Property | Testable p & TestArg x
(ForAndGen) infixl 0 :: !(x->p) ![x] -> Property | Testable p & TestArg x
classify :: !Bool l !p -> Property | Testable p & genShow{|*|} l
label :: !l !p -> Property | Testable p & genShow{|*|} l
name :: !n !p -> Property | Testable p & genShow{|*|} n
instance ~ Bool
instance ~ Property
instance ~ (a->b) | ~ b
implementation module stdProperty
/*
Pieter Koopman 2002
Nijmegen University, The Netherlands
GAST: A Generic Automatic Software Test-system
*/
import testable
from MersenneTwister import genRandInt
class (==>) infixr 1 b :: b p -> Property | Testable p
instance ==> Bool
where
(==>) c p
| c = Prop (evaluate p)
= Prop (\rs r = [{r & res = Rej}])
instance ==> Property
where
(==>) c p = Prop imp
where
imp rs r
# r1 = testAnalysis r (evaluate c rs r)
= case r1.res of
OK = evaluate p rs r1
= [{r & res = Rej}]
/*
(==>) infixr 1 :: !Bool p -> Property | Testable p
(==>) c p
| c = Prop (evaluate p)
= Prop (\rs r = [{r & res = Rej}])
*/
class (\/) infixr 2 a b :: !a b -> Property // Conditional or of arg1 and arg2
class (/\) infixr 3 a b :: !a b -> Property // Conditional and of arg1 and arg2
instance /\ Bool Bool where (/\) x y = prop (x && y)
instance /\ Property Bool where (/\) x y = x /\ prop y
instance /\ Bool Property where (/\) x y = prop x /\ y
instance /\ Property Property
where (/\) x y = Prop (and x y)
where
and x y rs r
# (rs2,rs) = split rs
r1 = testAnalysis r (evaluate x rs r)
r2 = testAnalysis r (evaluate y rs2 r)
= case (r1.res,r2.res) of // collect labels !! XXXXXXXXX
(CE ,_ ) = [r1] // to fix the evaluation order
(_ ,CE ) = [r2]
(Undef,_ ) = [r2]
(Rej ,OK ) = [r2]
= [r1]
/*
(OK ,OK ) = [r1]
(OK ,Rej ) = [r1]
(OK ,Undef) = [r1]
(OK ,CE ) = [r2]
(Rej ,OK ) = [r2]
(Rej ,Rej ) = [r1]
(Rej ,Undef) = [r1]
(Pass ,CE ) = [r2]
(Pass ,OK ) = [r1]
(Pass ,Rej ) = [r1]
(Pass ,Undef) = [r1]
(Pass ,CE ) = [r2]
(Undef,OK ) = [r2]
(Undef,Rej ) = [r2]
(Undef,Undef) = [r2]
(Undef,CE ) = [r2]
(CE ,OK ) = [r1]
(CE ,Rej ) = [r1]
(CE ,Undef) = [r1]
(CE ,CE ) = [r1]
*/
instance \/ Bool Bool where (\/) x y = prop (x || y)
instance \/ Property Bool where (\/) x y = x \/ prop y
instance \/ Bool Property where (\/) x y = prop x \/ y
instance \/ Property Property
where (\/) x y = Prop (or x y)
where
or x y rs r
# (rs2,rs) = split rs
= case testAnalysis r (evaluate x rs r) of
r=:{res=OK} = [r]
r=:{res=Pass} = case testAnalysis r (evaluate y rs2 r) of
r2=:{res=OK} = [r2]
= [r]
= evaluate y rs2 r
//(<==>) infix 4 :: !Property !Property -> Property // True if properties are equivalent
(<==>) infix 4 :: !a !b -> Property | Testable a & Testable b // True if properties are equivalent
(<==>) p q
# rs = genRandInt 42
r = {res=Undef, labels=[], args=[], name=[]}
b = testAnalysis r (evaluate p rs r)
c = testAnalysis r (evaluate q rs r)
= prop (b.res == c.res) // should be improved
//(<==>) p q = p ==> q /\ q ==> p // is dit beter? Nee, te veel rejects die als succes geteld worden
//(<==>) p q = (p ===> q) /\ (q ===> p) // is dit beter? Types niet goed.
// je zou hier een class van kunnen maken net zo als /\ en \/.
(===>) infix 1 :: Bool Bool -> Bool
(===>) p q = (not p) || q
Exists :: (x->p) -> Property | Testable p & TestArg x
Exists f = Prop p
where p rs r = [exists r (evaluate f rs r) MaxExists]
exists r [] n = {r & res = CE}
exists r _ 0 = {r & res = Undef}
exists _ [r=:{res=OK}:x] n = r
exists _ [r:x] n = exists r x (n-1)
noCE r [] n = {r & res = OK}
noCE r _ 0 = {r & res = Pass}
noCE _ [r=:{res=CE}:x] n = r
noCE _ [r=:{res=OK}:x] n = noCE {r&res=Pass} x (n-1)
noCE _ [r:x] n = noCE r x (n-1)
testAnalysis r l = analysis l MaxExists Undef OK
where
analysis [] n min max = {r & res = max}
analysis _ 0 min max = {r & res = min}
analysis [s:x] n min max
= case s.res of
CE = s
OK = analysis x (n-1) min max
Pass = analysis x (n-1) min Pass
Undef = analysis x (n-1) min Pass
Rej = analysis x (n-1) Rej max
= abort "Unknow result in testAnalysis"
ForAll :: !(x->p) -> Property | Testable p & TestArg x
ForAll f = Prop (evaluate f)
//ForAll f = Prop (\rs r = [testAnalysis r (evaluate f rs r)])
ForEach :: ![x] !(x->p) -> Property | Testable p & TestArg x
ForEach list f = Prop (forAll f list)
(For) infixl 0 :: !(x->p) ![x] -> Property | Testable p & TestArg x
(For) p list = ForEach list p
(ForAndGen) infixl 0 :: !(x->p) ![x] -> Property | Testable p & TestArg x
(ForAndGen) p list = Prop (evaluate p)
where evaluate f rs result
# (rs,rs2) = split rs
= forAll f (list++generateAll rs) rs2 result
classify :: !Bool l !p -> Property | Testable p & genShow{|*|} l
classify c l p
| c = Prop (\rs r = evaluate p rs {r & labels = [show1 l:r.labels]})
= Prop (evaluate p)
label :: !l !p -> Property | Testable p & genShow{|*|} l
label l p = Prop (\rs r = evaluate p rs {r & labels = [show1 l:r.labels]})
name :: !n !p -> Property | Testable p & genShow{|*|} n
name n p = Prop (\rs r = evaluate p rs {r & name = [show1 n:r.name]})
instance ~ Bool where ~ b = not b
instance ~ Result
where
~ CE = OK
~ OK = CE
~ Pass = CE
~ Rej = Rej
~ Undef = Undef
instance ~ Property
where ~ (Prop p) = Prop (\rs r = let r` = testAnalysis r (p rs r) in [{r` & res = ~r`.res}])
instance ~ (a->b) | ~ b
where
~ f = \x = ~ (f x)
definition module stdTest4
/*
Pieter Koopman 2002
Nijmegen University, The Netherlands
GAST: A Generic Automatic Software Test-system
*/
import stdProperty, testable
\ No newline at end of file
implementation module stdTest4
definition module testable
/*
Pieter Koopman 2002
Nijmegen University, The Netherlands
GAST: A Generic Automatic Software Test-system
*/
import StdEnv, genLibTest, StdTime //, Property
from stdProperty import ::Property // for instance of testable
//--- basics --//
:: Admin = {res::Result, labels::[String], args::[String], name::[String]}
:: Result = Undef | Rej | Pass | OK | CE
:: Trace
:: RandomStream :== [Int]
derive gLess Result
instance == Result
:: Property = Prop (RandomStream Admin -> [Admin])
prop :: a -> Property | Testable a
randomStream :: *env -> (RandomStream,*env) | TimeEnv env
generic generate a :: Trace RandomStream -> (a, Trace, a->Int, RandomStream)
class TestArg a | genShow{|*|}, generate{|*|} a
class Testable a where evaluate :: a RandomStream Admin -> [Admin]
instance Testable Bool
instance Testable Property
instance Testable (a->b) | Testable b & TestArg a
derive bimap [], (,), (,,), (,,,), (,,,,), (,,,,,)
derive generate (,), (,,), (,,,), (,,,,), (,,,,,), [], Int, Char, Bool, Real, String, UNIT, PAIR, EITHER, CONS, FIELD, OBJECT, (->)
predInts :== [0,1,-1]
predChars :== ['aZ ~']
predReals :== [0.0, 1.0, -1.0]
predStrings :== ["","\"\"","Hello world!"]
StrLen :== 25
IntSize :== 1000
MaxExists :== 500 //500
MaxNoCE :== 500
//--- for implementationof properties ---//
forAll :: !(a->b) ![a] RandomStream Admin -> [Admin] | Testable b & TestArg a
split :: RandomStream -> (RandomStream,RandomStream)
generateAll :: RandomStream -> [a] | generate{|*|} a
//--- testing --//
verbose :: RandomStream p -> [String] | Testable p
verbosen :: !Int RandomStream p -> [String] | Testable p
concise :: RandomStream p -> [String] | Testable p
concisen :: !Int RandomStream p -> [String] | Testable p
quiet :: RandomStream p -> [String] | Testable p
quietn :: !Int RandomStream p -> [String] | Testable p
test :== verbosen 20
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment