GenLibTest.icl 6.05 KB
Newer Older
1
implementation module Gast.GenLibTest
Bas Lijnse's avatar
Bas Lijnse committed
2 3 4 5

/*
	GAST: A Generic Automatic Software Test-system
	
6
	Gast.GenLibTest: library for generic testing: showing and comparing values
Bas Lijnse's avatar
Bas Lijnse committed
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 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143

	Pieter Koopman, 2004
	Radboud Universty, Nijmegen
	The Netherlands
	pieter@cs.ru.nl
*/

import StdEnv, StdGeneric, GenEq

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 = ["'",showChar 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
//	| p
//		= ["(":fx sep p x [sep: fy sep p y [")":rest]]]
		= fx sep p x [sep: fy sep p y rest]
//genShow{|PAIR|} 	fx fy	sep p (PAIR x y)	rest = fx sep True x [sep: fy sep True 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{|OBJECT|}	f    	sep p (OBJECT x)	rest = f 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}|} fx sep p (CONS x) rest
	| gcd_arity == 0
		= [gcd_name: rest]
	| otherwise
		| p // parentheses needed
//			= ["(",gcd_name," ":fx " " False x [")":rest]]
//			= [gcd_name," ":fx " " False x rest]
			= ["(",gcd_name," ":fx " " True x [")":rest]]
			= [gcd_name," ":fx " " True x rest]

genShow{|RECORD of {grd_name}|} fx sep p (RECORD x) rest
	= ["{",{grd_name.[i]\\i<-[1..size grd_name-1]},"|":fx "," False x ["}":rest]]

genShow{|FIELD of {gfd_name}|} fx sep p (FIELD x) rest
	= [gfd_name,"=":fx sep False x rest]

showChar :: Char -> String
showChar c
 = case c of
	'\n' = "\\n"
	'\t' = "\\t"
	'\r' = "\\r"
	'\b' = "\\b"
	'\'' = "\\'"
	c = toString c

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

//--- comparision ---//
/*
instance < Bool
where
	(<) True  b = not b
	(<) False _ = False
*/
generic gLess a  :: a a -> Bool

gLess{|UNIT|} _ _ 								= False
gLess{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2)	= fx x1 x2 || (not (fx x2 x1) && fy y1 y2) // x1<x2 || (x1==x2) && 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{|OBJECT|} f     (OBJECT x) (OBJECT y) 	= f x y
gLess{|FIELD|}  f     (FIELD x)  (FIELD y) 		= f x y
gLess{|Int|} 	x y 							= x < y
gLess{|Char|} x y 								= x < y
gLess{|Bool|} False y 							= y
gLess{|Bool|} x y 								= False
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)