From 4b15827018d04c340765e7607c16462ab9237088 Mon Sep 17 00:00:00 2001
From: Don Stewart <dons@galois.com>
Date: Sat, 29 Sep 2007 01:32:30 +0200
Subject: add some more properties for failure cases

darcs-hash:20070928233230-cba2c-291d995afedb1c3d1cf1ac4f8e69170b24029551
---
 tests/Properties.hs | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

(limited to 'tests')

diff --git a/tests/Properties.hs b/tests/Properties.hs
index 8256c45..138924f 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -11,8 +11,10 @@ import Data.Ratio
 import Data.Maybe
 import System.Environment
 import Control.Exception    (assert)
+import qualified Control.Exception as C
 import Control.Monad
 import Test.QuickCheck hiding (promote)
+import System.IO.Unsafe
 import System.IO
 import System.Random hiding (next)
 import Text.Printf
@@ -544,6 +546,28 @@ prop_differentiate xs =
                    else focus (fromJust (differentiate xs)) == head xs
     where _ = xs :: [Int]
 
+-- looking up the tag of the current workspace should always produce a tag.
+prop_lookup_current (x :: T) = lookupWorkspace scr x == Just tg
+    where
+        (Screen (Workspace tg  _ _) scr _) = current x
+
+-- ---------------------------------------------------------------------
+-- testing for failure
+
+-- and help out hpc
+prop_abort x = unsafePerformIO $ C.catch (abort "fail")
+                                         (\e -> return $  show e == "xmonad: StackSet: fail" )
+   where
+     _ = x :: Int
+
+-- new should fail with an abort
+prop_new_abort x = unsafePerformIO $ C.catch f
+                                         (\e -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" )
+   where
+     f = new undefined{-layout-} [] [] `seq` return False
+
+     _ = x :: Int
+
 ------------------------------------------------------------------------
 -- some properties for layouts:
 
@@ -675,6 +699,11 @@ main = do
         ,("floating is reversible" , mytest prop_float_reversible)
         ,("screens includes current", mytest prop_screens)
         ,("differentiate works", mytest prop_differentiate)
+        ,("lookupTagOnScreen", mytest prop_lookup_current)
+
+        -- testing for failure:
+        ,("abort fails", mytest prop_abort)
+        ,("new fails with abort", mytest prop_new_abort)
 
 {-
         ,("tile 1 window fullsize", mytest prop_tile_fullscreen)
-- 
cgit v1.2.3