37 lines
1.4 KiB
Plaintext
37 lines
1.4 KiB
Plaintext
;; WARNING!! This test file will report spurious errors if run twice
|
|
;; in the same sysout!! You have been warned...
|
|
|
|
(DO-TEST "USER DEFINED RECORD TYPES -SET UP"
|
|
(SETQ IL::CLISPRECORDTYPES (CONS 'IL:TESTRECORD
|
|
IL::CLISPRECORDTYPES))
|
|
(IL:MOVD 'IL:RECORD 'IL:TESTRECORD)
|
|
(IL:DEFINEQ (TESTRECORDMANIP(DECL)
|
|
`(IL:RECORD ,@(CDR DECL))))
|
|
(IL:PUTPROP 'IL:TESTRECORD 'IL:USERRECORDTYPE
|
|
'TESTRECORDMANIP))
|
|
|
|
(DO-TEST "USER DEFINED RECORD TYPES - CREATION"
|
|
(IL:TESTRECORD FOO (A B C))
|
|
(SETQ FOO1 (IL:CREATE FOO B IL:_ 2))
|
|
(IL:REPLACE (FOO A) IL:OF FOO1 IL:WITH 1)
|
|
(AND (EQ (IL:FETCH (FOO B) IL:OF FOO1) 2)
|
|
(EQ (IL:FETCH (FOO A) IL:OF FOO1) 1)))
|
|
|
|
(DO-TEST "USER DEFINED RECORDS - CLEANUP"
|
|
(SETQ IL::CLISPRECORDTYPES (CDR IL::CLISPRECORDTYPES)))
|
|
|
|
(DO-TEST "SUBRECORDS"
|
|
(IL:RECORD FOO ( X Y Z))
|
|
(IL:RECORD BAR (L M FOO) (IL:SUBRECORD FOO))
|
|
(SETQ BAR1 (IL:CREATE BAR X IL:_ 5))
|
|
(IL:REPLACE (BAR M) IL:OF BAR1 IL:WITH 2)
|
|
(AND (EQ (IL:FETCH (BAR X) IL:OF BAR1) 5)
|
|
(EQ (IL:FETCH (BAR M) IL:OF BAR1) 2)))
|
|
|
|
(DO-TEST "RECURSIVE RECORDS"
|
|
(IL:RECORD FOOBAR (FOO BAR)(IL:RECORD FOO (A B C))
|
|
(IL:RECORD BAR (D E F)))
|
|
(SETQ FOOBAR1 (IL:CREATE FOOBAR A IL:_ 1))
|
|
(IL:REPLACE (FOOBAR D) IL:OF FOOBAR1 IL:WITH 5)
|
|
(AND (EQ (IL:FETCH (FOOBAR A) IL:OF FOOBAR1) 1)
|
|
(EQ (IL:FETCH (FOOBAR D) IL:OF FOOBAR1) 5))) |