375 - reorg tests

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