a3/code/Gast/stdProperty.icl

   1 implementation module stdProperty
   2
   3 /*
   4         GAST: A Generic Automatic Software Test-system
   5
   6         stdProperty: opertors on logical properties
   7
   8         Pieter Koopman, 2004..2008
   9         Radboud Universty, Nijmegen
  10         The Netherlands
  11         pieter@cs.ru.nl
  12 */
  13
  14 import testable, StdEnv
  15 from MersenneTwister import genRandInt
  16
  17 class (==>) infixr 1 b :: b p -> Property | Testable p
  18
  19 instance ==> Bool
  20 where
  21         (==>) c p
  22                 | c     = Prop (evaluate p)
  23                         = Prop (\rs r = [{r & res = Rej}])
  24
  25 instance ==> Property
  26 where
  27         (==>) c p = Prop imp
  28         where
  29                 imp rs r
  30                 # r1 = testAnalysis r (evaluate c rs r)
  31                 = case  r1.res of
  32                         OK      = evaluate p rs r1
  33                                 = [{r & res = Rej}]
  34
  35 class (\/) infixr 2 a b :: !a b -> Property     //      Conditional or  of arg1 and arg2
  36 class (/\) infixr 3     a b :: !a b -> Property //      Conditional and of arg1 and arg2
  37
  38 instance /\ Bool     Bool      where (/\) x y = prop (x && y)
  39 instance /\ Property Bool      where (/\) x y = x /\ prop y
  40 instance /\ Bool     Property  where (/\) x y = prop x /\ y
  41 instance /\ Property Property
  42 where (/\) x y = Prop (and x y)
  43           where
  44                 and x y rs r
  45                         # (rs2,rs) = split rs
  46                           r1 = testAnalysis r (evaluate x rs r)
  47                           r2 = testAnalysis r (evaluate y rs2 r)
  48                         = case (r1.res,r2.res) of // collect labels  !!
  49                                 (CE   ,_    )   = [r1] // to fix the evaluation order
  50                                 (_    ,CE   )   = [r2]
  51                                 (Undef,_    )   = [r2]
  52                                 (Rej  ,OK   )   = [r2]
  53                                                                 = [r1]
  54 /*
  55                                 (OK   ,OK   )   = [r1]
  56                                 (OK   ,Rej  )   = [r1]
  57                                 (OK   ,Undef)   = [r1]
  58                                 (OK   ,CE   )   = [r2]
  59                                 (Rej  ,OK   )   = [r2]
  60                                 (Rej  ,Rej  )   = [r1]
  61                                 (Rej  ,Undef)   = [r1]
  62                                 (Pass ,CE   )   = [r2]
  63                                 (Pass ,OK   )   = [r1]
  64                                 (Pass ,Rej  )   = [r1]
  65                                 (Pass ,Undef)   = [r1]
  66                                 (Pass ,CE   )   = [r2]
  67                                 (Undef,OK   )   = [r2]
  68                                 (Undef,Rej  )   = [r2]
  69                                 (Undef,Undef)   = [r2]
  70                                 (Undef,CE   )   = [r2]
  71                                 (CE   ,OK   )   = [r1]
  72                                 (CE   ,Rej  )   = [r1]
  73                                 (CE   ,Undef)   = [r1]
  74                                 (CE   ,CE   )   = [r1]
  75 */
  76 instance \/ Bool     Bool      where (\/) x y = prop (x || y)
  77 instance \/ Property Bool      where (\/) x y = x \/ prop y
  78 instance \/ Bool     Property  where (\/) x y = prop x \/ y
  79 instance \/ Property Property
  80 where (\/) x y = Prop (or x y)
  81           where
  82                 or x y rs r
  83                         # (rs2,rs) = split rs
  84                         = case testAnalysis r (evaluate x rs r) of
  85                                 r=:{res=OK}             = [r]
  86                                 r=:{res=Pass}   = case testAnalysis r (evaluate y rs2 r) of
  87                                                                         r2=:{res=OK} = [r2]
  88                                                                                                  = [r]
  89                                                                 = evaluate y rs2 r
  90
  91 (<==>) infix 4 :: !a !b -> Property     | Testable a & Testable b               //      True if properties are equivalent
  92 (<==>) p q
  93                 # rs = genRandInt 42
  94                   r  = {res=Undef, labels=[], args=[], name=[]}
  95                   b  = testAnalysis r (evaluate p rs r)
  96                   c  = testAnalysis r (evaluate q rs r)
  97                 = prop (b.res == c.res) // can this be improved?
  98
  99 (===>) infix 1 :: Bool Bool -> Bool
 100 (===>) p q = (not p) || q
 101
 102 ExistsIn :: (x->p) [x] -> Property | Testable p & TestArg x
 103 ExistsIn f l = Prop p
 104 where p rs r = [exists r [testAnalysis r (evaluate (f a) rs r)\\a <- l] MaxExists]
 105
 106 Exists :: (x->p) -> Property | Testable p & TestArg x
 107 Exists f = Prop p
 108 where p rs r
 109                 # (rs,rs2) = split rs
 110                 = [exists r [testAnalysis r (evaluate (f a) rs2 r)\\a <- generateAll rs] MaxExists]
 111 exists r []                             n = {r & res = CE}
 112 exists r _                              0 = {r & res = Undef}
 113 exists _ [r=:{res}:x]   n = case res of
 114                                                                 OK      = r
 115                                                                 Pass    = r
 116                                                                                 = exists r x (n-1)
 117
 118 noCE r []              n = {r & res = OK}
 119 noCE r _               0 = {r & res = Pass}
 120 noCE _ [r=:{res=CE}:x] n = r
 121 noCE _ [r=:{res=OK}:x] n = noCE {r&res=Pass} x (n-1)
 122 noCE r [_:x]           n = noCE r x (n-1)
 123
 124 testAnalysis :: Admin [Admin] -> Admin // maakt van een lijst resultaten een enkel resultaat
 125 testAnalysis r l = analysis l MaxExists Undef OK
 126 where
 127         analysis []    n min max = {r & res = max}
 128         analysis _     0 min max = {r & res = min}
 129         analysis [s:x] n min max
 130          = case s.res of
 131                 CE              = s
 132                 OK              = analysis x (n-1) Pass max
 133                 Pass    = analysis x (n-1) Pass Pass
 134                 Undef   = analysis x (n-1) min  max
 135                 Rej             = case min of
 136                                         OK      = analysis x (n-1) OK   max
 137                                         Pass    = analysis x (n-1) Pass max
 138                                                         = analysis x (n-1) Rej  max
 139                                 = abort "Unknow result in testAnalysis"
 140
 141 ForAll :: !(x->p) -> Property | Testable p & TestArg x
 142 ForAll f = Prop (evaluate f)
 143
 144 ForEach :: ![x] !(x->p) -> Property | Testable p & TestArg x
 145 ForEach list f = Prop (forAll f list)
 146
 147 (For) infixl 0 :: !(x->p) ![x] -> Property | Testable p & TestArg x
 148 (For) p list = ForEach list p
 149
 150 // XXXXXXXXXXXXXXXXXXXXXXXXXX
 151
 152 class (VOOR) infixl 0 t :: (t a b) [a] -> [b]
 153 instance VOOR (->)
 154 where VOOR f l = map f l
 155
 156 :: PL a b = PL [a->b]
 157 instance VOOR PL
 158 where VOOR (PL fl) l = diagonal [map f l\\f<-fl] //[f x \\ f<-fl, x<-l]
 159
 160 //| Testable p & TestArg x
 161
 162 // XXXXXXXXXXXXXXXXXXXXXXXXXX
 163
 164 (ForAndGen) infixl 0 :: !(x->p) ![x] -> Property | Testable p & TestArg x
 165 (ForAndGen) p list = Prop (evaluate p)
 166 where evaluate f rs result
 167                 # (rs,rs2) = split rs
 168                 = forAll f (list++generateAll rs) rs2 result
 169
 170 classify :: !Bool l !p -> Property | Testable p & genShow{|*|} l
 171 classify c l p
 172         | c     = Prop (\rs r = evaluate p rs {r & labels = [show1 l:r.labels]})
 173                 = Prop (evaluate p)
 174
 175 label ::  !l !p -> Property | Testable p & genShow{|*|} l
 176 label l p = Prop (\rs r = evaluate p rs {r & labels = [show1 l:r.labels]})
 177
 178 name :: !n !p -> Property | Testable p & genShow{|*|} n
 179 name n p = Prop (\rs r = evaluate p rs {r & name = [show1 n:r.name]})
 180
 181 instance ~ Bool where ~ b = not b
 182
 183 instance ~ Result
 184 where
 185         ~ CE = OK
 186         ~ OK = CE
 187         ~ Pass = CE
 188         ~ Rej = Rej
 189         ~ Undef = Undef
 190
 191 instance ~ Property
 192 where ~ (Prop p) = Prop (\rs r = let r` = testAnalysis r (p rs r) in [{r` & res = ~r`.res}])
 193