;"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>)>>>