X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=MUDDLE%2Ftester.putget;fp=MUDDLE%2Ftester.putget;h=de720cf4cc81eed24072b94197acac1bbd0dd965;hp=0000000000000000000000000000000000000000;hb=39c5769144e7f2a58076bdb973d2c80fa603345c;hpb=bab072f950a643ac109660a223b57e635492ac25

diff --git a/MUDDLE/tester.putget b/MUDDLE/tester.putget
new file mode 100644
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>)>>>
+
\ No newline at end of file