From 63ef9953cada4fb107fa2d3d58075bc819c24244 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Tue, 14 Feb 2023 23:00:21 +0000 Subject: [PATCH 01/23] Consolidate into single test suite --- unison-src/builtin-tests/concurrency-tests.u | 2 +- unison-src/builtin-tests/interpreter-tests.md | 11 +++-------- unison-src/builtin-tests/interpreter-tests.output.md | 6 ------ unison-src/builtin-tests/jit-tests.md | 10 +++------- unison-src/builtin-tests/jit-tests.output.md | 4 ---- unison-src/builtin-tests/tests.u | 4 +++- 6 files changed, 10 insertions(+), 27 deletions(-) diff --git a/unison-src/builtin-tests/concurrency-tests.u b/unison-src/builtin-tests/concurrency-tests.u index b18ffb765d..c573bd191c 100644 --- a/unison-src/builtin-tests/concurrency-tests.u +++ b/unison-src/builtin-tests/concurrency-tests.u @@ -1,4 +1,4 @@ -concurrency.tests = Tests.main do +concurrency.tests = do !simpleRefTest !simpleRefTestScope !ticketTest diff --git a/unison-src/builtin-tests/interpreter-tests.md b/unison-src/builtin-tests/interpreter-tests.md index 7f94009be0..206efae6e8 100644 --- a/unison-src/builtin-tests/interpreter-tests.md +++ b/unison-src/builtin-tests/interpreter-tests.md @@ -11,20 +11,15 @@ then reference those tests (which should be of type `'{IO,Exception,Tests} ()`, to `Tests.check` and `Tests.checkEqual`). ```ucm:hide -.> load unison-src/builtin-tests/tests.u +.> load unison-src/builtin-tests/concurrency-tests.u .> add ``` -```ucm -.> run tests -``` - ```ucm:hide -.> load unison-src/builtin-tests/concurrency-tests.u +.> load unison-src/builtin-tests/tests.u .> add ``` ```ucm -.> run concurrency.tests +.> run tests ``` - diff --git a/unison-src/builtin-tests/interpreter-tests.output.md b/unison-src/builtin-tests/interpreter-tests.output.md index 311b77b6d5..947c5941a7 100644 --- a/unison-src/builtin-tests/interpreter-tests.output.md +++ b/unison-src/builtin-tests/interpreter-tests.output.md @@ -11,9 +11,3 @@ to `Tests.check` and `Tests.checkEqual`). () ``` -```ucm -.> run concurrency.tests - - () - -``` diff --git a/unison-src/builtin-tests/jit-tests.md b/unison-src/builtin-tests/jit-tests.md index b44da5dc01..3cb95d893b 100644 --- a/unison-src/builtin-tests/jit-tests.md +++ b/unison-src/builtin-tests/jit-tests.md @@ -13,19 +13,15 @@ then reference those tests (which should be of type `'{IO,Exception,Tests} ()`, to `Tests.check` and `Tests.checkEqual`). ```ucm:hide -.> load unison-src/builtin-tests/tests.u +.> load unison-src/builtin-tests/concurrency-tests.u .> add ``` -```ucm -.> run.native tests -``` - ```ucm:hide -.> load unison-src/builtin-tests/concurrency-tests.u +.> load unison-src/builtin-tests/tests.u .> add ``` ```ucm -.> run.native concurrency.tests +.> run.native tests ``` diff --git a/unison-src/builtin-tests/jit-tests.output.md b/unison-src/builtin-tests/jit-tests.output.md index 19ddeec195..016ea7e654 100644 --- a/unison-src/builtin-tests/jit-tests.output.md +++ b/unison-src/builtin-tests/jit-tests.output.md @@ -9,7 +9,3 @@ to `Tests.check` and `Tests.checkEqual`). .> run.native tests ``` -```ucm -.> run.native concurrency.tests - -``` diff --git a/unison-src/builtin-tests/tests.u b/unison-src/builtin-tests/tests.u index 5505853521..aa76faa73d 100644 --- a/unison-src/builtin-tests/tests.u +++ b/unison-src/builtin-tests/tests.u @@ -23,4 +23,6 @@ tests = Tests.main do check "Sha3_512 hmacBytes" do hmacBytes Sha3_512 (toUtf8 "key") (toUtf8 "") === 0xs7539119b6367aa902bdc6f558d20c906d6acbd4aba3fd344eb08b0200144a1fa453ff6e7919962358be53f6db2a320d1852c52a3dea3e907070775f7a91f1282 check "Blake2s_256 hmacBytes" do hmacBytes Blake2s_256 (toUtf8 "key") (toUtf8 "") === 0xs67148074efc0f6741b474ef81c4d98d266e880d372fe723d2569b1d414d234be check "Blake2b_256 hmacBytes" do hmacBytes Blake2b_256 (toUtf8 "key") (toUtf8 "") === 0xs4224e1297e51239a642e21f756bde2785716f872298178180d7f3d1d36a5e4e4 - check "Blake2b_512 hmacBytes" do hmacBytes Blake2b_512 (toUtf8 "key") (toUtf8 "") === 0xs019fe04bf010b8d72772e6b46897ecf74b4878c394ff2c4d5cfa0b7cc9bbefcb28c36de23cef03089db9c3d900468c89804f135e9fdef7ec9b3c7abe50ed33d3 \ No newline at end of file + check "Blake2b_512 hmacBytes" do hmacBytes Blake2b_512 (toUtf8 "key") (toUtf8 "") === 0xs019fe04bf010b8d72772e6b46897ecf74b4878c394ff2c4d5cfa0b7cc9bbefcb28c36de23cef03089db9c3d900468c89804f135e9fdef7ec9b3c7abe50ed33d3 + + !concurrency.tests From f4fe9c6a5040a3c997fb209ad0d1c2823fe9c8d2 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Wed, 15 Feb 2023 00:11:47 +0000 Subject: [PATCH 02/23] Ignore libb2 --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 6ef1f50473..73249e2dab 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,4 @@ dist-newstyle # GHC *.hie *.prof +/libb2.dylib From 949f677afced7aeb66d63977c4c6605cd6891214 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Wed, 15 Feb 2023 00:19:29 +0000 Subject: [PATCH 03/23] Add stub for tryEval --- scheme-libs/common/unison/primops.ss | 2 ++ unison-src/builtin-tests/concurrency-tests.u | 10 +++++-- unison-src/builtin-tests/jit-tests.output.md | 30 ++++++++++++++++++++ 3 files changed, 40 insertions(+), 2 deletions(-) diff --git a/scheme-libs/common/unison/primops.ss b/scheme-libs/common/unison/primops.ss index 98b32c886b..d6156587e6 100644 --- a/scheme-libs/common/unison/primops.ss +++ b/scheme-libs/common/unison/primops.ss @@ -73,6 +73,7 @@ unison-FOp-IO.delay.impl.v3 unison-POp-FORK unison-FOp-IO.kill.impl.v3 + unison-POp-TFRC unison-POp-ADDN unison-POp-ANDN @@ -327,6 +328,7 @@ (define (unison-FOp-Scope.array n) (make-vector n)) (define (unison-POp-FORK thunk) (fork thunk)) + (define (unison-POp-TFRC thunk) (display "stub")) (define (unison-FOp-IO.delay.impl.v3 micros) (sleep micros)) (define (unison-FOp-IO.kill.impl.v3 threadId) (kill threadId)) (define (unison-FOp-Scope.ref a) (ref-new a)) diff --git a/unison-src/builtin-tests/concurrency-tests.u b/unison-src/builtin-tests/concurrency-tests.u index c573bd191c..57ae05df52 100644 --- a/unison-src/builtin-tests/concurrency-tests.u +++ b/unison-src/builtin-tests/concurrency-tests.u @@ -6,7 +6,7 @@ concurrency.tests = do !promiseSequentialTest !promiseConcurrentTest !forkKillTest - -- !tryEvalForkTest + !tryEvalForkTest !fullTest simpleRefTest = do @@ -84,7 +84,13 @@ forkKillTest = do v = Ref.read ref checkEqual "Thread was killed" v "initial" -tryEvalForkTest = bug "Depends on the Exception ability being implemented" +tryEvalForkTest = do + t = fork do + match catchAll do sleep_ (500 * millis) with + Left _ -> unsafeRun! do IO.console.printLine "interrupted" + Right _ -> unsafeRun! do IO.console.printLine "finished" + sleep_ (300 * millis) + kill_ t atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () atomicUpdate ref f = diff --git a/unison-src/builtin-tests/jit-tests.output.md b/unison-src/builtin-tests/jit-tests.output.md index 016ea7e654..596fc74aa7 100644 --- a/unison-src/builtin-tests/jit-tests.output.md +++ b/unison-src/builtin-tests/jit-tests.output.md @@ -8,4 +8,34 @@ to `Tests.check` and `Tests.checkEqual`). ```ucm .> run.native tests + 💔💥 + + The program halted with an unhandled exception: + + Failure + (typeLink ANFDecodeError) "unrecognized POp tag" (Any 118) + + + Stack trace: + ##raise + ``` + + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + + + 💔💥 + + The program halted with an unhandled exception: + + Failure + (typeLink ANFDecodeError) "unrecognized POp tag" (Any 118) + + + Stack trace: + ##raise + From a0d36fdc516aad68818020f84243fa39918ac009 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Wed, 15 Feb 2023 06:40:21 +0000 Subject: [PATCH 04/23] Point ucm at fork of internal compiler lib --- .../src/Unison/Codebase/Editor/HandleInput.hs | 2 +- unison-src/builtin-tests/jit-tests.output.md | 31 +++---------------- 2 files changed, 5 insertions(+), 28 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index b06e167faa..94d1c74b74 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -2659,7 +2659,7 @@ doFetchCompiler = { server = RemoteRepo.DefaultCodeserver, repo = ShareUserHandle "unison", path = - Path.fromList $ NameSegment <$> ["public", "internal", "trunk"] + Path.fromList $ NameSegment <$> ["public", "internal", "primops"] } repo = Just $ ReadRemoteNamespaceShare ns diff --git a/unison-src/builtin-tests/jit-tests.output.md b/unison-src/builtin-tests/jit-tests.output.md index 596fc74aa7..d767bdcea1 100644 --- a/unison-src/builtin-tests/jit-tests.output.md +++ b/unison-src/builtin-tests/jit-tests.output.md @@ -1,41 +1,18 @@ Note: This should be forked off of the codebase created by base.md -If you want to define more complex tests somewhere other than `tests.u`, just `load my-tests.u` then `add`, -then reference those tests (which should be of type `'{IO,Exception,Tests} ()`, written using calls -to `Tests.check` and `Tests.checkEqual`). - ```ucm -.> run.native tests - - 💔💥 - - The program halted with an unhandled exception: - - Failure - (typeLink ANFDecodeError) "unrecognized POp tag" (Any 118) - - - Stack trace: - ##raise - +.> compile.native.fetch.> compile.native.genlibs.> load unison-src/builtin-tests/testlib.u.> add ``` - 🛑 The transcript failed due to an error in the stanza above. The error is: - 💔💥 - - The program halted with an unhandled exception: - - Failure - (typeLink ANFDecodeError) "unrecognized POp tag" (Any 118) - + ❗️ - Stack trace: - ##raise + The server didn't find anything at + unison.public.internal.primop-tags From ec6c8ef9ead5b100a5e6f0b233281b1dc60d7d11 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Wed, 15 Feb 2023 22:49:43 +0000 Subject: [PATCH 05/23] Finally managed to get the internal fork to work --- unison-src/builtin-tests/base.output.md | 6 +++--- unison-src/builtin-tests/jit-tests.output.md | 19 ++++++------------- 2 files changed, 9 insertions(+), 16 deletions(-) diff --git a/unison-src/builtin-tests/base.output.md b/unison-src/builtin-tests/base.output.md index ea906338b1..f47cea815e 100644 --- a/unison-src/builtin-tests/base.output.md +++ b/unison-src/builtin-tests/base.output.md @@ -4,13 +4,13 @@ ✅ - ✅ Successfully pulled into newly created namespace base. + Successfully pulled into newly created namespace base. .> compile.native.fetch ✅ - ✅ Successfully updated .unison.internal from - dolio.public.internal.trunk. + Successfully updated .unison.internal from + unison.public.internal.primops. ``` diff --git a/unison-src/builtin-tests/jit-tests.output.md b/unison-src/builtin-tests/jit-tests.output.md index d767bdcea1..016ea7e654 100644 --- a/unison-src/builtin-tests/jit-tests.output.md +++ b/unison-src/builtin-tests/jit-tests.output.md @@ -1,18 +1,11 @@ Note: This should be forked off of the codebase created by base.md -```ucm -.> compile.native.fetch.> compile.native.genlibs.> load unison-src/builtin-tests/testlib.u.> add -``` - - -🛑 +If you want to define more complex tests somewhere other than `tests.u`, just `load my-tests.u` then `add`, +then reference those tests (which should be of type `'{IO,Exception,Tests} ()`, written using calls +to `Tests.check` and `Tests.checkEqual`). -The transcript failed due to an error in the stanza above. The error is: - - - ❗️ - - The server didn't find anything at - unison.public.internal.primop-tags +```ucm +.> run.native tests +``` From ab03c43c5ecd370771c1f5fc68b6d795bb7347be Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Wed, 15 Feb 2023 23:35:04 +0000 Subject: [PATCH 06/23] Add structure for try-eval --- scheme-libs/chez/unison/concurrent.ss | 7 ++++--- scheme-libs/common/unison/primops.ss | 2 +- scheme-libs/racket/unison/concurrent.ss | 10 ++++++++-- 3 files changed, 13 insertions(+), 6 deletions(-) diff --git a/scheme-libs/chez/unison/concurrent.ss b/scheme-libs/chez/unison/concurrent.ss index e49a0c27d5..0e7ecf1b84 100644 --- a/scheme-libs/chez/unison/concurrent.ss +++ b/scheme-libs/chez/unison/concurrent.ss @@ -10,13 +10,13 @@ promise-try-read fork kill - sleep) + sleep + try-eval) (define err "This operation is not supported on the pure Chez Scheme backend, use the Racket over Chez Scheme backend") - ;; TODO feels like there is a macro waiting to happen here (define (ref-new a) (error err)) (define (ref-read ref) (error err)) (define (ref-write ref a) (error err)) @@ -25,5 +25,6 @@ backend, use the Racket over Chez Scheme backend") (define (promise-read promise) (error err)) (define (promise-try-read promise) (error err)) (define (fork thread-thunk) (error err)) - (define (kill thread-id) (error err))) + (define (kill thread-id) (error err)) + (define (try-eval thunk) (error err))) diff --git a/scheme-libs/common/unison/primops.ss b/scheme-libs/common/unison/primops.ss index d6156587e6..da84378340 100644 --- a/scheme-libs/common/unison/primops.ss +++ b/scheme-libs/common/unison/primops.ss @@ -328,7 +328,7 @@ (define (unison-FOp-Scope.array n) (make-vector n)) (define (unison-POp-FORK thunk) (fork thunk)) - (define (unison-POp-TFRC thunk) (display "stub")) + (define (unison-POp-TFRC thunk) (try-eval thunk)) (define (unison-FOp-IO.delay.impl.v3 micros) (sleep micros)) (define (unison-FOp-IO.kill.impl.v3 threadId) (kill threadId)) (define (unison-FOp-Scope.ref a) (ref-new a)) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 3c79ae533a..698b70c3cb 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -12,7 +12,8 @@ promise-try-read fork kill - sleep) + sleep + try-eval) (import (rnrs) (rnrs records syntactic) @@ -86,4 +87,9 @@ (define (kill threadId) (break-thread threadId) - (right unit))) + (right unit)) + + (define (try-eval thunk) + (with-handlers ([exn:break? (lambda (x) ())]) + (display "semi-stub") + (thunk)))) From bd3a3a587e5a504c65e5266103e4625963e49390 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Wed, 15 Feb 2023 23:48:12 +0000 Subject: [PATCH 07/23] Test tryEval on both completions and thread kills --- unison-src/builtin-tests/concurrency-tests.u | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/unison-src/builtin-tests/concurrency-tests.u b/unison-src/builtin-tests/concurrency-tests.u index 57ae05df52..cd8eba6b28 100644 --- a/unison-src/builtin-tests/concurrency-tests.u +++ b/unison-src/builtin-tests/concurrency-tests.u @@ -7,6 +7,7 @@ concurrency.tests = do !promiseConcurrentTest !forkKillTest !tryEvalForkTest + !tryEvalKillTest !fullTest simpleRefTest = do @@ -85,6 +86,13 @@ forkKillTest = do checkEqual "Thread was killed" v "initial" tryEvalForkTest = do + t = fork do + match catchAll do sleep_ (500 * millis) with + Left _ -> unsafeRun! do IO.console.printLine "interrupted" + Right _ -> unsafeRun! do IO.console.printLine "finished" + sleep_ (600 * millis) + +tryEvalKillTest = do t = fork do match catchAll do sleep_ (500 * millis) with Left _ -> unsafeRun! do IO.console.printLine "interrupted" From 6ad8fe9c88171009489cd0d130c5ef21eb097928 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Wed, 15 Feb 2023 23:55:43 +0000 Subject: [PATCH 08/23] Add assertions for tryEval tests --- unison-src/builtin-tests/concurrency-tests.u | 23 +++++++++++++------- unison-src/builtin-tests/jit-tests.output.md | 2 ++ 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/unison-src/builtin-tests/concurrency-tests.u b/unison-src/builtin-tests/concurrency-tests.u index cd8eba6b28..2268d092f6 100644 --- a/unison-src/builtin-tests/concurrency-tests.u +++ b/unison-src/builtin-tests/concurrency-tests.u @@ -86,19 +86,26 @@ forkKillTest = do checkEqual "Thread was killed" v "initial" tryEvalForkTest = do + ref = IO.ref "initial" t = fork do - match catchAll do sleep_ (500 * millis) with - Left _ -> unsafeRun! do IO.console.printLine "interrupted" - Right _ -> unsafeRun! do IO.console.printLine "finished" - sleep_ (600 * millis) + match catchAll do sleep_ (400 * millis) with + Left _ -> unsafeRun! do Ref.write ref "interrupted" + Right _ -> unsafeRun! do Ref.write ref "finished" + sleep_ (500 * millis) + v = Ref.read ref + checkEqual "tryEval is a no-op on success" v "finished" tryEvalKillTest = do + ref = IO.ref "initial" t = fork do - match catchAll do sleep_ (500 * millis) with - Left _ -> unsafeRun! do IO.console.printLine "interrupted" - Right _ -> unsafeRun! do IO.console.printLine "finished" - sleep_ (300 * millis) + match catchAll do sleep_ (400 * millis) with + Left _ -> unsafeRun! do Ref.write ref "interrupted" + Right _ -> unsafeRun! do Ref.write ref "finished" + sleep_ (200 * millis) kill_ t + sleep_ (300 * millis) + v = Ref.read ref + checkEqual "Thread was killed" v "interrupted" atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () atomicUpdate ref f = diff --git a/unison-src/builtin-tests/jit-tests.output.md b/unison-src/builtin-tests/jit-tests.output.md index 016ea7e654..f4277ee451 100644 --- a/unison-src/builtin-tests/jit-tests.output.md +++ b/unison-src/builtin-tests/jit-tests.output.md @@ -8,4 +8,6 @@ to `Tests.check` and `Tests.checkEqual`). ```ucm .> run.native tests + Scheme evaluation failed. + ``` From 67ab95bc200d0360e053d6cc56ff3fedab94227f Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Thu, 16 Feb 2023 00:02:38 +0000 Subject: [PATCH 09/23] tryEval is a no-op on success --- scheme-libs/racket/unison/concurrent.ss | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 698b70c3cb..e1860694ea 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -91,5 +91,4 @@ (define (try-eval thunk) (with-handlers ([exn:break? (lambda (x) ())]) - (display "semi-stub") - (thunk)))) + (right (thunk))))) From 22402b4a0842f3ea0b4ed335f8d61c1b1ea86e9f Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Thu, 16 Feb 2023 10:48:55 +0000 Subject: [PATCH 10/23] Distinguish test cases --- unison-src/builtin-tests/concurrency-tests.u | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-src/builtin-tests/concurrency-tests.u b/unison-src/builtin-tests/concurrency-tests.u index 2268d092f6..87a059ddaf 100644 --- a/unison-src/builtin-tests/concurrency-tests.u +++ b/unison-src/builtin-tests/concurrency-tests.u @@ -105,7 +105,7 @@ tryEvalKillTest = do kill_ t sleep_ (300 * millis) v = Ref.read ref - checkEqual "Thread was killed" v "interrupted" + checkEqual "Thread was killed, with finalisers" v "interrupted" atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () atomicUpdate ref f = From cdef5f7a1cff96f98cbe445580ae3a4599c0c7a2 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Thu, 16 Feb 2023 11:25:56 +0000 Subject: [PATCH 11/23] Broken: define failure data --- scheme-libs/common/unison/data.ss | 12 ++++++++++-- scheme-libs/racket/unison/concurrent.ss | 3 ++- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/scheme-libs/common/unison/data.ss b/scheme-libs/common/unison/data.ss index d4848c111c..40a03efa18 100644 --- a/scheme-libs/common/unison/data.ss +++ b/scheme-libs/common/unison/data.ss @@ -16,7 +16,8 @@ either-get unit false - true) + true + failure) (import (rnrs)) @@ -60,4 +61,11 @@ (define (left? either) (eq? 0 (car either))) ; Either a b -> a | b - (define (either-get either) (car (cdr either)))) + (define (either-get either) (car (cdr either))) + + ; a -> Any + (define (any a) `(0 ,a)) + + ; Type -> Text -> a -> Failure + (define (failure typeLink msg a) + `(0 ,typeLink ,msg ,(any a)))) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index e1860694ea..42cf4356df 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -90,5 +90,6 @@ (right unit)) (define (try-eval thunk) - (with-handlers ([exn:break? (lambda (x) ())]) + (with-handlers + ([exn:break? (lambda (x) (left (failure "reference" "thread killed" ())))]) (right (thunk))))) From c0f935dfcdc8eb483c8adfeb7e2e16559aff0b08 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Thu, 16 Feb 2023 14:05:11 +0000 Subject: [PATCH 12/23] Encode failure shape (typelink still not done properly) --- scheme-libs/common/unison/data.ss | 14 +- scheme-libs/racket/unison/concurrent.ss | 2 +- unison-src/builtin-tests/concurrency-tests.u | 244 +++++++++---------- unison-src/builtin-tests/jit-tests.output.md | 2 - unison-src/builtin-tests/tests.u | 42 ++-- 5 files changed, 154 insertions(+), 150 deletions(-) diff --git a/scheme-libs/common/unison/data.ss b/scheme-libs/common/unison/data.ss index 40a03efa18..24c950473f 100644 --- a/scheme-libs/common/unison/data.ss +++ b/scheme-libs/common/unison/data.ss @@ -17,7 +17,9 @@ unit false true - failure) + any + failure + exception) (import (rnrs)) @@ -66,6 +68,10 @@ ; a -> Any (define (any a) `(0 ,a)) - ; Type -> Text -> a -> Failure - (define (failure typeLink msg a) - `(0 ,typeLink ,msg ,(any a)))) + ; Type -> Text -> Any -> Failure + (define (failure typeLink msg any) + `(0 ,typeLink ,msg ,any)) + + ; Type -> Text -> a ->{Exception} b + (define (exception typeLink msg a) + (failure typeLink msg (any a)))) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 42cf4356df..089f2486b0 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -91,5 +91,5 @@ (define (try-eval thunk) (with-handlers - ([exn:break? (lambda (x) (left (failure "reference" "thread killed" ())))]) + ([exn:break? (lambda (x) (exception "referenceId" "thread killed" ()))]) (right (thunk))))) diff --git a/unison-src/builtin-tests/concurrency-tests.u b/unison-src/builtin-tests/concurrency-tests.u index 87a059ddaf..1c712f4de1 100644 --- a/unison-src/builtin-tests/concurrency-tests.u +++ b/unison-src/builtin-tests/concurrency-tests.u @@ -1,99 +1,99 @@ concurrency.tests = do - !simpleRefTest - !simpleRefTestScope - !ticketTest - !casTest - !promiseSequentialTest - !promiseConcurrentTest - !forkKillTest - !tryEvalForkTest + -- !simpleRefTest + -- !simpleRefTestScope + -- !ticketTest + -- !casTest + -- !promiseSequentialTest + -- !promiseConcurrentTest + -- !forkKillTest + -- !tryEvalForkTest !tryEvalKillTest - !fullTest - -simpleRefTest = do - r = IO.ref 0 - Ref.write r 1 - i = Ref.read r - Ref.write r 2 - j = Ref.read r - Ref.write r 5 - checkEqual "Ref read-write" (i, j, Ref.read r) (1, 2, 5) - -simpleRefTestScope = do - Scope.run do - r = Scope.ref 0 - Ref.write r 1 - i = Ref.read r - Ref.write r 2 - j = Ref.read r - Ref.write r 5 - checkEqual "Ref read-write" (i, j, Ref.read r) (1, 2, 5) - -ticketTest = do - r = IO.ref 3 - t = Ref.readForCas r - v = Ticket.read t - checkEqual "Ticket contains the Ref value" v 3 - -casTest = do - ref = IO.ref 0 - ticket = Ref.readForCas ref - v1 = Ref.cas ref ticket 5 - check "CAS is successful is there were no conflicting writes" 'v1 - Ref.write ref 10 - v2 = Ref.cas ref ticket 15 - check "CAS fails when there was an intervening write" '(not v2) - -promiseSequentialTest = do - use Nat eq - use Promise read write - p = !Promise.new - v0 = Promise.tryRead p - checkEqual "Promise should be empty when created" v0 None - Promise.write_ p 0 - v1 = read p - checkEqual "Promise should read a value that's been written" v1 0 - Promise.write_ p 1 - v2 = read p - checkEqual "Promise can only be written to once" v2 v1 - v3 = Promise.tryRead p - checkEqual "Once the Promise is full, tryRead is the same as read" v3 (Some v2) + -- !fullTest + +-- simpleRefTest = do +-- r = IO.ref 0 +-- Ref.write r 1 +-- i = Ref.read r +-- Ref.write r 2 +-- j = Ref.read r +-- Ref.write r 5 +-- checkEqual "Ref read-write" (i, j, Ref.read r) (1, 2, 5) + +-- simpleRefTestScope = do +-- Scope.run do +-- r = Scope.ref 0 +-- Ref.write r 1 +-- i = Ref.read r +-- Ref.write r 2 +-- j = Ref.read r +-- Ref.write r 5 +-- checkEqual "Ref read-write" (i, j, Ref.read r) (1, 2, 5) + +-- ticketTest = do +-- r = IO.ref 3 +-- t = Ref.readForCas r +-- v = Ticket.read t +-- checkEqual "Ticket contains the Ref value" v 3 + +-- casTest = do +-- ref = IO.ref 0 +-- ticket = Ref.readForCas ref +-- v1 = Ref.cas ref ticket 5 +-- check "CAS is successful is there were no conflicting writes" 'v1 +-- Ref.write ref 10 +-- v2 = Ref.cas ref ticket 15 +-- check "CAS fails when there was an intervening write" '(not v2) + +-- promiseSequentialTest = do +-- use Nat eq +-- use Promise read write +-- p = !Promise.new +-- v0 = Promise.tryRead p +-- checkEqual "Promise should be empty when created" v0 None +-- Promise.write_ p 0 +-- v1 = read p +-- checkEqual "Promise should read a value that's been written" v1 0 +-- Promise.write_ p 1 +-- v2 = read p +-- checkEqual "Promise can only be written to once" v2 v1 +-- v3 = Promise.tryRead p +-- checkEqual "Once the Promise is full, tryRead is the same as read" v3 (Some v2) millis = 1000 sleep_ n = unsafeRun! do sleep n -promiseConcurrentTest = do - use Nat eq - use concurrent fork - p = !Promise.new - _ = fork do - sleep_ (200 * millis) - Promise.write p 5 - v = Promise.read p - checkEqual "Reads awaits for completion of the Promise" v 5 +-- promiseConcurrentTest = do +-- use Nat eq +-- use concurrent fork +-- p = !Promise.new +-- _ = fork do +-- sleep_ (200 * millis) +-- Promise.write p 5 +-- v = Promise.read p +-- checkEqual "Reads awaits for completion of the Promise" v 5 kill_ t = unsafeRun! do concurrent.kill t -forkKillTest = do - ref = IO.ref "initial" - thread = fork do - sleep_ (400 * millis) - Ref.write ref "done" - sleep_ (200 * millis) - kill_ thread - sleep_ (300 * millis) - v = Ref.read ref - checkEqual "Thread was killed" v "initial" - -tryEvalForkTest = do - ref = IO.ref "initial" - t = fork do - match catchAll do sleep_ (400 * millis) with - Left _ -> unsafeRun! do Ref.write ref "interrupted" - Right _ -> unsafeRun! do Ref.write ref "finished" - sleep_ (500 * millis) - v = Ref.read ref - checkEqual "tryEval is a no-op on success" v "finished" +-- forkKillTest = do +-- ref = IO.ref "initial" +-- thread = fork do +-- sleep_ (400 * millis) +-- Ref.write ref "done" +-- sleep_ (200 * millis) +-- kill_ thread +-- sleep_ (300 * millis) +-- v = Ref.read ref +-- checkEqual "Thread was killed" v "initial" + +-- tryEvalForkTest = do +-- ref = IO.ref "initial" +-- t = fork do +-- match catchAll do sleep_ (400 * millis) with +-- Left _ -> unsafeRun! do Ref.write ref "interrupted" +-- Right _ -> unsafeRun! do Ref.write ref "finished" +-- sleep_ (500 * millis) +-- v = Ref.read ref +-- checkEqual "tryEval is a no-op on success" v "finished" tryEvalKillTest = do ref = IO.ref "initial" @@ -107,42 +107,42 @@ tryEvalKillTest = do v = Ref.read ref checkEqual "Thread was killed, with finalisers" v "interrupted" -atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () -atomicUpdate ref f = - ticket = Ref.readForCas ref - value = f (Ticket.read ticket) - if Ref.cas ref ticket value then () else atomicUpdate ref f +-- atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () +-- atomicUpdate ref f = +-- ticket = Ref.readForCas ref +-- value = f (Ticket.read ticket) +-- if Ref.cas ref ticket value then () else atomicUpdate ref f -spawnN : Nat -> '{IO} a ->{IO} [a] -spawnN n fa = - use Nat eq - - use concurrent fork +-- spawnN : Nat -> '{IO} a ->{IO} [a] +-- spawnN n fa = +-- use Nat eq - +-- use concurrent fork - go i acc = - if eq i 0 - then acc - else - value = !Promise.new - _ = fork do Promise.write value !fa - go (i - 1) (acc :+ value) - - map Promise.read (go n []) - -fullTest = do - use Nat * + eq - +-- go i acc = +-- if eq i 0 +-- then acc +-- else +-- value = !Promise.new +-- _ = fork do Promise.write value !fa +-- go (i - 1) (acc :+ value) + +-- map Promise.read (go n []) + +-- fullTest = do +-- use Nat * + eq - - numThreads = 100 - iterations = 100 - expected = numThreads * iterations - - state = IO.ref 0 - thread n = - if eq n 0 - then () - else - atomicUpdate state (v -> v + 1) - thread (n - 1) - ignore (spawnN numThreads '(thread iterations)) - result = Ref.read state - checkEqual "The state of the counter is consistent " result expected +-- numThreads = 100 +-- iterations = 100 +-- expected = numThreads * iterations + +-- state = IO.ref 0 +-- thread n = +-- if eq n 0 +-- then () +-- else +-- atomicUpdate state (v -> v + 1) +-- thread (n - 1) +-- ignore (spawnN numThreads '(thread iterations)) +-- result = Ref.read state +-- checkEqual "The state of the counter is consistent " result expected diff --git a/unison-src/builtin-tests/jit-tests.output.md b/unison-src/builtin-tests/jit-tests.output.md index f4277ee451..016ea7e654 100644 --- a/unison-src/builtin-tests/jit-tests.output.md +++ b/unison-src/builtin-tests/jit-tests.output.md @@ -8,6 +8,4 @@ to `Tests.check` and `Tests.checkEqual`). ```ucm .> run.native tests - Scheme evaluation failed. - ``` diff --git a/unison-src/builtin-tests/tests.u b/unison-src/builtin-tests/tests.u index aa76faa73d..10f6abe412 100644 --- a/unison-src/builtin-tests/tests.u +++ b/unison-src/builtin-tests/tests.u @@ -1,28 +1,28 @@ tests : '{IO,Exception} () tests = Tests.main do - check "Nat.+" do 1 + 1 == 2 - check "Nat.*" do 10 * 100 == 1000 - check "Nat./" do 100 / 10 == 10 + -- check "Nat.+" do 1 + 1 == 2 + -- check "Nat.*" do 10 * 100 == 1000 + -- check "Nat./" do 100 / 10 == 10 - -- cryptographic hashing - check "Sha1 hashBytes" do hashBytes Sha1 (toUtf8 "") === 0xsda39a3ee5e6b4b0d3255bfef95601890afd80709 - check "Sha2_256 hashBytes" do hashBytes Sha2_256 (toUtf8 "") === 0xse3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855 - check "Sha2_512 hashBytes" do hashBytes Sha2_512 (toUtf8 "") === 0xscf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e - check "Sha3_256 hashBytes" do hashBytes Sha3_256 (toUtf8 "") === 0xsa7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a - check "Sha3_512 hashBytes" do hashBytes Sha3_512 (toUtf8 "") === 0xsa69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26 - check "Blake2s_256 hashBytes" do hashBytes Blake2s_256 (toUtf8 "") === 0xs69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9 - check "Blake2b_256 hashBytes" do hashBytes Blake2b_256 (toUtf8 "") === 0xs0e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a8 - check "Blake2b_512 hashBytes" do hashBytes Blake2b_512 (toUtf8 "") === 0xs786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce + -- -- cryptographic hashing + -- check "Sha1 hashBytes" do hashBytes Sha1 (toUtf8 "") === 0xsda39a3ee5e6b4b0d3255bfef95601890afd80709 + -- check "Sha2_256 hashBytes" do hashBytes Sha2_256 (toUtf8 "") === 0xse3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855 + -- check "Sha2_512 hashBytes" do hashBytes Sha2_512 (toUtf8 "") === 0xscf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e + -- check "Sha3_256 hashBytes" do hashBytes Sha3_256 (toUtf8 "") === 0xsa7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a + -- check "Sha3_512 hashBytes" do hashBytes Sha3_512 (toUtf8 "") === 0xsa69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26 + -- check "Blake2s_256 hashBytes" do hashBytes Blake2s_256 (toUtf8 "") === 0xs69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9 + -- check "Blake2b_256 hashBytes" do hashBytes Blake2b_256 (toUtf8 "") === 0xs0e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a8 + -- check "Blake2b_512 hashBytes" do hashBytes Blake2b_512 (toUtf8 "") === 0xs786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce - -- hmacs - check "Sha1 hmacBytes" do hmacBytes Sha1 (toUtf8 "key") (toUtf8 "") === 0xsf42bb0eeb018ebbd4597ae7213711ec60760843f - check "Sha2_256 hmacBytes" do hmacBytes Sha2_256 (toUtf8 "key") (toUtf8 "") === 0xs5d5d139563c95b5967b9bd9a8c9b233a9dedb45072794cd232dc1b74832607d0 - check "Sha2_512 hmacBytes" do hmacBytes Sha2_512 (toUtf8 "key") (toUtf8 "") === 0xs84fa5aa0279bbc473267d05a53ea03310a987cecc4c1535ff29b6d76b8f1444a728df3aadb89d4a9a6709e1998f373566e8f824a8ca93b1821f0b69bc2a2f65e - check "Sha3_256 hmacBytes" do hmacBytes Sha3_256 (toUtf8 "key") (toUtf8 "") === 0xs74f3c030ecc36a1835d04a333ebb7fce2688c0c78fb0bcf9592213331c884c75 - check "Sha3_512 hmacBytes" do hmacBytes Sha3_512 (toUtf8 "key") (toUtf8 "") === 0xs7539119b6367aa902bdc6f558d20c906d6acbd4aba3fd344eb08b0200144a1fa453ff6e7919962358be53f6db2a320d1852c52a3dea3e907070775f7a91f1282 - check "Blake2s_256 hmacBytes" do hmacBytes Blake2s_256 (toUtf8 "key") (toUtf8 "") === 0xs67148074efc0f6741b474ef81c4d98d266e880d372fe723d2569b1d414d234be - check "Blake2b_256 hmacBytes" do hmacBytes Blake2b_256 (toUtf8 "key") (toUtf8 "") === 0xs4224e1297e51239a642e21f756bde2785716f872298178180d7f3d1d36a5e4e4 - check "Blake2b_512 hmacBytes" do hmacBytes Blake2b_512 (toUtf8 "key") (toUtf8 "") === 0xs019fe04bf010b8d72772e6b46897ecf74b4878c394ff2c4d5cfa0b7cc9bbefcb28c36de23cef03089db9c3d900468c89804f135e9fdef7ec9b3c7abe50ed33d3 + -- -- hmacs + -- check "Sha1 hmacBytes" do hmacBytes Sha1 (toUtf8 "key") (toUtf8 "") === 0xsf42bb0eeb018ebbd4597ae7213711ec60760843f + -- check "Sha2_256 hmacBytes" do hmacBytes Sha2_256 (toUtf8 "key") (toUtf8 "") === 0xs5d5d139563c95b5967b9bd9a8c9b233a9dedb45072794cd232dc1b74832607d0 + -- check "Sha2_512 hmacBytes" do hmacBytes Sha2_512 (toUtf8 "key") (toUtf8 "") === 0xs84fa5aa0279bbc473267d05a53ea03310a987cecc4c1535ff29b6d76b8f1444a728df3aadb89d4a9a6709e1998f373566e8f824a8ca93b1821f0b69bc2a2f65e + -- check "Sha3_256 hmacBytes" do hmacBytes Sha3_256 (toUtf8 "key") (toUtf8 "") === 0xs74f3c030ecc36a1835d04a333ebb7fce2688c0c78fb0bcf9592213331c884c75 + -- check "Sha3_512 hmacBytes" do hmacBytes Sha3_512 (toUtf8 "key") (toUtf8 "") === 0xs7539119b6367aa902bdc6f558d20c906d6acbd4aba3fd344eb08b0200144a1fa453ff6e7919962358be53f6db2a320d1852c52a3dea3e907070775f7a91f1282 + -- check "Blake2s_256 hmacBytes" do hmacBytes Blake2s_256 (toUtf8 "key") (toUtf8 "") === 0xs67148074efc0f6741b474ef81c4d98d266e880d372fe723d2569b1d414d234be + -- check "Blake2b_256 hmacBytes" do hmacBytes Blake2b_256 (toUtf8 "key") (toUtf8 "") === 0xs4224e1297e51239a642e21f756bde2785716f872298178180d7f3d1d36a5e4e4 + -- check "Blake2b_512 hmacBytes" do hmacBytes Blake2b_512 (toUtf8 "key") (toUtf8 "") === 0xs019fe04bf010b8d72772e6b46897ecf74b4878c394ff2c4d5cfa0b7cc9bbefcb28c36de23cef03089db9c3d900468c89804f135e9fdef7ec9b3c7abe50ed33d3 !concurrency.tests From 601ba2fc93406348e2a6579c111ded8f2450180a Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Thu, 16 Feb 2023 14:36:13 +0000 Subject: [PATCH 13/23] Enable all tests --- unison-src/builtin-tests/concurrency-tests.u | 244 +++++++++---------- unison-src/builtin-tests/tests.u | 42 ++-- 2 files changed, 143 insertions(+), 143 deletions(-) diff --git a/unison-src/builtin-tests/concurrency-tests.u b/unison-src/builtin-tests/concurrency-tests.u index 1c712f4de1..87a059ddaf 100644 --- a/unison-src/builtin-tests/concurrency-tests.u +++ b/unison-src/builtin-tests/concurrency-tests.u @@ -1,99 +1,99 @@ concurrency.tests = do - -- !simpleRefTest - -- !simpleRefTestScope - -- !ticketTest - -- !casTest - -- !promiseSequentialTest - -- !promiseConcurrentTest - -- !forkKillTest - -- !tryEvalForkTest + !simpleRefTest + !simpleRefTestScope + !ticketTest + !casTest + !promiseSequentialTest + !promiseConcurrentTest + !forkKillTest + !tryEvalForkTest !tryEvalKillTest - -- !fullTest - --- simpleRefTest = do --- r = IO.ref 0 --- Ref.write r 1 --- i = Ref.read r --- Ref.write r 2 --- j = Ref.read r --- Ref.write r 5 --- checkEqual "Ref read-write" (i, j, Ref.read r) (1, 2, 5) - --- simpleRefTestScope = do --- Scope.run do --- r = Scope.ref 0 --- Ref.write r 1 --- i = Ref.read r --- Ref.write r 2 --- j = Ref.read r --- Ref.write r 5 --- checkEqual "Ref read-write" (i, j, Ref.read r) (1, 2, 5) - --- ticketTest = do --- r = IO.ref 3 --- t = Ref.readForCas r --- v = Ticket.read t --- checkEqual "Ticket contains the Ref value" v 3 - --- casTest = do --- ref = IO.ref 0 --- ticket = Ref.readForCas ref --- v1 = Ref.cas ref ticket 5 --- check "CAS is successful is there were no conflicting writes" 'v1 --- Ref.write ref 10 --- v2 = Ref.cas ref ticket 15 --- check "CAS fails when there was an intervening write" '(not v2) - --- promiseSequentialTest = do --- use Nat eq --- use Promise read write --- p = !Promise.new --- v0 = Promise.tryRead p --- checkEqual "Promise should be empty when created" v0 None --- Promise.write_ p 0 --- v1 = read p --- checkEqual "Promise should read a value that's been written" v1 0 --- Promise.write_ p 1 --- v2 = read p --- checkEqual "Promise can only be written to once" v2 v1 --- v3 = Promise.tryRead p --- checkEqual "Once the Promise is full, tryRead is the same as read" v3 (Some v2) + !fullTest + +simpleRefTest = do + r = IO.ref 0 + Ref.write r 1 + i = Ref.read r + Ref.write r 2 + j = Ref.read r + Ref.write r 5 + checkEqual "Ref read-write" (i, j, Ref.read r) (1, 2, 5) + +simpleRefTestScope = do + Scope.run do + r = Scope.ref 0 + Ref.write r 1 + i = Ref.read r + Ref.write r 2 + j = Ref.read r + Ref.write r 5 + checkEqual "Ref read-write" (i, j, Ref.read r) (1, 2, 5) + +ticketTest = do + r = IO.ref 3 + t = Ref.readForCas r + v = Ticket.read t + checkEqual "Ticket contains the Ref value" v 3 + +casTest = do + ref = IO.ref 0 + ticket = Ref.readForCas ref + v1 = Ref.cas ref ticket 5 + check "CAS is successful is there were no conflicting writes" 'v1 + Ref.write ref 10 + v2 = Ref.cas ref ticket 15 + check "CAS fails when there was an intervening write" '(not v2) + +promiseSequentialTest = do + use Nat eq + use Promise read write + p = !Promise.new + v0 = Promise.tryRead p + checkEqual "Promise should be empty when created" v0 None + Promise.write_ p 0 + v1 = read p + checkEqual "Promise should read a value that's been written" v1 0 + Promise.write_ p 1 + v2 = read p + checkEqual "Promise can only be written to once" v2 v1 + v3 = Promise.tryRead p + checkEqual "Once the Promise is full, tryRead is the same as read" v3 (Some v2) millis = 1000 sleep_ n = unsafeRun! do sleep n --- promiseConcurrentTest = do --- use Nat eq --- use concurrent fork --- p = !Promise.new --- _ = fork do --- sleep_ (200 * millis) --- Promise.write p 5 --- v = Promise.read p --- checkEqual "Reads awaits for completion of the Promise" v 5 +promiseConcurrentTest = do + use Nat eq + use concurrent fork + p = !Promise.new + _ = fork do + sleep_ (200 * millis) + Promise.write p 5 + v = Promise.read p + checkEqual "Reads awaits for completion of the Promise" v 5 kill_ t = unsafeRun! do concurrent.kill t --- forkKillTest = do --- ref = IO.ref "initial" --- thread = fork do --- sleep_ (400 * millis) --- Ref.write ref "done" --- sleep_ (200 * millis) --- kill_ thread --- sleep_ (300 * millis) --- v = Ref.read ref --- checkEqual "Thread was killed" v "initial" - --- tryEvalForkTest = do --- ref = IO.ref "initial" --- t = fork do --- match catchAll do sleep_ (400 * millis) with --- Left _ -> unsafeRun! do Ref.write ref "interrupted" --- Right _ -> unsafeRun! do Ref.write ref "finished" --- sleep_ (500 * millis) --- v = Ref.read ref --- checkEqual "tryEval is a no-op on success" v "finished" +forkKillTest = do + ref = IO.ref "initial" + thread = fork do + sleep_ (400 * millis) + Ref.write ref "done" + sleep_ (200 * millis) + kill_ thread + sleep_ (300 * millis) + v = Ref.read ref + checkEqual "Thread was killed" v "initial" + +tryEvalForkTest = do + ref = IO.ref "initial" + t = fork do + match catchAll do sleep_ (400 * millis) with + Left _ -> unsafeRun! do Ref.write ref "interrupted" + Right _ -> unsafeRun! do Ref.write ref "finished" + sleep_ (500 * millis) + v = Ref.read ref + checkEqual "tryEval is a no-op on success" v "finished" tryEvalKillTest = do ref = IO.ref "initial" @@ -107,42 +107,42 @@ tryEvalKillTest = do v = Ref.read ref checkEqual "Thread was killed, with finalisers" v "interrupted" --- atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () --- atomicUpdate ref f = --- ticket = Ref.readForCas ref --- value = f (Ticket.read ticket) --- if Ref.cas ref ticket value then () else atomicUpdate ref f +atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () +atomicUpdate ref f = + ticket = Ref.readForCas ref + value = f (Ticket.read ticket) + if Ref.cas ref ticket value then () else atomicUpdate ref f --- spawnN : Nat -> '{IO} a ->{IO} [a] --- spawnN n fa = --- use Nat eq - --- use concurrent fork +spawnN : Nat -> '{IO} a ->{IO} [a] +spawnN n fa = + use Nat eq - + use concurrent fork --- go i acc = --- if eq i 0 --- then acc --- else --- value = !Promise.new --- _ = fork do Promise.write value !fa --- go (i - 1) (acc :+ value) - --- map Promise.read (go n []) - --- fullTest = do --- use Nat * + eq - + go i acc = + if eq i 0 + then acc + else + value = !Promise.new + _ = fork do Promise.write value !fa + go (i - 1) (acc :+ value) + + map Promise.read (go n []) + +fullTest = do + use Nat * + eq - --- numThreads = 100 --- iterations = 100 --- expected = numThreads * iterations - --- state = IO.ref 0 --- thread n = --- if eq n 0 --- then () --- else --- atomicUpdate state (v -> v + 1) --- thread (n - 1) --- ignore (spawnN numThreads '(thread iterations)) --- result = Ref.read state --- checkEqual "The state of the counter is consistent " result expected + numThreads = 100 + iterations = 100 + expected = numThreads * iterations + + state = IO.ref 0 + thread n = + if eq n 0 + then () + else + atomicUpdate state (v -> v + 1) + thread (n - 1) + ignore (spawnN numThreads '(thread iterations)) + result = Ref.read state + checkEqual "The state of the counter is consistent " result expected diff --git a/unison-src/builtin-tests/tests.u b/unison-src/builtin-tests/tests.u index 10f6abe412..2308b36b1d 100644 --- a/unison-src/builtin-tests/tests.u +++ b/unison-src/builtin-tests/tests.u @@ -1,28 +1,28 @@ tests : '{IO,Exception} () tests = Tests.main do - -- check "Nat.+" do 1 + 1 == 2 - -- check "Nat.*" do 10 * 100 == 1000 - -- check "Nat./" do 100 / 10 == 10 + check "Nat.+" do 1 + 1 == 2 + check "Nat.*" do 10 * 100 == 1000 + check "Nat./" do 100 / 10 == 10 - -- -- cryptographic hashing - -- check "Sha1 hashBytes" do hashBytes Sha1 (toUtf8 "") === 0xsda39a3ee5e6b4b0d3255bfef95601890afd80709 - -- check "Sha2_256 hashBytes" do hashBytes Sha2_256 (toUtf8 "") === 0xse3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855 - -- check "Sha2_512 hashBytes" do hashBytes Sha2_512 (toUtf8 "") === 0xscf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e - -- check "Sha3_256 hashBytes" do hashBytes Sha3_256 (toUtf8 "") === 0xsa7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a - -- check "Sha3_512 hashBytes" do hashBytes Sha3_512 (toUtf8 "") === 0xsa69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26 - -- check "Blake2s_256 hashBytes" do hashBytes Blake2s_256 (toUtf8 "") === 0xs69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9 - -- check "Blake2b_256 hashBytes" do hashBytes Blake2b_256 (toUtf8 "") === 0xs0e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a8 - -- check "Blake2b_512 hashBytes" do hashBytes Blake2b_512 (toUtf8 "") === 0xs786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce + -- cryptographic hashing + check "Sha1 hashBytes" do hashBytes Sha1 (toUtf8 "") === 0xsda39a3ee5e6b4b0d3255bfef95601890afd80709 + check "Sha2_256 hashBytes" do hashBytes Sha2_256 (toUtf8 "") === 0xse3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855 + check "Sha2_512 hashBytes" do hashBytes Sha2_512 (toUtf8 "") === 0xscf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e + check "Sha3_256 hashBytes" do hashBytes Sha3_256 (toUtf8 "") === 0xsa7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a + check "Sha3_512 hashBytes" do hashBytes Sha3_512 (toUtf8 "") === 0xsa69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26 + check "Blake2s_256 hashBytes" do hashBytes Blake2s_256 (toUtf8 "") === 0xs69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9 + check "Blake2b_256 hashBytes" do hashBytes Blake2b_256 (toUtf8 "") === 0xs0e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a8 + check "Blake2b_512 hashBytes" do hashBytes Blake2b_512 (toUtf8 "") === 0xs786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce - -- -- hmacs - -- check "Sha1 hmacBytes" do hmacBytes Sha1 (toUtf8 "key") (toUtf8 "") === 0xsf42bb0eeb018ebbd4597ae7213711ec60760843f - -- check "Sha2_256 hmacBytes" do hmacBytes Sha2_256 (toUtf8 "key") (toUtf8 "") === 0xs5d5d139563c95b5967b9bd9a8c9b233a9dedb45072794cd232dc1b74832607d0 - -- check "Sha2_512 hmacBytes" do hmacBytes Sha2_512 (toUtf8 "key") (toUtf8 "") === 0xs84fa5aa0279bbc473267d05a53ea03310a987cecc4c1535ff29b6d76b8f1444a728df3aadb89d4a9a6709e1998f373566e8f824a8ca93b1821f0b69bc2a2f65e - -- check "Sha3_256 hmacBytes" do hmacBytes Sha3_256 (toUtf8 "key") (toUtf8 "") === 0xs74f3c030ecc36a1835d04a333ebb7fce2688c0c78fb0bcf9592213331c884c75 - -- check "Sha3_512 hmacBytes" do hmacBytes Sha3_512 (toUtf8 "key") (toUtf8 "") === 0xs7539119b6367aa902bdc6f558d20c906d6acbd4aba3fd344eb08b0200144a1fa453ff6e7919962358be53f6db2a320d1852c52a3dea3e907070775f7a91f1282 - -- check "Blake2s_256 hmacBytes" do hmacBytes Blake2s_256 (toUtf8 "key") (toUtf8 "") === 0xs67148074efc0f6741b474ef81c4d98d266e880d372fe723d2569b1d414d234be - -- check "Blake2b_256 hmacBytes" do hmacBytes Blake2b_256 (toUtf8 "key") (toUtf8 "") === 0xs4224e1297e51239a642e21f756bde2785716f872298178180d7f3d1d36a5e4e4 - -- check "Blake2b_512 hmacBytes" do hmacBytes Blake2b_512 (toUtf8 "key") (toUtf8 "") === 0xs019fe04bf010b8d72772e6b46897ecf74b4878c394ff2c4d5cfa0b7cc9bbefcb28c36de23cef03089db9c3d900468c89804f135e9fdef7ec9b3c7abe50ed33d3 + -- hmacs + check "Sha1 hmacBytes" do hmacBytes Sha1 (toUtf8 "key") (toUtf8 "") === 0xsf42bb0eeb018ebbd4597ae7213711ec60760843f + check "Sha2_256 hmacBytes" do hmacBytes Sha2_256 (toUtf8 "key") (toUtf8 "") === 0xs5d5d139563c95b5967b9bd9a8c9b233a9dedb45072794cd232dc1b74832607d0 + check "Sha2_512 hmacBytes" do hmacBytes Sha2_512 (toUtf8 "key") (toUtf8 "") === 0xs84fa5aa0279bbc473267d05a53ea03310a987cecc4c1535ff29b6d76b8f1444a728df3aadb89d4a9a6709e1998f373566e8f824a8ca93b1821f0b69bc2a2f65e + check "Sha3_256 hmacBytes" do hmacBytes Sha3_256 (toUtf8 "key") (toUtf8 "") === 0xs74f3c030ecc36a1835d04a333ebb7fce2688c0c78fb0bcf9592213331c884c75 + check "Sha3_512 hmacBytes" do hmacBytes Sha3_512 (toUtf8 "key") (toUtf8 "") === 0xs7539119b6367aa902bdc6f558d20c906d6acbd4aba3fd344eb08b0200144a1fa453ff6e7919962358be53f6db2a320d1852c52a3dea3e907070775f7a91f1282 + check "Blake2s_256 hmacBytes" do hmacBytes Blake2s_256 (toUtf8 "key") (toUtf8 "") === 0xs67148074efc0f6741b474ef81c4d98d266e880d372fe723d2569b1d414d234be + check "Blake2b_256 hmacBytes" do hmacBytes Blake2b_256 (toUtf8 "key") (toUtf8 "") === 0xs4224e1297e51239a642e21f756bde2785716f872298178180d7f3d1d36a5e4e4 + check "Blake2b_512 hmacBytes" do hmacBytes Blake2b_512 (toUtf8 "key") (toUtf8 "") === 0xs019fe04bf010b8d72772e6b46897ecf74b4878c394ff2c4d5cfa0b7cc9bbefcb28c36de23cef03089db9c3d900468c89804f135e9fdef7ec9b3c7abe50ed33d3 !concurrency.tests From 2502776a8fe7f3ea0d6615f523306f8a32bd95fe Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Thu, 16 Feb 2023 14:46:02 +0000 Subject: [PATCH 14/23] Assert on message from thread killed exception --- unison-src/builtin-tests/concurrency-tests.u | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/unison-src/builtin-tests/concurrency-tests.u b/unison-src/builtin-tests/concurrency-tests.u index 87a059ddaf..50b197fc11 100644 --- a/unison-src/builtin-tests/concurrency-tests.u +++ b/unison-src/builtin-tests/concurrency-tests.u @@ -89,7 +89,7 @@ tryEvalForkTest = do ref = IO.ref "initial" t = fork do match catchAll do sleep_ (400 * millis) with - Left _ -> unsafeRun! do Ref.write ref "interrupted" + Left _ -> () Right _ -> unsafeRun! do Ref.write ref "finished" sleep_ (500 * millis) v = Ref.read ref @@ -99,13 +99,13 @@ tryEvalKillTest = do ref = IO.ref "initial" t = fork do match catchAll do sleep_ (400 * millis) with - Left _ -> unsafeRun! do Ref.write ref "interrupted" + Left (Failure typ msg a) -> unsafeRun! do Ref.write ref msg Right _ -> unsafeRun! do Ref.write ref "finished" sleep_ (200 * millis) kill_ t sleep_ (300 * millis) v = Ref.read ref - checkEqual "Thread was killed, with finalisers" v "interrupted" + checkEqual "Thread was killed, with finalisers" v "thread killed" atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () atomicUpdate ref f = From 75e58b4bf6579926cff0ecc6deef2022a91a8510 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Fri, 17 Feb 2023 12:09:09 +0000 Subject: [PATCH 15/23] Point ucm back at trunk of internal compiler lib --- unison-cli/src/Unison/Codebase/Editor/HandleInput.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 94d1c74b74..b06e167faa 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -2659,7 +2659,7 @@ doFetchCompiler = { server = RemoteRepo.DefaultCodeserver, repo = ShareUserHandle "unison", path = - Path.fromList $ NameSegment <$> ["public", "internal", "primops"] + Path.fromList $ NameSegment <$> ["public", "internal", "trunk"] } repo = Just $ ReadRemoteNamespaceShare ns From d4c7c4009e796e35643216996400e8a379d5f2c4 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Fri, 17 Feb 2023 12:16:05 +0000 Subject: [PATCH 16/23] Better modelling of thread killed exceptions --- scheme-libs/racket/unison/concurrent.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 089f2486b0..90267d2235 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -91,5 +91,5 @@ (define (try-eval thunk) (with-handlers - ([exn:break? (lambda (x) (exception "referenceId" "thread killed" ()))]) + ([exn:break? (lambda (x) (exception "ThreadKilled" "thread killed" x))]) (right (thunk))))) From 9a979153ea057a6867812c06b8f1031c5161f17b Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Fri, 17 Feb 2023 12:22:42 +0000 Subject: [PATCH 17/23] Add TODO about type links --- scheme-libs/racket/unison/concurrent.ss | 1 + 1 file changed, 1 insertion(+) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 90267d2235..399b6f02dc 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -89,6 +89,7 @@ (break-thread threadId) (right unit)) + ;; TODO Add proper type links to the various exception types once we have them (define (try-eval thunk) (with-handlers ([exn:break? (lambda (x) (exception "ThreadKilled" "thread killed" x))]) From fe79b7c7bf8a88ae3bc55ab80551d74ebccd5b1c Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Fri, 17 Feb 2023 12:43:06 +0000 Subject: [PATCH 18/23] Categorise failures --- scheme-libs/racket/unison/concurrent.ss | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 399b6f02dc..10c668fbf3 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -33,14 +33,18 @@ parameterize-break sleep printf + with-handlers exn:break? - with-handlers) + exn:fail:read? + exn:fail:filesystem? + exn:fail:network? + exn:fail?) (box ref-new) (unbox ref-read) (set-box! ref-write) (sleep sleep-secs)) - (only (racket unsafe ops) unsafe-struct*-cas!) - (unison data)) + (only (racket exn) exn->string) + (only (racket unsafe ops) unsafe-struct*-cas!)) (define-record-type promise (fields semaphore event (mutable value))) @@ -89,8 +93,15 @@ (break-thread threadId) (right unit)) + (define (exn:io? e) + (or (exn:fail:read? e) + (exn:fail:filesystem? e) + (exn:fail:network? e))) + ;; TODO Add proper type links to the various exception types once we have them (define (try-eval thunk) (with-handlers - ([exn:break? (lambda (x) (exception "ThreadKilled" "thread killed" x))]) + ([exn:break? (lambda (e) (exception "ThreadKilled" "thread killed" ()))] + [exn:io? (lambda (e) (exception "IOException" (exn->string e) ()))] + [exn:fail? (lambda (e) (exception "MiscFailure" (exn->string e) ()))]) (right (thunk))))) From 40fef4d8ce5485c5a64e8be887bff80c766b07ad Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Fri, 17 Feb 2023 12:53:27 +0000 Subject: [PATCH 19/23] Catch all other stray exceptions --- scheme-libs/racket/unison/concurrent.ss | 3 ++- unison-src/builtin-tests/tests.u | 9 +++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 10c668fbf3..4f64e77dcc 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -103,5 +103,6 @@ (with-handlers ([exn:break? (lambda (e) (exception "ThreadKilled" "thread killed" ()))] [exn:io? (lambda (e) (exception "IOException" (exn->string e) ()))] - [exn:fail? (lambda (e) (exception "MiscFailure" (exn->string e) ()))]) + [exn:fail? (lambda (e) (exception "MiscFailure" (exn->string e) ()))] + [(lambda (x) #t) (lambda (e) (exception "MiscFailure" "unknown exception" e))]) (right (thunk))))) diff --git a/unison-src/builtin-tests/tests.u b/unison-src/builtin-tests/tests.u index 2308b36b1d..1a3891fe07 100644 --- a/unison-src/builtin-tests/tests.u +++ b/unison-src/builtin-tests/tests.u @@ -26,3 +26,12 @@ tests = Tests.main do check "Blake2b_512 hmacBytes" do hmacBytes Blake2b_512 (toUtf8 "key") (toUtf8 "") === 0xs019fe04bf010b8d72772e6b46897ecf74b4878c394ff2c4d5cfa0b7cc9bbefcb28c36de23cef03089db9c3d900468c89804f135e9fdef7ec9b3c7abe50ed33d3 !concurrency.tests + !foo + + +foo = do + match catchAll do bug "nooo!" with + Left (Failure typ msg a) -> + IO.console.printLine msg + IO.console.printLine "caught there" + Right _ -> () From 88122d36e2763d3ec092abe9d68e554039bf99a2 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Fri, 17 Feb 2023 13:35:49 +0000 Subject: [PATCH 20/23] Better assertion for testing `bug` --- unison-src/builtin-tests/tests.u | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/unison-src/builtin-tests/tests.u b/unison-src/builtin-tests/tests.u index 1a3891fe07..363bf6da39 100644 --- a/unison-src/builtin-tests/tests.u +++ b/unison-src/builtin-tests/tests.u @@ -25,13 +25,5 @@ tests = Tests.main do check "Blake2b_256 hmacBytes" do hmacBytes Blake2b_256 (toUtf8 "key") (toUtf8 "") === 0xs4224e1297e51239a642e21f756bde2785716f872298178180d7f3d1d36a5e4e4 check "Blake2b_512 hmacBytes" do hmacBytes Blake2b_512 (toUtf8 "key") (toUtf8 "") === 0xs019fe04bf010b8d72772e6b46897ecf74b4878c394ff2c4d5cfa0b7cc9bbefcb28c36de23cef03089db9c3d900468c89804f135e9fdef7ec9b3c7abe50ed33d3 + check "bug is caught" do isLeft (catchAll do bug ()) !concurrency.tests - !foo - - -foo = do - match catchAll do bug "nooo!" with - Left (Failure typ msg a) -> - IO.console.printLine msg - IO.console.printLine "caught there" - Right _ -> () From 704648a7e0113ed573c64894e9ef5dae40fbb9fc Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Fri, 17 Feb 2023 13:46:37 +0000 Subject: [PATCH 21/23] More precise categorisation of exceptions --- scheme-libs/racket/unison/concurrent.ss | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 4f64e77dcc..5bd613fd80 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -35,10 +35,12 @@ printf with-handlers exn:break? + exn:fail? exn:fail:read? exn:fail:filesystem? exn:fail:network? - exn:fail?) + exn:fail:contract:divide-by-zero? + exn:fail:contract:non-fixnum-result?) (box ref-new) (unbox ref-read) (set-box! ref-write) @@ -98,11 +100,16 @@ (exn:fail:filesystem? e) (exn:fail:network? e))) - ;; TODO Add proper type links to the various exception types once we have them + (define (exn:arith? e) + (or (exn:fail:contract:divide-by-zero? e) + (exn:fail:contract:non-fixnum-result? e))) + + ;; TODO Replace strings with proper type links once we have them (define (try-eval thunk) (with-handlers - ([exn:break? (lambda (e) (exception "ThreadKilled" "thread killed" ()))] - [exn:io? (lambda (e) (exception "IOException" (exn->string e) ()))] - [exn:fail? (lambda (e) (exception "MiscFailure" (exn->string e) ()))] + ([exn:break? (lambda (e) (exception "ThreadKilledFailure" "thread killed" ()))] + [exn:io? (lambda (e) (exception "IOFailure" (exn->string e) ()))] + [exn:arith? (lambda (e) (exception "ArithmeticFailure" (exn->string e) ()))] + [exn:fail? (lambda (e) (exception "RuntimeFailure" (exn->string e) ()))] [(lambda (x) #t) (lambda (e) (exception "MiscFailure" "unknown exception" e))]) (right (thunk))))) From b71393e7579b4d50673504e8b7de322393f11542 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Fri, 17 Feb 2023 14:19:09 +0000 Subject: [PATCH 22/23] Slight refactor of test suite --- unison-src/builtin-tests/tests.u | 54 ++++++++++++++++++-------------- 1 file changed, 30 insertions(+), 24 deletions(-) diff --git a/unison-src/builtin-tests/tests.u b/unison-src/builtin-tests/tests.u index 363bf6da39..57ab19abec 100644 --- a/unison-src/builtin-tests/tests.u +++ b/unison-src/builtin-tests/tests.u @@ -1,29 +1,35 @@ tests : '{IO,Exception} () tests = Tests.main do - check "Nat.+" do 1 + 1 == 2 - check "Nat.*" do 10 * 100 == 1000 - check "Nat./" do 100 / 10 == 10 - - -- cryptographic hashing - check "Sha1 hashBytes" do hashBytes Sha1 (toUtf8 "") === 0xsda39a3ee5e6b4b0d3255bfef95601890afd80709 - check "Sha2_256 hashBytes" do hashBytes Sha2_256 (toUtf8 "") === 0xse3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855 - check "Sha2_512 hashBytes" do hashBytes Sha2_512 (toUtf8 "") === 0xscf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e - check "Sha3_256 hashBytes" do hashBytes Sha3_256 (toUtf8 "") === 0xsa7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a - check "Sha3_512 hashBytes" do hashBytes Sha3_512 (toUtf8 "") === 0xsa69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26 - check "Blake2s_256 hashBytes" do hashBytes Blake2s_256 (toUtf8 "") === 0xs69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9 - check "Blake2b_256 hashBytes" do hashBytes Blake2b_256 (toUtf8 "") === 0xs0e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a8 - check "Blake2b_512 hashBytes" do hashBytes Blake2b_512 (toUtf8 "") === 0xs786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce + !crypto.hash.tests + !hmac.tests + !concurrency.tests + check "bug is caught" do isLeft (catchAll do bug ()) - -- hmacs - check "Sha1 hmacBytes" do hmacBytes Sha1 (toUtf8 "key") (toUtf8 "") === 0xsf42bb0eeb018ebbd4597ae7213711ec60760843f - check "Sha2_256 hmacBytes" do hmacBytes Sha2_256 (toUtf8 "key") (toUtf8 "") === 0xs5d5d139563c95b5967b9bd9a8c9b233a9dedb45072794cd232dc1b74832607d0 - check "Sha2_512 hmacBytes" do hmacBytes Sha2_512 (toUtf8 "key") (toUtf8 "") === 0xs84fa5aa0279bbc473267d05a53ea03310a987cecc4c1535ff29b6d76b8f1444a728df3aadb89d4a9a6709e1998f373566e8f824a8ca93b1821f0b69bc2a2f65e - check "Sha3_256 hmacBytes" do hmacBytes Sha3_256 (toUtf8 "key") (toUtf8 "") === 0xs74f3c030ecc36a1835d04a333ebb7fce2688c0c78fb0bcf9592213331c884c75 - check "Sha3_512 hmacBytes" do hmacBytes Sha3_512 (toUtf8 "key") (toUtf8 "") === 0xs7539119b6367aa902bdc6f558d20c906d6acbd4aba3fd344eb08b0200144a1fa453ff6e7919962358be53f6db2a320d1852c52a3dea3e907070775f7a91f1282 - check "Blake2s_256 hmacBytes" do hmacBytes Blake2s_256 (toUtf8 "key") (toUtf8 "") === 0xs67148074efc0f6741b474ef81c4d98d266e880d372fe723d2569b1d414d234be - check "Blake2b_256 hmacBytes" do hmacBytes Blake2b_256 (toUtf8 "key") (toUtf8 "") === 0xs4224e1297e51239a642e21f756bde2785716f872298178180d7f3d1d36a5e4e4 - check "Blake2b_512 hmacBytes" do hmacBytes Blake2b_512 (toUtf8 "key") (toUtf8 "") === 0xs019fe04bf010b8d72772e6b46897ecf74b4878c394ff2c4d5cfa0b7cc9bbefcb28c36de23cef03089db9c3d900468c89804f135e9fdef7ec9b3c7abe50ed33d3 +crypto.hash.tests = do + hash alg = hashBytes alg (toUtf8 "") + tag name = name ++ " hashBytes" + [ + ("Sha1", Sha1, 0xsda39a3ee5e6b4b0d3255bfef95601890afd80709), + ("Sha2_256", Sha2_256, 0xse3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855), + ("Sha2_512", Sha2_512, 0xscf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e), + ("Sha3_256", Sha3_256, 0xsa7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a), + ("Sha3_512", Sha3_512, 0xsa69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26), + ("Blake2s_256", Blake2s_256, 0xs69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9), + ("Blake2b_256", Blake2b_256, 0xs0e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a8), + ("Blake2b_512", Blake2b_512, 0xs786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce) + ] |> List.foreach_ cases (name, alg, res) -> checkEqual (tag name) (hash alg) res - check "bug is caught" do isLeft (catchAll do bug ()) - !concurrency.tests +hmac.tests = do + hmac alg = hmacBytes alg (toUtf8 "key") (toUtf8 "") + tag name = name ++ " hmacBytes" + [ + ("Sha1", Sha1, 0xsf42bb0eeb018ebbd4597ae7213711ec60760843f), + ("Sha2_256", Sha2_256, 0xs5d5d139563c95b5967b9bd9a8c9b233a9dedb45072794cd232dc1b74832607d0), + ("Sha2_512", Sha2_512, 0xs84fa5aa0279bbc473267d05a53ea03310a987cecc4c1535ff29b6d76b8f1444a728df3aadb89d4a9a6709e1998f373566e8f824a8ca93b1821f0b69bc2a2f65e), + ("Sha3_256", Sha3_256, 0xs74f3c030ecc36a1835d04a333ebb7fce2688c0c78fb0bcf9592213331c884c75), + ("Sha3_512", Sha3_512, 0xs7539119b6367aa902bdc6f558d20c906d6acbd4aba3fd344eb08b0200144a1fa453ff6e7919962358be53f6db2a320d1852c52a3dea3e907070775f7a91f1282), + ("Blake2s_256", Blake2s_256, 0xs67148074efc0f6741b474ef81c4d98d266e880d372fe723d2569b1d414d234be), + ("Blake2b_256", Blake2b_256, 0xs4224e1297e51239a642e21f756bde2785716f872298178180d7f3d1d36a5e4e4), + ("Blake2b_512", Blake2b_512, 0xs019fe04bf010b8d72772e6b46897ecf74b4878c394ff2c4d5cfa0b7cc9bbefcb28c36de23cef03089db9c3d900468c89804f135e9fdef7ec9b3c7abe50ed33d3) + ] |> List.foreach_ cases (name, alg, res) -> checkEqual (tag name) (hmac alg) res From 2ee1f5a118fc78ff2694676ed1192451597c4a19 Mon Sep 17 00:00:00 2001 From: Fabio Labella Date: Fri, 17 Feb 2023 14:32:50 +0000 Subject: [PATCH 23/23] Correct output --- unison-src/builtin-tests/base.output.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-src/builtin-tests/base.output.md b/unison-src/builtin-tests/base.output.md index f47cea815e..e51894c11a 100644 --- a/unison-src/builtin-tests/base.output.md +++ b/unison-src/builtin-tests/base.output.md @@ -11,6 +11,6 @@ ✅ Successfully updated .unison.internal from - unison.public.internal.primops. + unison.public.internal.trunk. ```