summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--AufgabeFFP7.hs64
-rwxr-xr-xTestAufgabeFFP7.hs68
2 files changed, 112 insertions, 20 deletions
diff --git a/AufgabeFFP7.hs b/AufgabeFFP7.hs
index fc9d594..43e8014 100644
--- a/AufgabeFFP7.hs
+++ b/AufgabeFFP7.hs
@@ -2,7 +2,7 @@ module AufgabeFFP7
2where 2where
3 3
4import Data.Char 4import Data.Char
5import Data.List hiding ((\\), insert) 5import Data.List hiding ((\\), insert, delete)
6import Test.QuickCheck 6import Test.QuickCheck
7 7
8type Buffer = (Int, String) 8type Buffer = (Int, String)
@@ -55,26 +55,29 @@ insertI :: Char -> BufferI -> BufferI
55insertI c (beforeC, afterC) = ([c] ++ beforeC, afterC) 55insertI c (beforeC, afterC) = ([c] ++ beforeC, afterC)
56 56
57-- delete character before cursor 57-- delete character before cursor
58--TODO deleteI :: BufferI -> BufferI 58deleteI :: BufferI -> BufferI
59deleteI (beforeC, "") = (beforeC, "")
60deleteI (beforeC, last:afterC) = (beforeC, afterC)
59 61
60-- move cursor left one character 62-- move cursor left one character
61leftI :: BufferI -> BufferI 63leftI :: BufferI -> BufferI
62leftI ([], afterC) = ([], afterC) 64leftI ("", afterC) = ("", afterC)
63leftI (last:beforeC, afterC) = (beforeC, [last] ++ afterC) 65leftI (last:beforeC, afterC) = (beforeC, [last] ++ afterC)
64 66
65-- move cursor right one character 67-- move cursor right one character
66--TODO rightI :: BufferI -> BufferI 68rightI :: BufferI -> BufferI
69rightI (beforeC, "") = (beforeC, "")
70rightI (beforeC, last:afterC) = ([last] ++ beforeC, afterC)
67 71
68-- is cursor at left end? 72-- is cursor at left end?
69atLeftI :: BufferI -> Bool 73atLeftI :: BufferI -> Bool
70atLeftI ([], _) = True 74atLeftI ("", _) = True
71atLeftI (_, _) = False 75atLeftI (_, _) = False
72 76
73-- is cursor at right end? 77-- is cursor at right end?
74atRightI :: BufferI -> Bool 78atRightI :: BufferI -> Bool
75atRightI (_, []) = True 79atRightI (_, "") = True
76atRightI (_, _) = False 80atRightI (_, _) = False
77
78 81
79-------------------------------------------------------------------------------- 82--------------------------------------------------------------------------------
80 83
@@ -88,25 +91,50 @@ retrieve (beforeC, afterC) = (length beforeC, (reverse beforeC) ++ afterC)
88bufEqual :: BufferI -> Buffer -> Bool 91bufEqual :: BufferI -> Buffer -> Bool
89bufEqual bi b = (retrieve bi) == b 92bufEqual bi b = (retrieve bi) == b
90 93
94(<==>) = bufEqual
95
91-- generator for equal data 96-- generator for equal data
92genEqualBuf :: Gen(Buffer, BufferI) 97genEqualBuf :: Gen(Buffer, BufferI)
93genEqualBuf = do s <- arbitrary ; c <- choose (0, length s) ; return ( (c, s), revFst (splitAt c s) ) 98genEqualBuf = do
94 where 99 s <- arbitrary
95 revFst = \(a, b) -> (reverse a, b) 100 c <- choose (0, length s)
101 return ((c, s), revFst (splitAt c s))
102 where
103 revFst = \(a, b) -> (reverse a, b)
96 104
97instance Arbitrary Char where 105instance Arbitrary Char where
98 arbitrary = elements $ ['a'..'z'] ++ ['A'..'Z'] 106 arbitrary = elements $ ['a'..'z'] ++ ['A'..'Z']
107
108prop_empty :: Bool
109prop_empty = emptyI <==> empty
99 110
100-- naive insert test, will exhaust 111-- naive insert test, will exhaust
101prop_insert :: BufferI -> Buffer -> Char -> Property 112--prop_insert :: BufferI -> Buffer -> Char -> Property
102prop_insert bi b c = bufEqual bi b 113--prop_insert bi b c = bi <==> b
103 ==> bufEqual (insertI c bi) (insert c b) 114-- ==> insertI c bi <==> insert c b
115
116prop_insert :: BufferI -> Char -> Bool
117prop_insert bi c = insertI c bi <==> insert c (retrieve bi)
104 118
105-- use equal data generator 119-- use equal data generator
106prop_insert2 :: Char -> Property 120prop_insert2 :: Char -> Property
107prop_insert2 c = 121prop_insert2 c = forAll (genEqualBuf) $ \(b, bi) ->
108 forAll (genEqualBuf) $ \(b, bi) -> bufEqual (insertI c bi) (insert c b) 122 insertI c bi <==> insert c b
123
124prop_delete :: BufferI -> Bool
125prop_delete bi = deleteI bi <==> delete (retrieve bi)
126
127prop_left :: BufferI -> Bool
128prop_left bi = leftI bi <==> left (retrieve bi)
129
130prop_right :: BufferI -> Bool
131prop_right bi = rightI bi <==> right (retrieve bi)
132
133prop_atLeft :: BufferI -> Bool
134prop_atLeft bi = atLeftI bi == atLeft (retrieve bi)
109 135
136prop_atRight :: BufferI -> Bool
137prop_atRight bi = atRightI bi == atRight (retrieve bi)
110 138
111-------------------------------------------------------------------------------- 139--------------------------------------------------------------------------------
112 140
diff --git a/TestAufgabeFFP7.hs b/TestAufgabeFFP7.hs
index 1bbd10e..bbe3540 100755
--- a/TestAufgabeFFP7.hs
+++ b/TestAufgabeFFP7.hs
@@ -70,7 +70,71 @@ cases1 = TestLabel "buffer" $ TestList [
70 70
71-------------------------------------------------------------------------------- 71--------------------------------------------------------------------------------
72 72
73cases2 = TestLabel "ssfn/minfree" $ TestList [ 73cases2 = TestLabel "bufferI" $ TestList [
74 TestCase $ assertEqual "emptyI" ("", "")
75 (emptyI),
76
77 TestCase $ assertEqual "insertI1" ("a", "")
78 (insertI 'a' emptyI),
79 TestCase $ assertEqual "insertI2" ("ba", "")
80 (insertI 'b' (insertI 'a' emptyI)),
81 TestCase $ assertEqual "insertI3" ("ba", "c")
82 (insertI 'b' ("a", "c")),
83
84 TestCase $ assertEqual "deleteI1" ("", "bc")
85 (deleteI ("", "abc")),
86 TestCase $ assertEqual "deleteI2" ("cba", "")
87 (deleteI ("cba", "")),
88 TestCase $ assertEqual "deleteI3" ("", "")
89 (deleteI ("", "")),
90
91 TestCase $ assertEqual "leftI1" ("", "abc")
92 (leftI ("", "abc")),
93 TestCase $ assertEqual "leftI2" ("a", "bc")
94 (leftI ("ba", "c")),
95 TestCase $ assertEqual "leftI3" ("ba", "c")
96 (leftI ("cba", "")),
97
98 TestCase $ assertEqual "rightI1" ("a", "bc")
99 (rightI ("", "abc")),
100 TestCase $ assertEqual "rightI2" ("ba", "c")
101 (rightI ("a", "bc")),
102 TestCase $ assertEqual "rightI3" ("cba", "")
103 (rightI ("cba", "")),
104
105 TestCase $ assertEqual "atLeftI1" (True)
106 (atLeftI ("", "abc")),
107 TestCase $ assertEqual "atLeftI2" (False)
108 (atLeftI ("a", "bc")),
109
110 TestCase $ assertEqual "atRightI1" (True)
111 (atRightI ("cba", "")),
112 TestCase $ assertEqual "atRightI2" (False)
113 (atRightI ("a", "bc"))
114 ]
115
116--------------------------------------------------------------------------------
117
118cases3 = TestLabel "buffer/I_quickCheck" $ TestList [
119 TestCase $ assertEqual "empty" ()
120 (unsafePerformIO (quickCheck prop_empty)),
121 TestCase $ assertEqual "insert" ()
122 (unsafePerformIO (quickCheck prop_insert)),
123 TestCase $ assertEqual "delete" ()
124 (unsafePerformIO (quickCheck prop_delete)),
125 TestCase $ assertEqual "left" ()
126 (unsafePerformIO (quickCheck prop_left)),
127 TestCase $ assertEqual "right" ()
128 (unsafePerformIO (quickCheck prop_right)),
129 TestCase $ assertEqual "atLeft" ()
130 (unsafePerformIO (quickCheck prop_atLeft)),
131 TestCase $ assertEqual "atRight" ()
132 (unsafePerformIO (quickCheck prop_atRight))
133 ]
134
135--------------------------------------------------------------------------------
136
137cases4 = TestLabel "ssfn/minfree" $ TestList [
74 TestCase $ assertEqual "ssfn1" (5) (ssfn [0,1,2,3,4,6,7,8,9]), 138 TestCase $ assertEqual "ssfn1" (5) (ssfn [0,1,2,3,4,6,7,8,9]),
75 TestCase $ assertEqual "minfree1" (5) (minfree [0,1,2,3,4,6,7,8,9]), 139 TestCase $ assertEqual "minfree1" (5) (minfree [0,1,2,3,4,6,7,8,9]),
76 TestCase $ assertEqual "ssfn2" (0) (ssfn [1,2,3,4,5,6,7,8,9]), 140 TestCase $ assertEqual "ssfn2" (0) (ssfn [1,2,3,4,5,6,7,8,9]),
@@ -87,7 +151,7 @@ cases2 = TestLabel "ssfn/minfree" $ TestList [
87-------------------------------------------------------------------------------- 151--------------------------------------------------------------------------------
88 152
89tests :: [Test] 153tests :: [Test]
90tests = [cases1, cases2] 154tests = [cases1, cases2, cases3, cases4]
91 155
92isSuccess :: Counts -> Bool 156isSuccess :: Counts -> Bool
93isSuccess Counts{ cases = _, tried = _, errors = 0, failures = 0 } = True 157isSuccess Counts{ cases = _, tried = _, errors = 0, failures = 0 } = True