Do not run tests involving copy/paste unless environment variable USE_SDL_VIDEO_SUBSYSTEM = 1 (#35)

monomer.cabal

@@ -506,7 +506,7 @@ test-suite monomer-test
       test/unit
   default-extensions:
       OverloadedStrings
-  ghc-options: -threaded -fwarn-incomplete-patterns
+  ghc-options: -fwarn-incomplete-patterns
   build-depends:
       HUnit ==1.6.*
     , JuicyPixels >=3.2.9 && <3.5

package.yaml

@@ -152,7 +152,6 @@ tests:
     main: Spec.hs
     source-dirs: test/unit
     ghc-options:
-      - -threaded
       - -fwarn-incomplete-patterns
     dependencies:
       - directory >= 1.3 && < 1.4

test/unit/Monomer/TestUtil.hs

@@ -20,7 +20,9 @@ import Data.Default
 import Data.Maybe
 import Data.Text (Text)
 import Data.Sequence (Seq)
-import System.IO.Unsafe
+import System.Environment (lookupEnv)
+import System.IO.Unsafe (unsafePerformIO)
+import Test.Hspec (Expectation, pendingWith)
 
 import qualified Data.ByteString as BS
 import qualified Data.Map.Strict as M
@@ -348,3 +350,15 @@ roundRectUnits (Rect x y w h) = Rect nx ny nw nh where
   ny = fromIntegral (round y)
   nw = fromIntegral (round w)
   nh = fromIntegral (round h)
+
+useVideoSubSystem :: IO Bool
+useVideoSubSystem = do
+  (== Just "1") <$> lookupEnv "USE_SDL_VIDEO_SUBSYSTEM"
+
+testInVideoSubSystem :: Expectation -> Expectation
+testInVideoSubSystem expectation = do
+  useVideo <- useVideoSubSystem
+  if useVideo then
+    expectation
+  else
+    pendingWith "SDL Video sub system not initialized. Skipping."

test/unit/Monomer/Widgets/Singles/TextAreaSpec.hs

@@ -105,12 +105,16 @@ handleEvent = describe "handleEvent" $ do
   it "should copy and paste text around" $ do
     let str = "This is some long text"
     let steps = [evtT str, selWordL, selWordL, selCharL, evtKG keyC, moveWordL, moveWordL, moveCharL, evtKG keyV]
-    model steps ^. textValue `shouldBe` "This long text is some long text"
+
+    testInVideoSubSystem $
+      model steps ^. textValue `shouldBe` "This long text is some long text"
 
   it "should cut and paste text around" $ do
     let str = "This is long text"
     let steps = [evtT str, selWordL, selCharL, evtKG keyX, moveWordL, moveWordL, moveCharL, evtKG keyV]
-    model steps ^. textValue `shouldBe` "This text is long"
+
+    testInVideoSubSystem $
+      model steps ^. textValue `shouldBe` "This text is long"
 
   it "should generate an event when focus is received" $ do
     events [evtFocus] `shouldBe` Seq.singleton (GotFocus emptyPath)
@@ -173,7 +177,9 @@ handleEventValue = describe "handleEventValue" $ do
 
   it "should input 'abc123', move to beginning, select three letters, copy, move to end, paste" $ do
     let steps = [evtT "abc123", evtKC keyHome, selCharR, selCharR, selCharR, evtKG keyC, evtK keyEnd, evtKG keyV]
-    lastEvt steps `shouldBe` TextChanged "abc123abc"
+
+    testInVideoSubSystem $
+      lastEvt steps `shouldBe` TextChanged "abc123abc"
 
   it "should input a-b-c-d on separate lines, then press Return" $ do
     let steps = [evtT "a\nb\nc\nd", evtK keyReturn]

test/unit/Monomer/Widgets/Singles/TextFieldSpec.hs

@@ -95,12 +95,16 @@ handleEvent = describe "handleEvent" $ do
   it "should copy and paste text around" $ do
     let str = "This is some long text"
     let steps = [evtT str, selWordL, selWordL, selCharL, evtKG keyC, moveWordL, moveWordL, moveCharL, evtKG keyV]
-    model steps ^. textValue `shouldBe` "This long text is some long text"
+
+    testInVideoSubSystem $
+      model steps ^. textValue `shouldBe` "This long text is some long text"
 
   it "should cut and paste text around" $ do
     let str = "This is long text"
     let steps = [evtT str, selWordL, selCharL, evtKG keyX, moveWordL, moveWordL, moveCharL, evtKG keyV]
-    model steps ^. textValue `shouldBe` "This text is long"
+
+    testInVideoSubSystem $
+      model steps ^. textValue `shouldBe` "This text is long"
 
   it "should generate an event when focus is received" $ do
     events [evtFocus] `shouldBe` Seq.singleton (GotFocus emptyPath)
@@ -158,7 +162,9 @@ handleEventValue = describe "handleEventValue" $ do
 
   it "should input 'abc123', move to beginning, select three letters, copy, move to end, paste" $ do
     let steps = [evtT "abc123", evtKC keyHome, selCharR, selCharR, selCharR, evtKG keyC, evtK keyEnd, evtKG keyV]
-    lastEvt steps `shouldBe` TextChanged "abc123abc"
+
+    testInVideoSubSystem $
+      lastEvt steps `shouldBe` TextChanged "abc123abc"
 
   where
     wenv = mockWenv (TestModel "")

test/unit/Spec.hs

@@ -5,6 +5,8 @@ import Test.Hspec
 import qualified SDL
 import qualified SDL.Raw as Raw
 
+import Monomer.TestUtil (useVideoSubSystem)
+
 import qualified Monomer.Common.CursorIconSpec as CursorIconSpec
 import qualified Monomer.Core.SizeReqSpec as SizeReqSpec
 import qualified Monomer.Graphics.UtilSpec as GraphicsUtilSpec
@@ -55,13 +57,19 @@ import qualified Monomer.Widgets.Util.TextSpec as TextSpec
 
 main :: IO ()
 main = do
-  -- Initialize SDL
-  SDL.initialize [SDL.InitVideo]
-  -- Run tests
-  hspec spec
-  -- Shutdown SDL
-  Raw.quitSubSystem Raw.SDL_INIT_VIDEO
-  SDL.quit
+  initVideo <- useVideoSubSystem
+
+  if initVideo then do
+    -- Initialize SDL
+    SDL.initialize [SDL.InitVideo]
+    -- Run tests
+    hspec spec
+    -- Shutdown SDL
+    Raw.quitSubSystem Raw.SDL_INIT_VIDEO
+    SDL.quit
+  else do
+    -- Run tests
+    hspec spec
 
 spec :: Spec
 spec = do