diff options
Diffstat (limited to 'mu.arc.t')
-rw-r--r-- | mu.arc.t | 88 |
1 files changed, 40 insertions, 48 deletions
diff --git a/mu.arc.t b/mu.arc.t index 88c4e25f..a2698597 100644 --- a/mu.arc.t +++ b/mu.arc.t @@ -510,6 +510,19 @@ (if (~iso memory* (obj 1 34 2 nil 3 1 4 nil 5 34)) (prn "F - 'get' accesses fields of record address")) +(def memory-contains (addr value) +;? (prn "Looking for @value starting at @addr") + (loop (addr addr + idx 0) +;? (prn "@idx vs @addr") + (if (>= idx len.value) + t + (~is memory*.addr value.idx) + (do1 nil + (prn "@addr should contain @value.idx but contains @memory*.addr")) + :else + (recur (+ addr 1) (+ idx 1))))) + (reset) (new-trace "get-indirect-repeated") (add-code @@ -523,10 +536,9 @@ ((8 integer) <- get (5 integer-point-pair-address-address deref deref) (0 offset)) ]))) (run 'main) -(if (or (~is memory*.6 35) - (~is memory*.7 36) - (~is memory*.8 34)) +(if (~memory-contains 6 '(35 36 34)) (prn "F - 'get' can deref multiple times")) +;? (quit) (reset) (new-trace "get-compound-field") @@ -798,7 +810,7 @@ ;? (prn completed-routines*) (each routine completed-routines* (aif rep.routine!error (prn "error - " it))) -(if (or (~is memory*.3 34) (~is memory*.4 t)) +(if (~memory-contains 3 '(34 t)) (prn "F - 'maybe-coerce' copies value only if type tag matches")) ;? (quit) @@ -813,7 +825,7 @@ ]))) (run 'main) ;? (prn memory*) -(if (or (~is memory*.3 0) (~is memory*.4 nil)) +(if (~memory-contains 3 '(0 nil)) (prn "F - 'maybe-coerce' doesn't copy value when type tag doesn't match")) (reset) @@ -839,7 +851,7 @@ ;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1" "sizeof"))) (run 'main) ;? (prn memory*) -(if (or (~is memory*.3 34) (~is memory*.4 t)) +(if (~memory-contains 3 '(34 t)) (prn "F - 'new-tagged-value' is the converse of 'maybe-coerce'")) ;? (quit) @@ -3145,6 +3157,21 @@ ;; --- +; helper +(def memory-contains-array (addr value) +;? (prn "Looking for @value starting at @addr, size @memory*.addr vs @len.value") + (and (>= memory*.addr len.value) + (loop (addr (+ addr 1) + idx 0) +;? (prn "comparing @memory*.addr and @value.idx") + (if (>= idx len.value) + t + (~is memory*.addr value.idx) + (do1 nil + (prn "@addr should contain @value.idx but contains @memory*.addr")) + :else + (recur (+ addr 1) (+ idx 1)))))) + (reset) (new-trace "string-new") (add-code '((def main [ @@ -3165,32 +3192,8 @@ (run 'main) (if (~iso Memory-in-use-until (+ before 5 1)) (prn "F - 'new' allocates arrays of bytes for string literals")) - (if (or (~is 5 (memory* before)) - (~is #\h (memory* (+ before 1))) - (~is #\e (memory* (+ before 2))) - (~is #\l (memory* (+ before 3))) - (~is #\l (memory* (+ before 4))) - (~is #\o (memory* (+ before 5)))) - (prn "F - 'new' initializes allocated memory to string literal")) - -; helper -(def memory-contains-array (addr value) -;? (prn "Looking for @value starting at @addr, size @memory*.addr vs @len.value") - (and (>= memory*.addr len.value) - (loop (addr (+ addr 1) - idx 0) -;? ;? (prn "comparing @memory*.addr and @value.idx") - (if (>= idx len.value) - t - (~is memory*.addr value.idx) - (do1 nil - (prn "@addr should contain @value.idx but contains @memory*.addr")) - :else - (recur (+ addr 1) (+ idx 1)))))) - - ; test the helper (if (~memory-contains-array before "hello") - (prn "F - 'memory-contains-array' helper is broken"))) + (prn "F - 'new' initializes allocated memory to string literal"))) (reset) (new-trace "strcat") @@ -3432,14 +3435,11 @@ (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)) +(if (~memory-contains 4 '(23 24)) (prn "F - 'setm' writes compound records")) (assert (is memory*.7 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)) +(if (~memory-contains 7 '(23 24 25)) (prn "F - 'setm' writes records with compound fields")) (= routine* make-routine!foo) (setm '(4 integer-point-pair) (annotate 'record '(33 34))) @@ -3447,24 +3447,16 @@ (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)) +(if (~memory-contains 4 '(43 44 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)) +(if (~memory-contains 4 '(53 54 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)) +(if (~memory-contains 4 '(2 31 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)) +(if (~memory-contains 4 '(2 41 42)) (prn "F - 'setm' supports indirect writes to arrays")) (= routine* make-routine!foo) (setm '(4 integer-array) (annotate 'record '(2 31 32 33))) |