Refactor/document test suite (#436)

* refactor CI script

* fix paths

* restore .gitignore

* document test suite

* get root dir from shell

* check if args empty

* check if root path exists

* check if test-runner exists

* include test suite output

* fix configlet badge

README.md

@@ -0,0 +1,28 @@
+# Exercism Clojure Track
+
+[![Configlet CI](https://github.com/exercism/clojure/actions/workflows/configlet.yml/badge.svg)](https://github.com/exercism/clojure/actions/workflows/configlet.yml)
+[![test](https://github.com/exercism/clojure/workflows/test/badge.svg)](https://github.com/exercism/clojure/actions?query=workflow%3Atest)
+
+**Exercism exercises in [Clojure](https://clojure.org/)**
+
+This is the Clojure track, one of the many tracks on [Exercism][web-exercism].
+It holds all the _exercises_ that are currently implemented and available for students to complete.
+The track consists of various **concept** exercises which teach the [Clojure syllabus][web-syllabus], and various practice exercises, which are unlocked by progressing in the syllabus and can be used to practice concepts learned.
+You can find this in the [`config.json`][file-config].
+
+## Running the test suite
+
+To test all exercises with sample solutions using [babashka](https://babashka.org/):
+
+```bash
+./test.clj .
+```
+{:tested 86, :fails ()}
+
+## Contributing Guide
+
+Please see the [contributing guide](https://exercism.org/docs/building).
+
+[web-exercism]: https://exercism.org
+[web-syllabus]: https://exercism.org/tracks/clojure/concepts
+[file-config]: https://github.com/exercism/clojure/blob/main/config.json

test-runner.clj

@@ -0,0 +1,156 @@
+#!/usr/bin/env bb
+
+(require '[clojure.test :as t :refer [is deftest]]
+         '[babashka.classpath :as cp]
+         '[cheshire.core :as json]
+         '[clojure.string :as str]
+         '[rewrite-clj.zip :as z])
+
+(comment
+  (def slug "leap")
+  (def in-dir "/home/porky/exercism/clojure-test-runner/tests/example-success/")
+  )
+
+;; Add solution source and tests to classpath
+(def slug (first *command-line-args*))
+(def in-dir (second *command-line-args*))
+(def test-ns (symbol (str slug "-test")))
+(cp/add-classpath (str in-dir "src:" in-dir "test"))
+(require test-ns)
+
+;; Parse test file into zipper using rewrite-clj
+(def zloc (z/of-file (str in-dir "/test/" (str/replace slug "-" "_") "_test.clj")))
+
+(defmethod t/report :fail [m])
+
+(defn eval-is [assertion]
+  (try (eval assertion)
+       (catch Exception e
+         (str e))))
+
+(defn test-meta [loc]
+  (-> loc
+      (z/find-tag z/next :meta)
+      first
+      :children
+      first
+      :k))
+
+(defn test-deftest 
+  "Traverses a zipper from a 'deftest node. Recursively 
+   evaluates all assertions and outputs a map of the results."
+  [loc]
+  (let [test loc]
+    (loop [loc test prefix-string ""
+           test-strings [] results [] assertions []]
+      (cond
+        (= (symbol 'deftest) (-> loc z/down z/sexpr))
+        (recur (-> loc z/down z/right z/right)
+               prefix-string test-strings results assertions)
+        (and
+         (= (symbol 'testing) (-> loc z/down z/sexpr))
+         (= (symbol 'testing) (-> loc z/down z/right z/right z/down z/sexpr)))
+        (recur (-> loc z/down z/right z/right)
+               (-> loc z/down z/right z/sexpr)
+               test-strings results assertions)
+        (= (symbol 'testing) (-> loc z/down z/sexpr))
+        (recur (-> loc z/down z/right z/right)
+               prefix-string
+               (conj test-strings
+                     (str/trim (str prefix-string " "
+                                    (-> loc z/down z/right z/sexpr))))
+               (conj results [])
+               assertions)
+        (and 
+         (= (symbol 'is) (-> loc z/down z/sexpr)) 
+         (= (symbol 'is) (-> loc z/right z/down z/sexpr)))
+        (recur (-> loc z/right)
+               prefix-string
+               test-strings
+               (conj results [(eval-is (-> loc z/sexpr))])
+               (conj assertions (z/sexpr loc)))
+        (= (symbol 'is) (-> loc z/down z/sexpr))
+        (recur (if (= (symbol 'testing) (-> loc z/up z/right z/sexpr))
+                 (-> loc z/up z/right)
+                 (-> loc z/right))
+               prefix-string
+               test-strings
+               (conj (vec (butlast results))
+                     (conj (vec (last results)) (eval-is (-> loc z/sexpr))))
+               (conj assertions (z/sexpr loc)))
+        :else
+        {:test-name (-> test z/down z/right z/sexpr str)
+         :results (vec (remove empty? results))
+         :test-strings test-strings
+         :assertions assertions
+         :task_id (when (number? (test-meta test)) (Integer/parseInt (str/replace (str (test-meta test)) ":task" "")))}))))
+
+(comment
+  (test-deftest (z/of-string "(deftest year-not-divisible-by-4 (is (not (leap/leap-year? 2015))))")
+)
+  (test-deftest (-> zloc z/right))
+  )
+
+(defn test-file 
+  "Takes a zipper representing a parsed test file.
+   Finds each 'deftest form, tests it, and outputs
+   an ordered sequence of result maps."
+  [loc]
+  (loop [loc loc
+         tests []]
+    (cond
+      (nil? loc) tests
+      (= (symbol 'deftest) (-> loc z/down z/sexpr)) 
+      (recur (-> loc z/right) (conj tests (test-deftest loc)))
+      :else 
+      (recur (-> loc z/right) tests))))
+
+(comment
+  (test-file zloc))
+
+(defn results 
+  "Takes a zipper representing a parsed test file.
+   Outputs the test results according to the spec."
+  [loc]
+  (flatten
+   (for [test (test-file loc)]
+     (if (empty? (:test-strings test))
+       {:name (:test-name test)
+        :status (if (every? true? (flatten (:results test)))
+                  "pass" "fail")
+        :test_code (str (first (:assertions test)))}
+       (for [n (range (count (:test-strings test)))]
+         {:name (get (:test-strings test) n)
+          :status (cond 
+                    (every? true? (get (:results test) n)) "pass" 
+                    (some false? (get (:results test) n)) "fail"
+                    :else "error")
+          :test_code (str (get (:assertions test) n))
+          :task_id (:task_id test)})))))
+
+(comment
+  (first (test-file zloc))
+  (results zloc)
+  (eval-is '(is (= true (annalyns-infiltration/can-fast-attack? false))))
+  (eval-is '(is (= true (annas-infiltration/can-fast-attack? false))))
+  (eval-is '(is (= false (annalyns-infiltration/can-fast-attack? e))))
+  (results zloc)
+  )
+
+;; Produce JSON output
+
+(println (json/generate-string
+      {:version 3
+       :status (cond 
+                 (every? #(= "pass" (:status %)) (results zloc)) "pass" 
+                 (some #(= "fail" (:status %)) (results zloc)) "fail"
+                 :else "error")
+       :message 
+                  (first (remove #(or (= "pass" (:status %))
+                                      (= "fail" (:status %)))
+                                 (results zloc)))
+       :tests
+       (vec (results zloc))}
+      {:pretty true}))
+
+(System/exit 0)

test.clj

@@ -3,75 +3,63 @@
 (require
  '[cheshire.core :as json]
  '[clojure.string :as str]
- '[babashka.classpath :as cp]
- '[clojure.java.shell :as shell])
+ '[clojure.java.shell :as shell]
+ '[clojure.java.io :as io])
 
-(defn- ->snake_case [s] (str/replace s \- \_))
-
-(def root-dir "/github/workspace/main/")
-(def test-runner-dir "/github/workspace/clojure-test-runner/")
-
-(cp/add-classpath root-dir)
-
-(def practice-root (str root-dir "exercises/practice/"))
-(def concept-root (str root-dir "exercises/concept/"))
-
-(defn copy-practice-example! [slug]
-  (shell/sh "cp"
-            (str practice-root slug "/.meta/src/example.clj")
-            (str practice-root slug "/.meta/src/" (->snake_case slug) ".clj")))
+(defn clean-path [path]
+  (if (str/ends-with? path "/")
+    path
+    (str path "/")))
 
-(defn replace-practice-example! [slug]
-  (shell/sh "mv"
-            (str practice-root slug "/.meta/src/" (->snake_case slug) ".clj")
-            (str practice-root slug "/src/" (->snake_case slug) ".clj")))
+(def root 
+  (clean-path (if (.exists (io/file (str (clean-path (first *command-line-args*)) "config.json")))
+                (first *command-line-args*)
+                "/github/workspace/main/")))
 
-(defn practice-pass? [slug]
-  (let [copy (copy-practice-example! slug)
-        replace (replace-practice-example! slug)]
-    (= "pass" ((json/parse-string
-                (:out (shell/sh (str test-runner-dir "test-runner.clj")
-                                slug
-                                (str practice-root slug "/")
-                                (str practice-root slug "/"))))
-               "status"))))
+(def test-runner-dir 
+  (clean-path (if (.exists (io/file (str (clean-path (first *command-line-args*)) "test-runner.clj")))
+                (first *command-line-args*)
+                  "/github/workspace/clojure-test-runner/")))
 
-(defn copy-concept-example! [slug]
-  (shell/sh "cp"
-            (str concept-root slug "/.meta/exemplar.clj")
-            (str concept-root slug "/.meta/" (->snake_case slug) ".clj")))
+(defn- ->snake_case [s] (str/replace s \- \_))
 
-(defn replace-concept-example! [slug]
-  (shell/sh "mv"
-            (str concept-root slug "/.meta/" (->snake_case slug) ".clj")
-            (str concept-root slug "/src/" (->snake_case slug) ".clj")))
+(def practice-exercises
+  (map #(% "slug")
+       (-> (str root "config.json")
+           slurp
+           json/parse-string
+           (get "exercises")
+           (get "practice"))))
 
-(defn concept-pass? [slug]
-  (let [copy (copy-concept-example! slug)
-        replace (replace-concept-example! slug)]
+(def concept-exercises
+  (map #(% "slug")
+       (-> (str root "config.json")
+           slurp
+           json/parse-string
+           (get "exercises")
+           (get "concept"))))
+
+(defn test-exercise [slug]
+  (let [practice? (contains? (set practice-exercises) slug)
+        example (if practice?
+                  (str root "exercises/practice/" slug "/.meta/src/example.clj")
+                  (str root "exercises/concept/" slug "/.meta/exemplar.clj"))
+        src (if practice?
+              (str root "exercises/practice/" slug "/src/" (->snake_case slug) ".clj")
+              (str root "exercises/concept/" slug "/src/" (->snake_case slug) ".clj"))]
+    (shell/sh "cp" example src)
     (= "pass" ((json/parse-string
                 (:out (shell/sh (str test-runner-dir "test-runner.clj")
                                 slug
-                                (str concept-root slug "/")
-                                (str concept-root slug "/"))))
+                                (str root (if practice? "exercises/practice/" "exercises/concept/") slug "/")
+                                (str root (if practice? "exercises/practice/" "exercises/concept/") slug "/"))))
                "status"))))
 
-(def practice-exercises
-  (map #(% "slug") (((json/parse-string (slurp (str root-dir "config.json"))) "exercises") "practice")))
-
-(def concept-exercises
-  (map #(% "slug") (((json/parse-string (slurp (str root-dir "config.json"))) "exercises") "concept")))
-
-(defn check-practice-exercises! []
-  (for [exercise practice-exercises]
-    {(keyword exercise) (practice-pass? exercise)}))
-
-(defn check-concept-exercises! []
-  (for [exercise concept-exercises]
-    {(keyword exercise) (concept-pass? exercise)}))
+(defn test-exercises! []
+  (for [exercise (into practice-exercises concept-exercises)]
+    {(keyword exercise) (test-exercise exercise)}))
 
-(let [results (into (check-concept-exercises!)
-                    (check-practice-exercises!))
+(let [results (test-exercises!)
       fails (filter false? results)]
   (prn {:tested (count results)
         :fails fails})