Integrate Lua test results into tasty output

Author: tarleb

hslua-module-system.cabal

@@ -18,7 +18,7 @@ copyright:           Albert Krewinkel <albert+hslua@zeitkraut.de>
 category:            Foreign
 build-type:          Simple
 extra-source-files:  CHANGELOG.md
-                     test/system-module-tests.lua
+                   , test/test-system.lua
 cabal-version:       >=1.10
 tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5
 
@@ -51,4 +51,5 @@ test-suite test-hslua-module-system
                      , hslua-module-system
                      , tasty
                      , tasty-hunit
+                     , tasty-lua  >= 0.2    && < 0.3
                      , text 

stack.yaml

@@ -3,3 +3,4 @@ packages:
   - .
 extra-deps:
   - hslua-1.0.3
+  - tasty-lua-0.2.0

test/system-module-tests.lua

@@ -11,16 +11,22 @@ Portability : Requires language extensions ForeignFunctionInterface,
 Tests for the `system` Lua module.
 -}
 
-import Control.Monad (void, when)
+import Control.Monad (void)
 import Foreign.Lua (Lua)
 import Foreign.Lua.Module.System (preloadModule, pushModule)
 import Test.Tasty (TestTree, defaultMain, testGroup)
 import Test.Tasty.HUnit (assertEqual, testCase)
+import Test.Tasty.Lua (translateResultsFromFile)
 
 import qualified Foreign.Lua as Lua
 
 main :: IO ()
-main = defaultMain $ testGroup "hslua-module-system" [tests]
+main = do
+  luaTestResults <- Lua.run $ do
+    Lua.openlibs
+    Lua.requirehs "system" (void pushModule)
+    translateResultsFromFile "test/test-system.lua"
+  defaultMain $ testGroup "hslua-module-system" [tests, luaTestResults]
 
 -- | HSpec tests for the Lua 'system' module
 tests :: TestTree
@@ -40,14 +46,6 @@ tests = testGroup "HsLua System module"
       preloadModule "hssystem"
       assertEqual' "loading the module fails " Lua.OK =<<
         Lua.dostring "require 'hssystem'"
-
-  , testCase "Lua tests pass" . Lua.run $ do
-      Lua.openlibs
-      preloadModule "system"
-      assertEqual' "error while running lua tests" Lua.OK =<< do
-        st <- Lua.loadfile "test/system-module-tests.lua"
-        when (st == Lua.OK) $ Lua.call 0 0
-        return st
   ]
 
 assertEqual' :: (Show a, Eq a) => String -> a -> a -> Lua ()

test/test-hslua-module-system.hs

