Re-root site.

common/base_tests.fs

@@ -0,0 +1,124 @@
+\ Copyright 2021 Bradley D. Nelson
+\
+\ Licensed under the Apache License, Version 2.0 (the "License");
+\ you may not use this file except in compliance with the License.
+\ You may obtain a copy of the License at
+\
+\     http://www.apache.org/licenses/LICENSE-2.0
+\
+\ Unless required by applicable law or agreed to in writing, software
+\ distributed under the License is distributed on an "AS IS" BASIS,
+\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+\ See the License for the specific language governing permissions and
+\ limitations under the License.
+
+( Tests Base Operations )
+: test-empty-stack   depth 0 =assert ;
+: test-add   123 111 + 234 =assert ;
+: test-dup-depth   123 depth 1 =assert dup depth 2 =assert 2drop ;
+: test-dup-values   456 dup 456 =assert 456 =assert ;
+: test-2drop   123 456 2drop depth 0 =assert ;
+: test-nip   123 456 nip depth 1 =assert 456 =assert ;
+: 8throw   8 throw ;
+: test-catch ['] 8throw catch 8 =assert depth 0 =assert ;
+: throw-layer 456 >r 123 123 123 8throw 123 123 123 r> ;
+: test-catch2 9 ['] throw-layer catch 8 =assert 9 =assert depth 0 =assert ;
+: test-rdrop   111 >r 222 >r rdrop r> 111 =assert ;
+: test-*/    1000000 22 7 */ 3142857 =assert ;
+: test-bl   bl 32 =assert ;
+: test-0=   123 0= 0 =assert 0 0= assert ;
+: test-cells   123 cells cell+ cell/ 124 =assert ;
+: test-aligned    127 aligned 128 =assert ;
+: test-[char]   [char] * 42 =assert ;
+2 3 * 4 * 5 * 6 * 7 * 8 * 9 * 10 * 11 * 12 * constant 2-12*
+: test-fornext    1 10 for r@ 2 + * next 2-12* =assert ;
+: test-foraft    1 11 for aft r@ 2 + * then next 2-12* =assert ;
+: test-doloop     1 13 2 do i * loop 2-12* =assert ;
+: inc-times ( a n -- a+n ) 0 ?do 1+ loop ;
+: test-?do     123 40 inc-times 163 =assert ;
+: test-?do2     123 0 inc-times 123 =assert ;
+: test-<>   123 456 <> assert ;
+: test-<>2   123 123 <> 0 =assert ;
+: inc/2-times ( a n -- a+n/2 ) 0 ?do 1+ 2 +loop ;
+: test-+loop   123 0 inc/2-times 123 =assert ;
+: test-+loop2   123 6 inc/2-times 126 =assert ;
+
+e: test-arithmetic
+  3 4 + .
+  out:\ 7 
+;e
+
+e: test-print-string
+  : foo ." This is a test!" cr ;
+  foo
+  out: This is a test!
+;e
+
+e: test-print20
+  : foo 20 0 do i . loop cr ;
+  foo
+  out: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 
+;e
+
+e: test-multiline
+  : foo ." Hello" cr ." There" cr ." Test!" cr ; foo
+  out: Hello
+  out: There
+  out: Test!
+;e
+
+e: test-value-to
+  123 value foo
+  foo . cr
+  out: 123 
+  55 to foo
+  foo . cr
+  out: 55 
+  : bar 99 to foo ;
+  foo . cr
+  out: 55 
+  bar foo . cr
+  out: 99 
+;e
+
+e: test-comments-interp
+  123 ( Interpretered comment ) 456
+  789 \ Interpretered comment )
+  789 =assert 456 =assert 123 =assert
+;e
+
+e: test-comments-compiled
+  : foo 123 ( Compiled comment ) 456
+        789 \ Interpretered comment )
+        999 ;
+  foo 999 =assert 789 =assert 456 =assert 123 =assert
+;e
+
+e: test-recurse
+  : factorial   dup 0= if drop 1 else dup 1- recurse * then ;
+  5 factorial 120 =assert
+;e
+
+e: test-accept
+  in: 1234567890xxxxxx
+  pad 10 accept
+  pad swap type cr
+  out: --> 1234567890
+  out: 1234567890
+;e
+
+e: test-key
+  in: 1
+  key 49 =assert
+  key nl =assert
+;e
+
+e: test-compiler-off
+  : test [ 123 111 + literal ] ;
+  test 234 =assert
+;e
+
+e: test-empty-string
+  : test s" " ;
+  test 0 =assert drop
+;e