ITS Muddle.

[pdp10-muddle.git] / MUDDLE / tester.putget

diff --git a/MUDDLE/tester.putget b/MUDDLE/tester.putget
new file mode 100644 (file)
index 0000000..de720cf
--- /dev/null
+++ b/MUDDLE/tester.putget
@@ -0,0 +1,93 @@
+;"TESTER FOR PUT-GET ASSOCIATIONS"
+;"MAKES RANDOM ASSOCIATIONS THEN CHECKS LATER TO SEE IF MISSING"
+
+<SETG TEST <FUNCTION ("OPTIONAL" (COUNT <MIN>) (OUTCHAN .OUTCHAN)
+       "EXTRA" (X ()) (Y ()) (Z ()))
+       <REPEAT (I)
+               <SET I <MIN 1000 <MOD <RANDOM> .COUNT>>>
+               <SET COUNT <- .COUNT .I>>
+               <MAKE-ASSOCS .I>
+               <IVECTOR 5000>  ;"CALL GARBAGE COLLECTOR"
+               <CHECK-ASSOCS .I TENTATIVE>
+               <COND (<L? .COUNT 1> <RETURN "DONE">)>>
+       <CHECK-ASSOCS <LENGTH .X> FINAL>>>
+
+<SETG MAKE-ASSOCS <FUNCTION (I)
+       <REPEAT ()
+               <SET X (<MAKE-OBJ> !.X)>
+               <SET Y (<MAKE-OBJ> !.Y)>
+               <SET Z (<MAKE-OBJ> !.Z)>
+               <PUT <1 .X> <1 .Y> <1 .Z>>      ;"DO THE ASSOCIATION"
+               <CHECK-ASSOCS 1 INITIAL>
+               <COND (<0? <DEC I>> <RETURN "DONE">)>>>>
+
+<SETG MAKE-OBJ <FUNCTION ("EXTRA" (N <MOD <RANDOM> 19>))
+       <COND   (<0? .N> <IVECTOR <MOD <RANDOM> 10> <MAKE-OBJ>>)
+               (<1? .N> <IUVECTOR <MOD <RANDOM> 10> <MAKE-OBJ>>)
+               (<L? .N 3> <ILIST <MOD <RANDOM> 10> <MAKE-OBJ>>)
+               (<L? .N 4> <ISTRING <MOD <RANDOM> 10> !"A>)
+               (<L? .N 5> <<+ 1 <MOD <RANDOM> <LENGTH .X>>> .X>)
+               (<L? .N 6> <<+ 1 <MOD <RANDOM> <LENGTH .Y>>> .Y>)
+               (<L? .N 7> <<+ 1 <MOD <RANDOM> <LENGTH .Z>>> .Z>)
+               (<L? .N 10> <ATOM <ISTRING <MOD <RANDOM> 10>
+                               <ASCII <MOD <RANDOM> 127>>>>)
+               (<L? .N 16> <CHTYPE <RANDOM> FLOAT>)
+               (<L? .N 19> <ASCII <MOD <RANDOM> 127>>)>>>
+
+
+<SETG CHECK-ASSOCS <FUNCTION (I LEVEL)
+       <REPEAT ((X .X) (Y .Y) (Z .Z))
+               <COND (<NOT <==? <GET <1 .X> <1 .Y>>
+                               <1 .Z>>>
+                       <PRINT .LEVEL>
+                       <PRIN1 LOSER>
+                       <TERPRI>
+                       <PRINT-ASSOC 0>
+                       <PUT .X 1 0>
+                       <PUT .Y 1 0>
+                       <PUT .Z 1 0>)>
+               <CHOP X>
+               <CHOP Y>
+               <CHOP Z>
+               <COND (<0? <DEC I>> <RETURN "DONE">)>>>>
+
+
+<PUT 0 0 0>
+
+
+<SETG PRINT-ASSOC <FUNCTION (K)
+       <INDENT-TO .K>
+       <PRINC "ITEM: ">
+       <PRINT-IT <1 .X> <+ .K 10>>
+       <INDENT-TO .K>
+       <PRINC "INDIC: ">
+       <PRINT-IT <1 .Y> <+ .K 10>>
+       <INDENT-TO .K>
+       <PRINC "VALUE: ">
+       <PRINT-IT <1 .Z> <+ .K 10>>>>
+
+
+
+<SETG PRINT-IT <FUNCTION (IT K)
+       <PRINC <TYPE .IT>>
+       <COND   (<MONAD? .IT> <TERPRI>)
+               (ELSE
+                <PRINC " LENGTH: ">
+                <PRINC <LENGTH .IT>>
+                <PRINC " OF:">
+                <TERPRI>
+                <INDENT-TO .K>
+                <PRINT-IT <1 .IT> <+ .K 10>>)>
+       <COND (<MEMQ .IT <REST .X>>
+               <INDENT-TO .K>
+               <PRINC "***SHARED ITEM">
+               <TERPRI>)>
+       <COND (<MEMQ .IT <REST .Y>>
+               <INDENT-TO .K>
+               <PRINC "***SHARED INDIC">
+               <TERPRI>)>
+       <COND (<MEMQ .IT <REST .Z>>
+               <INDENT-TO .K>
+               <PRINC "***SHARED VALUE">
+               <TERPRI>)>>>
+\f\ 3\f
\ No newline at end of file