From 8120e21eae4564b278fb6e7b4b669c0ab4c9400b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Sat, 18 Jul 2026 17:32:26 -0600 Subject: [PATCH] remove wat tests --- golden/arith/out.wat | 102 ------------------------------------ golden/if-false/out.wat | 68 ------------------------ golden/if-number/out.wat | 70 ------------------------- golden/if-true/out.wat | 68 ------------------------ golden/lambda/out.wat | 78 --------------------------- gyehoek.cabal | 3 ++ src/Gyehoek/Driver.hs | 6 ++- test/Gyehoek/Test/Golden.hs | 45 ++++++++++++++++ test/Main.hs | 58 +++----------------- 9 files changed, 60 insertions(+), 438 deletions(-) delete mode 100644 golden/arith/out.wat delete mode 100644 golden/if-false/out.wat delete mode 100644 golden/if-number/out.wat delete mode 100644 golden/if-true/out.wat delete mode 100644 golden/lambda/out.wat create mode 100644 test/Gyehoek/Test/Golden.hs diff --git a/golden/arith/out.wat b/golden/arith/out.wat deleted file mode 100644 index 357b54b..0000000 --- a/golden/arith/out.wat +++ /dev/null @@ -1,102 +0,0 @@ -(module - (import - "gyehoek" - "write" - (func $gh-write (param (ref eq)))) - (import - "gyehoek" - "truthy?" - (func $gh-truthy? (param (ref eq)) (result i32))) - (type $heap-object (sub (struct (field $hash (mut i32))))) - (type $cont-type (func (param i32))) - (type $cont-stack-type (array (mut (ref null $cont-type)))) - (type - $closure - (sub - $heap-object - (struct - (field $hash (mut i32)) - (field $code (ref $cont-type))))) - (global $cont-stack-top (mut i32) (i32.const 0)) - (global - $cont-stack - (ref $cont-stack-type) - (array.new_default $cont-stack-type (i32.const 128))) - (type $arg-array-type (array (mut (ref null eq)))) - (global - $arg-array - (ref $arg-array-type) - (array.new_default $arg-array-type (i32.const 32))) - (global $result (mut (ref null eq)) (ref.null eq)) - (func - $halt - (param i32) - (global.get $arg-array) - (i32.const 0) - (array.get $arg-array-type) - ref.as_non_null - (global.set $result)) - (func - $scm-entry - (param i32) - (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) - (i32.const 3) - (i32.const 1) - i32.shl - ref.i31 - (i31.get_s (ref.cast (ref i31))) - (i32.const 1) - i32.shr_u - (i32.const 4) - (i32.const 1) - i32.shl - ref.i31 - (i31.get_s (ref.cast (ref i31))) - (i32.const 1) - i32.shr_u - i32.mul - (i32.const 1) - i32.shl - ref.i31 - (local.set 1) - (i32.const 2) - (i32.const 1) - i32.shl - ref.i31 - (i31.get_s (ref.cast (ref i31))) - (i32.const 1) - i32.shr_u - (i32.const 5) - (i32.const 1) - i32.shl - ref.i31 - (i31.get_s (ref.cast (ref i31))) - (i32.const 1) - i32.shr_u - i32.mul - (i32.const 1) - i32.shl - ref.i31 - (local.set 2) - (local.get 1) - (i31.get_s (ref.cast (ref i31))) - (i32.const 1) - i32.shr_u - (local.get 2) - (i31.get_s (ref.cast (ref i31))) - (i32.const 1) - i32.shr_u - i32.add - (i32.const 1) - i32.shl - ref.i31 - (local.set 3) - (global.get $arg-array) - (global.get 0) - (local.get 3) - (array.set $arg-array-type) - (return_call $halt (i32.const 1))) - (func - (export "main") - (call $scm-entry (i32.const 0)) - (call $gh-write (ref.as_non_null (global.get $result))))) \ No newline at end of file diff --git a/golden/if-false/out.wat b/golden/if-false/out.wat deleted file mode 100644 index d450f31..0000000 --- a/golden/if-false/out.wat +++ /dev/null @@ -1,68 +0,0 @@ -(module - (import - "gyehoek" - "write" - (func $gh-write (param (ref eq)))) - (import - "gyehoek" - "truthy?" - (func $gh-truthy? (param (ref eq)) (result i32))) - (type $heap-object (sub (struct (field $hash (mut i32))))) - (type $cont-type (func (param i32))) - (type $cont-stack-type (array (mut (ref null $cont-type)))) - (type - $closure - (sub - $heap-object - (struct - (field $hash (mut i32)) - (field $code (ref $cont-type))))) - (global $cont-stack-top (mut i32) (i32.const 0)) - (global - $cont-stack - (ref $cont-stack-type) - (array.new_default $cont-stack-type (i32.const 128))) - (type $arg-array-type (array (mut (ref null eq)))) - (global - $arg-array - (ref $arg-array-type) - (array.new_default $arg-array-type (i32.const 32))) - (global $result (mut (ref null eq)) (ref.null eq)) - (func - $halt - (param i32) - (global.get $arg-array) - (i32.const 0) - (array.get $arg-array-type) - ref.as_non_null - (global.set $result)) - (func - $scm-entry - (param i32) - (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) - (i32.const 1) - ref.i31 - (call $gh-truthy?) - (if - (then - (global.get $arg-array) - (global.get 0) - (i32.const 777) - (i32.const 1) - i32.shl - ref.i31 - (array.set $arg-array-type) - (return_call $halt (i32.const 1))) - (else - (global.get $arg-array) - (global.get 0) - (i32.const 555) - (i32.const 1) - i32.shl - ref.i31 - (array.set $arg-array-type) - (return_call $halt (i32.const 1))))) - (func - (export "main") - (call $scm-entry (i32.const 0)) - (call $gh-write (ref.as_non_null (global.get $result))))) \ No newline at end of file diff --git a/golden/if-number/out.wat b/golden/if-number/out.wat deleted file mode 100644 index 05bf4b6..0000000 --- a/golden/if-number/out.wat +++ /dev/null @@ -1,70 +0,0 @@ -(module - (import - "gyehoek" - "write" - (func $gh-write (param (ref eq)))) - (import - "gyehoek" - "truthy?" - (func $gh-truthy? (param (ref eq)) (result i32))) - (type $heap-object (sub (struct (field $hash (mut i32))))) - (type $cont-type (func (param i32))) - (type $cont-stack-type (array (mut (ref null $cont-type)))) - (type - $closure - (sub - $heap-object - (struct - (field $hash (mut i32)) - (field $code (ref $cont-type))))) - (global $cont-stack-top (mut i32) (i32.const 0)) - (global - $cont-stack - (ref $cont-stack-type) - (array.new_default $cont-stack-type (i32.const 128))) - (type $arg-array-type (array (mut (ref null eq)))) - (global - $arg-array - (ref $arg-array-type) - (array.new_default $arg-array-type (i32.const 32))) - (global $result (mut (ref null eq)) (ref.null eq)) - (func - $halt - (param i32) - (global.get $arg-array) - (i32.const 0) - (array.get $arg-array-type) - ref.as_non_null - (global.set $result)) - (func - $scm-entry - (param i32) - (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) - (i32.const 123) - (i32.const 1) - i32.shl - ref.i31 - (call $gh-truthy?) - (if - (then - (global.get $arg-array) - (global.get 0) - (i32.const 777) - (i32.const 1) - i32.shl - ref.i31 - (array.set $arg-array-type) - (return_call $halt (i32.const 1))) - (else - (global.get $arg-array) - (global.get 0) - (i32.const 555) - (i32.const 1) - i32.shl - ref.i31 - (array.set $arg-array-type) - (return_call $halt (i32.const 1))))) - (func - (export "main") - (call $scm-entry (i32.const 0)) - (call $gh-write (ref.as_non_null (global.get $result))))) \ No newline at end of file diff --git a/golden/if-true/out.wat b/golden/if-true/out.wat deleted file mode 100644 index d8e7d2e..0000000 --- a/golden/if-true/out.wat +++ /dev/null @@ -1,68 +0,0 @@ -(module - (import - "gyehoek" - "write" - (func $gh-write (param (ref eq)))) - (import - "gyehoek" - "truthy?" - (func $gh-truthy? (param (ref eq)) (result i32))) - (type $heap-object (sub (struct (field $hash (mut i32))))) - (type $cont-type (func (param i32))) - (type $cont-stack-type (array (mut (ref null $cont-type)))) - (type - $closure - (sub - $heap-object - (struct - (field $hash (mut i32)) - (field $code (ref $cont-type))))) - (global $cont-stack-top (mut i32) (i32.const 0)) - (global - $cont-stack - (ref $cont-stack-type) - (array.new_default $cont-stack-type (i32.const 128))) - (type $arg-array-type (array (mut (ref null eq)))) - (global - $arg-array - (ref $arg-array-type) - (array.new_default $arg-array-type (i32.const 32))) - (global $result (mut (ref null eq)) (ref.null eq)) - (func - $halt - (param i32) - (global.get $arg-array) - (i32.const 0) - (array.get $arg-array-type) - ref.as_non_null - (global.set $result)) - (func - $scm-entry - (param i32) - (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) - (i32.const 3) - ref.i31 - (call $gh-truthy?) - (if - (then - (global.get $arg-array) - (global.get 0) - (i32.const 777) - (i32.const 1) - i32.shl - ref.i31 - (array.set $arg-array-type) - (return_call $halt (i32.const 1))) - (else - (global.get $arg-array) - (global.get 0) - (i32.const 555) - (i32.const 1) - i32.shl - ref.i31 - (array.set $arg-array-type) - (return_call $halt (i32.const 1))))) - (func - (export "main") - (call $scm-entry (i32.const 0)) - (call $gh-write (ref.as_non_null (global.get $result))))) \ No newline at end of file diff --git a/golden/lambda/out.wat b/golden/lambda/out.wat deleted file mode 100644 index 5e389f0..0000000 --- a/golden/lambda/out.wat +++ /dev/null @@ -1,78 +0,0 @@ -(module - (import - "gyehoek" - "write" - (func $gh-write (param (ref eq)))) - (import - "gyehoek" - "truthy?" - (func $gh-truthy? (param (ref eq)) (result i32))) - (type $heap-object (sub (struct (field $hash (mut i32))))) - (type $cont-type (func (param i32))) - (type $cont-stack-type (array (mut (ref null $cont-type)))) - (type - $closure - (sub - $heap-object - (struct - (field $hash (mut i32)) - (field $code (ref $cont-type))))) - (global $cont-stack-top (mut i32) (i32.const 0)) - (global - $cont-stack - (ref $cont-stack-type) - (array.new_default $cont-stack-type (i32.const 128))) - (type $arg-array-type (array (mut (ref null eq)))) - (global - $arg-array - (ref $arg-array-type) - (array.new_default $arg-array-type (i32.const 32))) - (global $result (mut (ref null eq)) (ref.null eq)) - (func - $halt - (param i32) - (global.get $arg-array) - (i32.const 0) - (array.get $arg-array-type) - ref.as_non_null - (global.set $result)) - (func - (param i32) - (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) - (global.get $arg-array) - (i32.const 0) - (array.get $arg-array-type) - ref.as_non_null - (local.set 1) - (global.get $arg-array) - (global.get 0) - (local.get 1) - (array.set $arg-array-type) - (i32.const 1) - (global.get $cont-stack) - (global.get $cont-stack-top) - (array.get $cont-stack-type) - ref.as_non_null - (global.get $cont-stack-top) - (i32.const 1) - i32.sub - (global.set $cont-stack-top) - (return_call_ref $cont-type)) - (elem declare funcref (ref.func 3)) - (func - $scm-entry - (param i32) - (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) - (i32.const 0) - (ref.func 3) - (struct.new $closure) - (local.set 1) - (global.get $arg-array) - (global.get 0) - (local.get 1) - (array.set $arg-array-type) - (return_call $halt (i32.const 1))) - (func - (export "main") - (call $scm-entry (i32.const 0)) - (call $gh-write (ref.as_non_null (global.get $result))))) \ No newline at end of file diff --git a/gyehoek.cabal b/gyehoek.cabal index 4c780e6..12a41fb 100644 --- a/gyehoek.cabal +++ b/gyehoek.cabal @@ -94,10 +94,13 @@ test-suite test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs + other-modules: + Gyehoek.Test.Golden build-depends: base , gyehoek , filepath , tasty , tasty-silver , directory + , process-extras default-language: GHC2024 diff --git a/src/Gyehoek/Driver.hs b/src/Gyehoek/Driver.hs index 4deecd6..3e17a7f 100644 --- a/src/Gyehoek/Driver.hs +++ b/src/Gyehoek/Driver.hs @@ -67,10 +67,14 @@ withFile "-" FS.ReadMode k = k FS.stdin withFile "-" (FS.WriteMode; FS.AppendMode) k = k FS.stdout withFile f m k = FS.withFile f m k +fileName :: FilePath -> FilePath +fileName "-" = "" +fileName e = e + readScm :: FileSystem :> es => FilePath -> Eff es Scm.Program readScm f = withFile f FS.ReadMode $ \h -> - Sexp.parseSexps @Scm.CommandOrDef f <$> hGetContents h + Sexp.parseSexps @Scm.CommandOrDef (fileName f) <$> hGetContents h >>= either error (pure . Scm.MkProgram) driver diff --git a/test/Gyehoek/Test/Golden.hs b/test/Gyehoek/Test/Golden.hs new file mode 100644 index 0000000..a0f2b6d --- /dev/null +++ b/test/Gyehoek/Test/Golden.hs @@ -0,0 +1,45 @@ +module Gyehoek.Test.Golden (root) where + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Silver +import Gyehoek.Driver qualified as Driver +import System.FilePath +import Data.List (List) +import Data.Functor ((<&>)) +import System.Directory +import Data.Function +import System.Environment.Blank (getEnvDefault) +import qualified System.Process.Text as PT + + +disabled :: List String +disabled = + [ "square" + ] + +root :: IO TestTree +root = do + all_cases <- listDirectory "golden" + let tests = all_cases + & filter (`notElem` disabled) + & fmap ("golden") + testGroup "golden" <$> sequenceA + [ executionTests tests + ] + +executionTests :: List FilePath -> IO TestTree +executionTests files = do + cmd <- getEnvDefault "GYEHOEK_RUNTIME" + "runtime/target/debug/gyehoek-runtime" + pure $ testGroup "execution" $ files <&> \test -> + let testname = takeFileName test + scmfile = test "source.scm" + resultfile = test "exec" + action = do + t <- Driver.lower_e2e scmfile + PT.readProcessWithExitCode cmd ["-"] t + in goldenVsAction + testname + resultfile + action + printProcResult diff --git a/test/Main.hs b/test/Main.hs index d514954..44bb284 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,60 +1,16 @@ module Main (main) where import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Silver import Test.Tasty.Silver.Interactive (defaultMain) -import Data.Traversable -import Gyehoek.Driver qualified as Driver -import System.FilePath +import qualified Gyehoek.Test.Golden import Data.List (List) -import Data.Functor ((<&>)) -import System.Directory -import Data.Function -import System.Environment.Blank (getEnvDefault) -disabled :: List String -disabled = - [ "square" +main :: IO () +main = defaultMain =<< root + +root :: IO TestTree +root = testGroup "test" <$> sequenceA + [ Gyehoek.Test.Golden.root ] -main :: IO () -main = defaultMain =<< goldenTests - -goldenTests :: IO TestTree -goldenTests = do - all_cases <- listDirectory "golden" - let tests = all_cases - & filter (`notElem` disabled) - & fmap ("golden") - testGroup "golden" <$> sequenceA - [ pure $ watTests tests - , executionTests tests - ] - -watTests :: List FilePath -> TestTree -watTests files = - testGroup "wat" $ files <&> \test -> - let source = test "source.scm" - golden = test "out.wat" - testname = takeFileName test - in goldenVsAction - testname - golden - (Driver.lower_e2e source) - id - -executionTests :: List FilePath -> IO TestTree -executionTests files = do - cmd <- getEnvDefault "GYEHOEK_RUNTIME" - "runtime/target/debug/gyehoek-runtime" - pure $ testGroup "execution" $ files <&> \test -> - let wat = test "out.wat" - testname = takeFileName test - resultfile = test "exec" - in goldenVsProg - testname - resultfile - cmd - [wat] - "" -- stdin