From c381eea3362cb02e40e12f3a35c179282a182249 Mon Sep 17 00:00:00 2001 From: manuel Date: Tue, 22 May 2012 12:30:30 +0200 Subject: implement missing quickcheck props + tests --- AufgabeFFP7.hs | 64 +++++++++++++++++++++++++++++++++++--------------- TestAufgabeFFP7.hs | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++-- 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 where import Data.Char -import Data.List hiding ((\\), insert) +import Data.List hiding ((\\), insert, delete) import Test.QuickCheck type Buffer = (Int, String) @@ -55,26 +55,29 @@ insertI :: Char -> BufferI -> BufferI insertI c (beforeC, afterC) = ([c] ++ beforeC, afterC) -- delete character before cursor ---TODO deleteI :: BufferI -> BufferI +deleteI :: BufferI -> BufferI +deleteI (beforeC, "") = (beforeC, "") +deleteI (beforeC, last:afterC) = (beforeC, afterC) -- move cursor left one character leftI :: BufferI -> BufferI -leftI ([], afterC) = ([], afterC) +leftI ("", afterC) = ("", afterC) leftI (last:beforeC, afterC) = (beforeC, [last] ++ afterC) -- move cursor right one character ---TODO rightI :: BufferI -> BufferI +rightI :: BufferI -> BufferI +rightI (beforeC, "") = (beforeC, "") +rightI (beforeC, last:afterC) = ([last] ++ beforeC, afterC) -- is cursor at left end? atLeftI :: BufferI -> Bool -atLeftI ([], _) = True -atLeftI (_, _) = False +atLeftI ("", _) = True +atLeftI (_, _) = False -- is cursor at right end? atRightI :: BufferI -> Bool -atRightI (_, []) = True -atRightI (_, _) = False - +atRightI (_, "") = True +atRightI (_, _) = False -------------------------------------------------------------------------------- @@ -88,25 +91,50 @@ retrieve (beforeC, afterC) = (length beforeC, (reverse beforeC) ++ afterC) bufEqual :: BufferI -> Buffer -> Bool bufEqual bi b = (retrieve bi) == b +(<==>) = bufEqual + -- generator for equal data genEqualBuf :: Gen(Buffer, BufferI) -genEqualBuf = do s <- arbitrary ; c <- choose (0, length s) ; return ( (c, s), revFst (splitAt c s) ) - where - revFst = \(a, b) -> (reverse a, b) +genEqualBuf = do + s <- arbitrary + c <- choose (0, length s) + return ((c, s), revFst (splitAt c s)) + where + revFst = \(a, b) -> (reverse a, b) instance Arbitrary Char where - arbitrary = elements $ ['a'..'z'] ++ ['A'..'Z'] + arbitrary = elements $ ['a'..'z'] ++ ['A'..'Z'] + +prop_empty :: Bool +prop_empty = emptyI <==> empty -- naive insert test, will exhaust -prop_insert :: BufferI -> Buffer -> Char -> Property -prop_insert bi b c = bufEqual bi b - ==> bufEqual (insertI c bi) (insert c b) +--prop_insert :: BufferI -> Buffer -> Char -> Property +--prop_insert bi b c = bi <==> b +-- ==> insertI c bi <==> insert c b + +prop_insert :: BufferI -> Char -> Bool +prop_insert bi c = insertI c bi <==> insert c (retrieve bi) -- use equal data generator prop_insert2 :: Char -> Property -prop_insert2 c = - forAll (genEqualBuf) $ \(b, bi) -> bufEqual (insertI c bi) (insert c b) +prop_insert2 c = forAll (genEqualBuf) $ \(b, bi) -> + insertI c bi <==> insert c b + +prop_delete :: BufferI -> Bool +prop_delete bi = deleteI bi <==> delete (retrieve bi) + +prop_left :: BufferI -> Bool +prop_left bi = leftI bi <==> left (retrieve bi) + +prop_right :: BufferI -> Bool +prop_right bi = rightI bi <==> right (retrieve bi) + +prop_atLeft :: BufferI -> Bool +prop_atLeft bi = atLeftI bi == atLeft (retrieve bi) +prop_atRight :: BufferI -> Bool +prop_atRight bi = atRightI bi == atRight (retrieve bi) -------------------------------------------------------------------------------- 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 [ -------------------------------------------------------------------------------- -cases2 = TestLabel "ssfn/minfree" $ TestList [ +cases2 = TestLabel "bufferI" $ TestList [ + TestCase $ assertEqual "emptyI" ("", "") + (emptyI), + + TestCase $ assertEqual "insertI1" ("a", "") + (insertI 'a' emptyI), + TestCase $ assertEqual "insertI2" ("ba", "") + (insertI 'b' (insertI 'a' emptyI)), + TestCase $ assertEqual "insertI3" ("ba", "c") + (insertI 'b' ("a", "c")), + + TestCase $ assertEqual "deleteI1" ("", "bc") + (deleteI ("", "abc")), + TestCase $ assertEqual "deleteI2" ("cba", "") + (deleteI ("cba", "")), + TestCase $ assertEqual "deleteI3" ("", "") + (deleteI ("", "")), + + TestCase $ assertEqual "leftI1" ("", "abc") + (leftI ("", "abc")), + TestCase $ assertEqual "leftI2" ("a", "bc") + (leftI ("ba", "c")), + TestCase $ assertEqual "leftI3" ("ba", "c") + (leftI ("cba", "")), + + TestCase $ assertEqual "rightI1" ("a", "bc") + (rightI ("", "abc")), + TestCase $ assertEqual "rightI2" ("ba", "c") + (rightI ("a", "bc")), + TestCase $ assertEqual "rightI3" ("cba", "") + (rightI ("cba", "")), + + TestCase $ assertEqual "atLeftI1" (True) + (atLeftI ("", "abc")), + TestCase $ assertEqual "atLeftI2" (False) + (atLeftI ("a", "bc")), + + TestCase $ assertEqual "atRightI1" (True) + (atRightI ("cba", "")), + TestCase $ assertEqual "atRightI2" (False) + (atRightI ("a", "bc")) + ] + +-------------------------------------------------------------------------------- + +cases3 = TestLabel "buffer/I_quickCheck" $ TestList [ + TestCase $ assertEqual "empty" () + (unsafePerformIO (quickCheck prop_empty)), + TestCase $ assertEqual "insert" () + (unsafePerformIO (quickCheck prop_insert)), + TestCase $ assertEqual "delete" () + (unsafePerformIO (quickCheck prop_delete)), + TestCase $ assertEqual "left" () + (unsafePerformIO (quickCheck prop_left)), + TestCase $ assertEqual "right" () + (unsafePerformIO (quickCheck prop_right)), + TestCase $ assertEqual "atLeft" () + (unsafePerformIO (quickCheck prop_atLeft)), + TestCase $ assertEqual "atRight" () + (unsafePerformIO (quickCheck prop_atRight)) + ] + +-------------------------------------------------------------------------------- + +cases4 = TestLabel "ssfn/minfree" $ TestList [ TestCase $ assertEqual "ssfn1" (5) (ssfn [0,1,2,3,4,6,7,8,9]), TestCase $ assertEqual "minfree1" (5) (minfree [0,1,2,3,4,6,7,8,9]), TestCase $ assertEqual "ssfn2" (0) (ssfn [1,2,3,4,5,6,7,8,9]), @@ -87,7 +151,7 @@ cases2 = TestLabel "ssfn/minfree" $ TestList [ -------------------------------------------------------------------------------- tests :: [Test] -tests = [cases1, cases2] +tests = [cases1, cases2, cases3, cases4] isSuccess :: Counts -> Bool isSuccess Counts{ cases = _, tried = _, errors = 0, failures = 0 } = True -- cgit v1.2.3