@@ -0,0 +1,199 @@
+--
+-- Tests for the system module
+--
+local system = require 'system'
+local tasty = require 'tasty'
+
+local group = tasty.test_group
+local test = tasty.test_case
+local assert = tasty.assert
+
+--- helper function, combining with_wd and with_tmpdir
+function in_tmpdir (callback)
+  return function ()
+    system.with_tmpdir('test-sytem-tmpdir', function (tmpdir)
+      system.with_wd(tmpdir, callback)
+    end)
+  end
+end
+
+--- dummy string for testing
+local token = 'Banana'
+
+--- check if token can be written into a file in given directory; returns the
+--- content of this file.
+function write_read_token (dir, filename)
+  local filename = string.format('%s/%s', dir, 'foo.txt')
+  local fh = io.open(filename, 'w')
+  fh:write(token .. '\n')
+  fh:close()
+  return io.open(filename):read '*l'
+end
+
+
+-- Check existence static fields
+return {
+  group 'static fields' {
+    test('arch', function ()
+      assert.are_equal(type(system.arch), 'string')
+    end),
+    test('compiler_name', function ()
+      assert.are_equal(type(system.compiler_name), 'string')
+    end),
+    test('compiler_version', function ()
+      assert.are_equal(type(system.compiler_version), 'table')
+    end),
+    test('os', function ()
+      assert.are_equal(type(system.os), 'string')
+    end),
+  },
+
+  group 'environment' {
+    test('getenv returns same result as os.getenv', function ()
+      assert.are_equal(system.getenv 'PATH', os.getenv 'PATH')
+    end),
+
+    test('setenv sets environment values', function ()
+      system.setenv('HSLUA_SYSTEM_MODULE', 'test')
+      assert.are_equal(os.getenv 'HSLUA_SYSTEM_MODULE', 'test')
+    end),
+
+  },
+  group 'getwd' {
+    test('returns a string', function ()
+      assert.are_equal(type(system.getwd()), 'string')
+    end)
+  },
+
+  group 'env' {
+    test('returns a table', function ()
+      assert.are_equal(type(system.env()), 'table')
+    end)
+  },
+
+  group 'ls' {
+    test('returns a table', function ()
+      assert.are_equal(type(system.ls('.')), 'table')
+    end),
+    test('lists files in directory', in_tmpdir(function ()
+      io.open('README.org', 'w'):close()
+      assert.are_same(system.ls '.', {'README.org'})
+    end)),
+    test('argument defaults to `.`', function ()
+      assert.are_equal(#system.ls('.'), #system.ls())
+    end),
+    test('fails when arg is not a directory', function ()
+      assert.error_matches(
+        function () system.ls('thisdoesnotexist') end,
+        'thisdoesnotexist'
+      )
+      assert.error_matches(
+        function () system.ls('README.md') end,
+        'README%.md'
+      )
+    end)
+  },
+
+  group 'mkdir' {
+    test('create directory', in_tmpdir(function ()
+      system.mkdir 'foo'
+      assert.are_equal((system.ls())[1], 'foo')
+    end)),
+    test('create nested directories', in_tmpdir(function ()
+      system.mkdir('foo/bar', true)
+      assert.are_equal((system.ls())[1], 'foo')
+      assert.are_equal((system.ls 'foo')[1], 'bar')
+    end)),
+    test('cannot create existing directory', in_tmpdir(function ()
+      assert.error_matches(function () system.mkdir '.' end, '%.')
+    end)),
+    test('optionally ignores existing directories', in_tmpdir(function ()
+      system.mkdir 'foo'
+      system.mkdir('foo', true)
+    end)),
+    test('normal operation', in_tmpdir(function () system.mkdir 'foo' end)),
+  },
+
+
+  group 'rmdir' {
+    test('remove empty directory', in_tmpdir(function ()
+      system.mkdir 'remove-me'
+      system.rmdir 'remove-me'
+      assert.are_same(system.ls(), {})
+    end)),
+    test('fail if directory is not empty', in_tmpdir(function ()
+      system.mkdir('outer/inner', true)
+      assert.error_matches(function () system.rmdir('outer') end, '.')
+    end)),
+    test('optionally delete recursively', in_tmpdir(function ()
+      system.mkdir('outer/inner', true)
+      system.rmdir('outer', true)
+      assert.are_same(system.ls(), {})
+    end))
+  },
+
+  group 'tmpdirname' {
+    test('returns a string', function ()
+      assert.are_equal(type(system.tmpdirname()), 'string')
+    end)
+  },
+
+  group 'with_env' {
+    test('resets environment', function ()
+           local outer_value = 'outer test value'
+           local inner_value = 'inner test value'
+           local inner_only = 'test #2'
+
+           function check_env ()
+             assert.are_equal(os.getenv 'HSLUA_SYSTEM_TEST', inner_value)
+             assert.are_equal(
+               os.getenv 'HSLUA_SYSTEM_TEST_INNER_ONLY',
+               inner_only
+             )
+             assert.is_nil(os.getenv 'HSLUA_SYSTEM_TEST_OUTER_ONLY')
+           end
+
+           local test_env = {
+             HSLUA_SYSTEM_TEST = inner_value,
+             HSLUA_SYSTEM_TEST_INNER_ONLY = inner_only
+           }
+           system.setenv('HSLUA_SYSTEM_TEST_OUTER_ONLY', outer_value)
+           system.setenv('HSLUA_SYSTEM_TEST', outer_value)
+           system.with_env(test_env, check_env)
+           assert.are_equal(system.getenv 'HSLUA_SYSTEM_TEST', outer_value)
+           assert.is_nil(system.getenv 'HSLUA_SYSTEM_TEST_INNER_ONLY')
+           assert.are_equal(
+             system.getenv 'HSLUA_SYSTEM_TEST_OUTER_ONLY',
+             outer_value
+           )
+    end)
+  },
+
+  group 'with_tmpdir' {
+    test('no base directory given', function ()
+      assert.are_equal(system.with_tmpdir('foo', write_read_token), token)
+    end),
+    test('cwd as base directory', function ()
+      assert.are_equal(system.with_tmpdir('.', 'foo', write_read_token), token)
+    end),
+  },
+
+  group 'with_wd' {
+    test('can change to test directory', function ()
+      system.with_wd('test', function ()
+        local cwd = system.getwd()
+        assert.is_truthy(cwd:match 'test$')
+      end)
+    end),
+    test('returns to old directory once done', function ()
+      local cwd = system.getwd()
+      system.with_wd('test', function () end)
+      assert.are_equal(system.getwd(), cwd)
+    end),
+    test('working directory is passed to callback', function ()
+      system.with_wd('test', function (path)
+        assert.is_truthy(system.getwd():match (path .. '$'))
+      end)
+    end),
+  }
+}