1 ;"TESTER FOR PUT-GET ASSOCIATIONS"
2 ;"MAKES RANDOM ASSOCIATIONS THEN CHECKS LATER TO SEE IF MISSING"
4 <SETG TEST <FUNCTION ("OPTIONAL" (COUNT <MIN>) (OUTCHAN .OUTCHAN)
5 "EXTRA" (X ()) (Y ()) (Z ()))
7 <SET I <MIN 1000 <MOD <RANDOM> .COUNT>>>
8 <SET COUNT <- .COUNT .I>>
10 <IVECTOR 5000> ;"CALL GARBAGE COLLECTOR"
11 <CHECK-ASSOCS .I TENTATIVE>
12 <COND (<L? .COUNT 1> <RETURN "DONE">)>>
13 <CHECK-ASSOCS <LENGTH .X> FINAL>>>
15 <SETG MAKE-ASSOCS <FUNCTION (I)
17 <SET X (<MAKE-OBJ> !.X)>
18 <SET Y (<MAKE-OBJ> !.Y)>
19 <SET Z (<MAKE-OBJ> !.Z)>
20 <PUT <1 .X> <1 .Y> <1 .Z>> ;"DO THE ASSOCIATION"
21 <CHECK-ASSOCS 1 INITIAL>
22 <COND (<0? <DEC I>> <RETURN "DONE">)>>>>
24 <SETG MAKE-OBJ <FUNCTION ("EXTRA" (N <MOD <RANDOM> 19>))
25 <COND (<0? .N> <IVECTOR <MOD <RANDOM> 10> <MAKE-OBJ>>)
26 (<1? .N> <IUVECTOR <MOD <RANDOM> 10> <MAKE-OBJ>>)
27 (<L? .N 3> <ILIST <MOD <RANDOM> 10> <MAKE-OBJ>>)
28 (<L? .N 4> <ISTRING <MOD <RANDOM> 10> !"A>)
29 (<L? .N 5> <<+ 1 <MOD <RANDOM> <LENGTH .X>>> .X>)
30 (<L? .N 6> <<+ 1 <MOD <RANDOM> <LENGTH .Y>>> .Y>)
31 (<L? .N 7> <<+ 1 <MOD <RANDOM> <LENGTH .Z>>> .Z>)
32 (<L? .N 10> <ATOM <ISTRING <MOD <RANDOM> 10>
33 <ASCII <MOD <RANDOM> 127>>>>)
34 (<L? .N 16> <CHTYPE <RANDOM> FLOAT>)
35 (<L? .N 19> <ASCII <MOD <RANDOM> 127>>)>>>
38 <SETG CHECK-ASSOCS <FUNCTION (I LEVEL)
39 <REPEAT ((X .X) (Y .Y) (Z .Z))
40 <COND (<NOT <==? <GET <1 .X> <1 .Y>>
52 <COND (<0? <DEC I>> <RETURN "DONE">)>>>>
58 <SETG PRINT-ASSOC <FUNCTION (K)
61 <PRINT-IT <1 .X> <+ .K 10>>
64 <PRINT-IT <1 .Y> <+ .K 10>>
67 <PRINT-IT <1 .Z> <+ .K 10>>>>
71 <SETG PRINT-IT <FUNCTION (IT K)
73 <COND (<MONAD? .IT> <TERPRI>)
80 <PRINT-IT <1 .IT> <+ .K 10>>)>
81 <COND (<MEMQ .IT <REST .X>>
83 <PRINC "***SHARED ITEM">
85 <COND (<MEMQ .IT <REST .Y>>
87 <PRINC "***SHARED INDIC">
89 <COND (<MEMQ .IT <REST .Z>>
91 <PRINC "***SHARED VALUE">