Retropikzel
/
r7rs-tests
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Making the reports work

This commit is contained in:
retropikzel 2024-10-05 14:49:17 +03:00
parent 049937d6bc
commit 44f6b3a90e
3 changed files with 26 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
build.scm
View File

@ -11,7 +11,7 @@
(define full-library-command (define full-library-command
(lambda (implementation test) (lambda (implementation test)
(let* ((name (symbol->string (cdr (assoc 'name implementation)))) (let* ((name (cdr (assoc 'name implementation)))
(library-command (assoc 'library-command implementation))) (library-command (assoc 'library-command implementation)))
(cond ((not library-command) #f) (cond ((not library-command) #f)
; Note that Chicken needs to have the SRFI library as srfi-N.scm in same folder ; Note that Chicken needs to have the SRFI library as srfi-N.scm in same folder
@ -37,7 +37,7 @@
(define full-command (define full-command
(lambda (implementation test) (lambda (implementation test)
(let* ((name (symbol->string (cdr (assoc 'name implementation)))) (let* ((name (cdr (assoc 'name implementation)))
(test-name (cdr (assoc 'name test))) (test-name (cdr (assoc 'name test)))
(test-file (cdr (assoc 'file test))) (test-file (cdr (assoc 'file test)))
(command (command
@ -69,7 +69,7 @@
(newline out) (newline out)
(for-each (for-each
(lambda (implementation) (lambda (implementation)
(let ((name (symbol->string (cdr (assoc 'name implementation))))) (let ((name (cdr (assoc 'name implementation))))
(execute jenkinsfile-job-top (execute jenkinsfile-job-top
`((name . ,name) `((name . ,name)
(dockerimage . ,(if (assoc 'docker-image implementation) (dockerimage . ,(if (assoc 'docker-image implementation)
@ -103,7 +103,7 @@
(lambda (test) (lambda (test)
(for-each (for-each
(lambda (implementation) (lambda (implementation)
(let* ((name (symbol->string (cdr (assoc 'name implementation))))) (let* ((name (cdr (assoc 'name implementation))))
(execute makefile-job (execute makefile-job
`((name . ,name) `((name . ,name)
(test-name . ,(cdr (assoc 'name test))) (test-name . ,(cdr (assoc 'name test)))

26
implementations.scm
View File

@ -1,25 +1,25 @@
(define implementations (define implementations
'(((name . chibi) (command . "chibi-scheme -I ./snow/chibi")) '(((name . "chibi") (command . "chibi-scheme -I ./snow/chibi"))
((name . chicken) ((name . "chicken")
(command . "csc -include-path ./snow/chibi -X r7rs -R r7rs") (command . "csc -include-path ./snow/chibi -X r7rs -R r7rs")
(library-command . "csc -include-path ./snow/chibi -include-path ./snow/chibi/term -X r7rs -R r7rs -s -J")) (library-command . "csc -include-path ./snow/chibi -include-path ./snow/chibi/term -X r7rs -R r7rs -s -J"))
((name . cyclone) ((name . "cyclone")
(command . "cyclone -A .") (command . "cyclone -A .")
(library-command . "cyclone -A .")) (library-command . "cyclone -A ."))
((name . gambit) ((name . "gambit")
(command . "gsc -exe . -nopreload") (command . "gsc -exe . -nopreload")
(library-command . "gsc .")) (library-command . "gsc ."))
((name . gauche) (command . "gosh -r7 -A ./snow")) ((name . "gauche") (command . "gosh -r7 -A ./snow"))
((name . guile) (command . "guile --fresh-auto-compile --r7rs -L . -L ./snow")) ((name . "guile") (command . "guile --fresh-auto-compile --r7rs -L . -L ./snow"))
((name . kawa) (command . "kawa --r7rs -Dkawa.import.path=./snow/chibi/*.sld:./snow/srfi/*.sld")) ((name . "kawa") (command . "kawa --r7rs -Dkawa.import.path=./snow/chibi/*.sld:./snow/srfi/*.sld"))
((name . loko) ((name . "loko")
(docker-image . "schemers/loko:head") (docker-image . "schemers/loko:head")
(command . "LOKO_LIBRARY_PATH=./snow loko -std=r7rs --compile") (command . "LOKO_LIBRARY_PATH=./snow loko -std=r7rs --compile")
; Library command so the executable gets run ; Library command so the executable gets run
(library-command . "ls")) (library-command . "ls"))
((name . mit-scheme) (command . "mit-scheme --load")) ((name . "mit-scheme") (command . "mit-scheme --load"))
((name . sagittarius) (command . "sash -r7 -L ./snow")) ((name . "sagittarius") (command . "sash -r7 -L ./snow"))
((name . stklos) (command . "stklos -I ./snow")) ((name . "stklos") (command . "stklos -I ./snow"))
((name . skint) (command . "skint --program")) ((name . "skint") (command . "skint --program"))
((name . tr7) (command . "tr7i")))) ((name . "tr7") (command . "tr7i"))))

18
report.scm
View File

@ -28,25 +28,25 @@
(display "<th>Test</th>" out) (display "<th>Test</th>" out)
(for-each (for-each
(lambda (implementation) (lambda (implementation)
(display (string-append "<th>" (symbol->string (cdr (assoc 'name implementation))) "</th>") out) (display (string-append "<th>" (cdr (assoc 'name implementation)) "</th>") out)
(newline out)) (newline out))
implementations) implementations)
(display "</tr>" out) (display "</tr>" out)
(newline out) (newline out)
(newline out) (newline out)
(for-each (for-each
(lambda (test) (lambda (implementation)
(let ((test-name (cdr (assoc 'name test)))) (let ((name (cdr (assoc 'name implementation))))
(display (string-append "<tr>") out) (display (string-append "<tr>") out)
(newline out) (newline out)
(display (string-append "<td>" test-name "</td>") out) (display (string-append "<td>" name "</td>") out)
(newline out) (newline out)
(for-each (for-each
(lambda (implementation) (lambda (test)
(letrec* ((name (cdr (assoc 'name implementation))) (letrec* ((test-name (cdr (assoc 'name test)))
(command (cdr (assoc 'command implementation))) (command (cdr (assoc 'command implementation)))
(logfile (string-append "reports/" (logfile (string-append "reports/"
(symbol->string (cdr (assoc 'name implementation))) name
"-" "-"
test-name test-name
".log")) ".log"))
@ -78,8 +78,8 @@
(result . ,result)) (result . ,result))
out) out)
(newline out))) (newline out)))
implementations)
(display (string-append "</tr>") out)))
tests) tests)
(display (string-append "</tr>") out)))
implementations)
(execute report-bottom '() out) (execute report-bottom '() out)
(newline out))) (newline out)))