From 380df6dea7cb4f1a863e1754cc16fc4c1980e4cc Mon Sep 17 00:00:00 2001 From: crc Date: Wed, 11 Mar 2020 18:42:39 +0000 Subject: [PATCH] begin work on a better set of tests for words in the rx kernel FossilOrigin-Name: ba14795dce5211e798c2b2daf2b4d234ee1837a11b185dee7c41b931061c406a --- tests/rx.retro | 467 +++++++++++++++++++++++++++++++++++++++++++ vm/nga-js/index.html | 12 +- vm/nga-js/nga.js | 8 +- 3 files changed, 476 insertions(+), 11 deletions(-) create mode 100644 tests/rx.retro diff --git a/tests/rx.retro b/tests/rx.retro new file mode 100644 index 0000000..0607ce6 --- /dev/null +++ b/tests/rx.retro @@ -0,0 +1,467 @@ +~~~ +'Total var +'WordsTested var +'Flag var +'Tests var +'InTestState var + +:pad s:length #32 swap - #0 n:max &sp times ; +:Testing (s-) + dup 'Test:__ s:put s:put pad #-1 !Flag #0 !Tests &WordsTested v:inc reset ; + +:passed (-) + '->_ s:put @Tests n:put '_tests_passed s:put nl ; + +:exit-on-fail (-) + @Flag [ '->_FAILED. s:put nl bye ] -if ; + +:match (n-) + eq? @InTestState and !InTestState ; + +:try (qq-) + #-1 !InTestState + [ call ] dip call + depth n:-zero? [ @Flag and !Flag ] if + @Flag @InTestState and !Flag + exit-on-fail &Tests v:inc &Total v:inc ; + +:summary (-) + @WordsTested n:put '_words_tested s:put nl + @Total n:put '_tests_passed s:put nl ; +~~~ + +~~~ +'dup Testing + [ #1 dup ] [ #1 match #1 match ] try + [ #4 #3 dup ] [ #3 match #3 match #4 match ] try +passed +~~~ + +~~~ +'drop Testing + [ #1 #2 drop ] [ #1 eq? ] try + [ #1 #2 #3 drop ] [ #2 match #1 match ] try + [ #1 #2 drop drop ] [ #1 eq? ] try +passed +~~~ + +~~~ +'swap Testing + [ #1 #2 #3 swap ] [ #2 match #3 match #1 match ] try +passed +~~~ + +~~~ +'call Testing + [ #1 [ ] call #2 ] [ #2 match #1 match ] try + [ #1 [ #3 ] call #2 ] [ #2 match #3 match #1 match ] try +passed +~~~ + +~~~ +'eq? Testing + [ #1 #2 eq? ] [ FALSE match ] try + [ #1 #1 eq? ] [ TRUE match ] try + [ #2 #2 eq? ] [ TRUE match ] try + [ #2 #1 eq? ] [ FALSE match ] try +passed +~~~ + +~~~ +'-eq? Testing + [ #1 #2 -eq? ] [ TRUE match ] try + [ #1 #1 -eq? ] [ FALSE match ] try + [ #2 #2 -eq? ] [ FALSE match ] try + [ #2 #1 -eq? ] [ TRUE match ] try +passed +~~~ + +~~~ +'lt? Testing + [ #1 #2 lt? ] [ TRUE match ] try + [ #3 #2 lt? ] [ FALSE match ] try + [ #2 #2 lt? ] [ FALSE match ] try +passed +~~~ + +~~~ +'gt? Testing + [ #1 #2 gt? ] [ FALSE match ] try + [ #3 #2 gt? ] [ TRUE match ] try + [ #2 #2 gt? ] [ FALSE match ] try +passed +~~~ + +~~~ +'fetch Testing + 'A var + [ #100 &A store ] [ &A fetch #100 eq? ] try + [ #200 &A store ] [ &A fetch #200 eq? ] try + [ #300 &A store ] [ &A fetch #300 eq? ] try +passed +~~~ + +~~~ +'store Testing + 'A var + [ #100 &A store ] [ &A fetch #100 eq? ] try + [ #200 &A store ] [ &A fetch #200 eq? ] try + [ #300 &A store ] [ &A fetch #300 eq? ] try +passed +~~~ + +~~~ +'+ Testing + [ #1 #2 + ] [ #3 eq? ] try + [ #4 #-2 + ] [ #2 eq? ] try + [ #0 #1 + ] [ #1 eq? ] try +passed +~~~ + +~~~ +'- Testing + [ #2 #1 - ] [ #1 eq? ] try + [ #2 #4 #3 - - ] [ #1 eq? ] try + [ #1 #2 #1 #9 - ] [ #-8 match #2 match #1 match ] try +passed +~~~ + +~~~ +'* Testing + [ #1 #2 * ] [ #2 eq? ] try + [ #2 #3 * ] [ #6 eq? ] try + [ #-1 #10 * ] [ #-10 eq? ] try + [ #-1 #2 * #-1 * ] [ #2 eq? ] try +passed +~~~ + + +~~~ +'/mod Testing + [ #5 #2 /mod ] [ #2 match #1 match ] try + [ #-5 #2 /mod ] [ #-2 match #-1 match ] try + [ #-5 #-2 /mod ] [ #2 match #-1 match ] try + [ #5 #-2 /mod ] [ #-2 match #1 match ] try +passed +~~~ + +~~~ +'and Testing + [ #-1 #-1 and ] [ #-1 match ] try + [ #0 #-1 and ] [ #0 match ] try + [ #-1 #0 and ] [ #0 match ] try + [ #0 #0 and ] [ #0 match ] try +passed +~~~ + +~~~ +'or Testing + [ #-1 #-1 or ] [ #-1 match ] try + [ #0 #-1 or ] [ #-1 match ] try + [ #-1 #0 or ] [ #-1 match ] try + [ #0 #0 or ] [ #0 match ] try +passed +~~~ + +~~~ +'xor Testing + [ #-1 #-1 xor ] [ #0 match ] try + [ #0 #-1 xor ] [ #-1 match ] try + [ #-1 #0 xor ] [ #-1 match ] try + [ #0 #0 xor ] [ #0 match ] try +passed +~~~ + +~~~ +'shift Testing + [ #455 #-3 shift ] [ #3640 match ] try + [ #3640 #3 shift ] [ #455 match ] try +passed +~~~ + +~~~ +'push Testing + [ #1 dup push #2 pop ] [ #1 match #2 match #1 match ] try +passed +~~~ + +~~~ +'pop Testing + [ #1 dup push #2 pop ] [ #1 match #2 match #1 match ] try +passed +~~~ + +~~~ +'0; Testing + [ #1 0; #2 0; ] [ #2 eq? swap #1 eq? and ] try + [ #1 0; #0 0; #2 0; ] [ #1 eq? ] try +passed +~~~ + +~~~ +'fetch-next Testing + 'A d:create #1 , #2 , #3 , + [ &A fetch-next ] [ #1 match &A #1 + match ] try + [ &A fetch-next drop fetch-next ] [ #2 match &A #2 + match ] try +passed +~~~ + +~~~ +'store-next Testing + 'A d:create #1 , #2 , #3 , + #9 #10 #11 &A store-next store-next store-next drop + [ &A fetch-next ] [ #11 match &A #1 + match ] try + [ &A fetch-next drop fetch-next ] [ #10 match &A #2 + match ] try +passed +~~~ + +~~~ +'s:to-number Testing + [ '123 s:to-number ] [ #123 match ] try + [ '-123 s:to-number ] [ #-123 match ] try +passed +~~~ + + +~~~ +'s:eq? Testing + [ 'egg 'egg s:eq? ] [ #-1 match ] try + [ 'egg 'shell s:eq? ] [ #0 match ] try +passed +~~~ + +~~~ +'s:length Testing + [ 'abc s:length ] [ #3 match ] try + [ 'abcdef s:length ] [ #6 match ] try +passed +~~~ + +~~~ +'choose Testing + [ TRUE [ #1 ] [ #0 ] choose ] [ #1 match ] try + [ FALSE [ #1 ] [ #0 ] choose ] [ #0 match ] try +passed +~~~ + + +~~~ +'if Testing + [ #0 TRUE [ #1 ] if ] [ #1 match #0 match ] try + [ #0 FALSE [ #1 ] if ] [ #0 match ] try +passed +~~~ + + +~~~ +'-if Testing + [ #0 TRUE [ #1 ] -if ] [ #0 match ] try + [ #0 FALSE [ #1 ] -if ] [ #1 match #0 match ] try +passed +~~~ + +~~~ +'prefix:( Testing +passed +~~~ + +~~~ +'Compiler Testing +passed +~~~ + + +~~~ +'Heap Testing +passed +~~~ + +~~~ +', Testing + [ here #0 , here swap - ] [ #1 eq? ] try + [ here #12 , fetch ] [ #12 eq? ] try + here #1 , #2 , #3 , + [ fetch-next swap fetch-next swap fetch ] + [ #3 eq? swap #2 eq? and swap #1 eq? and ] try +passed +~~~ + +~~~ +'s, Testing + [ here 'hello s, ] [ fetch-next $h match + fetch-next $e match + fetch-next $l match + fetch-next $l match + fetch-next $o match + drop ] try +passed +~~~ + +~~~ +'; Testing + [ here &; call here swap - ] [ #1 eq? ] try + [ here &; call fetch ] [ #10 eq? ] try +passed +~~~ + +~~~ +'[ Testing + [ [ ] fetch ] [ #10 match ] try + [ [ ] #2 - fetch ] [ #1793 match ] try +passed +~~~ + +~~~ +'] Testing + [ [ ] fetch ] [ #10 match ] try + [ [ ] #2 - fetch ] [ #1793 match ] try +passed +~~~ + +~~~ +'Dictionary Testing + [ Dictionary ] [ #2 match ] try +passed +~~~ + +~~~ +'d:link Testing + [ #0 d:link ] [ #0 match ] try +passed +~~~ + + +~~~ +'d:xt Testing + [ #0 d:xt ] [ #1 match ] try +passed +~~~ + +~~~ +'d:class Testing + [ #0 d:class ] [ #2 match ] try +passed +~~~ + +~~~ +'d:name Testing + [ #0 d:name ] [ #3 match ] try +passed +~~~ + +~~~ +'class:word Testing +passed +~~~ + +~~~ +'class:macro Testing +passed +~~~ + +~~~ +'class:data Testing +passed +~~~ + +~~~ +'d:add-header Testing +passed +~~~ + + +~~~ +'prefix:# Testing + [ #1 ] [ #1 match ] try + [ #2 ] [ #2 match ] try + [ #-1234 ] [ #-1234 match ] try +passed +~~~ + +~~~ +'prefix:: Testing + :test #1 #2 ; + [ test ] [ #2 match #1 match ] try +passed +~~~ + +~~~ +'prefix:& Testing + [ &Version ] [ #4 match ] try +passed +~~~ + +~~~ +'prefix:$ Testing +passed +~~~ + +~~~ +'repeat Testing + [ #3 repeat dup n:dec 0; again ] [ #1 match #2 match #3 match ] try +passed +~~~ + +~~~ +'again Testing + [ #3 repeat dup n:dec 0; again ] [ #1 match #2 match #3 match ] try +passed +~~~ + +~~~ +'interpret Testing +passed +~~~ + +~~~ +'d:lookup Testing +passed +~~~ + + +~~~ +'class:primitive Testing +passed +~~~ + +~~~ +'Version Testing + [ Version ] [ #4 match ] try + [ &Version ] [ #4 match ] try +passed +~~~ + +~~~ +'i Testing + [ here '........ i ] [ fetch #0 match ] try + [ here 'li...... i ] [ fetch #1 match ] try + [ here 'ha...... i ] [ fetch #26 match ] try +passed +~~~ + +~~~ +'d Testing + [ here #1 d ] [ fetch #1 match ] try + [ here #2 d ] [ fetch #2 match ] try + [ here #3 d ] [ fetch #3 match ] try +passed +~~~ + +~~~ +'r Testing + [ here 'swap r ] [ fetch &swap match ] try + [ here 'drop r ] [ fetch &drop match ] try + [ here 'prefix:: r ] [ fetch &prefix:: match ] try +passed +~~~ + + +~~~ +'err:notfound Testing +passed +~~~ + +~~~ +summary +~~~ + diff --git a/vm/nga-js/index.html b/vm/nga-js/index.html index 0d8d9a2..d56992a 100644 --- a/vm/nga-js/index.html +++ b/vm/nga-js/index.html @@ -16,16 +16,14 @@ -->
-
+
-
-
-

