Skip to content

Commit 08cf35f

Browse files
masintermasinter
committed
clean retranscript of AVTests
1 parent bf82d35 commit 08cf35f

File tree

2 files changed

+264
-0
lines changed

2 files changed

+264
-0
lines changed

‎test/medley/LOOPSTEST‎

Lines changed: 264 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,264 @@
1+
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
2+
3+
(FILECREATED "22-Feb-2024 17:34:11" {DSK}<home>larry>il>loops>LOOPSTEST.;2 6613
4+
5+
:EDIT-BY "lmm"
6+
7+
:CHANGES-TO (FNS TESTLOOPS)
8+
(VARS LOOPSTESTCOMS)
9+
10+
:PREVIOUS-DATE "22-Feb-2024 15:52:27" {DSK}<home>larry>il>loops>system>LOOPSTEST.;1)
11+
12+
13+
(PRETTYCOMPRINT LOOPSTESTCOMS)
14+
15+
(RPAQQ LOOPSTESTCOMS ((FNS TESTLOOPS)
16+
(VARS TESTAV1 TESTAV2)))
17+
(DEFINEQ
18+
19+
(TESTLOOPS
20+
[LAMBDA NIL (* ; "Edited 22-Feb-2024 16:33 by lmm")
21+
(FOR PROMPT IN TESTAV1 DO (if (AND (EQ (CAR PROMPT)
22+
'*)
23+
(EQ (CADR PROMPT)
24+
';;))
25+
THEN (PRIN1 (CL:THIRD PROMPT)
26+
T)
27+
28+
(* ;; "just print, it's a comment)")
29+
30+
(TERPRI T)
31+
ELSE (PRIN2 PROMPT T)
32+
(IF (CL:Y-OR-N-P " Proceed? ")
33+
then (PRIN1 " => " T)
34+
(PRINT (EVAL PROMPT)
35+
T])
36+
)
37+
38+
(RPAQQ TESTAV1
39+
('(CNDIR "loops/system")
40+
(FILESLOAD LOADLOOPS)
41+
(LOADLOOPS NIL)
42+
(SETQ ErrorOnNameConflict T)
43+
44+
(* ;; "")
45+
46+
47+
(* ;; "Define the classes")
48+
49+
(DefineClass 'Tank)
50+
(SETQ Tank (_ ($ Tank)
51+
SetName
52+
'Tank))
53+
($ Tank)
54+
55+
(* ;; "")
56+
57+
(DefineClass 'Pipe)
58+
(_ ($ Pipe)
59+
SetName
60+
'Pipe)
61+
(PP Pipe)
62+
63+
(* ;; "")
64+
65+
66+
(* ;; "Add outputPressure as IV to Tank")
67+
68+
(_ ($ Tank)
69+
AddIV
70+
'outputPressure)
71+
(PP Tank)
72+
73+
(* ;; "")
74+
75+
76+
(* ;; "Add inputPressure to Pipe")
77+
78+
(_ ($ Pipe)
79+
AddIV
80+
'inputPressure)
81+
82+
(* ;; "")
83+
84+
85+
(* ;; "Create subclass of Tank and Pipe named Tank1 and Pipe1")
86+
87+
(SETQ Tank1 (_ ($ Tank)
88+
New
89+
'Tank1))
90+
(PP ($ Tank1))
91+
(SETQ Pipe1 (_ ($ Pipe)
92+
New
93+
'Pipe1))
94+
(PP ($ Pipe1))
95+
96+
(* ;; "")
97+
98+
99+
(* ;; "Create an instance of IndirectVariable%")")
100+
101+
102+
(* ;; " Initialize its contents to point to the Tank's pressure")
103+
104+
(SETQ indVar1 (_ ($ IndirectVariable)
105+
New
106+
'indVar1))
107+
(_ ($ indVar1)
108+
SetName
109+
'indVar1)
110+
111+
(* ;; "")
112+
113+
114+
(* ;; "Assign object and varName")
115+
116+
(_@ ($ indVar1)
117+
object
118+
($ Tank1))
119+
(_@ ($ indVar1)
120+
varName
121+
'outputPressure)
122+
(PP ($ indVar1))
123+
124+
(* ;; "")
125+
126+
127+
(* ;; "Install the active value instance as the pipe's input pressure")
128+
129+
(_ ($ indVar1)
130+
AddActiveValue
131+
($ Pipe1)
132+
'inputPressure)
133+
(PP ($ indVar1))
134+
135+
(* ;; "")
136+
137+
138+
(* ;; "Accesses to either pipe's input pressure or tank's output pressure")
139+
140+
(@ Pipe1 inputPressure)
141+
(_@ Pipe1 inputPressure 100)
142+
(@ Tank1 outputPressure)
143+
(_@ Tank1 outputPressure 200)
144+
(@ Pipe1 inputPressure)
145+
(@ Tank1 outputPressure)
146+
147+
(* ;; "")
148+
149+
150+
(* ;; "Show Inspector Window on Pipe1")
151+
152+
(_ Tank1 Inspect NIL)
153+
(_ Pipe1 Inspect NIL)))
154+
155+
(RPAQQ TESTAV2
156+
(
157+
(* ;; "** NewTestAV **")
158+
159+
160+
(* ;; "From Section 8.2, Example 2 of the LRM **")
161+
162+
163+
(* ;; "Create the Bin class for the Conveyor")
164+
165+
(DefineClass 'Bin)
166+
(DefineClass 'Conveyor)
167+
168+
(* ;; "Add IVs to describe Bin")
169+
170+
(_ ($ Bin)
171+
AddIV
172+
'height 0)
173+
(_ ($ Conveyor)
174+
AddIV
175+
'height 0)
176+
177+
(* ;; "Create a Bin instance.")
178+
179+
(SETQ Bin1 (_ ($ Bin)
180+
New
181+
'Bin1))
182+
(SETQ Bin1 (_ ($ Bin1)
183+
SetName
184+
'Bin1))
185+
186+
(* ;; "Create a Conveyor instance.")
187+
188+
(SETQ Conveyor1 (_ ($ Conveyor)
189+
New
190+
'Conveyor1))
191+
(SETQ COnveyor1 (_ ($ Conveyor1)
192+
SetName
193+
'Conveyor1))
194+
195+
(* ;; "Define 3FeetAbove as a class.")
196+
197+
(DefineClass '3FeetAbove '(IndirectVariable))
198+
(SETQ 3FeetAbove (_ ($ 3FeetAbove)
199+
SetName
200+
'3FeetAbove))
201+
(PP 3FeetAbove)
202+
203+
(* ;; "Create an instance of 3FeetAbove.")
204+
205+
206+
(* ;; "Initialize its contents to point to the bin's height.")
207+
208+
(_ ($ 3FeetAbove)
209+
New
210+
'3fa1)
211+
(_@ ($ 3fa1)
212+
object
213+
($ Bin1))
214+
(_@ ($ 3fa1)
215+
varName
216+
'height)
217+
(_ ($ 3fa1)
218+
Inspect NIL)
219+
220+
(* ;; "Install 3fa1 as the value of the conveyor's height.")
221+
222+
(_ ($ 3fa1)
223+
AddActiveValue
224+
($ Conveyor1)
225+
'height)
226+
(_ ($ 3fa1)
227+
Inspect NIL)
228+
229+
(* ;; "The height of Bin1 defaults to 0, but what is the height of conveyor?")
230+
231+
(@ ($ Bin1)
232+
height)
233+
(@ ($ Conveyor1)
234+
height)
235+
236+
(* ;; "Now, set Bin1's height or Conveyor1's height.")
237+
238+
239+
(* ;; "See how the track each other.")
240+
241+
(_@ ($ Bin1)
242+
height 15)
243+
(@ ($ Conveyor1)
244+
height)
245+
(_@ ($ Conveyor1)
246+
height 21)
247+
(@ ($ Bin1)
248+
height)
249+
250+
(* ;; "Define subclass of LocalStateActiveValue.")
251+
252+
253+
(* ;; "Provide two IVs relative to height.")
254+
255+
(DefineClass 'WarningAV '(LocalStateActiveValue))
256+
(_ ($ WarningAV)
257+
AddIV
258+
'lowTrigger 0)
259+
(_ ($ WarningAV)
260+
AddIV
261+
'highTrigger 100)))
262+
(DECLARE%: DONTCOPY
263+
(FILEMAP (NIL (473 1404 (TESTLOOPS 483 . 1402)))))
264+
STOP

‎test/medley/LOOPSTEST.DFASL‎

2.58 KB
Binary file not shown.

0 commit comments

Comments
 (0)