improve test code extraction

Author: keiravillekode

bin/run.sh

@@ -75,20 +75,57 @@ AWK
 # 1. Extract source-test records (one JSON object per line, NDJSON):
 #    {"line_no":N,"task_id":N|null,"test_code":"..."}
 #    Reads the post-strip file so line numbers match what Factor reports.
+#    A test runs from its first code line through the line that ends in a
+#    test word (e.g. `unit-test`); accumulate the whole span so `test_code`
+#    holds the full multi-line source, not just the closing `] unit-test`.
+#    `line_no` stays the closing line, matching what Factor reports for
+#    failures. Blank, comment, and TASK lines reset the buffer so they are
+#    never folded into the next test.
 src_tests=$(awk "${awk_json}"'
-    BEGIN { task = "null" }
+    function reset() {
+        n = 0
+        delete buf
+    }
+    function flush(   i, code) {
+        code = ""
+        for (i = 1; i <= n; i++) code = code (i > 1 ? "\n" : "") buf[i]
+        printf "{\"line_no\":%d,\"task_id\":%s,\"test_code\":%s}\n", NR, task, json_str(code)
+        reset()
+    }
+    BEGIN {
+        task = "null"
+        n = 0
+    }
     /^[[:space:]]*TASK:[[:space:]]+[0-9]+/ {
         match($0, /TASK:[[:space:]]+[0-9]+/)
         s = substr($0, RSTART, RLENGTH)
         sub(/^TASK:[[:space:]]+/, "", s)
         task = s
+        reset()
         next
     }
-    /(unit-test|unit-test~|unit-test-v~|long-unit-test|must-fail-with|must-fail|must-not-fail|must-infer|must-infer-as)[[:space:]]*$/ {
+    /^[[:space:]]*$/ {
+        reset()
+        next
+    }
+    /^[[:space:]]*!/ {
+        reset()
+        next
+    }
+    # A `"label" description` line names the test that follows; it is its own
+    # statement, not part of the test form, so treat it as a boundary.
+    /^[[:space:]]*"[^"]*"[[:space:]]+description[[:space:]]*$/ {
+        reset()
+        next
+    }
+    {
         line = $0
-        sub(/^[[:space:]]+/, "", line)
         sub(/[[:space:]]+$/, "", line)
-        printf "{\"line_no\":%d,\"task_id\":%s,\"test_code\":%s}\n", NR, task, json_str(line)
+        n++
+        buf[n] = line
+    }
+    /(unit-test|unit-test~|unit-test-v~|long-unit-test|must-fail-with|must-fail|must-not-fail|must-infer|must-infer-as)[[:space:]]*$/ {
+        flush()
     }
 ' "${tmp_dir}/${slug}/${slug}-tests.factor")
 
@@ -139,6 +176,17 @@ parsed=$(printf '%s\n' "${raw_output}" | awk "${awk_json}"'
         delete seg
         cur_name = pending_name
         pending_name = ""
+        # Factor pretty-prints a long test form across lines: the header
+        # line is just "Unit Test: {" and the form body follows, indented,
+        # up to a closing "}" at column 0. Those continuation lines are an
+        # echo of the test, not program output, so skip them.
+        rest = $0
+        sub(header_re, "", rest)
+        if (rest == "{") state = "header_cont"
+        next
+    }
+    state == "header_cont" {
+        if ($0 ~ /^}[[:space:]]*$/) state = "inline"
         next
     }
     # A generated "###DESC### <description>" line labels the test that

tests/concept-concurrency/expected_results.json

@@ -47,9 +47,8 @@
     {
       "name": "Test 8",
       "status": "pass",
-      "test_code": "] unit-test",
-      "task_id": 3,
-      "output": "    { 5 0 }\n    [\n        <crane> dup 5 swap hoist-crate\n        tonnage>> <crane> tonnage>>\n    ]\n}"
+      "test_code": "{ 5 0 } [\n    <crane> dup 5 swap hoist-crate tonnage>>\n    <crane> tonnage>>\n] unit-test",
+      "task_id": 3
     },
     {
       "name": "Test 9",
@@ -60,9 +59,8 @@
     {
       "name": "Test 10",
       "status": "pass",
-      "test_code": "] unit-test",
-      "task_id": 4,
-      "output": "    { 52 }\n    [\n        <crane> dup 35 swap hoist-crate dup 17 swap hoist-crate\n        tonnage>>\n    ]\n}"
+      "test_code": "{ 52 }\n[\n    <crane>\n    dup 35 swap hoist-crate\n    dup 17 swap hoist-crate\n    tonnage>>\n] unit-test",
+      "task_id": 4
     },
     {
       "name": "Test 11",
@@ -79,22 +77,20 @@
     {
       "name": "Test 13",
       "status": "pass",
-      "test_code": "] unit-test",
-      "task_id": 6,
-      "output": "    { 32 }\n    [\n        <crane> { { 5 5 } { 10 } { 3 4 5 } } over load-cargo\n        crane-tonnage\n    ]\n}"
+      "test_code": "{ 32 } [\n    <crane>\n    { { 5 5 } { 10 } { 3 4 5 } } over load-cargo\n    crane-tonnage\n] unit-test",
+      "task_id": 6
     },
     {
       "name": "Test 14",
       "status": "pass",
-      "test_code": "] unit-test",
+      "test_code": "{ 0 } [\n    <crane>\n    { } over load-cargo\n    crane-tonnage\n] unit-test",
       "task_id": 6
     },
     {
       "name": "Test 15",
       "status": "pass",
-      "test_code": "] unit-test",
-      "task_id": 6,
-      "output": "    { 5050 }\n    [\n        <crane> 100 <iota> [ 1 + 1array ] map over load-cargo\n        crane-tonnage\n    ]\n}"
+      "test_code": "{ 5050 } [\n    <crane>\n    100 <iota> [ 1 + 1array ] map\n    over load-cargo\n    crane-tonnage\n] unit-test",
+      "task_id": 6
     }
   ]
 }

