From d8a52af2520d14035fc3a36a7aa3569f9856380a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 8 Oct 2023 11:29:21 +0200 Subject: Further rewrite of testrunner. Move many of the atomic procedures into proper libraries. --- Makefile | 2 +- module/hnh/test/testrunner.scm | 152 +++++++++++++++++------------ module/hnh/util/atomic-queue.scm | 49 ++++++++++ module/hnh/util/atomic-stack.scm | 43 +++++++++ module/hnh/util/atomic.scm | 11 +++ module/hnh/util/coverage.scm | 3 +- testrunner.scm | 191 +++++++++++++++++++++---------------- tests/unit/coverage-supplement.scm | 13 +++ tests/unit/util/atomic-queue.scm | 32 +++++++ tests/unit/util/atomic-stack.scm | 25 +++++ 10 files changed, 375 insertions(+), 146 deletions(-) create mode 100644 module/hnh/util/atomic-queue.scm create mode 100644 module/hnh/util/atomic-stack.scm create mode 100644 module/hnh/util/atomic.scm create mode 100644 tests/unit/coverage-supplement.scm create mode 100644 tests/unit/util/atomic-queue.scm create mode 100644 tests/unit/util/atomic-stack.scm diff --git a/Makefile b/Makefile index a1809876..2d21588f 100644 --- a/Makefile +++ b/Makefile @@ -102,7 +102,7 @@ install: all calp-release unit-test-deps: calp $(GO_UNIT_TESTS) $(GO_FILES) $(TEST_FILES) $(COV_FILE): cpucount unit-test-deps - ./testrunner.scm --threads $(shell ./cpucount) --coverage $@ + ./testrunner.scm --threads $(shell ./cpucount) --coverage $@ --coverage-supplement tests/unit/coverage-supplement.scm unit-test-with-cov: $(COV_FILE) diff --git a/module/hnh/test/testrunner.scm b/module/hnh/test/testrunner.scm index 384afd4b..38df0ee1 100644 --- a/module/hnh/test/testrunner.scm +++ b/module/hnh/test/testrunner.scm @@ -1,8 +1,11 @@ (define-module (hnh test testrunner) :use-module (srfi srfi-64) :use-module (hnh test util) + :use-module (hnh util type) + :use-module (hnh util atomic-queue) :use-module (ice-9 pretty-print) :use-module (ice-9 format) + :use-module (ice-9 curried-definitions) :export (verbose? construct-test-runner) ) @@ -21,97 +24,124 @@ width: (- 79 (string-length indent))))) (string-append indent prefix-1)))) +;;; Return a "name" for the test. +;;; If the test was explicitly named, than that name will be used. +;;; Otherwise a string describing the expected value will be returned. +(define (test-runner-test-name/description runner) + (cond ((test-runner-test-name runner) + (negate string-null?) => identity) + ((test-result-ref runner 'expected-value) + => (lambda (p) (with-output-to-string + (lambda () + (display (bold "[SOURCE]: ")) + (truncated-print p width: 60))))))) -(define (construct-test-runner) + +(define (test-runner-describe-error runner depth) + (cond ((test-result-ref runner 'actual-error) + => (lambda (err) + (if (and (list? err) + (= 5 (length err))) + (let ((err (list-ref err 0)) + (proc (list-ref err 1)) + (fmt (list-ref err 2)) + (args (list-ref err 3))) + (format #t "~a~a in ~a: ~?~%" + (make-indent (1+ depth)) + err proc fmt args)) + (format #t "~aError: ~s~%" (make-indent (1+ depth)) err)))) + (else + (let ((unknown-expected (gensym)) + (unknown-actual (gensym))) + (let ((expected (test-result-ref runner 'expected-value unknown-expected)) + (actual (test-result-ref runner 'actual-value unknown-actual))) + (let ((indent (make-indent (1+ depth)))) + (if (eq? expected unknown-expected) + (format #t "~aAssertion failed~%" indent) + (begin + (display (pp expected indent "Expected: ")) + (display (pp actual indent "Received: ")) + (let ((d (diff (pp expected "" "") + (pp actual "" "")))) + (display + (string-join + (map (lambda (line) (string-append indent "|" line)) + (string-split d #\newline)) + "\n" 'suffix)))))))))) + + (format #t "~aNear ~a:~a~%" + (make-indent (1+ depth)) + (test-result-ref runner 'source-file) + (test-result-ref runner 'source-line)) + (pretty-print (test-result-ref runner 'source-form) + (current-output-port) + per-line-prefix: (string-append (make-indent (1+ depth)) "> "))) + +(define ((construct-test-runner print err-queue)) + (typecheck err-queue atomic-queue?) (define runner (test-runner-null)) + ;; TODO wouldn't `depth` need to be atomic to work? (define depth 0) - ;; end of individual test case + (test-runner-on-test-begin! runner (lambda (runner) + ;; This should be thread local, TODO test that (test-runner-aux-value! runner (transform-time-of-day (gettimeofday))))) + (test-runner-on-test-end! runner (lambda (runner) (when (verbose?) (display (make-indent depth))) - (case (test-result-kind runner) - ((pass) (display (green "X"))) - ((fail) (display (red "E"))) - ((xpass) (display (yellow "X"))) - ((xfail) (display (yellow "E"))) - ((skip) (display (yellow "-")))) - (when (or (verbose?) (eq? 'fail (test-result-kind))) - (format #t " ~a~%" - (cond ((test-runner-test-name runner) - (negate string-null?) => identity) - ((test-result-ref runner 'expected-value) - => (lambda (p) (with-output-to-string - (lambda () - (display (bold "[SOURCE]: ")) - (truncated-print p width: 60)))))))) + (display + (case (test-result-kind runner) + ((pass) (green "X")) + ((fail) (red "E")) + ((xpass) (red "X")) + ((xfail) (yellow "E")) + ((skip) (yellow "-")))) + + (when (or (verbose?) #;(eq? 'fail (test-result-kind))) + (format #t " ~a~%" (test-runner-test-name/description runner))) + (when (eq? 'fail (test-result-kind)) - (cond ((test-result-ref runner 'actual-error) - => (lambda (err) - (if (and (list? err) - (= 5 (length err))) - (let ((err (list-ref err 0)) - (proc (list-ref err 1)) - (fmt (list-ref err 2)) - (args (list-ref err 3))) - (format #t "~a~a in ~a: ~?~%" - (make-indent (1+ depth)) - err proc fmt args)) - (format #t "~aError: ~s~%" (make-indent (1+ depth)) err)))) - (else - (let ((unknown-expected (gensym)) - (unknown-actual (gensym))) - (let ((expected (test-result-ref runner 'expected-value unknown-expected)) - (actual (test-result-ref runner 'actual-value unknown-actual))) - (let ((indent (make-indent (1+ depth)))) - (if (eq? expected unknown-expected) - (format #t "~aAssertion failed~%" indent) - (begin - (display (pp expected indent "Expected: ")) - (display (pp actual indent "Received: ")) - (let ((d (diff (pp expected "" "") - (pp actual "" "")))) - (display - (string-join - (map (lambda (line) (string-append indent "|" line)) - (string-split d #\newline)) - "\n" 'suffix)))))))))) - (format #t "~aNear ~a:~a~%" - (make-indent (1+ depth)) - (test-result-ref runner 'source-file) - (test-result-ref runner 'source-line)) - (pretty-print (test-result-ref runner 'source-form) - (current-output-port) - per-line-prefix: (string-append (make-indent (1+ depth)) "> ") - )) + (enqueue! + (with-output-to-string + (lambda () + (display + (red (format #f "Test failed: ~a~%" + (test-runner-test-name/description runner)))) + (test-runner-describe-error runner 0))) + err-queue)) (let ((start (test-runner-aux-value runner)) (end (transform-time-of-day (gettimeofday)))) (when (< (µs 1) (- end start)) - (format #t "~%Slow test: ~s, took ~a~%" - (test-runner-test-name runner) - (exact->inexact (/ (- end start) (µs 1))) - ))))) + (enqueue! + (format #f "~%Slow test: ~s, took ~a~%" + (test-runner-test-name/description runner) + (exact->inexact (/ (- end start) (µs 1)))) + err-queue))) + + )) ;; on start of group (test-runner-on-group-begin! runner ;; count is number of #f (lambda (runner name count) - (if (<= depth 1) + (if (<= depth 0) (format #t "~a ~a ~a~%" (make-string 10 #\=) name (make-string 10 #\=)) (when (verbose?) - (format #t "~a~a~%" (make-string (* depth 2) #\space) name))) + (format #t "~a~a~%" (make-string (* depth 2) #\space) name))) (set! depth (1+ depth)))) + (test-runner-on-group-end! runner (lambda (runner) (set! depth (1- depth)) (when (<= depth 1) (newline)))) + ;; after everything else is done (test-runner-on-final! runner (lambda (runner) diff --git a/module/hnh/util/atomic-queue.scm b/module/hnh/util/atomic-queue.scm new file mode 100644 index 00000000..2ab0c2ef --- /dev/null +++ b/module/hnh/util/atomic-queue.scm @@ -0,0 +1,49 @@ +(define-module (hnh util atomic-queue) + :use-module (srfi srfi-18) ; Threading + :use-module (rnrs records syntactic) + :use-module (rnrs exceptions) + ;; :use-module (rnrs mutable-pair) + :use-module (hnh util atomic) + :use-module (hnh util type) + :use-module ((hnh util) :select (begin1)) + :export (atomic-queue + atomic-queue? + queue-peek queue->list + enqueue! dequeue!)) + + + +;;; Items are added at the back, and poped from the front + +(define-record-type (queue %atomic-queue atomic-queue?) + (fields front + (mutable back) + front-mutex back-mutex) + (sealed #t) + (opaque #t)) + +(define (atomic-queue) + (let ((p (list 'FRONT))) + (%atomic-queue p p (make-mutex) (make-mutex)))) + +(define (enqueue! value q) + (typecheck q atomic-queue?) + (with-mutex (queue-back-mutex q) + (set-cdr! (queue-back q) (list value)) + (queue-back-set! q (cdr (queue-back q))))) + +(define (queue-peek q) + (typecheck q atomic-queue?) + (cadr (queue-front q))) + +(define (dequeue! q) + (typecheck q atomic-queue?) + (with-mutex (queue-front-mutex q) + (guard (_ (else #f)) + (begin1 (queue-peek q) + (set-cdr! (queue-front q) + (cddr (queue-front q))))))) + +(define (queue->list q) + (typecheck q atomic-queue?) + (cdr (queue-front q))) diff --git a/module/hnh/util/atomic-stack.scm b/module/hnh/util/atomic-stack.scm new file mode 100644 index 00000000..6b17724d --- /dev/null +++ b/module/hnh/util/atomic-stack.scm @@ -0,0 +1,43 @@ +(define-module (hnh util atomic-stack) + :use-module (srfi srfi-18) ; Threading + :use-module (rnrs records syntactic) + :use-module (rnrs exceptions) + :use-module (hnh util atomic) + :use-module ((hnh util type) :select (typecheck)) + :use-module ((hnh util) :select (begin1)) + :export (atomic-stack + atomic-stack? + stack-peek stack->list + push! pop!)) + +(define-record-type (stack %atomic-stack atomic-stack?) + (fields (mutable contents) + mutex) + (sealed #t) + (opaque #t)) + +(define (atomic-stack) + (%atomic-stack '() (make-mutex))) + +(define (stack->list stack) + (stack-contents stack)) + +(define (push! value stack) + (typecheck stack atomic-stack?) + (with-mutex (stack-mutex stack) + (stack-contents-set! + stack + (cons value (stack-contents stack))))) + +(define (stack-peek stack) + (typecheck stack atomic-stack?) + (car (stack-contents stack))) + +(define (pop! stack) + (typecheck stack atomic-stack?) + (with-mutex (stack-mutex stack) + (guard (_ (else #f)) + (begin1 (stack-peek stack) + (stack-contents-set! + stack (cdr (stack-contents stack))))))) + diff --git a/module/hnh/util/atomic.scm b/module/hnh/util/atomic.scm new file mode 100644 index 00000000..1deba2c1 --- /dev/null +++ b/module/hnh/util/atomic.scm @@ -0,0 +1,11 @@ +(define-module (hnh util atomic) + :use-module (srfi srfi-18) + :export (with-mutex)) + +(define-syntax with-mutex + (syntax-rules () + ((_ mutex body ...) + (dynamic-wind + (lambda () (mutex-lock! mutex)) + (lambda () body ...) + (lambda () (mutex-unlock! mutex)))))) diff --git a/module/hnh/util/coverage.scm b/module/hnh/util/coverage.scm index 2517e81f..9b76411b 100644 --- a/module/hnh/util/coverage.scm +++ b/module/hnh/util/coverage.scm @@ -63,7 +63,7 @@ (fold (lambda (line state) (match (parse-coverage-line line) (('DA line hits) - (modify state (compose-lens car* lines) + (modify state (compose-lenses car* lines) (lambda (lines) (cons (cons line hits) lines)))) (('SF source) (set state car* filename source)) @@ -86,6 +86,7 @@ "Can only merge coverage data for the same file, got ~s and ~s" (list (filename a) (filename b)) #f)) + #; (unless (= (total-lines a) (total-lines b)) (scm-error 'misc-error "merge-coverage" "Mismatch between found lines. Is it really the same file? File: ~s, got ~s and ~s" diff --git a/testrunner.scm b/testrunner.scm index c3fa0ae3..267e3c17 100755 --- a/testrunner.scm +++ b/testrunner.scm @@ -1,11 +1,11 @@ #!/usr/bin/env bash # -*- mode: scheme; geiser-scheme-implementation: guile -*- -make calp unit-test-deps +make calp +make unit-test-deps root=$(dirname "$(realpath "$0")") -eval "$(env __PRINT_ENVIRONMENT=1 ${root}/calp)" - +eval "$(env __PRINT_ENVIRONMENT=1 "${root}/calp")" exec "$GUILE" --debug --no-auto-compile -e main -s "$0" "$@" !# @@ -19,26 +19,25 @@ exec "$GUILE" --debug --no-auto-compile -e main -s "$0" "$@" (srfi srfi-18) (srfi srfi-64) (srfi srfi-71) - ((hnh util) :select (->> for group-by)) + (srfi srfi-111) + ((rnrs io ports) :select (get-bytevector-all)) + ((hnh util) :select (-> ->> for group-by)) (hnh util path) (hnh util type) - ((hnh util lens) :select (modify cdr* car* compose-lenses)) (hnh util object) (hnh util coverage) + (hnh util atomic) + (hnh util atomic-stack) + (hnh util atomic-queue) + (hnh test testrunner) + ((hnh util io) :select (displayln)) + (crypto) (ice-9 getopt-long) (ice-9 control) (ice-9 format)) -(define-syntax with-mutex - (syntax-rules () - ((_ mutex body ...) - (dynamic-wind - (lambda () (mutex-lock! mutex)) - (lambda () body ...) - (lambda () (mutex-unlock! mutex)))))) - (define-syntax-rule (begin-thread forms ...) (let ((thread (make-thread (lambda () forms ...)))) (thread-start! thread) @@ -66,34 +65,16 @@ exec "$GUILE" --debug --no-auto-compile -e main -s "$0" "$@" (define current-filename (make-parameter #f)) -(define (construct-test-runner) - (define runner (test-runner-null)) - (test-runner-aux-value! - runner - `((thread-name . ,(thread-name (current-thread))))) - #; - (test-runner-on-test-begin! runner - (lambda (runner) - (test-runner-aux-value! runner #t))) - (test-runner-on-test-end! runner - (lambda (runner) - (case (test-result-kind runner) - ((pass) - (if (getenv "VERBOSE") - (println (format #f "~a SUCCEED ~a" - (current-filename) - (test-runner-test-name runner))) - (display #\#))) - ((fail) - (println (format #f "~a FAIL ~a" - (current-filename) - (test-runner-test-name runner)))) - ((xpass xfail skip) - (println (format #f "~a ~a ~a" - (current-filename) - (test-result-kind runner) - (test-runner-test-name runner))))))) - runner) +(define (test-runner-name runner) + (cond ((test-runner-test-name runner) + (negate string-null?) => identity) + ((test-result-ref runner 'expected-value) + => (lambda (p) (with-output-to-string + (lambda () + ;; (display (bold "[SOURCE]: ")) + ;; (truncated-print p width: 60) + (write p) + )))))) (define (test-runner-processed runner) @@ -114,19 +95,20 @@ exec "$GUILE" --debug --no-auto-compile -e main -s "$0" "$@" (else (string-join (test-runner-group-path runner) " → "))))) -(define runners '()) -(define runner-mutex (make-mutex)) + + +(define runners (atomic-stack)) + (sigaction SIGINT -(lambda _ + (lambda _ (display - (string-join (map test-runner-test-description runners) "\n")))) - + (string-join (map test-runner-test-description (stack->list runners)) + "\n")))) (define-type (job) (jobname type: string?) (job-thunk type: thunk?)) - (define* (maybe-with-code-coverage thunk key: (coverage? #f)) (if coverage? (with-code-coverage @@ -141,15 +123,13 @@ exec "$GUILE" --debug --no-auto-compile -e main -s "$0" "$@" (lambda () (parameterize ((current-filename (basename entry))) (test-begin entry) - (with-mutex runner-mutex - (set! runners (cons (test-runner-get) runners))) + (push! (test-runner-get) runners) (let ((coverage module-names (maybe-with-code-coverage (lambda () (load entry)) coverage?: coverage?))) (let ((tested-files (map module->source-file module-names))) (test-end entry) - (println (format #f "Completed ~a" entry)) (if coverage (let ((lcov-data (call-with-output-string @@ -162,28 +142,20 @@ exec "$GUILE" --debug --no-auto-compile -e main -s "$0" "$@" (define* (make-work-pool jobs key: (thread-count 1)) - (define job-pool jobs) - (define pool-mutex (make-mutex)) - - (define results (list)) - (define results-mutex (make-mutex)) + (define job-pool (atomic-stack)) + (define results (atomic-stack)) + (for-each (lambda (job) (push! job job-pool)) jobs) (define (pool-worker) (call/ec (lambda (return) (while #t - (let ((job (with-mutex pool-mutex - (if (null? job-pool) - (return #f) - (let ((job (car job-pool))) - (set! job-pool (cdr job-pool)) - job))))) + (let ((job (pop! job-pool))) + (unless job (return #f)) (catch #t - (lambda () - (let ((result ((job-thunk job)))) - (with-mutex results-mutex - (set! results (cons result results))))) + (lambda () (push! ((job-thunk job)) results)) (lambda args + ;; TODO indicate FATAL ERROR (println (format #f "Job [~a] failed: ~s" (jobname job) ;; TODO better error formatting @@ -218,6 +190,7 @@ exec "$GUILE" --debug --no-auto-compile -e main -s "$0" "$@" (nice (value #t)) (threads (value #t)) (coverage (value optional)) + (coverage-supplement (value #t)) )) (define help " @@ -249,18 +222,31 @@ Flags: --coverage [output-filename] Generate code coverage data, this causes the tests to be quite a bit slower. +--coverage-supplement supplement-file ") + +(define (read-coverage-info port) + (map (lambda (entry) + (call-with-values (lambda () (apply values entry)) + (lambda (filename checksum . lines) + (cons checksum + (coverage-info + filename: (realpath filename) + lines: (map (lambda (l) (cons l 1)) lines)))))) + (read port))) + + + (define (main args) (define options (getopt-long args option-spec)) (when (option-ref options 'help #f) - (display help) (exit 0)) - (when (option-ref options 'verbose #f) - (setenv "VERBOSE" "1")) + (when (option-ref options 'verbose (getenv "VERBOSE")) + (verbose? #t)) (define test-files (cond ((option-ref options 'suite #f) @@ -271,7 +257,9 @@ Flags: (nice (string->number (option-ref options 'nice "10"))) - (test-runner-factory construct-test-runner) + (define error-queue (atomic-queue)) + + (test-runner-factory (construct-test-runner print error-queue)) (define coverage (let ((cov (option-ref options 'coverage #f))) @@ -279,21 +267,58 @@ Flags: (cov "coverage.info") (else #f)))) + ;; Guile's coverage system sometimes miss some definitions. + ;; Add these here so the output gets green. + ;; However, always start by attempting to add more tests to fill + ;; in the coverage. + (define-values (extra-coverage outdated-extra) + (cond ((option-ref options 'coverage-supplement #f) + => (lambda (supplement-file) + (partition + (lambda (pair) + (let ((checksum coverage (car+cdr pair))) + (-> (call-with-input-file (filename coverage) + get-bytevector-all) + sha256 + checksum->string + (string=? checksum)))) + (call-with-input-file supplement-file read-coverage-info)))) + (else (values '() '())))) + + (unless (null? outdated-extra) + (format #t "The following files have changed since their coverage") + (format #t "exceptions were written. Please review:~%") + (for-each displayln outdated-extra)) + ((@ (hnh util exceptions) warnings-are-errors) #t) (if (option-ref options 'list #f) (format #t "Gathered the following tests:~%~y~%" test-files) - (let ((results (thread-join! - (make-work-pool - (prepare-jobs test-files coverage?: coverage) - thread-count: (string->number - (option-ref options 'threads "1")))))) - (define merged-coverages - (map (lambda (group) (reduce merge-coverage #f (cdr group))) - (group-by filename (concatenate results)))) - - (unless (null? merged-coverages) - (with-output-to-file coverage - (lambda () - (display "TN:") (newline) - (for-each output-coverage merged-coverages))))))) + (begin + (test-begin "Universe") + (let ((results (thread-join! + (make-work-pool + (prepare-jobs test-files coverage?: coverage) + thread-count: (string->number + (option-ref options 'threads "1")))))) + + (test-end "Universe") + (define merged-coverages + (map (lambda (group) (reduce merge-coverage #f (cdr group))) + (group-by filename (concatenate (cons (map cdr extra-coverage) + (stack->list results)))))) + + + (unless (null? merged-coverages) + (with-output-to-file coverage + (lambda () + (display "TN:") (newline) + (for-each output-coverage merged-coverages)))) + + (display "== Gathered errors ==\n") + (let loop () + (cond ((dequeue! error-queue) + => (lambda (entry) + (display entry) + (newline) + (loop))))))))) diff --git a/tests/unit/coverage-supplement.scm b/tests/unit/coverage-supplement.scm new file mode 100644 index 00000000..9fb2f6d6 --- /dev/null +++ b/tests/unit/coverage-supplement.scm @@ -0,0 +1,13 @@ +;;; Guile's coverage system sometimes miss some definitions. +;;; Add these here so the output gets green. +;;; However, always start by attempting to add more tests to fill +;;; in the coverage. +;;; +;;; Each entry in this file should be a list consisting of: +;;; - The filename, relative calp's root +;;; - The sha256-sum of that file +;;; - Any number of lines which should be marked as covered. +(("module/vcomponent/base.scm" + "f98a3887020c400595bcc32805f968ebebca685bc1c18ef1f1531f55d9f72ec1" + 73 83 108 1) + ) diff --git a/tests/unit/util/atomic-queue.scm b/tests/unit/util/atomic-queue.scm new file mode 100644 index 00000000..428f4457 --- /dev/null +++ b/tests/unit/util/atomic-queue.scm @@ -0,0 +1,32 @@ +(define-module (test atomic-queue) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module (hnh util atomic-queue)) + +;;; TODO multithreaded tests + +(define q (atomic-queue)) + +(enqueue! 1 q) +(enqueue! 2 q) +(enqueue! 3 q) + +(test-equal 1 (dequeue! q)) + +(enqueue! 4 q) + +(test-equal 2 (dequeue! q)) +(test-equal 3 (dequeue! q)) +(test-equal 4 (dequeue! q)) +(test-equal #f (dequeue! q)) +(test-equal #f (dequeue! q)) + +(test-group "Errors are capturable" + (catch #t + (lambda () + (queue-peek q) + (test-assert "Should never be reached" #f)) + (lambda _ (test-assert #t "Error correctly captured")))) + + +'((hnh util atomic-queue)) diff --git a/tests/unit/util/atomic-stack.scm b/tests/unit/util/atomic-stack.scm new file mode 100644 index 00000000..46a16bfb --- /dev/null +++ b/tests/unit/util/atomic-stack.scm @@ -0,0 +1,25 @@ +(define-module (test atomic-stack) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module (hnh util atomic-stack)) + +(define stack (atomic-stack)) + +(test-equal "Fresh stacks are empty" + '() (stack->list stack)) + +(push! 1 stack) +(push! 2 stack) +(push! 3 stack) + +(test-equal "Stack contents when content" + '(3 2 1) (stack->list stack)) + +(test-equal "Poped correctly 3" 3 (pop! stack)) +(push! 4 stack) +(test-equal "Poped correctly 4" 4 (pop! stack)) +(test-equal "Poped correctly 2" 2 (pop! stack)) +(test-equal "Poped correctly 1" 1 (pop! stack)) +(test-equal "Poped correctly #f" #f (pop! stack)) + +'((hnh util atomic-stack)) -- cgit v1.2.3