diff options
-rw-r--r-- | mu.arc.t | 428 |
1 files changed, 189 insertions, 239 deletions
diff --git a/mu.arc.t b/mu.arc.t index 15e3ea9e..1661ca71 100644 --- a/mu.arc.t +++ b/mu.arc.t @@ -722,196 +722,6 @@ (prn "F - 'sizeof' is different from number of elems")) ; Regardless of a type's length, you can move it around just like a primitive. -; Various primitives need to support this. - -; unit tests for 'addr' helper -(reset) -(= routine* nil) -(if (~is 4 (addr '(4 integer))) - (prn "F - directly addressed operands are their own address")) -(if (~is 4 (addr '(4 integer-address))) - (prn "F - directly addressed operands are their own address - 2")) -(if (~is 4 (addr '(4 literal))) - (prn "F - 'addr' doesn't understand literals")) -(= memory*.4 23) -(if (~is 23 (addr '(4 integer-address deref))) - (prn "F - 'addr' works with indirectly-addressed 'deref'")) -(= memory*.3 4) -(if (~is 23 (addr '(3 integer-address-address deref deref))) - (prn "F - 'addr' works with multiple 'deref'")) - -(= routine* make-routine!foo) -(if (~is 4 (addr '(4 integer))) - (prn "F - directly addressed operands are their own address inside routines")) -(if (~is 4 (addr '(4 integer-address))) - (prn "F - directly addressed operands are their own address inside routines - 2")) -(if (~is 4 (addr '(4 literal))) - (prn "F - 'addr' doesn't understand literals inside routines")) -(= memory*.4 23) -(if (~is 23 (addr '(4 integer-address deref))) - (prn "F - 'addr' works with indirectly-addressed 'deref' inside routines")) - -(= rep.routine*!call-stack.0!default-scope 10) -(= memory*.10 5) ; bounds check for default-scope -(if (~is 14 (addr '(4 integer))) - (prn "F - directly addressed operands in routines add default-scope")) -(if (~is 14 (addr '(4 integer-address))) - (prn "F - directly addressed operands in routines add default-scope - 2")) -(if (~is 14 (addr '(4 literal))) - (prn "F - 'addr' doesn't understand literals")) -(= memory*.14 23) -(if (~is 23 (addr '(4 integer-address deref))) - (prn "F - 'addr' adds default-scope before 'deref', not after")) - -; unit tests for 'deref' helper -(reset) -(= memory*.3 4) -(if (~iso '(4 integer) (deref '(3 integer-address deref))) - (prn "F - 'deref' handles simple addresses")) -(if (~iso '(4 integer deref) (deref '(3 integer-address deref deref))) - (prn "F - 'deref' deletes just one deref")) -(= memory*.4 5) -(if (~iso '(5 integer) (deref:deref '(3 integer-address-address deref deref))) - (prn "F - 'deref' can be chained")) - -; unit tests for 'absolutize' helper -(reset) -(if (~iso '(4 integer) (absolutize '(4 integer))) - (prn "F - 'absolutize' works without routine")) -(= routine* make-routine!foo) -(if (~iso '(4 integer) (absolutize '(4 integer))) - (prn "F - 'absolutize' works without default-scope")) -(= rep.routine*!call-stack.0!default-scope 10) -(= memory*.10 5) ; bounds check for default-scope -(if (~iso '(14 integer global) (absolutize '(4 integer))) - (prn "F - 'absolutize' works with default-scope")) -(absolutize '(5 integer)) -(if (~posmatch "no room" rep.routine*!error) - (prn "F - 'absolutize' checks against default-scope bounds")) - -; unit tests for 'sizeof' helper -(reset) -(if (~is 1 sizeof!integer) - (prn "F - 'sizeof' works on primitives")) -(if (~is 1 sizeof!integer-address) - (prn "F - 'sizeof' works on addresses")) -(if (~is 2 sizeof!integer-boolean-pair) - (prn "F - 'sizeof' works on records")) -(if (~is 3 sizeof!integer-point-pair) - (prn "F - 'sizeof' works on records with record fields")) - -(if (~is 1 (sizeof '(34 integer))) - (prn "F - 'sizeof' works on primitive operands")) -(if (~is 1 (sizeof '(34 integer-address))) - (prn "F - 'sizeof' works on address operands")) -(if (~is 2 (sizeof '(34 integer-boolean-pair))) - (prn "F - 'sizeof' works on record operands")) -(if (~is 3 (sizeof '(34 integer-point-pair))) - (prn "F - 'sizeof' works on record operands with record fields")) -(if (~is 2 (sizeof '(34 integer-boolean-pair-address deref))) - (prn "F - 'sizeof' works on pointers to records")) - -(= memory*.4 23) -(if (~is 24 (sizeof '(4 integer-array))) - (prn "F - 'sizeof' reads array lengths from memory")) -(= memory*.3 4) -(if (~is 24 (sizeof '(3 integer-array-address deref))) - (prn "F - 'sizeof' handles pointers to arrays")) -(= memory*.14 34) -(= routine* make-routine!foo) -(if (~is 24 (sizeof '(4 integer-array))) - (prn "F - 'sizeof' reads array lengths from memory inside routines")) -(= rep.routine*!call-stack.0!default-scope 10) -(= memory*.10 5) ; bounds check for default-scope -(if (~is 35 (sizeof '(4 integer-array))) - (prn "F - 'sizeof' reads array lengths from memory using default-scope")) - -; unit tests for 'm' helper -(reset) -(if (~is 4 (m '(4 literal))) - (prn "F - 'm' avoids reading memory for literals")) -(if (~is 4 (m '(4 offset))) - (prn "F - 'm' avoids reading memory for offsets")) -(= memory*.4 34) -(if (~is 34 (m '(4 integer))) - (prn "F - 'm' reads memory for simple types")) -(= memory*.3 4) -(if (~is 34 (m '(3 integer-address deref))) - (prn "F - 'm' redirects addresses")) -(= memory*.2 3) -(if (~is 34 (m '(2 integer-address-address deref deref))) - (prn "F - 'm' multiply redirects addresses")) -(if (~iso (annotate 'record '(34 nil)) (m '(4 integer-boolean-pair))) - (prn "F - 'm' supports compound records")) -(= memory*.5 35) -(= memory*.6 36) -(if (~iso (annotate 'record '(34 35 36)) (m '(4 integer-point-pair))) - (prn "F - 'm' supports records with compound fields")) -(if (~iso (annotate 'record '(34 35 36)) (m '(3 integer-point-pair-address deref))) - (prn "F - 'm' supports indirect access to records")) -(= memory*.4 2) -(if (~iso (annotate 'record '(2 35 36)) (m '(4 integer-array))) - (prn "F - 'm' supports access to arrays")) -(if (~iso (annotate 'record '(2 35 36)) (m '(3 integer-array-address deref))) - (prn "F - 'm' supports indirect access to arrays")) - -; unit tests for 'setm' helper -(reset) -(setm '(4 integer) 34) -(if (~is 34 memory*.4) - (prn "F - 'setm' writes primitives to memory")) -(setm '(3 integer-address) 4) -(if (~is 4 memory*.3) - (prn "F - 'setm' writes addresses to memory")) -(setm '(3 integer-address deref) 35) -(if (~is 35 memory*.4) - (prn "F - 'setm' redirects writes")) -(= memory*.2 3) -(setm '(2 integer-address-address deref deref) 36) -(if (~is 36 memory*.4) - (prn "F - 'setm' multiply redirects writes")) -(setm '(4 integer-integer-pair) (annotate 'record '(23 24))) -(if (or (~is memory*.4 23) - (~is memory*.5 24)) - (prn "F - 'setm' writes compound records")) -(assert (is memory*.6 nil)) -(setm '(7 integer-point-pair) (annotate 'record '(23 24 25))) -(if (or (~is memory*.7 23) - (~is memory*.8 24) - (~is memory*.9 25)) - (prn "F - 'setm' writes records with compound fields")) -(= routine* make-routine!foo) -(setm '(4 integer-point-pair) (annotate 'record '(33 34))) -(if (~posmatch "incorrect size" rep.routine*!error) - (prn "F - 'setm' checks size of target")) -(wipe routine*) -(setm '(3 integer-point-pair-address deref) (annotate 'record '(43 44 45))) -(if (or (~is memory*.4 43) - (~is memory*.5 44) - (~is memory*.6 45)) - (prn "F - 'setm' supports indirect writes to records")) -(setm '(2 integer-point-pair-address-address deref deref) (annotate 'record '(53 54 55))) -(if (or (~is memory*.4 53) - (~is memory*.5 54) - (~is memory*.6 55)) - (prn "F - 'setm' supports multiply indirect writes to records")) -(setm '(4 integer-array) (annotate 'record '(2 31 32))) -(if (or (~is memory*.4 2) - (~is memory*.5 31) - (~is memory*.6 32)) - (prn "F - 'setm' writes arrays")) -(setm '(3 integer-array-address deref) (annotate 'record '(2 41 42))) -(if (or (~is memory*.4 2) - (~is memory*.5 41) - (~is memory*.6 42)) - (prn "F - 'setm' supports indirect writes to arrays")) -(= routine* make-routine!foo) -(setm '(4 integer-array) (annotate 'record '(2 31 32 33))) -(if (~posmatch "invalid array" rep.routine*!error) - (prn "F - 'setm' checks that array written is well-formed")) -(wipe routine*) - -; back to top level tests (reset) (new-trace "copy-record") @@ -3276,19 +3086,6 @@ ]))) ;? (= dump-trace* (obj whitelist '("run"))) (run 'main) -;? (prn memory*.1 " " memory*.2 " " memory*.3) -;? (prn (memory* memory*.3)) -;? (prn (memory* (+ memory*.3 1))) -;? (prn (memory* (+ memory*.3 2))) -;? (prn (memory* (+ memory*.3 3))) -;? (prn (memory* (+ memory*.3 4))) -;? (prn (memory* (+ memory*.3 5))) -;? (prn (memory* (+ memory*.3 6))) -;? (prn (memory* (+ memory*.3 7))) -;? (prn (memory* (+ memory*.3 8))) -;? (prn (memory* (+ memory*.3 9))) -;? (prn (memory* (+ memory*.3 10))) -;? (prn (memory* (+ memory*.3 11))) (if (~memory-contains memory*.3 "hello, abc!") (prn "F - 'interpolate' splices strings")) @@ -3301,18 +3098,6 @@ ]))) ;? (= dump-trace* (obj whitelist '("run"))) (run 'main) -;? (prn (memory* memory*.3)) -;? (prn (memory* (+ memory*.3 1))) -;? (prn (memory* (+ memory*.3 2))) -;? (prn (memory* (+ memory*.3 3))) -;? (prn (memory* (+ memory*.3 4))) -;? (prn (memory* (+ memory*.3 5))) -;? (prn (memory* (+ memory*.3 6))) -;? (prn (memory* (+ memory*.3 7))) -;? (prn (memory* (+ memory*.3 8))) -;? (prn (memory* (+ memory*.3 9))) -;? (prn (memory* (+ memory*.3 10))) -;? (prn (memory* (+ memory*.3 11))) (if (~memory-contains memory*.3 "hello!") (prn "F - 'interpolate' without underscore returns template")) @@ -3325,18 +3110,6 @@ ]))) ;? (= dump-trace* (obj whitelist '("run"))) (run 'main) -;? (prn (memory* memory*.3)) -;? (prn (memory* (+ memory*.3 1))) -;? (prn (memory* (+ memory*.3 2))) -;? (prn (memory* (+ memory*.3 3))) -;? (prn (memory* (+ memory*.3 4))) -;? (prn (memory* (+ memory*.3 5))) -;? (prn (memory* (+ memory*.3 6))) -;? (prn (memory* (+ memory*.3 7))) -;? (prn (memory* (+ memory*.3 8))) -;? (prn (memory* (+ memory*.3 9))) -;? (prn (memory* (+ memory*.3 10))) -;? (prn (memory* (+ memory*.3 11))) (if (~memory-contains memory*.3 "abc, hello") (prn "F - 'interpolate' splices strings at start")) @@ -3349,19 +3122,196 @@ ]))) ;? (= dump-trace* (obj whitelist '("run"))) (run 'main) -;? (prn (memory* memory*.3)) -;? (prn (memory* (+ memory*.3 1))) -;? (prn (memory* (+ memory*.3 2))) -;? (prn (memory* (+ memory*.3 3))) -;? (prn (memory* (+ memory*.3 4))) -;? (prn (memory* (+ memory*.3 5))) -;? (prn (memory* (+ memory*.3 6))) -;? (prn (memory* (+ memory*.3 7))) -;? (prn (memory* (+ memory*.3 8))) -;? (prn (memory* (+ memory*.3 9))) -;? (prn (memory* (+ memory*.3 10))) -;? (prn (memory* (+ memory*.3 11))) (if (~memory-contains memory*.3 "hello, abc") (prn "F - 'interpolate' splices strings at start")) +;; unit tests for various helpers + +; addr +(reset) +(= routine* nil) +(if (~is 4 (addr '(4 integer))) + (prn "F - directly addressed operands are their own address")) +(if (~is 4 (addr '(4 integer-address))) + (prn "F - directly addressed operands are their own address - 2")) +(if (~is 4 (addr '(4 literal))) + (prn "F - 'addr' doesn't understand literals")) +(= memory*.4 23) +(if (~is 23 (addr '(4 integer-address deref))) + (prn "F - 'addr' works with indirectly-addressed 'deref'")) +(= memory*.3 4) +(if (~is 23 (addr '(3 integer-address-address deref deref))) + (prn "F - 'addr' works with multiple 'deref'")) + +(= routine* make-routine!foo) +(if (~is 4 (addr '(4 integer))) + (prn "F - directly addressed operands are their own address inside routines")) +(if (~is 4 (addr '(4 integer-address))) + (prn "F - directly addressed operands are their own address inside routines - 2")) +(if (~is 4 (addr '(4 literal))) + (prn "F - 'addr' doesn't understand literals inside routines")) +(= memory*.4 23) +(if (~is 23 (addr '(4 integer-address deref))) + (prn "F - 'addr' works with indirectly-addressed 'deref' inside routines")) + +(= rep.routine*!call-stack.0!default-scope 10) +(= memory*.10 5) ; bounds check for default-scope +(if (~is 14 (addr '(4 integer))) + (prn "F - directly addressed operands in routines add default-scope")) +(if (~is 14 (addr '(4 integer-address))) + (prn "F - directly addressed operands in routines add default-scope - 2")) +(if (~is 14 (addr '(4 literal))) + (prn "F - 'addr' doesn't understand literals")) +(= memory*.14 23) +(if (~is 23 (addr '(4 integer-address deref))) + (prn "F - 'addr' adds default-scope before 'deref', not after")) + +; deref +(reset) +(= memory*.3 4) +(if (~iso '(4 integer) (deref '(3 integer-address deref))) + (prn "F - 'deref' handles simple addresses")) +(if (~iso '(4 integer deref) (deref '(3 integer-address deref deref))) + (prn "F - 'deref' deletes just one deref")) +(= memory*.4 5) +(if (~iso '(5 integer) (deref:deref '(3 integer-address-address deref deref))) + (prn "F - 'deref' can be chained")) + +; absolutize +(reset) +(if (~iso '(4 integer) (absolutize '(4 integer))) + (prn "F - 'absolutize' works without routine")) +(= routine* make-routine!foo) +(if (~iso '(4 integer) (absolutize '(4 integer))) + (prn "F - 'absolutize' works without default-scope")) +(= rep.routine*!call-stack.0!default-scope 10) +(= memory*.10 5) ; bounds check for default-scope +(if (~iso '(14 integer global) (absolutize '(4 integer))) + (prn "F - 'absolutize' works with default-scope")) +(absolutize '(5 integer)) +(if (~posmatch "no room" rep.routine*!error) + (prn "F - 'absolutize' checks against default-scope bounds")) + +; sizeof +(reset) +(if (~is 1 sizeof!integer) + (prn "F - 'sizeof' works on primitives")) +(if (~is 1 sizeof!integer-address) + (prn "F - 'sizeof' works on addresses")) +(if (~is 2 sizeof!integer-boolean-pair) + (prn "F - 'sizeof' works on records")) +(if (~is 3 sizeof!integer-point-pair) + (prn "F - 'sizeof' works on records with record fields")) + +(if (~is 1 (sizeof '(34 integer))) + (prn "F - 'sizeof' works on primitive operands")) +(if (~is 1 (sizeof '(34 integer-address))) + (prn "F - 'sizeof' works on address operands")) +(if (~is 2 (sizeof '(34 integer-boolean-pair))) + (prn "F - 'sizeof' works on record operands")) +(if (~is 3 (sizeof '(34 integer-point-pair))) + (prn "F - 'sizeof' works on record operands with record fields")) +(if (~is 2 (sizeof '(34 integer-boolean-pair-address deref))) + (prn "F - 'sizeof' works on pointers to records")) + +(= memory*.4 23) +(if (~is 24 (sizeof '(4 integer-array))) + (prn "F - 'sizeof' reads array lengths from memory")) +(= memory*.3 4) +(if (~is 24 (sizeof '(3 integer-array-address deref))) + (prn "F - 'sizeof' handles pointers to arrays")) +(= memory*.14 34) +(= routine* make-routine!foo) +(if (~is 24 (sizeof '(4 integer-array))) + (prn "F - 'sizeof' reads array lengths from memory inside routines")) +(= rep.routine*!call-stack.0!default-scope 10) +(= memory*.10 5) ; bounds check for default-scope +(if (~is 35 (sizeof '(4 integer-array))) + (prn "F - 'sizeof' reads array lengths from memory using default-scope")) + +; m +(reset) +(if (~is 4 (m '(4 literal))) + (prn "F - 'm' avoids reading memory for literals")) +(if (~is 4 (m '(4 offset))) + (prn "F - 'm' avoids reading memory for offsets")) +(= memory*.4 34) +(if (~is 34 (m '(4 integer))) + (prn "F - 'm' reads memory for simple types")) +(= memory*.3 4) +(if (~is 34 (m '(3 integer-address deref))) + (prn "F - 'm' redirects addresses")) +(= memory*.2 3) +(if (~is 34 (m '(2 integer-address-address deref deref))) + (prn "F - 'm' multiply redirects addresses")) +(if (~iso (annotate 'record '(34 nil)) (m '(4 integer-boolean-pair))) + (prn "F - 'm' supports compound records")) +(= memory*.5 35) +(= memory*.6 36) +(if (~iso (annotate 'record '(34 35 36)) (m '(4 integer-point-pair))) + (prn "F - 'm' supports records with compound fields")) +(if (~iso (annotate 'record '(34 35 36)) (m '(3 integer-point-pair-address deref))) + (prn "F - 'm' supports indirect access to records")) +(= memory*.4 2) +(if (~iso (annotate 'record '(2 35 36)) (m '(4 integer-array))) + (prn "F - 'm' supports access to arrays")) +(if (~iso (annotate 'record '(2 35 36)) (m '(3 integer-array-address deref))) + (prn "F - 'm' supports indirect access to arrays")) + +; setm +(reset) +(setm '(4 integer) 34) +(if (~is 34 memory*.4) + (prn "F - 'setm' writes primitives to memory")) +(setm '(3 integer-address) 4) +(if (~is 4 memory*.3) + (prn "F - 'setm' writes addresses to memory")) +(setm '(3 integer-address deref) 35) +(if (~is 35 memory*.4) + (prn "F - 'setm' redirects writes")) +(= memory*.2 3) +(setm '(2 integer-address-address deref deref) 36) +(if (~is 36 memory*.4) + (prn "F - 'setm' multiply redirects writes")) +(setm '(4 integer-integer-pair) (annotate 'record '(23 24))) +(if (or (~is memory*.4 23) + (~is memory*.5 24)) + (prn "F - 'setm' writes compound records")) +(assert (is memory*.6 nil)) +(setm '(7 integer-point-pair) (annotate 'record '(23 24 25))) +(if (or (~is memory*.7 23) + (~is memory*.8 24) + (~is memory*.9 25)) + (prn "F - 'setm' writes records with compound fields")) +(= routine* make-routine!foo) +(setm '(4 integer-point-pair) (annotate 'record '(33 34))) +(if (~posmatch "incorrect size" rep.routine*!error) + (prn "F - 'setm' checks size of target")) +(wipe routine*) +(setm '(3 integer-point-pair-address deref) (annotate 'record '(43 44 45))) +(if (or (~is memory*.4 43) + (~is memory*.5 44) + (~is memory*.6 45)) + (prn "F - 'setm' supports indirect writes to records")) +(setm '(2 integer-point-pair-address-address deref deref) (annotate 'record '(53 54 55))) +(if (or (~is memory*.4 53) + (~is memory*.5 54) + (~is memory*.6 55)) + (prn "F - 'setm' supports multiply indirect writes to records")) +(setm '(4 integer-array) (annotate 'record '(2 31 32))) +(if (or (~is memory*.4 2) + (~is memory*.5 31) + (~is memory*.6 32)) + (prn "F - 'setm' writes arrays")) +(setm '(3 integer-array-address deref) (annotate 'record '(2 41 42))) +(if (or (~is memory*.4 2) + (~is memory*.5 41) + (~is memory*.6 42)) + (prn "F - 'setm' supports indirect writes to arrays")) +(= routine* make-routine!foo) +(setm '(4 integer-array) (annotate 'record '(2 31 32 33))) +(if (~posmatch "invalid array" rep.routine*!error) + (prn "F - 'setm' checks that array written is well-formed")) +(wipe routine*) + (reset) ; end file with this to persist the trace for the final test |