tests/concept-quotations/concept-quotations/concept-quotations-tests.factor

@@ -0,0 +1,69 @@
+USING: concept-quotations exercism-tools kernel math math.order
+random random.mersenne-twister sequences sets sorting tools.test ;
+IN: concept-quotations.tests
+
+TASK: 1 roll-die
+{ 6 } [ 4 <mersenne-twister> [ 6 roll-die ] with-random ] unit-test
+
+STOP-HERE
+
+{ 2 } [ 5 <mersenne-twister> [ 6 roll-die ] with-random ] unit-test
+
+! Every roll of a six-sided die lands in 1..6.
+{ t } [
+    1 <mersenne-twister> [ 200 [ 6 roll-die ] replicate ] with-random
+    [ 1 6 between? ] all?
+] unit-test
+
+TASK: 2 pick-prize
+{ "e" } [
+    4 <mersenne-twister>
+    [ { "a" "b" "c" "d" "e" } pick-prize ] with-random
+] unit-test
+
+{ "b" } [
+    5 <mersenne-twister>
+    [ { "a" "b" "c" "d" "e" } pick-prize ] with-random
+] unit-test
+
+TASK: 3 shuffle-deck
+{ { 5 1 3 4 2 } } [
+    42 <mersenne-twister> [ { 1 2 3 4 5 } shuffle-deck ] with-random
+] unit-test
+
+{ { 2 4 3 5 1 } } [
+    7 <mersenne-twister> [ { 1 2 3 4 5 } shuffle-deck ] with-random
+] unit-test
+
+! Shuffling keeps exactly the same cards, only reordered.
+{ t } [
+    13 <mersenne-twister> [ { 3 1 4 1 5 9 } shuffle-deck ] with-random
+    natural-sort { 1 1 3 4 5 9 } =
+] unit-test
+
+TASK: 4 deal-hand
+{ { 30 40 20 } } [
+    42 <mersenne-twister> [ { 10 20 30 40 50 } 3 deal-hand ] with-random
+] unit-test
+
+{ { 30 50 10 } } [
+    7 <mersenne-twister> [ { 10 20 30 40 50 } 3 deal-hand ] with-random
+] unit-test
+
+! A dealt hand is distinct cards drawn from the deck.
+{ t } [
+    7 <mersenne-twister> [ { 10 20 30 40 50 } 3 deal-hand ] with-random
+    [ [ { 10 20 30 40 50 } member? ] all? ]
+    [ [ length ] [ members length ] bi = ] bi and
+] unit-test
+
+TASK: 5 play-seeded
+! play-seeded installs the seeded generator and returns the result.
+{ 6 } [ 4 [ 6 roll-die ] play-seeded ] unit-test
+
+! The same seed reproduces the same game.
+{ t } [
+    99 [ { 10 20 30 40 50 } 3 deal-hand ] play-seeded
+    99 [ { 10 20 30 40 50 } 3 deal-hand ] play-seeded
+    =
+] unit-test

tests/concept-quotations/concept-quotations/concept-quotations.factor