+
+ +
diff --git a/vm/nga-js/nga.js b/vm/nga-js/nga.js index b137587..5457443 100644 --- a/vm/nga-js/nga.js +++ b/vm/nga-js/nga.js @@ -284,7 +284,7 @@ instructions[vm.II] = function() { var chosen = data.pop(); if (chosen == 0) { var s = String.fromCharCode(data.pop()); - document.getElementById('console').innerHTML += s; + document.getElementById('console').value += s; } else if (chosen == 1) { draw(data.pop()) } @@ -432,7 +432,7 @@ function evaluate(s) { } function cls() { - document.getElementById('console').innerHTML = ""; + document.getElementById('console').value = ""; const context = canvas.getContext('2d'); context.clearRect(0, 0, canvas.width, canvas.height); } @@ -461,7 +461,7 @@ function go() { loadInitialImage(); notfound = d_xt_for("err:notfound"); interpret = d_xt_for("interpret"); - document.getElementById("console").innerHTML = ""; + document.getElementById("console").value = ""; src = document.getElementById("input").value; tokens = unu(src).match(/\S+/g); var i = tokens.length; @@ -477,7 +477,7 @@ function go() { s = s + data.data[j] + " "; j++; } - document.getElementById("console").innerHTML += "\n" + s; + document.getElementById("console").value += "\n" + s; if (framebuffer === 0) { var canvas = document.getElementById('canvas'); canvas.style.display = "none";