1
0
mirror of synced 2026-01-15 16:26:26 +00:00

234 lines
9.2 KiB
Plaintext

;; Function To Be Tested: DWIM (Program Support Tools)
;;
;; Source: IRM VOLUME 2 , Section 20
;; Section 20. DWIM,Lyric Release Notes
;;
;; Section: Program Support
;;
;; Created By: John Park
;;
;; Creation Date: April 6, 1987
;;
;; Last Update: April 7, 1987
;;
;; Filed As: {ERIS}<lispcore>test>program-support>clisp.u
;;
;;
;; Syntax: SEE IRM Volume 2, Section 20
;;
;; Function Description: To correct misspellings, parentheses errors, and other
;; syntactical errors in interlisp programming, the DWIM facility (Do-What-I-Mean) is
;; implemented. DWIM is called automatically whenever an error occurs in the evaluation
;; of an Interlisp expression. DWIM then proceeds to try to correct the mistake using
;; the current context of computation plus information about what the user had
;; previously been doing, (what mistakes he had been making) as guides to the remedy
;; of the error. If DWIM is able to make the correction, the computation continues
;; as though DWIM had not intervened: a break occurs, or an unwind to the last ERRORSET
;; (page 14.21).
;;
;; Argument(s): SEE IRM Volume 2, Section 20
;;
;; Returns: SEE IRM Volume 2, Section 20
;;
;; Constraints/Limitations: Testing for DWIM requires the old interlisp executive, which
;; the user will be prompted to create during the couse of testing.
;; Instructions will be given in the prompt window for the user actions to be taken
;; during testing and appropriate messages will be displayed to explain each test
;; process. Test result is logged on {eris}<lispcore>test>program-support>clisp.report.
;;
;;
;;
(DO-TEST "DWIM-TEST-SETUP"
(PROGN
(IL:PAGEHEIGHT 0)
(SETQ TEST-START (GET-INTERNAL-RUN-TIME))
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>PROGRAM-SUPPORT>DWIM.REPORT")
(DEFUN T-FORMAT (TIME)
(FORMAT *OUTPUT* "~2%TOTAL TEST RUN TIME FOR DWIM: ~F MINUTES ~%"
TIME))
(DEFUN ITEM-FORMAT-S (COMMAND-LANGUAGE)
(FORMAT *OUTPUT* "~%COMMAND: DWIMIFIED OPERATOR: ~A~%LISP VERSION: ~A ~%STATUS: ~A DATE: ~A TESTER: ~A~%" COMMAND-LANGUAGE (LISP-IMPLEMENTATION-VERSION) 'SUCCESS (IL:DATE) IL:USERNAME))
(DEFUN ITEM-FORMAT-F (COMMAND-LANGUAGE)
(FORMAT *OUTPUT* "~%COMMAND: DWIMIFIED OPERATOR: ~A~%LISP VERSION: ~A ~%STATUS: ~A DATE: ~A TESTER: ~A~%" COMMAND-LANGUAGE (LISP-IMPLEMENTATION-VERSION) 'FAIL (IL:DATE) IL:USERNAME))
(DEFUN PASS-FAIL (COMMAND-LANGUAGE TEST-ITEM)
(IF (EQ TEST-ITEM T) (ITEM-FORMAT-S COMMAND-LANGUAGE)
(ITEM-FORMAT-F COMMAND-LANGUAGE)))
(DEFUN PAUSE NIL (PROGN
(IL:PLAYTUNE '((262 . 15000) (440 . 15000) (349 . 15000)))
(SLEEP 2)))
(SETQ DWIM-MESS1 "Shortly, you will be prompted to create
an old interlisp exec window.After specifying a region,
click the new exec and enter (DWIM-TEST)")
(SETQ DWIM-MESS2 "Please answer y when the test is finished... ")
(SETQ DWIM-MESS3 "DWIM test is now finished; please answer Y to continue")
; Defining DWIM-TEST for tesing clisp operators...
(IL:DEFINEQ (IL:FOO (X Y) (IL:PLUS X Y)))
(IL:DEFINEQ (IL:DWIM-TEST NIL
(IL:PROGN
(IL:PAGEHEIGHT 0)
(IL:SETQ IL:DWIM-MESS " DWIM TEST IS FINISHED
PLEASE CLICK THE XCL EXEC WINDOW AND ANSWER YES")
(IL:SETQ IL:OPS-LIST '(IL:+OPERATOR IL:-OPERATOR IL:*OPERATOR
IL:/OPERATOR IL:^OPERATOR IL:=OPERATOR IL:GT-OPERATOR
IL:LT-OPERATOR IL:GE-OPERATOR IL:LE-OPERATOR IL:NTH-OPERATOR-1
IL:NTH-OPERATOR-2 IL:RECORD-OPERATOR IL:NTH-TAIL-OPERATOR
IL:SETQ-OPERATOR IL:SETQ-OPERATOR-1 IL:SETQ-OPERATOR-2
IL:LIST-OPERATOR IL:LIST-OPERATOR-1 IL:LIST-OPERATOR-2
IL:LIST-OPERATOR-3 IL:QUOTE-OPERATOR-1 IL:QUOTE-OPERATOR-2
IL:NOT-OPERATOR IL:PRECEDENCE-1 IL:PRECEDENCE-2
IL:PRECEDENCE-3 IL:PRECEDENCE-4 IL:PRECEDENCE-5
IL:PRECEDENCE-6 IL:PRECEDENCE-7))
(IL:SETQ IL:DWIM-TEST-STRING
"(DRIBBLE '{CORE}SPELL)
(SETQ FOO (PLUSS 1 2))
(DRIBBLE)
(DRIBBLE '{CORE}PAREN)
9IPLUS 1 2]
(DRIBBLE)
(DRIBBLE '{CORE}ATOM)
(SETQ BAR 'YES)
BARR
(DRIBBLE)
(DRIBBLE '{CORE}FNS)
(FOOS 1 2)
(DRIBBLE)
(SETQ OPEN-SPELL (OPEN '{CORE}SPELL 'INPUT))
(SETQ SPELL-LST (FOR X TO 10 COLLECT (READ OPEN-SPELL)))
(CLOSEF OPEN-SPELL)
(IF (AND (MEMBER '=IPLUS SPELL-LST) (MEMBER 3 SPELL-LST))
THEN (SETQ DWIM-SPELL T) ELSE (SETQ DWIM-SPELL NIL))
(SETQ OPEN-PAREN (OPEN '{CORE}PAREN 'INPUT))
(SETQ PAREN-LST (FOR X TO 12 COLLECT (READ OPEN-PAREN)))
(CLOSEF OPEN-PAREN)
(IF (AND (MEMBER '=IPLUS PAREN-LST) (MEMBER 3 PAREN-LST))
THEN (SETQ DWIM-PAREN T) ELSE (SETQ DWIM-PAREN NIL))
(SETQ OPEN-ATOM (OPEN '{CORE}ATOM 'INPUT))
(SETQ ATOM-LST (FOR X TO 12 COLLECT (READ OPEN-ATOM)))
(CLOSEF OPEN-ATOM)
(IF (AND (MEMBER '=BAR ATOM-LST) (MEMBER 'YES ATOM-LST))
THEN (SETQ DWIM-ATOM T) ELSE (SETQ DWIM-ATOM NIL))
(SETQ OPEN-FNS (OPEN '{CORE}FNS 'INPUT))
(SETQ FNS-LST (FOR X TO 10 COLLECT (READ OPEN-FNS)))
(CLOSEF OPEN-FNS)
(IF (AND (MEMBER '=FOO FNS-LST) (MEMBER 3 FNS-LST))
THEN (SETQ DWIM-FNS T) ELSE (SETQ DWIM-FNS NIL))
(PROMPTPRINT DWIM-MESS3)
(PLAYTUNE '((262 . 15000) (440 . 15000) (349 . 15000)))
")
(IL:BKSYSBUF IL:DWIM-TEST-STRING)
)
))
; Test Result Analysis
; The following will compare the actural results of DWIM forms with
; the expected results...
(PAUSE)
(SETQ DWIM-STRING
"; Creating an old interlisp executive
(IL:PROMPTPRINT DWIM-MESS1)
(PAUSE)
(ADD-EXEC :PROFILE 'OLD-INTERLISP-T :EXEC (QUOTE IL:EVALQT))
(IL:ASKUSER 10 'Y DWIM-MESS2)
(SETQ OPERATOR-LIST '(+OPERATOR -OPERATOR *OPERATOR /OPERATOR ^OPERATOR =OPERATOR
GT-OPERATOR LT-OPERATOR GE-OPERATOR LE-OPERATOR
NTH-OPERATOR-1 NTH-OPERATOR-2 RECORD-OPERATOR NTH-TAIL-OPERATOR
SETQ-OPERATOR SETQ-OPERATOR-1 SETQ-OPERATOR-2 LIST-OPERATOR
LIST-OPERATOR-1 LIST-OPERATOR-2 LIST-OPERATOR-3
QUOTE-OPERATOR-1 QUOTE-OPERATOR-2 NOT-OPERATOR PRECEDENCE-1
PRECEDENCE-2 PRECEDENCE-3 PRECEDENCE-4 PRECEDENCE-5
PRECEDENCE-6 PRECEDENCE-7))
; Test Result Analysis
; The following will compare the actural results of DWIM forms with
(CL:IN-PACKAGE 'INTERLISP)
(SETQ EXPECTED-DWIM-FORMS
'((PLUS A B) (DIFFERENCE A B) (TIMES A B)
(QUOTIENT A B) (EXPT A B) (EQ A A) (GREATERP A B) (LESSP A B)
(AND (GEQ A B) (GEQ A C)) (AND (LEQ B A) (LEQ B D)) (CADR FOO)
(CAR (LAST (CAR (LAST FOO)))) (|fetch| (B B1) |of| RECORD-1) (CDDDR FOO)
(SETQ SETQ-OP 7) (RPLACA (CDR FOO-SETQ) 90) (RPLACD FOO-SETQ 0)
(LIST A B (LIST C D)) (CONS A (CONS B C)) (APPEND A B (LIST C))
(NCONC1 A B) (EQ X (QUOTE Y)) (EQ Z (QUOTE DON'T))
(AND (EQ (NOT NIL) T) (NOT (GEQ A B)))
(PLUS 1 (TIMES 3 2)) (DIFFERENCE 10 (EXPT 4 2)) (NEQ (PLUS 1 3) 5)
(TIMES 2 (EXPT 3 3)) (EQ (TIMES 2 2) 4)
(GREATERP (DIFFERENCE 4 1) (PLUS 1 (TIMES 2 3))) (AND (NOT NIL) T)))
(SETQ ACTUAL-CLISP '((A + B) (A - B) (A * B) (A / B) (A ^ B) (A = A) (A GT B)
(A LT B) (AND (A GE B) (A GE C)) (AND (B LE A) (B LE D))
(|FOO:2|) (|FOO:-1:-1|) (|RECORD-1-1:B.B1|) (|FOO::3|)
(SETQ-OP_7) (|FOO-SETQ:2_90|)(|FOO-SETQ::1_0|)
(<A B <C D>>) (<A B ! C>) (<! A ! B C>)
(<! ! A B>) (X = (QUOTE Y)) (Z = (QUOTE DON'T))
(AND ~NIL = T ~ (A GE B))
(1 + 3 * 2) (10 - 4 ^ 2) (1 + 3 ~= 5)(2 * 3 ^ 3) (2 * 2 = 4)
(4 - 1 GT 1 + 2 * 3) (~NIL AND T)))
(SETQ ACTUAL-DWIMIFIED-CLISP (MAPCAR ACTUAL-CLISP 'DWIMIFY))
(CL:IN-PACKAGE 'XCL-TEST)
(SETQ PAIRED-DWIM (PAIRLIS IL:EXPECTED-DWIM-FORMS IL:ACTUAL-DWIMIFIED-CLISP))
; Test to see if the following DWIM functions defineds and variables bound...
(SETQ DWIM-FNS-BOUND NIL)
(SETQ DWIM-FLIST '(IL:ADDSPELL IL:MISSPELLED? IL:FIXSPELL IL:FNCHECK))
(DOLIST (Y DWIM-FLIST) (IF (FBOUNDP Y) (PUSH T DWIM-FNS-BOUND )
(PROGN (PUSH NIL DWIM-FNS-BOUND)
(IL:PROMPTPRINT Y '|: FUNCTION NOT BOUND|))))
(SETQ DWIM-VAR-BOUND NIL)
(SETQ DWIM-VLIST '(IL:DWIMWAIT IL:FIXSPELLDEFAULT IL:ADDSPELLFLG
IL:NOSPELLFLG IL:RUNONFLG IL:DWIMLOADFNSFLG
IL:LPARKEY IL:RPARKEY IL:OKREEVALST IL:DWIMFLG
IL:APPROVEFLG IL:LAMBDASPLST IL:SPELLINGS1
IL:SPELLINGS2 IL:SPELLINGS3 IL:USERWORDS
IL:\#SPELLINGS1 IL:\#SPELLINGS2 IL:\#SPELLINGS3 IL:\#USERWORDS))
(DOLIST (Y DWIM-VLIST) (IF (BOUNDP Y) (PUSH T DWIM-VAR-BOUND )
(PROGN (PUSH NIL DWIM-VAR-BOUND)
(IL:PROMPTPRINT Y '|: VARIABLE NOT BOUND|))))
(IL:CLRPROMPT)
(SETQ TEST-END (GET-INTERNAL-RUN-TIME))
(SETQ TOTAL-TEST-TIME (FLOAT (/ (ABS(- TEST-END TEST-START)) 60000)))
; Wrinting the test results to
; {eris}<lispcore>test>program-support>clisp.u....
(DO-TEST 'DWIM-TEST-RESULT
(PROGN (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
:IF-EXISTS :APPEND))
(DOLIST (Y PAIRED-DWIM)
(IF (EQUAL (CAR Y) (CDR Y))
(PROGN (SETQ OPERATOR (POP IL:OPS-LIST))
(PASS-FAIL OPERATOR T))
(PROGN (SETQ OPERATOR (POP IL:OPS-LIST))
(PASS-FAIL OPERATOR NIL))))
(PASS-FAIL 'DWIM-SPELLING IL:DWIM-SPELL)
(PASS-FAIL 'DWIM-PARENTHESES IL:DWIM-PAREN)
(PASS-FAIL 'DWIM-UNBOUND-ATOM IL:DWIM-ATOM)
(PASS-FAIL 'DWIM-UNDEFINED-FN IL:DWIM-FNS)
(PASS-FAIL 'DWIM-FUNCTIONS (NOTANY #'NULL DWIM-FNS-BOUND))
(PASS-FAIL 'DWIM-VARIABLES (NOTANY #'NULL DWIM-VAR-BOUND))
(T-FORMAT TOTAL-TEST-TIME)
(CLOSE *OUTPUT*)
(IDENTITY T)
)
)
")
(IL:BKSYSBUF DWIM-STRING)
)
)
STOP