@@ -0,0 +1,17 @@
+USING: kernel locals math random random.mersenne-twister ;
+IN: concept-quotations
+
+:: roll-die ( sides -- n )
+    sides random 1 + ;
+
+:: pick-prize ( prizes -- prize )
+    prizes random ;
+
+:: shuffle-deck ( deck -- deck' )
+    deck randomize ;
+
+:: deal-hand ( deck n -- hand )
+    deck n sample ;
+
+:: play-seeded ( seed quot -- )
+    seed 1 + <mersenne-twister> quot with-random ; inline

tests/concept-quotations/exercism-tools/exercism-tools.factor

@@ -0,0 +1,37 @@
+USING: accessors command-line continuations debugger io kernel
+       lexer namespaces sequences source-files.errors.debugger
+       system tools.test vocabs vocabs.loader ;
+IN: exercism-tools
+
+SYNTAX: STOP-HERE
+    lexer get [ text>> length ] keep line<< ;
+
+SYNTAX: TASK:
+    lexer get next-line ;
+
+! Label the test that follows with its description. The marker lets the
+! wrapper strip this line from captured output and attach it to the next
+! test as a name, rather than leaving it in the previous test's output.
+: description ( str -- )
+    "###DESC### " write print ;
+
+! Print one failure block in a stable, parser-friendly form. Bracketed by
+! markers so a wrapper can split the stream reliably and avoid Factor's
+! noisy callstack output (which is interleaved with subsequent failures).
+:: print-failure ( failure -- )
+    "###FAIL_BEGIN###" print
+    failure error-location print
+    failure error>> [ error. ] [ 2drop ] recover
+    "###FAIL_END###" print
+    flush ;
+
+: print-failures ( -- )
+    test-failures get [ print-failure ] each ;
+
+: run-exercism-tests ( -- )
+    command-line get first
+    [ require ] [ test ] bi
+    test-failures get empty?
+    [ 0 exit ] [ print-failures 1 exit ] if ;
+
+MAIN: run-exercism-tests

tests/concept-quotations/expected_results.json

@@ -0,0 +1,85 @@
+{
+  "version": 3,
+  "status": "fail",
+  "tests": [
+    {
+      "name": "Test 1",
+      "status": "pass",
+      "test_code": "{ 6 } [ 4 <mersenne-twister> [ 6 roll-die ] with-random ] unit-test",
+      "task_id": 1
+    },
+    {
+      "name": "Test 2",
+      "status": "pass",
+      "test_code": "{ 2 } [ 5 <mersenne-twister> [ 6 roll-die ] with-random ] unit-test",
+      "task_id": 1
+    },
+    {
+      "name": "Test 3",
+      "status": "pass",
+      "test_code": "{ t } [\n    1 <mersenne-twister> [ 200 [ 6 roll-die ] replicate ] with-random\n    [ 1 6 between? ] all?\n] unit-test",
+      "task_id": 1
+    },
+    {
+      "name": "Test 4",
+      "status": "pass",
+      "test_code": "{ \"e\" } [\n    4 <mersenne-twister>\n    [ { \"a\" \"b\" \"c\" \"d\" \"e\" } pick-prize ] with-random\n] unit-test",
+      "task_id": 2
+    },
+    {
+      "name": "Test 5",
+      "status": "pass",
+      "test_code": "{ \"b\" } [\n    5 <mersenne-twister>\n    [ { \"a\" \"b\" \"c\" \"d\" \"e\" } pick-prize ] with-random\n] unit-test",
+      "task_id": 2
+    },
+    {
+      "name": "Test 6",
+      "status": "pass",
+      "test_code": "{ { 5 1 3 4 2 } } [\n    42 <mersenne-twister> [ { 1 2 3 4 5 } shuffle-deck ] with-random\n] unit-test",
+      "task_id": 3
+    },
+    {
+      "name": "Test 7",
+      "status": "pass",
+      "test_code": "{ { 2 4 3 5 1 } } [\n    7 <mersenne-twister> [ { 1 2 3 4 5 } shuffle-deck ] with-random\n] unit-test",
+      "task_id": 3
+    },
+    {
+      "name": "Test 8",
+      "status": "pass",
+      "test_code": "{ t } [\n    13 <mersenne-twister> [ { 3 1 4 1 5 9 } shuffle-deck ] with-random\n    natural-sort { 1 1 3 4 5 9 } =\n] unit-test",
+      "task_id": 3
+    },
+    {
+      "name": "Test 9",
+      "status": "pass",
+      "test_code": "{ { 30 40 20 } } [\n    42 <mersenne-twister> [ { 10 20 30 40 50 } 3 deal-hand ] with-random\n] unit-test",
+      "task_id": 4
+    },
+    {
+      "name": "Test 10",
+      "status": "pass",
+      "test_code": "{ { 30 50 10 } } [\n    7 <mersenne-twister> [ { 10 20 30 40 50 } 3 deal-hand ] with-random\n] unit-test",
+      "task_id": 4
+    },
+    {
+      "name": "Test 11",
+      "status": "pass",
+      "test_code": "{ t } [\n    7 <mersenne-twister> [ { 10 20 30 40 50 } 3 deal-hand ] with-random\n    [ [ { 10 20 30 40 50 } member? ] all? ]\n    [ [ length ] [ members length ] bi = ] bi and\n] unit-test",
+      "task_id": 4
+    },
+    {
+      "name": "Test 12",
+      "status": "fail",
+      "test_code": "{ 6 } [ 4 [ 6 roll-die ] play-seeded ] unit-test",
+      "task_id": 5,
+      "message": "=== Expected:\n6\n=== Got:\n2"
+    },
+    {
+      "name": "Test 13",
+      "status": "pass",
+      "test_code": "{ t } [\n    99 [ { 10 20 30 40 50 } 3 deal-hand ] play-seeded\n    99 [ { 10 20 30 40 50 } 3 deal-hand ] play-seeded\n    =\n] unit-test",
+      "task_id": 5
+    }
+  ]
+}