Commit 9add1039 authored by hayeah's avatar hayeah

Removed Clutter in Repo

parent e1756498
<title>Lispscript tests</title>
<style type='text/css'>
margin: .5in;
font-weight: bold;
width: 100%;
background: #bbbbff;
thead tr
font-weight: bold;
background: #cccccc;
padding: 3pt;
font-family: courier;
font-size: 8pt;
<script type='text/javascript' src='lispscript-tests.js'>
<script type='text/javascript' src='lispscript-test-cases.js'>
<body onload='runTests();'>
<p>Passes: <span id='passes'>0</span>; Failures: <span id='failures'>0</span> &mdash; <span id='done'>Tests didn't complete.</span></p>
<tbody id='results'>
window.pass = 0; = 0;
window.dotest = (function (ls, js, result, expected, note) {
return (function (results) {
return (function (row) {
row.insertCell(row.cells.length).innerHTML = ls;
row.insertCell(row.cells.length).innerHTML = js;
row.insertCell(row.cells.length).innerHTML = displayString(expected);
row.insertCell(row.cells.length).innerHTML = displayString(result);
if ((result === expected)) {
row.insertCell(row.cells.length).innerHTML = "Pass"; = "#aaffaa";
return document.getElementById("passes").innerHTML = pass;
} else {
if (true) {
row.insertCell(row.cells.length).innerHTML = "Fail"; = "#ffaaaa";
return document.getElementById("failures").innerHTML = fail;
} else {
return undefined;
}).call(this, results.insertRow(results.rows.length));
}).call(this, document.getElementById("results"));
window.allTestsDone = (function () {
return document.getElementById("done").innerHTML = "All tests completed.";
window.displayString = (function (obj) {
if ((obj && (obj.constructor == String))) {
return ("\"" + obj + "\"");
} else {
return ("" + obj);
;; Copyright (c) 2005, Gigamonkeys Consulting All rights reserved.
(defparameter *to-trim* (list #\Space #\Newline))
(defun make-test (string)
(list string (string-trim *to-trim* (generate-from-string *lispscript* string))))
(defun testpage ()
(:title "Lispscript tests")
(:body :margin ".5in")
(:p :font-weight :bold)
(:table :width "100%" :background "#bbbbff")
((and :thead :tr) :font-weight :bold)
(:tr :background "#cccccc")
(:td :padding "3pt" :font-family "Courier" :font-size "8pt"))
(:script :type "text/javascript" :src "lispscript-tests.js")
(:script :type "text/javascript" :src "lispscript-test-cases.js"))
((:body :onload "runTests();")
(:p "Passes: " (:span :id "passes" "0") "; Failures: " (:span :id "failures" "0") " " (:character :mdash) " " (:span :id "done" "Tests didn't complete."))
(:td "Lispscript")
(:td "Javascript")
(:td "Expected")
(:td "Result")
(:td "Okay?")))
((:tbody :id "results")))))))
(defun testcases ()
(flet ((js (string)
(string-trim *to-trim* (generate-from-string *lispscript* string))))
(with-output-to-string (out)
(flet ((test (form expected)
(let ((js (substitute #\Space #\Newline (js form))))
(format out "(dotest ~s ~s (eval ~s) (ignore-errors (eval ~s)))"
form js js expected))))
(write-string "(defun run-tests () " out)
(with-open-file (tests (merge-pathnames
(loop for test = (read-line tests nil nil)
while test
unless (blank-or-comment-p test)
do (test test (read-line tests)))))
(write-string "(all-tests-done))" out)))))
(defun blank-or-comment-p (line)
(let ((trimmed (string-trim '(#\Space #\Tab) line)))
(or (zerop (length trimmed))
(char= (char trimmed 0) #\;))))
(defun maketests ()
(let ((html-file (merge-pathnames "lispscript-tests.html" #p"/home/howard/lisp/libs/monkeylib-0.3.204/foo/"))
(ls-file (merge-pathnames "" #p"/home/howard/lisp/libs/monkeylib-0.3.204/foo/"))
(test-cases-file (merge-pathnames "lispscript-test-cases.js" #p"/home/howard/lisp/libs/monkeylib-0.3.204/foo/")))
(with-html-to-file (html-file) (testpage))
(generate-from-file *lispscript* ls-file)
(with-open-file (out test-cases-file :direction :output :if-exists :supersede)
(write-string (testcases) out))
(format t ";; Testing Lispscript found in ~A~%" (namestring ls-file))
(format t ";; For test results view ~A~%" (namestring html-file))
(format t ";; using a Firefox broswer.~%")
(generate-from-string *lispscript* "(@ (.foo bar))")
(generate-from-string *lispscript* "(.foo bar (.baz maz jo jo))")
(generate-from-string *lispscript* "(@ (.foo bar) baz)")
(generate-from-string *lispscript* "((foo ~ bar) baz)")
\ No newline at end of file
(defvar pass 0)
(defvar fail 0)
(defun dotest (ls js result expected note)
(let* ((results (document get-element-by-id ~ "results"))
(row (results insert-row (results rows length))))
(set ((row insert-cell ~ (row cells length)) innerHTML) ls)
(set ((row insert-cell ~ (row cells length)) innerHTML) js)
(set ((row insert-cell ~ (row cells length)) innerHTML) (display-string expected))
(set ((row insert-cell ~ (row cells length)) innerHTML) (display-string result))
((eq result expected)
(set ((row insert-cell ~ (row cells length)) innerHTML) "Pass")
(set (row style background) "#aaffaa")
(+1 pass) ; pre increment
(set ((document get-element-by-id ~ "passes") innerHTML) pass))
(set ((row insert-cell ~ (row cells length)) innerHTML) "Fail")
(set (row style background) "#ffaaaa")
(1+ fail) ; post increment, cute.
(set ((document get-element-by-id ~ "failures") innerHTML) fail)))))
(defun all-tests-done ()
(set ((document get-element-by-id ~ "done") innerHTML) "All tests completed."))
(defun display-string (obj)
(if (and obj (equal (obj constructor) String))
(+ "\"" obj "\"")
(+ "" obj)))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment