10 lines
9.0 KiB
Plaintext
10 lines
9.0 KiB
Plaintext
Script for testing defstruct and the inspector with defstruct
|
||
(assuming currently in Common Lisp User package)
|
||
-----------------------------------------------------
|
||
type:
|
||
(cl:in-package "USER")
|
||
|
||
type:
|
||
(defstruct rec (a "hello there" :type IL:pointer)(b 5 :type il:integer) (c 4 :type il:fixp) (d 2.3 :type il:floating) (e 4.5 :type il:floatp) (f -5 :type il:signedword :read-only t) (g T :type il:flag) (h 7 :type il:bits3) (i 4 :type il:byte) (j 7 :type il:word) (k '(a b c d) :type il:xpointer))
|
||
|
||
-- it should reply rec
|
||
|
||
type:
|
||
(setf rec1 (make-rec :e 2.3))
|
||
|
||
type:
|
||
(inspect rec1)
|
||
|
||
-- a window that looks like the following appears
|
||
|
||
‚ ¢ ªªªªªªªªªªªªªªªª€ UUUUUUUUUUUUUUUU@ UUUUUUUUUUUUUUUU@ ªªªªªªªªªªªªªªªª€ ªªªªªªªªªªªªªªªª€ _ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÀ _ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÀ ¯ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ€ ¯Áßÿÿßÿÿýÿÿÿÿýÿÿ€ _¾ßÿÿßÿÿýÿÿÿÿýÿÿÀ _¿…/q…í1ý£ÇG<C387>aÓÀ ¯ÃܯnÝì®ý<C2AE>»;víÞË€ ¯ýÝïoÝíàý½Ç{ýÞ߀ _þÝïoÝíïý½û{~ýÞßÀ _¾ÝînÝÍîý½»;víÞßÀ ¯Áåñqæ-ñý½ÇG<C387> a߀ ¯ÿÿÿÿÿÿÿÿÿÿÿÿÿÿ€ _ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÀ _ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÀ ¬ € ¬ € \ À \
|
||
pà ¡À ¬
|
||
¡€ ¬
|
||
,8!À Xp¡€ \ 2D" "dˆÀ \ "|" >@øÀ ¬ "@" @€€ ¬ "D" ‘"@ˆ€ \ "8!À @pÀ \ À ¬ € ¬ € \ À \ À ¬ € ¬ € \ À \ À ¬ € ¬ € \ À \ À ¬ € ¬ € \ À \ À ¬
|
||
€ ¬
|
||
€ \ À \ À ¬ € ¬ € \ À \ À ¬ € ¬ € \ À \ 8 À ¬ D € ¬
|
||
€ \ 8 À \ À ¬ € ¬ D € \
|
||
8 À \ À ¬ € ¬ € \ À \ 8 À ¬ D € ¬ € \ 8 À \ À ¬ € ¬ D € \ 8 À \ À ¬ € ¬ € \ À \ > À ¬ € ¬ € \ < À \ " À ¬ € ¬ " € \ À \ À ¬ € ¬ € D À \ À ¬ € ¬
|
||
€ \ À \ À ¬ € ¬ € \
|
||
À \ À ¬ € ¬ € \ À \ )))
|
||
|
||
(DO-TEST |smashing-datatype|
|
||
(SETQ RECORD-TEST-RECORD4 (IL:CREATE RECORD-TEST-NAME
|
||
IL:SMASHING RECORD-TEST-RECORD2))
|
||
(AND (NULL (IL:FETCH ALPHA IL:OF RECORD-TEST-RECORD2))
|
||
(EQ RECORD-TEST-RECORD2 RECORD-TEST-RECORD4)))
|
||
|
||
|
||
;record type arrayrecord
|
||
|
||
(DO-TEST |setup-arrayrecord|
|
||
(IL:ARRAYRECORD RECORD-TEST-NAME (ALPHA BRAVO GAMMA)
|
||
(IL:SYNONYM ALPHA A)
|
||
(IL:TYPE? (COND (IL:DATUM T)))))
|
||
|
||
(DO-TEST |create-arrayrecord|
|
||
(SETQ RECORD-TEST-RECORD
|
||
(IL:|create| RECORD-TEST-NAME
|
||
ALPHA IL:_ ALFA BRAVO IL:_ S)))
|
||
|
||
|
||
(DO-TEST |type?-arrayrecord|
|
||
(IL:|type?| RECORD-TEST-NAME RECORD-TEST-RECORD))
|
||
|
||
(DO-TEST SYNONYM-typearary
|
||
(EQ (IL:FETCH A IL:OF RECORD-TEST-RECORD) ALFA))
|
||
|
||
(DO-TEST |fetch-arrayrecord|
|
||
` (AND (EQ (IL:FETCH ALPHA IL:OF RECORD-TEST-RECORD) ALFA)
|
||
(EQ (IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD) S)))
|
||
|
||
(DO-TEST |replace-arrayrecord|
|
||
(AND (EQ (IL:REPLACE ALPHA IL:OF RECORD-TEST-RECORD
|
||
IL:WITH S) S)
|
||
(EQ (IL:REPLACE BRAVO IL:OF RECORD-TEST-RECORD
|
||
IL:WITH ALFA) ALFA)))
|
||
|
||
(DO-TEST |refetch-arrayrecord|
|
||
(AND (EQ (IL:FETCH ALPHA IL:OF RECORD-TEST-RECORD) S)
|
||
(EQ (IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD) ALFA)
|
||
(EQ (IL:FETCH A IL:OF RECORD-TEST-RECORD) S)))
|
||
|
||
(DO-TEST rereplace-arrayrecord
|
||
(AND (EQ (IL:REPLACE ALPHA IL:OF RECORD-TEST-RECORD
|
||
IL:WITH ALFA) ALFA)
|
||
(EQ (IL:REPLACE BRAVO IL:OF RECORD-TEST-RECORD
|
||
IL:WITH S) S)))
|
||
|
||
(DO-TEST |typeglobalvariable-arrayrecord|
|
||
(EQ (SYMBOL-PACKAGE (IL:\\TYPEGLOBALVARIABLE
|
||
(QUOTE RECORD-TEST-NAME)))
|
||
(FIND-PACKAGE "XCL-TEST")))
|
||
|
||
(DO-TEST getfieldspecs-arrayrecord
|
||
(EQ (CAR (IL:GETFIELDSPECS (QUOTE RECORD-TEST-NAME)))
|
||
(CADDAR (IL:GETDESCRIPTORS (QUOTE RECORD-TEST-NAME)))))
|
||
|
||
(DO-TEST IL:typename-arrayrecord
|
||
(EQ (IL:TYPENAME RECORD-TEST-RECORD)
|
||
(QUOTE il:arrayp)))
|
||
|
||
(DO-TEST typenamep-arrayrecord
|
||
(IL:TYPENAMEP RECORD-TEST-RECORD (QUOTE il:arrayp)))
|
||
|
||
|
||
(DO-TEST |using-arrayrecord|
|
||
(SETQ RECORD-TEST-RECORD3
|
||
(IL:CREATE RECORD-TEST-NAME
|
||
IL:USING RECORD-TEST-RECORD GAMMA IL:_ S))
|
||
(AND (EQ (IL:FETCH ALPHA IL:OF RECORD-TEST-RECORD)
|
||
(IL:FETCH ALPHA IL:OF RECORD-TEST-RECORD3))
|
||
(EQ (IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD)
|
||
(IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD3))
|
||
(EQ (IL:FETCH GAMMA IL:OF RECORD-TEST-RECORD3) S)))
|
||
|
||
|
||
(DO-TEST |reusing-arrayrecord|
|
||
(SETQ RECORD-TEST-RECORD3
|
||
(IL:CREATE RECORD-TEST-NAME
|
||
IL:REUSING RECORD-TEST-RECORD))
|
||
(AND (EQ (IL:FETCH ALPHA IL:OF RECORD-TEST-RECORD)
|
||
(IL:FETCH ALPHA IL:OF RECORD-TEST-RECORD3))
|
||
(EQ (IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD)
|
||
(IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD3))))
|
||
|
||
|
||
(DO-TEST |copying-arrayrecord|
|
||
(SETQ RECORD-TEST-RECORD2
|
||
(IL:CREATE RECORD-TEST-NAME
|
||
IL:COPYING RECORD-TEST-RECORD))
|
||
(AND (EQUAL (IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD)
|
||
(IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD2))
|
||
(NOT (EQ (IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD)
|
||
(IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD2)))))
|
||
|
||
|
||
(DO-TEST |smashing-arrayrecord|
|
||
(SETQ RECORD-TEST-RECORD4 (IL:CREATE RECORD-TEST-NAME
|
||
IL:SMASHING RECORD-TEST-RECORD2))
|
||
(AND (NULL (IL:FETCH ALPHA IL:OF RECORD-TEST-RECORD2))
|
||
(EQ RECORD-TEST-RECORD2 RECORD-TEST-RECORD4)))
|
||
|
||
;record type assocrecord
|
||
|
||
(DO-TEST |setup-assocrecord|
|
||
(IL:ASSOCRECORD RECORD-TEST-NAME (ALPHA BRAVO GAMMA)
|
||
(IL:SYNONYM ALPHA A)
|
||
(IL:TYPE? (NOT (IL:ATOM (CAR IL:DATUM))))))
|
||
|
||
|
||
(DO-TEST |create-assocrecord|
|
||
(SETQ RECORD-TEST-RECORD (IL:|create| RECORD-TEST-NAME
|
||
ALPHA IL:_ ALFA BRAVO IL:_ S)))
|
||
|
||
|
||
(DO-TEST |type?-assocrecord|
|
||
(IL:|type?| RECORD-TEST-NAME RECORD-TEST-RECORD))
|
||
|
||
(DO-TEST synonym-assocrecord
|
||
(EQ (IL:FETCH A IL:OF RECORD-TEST-RECORD) ALFA))
|
||
|
||
(DO-TEST |fetch-assocrecord|
|
||
(AND (EQ (IL:FETCH ALPHA IL:OF RECORD-TEST-RECORD) ALFA)
|
||
(EQ (IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD) S)))
|
||
|
||
(DO-TEST |replace-assocrecord|
|
||
(AND (EQ (IL:REPLACE ALPHA IL:OF RECORD-TEST-RECORD
|
||
IL:WITH S) S)
|
||
(EQ (IL:REPLACE BRAVO IL:OF RECORD-TEST-RECORD
|
||
IL:WITH ALFA) ALFA)))
|
||
|
||
(DO-TEST |refetch-assocrecord|
|
||
(AND (EQ (IL:FETCH ALPHA IL:OF RECORD-TEST-RECORD) S)
|
||
(EQ (IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD) ALFA)
|
||
(EQ (IL:FETCH A IL:OF RECORD-TEST-RECORD) S)))
|
||
|
||
(DO-TEST rereplace-assocrecord
|
||
(AND (EQ (IL:REPLACE ALPHA IL:OF RECORD-TEST-RECORD
|
||
IL:WITH ALFA) ALFA)
|
||
(EQ (IL:REPLACE BRAVO IL:OF RECORD-TEST-RECORD
|
||
IL:WITH S) S)))
|
||
|
||
(DO-TEST |typeglobalvariable-assocrecord|
|
||
(EQ (SYMBOL-PACKAGE (IL:\\TYPEGLOBALVARIABLE
|
||
(QUOTE RECORD-TEST-NAME)))
|
||
(FIND-PACKAGE "XCL-TEST")))
|
||
|
||
(DO-TEST |using-assocrecord|
|
||
(SETQ RECORD-TEST-RECORD3
|
||
(IL:CREATE RECORD-TEST-NAME
|
||
IL:USING RECORD-TEST-RECORD GAMMA IL:_ S))
|
||
(AND (EQ (IL:FETCH ALPHA IL:OF RECORD-TEST-RECORD)
|
||
(IL:FETCH ALPHA IL:OF RECORD-TEST-RECORD3))
|
||
(EQ (IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD)
|
||
(IL:FETCH BRAVO IL:OF RECORD-TEST-RECORD3))
|
||
(EQ (IL:FETCH GAMMA IL:OF RECORD-TEST-RECORD3) S)))
|
||
|
||
|
||
(DO-TEST |reusing-assocrecord|
|
||
(SETQ RECORD-TEST-RECORD3
|
||
(IL:CREATE RECORD-TEST-NAME
|
||
ILuote (a b c d)) il:xpointer nil (rec 20 il:xpointer) rec-k)
|
||
|
||
MODERN
|
||
MODERN
|
||
? 1(DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8))
|
||
T @ * 3 p BMOBJ.GETFN3 5 = 6 5 5 ! * p BMOBJ.GETFN3 ? 1(DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8))
|
||
n < W ^ µ = Xzº |