1
0
mirror of synced 2026-03-15 06:44:17 +00:00

Compare commits

...

15 Commits

Author SHA1 Message Date
Larry Masinter
9ab24c044d Merge branch 'Miscellaneous-format-stuff' 2021-08-06 13:38:26 -07:00
rmkaplan
565f5994f2 Merge pull request #394 from Interlisp/sysedit-load-exports.all
Update SYSEDIT to load exports.all when running run-medley -new
2021-08-06 12:53:49 -07:00
Larry Masinter
93d9b7f176 Fix bitrot in manual TEdit file as per #268 (#391) 2021-08-06 12:16:17 -07:00
Larry Masinter
8a5057fbdc Remove explicit old versions from cloned repo (#392)
it took a long time to figure out how to restore old versions, using the './scripts/restore-versions file'. Now that it's there and tested  it should be ok to remove them from new 'git clone' of medley
2021-08-06 12:14:55 -07:00
Larry Masinter
b07d528f22 duplicate definition of UNINTERRUPTABLY pp macro (#395) 2021-08-06 12:09:49 -07:00
rmkaplan
3de2ebb719 FILEIO UNICODE: Fix THROUGHIN, cleanup UTF8-16 back 2021-08-06 10:36:05 -07:00
Larry Masinter
a2fdebbfa0 Update SYSEDIT to load exports.all when running run-medley -new 2021-08-06 07:41:06 -07:00
rmkaplan
b1d209484a FILEIO, MACHINEINDEPENDENT
\EXTERNALFORMAT extracts the format from a reader-environment
WRITEFILE uses the format in *OLD-IINTERLISP-READ-ENVIRONMENT* (now :XCCS)
2021-08-05 21:08:05 -07:00
rmkaplan
c2cff44a64 MACHIINEINDEPENDENT
MAKEFILE NEW with Interlisp read table, as per Larry's request
2021-08-05 15:17:41 -07:00
rmkaplan
c94e044bf3 FILEIO: Fix bad IF statement in \EXTERNALFORMAT 2021-08-05 14:44:01 -07:00
rmkaplan
d64e9282bf DEFINE-FILE-INFO with its own reader environment (#381)
* DEFINE-FILE-INFO with its own reader environment

Including format.  That reader environment also allows colon as a package delimiter, in addition to the funky control and upper panel character.

"Function" is now a synonym for character set 2.  WITH-READER-ENVIRONMENT doesn't bind EXTERNALFORMAT.

* Changed *DEFAULT-MAKEFILE-ENVIRONMENT* to use Interlisp rdtbl

* Store FDEV's default externalformat in the FDEV

And related adjustments so that the display output stream (which is created in various places) is always created with the right (CR) EOL convention.  Also a little simpler interface for creating external formats.
2021-08-05 13:43:08 -07:00
Larry Masinter
3fc26567c0 git on WSL doesn't remember +x bit (#387) 2021-08-05 09:53:34 -07:00
rmkaplan
4ea68c6746 Store FDEV's default externalformat in the FDEV
And related adjustments so that the display output stream (which is created in various places) is always created with the right (CR) EOL convention.  Also a little simpler interface for creating external formats.
2021-08-02 19:56:19 -07:00
rmkaplan
ff134ecd23 Changed *DEFAULT-MAKEFILE-ENVIRONMENT* to use Interlisp rdtbl 2021-08-01 21:03:24 -07:00
rmkaplan
925adc1deb DEFINE-FILE-INFO with its own reader environment
Including format.  That reader environment also allows colon as a package delimiter, in addition to the funky control and upper panel character.

"Function" is now a synonym for character set 2.  WITH-READER-ENVIRONMENT doesn't bind EXTERNALFORMAT.
2021-07-30 19:37:48 -07:00
523 changed files with 32898 additions and 117042 deletions

View File

@@ -1,248 +0,0 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL")
(IL:FILECREATED "24-Mar-92 14:56:18" IL:|{DSK}<usr>local>lde>lispcore>sources>CMLDEFFER.;3| 40644
IL:|changes| IL:|to:| (IL:VARS IL:CMLDEFFERCOMS)
IL:|previous| IL:|date:| " 4-Jan-92 15:32:26"
IL:|{DSK}<usr>local>lde>lispcore>sources>CMLDEFFER.;2|)
; Copyright (c) 1986, 1900, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All rights reserved.
(IL:PRETTYCOMPRINT IL:CMLDEFFERCOMS)
(IL:RPAQQ IL:CMLDEFFERCOMS ((IL:* IL:|;;;| "DEF-DEFINE-TYPE and DEFDEFINER -- Your One-Stop Providers of Customized File Manager Facilities.") (IL:* IL:|;;| "BE VERY CAREFUL CHANGING ANYTHING IN THIS FILE!!! It is heavily self-referential and thick with bootstrapping problems. All but the most trivial changes (and some of those) are very tricky to make without blowing yourself out of the water... You have been warned.") (IL:* IL:|;;;| "Also see the file deffer-runtime for stuff that must be defined before fasl files may be loaded into the init") (IL:COMS (IL:* IL:\; "Filepkg interface") (IL:FUNCTIONS REMOVE-COMMENTS PPRINT-DEFINER PPRINT-DEFINER-FITP PPRINT-DEFINER-RECURSE) (IL:VARIABLES IL:*REMOVE-INTERLISP-COMMENTS*) (IL:* IL:\; "Share with xcl?") (IL:FUNCTIONS %DEFINE-TYPE-DELDEF %DEFINE-TYPE-GETDEF %DEFINE-TYPE-FILE-DEFINITIONS %DEFINE-TYPE-FILEGETDEF %DEFINE-TYPE-SAVE-DEFN %DEFINE-TYPE-PUTDEF)) (IL:COMS (IL:* IL:\; "Compatibility with old cmldeffer") (IL:DECLARE\: IL:DOCOPY IL:DONTEVAL@LOAD (IL:P (IL:MOVD (QUOTE %DEFINE-TYPE-DELDEF) (QUOTE IL:\\DEFINE-TYPE-DELDEF)) (IL:MOVD (QUOTE %DEFINE-TYPE-GETDEF) (QUOTE IL:\\DEFINE-TYPE-GETDEF)) (IL:MOVD (QUOTE %DEFINE-TYPE-FILE-DEFINITIONS) (QUOTE IL:\\DEFINE-TYPE-FILE-DEFINITIONS)) (IL:MOVD (QUOTE %DEFINE-TYPE-FILEGETDEF) (QUOTE IL:\\DEFINE-TYPE-FILEGETDEF)) (IL:MOVD (QUOTE %DEFINE-TYPE-SAVE-DEFN) (QUOTE IL:\\DEFINE-TYPE-SAVE-DEFN)) (IL:MOVD (QUOTE %DEFINE-TYPE-PUTDEF) (QUOTE IL:\\DEFINE-TYPE-PUTDEF)) (IL:MOVD (QUOTE PPRINT-DEFINER) (QUOTE IL:PPRINT-DEFINER))))) (IL:DECLARE\: IL:DOCOPY IL:DONTEVAL@LOAD (IL:P (IL:* IL:|;;| "Set up fake definer prototype stuff for FNS") (ADD-PROTOTYPE-FN (QUOTE IL:FNS) (QUOTE IL:NLAMBDA) (FUNCTION (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (IL:DEFINEQ ((IL:\\\, NAME) (IL:NLAMBDA (IL:\\\,@ (%MAKE-FUNCTION-PROTOTYPE)))))))))) (ADD-PROTOTYPE-FN (QUOTE IL:FNS) (QUOTE IL:LAMBDA) (FUNCTION (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (IL:DEFINEQ ((IL:\\\, NAME) (IL:LAMBDA (IL:\\\,@ (%MAKE-FUNCTION-PROTOTYPE)))))))))))) (IL:COMS (IL:* IL:\; "The groundwork for bootstrapping ") (IL:DEFINE-TYPES IL:DEFINE-TYPES IL:FUNCTIONS IL:VARIABLES) (IL:* IL:\; "DefDefiner itself and friends") (IL:FUNCTIONS SI::EXPANSION-FUNCTION SI::MACRO-FUNCALL WITHOUT-FILEPKG)) (IL:COMS (IL:* IL:\; "Compatibility with old cmldeffer") (IL:FUNCTIONS IL:WITHOUT-FILEPKG)) (IL:COMS (IL:* IL:\; "Some special forms") (IL:FUNCTIONS DEFINER DEFINER-VARIABLE-TYPE NAMED-PROGN)) (IL:COMS (IL:* IL:\; "Auxiliary functions") (IL:FUNCTIONS GET-DEFINER-NAME %DELETE-DEFINER) (IL:FUNCTIONS DEF-DEFINE-TYPE DEFDEFINER DEFDEFINER-VARIABLE-TYPE) (IL:FUNCTIONS %EXPAND-DEFINER %DEFINER-NAME)) (IL:COMS (IL:* IL:\; "The most commonly-used definers") (IL:FUNCTIONS DEFUN DEFINLINE DEFMACRO) (IL:FUNCTIONS DEFVAR DEFPARAMETER DEFCONSTANT DEFGLOBALVAR DEFGLOBALPARAMETER)) (IL:COMS (IL:* IL:\; "Here so that the evaluator can be in the init without definers being in the init.") (IL:DEFINE-TYPES IL:SPECIAL-FORMS) (IL:FUNCTIONS %REMOVE-SPECIAL-FORM) (IL:FUNCTIONS DEFINE-SPECIAL-FORM) (IL:* IL:\; "Form for defining interpreters of special forms")) (IL:COMS (IL:* IL:\; "Don't note changes to these properties/variables") (IL:PROP IL:PROPTYPE IL:MACRO-FN :UNDEFINERS IL:UNDEFINERS :DEFINER-FOR IL:DEFINER-FOR :DEFINED-BY IL:DEFINED-BY :DEFINITION-NAME IL:DEFINITION-NAME) (IL:* IL:\; "Templates for definers not defined here. These should really be where they're defined.") (IL:PROP :DEFINITION-PRINT-TEMPLATE DEFCOMMAND DEFINE-CONDITION DEFINE-MODIFY-MACRO DEFINE-SETF-METHOD DEFSETF DEFSTRUCT DEFTYPE)) (IL:* IL:|;;| "Arrange for the correct compiler to be used.") (IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT) IL:CMLDEFFER)))
(IL:* IL:|;;;|
"DEF-DEFINE-TYPE and DEFDEFINER -- Your One-Stop Providers of Customized File Manager Facilities.")
(IL:* IL:|;;|
"BE VERY CAREFUL CHANGING ANYTHING IN THIS FILE!!! It is heavily self-referential and thick with bootstrapping problems. All but the most trivial changes (and some of those) are very tricky to make without blowing yourself out of the water... You have been warned."
)
(IL:* IL:|;;;|
"Also see the file deffer-runtime for stuff that must be defined before fasl files may be loaded into the init"
)
(IL:* IL:\; "Filepkg interface")
(DEFUN REMOVE-COMMENTS (X) (IL:* IL:|;;;| "Removes SEdit-style comments from the given list structure.") (COND ((NOT (CONSP X)) X) ((AND (CONSP (CAR X)) (EQ (CAAR X) (QUOTE IL:*)) (CONSP (CDAR X)) (OR (MEMBER (CADAR X) (QUOTE (IL:\; IL:|;;| IL:|;;;| IL:|;;;;| IL:\|)) :TEST (FUNCTION EQ)) (IL:* IL:\; "a sedit comment") (EQ IL:*REMOVE-INTERLISP-COMMENTS* T) (IL:* IL:\; "always strip") (PROGN (IF (EQ IL:*REMOVE-INTERLISP-COMMENTS* (QUOTE :WARN)) (WARN "Possible comment not stripped ~S" (CAR X))) NIL))) (REMOVE-COMMENTS (CDR X))) (T (LET ((A (REMOVE-COMMENTS (CAR X))) (D (REMOVE-COMMENTS (CDR X)))) (IF (AND (EQ A (CAR X)) (EQ D (CDR X))) X (CONS A D))))))
(DEFUN PPRINT-DEFINER (DEFINE-EXPRESSION) (DECLARE (SPECIAL IL:FORMFLG IL:SPACEWIDTH)) (IL:* IL:\; "Bound in prettyprinter") (COND ((OR (NULL IL:FORMFLG) (ATOM (CDR DEFINE-EXPRESSION))) (IL:* IL:\; "Degenerate cases or printing as a quoted form--punt to default prettyprinting") DEFINE-EXPRESSION) (T (LET ((IL:TAIL DEFINE-EXPRESSION) (IL:LEFT (IL:DSPXPOSITION)) TEMPLATE TOP-LEVEL-P NEXT TYPE FORM NEWLINEP) (DECLARE (SPECIAL IL:TAIL IL:LEFT)) (IL:* IL:\; "For comment printer") (SETQ TOP-LEVEL-P (EQ IL:LEFT (IL:DSPLEFTMARGIN))) (IL:* IL:\; "Printing definition to file, etc.") (SETQ IL:LEFT (+ IL:LEFT (* 3 IL:SPACEWIDTH))) (IL:* IL:\; "Place we will indent body") (IL:PRIN1 "(") (IL:PRIN2 (CAR IL:TAIL)) (SETQ TEMPLATE (OR (GET (POP IL:TAIL) :DEFINITION-PRINT-TEMPLATE) (QUOTE (:NAME)))) (IL:* IL:|;;| "This code should, and doesn't, pay attention to the NAME function to determine where the name is to decide what should and shouldn't be bold. Right now, it always bolds the second thing. Fortunately, we currently don't have any definers that don't have either the second or CAR of the second as the definition name.") (IL:* IL:|;;| "Also, this code should be careful about calling the NAME function on the form. Sometimes, the form is not really a call to the definer but instead a back-quoted expression in a macro. In most such cases, the name is not really there; some comma-quoted expression is there instead.") (IL:WHILE (CONSP IL:TAIL) IL:DO (COND ((AND (LISTP (SETQ NEXT (CAR IL:TAIL))) (EQ (CAR NEXT) IL:COMMENTFLG) (IL:SEMI-COLON-COMMENT-P NEXT)) (IL:* IL:\; "Comments can appear anywhere, so print this one without consuming the template. ENDLINE has side effect of printing comments") (IL:SUBPRINT/ENDLINE IL:LEFT *STANDARD-OUTPUT*) (SETQ NEWLINEP T)) ((OR (ATOM TEMPLATE) (EQ (SETQ TYPE (POP TEMPLATE)) :BODY)) (IL:* IL:\; "Once we hit the body, there's nothing more special to do.") (RETURN)) (T (IL:SPACES 1) (CASE TYPE (:NAME (IL:* IL:\; "Embolden the name of this thing") (SETQ NEWLINEP NIL) (COND ((NOT TOP-LEVEL-P) (IL:* IL:\; "Nothing special here--could even be a backquoted thing") (PPRINT-DEFINER-RECURSE)) (T (POP IL:TAIL) (COND ((CONSP NEXT) (IL:* IL:\; "Name is a list. Assume the real name is the car and the rest is an options list or something") (UNLESS (EQ (IL:DSPYPOSITION) (PROGN (IL:PRIN1 "(") (IL:PRINTOUT NIL IL:.FONT IL:LAMBDAFONT IL:.P2 (CAR NEXT) IL:.FONT IL:DEFAULTFONT) (IL:SPACES 1) (IL:PRINTDEF (CDR NEXT) T T T IL:FNSLST) (IL:PRIN1 ")") (IL:DSPYPOSITION))) (IL:* IL:\; "This thing took more than one line to print, so go to new line") (IL:SUBPRINT/ENDLINE IL:LEFT *STANDARD-OUTPUT*) (SETQ NEWLINEP T))) (T (IL:* IL:\; "Atomic name is bold") (IL:PRINTOUT NIL IL:.FONT IL:LAMBDAFONT IL:.P2 NEXT IL:.FONT IL:DEFAULTFONT)))))) (:ARG-LIST (IL:* IL:\; "NEXT is some sort of argument list. ") (COND ((NULL NEXT) (IL:* IL:\; "If NIL, be sure to print as ()") (IL:PRIN1 "()") (POP IL:TAIL)) (T (PPRINT-DEFINER-RECURSE))) (SETQ NEWLINEP NIL)) (T (IL:* IL:\; "Just print it, perhaps starting a new line") (UNLESS (OR NEWLINEP (PPRINT-DEFINER-FITP NEXT)) (IL:* IL:\; "Go to new line if getting crowded") (IL:PRINENDLINE IL:LEFT)) (PPRINT-DEFINER-RECURSE) (SETQ NEWLINEP NIL)))))) (IL:* IL:|;;| "We've now gotten to the end of stuff we know how to print. Just prettyprint the rest") (UNLESS (NULL IL:TAIL) (COND (NEWLINEP (IL:* IL:\; "Already on new line")) ((OR (EQ TYPE :BODY) (NOT (PPRINT-DEFINER-FITP (CAR IL:TAIL)))) (IL:* IL:\; "Go to new line and indent a bit. Always do this for the part matching &BODY, whether or not the prettyprinter thought that the remainder would \"fit\"") (IL:PRINENDLINE IL:LEFT NIL T)) (T (IL:SPACES 1))) (IL:WHILE (AND (CONSP IL:TAIL) (ATOM (SETQ FORM (CAR IL:TAIL)))) IL:DO (IL:* IL:|;;| "Print this doc string or whatever on its own line. This is because otherwise the prettyprinter gets confused and tries to put the next thing after the string") (PPRINT-DEFINER-RECURSE) (WHEN (AND (KEYWORDP FORM) (CONSP IL:TAIL)) (IL:* IL:\; "Some sort of keyword-value pair stuff--print it on same line") (IL:SPACES 1) (PPRINT-DEFINER-RECURSE)) (WHEN (NULL IL:TAIL) (RETURN)) (IL:SUBPRINT/ENDLINE IL:LEFT *STANDARD-OUTPUT*)) (IL:PRINTDEF IL:TAIL T T T IL:FNSLST)) (IL:PRIN1 ")") NIL))))
(DEFUN PPRINT-DEFINER-FITP (ITEM) (IL:* IL:|;;| "True if it won't look silly to try to print ITEM at current position instead of starting new line") (IF (CONSP ITEM) (OR (EQ (CAR ITEM) IL:COMMENTFLG) (AND (< (IL:COUNT ITEM) 20) (IL:FITP ITEM))) (< (+ (IL:DSPXPOSITION) (IL:STRINGWIDTH ITEM *STANDARD-OUTPUT*)) (IL:DSPRIGHTMARGIN))))
(DEFUN PPRINT-DEFINER-RECURSE NIL (IL:* IL:|;;| "Print and pop the next element. Prettyprinter uses the variable IL:TAIL for lookahead") (DECLARE (SPECIAL IL:TAIL)) (IL:SUPERPRINT (CAR IL:TAIL) IL:TAIL NIL *STANDARD-OUTPUT*) (SETQ IL:TAIL (CDR IL:TAIL)))
(DEFVAR IL:*REMOVE-INTERLISP-COMMENTS* (QUOTE :WARN) "Either NIL (don't) T (always do) or :WARN (don't and warn)")
(IL:* IL:\; "Share with xcl?")
(DEFUN %DEFINE-TYPE-DELDEF (NAME TYPE) (IL:* IL:|;;| "DELETE definition of definer-defined NAME as TYPE ") (UNDOABLY-SETF (DOCUMENTATION NAME TYPE) NIL) (LET* ((HT (GETHASH TYPE *DEFINITION-HASH-TABLE*)) (DEFN (AND HT (GETHASH NAME HT)))) (AND HT (IL:/PUTHASH NAME NIL HT)) (DOLIST (FN (OR (GET TYPE (QUOTE :UNDEFINERS)) (GET TYPE (QUOTE IL:UNDEFINERS)))) (FUNCALL FN NAME)) (DOLIST (FN (OR (GET (CAR DEFN) (QUOTE :UNDEFINERS)) (GET (CAR DEFN) (QUOTE IL:UNDEFINERS)))) (FUNCALL FN NAME)) NAME))
(DEFUN %DEFINE-TYPE-GETDEF (NAME TYPE OPTIONS) (IL:* IL:|;;| "GETDEF method for all definers. The EDIT is so that when you say EDITDEF you get a copy & can know when you made edits.") (LET* ((HASH-TABLE (GETHASH TYPE *DEFINITION-HASH-TABLE*)) (DEFN (AND HASH-TABLE (GETHASH NAME HASH-TABLE)))) (IF (TYPECASE OPTIONS (CONS (MEMBER (QUOTE IL:EDIT) OPTIONS :TEST (FUNCTION EQ))) (T (EQ OPTIONS (QUOTE IL:EDIT)))) (COPY-TREE DEFN) DEFN)))
(DEFUN %DEFINE-TYPE-FILE-DEFINITIONS (TYPE NAMES) (IL:* IL:|;;| "get the definitions for NAMES suitable for printing on a file. Like GETDEF but checks.") (MAPCAR (FUNCTION (LAMBDA (NAME) (LET ((DEF (%DEFINE-TYPE-GETDEF NAME TYPE (QUOTE (IL:NOCOPY))))) (IF (NULL DEF) (ERROR (QUOTE IL:NO-SUCH-DEFINITION) :NAME NAME :TYPE TYPE) DEF)))) NAMES))
(DEFUN %DEFINE-TYPE-FILEGETDEF (NAME TYPE SOURCE OPTIONS NOTFOUND) (LET ((VAL (IL:LOADFNS NIL SOURCE (QUOTE IL:GETDEF) (IL:* IL:|;;| "The bletcherous lambda form is require by the interface to loadfns (can't pass a closure)") (IL:BQUOTE (IL:LAMBDA (FIRST SECOND) (AND (MEMBER FIRST (QUOTE (IL:\\\, (OR (GET TYPE (QUOTE :DEFINED-BY)) (GET TYPE (QUOTE IL:DEFINED-BY))))) :TEST (FUNCTION EQ)) (LET ((NAMER (OR (GET FIRST (QUOTE :DEFINITION-NAME)) (GET FIRST (QUOTE IL:DEFINITION-NAME)) (QUOTE SECOND)))) (IF (EQ NAMER (QUOTE SECOND)) (EQUAL SECOND (QUOTE (IL:\\\, NAME))) (EQUAL (FUNCALL NAMER (REMOVE-COMMENTS (IL:READ))) (QUOTE (IL:\\\, NAME))))))))))) (COND ((EQ (CAAR VAL) (QUOTE IL:NOT-FOUND\:)) NOTFOUND) ((CDR VAL) (CONS (QUOTE PROGN) VAL)) (T (CAR VAL)))))
(DEFUN %DEFINE-TYPE-SAVE-DEFN (NAME TYPE DEFINITION) (SETQ TYPE (IL:GETFILEPKGTYPE TYPE (QUOTE TYPE))) (LET ((HASH-TABLE (GETHASH TYPE *DEFINITION-HASH-TABLE*))) (WHEN (NULL HASH-TABLE) (WARN "Couldn't find a hash-table for ~S definitions.~%One will be created." TYPE) (SETQ HASH-TABLE (SETF (GETHASH TYPE *DEFINITION-HASH-TABLE*) (MAKE-HASH-TABLE :TEST (FUNCTION EQUAL) :SIZE 50 :REHASH-SIZE 50)))) (LET ((OLD-DEFINITION (GETHASH NAME HASH-TABLE))) (UNLESS (EQUAL DEFINITION OLD-DEFINITION) (WHEN (AND OLD-DEFINITION (NOT (EQ IL:DFNFLG T))) (FORMAT *TERMINAL-IO* "~&New ~A definition for ~S~:[~; (but not installed)~].~%" TYPE NAME (MEMBER IL:DFNFLG (QUOTE (IL:PROP IL:ALLPROP)) :TEST (FUNCTION EQ)))) (IL:/PUTHASH NAME DEFINITION HASH-TABLE) (IL:MARKASCHANGED NAME TYPE (IF OLD-DEFINITION (QUOTE IL:CHANGED) (QUOTE IL:DEFINED)))))))
(DEFUN %DEFINE-TYPE-PUTDEF (NAME TYPE DEFINITION REASON) (IF (NULL DEFINITION) (%DEFINE-TYPE-DELDEF NAME TYPE) (LET ((DEFN-WITHOUT-COMMENTS (REMOVE-COMMENTS DEFINITION))) (UNLESS (AND (CONSP DEFN-WITHOUT-COMMENTS) (MEMBER (CAR DEFN-WITHOUT-COMMENTS) (OR (GET TYPE (QUOTE :DEFINED-BY)) (GET TYPE (QUOTE IL:DEFINED-BY))) :TEST (FUNCTION EQ)) (EQUAL NAME (FUNCALL (OR (GET (CAR DEFN-WITHOUT-COMMENTS) (QUOTE :DEFINITION-NAME)) (GET (CAR DEFN-WITHOUT-COMMENTS) (QUOTE IL:DEFINITION-NAME)) (QUOTE SECOND)) DEFN-WITHOUT-COMMENTS))) (SIGNAL (QUOTE IL:DEFINER-MISMATCH) :NAME NAME :TYPE TYPE :DEFINITION DEFINITION)) (SETQ DEFINITION (COPY-TREE DEFINITION)) (EVAL (IF IL:LISPXHIST (MAKE-UNDOABLE DEFINITION) DEFINITION)))))
(IL:* IL:\; "Compatibility with old cmldeffer")
(IL:DECLARE\: IL:DOCOPY IL:DONTEVAL@LOAD
(IL:MOVD (QUOTE %DEFINE-TYPE-DELDEF) (QUOTE IL:\\DEFINE-TYPE-DELDEF))
(IL:MOVD (QUOTE %DEFINE-TYPE-GETDEF) (QUOTE IL:\\DEFINE-TYPE-GETDEF))
(IL:MOVD (QUOTE %DEFINE-TYPE-FILE-DEFINITIONS) (QUOTE IL:\\DEFINE-TYPE-FILE-DEFINITIONS))
(IL:MOVD (QUOTE %DEFINE-TYPE-FILEGETDEF) (QUOTE IL:\\DEFINE-TYPE-FILEGETDEF))
(IL:MOVD (QUOTE %DEFINE-TYPE-SAVE-DEFN) (QUOTE IL:\\DEFINE-TYPE-SAVE-DEFN))
(IL:MOVD (QUOTE %DEFINE-TYPE-PUTDEF) (QUOTE IL:\\DEFINE-TYPE-PUTDEF))
(IL:MOVD (QUOTE PPRINT-DEFINER) (QUOTE IL:PPRINT-DEFINER))
)
(IL:DECLARE\: IL:DOCOPY IL:DONTEVAL@LOAD
(IL:* IL:|;;| "Set up fake definer prototype stuff for FNS")
(ADD-PROTOTYPE-FN (QUOTE IL:FNS) (QUOTE IL:NLAMBDA) (FUNCTION (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (IL:DEFINEQ ((IL:\\\, NAME) (IL:NLAMBDA (IL:\\\,@ (%MAKE-FUNCTION-PROTOTYPE))))))))))
(ADD-PROTOTYPE-FN (QUOTE IL:FNS) (QUOTE IL:LAMBDA) (FUNCTION (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (IL:DEFINEQ ((IL:\\\, NAME) (IL:LAMBDA (IL:\\\,@ (%MAKE-FUNCTION-PROTOTYPE))))))))))
)
(IL:* IL:\; "The groundwork for bootstrapping ")
(DEF-DEFINE-TYPE IL:DEFINE-TYPES "Definition type")
(DEF-DEFINE-TYPE IL:FUNCTIONS "Common Lisp functions/macros" :UNDEFINER IL:UNDOABLY-FMAKUNBOUND)
(DEF-DEFINE-TYPE IL:VARIABLES "Common Lisp variables" :UNDEFINER UNDOABLY-MAKUNBOUND)
(IL:* IL:\; "DefDefiner itself and friends")
(DEFUN SI::EXPANSION-FUNCTION (NAME ARG-LIST BODY) (IL:* IL:|;;;| "Shared code between DEFMACRO and DEFDEFINER. Takes the parts of a DEFMACRO and returns two values: a LAMBDA form for the expansion function, and the documentation string found, if any.") (MULTIPLE-VALUE-BIND (PARSED-BODY PARSED-DECLARATIONS PARSED-DOCSTRING) (IL:PARSE-DEFMACRO ARG-LIST (QUOTE SI::$$MACRO-FORM) BODY NAME NIL :ENVIRONMENT (QUOTE SI::$$MACRO-ENVIRONMENT)) (VALUES (IL:BQUOTE (LAMBDA (SI::$$MACRO-FORM SI::$$MACRO-ENVIRONMENT) (IL:\\\,@ PARSED-DECLARATIONS) (BLOCK (IL:\\\, NAME) (IL:\\\, PARSED-BODY)))) PARSED-DOCSTRING)))
(DEFMACRO SI::MACRO-FUNCALL (EXPANSION-FUNCTION MACRO-CALL ENV) (IL:* IL:|;;;| "Used by DEFDEFINER as a mechanism for delaying macro-expansion until after checking the value of DFNFLG. The arguments (unevaluated) are a macro-expansion function and a call on that macro. The call to MACRO-FUNCALL should expand into the result of expanding the given macro-call.") (FUNCALL EXPANSION-FUNCTION MACRO-CALL ENV))
(DEFMACRO WITHOUT-FILEPKG (&BODY BODY) (IL:BQUOTE (PROGN (EVAL-WHEN (LOAD) (IL:\\\,@ BODY)) (EVAL-WHEN (EVAL) (UNLESS (OR (EQ IL:DFNFLG (QUOTE IL:PROP)) (EQ IL:DFNFLG (QUOTE IL:ALLPROP))) (LET ((IL:FILEPKGFLG NIL) (IL:DFNFLG T)) (IL:\\\,@ BODY)))))))
(IL:* IL:\; "Compatibility with old cmldeffer")
(DEFMACRO IL:WITHOUT-FILEPKG (&BODY BODY) (IL:BQUOTE (WITHOUT-FILEPKG (IL:\\\,@ BODY))))
(IL:* IL:\; "Some special forms")
(DEFMACRO DEFINER (TYPE NAME DEFINITION &OPTIONAL ENV) (LET* ((EXPANDER (GET NAME :DEFINITION-EXPANDER)) (DEFINITION-WITHOUT-COMMENTS (REMOVE-COMMENTS DEFINITION)) (DEFINITION-NAME (FUNCALL (GET NAME :DEFINITION-NAME) DEFINITION-WITHOUT-COMMENTS))) (IL:BQUOTE (PROGN (WITHOUT-FILEPKG (SI::MACRO-FUNCALL (IL:\\\, EXPANDER) (IL:\\\, DEFINITION-WITHOUT-COMMENTS) (IL:\\\, ENV))) (EVAL-WHEN (EVAL) (UNLESS (NULL IL:FILEPKGFLG) (%DEFINE-TYPE-SAVE-DEFN (QUOTE (IL:\\\, DEFINITION-NAME)) (QUOTE (IL:\\\, TYPE)) (QUOTE (IL:\\\, DEFINITION))))) (QUOTE (IL:\\\, DEFINITION-NAME))))))
(DEFMACRO DEFINER-VARIABLE-TYPE (NAME DEFINITION &OPTIONAL ENV) (LET* ((DEFINITION-WITHOUT-COMMENTS (REMOVE-COMMENTS DEFINITION)) (TYPE (FUNCALL (GET NAME :TYPE-DISCRIMINATOR) DEFINITION-WITHOUT-COMMENTS)) (EXPANDER (GETF (GET NAME :DEFINITION-EXPANDER) TYPE)) (DEFINITION-NAME (FUNCALL (GET NAME :DEFINITION-NAME) DEFINITION-WITHOUT-COMMENTS))) (IL:BQUOTE (PROGN (WITHOUT-FILEPKG (SI::MACRO-FUNCALL (IL:\\\, EXPANDER) (IL:\\\, DEFINITION-WITHOUT-COMMENTS) (IL:\\\, ENV))) (EVAL-WHEN (EVAL) (UNLESS (NULL IL:FILEPKGFLG) (%DEFINE-TYPE-SAVE-DEFN (QUOTE (IL:\\\, DEFINITION-NAME)) (QUOTE (IL:\\\, TYPE)) (QUOTE (IL:\\\, DEFINITION))))) (QUOTE (IL:\\\, DEFINITION-NAME))))))
(DEFMACRO NAMED-PROGN (DEFINER NAME &REST FORMS) (IL:* IL:|;;| "Used by the compiler when processing definers") (IL:BQUOTE (PROGN (IL:\\\,@ FORMS) (QUOTE (IL:\\\, NAME)))))
(IL:* IL:\; "Auxiliary functions")
(DEFUN GET-DEFINER-NAME (DEFINER STRING) (VALUES (INTERN (CONCATENATE (QUOTE STRING) STRING (STRING DEFINER)) (SYMBOL-PACKAGE DEFINER))))
(DEFUN %DELETE-DEFINER (NAME) (AND (SYMBOLP NAME) (LET ((TYPE (OR (GET NAME (QUOTE :DEFINER-FOR)) (GET NAME (QUOTE IL:DEFINER-FOR))))) (IL:/REMPROP NAME (QUOTE :DEFINER-FOR)) (IL:/REMPROP NAME (QUOTE IL:DEFINER-FOR)) (IL:/REMPROP NAME (QUOTE :DEFINITION-NAME)) (IL:/REMPROP NAME (QUOTE IL:DEFINITION-NAME)) (IL:/REMPROP NAME (QUOTE :DEFINITION-EXPANDER)) (WHEN TYPE (IF (GET TYPE (QUOTE :DEFINED-BY)) (IL:/PUTPROP TYPE (QUOTE :DEFINED-BY) (REMOVE NAME (GET TYPE (QUOTE :DEFINED-BY)))) (IL:/PUTPROP TYPE (QUOTE IL:DEFINED-BY) (REMOVE NAME (GET TYPE (QUOTE IL:DEFINED-BY))))) (IL:* IL:|;;| "need to remove the prototype function!") (LET* ((LOOKUP-TYPE (ASSOC TYPE *DEFINITION-PROTOTYPES* :TEST (FUNCTION EQ)))) (IL:/RPLACD LOOKUP-TYPE (REMOVE NAME (CDR LOOKUP-TYPE) :KEY (FUNCTION CAR))))))))
(DEFDEFINER (DEF-DEFINE-TYPE (:PROTOTYPE (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (DEF-DEFINE-TYPE (IL:\\\, NAME) "Description string")))))) IL:DEFINE-TYPES (NAME DESCRIPTION &KEY UNDEFINER &AUX (CHANGELST (INTERN (CONCATENATE (QUOTE STRING) "CHANGED" (STRING NAME) "LST") (SYMBOL-PACKAGE NAME)))) "Define NAME as a new definition type" (IL:* IL:|;;| "This definition is a clean interface to a hokey implementation. It works even before the file package is loaded.") (IL:BQUOTE (PROGN (SETF (DOCUMENTATION (QUOTE (IL:\\\, NAME)) (QUOTE IL:DEFINE-TYPES)) (QUOTE (IL:\\\, DESCRIPTION))) (PUSHNEW (QUOTE ((IL:\\\, NAME) X (IL:P IL:* (%DEFINE-TYPE-FILE-DEFINITIONS (QUOTE (IL:\\\, NAME)) (QUOTE X))))) IL:PRETTYDEFMACROS :TEST (QUOTE EQUAL)) (IL:* IL:|;;| "the information about a type in the file package is split up into a number of different places. PRETTYTYPELST contains a random amount: the changelist is the variable whose top level value contains the list of changed items, and the description is a string used by files? This is duplicated in the CL:DOCUMENTATION mechanism") (PUSHNEW (QUOTE ((IL:\\\, CHANGELST) (IL:\\\, NAME) (IL:\\\, DESCRIPTION))) IL:PRETTYTYPELST :TEST (QUOTE EQUAL)) (DEFGLOBALVAR (IL:\\\, CHANGELST) NIL) (IL:* IL:|;;| "the definition hash table is where the definitions are really stored. Create an entry for this type. Note that definitions are compared using CL:EQUAL so that names can be strings, lists, etc.") (UNLESS (GETHASH (QUOTE (IL:\\\, NAME)) *DEFINITION-HASH-TABLE*) (SETF (GETHASH (QUOTE (IL:\\\, NAME)) *DEFINITION-HASH-TABLE*) (MAKE-HASH-TABLE :TEST (QUOTE EQUAL) :SIZE 50 :REHASH-SIZE 50))) (PUSHNEW (QUOTE (IL:\\\, NAME)) IL:FILEPKGTYPES) (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE IL:GETDEF)) (QUOTE %DEFINE-TYPE-GETDEF)) (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE IL:DELDEF)) (QUOTE %DEFINE-TYPE-DELDEF)) (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE IL:PUTDEF)) (QUOTE %DEFINE-TYPE-PUTDEF)) (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE IL:FILEGETDEF)) (QUOTE %DEFINE-TYPE-FILEGETDEF)) (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE IL:FILEPKGCONTENTS)) (QUOTE IL:NILL)) (IL:\\\,@ (WHEN UNDEFINER (IL:BQUOTE ((PUSHNEW (QUOTE (IL:\\\, UNDEFINER)) (GET (QUOTE (IL:\\\, NAME)) (QUOTE :UNDEFINERS))))))))))
(DEFDEFINER (DEFDEFINER (:NAME (LAMBDA (WHOLE) (LET ((NAME (SECOND WHOLE))) (IF (CONSP NAME) (CAR NAME) NAME)))) (:PROTOTYPE (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (DEFDEFINER (IL:\\\, NAME) (IL:\\\, (IF (EQ (IL:EDITMODE) (QUOTE IL:SEDIT)) (SYMBOL-VALUE (INTERN "BASIC-GAP" "SEDIT")) "Type")) (IL:\\\,@ (%MAKE-FUNCTION-PROTOTYPE))))))) (:UNDEFINER %DELETE-DEFINER) (:TEMPLATE (:NAME :TYPE :ARG-LIST :BODY))) IL:FUNCTIONS (NAME TYPE ARG-LIST &BODY BODY) (LET* ((OPTIONS (COND ((CONSP NAME) (PROG1 (CDR NAME) (SETQ NAME (CAR NAME)))) (T NIL))) (NAME-FN NIL) (UNDEFINER NIL) (PROTOTYPE-FN NIL) (TEMPLATE NIL) (PRETTYMACRO NIL) (EDITDATE-OFFSET NIL)) (DOLIST (OPT-LIST OPTIONS) (CASE (CAR OPT-LIST) ((:UNDEFINER) (SETQ UNDEFINER (CADR OPT-LIST))) ((:NAME) (SETQ NAME-FN (CADR OPT-LIST))) ((:PROTOTYPE) (SETQ PROTOTYPE-FN (CADR OPT-LIST))) ((:TEMPLATE) (SETQ TEMPLATE (CADR OPT-LIST))) ((:PRETTYPRINTMACRO) (SETQ PRETTYMACRO (CADR OPT-LIST))) ((:EDITDATE-OFFSET) (SETQ EDITDATE-OFFSET (CADR OPT-LIST))) (OTHERWISE (CERROR "Ignore the option" "Unrecognized option to DefDefiner: ~S" OPT-LIST)))) (IL:* IL:|;;| "Crap out now if junk in EDITDATE-OFFSET") (WHEN (AND EDITDATE-OFFSET (NOT (INTEGERP EDITDATE-OFFSET))) (ERROR ":EDITDATE-OFFSET must be an integer, not ~a" EDITDATE-OFFSET)) (MULTIPLE-VALUE-BIND (EXPANSION-FN DOC) (SI::EXPANSION-FUNCTION NAME ARG-LIST BODY) (UNLESS (OR TEMPLATE PRETTYMACRO (NOT (MEMBER (QUOTE &BODY) ARG-LIST))) (IL:* IL:\; "Tell default prettyprinter where the body is") (SETQ TEMPLATE (NCONC (IL:FOR X IL:IN ARG-LIST IL:UNTIL (EQ X (QUOTE &BODY)) IL:UNLESS (MEMBER X LAMBDA-LIST-KEYWORDS) IL:COLLECT NIL) (LIST :BODY))) (WHEN (AND (NULL (CAR TEMPLATE)) (NULL NAME-FN)) (IL:* IL:\; "Name is in default place") (SETF (CAR TEMPLATE) :NAME))) (LET ((EXPANDER-NAME (GET-DEFINER-NAME NAME "definition-expander-")) (NAME-FN-NAME (IF (CONSP NAME-FN) (GET-DEFINER-NAME NAME "name-fn-")))) (IL:BQUOTE (PROGN (EVAL-WHEN (LOAD EVAL ) (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE :DEFINER-FOR)) (QUOTE (IL:\\\, TYPE))) (PUSHNEW (QUOTE (IL:\\\, NAME)) (GET (QUOTE (IL:\\\, TYPE)) (QUOTE :DEFINED-BY))) (SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, EXPANDER-NAME))) (FUNCTION (IL:\\\, EXPANSION-FN))) (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE :DEFINITION-EXPANDER)) (QUOTE (IL:\\\, EXPANDER-NAME))) (IL:\\\,@ (IF NAME-FN-NAME (IL:BQUOTE ((SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, NAME-FN-NAME))) (FUNCTION (IL:\\\, NAME-FN))))))) (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE :DEFINITION-NAME)) (QUOTE (IL:\\\, (OR NAME-FN-NAME NAME-FN (QUOTE SECOND))))) (IL:\\\,@ (AND UNDEFINER (LET ((UNDEFINER-FN-NAME (GET-DEFINER-NAME NAME "undefiner-fn-"))) (IL:BQUOTE ((SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, UNDEFINER-FN-NAME))) (FUNCTION (IL:\\\, UNDEFINER))) (PUSHNEW (QUOTE (IL:\\\, UNDEFINER-FN-NAME)) (GET (QUOTE (IL:\\\, NAME)) (QUOTE :UNDEFINERS)))))))) (IL:\\\,@ (AND PROTOTYPE-FN (LET ((PROTOTYPE-FN-NAME (GET-DEFINER-NAME NAME "prototype-fn-"))) (IL:BQUOTE ((SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, PROTOTYPE-FN-NAME))) (FUNCTION (IL:\\\, PROTOTYPE-FN))) (ADD-PROTOTYPE-FN (QUOTE (IL:\\\, TYPE)) (QUOTE (IL:\\\, NAME)) (QUOTE (IL:\\\, PROTOTYPE-FN-NAME)))))))) (IL:\\\,@ (AND DOC (IL:BQUOTE ((SETF (DOCUMENTATION (QUOTE (IL:\\\, NAME)) (QUOTE FUNCTION)) (IL:\\\, DOC)))))) (IL:\\\,@ (AND TEMPLATE (IL:BQUOTE ((SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE :DEFINITION-PRINT-TEMPLATE)) (QUOTE (IL:\\\, TEMPLATE))))))) (IL:\\\,@ (AND EDITDATE-OFFSET (IL:BQUOTE ((SETF (GET (QUOTE (IL:\\\, NAME)) :EDITDATE-OFFSET) (IL:\\\, EDITDATE-OFFSET)))))) (PUSHNEW (QUOTE ((IL:\\\, NAME) (IL:\\\,@ (OR PRETTYMACRO (QUOTE PPRINT-DEFINER))))) IL:PRETTYPRINTMACROS :TEST (QUOTE EQUAL))) (DEFMACRO (IL:\\\, NAME) (&WHOLE DEFINITION &ENVIRONMENT ENV) (IL:BQUOTE (DEFINER (IL:\\\, (QUOTE (IL:\\\, TYPE))) (IL:\\\, (QUOTE (IL:\\\, NAME))) (IL:\\\, DEFINITION) (IL:\\\, ENV))))))))))
(DEFDEFINER (DEFDEFINER-VARIABLE-TYPE (:NAME (LAMBDA (WHOLE) (LET ((NAME (SECOND WHOLE))) (IF (CONSP NAME) (CAR NAME) NAME)))) (:PROTOTYPE (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (DEFDEFINER-VARIABLE-TYPE (IL:\\\, NAME) (IL:\\\, (IF (EQ (IL:EDITMODE) (INTERN "SEDIT" "SEDIT")) (SYMBOL-VALUE (INTERN "BASIC-GAP" "SEDIT")) "Type")) (IL:\\\,@ (%MAKE-FUNCTION-PROTOTYPE))))))) (:UNDEFINER %DELETE-DEFINER) (:TEMPLATE (:NAME :TYPE :ARG-LIST :BODY))) IL:FUNCTIONS (NAME TYPES ARG-LIST &BODY BODY) (IL:* IL:|;;| "An extension to the DEFDEFINER universe, this allows the creation of definers that map to multiple file-package types. The test case, and the only case guaranteed to work, is DEFUN (which now must accept (DEFUN (SETF FOO)...), which needs to be stored as a SETFS file type).") (LET* ((OPTIONS (COND ((CONSP NAME) (PROG1 (CDR NAME) (SETQ NAME (CAR NAME)))) (T NIL))) (NAME-FN NIL) (UNDEFINERS NIL) (PROTOTYPE-FNS NIL) (TEMPLATE NIL) (PRETTYMACRO NIL) (TYPE-DISCRIMINATOR NIL) (EXPANSION-FNS NIL) (DOCS NIL) (EDITDATE-OFFSET NIL)) (DOLIST (OPT-LIST OPTIONS) (CASE (CAR OPT-LIST) ((:UNDEFINERS) (SETQ UNDEFINERS (CDR OPT-LIST))) ((:NAME) (SETQ NAME-FN (CADR OPT-LIST))) ((:PROTOTYPES) (SETQ PROTOTYPE-FNS (CDR OPT-LIST))) ((:TEMPLATE) (SETQ TEMPLATE (CADR OPT-LIST))) ((:PRETTYPRINTMACRO) (SETQ PRETTYMACRO (CADR OPT-LIST))) ((:TYPE-DISCRIMINATOR) (SETQ TYPE-DISCRIMINATOR (CADR OPT-LIST))) ((:EDITDATE-OFFSET) (SETQ EDITDATE-OFFSET (CADR OPT-LIST))) (OTHERWISE (CERROR "Ignore the option" "Unrecognized option to DefDefiner: ~S" OPT-LIST)))) (UNLESS TYPE-DISCRIMINATOR (ERROR "DEFDEFINER-VARIABLE-TYPE must have a TYPE-DISCRIMINATOR")) (IL:* IL:|;;| "Crap out now if junk in EDITDATE-OFFSET") (WHEN (AND EDITDATE-OFFSET (NOT (INTEGERP EDITDATE-OFFSET))) (ERROR ":EDITDATE-OFFSET must be an integer, not ~a" EDITDATE-OFFSET)) (DOLIST (TYPE TYPES) (MULTIPLE-VALUE-BIND (EXPANSION-FN DOC) (SI::EXPANSION-FUNCTION NAME ARG-LIST (LET ((TB (GETF BODY TYPE))) (IF TB (LIST TB) (ERROR "No expansion-function for ~A" TYPE)))) (SETF (GETF EXPANSION-FNS TYPE) EXPANSION-FN) (WHEN DOC (SETQ DOCS (CONCATENATE (QUOTE STRING) DOCS (OR DOCS "
") (SYMBOL-NAME TYPE) ": " DOC))))) (UNLESS (OR TEMPLATE PRETTYMACRO (NOT (MEMBER (QUOTE &BODY) ARG-LIST))) (IL:* IL:\; "Tell default prettyprinter where the body is") (SETQ TEMPLATE (NCONC (IL:FOR X IL:IN ARG-LIST IL:UNTIL (EQ X (QUOTE &BODY)) IL:UNLESS (MEMBER X LAMBDA-LIST-KEYWORDS) IL:COLLECT NIL) (LIST :BODY))) (WHEN (AND (NULL (CAR TEMPLATE)) (NULL NAME-FN)) (IL:* IL:\; "Name is in default place") (SETF (CAR TEMPLATE) :NAME))) (LET ((NAME-FN-NAME (IF (CONSP NAME-FN) (GET-DEFINER-NAME NAME "name-fn-"))) (TYPE-DISCRIMINATOR-NAME (GET-DEFINER-NAME NAME "type-discriminator-fn-"))) (IL:BQUOTE (PROGN (EVAL-WHEN (LOAD EVAL ) (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE :DEFINER-FOR)) (QUOTE (IL:\\\, TYPES))) (SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, TYPE-DISCRIMINATOR-NAME))) (FUNCTION (IL:\\\, TYPE-DISCRIMINATOR))) (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE :TYPE-DISCRIMINATOR)) (QUOTE (IL:\\\, TYPE-DISCRIMINATOR-NAME))) (IL:\\\,@ (AND PROTOTYPE-FNS (MAPCAN (FUNCTION (LAMBDA (TYPE) (LET ((PROTOTYPE-FN-NAME (GET-DEFINER-NAME NAME (CONCATENATE (QUOTE STRING) (SYMBOL-NAME TYPE) "-prototype-fn-")))) (IL:BQUOTE ((SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, PROTOTYPE-FN-NAME))) (FUNCTION (IL:\\\, (GETF PROTOTYPE-FNS TYPE)))) (ADD-PROTOTYPE-FN (QUOTE (IL:\\\, TYPE)) (QUOTE (IL:\\\, NAME)) (QUOTE (IL:\\\, PROTOTYPE-FN-NAME)))))))) TYPES))) (IL:\\\,@ (AND DOCS (IL:BQUOTE ((SETF (DOCUMENTATION (QUOTE (IL:\\\, NAME)) (QUOTE FUNCTION)) (IL:\\\, DOCS)))))) (IL:\\\,@ (AND TEMPLATE (IL:BQUOTE ((SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE :DEFINITION-PRINT-TEMPLATE)) (QUOTE (IL:\\\, TEMPLATE))))))) (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE :DEFINITION-NAME)) (QUOTE (IL:\\\, (OR NAME-FN-NAME NAME-FN (QUOTE SECOND))))) (IL:\\\,@ (MAPCAN (FUNCTION (LAMBDA (TYPE) (LET ((EXPANDER-NAME (GET-DEFINER-NAME NAME (CONCATENATE (QUOTE STRING) (SYMBOL-NAME TYPE) "-definition-expander-"))) (EXPANSION-FN (GETF EXPANSION-FNS TYPE))) (IL:BQUOTE ((PUSHNEW (QUOTE (IL:\\\, NAME)) (GET (QUOTE (IL:\\\, TYPE)) (QUOTE :DEFINED-BY))) (SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, EXPANDER-NAME))) (FUNCTION (IL:\\\, EXPANSION-FN))) (SETF (GETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE :DEFINITION-EXPANDER)) (QUOTE (IL:\\\, TYPE))) (QUOTE (IL:\\\, EXPANDER-NAME)))))))) TYPES)) (IL:\\\,@ (IF NAME-FN-NAME (IL:BQUOTE ((SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, NAME-FN-NAME))) (FUNCTION (IL:\\\, NAME-FN))))))) (IL:\\\,@ (AND UNDEFINERS (MAPCAN (FUNCTION (LAMBDA (TYPE) (WHEN (GETF UNDEFINERS TYPE) (LET ((UNDEFINER-FN-NAME (GET-DEFINER-NAME NAME (CONCATENATE (QUOTE STRING) (SYMBOL-NAME TYPE) "-undefiner-fn-")))) (IL:BQUOTE ((SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, UNDEFINER-FN-NAME))) (FUNCTION (IL:\\\, (GETF UNDEFINERS TYPE)))) (PUSHNEW (QUOTE (IL:\\\, UNDEFINER-FN-NAME)) (GETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE :UNDEFINERS)) (QUOTE (IL:\\\, TYPE)))))))))) TYPES))) (IL:\\\,@ (AND EDITDATE-OFFSET (IL:BQUOTE ((SETF (GET (QUOTE (IL:\\\, NAME)) :EDITDATE-OFFSET) (IL:\\\, EDITDATE-OFFSET)))))) (PUSHNEW (QUOTE ((IL:\\\, NAME) (IL:\\\,@ (OR PRETTYMACRO (QUOTE PPRINT-DEFINER))))) IL:PRETTYPRINTMACROS :TEST (QUOTE EQUAL))) (DEFMACRO (IL:\\\, NAME) (&WHOLE DEFINITION &ENVIRONMENT ENV) (IL:BQUOTE (DEFINER-VARIABLE-TYPE (IL:\\\, (QUOTE (IL:\\\, NAME))) (IL:\\\, DEFINITION) (IL:\\\, ENV)))))))))
(DEFUN %EXPAND-DEFINER (DEFINER DEFINITION-WITHOUT-COMMENTS &OPTIONAL ENV) (FUNCALL (GET DEFINER :DEFINITION-EXPANDER) DEFINITION-WITHOUT-COMMENTS ENV))
(DEFUN %DEFINER-NAME (DEFINER DEFINITION-WITHOUT-COMMENTS) (FUNCALL (GET DEFINER :DEFINITION-NAME) DEFINITION-WITHOUT-COMMENTS))
(IL:* IL:\; "The most commonly-used definers")
(DEFDEFINER-VARIABLE-TYPE (DEFUN (:TYPE-DISCRIMINATOR (LAMBDA (WHOLE) (LET ((NAME (SECOND WHOLE))) (COND ((SYMBOLP NAME) (QUOTE IL:FUNCTIONS)) ((CL::SETF-NAME-P NAME) (QUOTE IL:SETFS)) (T (ERROR "Can't determine type for DEFUN: ~s" NAME)))))) (:NAME (LAMBDA (WHOLE) (LET ((NAME (SECOND WHOLE))) (COND ((SYMBOLP NAME) NAME) ((CL::SETF-NAME-P NAME) (CADR NAME)) (T (ERROR "Bad function-name for DEFUN: ~s" NAME)))))) (:PROTOTYPES IL:FUNCTIONS (LAMBDA (NAME) (IL:BQUOTE (DEFUN (IL:\\\, NAME) (IL:\\\,@ (%MAKE-FUNCTION-PROTOTYPE))))) IL:SETFS (LAMBDA (NAME) (IL:BQUOTE (DEFUN (SETF (IL:\\\, NAME)) (IL:\\\,@ (%MAKE-FUNCTION-PROTOTYPE)))))) (:TEMPLATE (:NAME :ARG-LIST :BODY)) (:EDITDATE-OFFSET 3)) (IL:FUNCTIONS IL:SETFS) (NAME ARGS &BODY (BODY DECLS DOCUMENTATION) &ENVIRONMENT ENV) IL:FUNCTIONS (IL:BQUOTE (PROGN (SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, NAME))) (FUNCTION (LAMBDA (IL:\\\, ARGS) (IL:\\\,@ DECLS) (BLOCK (IL:\\\, NAME) (IL:\\\,@ BODY))))) (IL:\\\,@ (AND DOCUMENTATION (IL:BQUOTE ((SETF (DOCUMENTATION (QUOTE (IL:\\\, NAME)) (QUOTE FUNCTION)) (IL:\\\, DOCUMENTATION)))))))) IL:SETFS (IL:* IL:|;;| "The form is (defun (setf foo) (store-var &rest args) body)") (IL:* IL:|;;| "Strategy is to give the code a name with DEFUN-SETF-NAME. The name is stored on the :SETF-DEFUN property of the accessor. This name is there for convenience/documentation only; the name can't be reliably changed by smashing this property (i.e. (SETF (FDEFINITION '(SETF FOO)) #'BAR) essentially does (SETF (SYMBOL-FUNCTION (DEFUN-SETF-NAME 'FOO)) #'BAR); it does NOT change the :SETF-DEFUN property on FOO).") (LET* ((REAL-NAME (SECOND NAME)) (DEFUN-SETF-NAME (DEFUN-SETF-NAME REAL-NAME))) (IL:BQUOTE (PROGN (SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, DEFUN-SETF-NAME))) (FUNCTION (LAMBDA (IL:\\\, ARGS) (IL:\\\,@ DECLS) (BLOCK (IL:\\\, REAL-NAME) (IL:\\\,@ BODY))))) (SET-DEFUN-SETF (QUOTE (IL:\\\, REAL-NAME)) (QUOTE (IL:\\\, DEFUN-SETF-NAME))) (IL:\\\,@ (AND DOCUMENTATION (IL:BQUOTE ((SETF (DOCUMENTATION (QUOTE (IL:\\\, REAL-NAME)) (QUOTE SETF)) (IL:\\\, DOCUMENTATION))))))))))
(DEFDEFINER (DEFINLINE (:PROTOTYPE (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (DEFINLINE (IL:\\\, NAME) (IL:\\\,@ (%MAKE-FUNCTION-PROTOTYPE))))))) (:TEMPLATE (:NAME :ARG-LIST :BODY))) IL:FUNCTIONS (NAME ARG-LIST &BODY BODY &ENVIRONMENT ENV) (IL:* IL:|;;;| "This is an INTERIM version of DEFINLINE. Eventually, this will just turn into a DEFUN and a PROCLAIM INLINE. (It says so right here.) If you're using this one, DO NOT make any recursive calls in the body of the DEFINLINE. If you do, the compiler will run forever trying to expand the optimizer... Once the INLINE version gets working (in the PavCompiler only) that restriction will be lifted.") (MULTIPLE-VALUE-BIND (CODE DECLS DOC) (PARSE-BODY BODY ENV T) (LET ((NEW-LAMBDA (IL:BQUOTE ((IL:\\\, (QUOTE LAMBDA)) (IL:\\\, ARG-LIST) (IL:\\\,@ DECLS) (BLOCK (IL:\\\, NAME) (IL:\\\,@ CODE)))))) (IL:BQUOTE (PROGN (DEFUN (IL:\\\, NAME) (IL:\\\, ARG-LIST) (IL:\\\,@ BODY)) (DEFOPTIMIZER (IL:\\\, NAME) (IL:\\\, (PACK (LIST "definline-" NAME) (SYMBOL-PACKAGE NAME))) (&REST ARGS) (CONS (QUOTE (IL:\\\, NEW-LAMBDA)) ARGS)))))))
(DEFDEFINER (DEFMACRO (:PROTOTYPE (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (DEFMACRO (IL:\\\, NAME) (IL:\\\,@ (%MAKE-FUNCTION-PROTOTYPE))))))) (:UNDEFINER (LAMBDA (NAME) (REMPROP NAME (QUOTE IL:ARGNAMES)))) (:TEMPLATE (:NAME :ARG-LIST :BODY))) IL:FUNCTIONS (NAME DEFMACRO-ARGS &BODY DEFMACRO-BODY) (UNLESS (AND NAME (SYMBOLP NAME)) (ERROR "Illegal name used in DEFMACRO: ~S" NAME)) (LET ((CMACRONAME (PACK (LIST "expand-" NAME) (SYMBOL-PACKAGE NAME)))) (MULTIPLE-VALUE-BIND (EXPANSION-FN DOC-STRING) (SI::EXPANSION-FUNCTION NAME DEFMACRO-ARGS DEFMACRO-BODY) (IL:BQUOTE (PROGN (SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, CMACRONAME))) (FUNCTION (IL:\\\, EXPANSION-FN))) (SETF (MACRO-FUNCTION (QUOTE (IL:\\\, NAME))) (QUOTE (IL:\\\, CMACRONAME))) (IL:\\\,@ (AND DOC-STRING (IL:BQUOTE ((SETF (DOCUMENTATION (QUOTE (IL:\\\, NAME)) (QUOTE FUNCTION)) (IL:\\\, DOC-STRING)))))) (IL:\\\,@ (WHEN COMPILER::*NEW-COMPILER-IS-EXPANDING* (IL:BQUOTE ((SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE IL:ARGNAMES)) (QUOTE (IL:\\\, (MAPCAR (FUNCTION (LAMBDA (ARG) (IF (MEMBER ARG LAMBDA-LIST-KEYWORDS) ARG (PRIN1-TO-STRING ARG)))) (IL:\\SIMPLIFY.CL.ARGLIST DEFMACRO-ARGS))))))))))))))
(DEFDEFINER (DEFVAR (:PROTOTYPE (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (DEFVAR (IL:\\\, NAME))))))) IL:VARIABLES (NAME &OPTIONAL (INITIAL-VALUE NIL IVP) DOCUMENTATION) (IL:BQUOTE (PROGN (PROCLAIM (QUOTE (SPECIAL (IL:\\\, NAME)))) (IL:\\\,@ (AND IVP (IL:BQUOTE ((OR (BOUNDP (QUOTE (IL:\\\, NAME))) (SETQ (IL:\\\, NAME) (IL:\\\, INITIAL-VALUE))))))) (IL:\\\,@ (AND DOCUMENTATION (IL:BQUOTE ((SETF (DOCUMENTATION (QUOTE (IL:\\\, NAME)) (QUOTE VARIABLE)) (IL:\\\, DOCUMENTATION)))))))))
(DEFDEFINER (DEFPARAMETER (:PROTOTYPE (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (DEFPARAMETER (IL:\\\, NAME) "Value" "Documentation string")))))) IL:VARIABLES (NAME INITIAL-VALUE &OPTIONAL DOCUMENTATION) (IL:BQUOTE (PROGN (PROCLAIM (QUOTE (SPECIAL (IL:\\\, NAME)))) (SETQ (IL:\\\, NAME) (IL:\\\, INITIAL-VALUE)) (IL:\\\,@ (AND DOCUMENTATION (IL:BQUOTE ((SETF (DOCUMENTATION (QUOTE (IL:\\\, NAME)) (QUOTE VARIABLE)) (IL:\\\, DOCUMENTATION)))))))))
(DEFDEFINER (DEFCONSTANT (:PROTOTYPE (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (DEFCONSTANT (IL:\\\, NAME) "Value" "Documentation string")))))) IL:VARIABLES (NAME VALUE &OPTIONAL DOCUMENTATION) (IL:BQUOTE (PROGN (IL:\\\,@ (IF (CONSTANTP NAME) (IL:BQUOTE ((SET-CONSTANTP (QUOTE (IL:\\\, NAME)) NIL))))) (SETQ (IL:\\\, NAME) (IL:\\\, VALUE)) (PROCLAIM (QUOTE (SI::CONSTANT (IL:\\\, NAME)))) (IL:\\\,@ (AND DOCUMENTATION (IL:BQUOTE ((SETF (DOCUMENTATION (QUOTE (IL:\\\, NAME)) (QUOTE VARIABLE)) (IL:\\\, DOCUMENTATION)))))))))
(DEFDEFINER (DEFGLOBALVAR (:PROTOTYPE (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (DEFGLOBALVAR (IL:\\\, NAME))))))) IL:VARIABLES (NAME &OPTIONAL (INITIAL-VALUE NIL IVP) DOCUMENTATION) (IL:* IL:|;;| "Use IL:SETQ here or the INIT dies.") (IL:BQUOTE (PROGN (PROCLAIM (QUOTE (GLOBAL (IL:\\\, NAME)))) (IL:\\\,@ (AND IVP (IL:BQUOTE ((OR (BOUNDP (QUOTE (IL:\\\, NAME))) (SETQ (IL:\\\, NAME) (IL:\\\, INITIAL-VALUE))))))) (IL:\\\,@ (AND DOCUMENTATION (IL:BQUOTE ((SETF (DOCUMENTATION (QUOTE (IL:\\\, NAME)) (QUOTE VARIABLE)) (IL:\\\, DOCUMENTATION)))))))))
(DEFDEFINER (DEFGLOBALPARAMETER (:PROTOTYPE (LAMBDA (NAME) (AND (SYMBOLP NAME) (IL:BQUOTE (DEFGLOBALPARAMETER (IL:\\\, NAME) "Value" "Documentation string")))))) IL:VARIABLES (NAME INITIAL-VALUE &OPTIONAL DOCUMENTATION) (IL:BQUOTE (PROGN (PROCLAIM (QUOTE (GLOBAL (IL:\\\, NAME)))) (SETQ (IL:\\\, NAME) (IL:\\\, INITIAL-VALUE)) (IL:\\\,@ (AND DOCUMENTATION (IL:BQUOTE ((SETF (DOCUMENTATION (QUOTE (IL:\\\, NAME)) (QUOTE VARIABLE)) (IL:\\\, DOCUMENTATION)))))))))
(IL:* IL:\; "Here so that the evaluator can be in the init without definers being in the init.")
(DEF-DEFINE-TYPE IL:SPECIAL-FORMS "Common Lisp special forms" :UNDEFINER %REMOVE-SPECIAL-FORM)
(DEFUN %REMOVE-SPECIAL-FORM (X) (IL:/REMPROP X (QUOTE IL:SPECIAL-FORM)))
(DEFDEFINER (DEFINE-SPECIAL-FORM (:TEMPLATE (:NAME :ARG-LIST :BODY))) IL:SPECIAL-FORMS (NAME ARGS &REST BODY) (COND ((NULL BODY) (ASSERT (SYMBOLP NAME) NIL "Ill-formed short DEFINE-SPECIAL-FORM; ~S is not a symbol." ARGS) (IL:BQUOTE (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE IL:SPECIAL-FORM)) (QUOTE (IL:\\\, ARGS))))) (T (LET ((SF (INTERN (CONCATENATE (QUOTE STRING) "interpret-" (STRING NAME)) (SYMBOL-PACKAGE NAME)))) (MULTIPLE-VALUE-BIND (PARSED-BODY DECLS DOC) (IL:PARSE-DEFMACRO ARGS (QUOTE $$TAIL) BODY NAME NIL :PATH (QUOTE $$TAIL) :ENVIRONMENT (QUOTE $$ENV)) (IL:BQUOTE (PROGN (SETF (SYMBOL-FUNCTION (QUOTE (IL:\\\, SF))) (FUNCTION (LAMBDA ($$TAIL $$ENV) (IL:\\\,@ DECLS) (BLOCK (IL:\\\, NAME) (IL:\\\, PARSED-BODY))))) (SETF (GET (QUOTE (IL:\\\, NAME)) (QUOTE IL:SPECIAL-FORM)) (QUOTE (IL:\\\, SF))))))))))
(IL:* IL:\; "Form for defining interpreters of special forms")
(IL:* IL:\; "Don't note changes to these properties/variables")
(IL:PUTPROPS IL:MACRO-FN IL:PROPTYPE IL:FUNCTIONS)
(IL:PUTPROPS :UNDEFINERS IL:PROPTYPE IGNORE)
(IL:PUTPROPS IL:UNDEFINERS IL:PROPTYPE IGNORE)
(IL:PUTPROPS :DEFINER-FOR IL:PROPTYPE IGNORE)
(IL:PUTPROPS IL:DEFINER-FOR IL:PROPTYPE IGNORE)
(IL:PUTPROPS :DEFINED-BY IL:PROPTYPE IGNORE)
(IL:PUTPROPS IL:DEFINED-BY IL:PROPTYPE IGNORE)
(IL:PUTPROPS :DEFINITION-NAME IL:PROPTYPE IGNORE)
(IL:PUTPROPS IL:DEFINITION-NAME IL:PROPTYPE IGNORE)
(IL:* IL:\;
"Templates for definers not defined here. These should really be where they're defined.")
(IL:PUTPROPS DEFCOMMAND :DEFINITION-PRINT-TEMPLATE (:NAME :ARG-LIST :BODY))
(IL:PUTPROPS DEFINE-CONDITION :DEFINITION-PRINT-TEMPLATE (:NAME :VALUE :BODY))
(IL:PUTPROPS DEFINE-MODIFY-MACRO :DEFINITION-PRINT-TEMPLATE (:NAME :ARG-LIST))
(IL:PUTPROPS DEFINE-SETF-METHOD :DEFINITION-PRINT-TEMPLATE (:NAME NIL NIL :BODY))
(IL:PUTPROPS DEFSETF :DEFINITION-PRINT-TEMPLATE (:NAME :ARG-LIST :ARG-LIST :BODY))
(IL:PUTPROPS DEFSTRUCT :DEFINITION-PRINT-TEMPLATE (:NAME :BODY))
(IL:PUTPROPS DEFTYPE :DEFINITION-PRINT-TEMPLATE (:NAME NIL :BODY))
(IL:* IL:|;;| "Arrange for the correct compiler to be used.")
(IL:PUTPROPS IL:CMLDEFFER IL:FILETYPE :COMPILE-FILE)
(IL:PUTPROPS IL:CMLDEFFER IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "XCL"))
(IL:PUTPROPS IL:CMLDEFFER IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1900 1987 1988 1990 1992))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL)))
IL:STOP

File diff suppressed because one or more lines are too long

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@@ -1,55 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Jun-2017 22:48:46" {DSK}<Volumes>Personal>local>medley3.5>current>LOCAL-INIT.;32 9225
changes to%: (VARS LOCAL-INITCOMS)
previous date%: "15-Jun-2017 22:06:37"
{DSK}<Volumes>Personal>local>medley3.5>current>LOCAL-INIT.;31)
(PRETTYCOMPRINT LOCAL-INITCOMS)
(RPAQQ LOCAL-INITCOMS
[
(* ;; "Local (Mac) system greeting file")
(FNS INTERLISPMODE)
(VARS (COMPILEIGNOREDECL T)
(MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR))
(SITE 'LOCAL-MAC))
(P (BKSYSBUF " ")
(* ;
 "So tty window doesn't hang during greeting")
(KEYACTION 'BLANK-TOP '(METADOWN . METAUP)
\CURRENTKEYACTION)
(KEYACTION 'BLANK-TOP '(METADOWN . METAUP))
(INTERLISPMODE)
(DEFCOMMAND ("show" :QUIET)
(&REST EVENTSPEC)
(CL:PPRINT (VALUOF EVENTSPEC T)
T)))
(FNS LOCAL-INIT LoadPatches COLLECT-PATCH-FILES)
(FUNCTIONS WITHOUT.PAGEHOLD)
(VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispusers")
(CONCAT MEDLEYDIR "/library")))
(LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/sources")))
(DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
(LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/patches")))
[VARS (USERGREETFILES '(({DSK}/Users/ USER /Lisp/INIT.LCOM)
({DSK}/Users/ USER /Lisp/INIT.DFASLs)
({DSK}/Users/ USER /Lisp/INIT]
[VARS (*USEOLDFONTDIRECTORIES* NIL)
(DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/displayfonts]
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (LOCAL-INIT)
(SETQ USERNAME (UNIX-GETENV "USER")))
(* ; "To get personal greeting to work, since GREET computes the USERNAME before USERNAMEPATCH is loaded.")
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(* ;; "Local (Mac) system greeting file")
(DEFINEQ

View File

@@ -1,55 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-Jul-2017 17:13:31" {DSK}<Volumes>Personal>local>medley3.5>current>LOCAL-INIT.;36 9762
changes to%: (VARS LOCAL-INITCOMS)
previous date%: "26-Jun-2017 13:36:35"
{DSK}<Volumes>Personal>local>medley3.5>current>LOCAL-INIT.;35)
(PRETTYCOMPRINT LOCAL-INITCOMS)
(RPAQQ LOCAL-INITCOMS
[
(* ;; "Local (Mac) system greeting file")
(FNS INTERLISPMODE)
(VARS (COMPILEIGNOREDECL T)
(MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR))
(SITE 'LOCAL-MAC))
(P (BKSYSBUF " ")
(* ;
 "So tty window doesn't hang during greeting")
(INTERLISPMODE)
(DEFCOMMAND ("show" :QUIET)
(&REST EVENTSPEC)
(CL:PPRINT (VALUOF EVENTSPEC T)
T)))
(FNS LOCAL-INIT LoadPatches COLLECT-PATCH-FILES FIXMETA)
(P (FIXMETA))
(FUNCTIONS WITHOUT.PAGEHOLD)
(VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispusers")
(CONCAT MEDLEYDIR "/library")))
(LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/sources")))
(DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
(LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/patches")))
[VARS (USERGREETFILES '(({DSK}/Users/ USER /Lisp/INIT.LCOM)
({DSK}/Users/ USER /Lisp/INIT.DFASLs)
({DSK}/Users/ USER /Lisp/INIT]
[VARS (*USEOLDFONTDIRECTORIES* NIL)
[DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/displayfonts)
(CONCAT MEDLEYDIR '/fonts/altofonts]
[INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/ipfonts]
(POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/postscriptfonts]
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (LOCAL-INIT)
(SETQ USERNAME (UNIX-GETENV "USER")))
(* ; "To get personal greeting to work, since GREET computes the USERNAME before USERNAMEPATCH is loaded.")
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(* ;; "Local (Mac) system greeting file")

View File

@@ -1,55 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Apr-2018 11:06:31" {DSK}<Users>kaplan>Local>medley3.5>current>LOCAL-INIT.;39 10035
changes to%: (VARS LOCAL-INITCOMS)
previous date%: "27-Mar-2018 07:18:26" {DSK}<Users>kaplan>Local>medley3.5>current>LOCAL-INIT.;38
)
(PRETTYCOMPRINT LOCAL-INITCOMS)
(RPAQQ LOCAL-INITCOMS
[
(* ;; "Local (Mac) system greeting file")
(FNS INTERLISPMODE)
(VARS (COMPILEIGNOREDECL T)
(MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR))
(SITE 'LOCAL-MAC))
(P (BKSYSBUF " ")
(* ;
 "So tty window doesn't hang during greeting")
(INTERLISPMODE)
(DEFCOMMAND ("show" :QUIET)
(&REST EVENTSPEC)
(CL:PPRINT (VALUOF EVENTSPEC T)
T)))
(FNS LOCAL-INIT LoadPatches COLLECT-PATCH-FILES FIXMETA)
(P (FIXMETA))
(FUNCTIONS WITHOUT.PAGEHOLD)
(VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispcore/lispusers")
(CONCAT MEDLEYDIR "/lispcore/library")))
(LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispcore/sources")))
(DIRECTORIES (APPEND (CONS (CONCAT MEDLEYDIR "/lispcore/patches"))
LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
(LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/patches")))
[VARS (USERGREETFILES '(({DSK}/Users/ USER /Lisp/INIT.LCOM)
({DSK}/Users/ USER /Lisp/INIT.DFASLs)
({DSK}/Users/ USER /Lisp/INIT]
[VARS (*USEOLDFONTDIRECTORIES* NIL)
[DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/displayfonts)
(CONCAT MEDLEYDIR '/lispcore/fonts/altofonts]
[INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/ipfonts]
(POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/postscriptfonts]
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (LOCAL-INIT)
(SETQ USERNAME (UNIX-GETENV "USER")))
(* ; "To get personal greeting to work, since GREET computes the USERNAME before USERNAMEPATCH is loaded.")
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(* ;; "Local (Mac) system greeting file")

View File

@@ -1,55 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Apr-2018 13:24:14" {DSK}<Users>kaplan>Local>medley3.5>current>LOCAL-INIT.;41 10332
changes to%: (VARS LOCAL-INITCOMS)
previous date%: "23-Apr-2018 22:12:02" {DSK}<Users>kaplan>Local>medley3.5>current>LOCAL-INIT.;40
)
(PRETTYCOMPRINT LOCAL-INITCOMS)
(RPAQQ LOCAL-INITCOMS
[
(* ;; "Local (Mac) system greeting file")
(FNS INTERLISPMODE)
(VARS (COMPILEIGNOREDECL T)
(MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR))
(SITE 'LOCAL-MAC))
(P (BKSYSBUF " ")
(* ;
 "So tty window doesn't hang during greeting")
(INTERLISPMODE)
(DEFCOMMAND ("show" :QUIET)
(&REST EVENTSPEC)
(CL:PPRINT (VALUOF EVENTSPEC T)
T)))
(FNS LOCAL-INIT LoadPatches COLLECT-PATCH-FILES FIXMETA)
(P (FIXMETA))
(FUNCTIONS WITHOUT.PAGEHOLD)
(VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispcore/lispusers")
(CONCAT MEDLEYDIR "/lispcore/library")))
(LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispcore/sources")))
(DIRECTORIES (APPEND (CONS (CONCAT MEDLEYDIR "/lispcore/patches"))
LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
(LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/lispcore/patches")))
[VARS (USERGREETFILES '(({DSK}/Users/ USER /Lisp/INIT.LCOM)
({DSK}/Users/ USER /Lisp/INIT.DFASLs)
({DSK}/Users/ USER /Lisp/INIT]
[VARS (*USEOLDFONTDIRECTORIES* NIL)
[DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/displayfonts)
(CONCAT MEDLEYDIR '/lispcore/fonts/altofonts]
[INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/ipfonts]
(POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/postscriptfonts]
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (LOCAL-INIT)
(* ;
 "(SETQ USERNAME (UNIX-GETENV %"USER%"))")
)
(* ; "To get personal greeting to work, since GREET computes the USERNAME before USERNAMEPATCH is loaded.")
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])

View File

@@ -1,55 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Dec-2018 17:13:47" {DSK}<Users>kaplan>Local>medley3.5>current>LOCAL-INIT.;42 10043
changes to%: (VARS LOCAL-INITCOMS)
previous date%: "26-Apr-2018 13:24:14" {DSK}<Users>kaplan>Local>medley3.5>current>LOCAL-INIT.;41
)
(PRETTYCOMPRINT LOCAL-INITCOMS)
(RPAQQ LOCAL-INITCOMS
[
(* ;; "Local (Mac) system greeting file")
(FNS INTERLISPMODE)
(VARS (COMPILEIGNOREDECL T)
(MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR))
(SITE 'LOCAL-MAC))
(P (BKSYSBUF " ")
(* ;
 "So tty window doesn't hang during greeting")
(INTERLISPMODE)
(DEFCOMMAND ("show" :QUIET)
(&REST EVENTSPEC)
(CL:PPRINT (VALUOF EVENTSPEC T)
T)))
(FNS LOCAL-INIT LoadPatches COLLECT-PATCH-FILES)
(FUNCTIONS WITHOUT.PAGEHOLD)
(VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispcore/lispusers")
(CONCAT MEDLEYDIR "/lispcore/library")))
(LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispcore/sources")))
(DIRECTORIES (APPEND (CONS (CONCAT MEDLEYDIR "/lispcore/patches"))
LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
(LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/lispcore/patches")))
[VARS (USERGREETFILES '(({DSK}/Users/ USER /Lisp/INIT.LCOM)
({DSK}/Users/ USER /Lisp/INIT.DFASLs)
({DSK}/Users/ USER /Lisp/INIT]
[VARS (*USEOLDFONTDIRECTORIES* NIL)
[DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/displayfonts)
(CONCAT MEDLEYDIR '/lispcore/fonts/altofonts]
[INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/ipfonts]
(POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/postscriptfonts]
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (LOCAL-INIT)
(* ;
 "(SETQ USERNAME (UNIX-GETENV %"USER%"))")
)
(* ; "To get personal greeting to work, since GREET computes the USERNAME before USERNAMEPATCH is loaded.")
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])

View File

@@ -1,55 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Dec-2018 17:13:47" {DSK}<Users>kaplan>Local>medley3.5>current>LOCAL-INIT.;42 10043
changes to%: (VARS LOCAL-INITCOMS)
previous date%: "26-Apr-2018 13:24:14" {DSK}<Users>kaplan>Local>medley3.5>current>LOCAL-INIT.;41
)
(PRETTYCOMPRINT LOCAL-INITCOMS)
(RPAQQ LOCAL-INITCOMS
[
(* ;; "Local (Mac) system greeting file")
(FNS INTERLISPMODE)
(VARS (COMPILEIGNOREDECL T)
(MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR))
(SITE 'LOCAL-MAC))
(P (BKSYSBUF " ")
(* ;
 "So tty window doesn't hang during greeting")
(INTERLISPMODE)
(DEFCOMMAND ("show" :QUIET)
(&REST EVENTSPEC)
(CL:PPRINT (VALUOF EVENTSPEC T)
T)))
(FNS LOCAL-INIT LoadPatches COLLECT-PATCH-FILES)
(FUNCTIONS WITHOUT.PAGEHOLD)
(VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispcore/lispusers")
(CONCAT MEDLEYDIR "/lispcore/library")))
(LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispcore/sources")))
(DIRECTORIES (APPEND (CONS (CONCAT MEDLEYDIR "/lispcore/patches"))
LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
(LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/lispcore/patches")))
[VARS (USERGREETFILES '(({DSK}/Users/ USER /Lisp/INIT.LCOM)
({DSK}/Users/ USER /Lisp/INIT.DFASLs)
({DSK}/Users/ USER /Lisp/INIT]
[VARS (*USEOLDFONTDIRECTORIES* NIL)
[DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/displayfonts)
(CONCAT MEDLEYDIR '/lispcore/fonts/altofonts]
[INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/ipfonts]
(POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/postscriptfonts]
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (LOCAL-INIT)
(* ;
 "(SETQ USERNAME (UNIX-GETENV %"USER%"))")
)
(* ; "To get personal greeting to work, since GREET computes the USERNAME before USERNAMEPATCH is loaded.")
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])

View File

@@ -1,55 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Oct-2020 15:15:23" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>current>LOCAL-INIT.;44 10136
changes to%: (VARS LOCAL-INITCOMS)
previous date%: "22-Dec-2018 17:13:47"
{DSK}<Users>kaplan>Local>medley3.5>lispcore>current>LOCAL-INIT.;43)
(PRETTYCOMPRINT LOCAL-INITCOMS)
(RPAQQ LOCAL-INITCOMS
[
(* ;; "Local (Mac) system greeting file")
(FNS INTERLISPMODE)
(VARS (COMPILEIGNOREDECL T)
(MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR))
(SITE 'LOCAL-MAC))
(P (BKSYSBUF " ")
(* ;
 "So tty window doesn't hang during greeting")
(INTERLISPMODE)
(DEFCOMMAND ("show" :QUIET)
(&REST EVENTSPEC)
(CL:PPRINT (VALUOF EVENTSPEC T)
T)))
(FNS LOCAL-INIT LoadPatches COLLECT-PATCH-FILES)
(FUNCTIONS WITHOUT.PAGEHOLD)
(VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispcore/lispusers")
(CONCAT MEDLEYDIR "/lispcore/library")))
(LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispcore/sources")))
(DIRECTORIES (APPEND (CONS (CONCAT MEDLEYDIR "/lispcore/patches"))
LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
(LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/lispcore/patches")))
[VARS (USERGREETFILES '(({DSK}/Users/ USER /Lisp/INIT.LCOM)
({DSK}/Users/ USER /Lisp/INIT.DFASL)
({DSK}/Users/ USER /Lisp/INIT]
[VARS (*USEOLDFONTDIRECTORIES* NIL)
[DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/displayfonts)
(CONCAT MEDLEYDIR '/lispcore/fonts/altofonts]
[INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/ipfonts]
(POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/postscriptfonts]
(DECLARE%: DONTEVAL@LOAD DOCOPY [P (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE]
(P (LOCAL-INIT)
(* ;
 "(SETQ USERNAME (UNIX-GETENV %"USER%"))")
)
(* ; "To get personal greeting to work, since GREET computes the USERNAME before USERNAMEPATCH is loaded.")
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])

View File

@@ -1,55 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Oct-2020 15:19:00" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>greetfiles>LOCAL-INIT.;45 10099
previous date%: "19-Oct-2020 15:15:23"
{DSK}<Users>kaplan>Local>medley3.5>lispcore>greetfiles>LOCAL-INIT.;44)
(PRETTYCOMPRINT LOCAL-INITCOMS)
(RPAQQ LOCAL-INITCOMS
[
(* ;; "Local (Mac) system greeting file")
(FNS INTERLISPMODE)
(VARS (COMPILEIGNOREDECL T)
(MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR))
(SITE 'LOCAL-MAC))
(P (BKSYSBUF " ")
(* ;
 "So tty window doesn't hang during greeting")
(INTERLISPMODE)
(DEFCOMMAND ("show" :QUIET)
(&REST EVENTSPEC)
(CL:PPRINT (VALUOF EVENTSPEC T)
T)))
(FNS LOCAL-INIT LoadPatches COLLECT-PATCH-FILES)
(FUNCTIONS WITHOUT.PAGEHOLD)
(VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispcore/lispusers")
(CONCAT MEDLEYDIR "/lispcore/library")))
(LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispcore/sources")))
(DIRECTORIES (APPEND (CONS (CONCAT MEDLEYDIR "/lispcore/patches"))
LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
(LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/lispcore/patches")))
[VARS (USERGREETFILES '(({DSK}/Users/ USER /Lisp/INIT.LCOM)
({DSK}/Users/ USER /Lisp/INIT.DFASL)
({DSK}/Users/ USER /Lisp/INIT]
[VARS (*USEOLDFONTDIRECTORIES* NIL)
[DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/displayfonts)
(CONCAT MEDLEYDIR '/lispcore/fonts/altofonts]
[INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/ipfonts]
(POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/lispcore/fonts/postscriptfonts]
(DECLARE%: DONTEVAL@LOAD DOCOPY [P (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE]
(P (LOCAL-INIT)
(* ;
 "(SETQ USERNAME (UNIX-GETENV %"USER%"))")
)
(* ; "To get personal greeting to work, since GREET computes the USERNAME before USERNAMEPATCH is loaded.")
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])

File diff suppressed because one or more lines are too long

View File

@@ -1 +0,0 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

File diff suppressed because one or more lines are too long

View File

@@ -1,222 +0,0 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(FILECREATED "23-Mar-94 17:45:59" |{DSK}<king>export>lispcore>internal>library>CALENDARHACKS.;3| 11258
|changes| |to:| (FNS PRINTMONTHIMAGE PRINT-NOTEBOOK-YEAR PRINT-SUMMARY-YEAR PRINT-SCALED-MONTH
)
|previous| |date:| "15-Jun-90 11:46:01"
|{DSK}<king>export>lispcore>internal>library>CALENDARHACKS.;1|)
; Copyright (c) 1987, 1990, 1994 by Venue & Xerox Corporation. All rights reserved.
(PRETTYCOMPRINT CALENDARHACKSCOMS)
(RPAQQ CALENDARHACKSCOMS
(
(* |;;| "Hacks for making reminder-book pages for calendars.")
(FILES CALENDAR)
(COMS
(* |;;| "User level functions")
(FNS PRINT-LAND-MONTH PRINT-LAND-YEAR PRINT-NOTEBOOK-MONTH PRINT-NOTEBOOK-YEAR
PRINT-SUMMARY-YEAR PRINT-NARROW-MONTH))
(COMS
(* |;;| "Internal functions and macros")
(FNS PRINT-SCALED-MONTH PRINTMONTHIMAGE)
(FUNCTIONS CAL-X CAL-Y))))
(* |;;| "Hacks for making reminder-book pages for calendars.")
(FILESLOAD CALENDAR)
(* |;;| "User level functions")
(DEFINEQ
(PRINT-LAND-MONTH
(LAMBDA (MONTH YEAR STREAM) (* \; "Edited 17-Oct-87 17:45 by jds")
(* |;;| "Print a single month's calendar landscape on letter paper.")
(LET ((PRINTSTREAM (OR STREAM (OPENIMAGESTREAM "{LPT}" 'INTERPRESS '(LANDSCAPE T)))))
(PRINT-SCALED-MONTH MONTH YEAR 635 635 1.0 1.0 PRINTSTREAM 12 18 6)
(CLOSEF PRINTSTREAM))))
(PRINT-LAND-YEAR
(LAMBDA (YEAR STREAM) (* \; "Edited 17-Oct-87 17:49 by jds")
(* |;;| "Print a single month's calendar landscape on letter paper.")
(LET ((PRINTSTREAM (OR STREAM (OPENIMAGESTREAM "{LPT}" 'INTERPRESS '(LANDSCAPE T)))))
(|for| MONTH |from| 1 |to| 12
|do| (PRINT-SCALED-MONTH MONTH YEAR 635 635 1.0 1.0 PRINTSTREAM 12 18 6)
(DSPNEWPAGE PRINTSTREAM))
(CLOSEF PRINTSTREAM))))
(PRINT-NOTEBOOK-MONTH
(LAMBDA (MONTH YEAR STREAM) (* \; "Edited 17-Sep-87 21:55 by jds")
(* |;;| "Print a single month's calendar on a half-sheet, suitable for punching and putting in a Time-Design notebook or a 5 1/2 x 8 1/2\" reminder book.")
(* |;;| "If you leave STREAM NIL, you'll get one page on the printer.")
(PRINT-SCALED-MONTH MONTH YEAR 0 0 0.75 0.6 STREAM)))
(PRINT-NOTEBOOK-YEAR
(LAMBDA (YEAR STREAM) (* \; "Edited 23-Mar-94 17:22 by turpiN:mv:envos")
(* |;;| "Print a year's worth of month-calendar pages in half-sheet size.")
(LET ((PRINTSTREAM (OR STREAM (OPENIMAGESTREAM "{LPT}" 'POSTSCRIPT))))
(|for| MONTH |from| 1 |to| 12 |do| (PRINT-SCALED-MONTH MONTH YEAR 0
(COND
((EVENP MONTH 2)
13970)
(T 0))
0.75 0.6 PRINTSTREAM)
(COND
((EVENP MONTH 2)
(DSPNEWPAGE PRINTSTREAM))))
(CLOSEF PRINTSTREAM))))
(PRINT-SUMMARY-YEAR
(LAMBDA (YEAR STREAM) (* \; "Edited 23-Mar-94 17:36 by turpiN:mv:envos")
(* |;;| "Print a year's worth of small months on 1 sheet of paper that will fit into a 8.25 x 10.5 format (for Time-Design books).")
(LET ((PRINTSTREAM (OR STREAM (OPENIMAGESTREAM "{LPT}" 'POSTSCRIPT '(LANDSCAPE T)))))
(|for| MONTH |from| 1 |to| 4 |as| YOFFSET |from| 44500 |by| -14800
|do| (PRINT-SCALED-MONTH MONTH YEAR 227 YOFFSET 0.33 0.23 PRINTSTREAM 6 8 6))
(|for| MONTH |from| 5 |to| 8 |as| YOFFSET |from| 44500 |by| -14800
|do| (PRINT-SCALED-MONTH MONTH YEAR 25427 YOFFSET 0.33 0.23 PRINTSTREAM 6 8 6))
(|for| MONTH |from| 9 |to| 12 |as| YOFFSET |from| 44500 |by| -14800
|do| (PRINT-SCALED-MONTH MONTH YEAR 50627 YOFFSET 0.33 0.23 PRINTSTREAM 6 8 6))
(CLOSEF PRINTSTREAM))))
(PRINT-NARROW-MONTH
(LAMBDA (MONTH YEAR STREAM) (* \; "Edited 17-Sep-87 22:32 by jds")
(PRINT-SCALED-MONTH MONTH YEAR 0 0 0.45 0.95 STREAM NIL NIL NIL '(LANDSCAPE T))))
)
(* |;;| "Internal functions and macros")
(DEFINEQ
(PRINT-SCALED-MONTH
(LAMBDA (MONTH YEAR X-OFFSET Y-OFFSET X-SCALE Y-SCALE STREAM DAYSIZE DATESIZE TINYSIZE OPTIONS)
(* \; "Edited 23-Mar-94 17:24 by turpiN:mv:envos")
(* |;;|
 "Print a month's calendar on STREAM. MONTH is a number 1-12, Year is the year, 19-- and all.")
(PROG ((STREAM-EXISTED STREAM)
PBIGFONT PCALFONT PLITTLEFONT)
(SETCURSOR WAITINGCURSOR)
(PRINTOUT PROMPTWINDOW T "Formatting for print...")
(SETQ STREAM (OR STREAM (OPENIMAGESTREAM "{LPT}" 'POSTSCRIPT OPTIONS)))
(SETQ PBIGFONT (FONTCREATE 'MODERN (OR DAYSIZE 8)
NIL 0 STREAM))
(SETQ PCALFONT (FONTCREATE 'CLASSIC (OR DATESIZE 12)
NIL 0 STREAM))
(SETQ PLITTLEFONT (FONTCREATE 'MODERN (OR TINYSIZE 6)
NIL 0 STREAM))
(PRINTMONTHIMAGE MONTH YEAR STREAM X-OFFSET Y-OFFSET X-SCALE (OR Y-SCALE X-SCALE)
PBIGFONT PCALFONT PLITTLEFONT) (* \; "Print horizontal lines")
(OR STREAM-EXISTED (CLOSEF STREAM))
(PRINTOUT PROMPTWINDOW "done." T)
(CURSOR T))))
(PRINTMONTHIMAGE
(LAMBDA (MONTH YEAR STREAM XOFFSET YOFFSET X-SCALE Y-SCALE DAYFONT DATEFONT TINYDATEFONT)
(* \; "Edited 23-Mar-94 17:42 by turpiN:mv:envos")
(* |;;|
 "Print a month's calendar on STREAM. MONTH is a number 1-12, Year is the year, 19-- and all.")
(* |;;|
 " X-SCALE & XOFFSET, and Y-SCALE & YOFFSET are used in the CAL-X and CAL-Y macros, resp.")
(* |;;| "DAYFONT and DATEFONT are used for printing the day names and dates/month title resp.")
(DSPRESET STREAM)
(DSPRIGHTMARGIN 65535 STREAM)
(LET ((TITLESTRING (CONCAT (MONTHNAME MONTH)
" " YEAR)))
(MOVETO (- (CAL-X 37559)
(IQUOTIENT (STRINGWIDTH TITLESTRING DATEFONT)
2))
(CAL-Y 57827)
STREAM))
(DSPFONT DATEFONT STREAM)
(PRINTOUT STREAM (MONTHNAME MONTH)
" " YEAR)
(LET ((DAYLABELS (APPEND (|for| N |from| 1 |to| (DAYOF MONTH 1 YEAR)
|collect| '\ )
(|for| N |from| 1 |to| (DAYSIN MONTH YEAR) |collect|
N)))
(X 1559)
(Y 47339)
(CT 0))
(|for| I |in| DAYLABELS |do|
(* |;;| "Print blanks up to the first day of the month (to allow for not starting on Sunday), then print the dates.")
(MOVETO (CAL-X X)
(CAL-Y Y)
STREAM)
(PRIN1 I STREAM)
(|add| X 10630)
(|add| CT 1)
(COND
((EQ (IREMAINDER CT 7)
0)
(SETQ X 1701)
(|add| Y -8974)))))
(|for| X |from| 850 |to| 75968 |by| 10630 |do|
(* |;;| "Print vertical lines")
(DRAWLINE (CAL-X X)
(CAL-Y 1701)
(CAL-X X)
(CAL-Y 55559)
40
'PAINT STREAM))
(|for| Y |from| 1701 |to| 55559 |by| 8974 |do|
(* |;;|
 "Print horizontal lines")
(DRAWLINE (CAL-X 850)
(CAL-Y Y)
(CAL-X 75260)
(CAL-Y Y)
40
'PAINT STREAM))
(DSPFONT DAYFONT STREAM)
(|for| X |from| 2268 |to| 72567 |by| 10630 |as| D |from| 0 |to|
6
|do|
(* |;;| "Print day names")
(MOVETO (CAL-X X)
(CAL-Y 56126)
STREAM)
(PRIN1 (DAYNAME D)
STREAM))
(COND
((>= X-SCALE 0.7)
(DSPFONT PLITTLEFONT STREAM)
(SHOWMONTHSMALL (MONTHPLUS MONTH -1)

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View File

@@ -1,374 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "16-Nov-94 16:28:04" |{DSK}<lispcore>internal>library>MULTI-COMPILE.;4| 37236
|changes| |to:| (VARS MULTI-COMPILECOMS)
(FNS FIND-UNCOMPILED-FILES)
|previous| |date:| " 9-Sep-94 13:03:19" |{DSK}<lispcore>internal>library>MULTI-COMPILE.;3|)
; Copyright (c) 1988, 1990, 1991, 1992, 1993, 1994 by Venue & Xerox Corporation. All rights reserved.
(PRETTYCOMPRINT MULTI-COMPILECOMS)
(RPAQQ MULTI-COMPILECOMS
(
(* |;;| "Support for compiling multiple files in one pass, for a bulk recompilation of the system (or some part of it).")
(COMS (* \; "Function to compile multiple files without having one step on the next (so you could compile all the system with it).")
(FUNCTIONS BIGCOMP))
(COMS (* \; "Function to identify all the source files on a given directory (useful for creating lists of things to compile)")
(FUNCTIONS FIND-ALL-SOURCE-FILES)
(FNS FIND-UNCOMPILED-FILES))
(COMS (* \;
 "Misc utility functions from the big Lyric recompiles.")
(FNS NEWERDCOMS? NEWERSOURCES? SETUP-FOR-RECOMPILE SMASH-OPCODES GET-DIRECTORY-LISTING
GET-OPEN-FILES)
(* |;;| "Control variables")
(VARS FILES-IN-FULL.SYSOUT FILES-IN-LIBRARY FILES-IN-LISP.SYSOUT FILES-IN-SOURCES
FORKED-FILES GARBAGE-OPCODES))
(COMS (* \;
 "Utilities for making mass-scale fixups to a library of files.")
(FNS FIX-FILES FIX-FILE FIX-COPYRIGHT FIX-FILE-COPYRIGHT QUALIFY-FIELDS FIX-TEDIT
FIX-DOCS))
(* |;;| "Removes bogus (CLISP <clisp xlation> <real-code>) translations that result from CLISPARRAY being NIL.")
(FNS CLFIX)
(PROP FILETYPE MULTI-COMPILE)
(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA FIX-FILES)))))
(* |;;|
"Support for compiling multiple files in one pass, for a bulk recompilation of the system (or some part of it)."
)
(* \;
"Function to compile multiple files without having one step on the next (so you could compile all the system with it)."
)
(CL:DEFUN BIGCOMP (FILENAMES SOURCEDIRS DESTDIR &OPTIONAL (DRIBBLE-FILE '"{DSK}BIGCOMP.DRIBBLE")
DELETE-DCOMS? DELETE-DRIBBLE?)
(* |;;| "Compile all the files in the system.")
(LET ((COMPLETION 'ERROR)
(NUM-FILES (LENGTH FILENAMES)))
(IDLE.SET.OPTION 'TIMEOUT T) (* \; "never idle")
(SETQ NOSPELLFLG T) (* \; "death to DWIM!")
(SETQ DWIMIFYCOMPFLG NIL) (* \; "I mean it")
(* |;;| "do it")
(CL:UNWIND-PROTECT
(PROGN (DRIBBLE DRIBBLE-FILE)
(WINDOWPROP (WFROMDS (TTYDISPLAYSTREAM))
'PAGEFULLFN
'NILL)
(PRINTOUT NIL "= = = = = Setting up for full-system compilation run on " (DATE)
" = = = = =" T T)
(|for| FILE |in| FILENAMES |as| FILE-NUM |from| 1
|do| (DSPNEWPAGE (GETSTREAM NIL 'OUTPUT))
(* |;;| "changed the destfile so it has the proper extension. It was compiling everything correctly, but naming all the files .lcom.")
(LET* ((CF (COMPILE-FILE? FILE))
(SOURCEFILE (FINDFILE FILE NIL SOURCEDIRS))
(DESTFILE (PACKFILENAME 'BODY FILE 'DIRECTORY DESTDIR 'EXTENSION
(SELECTQ CF
(CL:COMPILE-FILE
'DFASL)
'LCOM))))
(RESETLST
(RESETSAVE (RESETUNDO))
(PRINTOUT NIL T "- - - " (OR CF 'BCOMPL)
"'ing file " SOURCEFILE " to " DESTFILE " at " (DATE)
" - - -" T)
(PRINTOUT NIL T "(File number " FILE-NUM " of " NUM-FILES ": "
(- NUM-FILES FILE-NUM)
" left)" T T)
(PRINT (SELECTQ CF
((BCOMPL TCOMPL NIL)
(LISPXUNREAD '(F))
(CL:FUNCALL (OR CF 'BCOMPL)
SOURCEFILE DESTFILE))
(CL:FUNCALL CF SOURCEFILE :OUTPUT-FILE DESTFILE))
T)
(PRINTOUT NIL T T "- - - End of " FILE " compilation - - -" T))
(AND DELETE-DCOMS? (DELFILE DESTFILE))))
(PRINTOUT NIL T T T "= = = = = END OF FULL-SYSTEM COMPILATION RUN = = = = =")
(SETQ COMPLETION 'SUCCESS))
(* |;;| "cleanup forms")
(PRINTOUT NIL T "Compilation status: " COMPLETION T T)
(DRIBBLE)
(WINDOWPROP (WFROMDS (TTYDISPLAYSTREAM))
'PAGEFULLFN NIL))
(SEND.FILE.TO.PRINTER DRIBBLE-FILE)
(AND DELETE-DRIBBLE? (DELFILE DRIBBLE-FILE))))
(* \;
"Function to identify all the source files on a given directory (useful for creating lists of things to compile)"
)
(CL:DEFUN FIND-ALL-SOURCE-FILES (DIRECTORY)
(* |;;| "Return a list of every file that has a compiled equivalent on DIRECTORY. This is a way of finding out what needs to be recompiled for a bulk compile.")
(LET ((DFASLS (FOR FILENAME IN (DIRECTORY (PACKFILENAME 'DIRECTORY DIRECTORY 'BODY
"*.DFASL;"))
COLLECT (UNPACKFILENAME FILENAME 'NAME)))
(LCOMS (FOR FILENAME IN (DIRECTORY (PACKFILENAME 'DIRECTORY DIRECTORY 'BODY
"*.LCOM;"))
COLLECT (UNPACKFILENAME FILENAME 'NAME))))
(UNION (INTERSECTION DFASLS DFASLS)
(INTERSECTION LCOMS LCOMS))))
(DEFINEQ
(FIND-UNCOMPILED-FILES
(LAMBDA (SRCDIR DESTDIR) (* \; "Edited 16-Nov-94 16:23 by jds")
(LET ((SRCFILES (DIRECTORY (PACKFILENAME 'DIRECTORY SRCDIR 'BODY '*.\;)))
SFILE DFILE)
(|for| FILE |in| SRCFILES |do| (SETQ SFILE (UNPACKFILENAME FILE 'NAME))
(COND
((AND (SETQ DFILE (FINDFILE-WITH-EXTENSIONS
SFILE
(LIST DESTDIR)
'(DFASL LCOM)))
(ILESSP (GETFILEINFO DFILE 'ICREATIONDATE)
(GETFILEINFO FILE 'ICREATIONDATE)))
(PRINTOUT T FILE " needs compiling." T))
((NOT DFILE)
(PRINTOUT T FILE " has no compiled version." T))
)))))
)
(* \; "Misc utility functions from the big Lyric recompiles.")
(DEFINEQ
(NEWERDCOMS?
(LAMBDA (DIRPAIRS EXTENSIONS FILTER) (* \; "Edited 9-Dec-86 21:39 by bvm")
(OR DIRPAIRS (SETQ DIRPAIRS '(({ERIS}<LISPCORE>NEWSTRING>SOURCES> {ERIS}<LISPCORE>SOURCES>)
({ERIS}<LISPCORE>NEWSTRING>LIBRARY> {ERIS}<LISPCORE>LIBRARY>)
({ERIS}<LISPCORE>NEWSTRING>INTERNAL>LIBRARY>
{ERIS}<LISPCORE>INTERNAL>LIBRARY>))))
(OR EXTENSIONS (SETQ EXTENSIONS '(LCOM DCOM)))
(|for| PAIR |in| DIRPAIRS
|join| (RESETLST
(LET ((THISDIR (CAR PAIR))
(OTHERDIR (CADR PAIR))
(THISEXT (CAR EXTENSIONS))
(OTHEREXT (CADR EXTENSIONS))
NEXT DT OTHERFILE OTHERDT OTHERWDT THISAUTHOR DIRPRINTED GEN)
(SETQ GEN (\\GENERATEFILES (PACKFILENAME.STRING 'DIRECTORY THISDIR
'NAME "*" 'EXTENSION THISEXT
'VERSION "")
'(ICREATIONDATE)
'(RESETLST)))
(|while| (SETQ NEXT (\\GENERATENEXTFILE GEN)) |eachtime|
(SETQ OTHERWDT NIL)
|when| (AND (SETQ OTHERFILE (INFILEP (PACKFILENAME.STRING
'DIRECTORY OTHERDIR
'EXTENSION OTHEREXT
'VERSION NIL 'BODY NEXT)))
(SETQ DT (\\GENERATEFILEINFO GEN 'ICREATIONDATE))
(OR (AND (SETQ OTHERDT (GETFILEINFO OTHERFILE
'ICREATIONDATE))
(< DT OTHERDT))
(AND (SETQ OTHERWDT (GETFILEINFO OTHERFILE
'IWRITEDATE))
(< DT OTHERWDT)))
(OR (NULL FILTER)
(CL:FUNCALL FILTER NEXT OTHERFILE DT OTHERDT
OTHERWDT GEN)))
|collect| (|if| (NOT DIRPRINTED)
|then| (|printout| T T " " THISDIR 18
"This Date" 38 "Other Date" 58
"Author" T)
(SETQ DIRPRINTED T))
(|printout| T (SUBSTRING NEXT
(STRPOS THISDIR NEXT 1 NIL T T
UPPERCASEARRAY))
18
(GDATE DT)
38
(GDATE OTHERDT)
58)
(|if| OTHERWDT
|then| (|printout| T (GDATE OTHERWDT)
" "))
(|printout| T (GETFILEINFO OTHERFILE 'AUTHOR)
T)
(FILENAMEFIELD NEXT 'NAME)))))))
(NEWERSOURCES?
(LAMBDA (DIRPAIRS FILTER) (* \; "Edited 9-Dec-86 23:07 by bvm")
(OR DIRPAIRS (SETQ DIRPAIRS '(({ERIS}<LISPCORE>NEWSTRING>SOURCES> {ERIS}<LISPCORE>SOURCES>)
({ERIS}<LISPCORE>NEWSTRING>LIBRARY> {ERIS}<LISPCORE>LIBRARY>)
({ERIS}<LISPCORE>NEWSTRING>INTERNAL>LIBRARY>
{ERIS}<LISPCORE>INTERNAL>LIBRARY>))))
(|for| PAIR |in| DIRPAIRS
|do| (RESETLST
(LET ((THISDIR (CAR PAIR))
(OTHERDIR (CADR PAIR))
NEXT DT THISFILE THISDT WDT DIRPRINTED GEN)
(SETQ GEN (\\GENERATEFILES (PACKFILENAME.STRING 'DIRECTORY OTHERDIR
'NAME "*" 'VERSION "")
'(ICREATIONDATE IWRITEDATE AUTHOR)
'(RESETLST)))
(|while| (SETQ NEXT (\\GENERATENEXTFILE GEN))
|eachtime| (SETQ THISDT (SETQ WDT (SETQ DT NIL)))
|when| (AND (SETQ DT (\\GENERATEFILEINFO GEN 'ICREATIONDATE))
(OR (NULL (SETQ THISFILE (INFILEP (PACKFILENAME.STRING
'DIRECTORY THISDIR
'EXTENSION COMPILE.EXT
'VERSION NIL
'BODY NEXT))))
(AND (SETQ THISDT (GETFILEINFO THISFILE
'ICREATIONDATE))
(OR (> DT THISDT)
(AND (SETQ WDT (\\GENERATEFILEINFO
GEN
'IWRITEDATE))
(> WDT THISDT)))))
(OR (NULL FILTER)
(CL:FUNCALL FILTER NEXT THISFILE DT WDT THISDT GEN)))
|do| (|if| (NOT DIRPRINTED)
|then| (|printout| T T " " OTHERDIR 18 " Its Date" 38
" Other Date" 58 "Author" T)
(SETQ DIRPRINTED T))
(OR (GET (NAMEFIELD NEXT)
'FILEDATES)
(PRIN1 "+" T))
(|printout| T (SUBSTRING NEXT
(STRPOS OTHERDIR NEXT 1 NIL T T UPPERCASEARRAY
))
18
(GDATE DT)
38
(|if| THISDT
|then| (GDATE THISDT)
|else| " - - -")
58)
(|if| WDT
|then| (|printout| T (GDATE WDT)
" "))
(|printout| T (\\GENERATEFILEINFO GEN 'AUTHOR)
T)))))))
(SETUP-FOR-RECOMPILE
(LAMBDA NIL (* \; "Edited 8-Dec-86 21:23 by jop:")
(* \;
 "So we don't get alot of warnings")
(SETQ *REMOVE-INTERLISP-COMMENTS* NIL) (* \;
 "So we don't get asked stupid questions")
(SETQ CROSSCOMPILING T) (* \;
 "setup up new compiled file version")
(PUTPROP ':D4 'CODEREADER (COPYALL (GETPROP 'D1 'CODEREADER)))
(RPAQQ CODEINDICATOR :D4)
(RPAQQ COMPILE.EXT LCOM) (* \;
 "Smash garbage collectable opcodes")
(SMASH-OPCODES GARBAGE-OPCODES) (* \; "Setup for unwind recompile")
(LOAD '{ERIS}<LISPCORE>NEWSTRING>SOURCES>UNWINDMACROS 'SYSLOAD)
(* \; "may not be necessary")
(LOAD '{ERIS}<LISPCORE>NEWSTRING>SOURCES>PROC 'PROP) (* \; "Setup for new string recompile")
(LOAD '{ERIS}<LISPCORE>NEWSTRING>SOURCES>LLCHAR 'PROP)
(REMPROP 'STRINGP 'DOPVAL) (* \; "to get correct record def's")
(LOAD '{ERIS}<LISPCORE>SOURCES>CMLARRAY 'PROP) (* \; "Setup for new stream record")
(LOAD '{ERIS}<LISPCORE>NEWSTRING>SOURCES>FILEIO 'PROP) (* \;
 "To setup packagified global type number vars")
(LOAD '{ERIS}<LISPCORE>NEWSTRING>SOURCES>DTDECLARE.DCOM 'SYSLOAD)
(* \;
 "hack for typep - not needed if makesysdate > Nov 23")
(CL:DEFTYPE :DATATYPE (OBJECT)
`(DATATYPE ,OBJECT)) (* \; "dribble hack")
(WBREAK NIL) (* \; "So the debuuger will compile")
(LOAD '{ERIS}<LISPCORE>SOURCES>XCL-PACKAGE.DCOM) (* \; "To fix the broken FP printer")
(LOADFNS '\\CONVERT.FLOATING.NUMBER '{ERIS}<LISPCORE>SOURCES>LLFLOAT.DCOM)))
(SMASH-OPCODES
(LAMBDA (OPCODE-ALIST) (* \; "Edited 24-Nov-86 17:56 by jop:")
(LET (OPNUMBER)
(CL:DOLIST (OPCODE OPCODE-ALIST)
(SETQ OPNUMBER (CADR OPCODE))
(CL:NSUBSTITUTE-IF (LIST OPNUMBER ':UNUSED)
(FUNCTION (CL:LAMBDA (OP)
(EQL (CAR OP)
OPNUMBER)))
\\OPCODES :COUNT 1)
(SETQ \\OPCODEARRAY NIL)))))
(GET-DIRECTORY-LISTING
(LAMBDA (DIRECTORY EXTENSION) (* \; "Edited 24-Nov-86 18:14 by jop:")
(|for| X |infiles| (DIRECTORY.FILL.PATTERN DIRECTORY (OR EXTENSION "")
"") |collect| (FILENAMEFIELD X 'NAME))))
(GET-OPEN-FILES
(LAMBDA (DEVICE-NAME) (* \; "Edited 25-Nov-86 18:16 by jop:")
(FETCH (FDEV OPENFILELST) OF (CDR (ASSOC DEVICE-NAME \\DEVICENAMETODEVICE)))))
)
(* |;;| "Control variables")
(RPAQQ FILES-IN-FULL.SYSOUT
(PACKAGE-STARTUP LLPACKAGE LLSYMBOL CMLARRAY CMLLIST CMLMACROS DMISC COMPATIBILITY APUTDQ
LLDISPLAY FONT PASSWORDS LEAF PUP LLETHER PROC ERROR-RUNTIME DEFSTRUCT-RUN-TIME
BOOTSTRAP MISC AINTERRUPT AERROR ABASIC APRINT ATERM MOD44IO VANILLADISK PMAP ADIR AOFD
COREIO IOCHAR LLCODE ATBL DTDECLARE ASTACK LLTIMER LLKEY LLDATATYPE LLSTK LLCHAR LLREAD
LLBIGNUM LLFLOAT LLARITH LLARRAYELT LLMVS LLINTERP LLGC LLBASIC IMAGEIO FILEIO LLNEW
LLBFS LLSUBRS LLFAULT PACKAGE-CONVERSION-TABLE ACODE MACHINEINDEPENDENT POSTLOADUP
DEFPACKAGE-IMPORT XCL-PACKAGE LISP-PACKAGE FASL-PACKAGE COMPILER-PACKAGE BSP DPUPFTP
CMLCHARACTER CMLREADTABLE STACKFNS CMLMVS MACROS MACROAUX CMLSYMBOL CMLHASH CMLDEFFER
CMLPROGV CMLEVAL COMMON CMLSPECIALFORMS CONDITION-HIERARCHY XCLC-RUNTIME CMLTYPES
CL-ERROR AFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF FONTPROFILE SPELLFILE PRINTFN
ADVISE LOADFNS DIRECTORY FILEPKG RESOURCE DLAP BYTECOMPILER COMPILE HIST UNDO SPELL
DWIM WTFIX CLISP DWIMIFY CLISPIFY RECORD ASSIST ASKUSER CMLUNDO CMLEXEC DEBUGGER TRACE
CMLDOC CMLPARSE CMLSETF CMLPRED CMLARRAY-OPTIMIZERS CMLREAD CMLWALK CMLSEQCOMMON
CMLSEQBASICS CMLSEQMAPPERS CMLSEQMODIFY CMLSEQFINDER CMLSORT CMLSEQ CMLARITH DEFSTRUCT
CMLMISCIO CMLCOMPILE CMLSTRING CLSTREAMS CMLDESTRUCT CMLFORMAT CMLENVIRONMENT CMLPRINT
CMLLOAD CMLFILESYS CMLFLOAT CMLTIME CMLRAND CMLMODULES ADDARITH READ-PRINT-PROFILE
CMLPATHNAME HPRINT MSANALYZE MSPARSE MASTERSCOPE AARITH ADISPLAY HLDISPLAY MENU
WINDOWOBJ WINDOWSCROLL WINDOW WINDOWICON ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT
TWODINSPECTOR FREEMENU CMLARRAYINSPECTOR EDITINTERFACE TTYIN DISKDLION DOVEINPUTOUTPUT
DOVEDISK DOVEDISPLAY DOVEMISC DOVEETHER DOVEFLOPPY LOCALFILE DSKDISPLAY 10MBDRIVER LLNS
TRSERVER SPP COURIER NSPRINT CLEARINGHOUSE NSFILING HARDCOPY INTERPRESS FLOPPY IDLER
ICONW SEDIT-ATOMIC SEDIT-COMMANDS SEDIT-COMMENTS SEDIT-LINEAR SEDIT-LISTS
SEDIT-TERMINAL SEDIT-TOPLEVEL SEDIT-WINDOW SEDIT D-ASSEM-PACKAGE D-ASSEM FASL
XCLC-READER XCLC-ENV-CTXT XCLC-TREES XCLC-TOP-LEVEL XCLC-ALPHA XCLC-ANALYZE
XCLC-META-EVAL XCLC-ANNOTATE XCLC-GENCODE XCLC-PEEPHOLE XCLC-DATABASE XCL-COMPILER
CMLPACKAGE GIVE-AND-TAKE CHATTERMINAL DMCHAT CHAT PUPCHAT NSCHAT PRESS PUPPRINT
TEDITDECLS TEXTOFD TEDITCOMMAND TEDITSCREEN TEDITABBREV TEDITLOOKS TEDITFIND
TEDITHISTORY TEDITFILE TEDITWINDOW TEDITSELECTION READNUMBER EDITBITMAP IMAGEOBJ
TFBRAVO TEDITHCPY TEDITPAGE TEDITMENU TEDITFNKEYS TEDIT HRULE TEDITCHAT GRAPEVINE
MAILCLIENT NSMAIL LAFITEBROWSE LAFITESEND LAFITEMAIL LAFITE TABLEBROWSER FILEBROWSER
REMOTEVMEM VMEM READSYS RDSYS TELERAID GRAPHER SPY AREDIT HASH WHEREIS COPYFILES))
(RPAQQ FILES-IN-LIBRARY
(4045XLPDEFAULTPRINTER 4045XLPSTREAM ARCLEANUP AREDIT BROWSER BSEARCH CENTRONICS
CHARCODETABLES CHAT CHATDECLS CHATTERMINAL CLMAIL CML CMLARRAYINSPECTOR CMLDEBUGGER
CMLFLOATARRAY CMLHELP COLOR COLORDEMO CONDITIONGRAPH COPYFILES DANDELIONKEYBOARDS
DATABASEFNS DAYBREAKKEYBOARDS DEDIT DES DICOLOR DINFO DLRS232C DLTTY DMCHAT DO-TEST
DORADOCOLOR DORADOKEYBOARDS DOVEKEYBOARDS DOVERS232C DSKTEST EDITBITMAP ETHERRECORDS
FASTFX80STREAM FILEBROWSER FILECACHE FILECACHE-BROWSER FILECACHE-DECLS FILECACHE-HOSTUP
FILECACHE-SCAVENGE FILENAMES FONTSAMPLE FTPSERVER FX80STREAM FXPRINTER GCHAX
GIVE-AND-TAKE GRAPEVINE GRAPHER GRAPHZOOM HASH HELPSYS HRULE IMAGEOBJ KERMIT KERMITMENU
KEYBOARDEDITOR LAFITE LAFITEBROWSE LAFITEDECLS LAFITEFIND LAFITEMAIL LAFITESEND

View File

@@ -1,920 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "23-Jun-88 16:06:34" {ERIS}<TEST>GC>HAND>MAIKO-GC-TESTS.\;6 46489
|changes| |to:| (VARS MAIKO-GC-TESTSCOMS)
(FNS MAIN-GC-TEST ARRAY-STRING-TEST VARIOUS-TYPES-TEST LIST-MANIPULATION-TEST
CODE-RECLAIM-TEST)
|previous| |date:| "27-May-88 14:59:01" {ERIS}<TEST>GC>HAND>MAIKO-GC-TESTS.\;5)
; Copyright (c) 1988 by John Sybalsky & Xerox Corporation. All rights reserved.
(PRETTYCOMPRINT MAIKO-GC-TESTSCOMS)
(RPAQQ MAIKO-GC-TESTSCOMS
((FILES DANCEROBJ GCHAX)
(ADDVARS (DISPLAYFONTDIRECTORIES "{ERIS}<TEST>GC>HAND-AUX>"
"{ERIS}<LISPCORE>XEROXPRIVATE>FONTS>")
(INTERPRESSFONTDIRECTORIES "{ERIS}<TEST>GC>HAND-AUX>"
"{ERIS}<LISPCORE>XEROXPRIVATE>FONTS>"))
(P (SETQ DISPLAYFONTEXTENSIONS '(DISPLAYFONT AC STRIKE)))
(FNS MAIN-GC-TEST)
(FNS ITEMS-ON-STACK-TEST MANY-BIGNUM-MAKER MANY-FIXP-MAKER MANY-FLOAT-MAKER BOUNDARY-TESTS
ARRAY-STRING-TEST VARIOUS-TYPES-TEST)
(FNS TEDIT-CRUNCH-TEST LIST-MANIPULATION-TEST)
(FNS ATOM-FULL-TEST STORAGE-FULL-TEST)
(COMS (FNS DATATYPE-TEST)
(RECORDS GC-TEST-TYPE)
(* |;;| "DATATYPE TESTS")
)
(COMS
(* |;;| "CODE RECLAIMATION TESTS")
(FNS CODE-RECLAIM-TEST)
(* |;;| "The function that is repeatedly compiled to test that code-block constants inside code blocks are reclaimed.")
(VARS (CODE-RECLAIM-TEST-TEMP-FN
'(DEFINEQ (CODE-RECLAIM-TEST-TEMP-FN
(ASDF)
(LET (I)
(FOR I FROM 1 TO 10 COLLECT (SQRT 4.5))
(ERSETQ (DATE))
(NLSETQ (DATE))
(ERSETQ (DATE))
(NLSETQ (DATE))
(ERSETQ (DATE))
(CL:FLET ((TEMP (ARG)
(SETQ ARG (FLOAT ARG))
(EXPT (SQRT I)
(SQRT (COS (/ I 180))))))
(CL:UNWIND-PROTECT
(FOR I FROM 1 TO 1000 COLLECT (TEMP I))
(SETQ I NIL)))))))))))
(FILESLOAD DANCEROBJ GCHAX)
(ADDTOVAR DISPLAYFONTDIRECTORIES "{ERIS}<TEST>GC>HAND-AUX>" "{ERIS}<LISPCORE>XEROXPRIVATE>FONTS>")
(ADDTOVAR INTERPRESSFONTDIRECTORIES "{ERIS}<TEST>GC>HAND-AUX>"
"{ERIS}<LISPCORE>XEROXPRIVATE>FONTS>")
(SETQ DISPLAYFONTEXTENSIONS '(DISPLAYFONT AC STRIKE))
(DEFINEQ
(MAIN-GC-TEST
(LAMBDA (LIMIT DRIBBLE-FILE STACK-COUNT BIGNUM-COUNT FIXP-COUNT FLOAT-COUNT TEDIT-COUNT LIST-COUNT
CODE-COUNT) (* \; "Edited 23-Jun-88 13:30 by jds")
(DRIBBLE (OR DRIBBLE-FILE "{LPT}"))
(PRINTOUT T ";;; ***********" T ";;; MAIKO GARBAGE COLLECTOR TESTS" T ";;; Run on " (DATE)
T ";;; Dribble to " (OR DRIBBLE-FILE "{LPT}")
T T)
(|for| I |from| 1 |to| (OR LIMIT 10) |do| (PRINTOUT T
"Starting Maiko GC tests, pass "
I T)
(ITEMS-ON-STACK-TEST (OR STACK-COUNT
100))
(MANY-BIGNUM-MAKER (OR BIGNUM-COUNT
1000))
(MANY-FIXP-MAKER (OR FIXP-COUNT 1000))
(MANY-FLOAT-MAKER (OR FLOAT-COUNT 1000
))
(TEDIT-CRUNCH-TEST (OR TEDIT-COUNT 5))
(ARRAY-STRING-TEST 3)
(LIST-MANIPULATION-TEST (OR LIST-COUNT
5))
(BOUNDARY-TESTS)
(CODE-RECLAIM-TEST (OR CODE-COUNT 20))
(VARIOUS-TYPES-TEST (OR TYPE-COUNT 10)
)
(FRPTQ 100 (RECLAIM))
(STORAGE))
(ATOM-FULL-TEST)
(STORAGE-FULL-TEST)
(DRIBBLE NIL)))
)
(DEFINEQ
(ITEMS-ON-STACK-TEST
(LAMBDA (LIMIT) (* \; "Edited 25-May-88 11:56 by jds")
(PRINTOUT T " Starting ITEMS-ON-STACK test for " LIMIT " iterations." T)
(FOR I FROM 1 TO LIMIT DO (LET ((X (CREATE CHARLOOKS))
(Y (EXPT 1234.5 (RAND 3 7))))
(ERSETQ (FRPTQ 5 (RECLAIM))
(COND
((\\ISONFREELIST X)
(HELP
"X is free, but pointer is on stack."
))
((\\ISONFREELIST Y)
(HELP
"Y is free, but pointer is on stack."
))))))))
(MANY-BIGNUM-MAKER
(LAMBDA (LIMIT) (* \; "Edited 25-May-88 11:54 by jds")
(PRINTOUT T " Starting MANY-BIGNUM-MAKER test for " LIMIT " iterations." T)
(LET (X Y Z W)
(FOR I FROM 1 TO LIMIT DO (SETQ X (CL:* 12345678901234567890
(RAND 1 I)))
(SETQ Y (IQUOTIENT X 3))
(SETQ Z (IPLUS Y X X 34 2 9 (IMOD X 7)
(IREMAINDER Y 3)
(CL:FLOOR Y 2)
(CL:CEILING X 8)))
(SETQ W (/ Z Y))))))
(MANY-FIXP-MAKER
(LAMBDA (LIMIT) (* \; "Edited 25-May-88 11:54 by jds")
(PRINTOUT T " Starting MANY-FIXP-MAKER test for " LIMIT " iterations." T)
(LET (X Y Z W)
(FOR I FROM 1 TO LIMIT DO (SETQ X (CL:* 543 (RAND 1 I)))
(SETQ Y (IQUOTIENT X 3))
(SETQ Z (IPLUS Y X X 34 2 9 (IMOD X 7)
(IREMAINDER Y 3)
(CL:FLOOR Y 2)
(CL:CEILING X 8)))
(SETQ W (/ Z Y))))))
(MANY-FLOAT-MAKER
(LAMBDA (LIMIT) (* \; "Edited 25-May-88 11:55 by jds")
(PRINTOUT T " Starting MANY-FLOAT-MAKER test for " LIMIT " iterations." T)
(LET (X Y Z W)
(FOR I FROM 1 TO LIMIT DO (SETQ X (FTIMES 1.0 (RAND 0 1)))
(SETQ Y (+ (SQRT I)
(EXPT (SQRT (SQRT I))
3.4)))
(SETQ Z (LOG Y))))))
(BOUNDARY-TESTS
(LAMBDA NIL (* \; "Edited 26-May-88 11:54 by jds")
(* |;;| "Tests the transition into and out of big refcnts, and BIG refcnt's.")
(PRINTOUT T " Starting Refcnt-63 crossing test" T)
(LET* ((ITEM (|create| FMTSPEC))
(LIST (|for| I |from| 1 |to| 62 |collect| ITEM)))
(|for| I |from| 1 |to| 1000 |do| (|for| J |from| (LENGTH LIST)
|to| (+ 63 (RAND 1 10))
|do| (SETQ LIST (CONS ITEM LIST)))
(|for| J |from| (LENGTH LIST)
|to| (- 63 (RAND 3 12))
|do| (|pop| LIST))
(COND
((ZEROP (IMOD I 31))
(RECLAIM))))
(PRINTOUT T " Starting Refcount-500K <-> NIL test." T)
(|for| LOOP |from| 1 |to| 10 |do| (|for| I |from| 1 |to| 500000
|do| (SETQ LIST (CONS ITEM LIST)))
(SETQ LIST NIL))
(PRINTOUT T " Starting Refcount 1-2 boundary test." T)
(LET ((ITEM (LIST (|create| FMTSPEC))))
(|for| I |from| 1 |to| 5000 |do| (SETQ ITEM2 (CAR ITEM))
(SETQ ITEM2 NIL)))
(PRINTOUT T " Starting Refcount 1 + stack boundary test." T)
(LET ((ITEM (|create| FMTSPEC))
ITEM2)
(|for| I |from| 1 |to| 5000 |do| (SETQ ITEM2 (LIST ITEM))
(RPLACA ITEM2 NIL)))
(PRINTOUT T " Starting Refcount 0-1 boundary test." T)
(LET (ITEM)
(|for| I |from| 1 |to| 5000 |do| (SETQ ITEM (LIST (|create|
FMTSPEC)))
(RPLACA ITEM NIL))))))
(ARRAY-STRING-TEST
(LAMBDA (LIMIT REAL-STRESS) (* \; "Edited 23-Jun-88 12:23 by jds")
(* |;;| "Try out array & string creation, and substringing on the GC.")
(PRINTOUT T " Starting Array & String test." T)
(FOR I FROM 1 TO (OR LIMIT 10)
DO (LET (STRINGS ARRAYS)
(FOR ARRAY-COUNT FROM 1 TO 5000
COLLECT (CL:MAKE-ARRAY (RAND 10 (COND
(REAL-STRESS 65000)
(T (IMAX 100 (IQUOTIENT 65000
ARRAY-COUNT)))))))
(FOR I FROM 1 TO 5000 COLLECT (BITMAPCREATE (RAND 1 512)
(RAND 1 512)))
(SETQ STRINGS (FOR STRING-COUNT FROM 1 TO 5000
COLLECT (ALLOCSTRING (RAND 10
(COND
(REAL-STRESS 65000)
(T (IMAX 100 (IQUOTIENT 65000
STRING-COUNT
))))))))
(FOR STRING IN STRINGS
COLLECT (SUBSTRING STRING (RAND 1 (LRSH (NCHARS STRING)
1))
(RAND (ADD1 (LRSH (NCHARS STRING)
1))
(NCHARS STRING))))))))
(VARIOUS-TYPES-TEST
(LAMBDA (LIMIT) (* \; "Edited 23-Jun-88 12:04 by jds")
(* |;;|
 "Run thru creation and collection of various types that have caused trouble in the past. ")
(PRINTOUT T " Starting various type cases." T)
(FOR REPEAT-COUNT FROM 1 TO (OR LIMIT 10)
DO (|for| TYPE IN '(VMEMPAGEP) AS CREATION-LIMIT IN '(100)
|do| (FOR I FROM 1 TO CREATION-LIMIT COLLECT (NCREATE TYPE))
(DORECLAIM)))))
)
(DEFINEQ
(TEDIT-CRUNCH-TEST
(LAMBDA (LIMIT) (* \; "Edited 27-May-88 13:06 by jds")
(* |;;| "GC Testing -- stressing the world.")
(* |;;| "Hardcopy a big TEdit file to a {CORE} file, copy that to disk, and delete everything.")
(PRINTOUT T " Starting TEDIT-CRUNCH test for " LIMIT " iterations." T)
(FOR PASS FROM 1 TO LIMIT DO (PRINTOUT T " Round " PASS " started " (DATE)
"." T)
(LET ((TS (OPENTEXTSTREAM
'
|{ERIS}<Test>GC>Hand-Aux>ADVDICT-N-Z.TEDIT|
))
TLIST)
(TEDIT.HARDCOPY TS '{CORE}FOO.IP T)
(COPYFILE '{CORE}FOO.IP '{DSK}FOO.IP)
(DELFILE '{DSK}FOO.IP)
(DELFILE '{CORE}FOO.IP)
(CLOSEF (FETCH (TEXTOBJ TXTFILE)
OF (TEXTOBJ TS)))))))
(LIST-MANIPULATION-TEST
(LAMBDA (LIMIT) (* \; "Edited 23-Jun-88 14:03 by jds")
(* |;;| "Do lots of list creation, popping, and consing, to make sure the GC works.")
(PRINTOUT T " Starting LIST-MANIPULATION test for " LIMIT " iterations." T)
(|for| PASS |from| 1 |to| LIMIT
|do| (PRINTOUT T " Round " PASS " started " (DATE)
"." T)
(LET ((TS (OPENTEXTSTREAM '|{ERIS}<sybalsky>Top10-87>Dictionaries>ADVDICT-A-M.TEDIT|))
(LEN (RAND 0 100000))
TLIST)
(SETQ TLIST (|for| I |from| 1 |to| LEN |collect| TS))
(|for| I |from| 1 |to| (RAND 1 (IMAX 1 (LRSH LEN 1)))
|do| (|pop| TLIST))
(|for| I |from| 1 |to| (RAND 1 100) |do| (SETQ TLIST
(CONS TS TLIST)))
(|for| I |from| 1 |to| (RAND 1 (IMAX 1 (LRSH (FLENGTH TLIST)
1)))
|do| (|pop| TLIST))
(|for| I |from| 1 |to| (RAND 1 2000) |do| (SETQ TLIST
(CONS TS TLIST)))
(|for| I |from| 1 |to| (RAND 1 (IMAX 1 (LRSH (FLENGTH TLIST)
1)))
|do| (|pop| TLIST))
(|for| \i |from| 1 |to| (RAND 1 1500)
|do| (SETQ TLIST (NCONC TLIST
(|for| J |from| 1
|to| (RAND 1 10)
|join| (|for| K |from| 1 |to|
3
|collect| (CONS TS K))))))
(|for| I |from| 1 |to| (RAND 1 (IMAX 1 (LRSH (FLENGTH TLIST)
1)))
|do| (|pop| TLIST))
(CLOSEF (|fetch| (TEXTOBJ TXTFILE) |of| (TEXTOBJ TS))))
(LET ((GC-ITEM (NCREATE 'VMEMPAGEP))
(LEN (RAND 10 500))
TLIST ELT)
(SETQ TLIST (|for| I |from| 1 |to| LEN |collect| NIL))
(|for| I |from| 1 |to| LEN |do| (SETQ ELT (CL:RANDOM LEN))
(RPLACA (CL:NTHCDR ELT TLIST)
GC-ITEM)
(RPLACA (CL:NTHCDR (SUB1 I)
TLIST)
GC-ITEM))
(|for| I |from| (SUB1 LEN) |to| 0 |by| -1
|do| (RPLACD (CL:NTHCDR I TLIST)
GC-ITEM))))))
)
(DEFINEQ
(ATOM-FULL-TEST
(LAMBDA NIL (* \; "Edited 26-May-88 11:39 by jds")
(PRINTOUT T " Starting ATOM-space full test.")
(LET ((CUR-ATOM-COUNT |\\AtomFrLst|))
(CL:UNWIND-PROTECT
(PROGN (SETQ |\\AtomFrLst| 64000)
(FOR I FROM 64000 TO 70000 DO (GENSYM 'GC-TEST)))
(SETQ |\\AtomFrLst| CUR-ATOM-COUNT)))))
(STORAGE-FULL-TEST
(LAMBDA NIL (* \; "Edited 26-May-88 11:47 by jds")
(PRINTOUT T " Starting Storage-full test." T)
(ERSETQ (FOR I FROM 1 COLLECT (ARRAY 100)))))
)
(DEFINEQ
(DATATYPE-TEST
(LAMBDA (LIMIT) (* \; "Edited 26-May-88 11:26 by jds")
(FOR I FROM 1 TO (OR LIMIT 10)
DO (FOR L FROM 1 TO 100 DO (FOR Y FROM 1 TO 20
COLLECT (CREATE GC-TEST-TYPE
FIELD-1 _ T))
(RECLAIM)))))
)
(DECLARE\: EVAL@COMPILE
(DATATYPE GC-TEST-TYPE (FIELD-1 FIELD-2 FIELD-3 (FIELD-4 BYTE)
(FIELD-5 FIXP)
FIELD-6
(FIELD-7 WORD)
FIELD-8 FIELD-9 FIELD-10 FIELD-11 FIELD-12 FIELD-13 (FIELD-14
FIXP)
FIELD-15
(FIELD-16 XPOINTER)
FIELD-17
(FIELD-18 BYTE)
(FIELD-19 FIXP)
FIELD-20
(FIELD-21 BYTE)
FIELD-22 FIELD-23 FIELD-24 (FIELD-25 BYTE)
FIELD-26
(FIELD-27 BYTE)
FIELD-28
(FIELD-29 BYTE)
FIELD-30
(FIELD-31 WORD)
FIELD-32
(FIELD-33 XPOINTER)
FIELD-34
(FIELD-35 FIXP)
FIELD-36 FIELD-37 FIELD-38 (FIELD-39 FLAG)
FIELD-40
(FIELD-41 FLAG)
FIELD-42
(FIELD-43 FIXP)
(FIELD-44 FIXP)
FIELD-45
(FIELD-46 XPOINTER)
FIELD-47 FIELD-48 FIELD-49 (FIELD-50 FLAG)
(FIELD-51 BYTE)
FIELD-52 FIELD-53 (FIELD-54 BYTE)
FIELD-55 FIELD-56 (FIELD-57 BYTE)
(FIELD-58 WORD)
FIELD-59 FIELD-60 (FIELD-61 XPOINTER)
FIELD-62 FIELD-63 (FIELD-64 XPOINTER)
(FIELD-65 XPOINTER)
FIELD-66 FIELD-67 FIELD-68 FIELD-69 (FIELD-70 FLAG)
FIELD-71 FIELD-72 (FIELD-73 WORD)
FIELD-74
(FIELD-75 FLAG)
FIELD-76 FIELD-77 FIELD-78 FIELD-79 (FIELD-80 FIXP)
(FIELD-81 FIXP)
FIELD-82 FIELD-83 FIELD-84 FIELD-85 (FIELD-86 XPOINTER)
(FIELD-87 BYTE)
(FIELD-88 XPOINTER)
FIELD-89
(FIELD-90 BYTE)
(FIELD-91 FLAG)
(FIELD-92 FIXP)
(FIELD-93 FIXP)
(FIELD-94 FLAG)
FIELD-95
(FIELD-96 FLAG)
FIELD-97
(FIELD-98 FLAG)
FIELD-99 FIELD-100 FIELD-101 FIELD-102 FIELD-103 (FIELD-104
XPOINTER)
FIELD-105 FIELD-106 FIELD-107 FIELD-108 (FIELD-109 BYTE)
FIELD-110
(FIELD-111 WORD)
FIELD-112
(FIELD-113 XPOINTER)
(FIELD-114 FLAG)
(FIELD-115 FIXP)
FIELD-116 FIELD-117 (FIELD-118 BYTE)
FIELD-119 FIELD-120 FIELD-121 FIELD-122 FIELD-123 (FIELD-124
XPOINTER)
(FIELD-125 BYTE)
(FIELD-126 XPOINTER)
FIELD-127 FIELD-128 (FIELD-129 FIXP)
(FIELD-130 FLAG)
FIELD-131 FIELD-132 FIELD-133 FIELD-134 (FIELD-135 WORD)
(FIELD-136 FLAG)
FIELD-137 FIELD-138 FIELD-139 (FIELD-140 WORD)
(FIELD-141 FLAG)
FIELD-142 FIELD-143 FIELD-144 (FIELD-145 FIXP)
FIELD-146 FIELD-147 FIELD-148 FIELD-149 (FIELD-150 FLAG)
FIELD-151 FIELD-152 FIELD-153 FIELD-154 (FIELD-155 FIXP)
FIELD-156
(FIELD-157 BYTE)
FIELD-158
(FIELD-159 FIXP)
(FIELD-160 WORD)
FIELD-161
(FIELD-162 WORD)
(FIELD-163 FIXP)
FIELD-164
(FIELD-165 FIXP)
FIELD-166
(FIELD-167 FLAG)
(FIELD-168 BYTE)
FIELD-169 FIELD-170 (FIELD-171 XPOINTER)
(FIELD-172 BYTE)
FIELD-173 FIELD-174 (FIELD-175 FLAG)
(FIELD-176 BYTE)
(FIELD-177 WORD)
FIELD-178
(FIELD-179 FIXP)
FIELD-180 FIELD-181 (FIELD-182 BYTE)
FIELD-183 FIELD-184 FIELD-185 FIELD-186 FIELD-187 (FIELD-188 BYTE)
(FIELD-189 FIXP)
FIELD-190 FIELD-191 FIELD-192 (FIELD-193 BYTE)
FIELD-194
(FIELD-195 WORD)
FIELD-196 FIELD-197 FIELD-198 FIELD-199 (FIELD-200 WORD)
FIELD-201
(FIELD-202 FLAG)
FIELD-203
(FIELD-204 XPOINTER)
FIELD-205 FIELD-206 FIELD-207 (FIELD-208 FLAG)
FIELD-209
(FIELD-210 WORD)
(FIELD-211 BYTE)
FIELD-212 FIELD-213 FIELD-214 (FIELD-215 FIXP)
FIELD-216 FIELD-217 (FIELD-218 XPOINTER)
FIELD-219
(FIELD-220 FLAG)
FIELD-221
(FIELD-222 FLAG)
(FIELD-223 WORD)
(FIELD-224 FLAG)
(FIELD-225 WORD)
FIELD-226 FIELD-227 FIELD-228 FIELD-229 FIELD-230 (FIELD-231
XPOINTER)
FIELD-232
(FIELD-233 WORD)
(FIELD-234 WORD)
FIELD-235 FIELD-236 FIELD-237 FIELD-238 FIELD-239 FIELD-240
FIELD-241 (FIELD-242 XPOINTER)
FIELD-243
(FIELD-244 WORD)
FIELD-245 FIELD-246 (FIELD-247 XPOINTER)
FIELD-248 FIELD-249 FIELD-250 FIELD-251 FIELD-252 FIELD-253
FIELD-254 FIELD-255 FIELD-256 FIELD-257 (FIELD-258 XPOINTER)
FIELD-259
(FIELD-260 FIXP)
FIELD-261 FIELD-262 (FIELD-263 XPOINTER)
FIELD-264
(FIELD-265 WORD)
(FIELD-266 FLAG)
FIELD-267 FIELD-268 FIELD-269 FIELD-270 FIELD-271 (FIELD-272 BYTE)
FIELD-273 FIELD-274 (FIELD-275 FLAG)
(FIELD-276 BYTE)
FIELD-277 FIELD-278 FIELD-279 (FIELD-280 XPOINTER)
(FIELD-281 WORD)
(FIELD-282 WORD)
FIELD-283 FIELD-284 FIELD-285 (FIELD-286 WORD)
FIELD-287
(FIELD-288 XPOINTER)
(FIELD-289 BYTE)
FIELD-290
(FIELD-291 XPOINTER)
(FIELD-292 FLAG)
FIELD-293 FIELD-294 (FIELD-295 FLAG)
FIELD-296 FIELD-297 (FIELD-298 XPOINTER)
(FIELD-299 FIXP)
(FIELD-300 FIXP)
(FIELD-301 BYTE)
FIELD-302 FIELD-303 FIELD-304 FIELD-305 (FIELD-306 FIXP)
FIELD-307
(FIELD-308 FLAG)
(FIELD-309 FIXP)
FIELD-310
(FIELD-311 XPOINTER)
FIELD-312 FIELD-313 (FIELD-314 BYTE)
FIELD-315
(FIELD-316 WORD)
(FIELD-317 FIXP)
FIELD-318
(FIELD-319 FLAG)
FIELD-320
(FIELD-321 WORD)))
)
(/DECLAREDATATYPE 'GC-TEST-TYPE
'(POINTER POINTER POINTER BYTE FIXP POINTER WORD POINTER POINTER POINTER POINTER POINTER
POINTER FIXP POINTER XPOINTER POINTER BYTE FIXP POINTER BYTE POINTER POINTER POINTER
BYTE POINTER BYTE POINTER BYTE POINTER WORD POINTER XPOINTER POINTER FIXP POINTER
POINTER POINTER FLAG POINTER FLAG POINTER FIXP FIXP POINTER XPOINTER POINTER POINTER
POINTER FLAG BYTE POINTER POINTER BYTE POINTER POINTER BYTE WORD POINTER POINTER
XPOINTER POINTER POINTER XPOINTER XPOINTER POINTER POINTER POINTER POINTER FLAG
POINTER POINTER WORD POINTER FLAG POINTER POINTER POINTER POINTER FIXP FIXP POINTER
POINTER POINTER POINTER XPOINTER BYTE XPOINTER POINTER BYTE FLAG FIXP FIXP FLAG
POINTER FLAG POINTER FLAG POINTER POINTER POINTER POINTER POINTER XPOINTER POINTER
POINTER POINTER POINTER BYTE POINTER WORD POINTER XPOINTER FLAG FIXP POINTER POINTER
BYTE POINTER POINTER POINTER POINTER POINTER XPOINTER BYTE XPOINTER POINTER POINTER
FIXP FLAG POINTER POINTER POINTER POINTER WORD FLAG POINTER POINTER POINTER WORD FLAG
POINTER POINTER POINTER FIXP POINTER POINTER POINTER POINTER FLAG POINTER POINTER
POINTER POINTER FIXP POINTER BYTE POINTER FIXP WORD POINTER WORD FIXP POINTER FIXP
POINTER FLAG BYTE POINTER POINTER XPOINTER BYTE POINTER POINTER FLAG BYTE WORD POINTER
FIXP POINTER POINTER BYTE POINTER POINTER POINTER POINTER POINTER BYTE FIXP POINTER
POINTER POINTER BYTE POINTER WORD POINTER POINTER POINTER POINTER WORD POINTER FLAG
POINTER XPOINTER POINTER POINTER POINTER FLAG POINTER WORD BYTE POINTER POINTER
POINTER FIXP POINTER POINTER XPOINTER POINTER FLAG POINTER FLAG WORD FLAG WORD POINTER
POINTER POINTER POINTER POINTER XPOINTER POINTER WORD WORD POINTER POINTER POINTER
POINTER POINTER POINTER POINTER XPOINTER POINTER WORD POINTER POINTER XPOINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER XPOINTER
POINTER FIXP POINTER POINTER XPOINTER POINTER WORD FLAG POINTER POINTER POINTER
POINTER POINTER BYTE POINTER POINTER FLAG BYTE POINTER POINTER POINTER XPOINTER WORD
WORD POINTER POINTER POINTER WORD POINTER XPOINTER BYTE POINTER XPOINTER FLAG POINTER
POINTER FLAG POINTER POINTER XPOINTER FIXP FIXP BYTE POINTER POINTER POINTER POINTER
FIXP POINTER FLAG FIXP POINTER XPOINTER POINTER POINTER BYTE POINTER WORD FIXP POINTER
FLAG POINTER WORD)
'((GC-TEST-TYPE 0 POINTER)
(GC-TEST-TYPE 2 POINTER)
(GC-TEST-TYPE 4 POINTER)
(GC-TEST-TYPE 4 (BITS . 7))
(GC-TEST-TYPE 6 FIXP)
(GC-TEST-TYPE 8 POINTER)
(GC-TEST-TYPE 10 (BITS . 15))
(GC-TEST-TYPE 12 POINTER)
(GC-TEST-TYPE 14 POINTER)
(GC-TEST-TYPE 16 POINTER)
(GC-TEST-TYPE 18 POINTER)
(GC-TEST-TYPE 20 POINTER)
(GC-TEST-TYPE 22 POINTER)
(GC-TEST-TYPE 24 FIXP)
(GC-TEST-TYPE 26 POINTER)
(GC-TEST-TYPE 28 XPOINTER)
(GC-TEST-TYPE 30 POINTER)
(GC-TEST-TYPE 30 (BITS . 7))
(GC-TEST-TYPE 32 FIXP)
(GC-TEST-TYPE 34 POINTER)
(GC-TEST-TYPE 34 (BITS . 7))
(GC-TEST-TYPE 36 POINTER)
(GC-TEST-TYPE 38 POINTER)
(GC-TEST-TYPE 40 POINTER)
(GC-TEST-TYPE 40 (BITS . 7))
(GC-TEST-TYPE 42 POINTER)
(GC-TEST-TYPE 42 (BITS . 7))
(GC-TEST-TYPE 44 POINTER)
(GC-TEST-TYPE 44 (BITS . 7))
(GC-TEST-TYPE 46 POINTER)
(GC-TEST-TYPE 11 (BITS . 15))
(GC-TEST-TYPE 48 POINTER)
(GC-TEST-TYPE 50 XPOINTER)
(GC-TEST-TYPE 52 POINTER)
(GC-TEST-TYPE 54 FIXP)
(GC-TEST-TYPE 56 POINTER)
(GC-TEST-TYPE 58 POINTER)
(GC-TEST-TYPE 60 POINTER)
(GC-TEST-TYPE 60 (FLAGBITS . 0))
(GC-TEST-TYPE 62 POINTER)
(GC-TEST-TYPE 62 (FLAGBITS . 0))
(GC-TEST-TYPE 64 POINTER)
(GC-TEST-TYPE 66 FIXP)
(GC-TEST-TYPE 68 FIXP)
(GC-TEST-TYPE 70 POINTER)
(GC-TEST-TYPE 72 XPOINTER)
(GC-TEST-TYPE 74 POINTER)
(GC-TEST-TYPE 76 POINTER)
(GC-TEST-TYPE 78 POINTER)
(GC-TEST-TYPE 78 (FLAGBITS . 0))
(GC-TEST-TYPE 76 (BITS . 7))
(GC-TEST-TYPE 80 POINTER)
(GC-TEST-TYPE 82 POINTER)
(GC-TEST-TYPE 82 (BITS . 7))
(GC-TEST-TYPE 84 POINTER)
(GC-TEST-TYPE 86 POINTER)
(GC-TEST-TYPE 86 (BITS . 7))
(GC-TEST-TYPE 88 (BITS . 15))
(GC-TEST-TYPE 90 POINTER)
(GC-TEST-TYPE 92 POINTER)
(GC-TEST-TYPE 94 XPOINTER)
(GC-TEST-TYPE 96 POINTER)
(GC-TEST-TYPE 98 POINTER)
(GC-TEST-TYPE 100 XPOINTER)
(GC-TEST-TYPE 102 XPOINTER)
(GC-TEST-TYPE 104 POINTER)
(GC-TEST-TYPE 106 POINTER)
(GC-TEST-TYPE 108 POINTER)
(GC-TEST-TYPE 110 POINTER)
(GC-TEST-TYPE 110 (FLAGBITS . 0))
(GC-TEST-TYPE 112 POINTER)
(GC-TEST-TYPE 114 POINTER)
(GC-TEST-TYPE 89 (BITS . 15))
(GC-TEST-TYPE 116 POINTER)
(GC-TEST-TYPE 116 (FLAGBITS . 0))
(GC-TEST-TYPE 118 POINTER)
(GC-TEST-TYPE 120 POINTER)
(GC-TEST-TYPE 122 POINTER)
(GC-TEST-TYPE 124 POINTER)
(GC-TEST-TYPE 126 FIXP)
(GC-TEST-TYPE 128 FIXP)
(GC-TEST-TYPE 130 POINTER)
(GC-TEST-TYPE 132 POINTER)
(GC-TEST-TYPE 134 POINTER)
(GC-TEST-TYPE 136 POINTER)
(GC-TEST-TYPE 138 XPOINTER)
(GC-TEST-TYPE 138 (BITS . 7))
(GC-TEST-TYPE 140 XPOINTER)
(GC-TEST-TYPE 142 POINTER)
(GC-TEST-TYPE 142 (BITS . 7))
(GC-TEST-TYPE 140 (FLAGBITS . 0))
(GC-TEST-TYPE 144 FIXP)
(GC-TEST-TYPE 146 FIXP)
(GC-TEST-TYPE 140 (FLAGBITS . 16))
(GC-TEST-TYPE 148 POINTER)
(GC-TEST-TYPE 148 (FLAGBITS . 0))
(GC-TEST-TYPE 150 POINTER)
(GC-TEST-TYPE 150 (FLAGBITS . 0))
(GC-TEST-TYPE 152 POINTER)
(GC-TEST-TYPE 154 POINTER)
(GC-TEST-TYPE 156 POINTER)
(GC-TEST-TYPE 158 POINTER)
(GC-TEST-TYPE 160 POINTER)
(GC-TEST-TYPE 162 XPOINTER)
(GC-TEST-TYPE 164 POINTER)
(GC-TEST-TYPE 166 POINTER)
(GC-TEST-TYPE 168 POINTER)
(GC-TEST-TYPE 170 POINTER)
(GC-TEST-TYPE 170 (BITS . 7))
(GC-TEST-TYPE 172 POINTER)
(GC-TEST-TYPE 174 (BITS . 15))
(GC-TEST-TYPE 176 POINTER)
(GC-TEST-TYPE 178 XPOINTER)
(GC-TEST-TYPE 178 (FLAGBITS . 0))
(GC-TEST-TYPE 180 FIXP)
(GC-TEST-TYPE 182 POINTER)
(GC-TEST-TYPE 184 POINTER)
(GC-TEST-TYPE 184 (BITS . 7))
(GC-TEST-TYPE 186 POINTER)
(GC-TEST-TYPE 188 POINTER)
(GC-TEST-TYPE 190 POINTER)
(GC-TEST-TYPE 192 POINTER)
(GC-TEST-TYPE 194 POINTER)
(GC-TEST-TYPE 196 XPOINTER)
(GC-TEST-TYPE 196 (BITS . 7))
(GC-TEST-TYPE 198 XPOINTER)
(GC-TEST-TYPE 200 POINTER)
(GC-TEST-TYPE 202 POINTER)
(GC-TEST-TYPE 204 FIXP)
(GC-TEST-TYPE 202 (FLAGBITS . 0))
(GC-TEST-TYPE 206 POINTER)
(GC-TEST-TYPE 208 POINTER)
(GC-TEST-TYPE 210 POINTER)
(GC-TEST-TYPE 212 POINTER)
(GC-TEST-TYPE 175 (BITS . 15))
(GC-TEST-TYPE 212 (FLAGBITS . 0))
(GC-TEST-TYPE 214 POINTER)
(GC-TEST-TYPE 216 POINTER)
(GC-TEST-TYPE 218 POINTER)
(GC-TEST-TYPE 220 (BITS . 15))
(GC-TEST-TYPE 218 (FLAGBITS . 0))
(GC-TEST-TYPE 222 POINTER)
(GC-TEST-TYPE 224 POINTER)
(GC-TEST-TYPE 226 POINTER)
(GC-TEST-TYPE 228 FIXP)
(GC-TEST-TYPE 230 POINTER)
(GC-TEST-TYPE 232 POINTER)
(GC-TEST-TYPE 234 POINTER)
(GC-TEST-TYPE 236 POINTER)
(GC-TEST-TYPE 236 (FLAGBITS . 0))
(GC-TEST-TYPE 238 POINTER)
(GC-TEST-TYPE 240 POINTER)
(GC-TEST-TYPE 242 POINTER)
(GC-TEST-TYPE 244 POINTER)
(GC-TEST-TYPE 246 FIXP)
(GC-TEST-TYPE 248 POINTER)
(GC-TEST-TYPE 248 (BITS . 7))
(GC-TEST-TYPE 250 POINTER)
(GC-TEST-TYPE 252 FIXP)
(GC-TEST-TYPE 221 (BITS . 15))
(GC-TEST-TYPE 254 POINTER)
(GC-TEST-TYPE 256 (BITS . 15))
(GC-TEST-TYPE 257 FIXP)
(GC-TEST-TYPE 260 POINTER)
(GC-TEST-TYPE 262 FIXP)
(GC-TEST-TYPE 264 POINTER)
(GC-TEST-TYPE 264 (FLAGBITS . 0))
(GC-TEST-TYPE 260 (BITS . 7))
(GC-TEST-TYPE 266 POINTER)
(GC-TEST-TYPE 268 POINTER)
(GC-TEST-TYPE 270 XPOINTER)
(GC-TEST-TYPE 270 (BITS . 7))
(GC-TEST-TYPE 272 POINTER)
(GC-TEST-TYPE 274 POINTER)
(GC-TEST-TYPE 274 (FLAGBITS . 0))
(GC-TEST-TYPE 272 (BITS . 7))
(GC-TEST-TYPE 259 (BITS . 15))
(GC-TEST-TYPE 276 POINTER)
(GC-TEST-TYPE 278 FIXP)
(GC-TEST-TYPE 280 POINTER)
(GC-TEST-TYPE 282 POINTER)
(GC-TEST-TYPE 282 (BITS . 7))
(GC-TEST-TYPE 284 POINTER)
(GC-TEST-TYPE 286 POINTER)
(GC-TEST-TYPE 288 POINTER)
(GC-TEST-TYPE 290 POINTER)
(GC-TEST-TYPE 292 POINTER)
(GC-TEST-TYPE 292 (BITS . 7))
(GC-TEST-TYPE 294 FIXP)
(GC-TEST-TYPE 296 POINTER)
(GC-TEST-TYPE 298 POINTER)
(GC-TEST-TYPE 300 POINTER)
(GC-TEST-TYPE 300 (BITS . 7))
(GC-TEST-TYPE 302 POINTER)
(GC-TEST-TYPE 304 (BITS . 15))
(GC-TEST-TYPE 306 POINTER)
(GC-TEST-TYPE 308 POINTER)
(GC-TEST-TYPE 310 POINTER)
(GC-TEST-TYPE 312 POINTER)
(GC-TEST-TYPE 305 (BITS . 15))
(GC-TEST-TYPE 314 POINTER)
(GC-TEST-TYPE 314 (FLAGBITS . 0))
(GC-TEST-TYPE 316 POINTER)
(GC-TEST-TYPE 318 XPOINTER)
(GC-TEST-TYPE 320 POINTER)
(GC-TEST-TYPE 322 POINTER)
(GC-TEST-TYPE 324 POINTER)
(GC-TEST-TYPE 324 (FLAGBITS . 0))
(GC-TEST-TYPE 326 POINTER)
(GC-TEST-TYPE 328 (BITS . 15))
(GC-TEST-TYPE 326 (BITS . 7))
(GC-TEST-TYPE 330 POINTER)
(GC-TEST-TYPE 332 POINTER)
(GC-TEST-TYPE 334 POINTER)
(GC-TEST-TYPE 336 FIXP)
(GC-TEST-TYPE 338 POINTER)
(GC-TEST-TYPE 340 POINTER)
(GC-TEST-TYPE 342 XPOINTER)
(GC-TEST-TYPE 344 POINTER)
(GC-TEST-TYPE 344 (FLAGBITS . 0))
(GC-TEST-TYPE 346 POINTER)
(GC-TEST-TYPE 346 (FLAGBITS . 0))
(GC-TEST-TYPE 329 (BITS . 15))
(GC-TEST-TYPE 346 (FLAGBITS . 16))
(GC-TEST-TYPE 348 (BITS . 15))
(GC-TEST-TYPE 350 POINTER)
(GC-TEST-TYPE 352 POINTER)
(GC-TEST-TYPE 354 POINTER)
(GC-TEST-TYPE 356 POINTER)
(GC-TEST-TYPE 358 POINTER)
(GC-TEST-TYPE 360 XPOINTER)
(GC-TEST-TYPE 362 POINTER)
(GC-TEST-TYPE 349 (BITS . 15))
(GC-TEST-TYPE 364 (BITS . 15))
(GC-TEST-TYPE 366 POINTER)
(GC-TEST-TYPE 368 POINTER)
(GC-TEST-TYPE 370 POINTER)
(GC-TEST-TYPE 372 POINTER)
(GC-TEST-TYPE 374 POINTER)
(GC-TEST-TYPE 376 POINTER)
(GC-TEST-TYPE 378 POINTER)
(GC-TEST-TYPE 380 XPOINTER)
(GC-TEST-TYPE 382 POINTER)
(GC-TEST-TYPE 365 (BITS . 15))
(GC-TEST-TYPE 384 POINTER)
(GC-TEST-TYPE 386 POINTER)
(GC-TEST-TYPE 388 XPOINTER)
(GC-TEST-TYPE 390 POINTER)
(GC-TEST-TYPE 392 POINTER)
(GC-TEST-TYPE 394 POINTER)
(GC-TEST-TYPE 396 POINTER)
(GC-TEST-TYPE 398 POINTER)
(GC-TEST-TYPE 400 POINTER)
(GC-TEST-TYPE 402 POINTER)
(GC-TEST-TYPE 404 POINTER)
(GC-TEST-TYPE 406 POINTER)
(GC-TEST-TYPE 408 POINTER)
(GC-TEST-TYPE 410 XPOINTER)
(GC-TEST-TYPE 412 POINTER)
(GC-TEST-TYPE 414 FIXP)
(GC-TEST-TYPE 416 POINTER)
(GC-TEST-TYPE 418 POINTER)
(GC-TEST-TYPE 420 XPOINTER)
(GC-TEST-TYPE 422 POINTER)
(GC-TEST-TYPE 424 (BITS . 15))
(GC-TEST-TYPE 422 (FLAGBITS . 0))
(GC-TEST-TYPE 426 POINTER)
(GC-TEST-TYPE 428 POINTER)
(GC-TEST-TYPE 430 POINTER)
(GC-TEST-TYPE 432 POINTER)
(GC-TEST-TYPE 434 POINTER)
(GC-TEST-TYPE 434 (BITS . 7))
(GC-TEST-TYPE 436 POINTER)
(GC-TEST-TYPE 438 POINTER)
(GC-TEST-TYPE 438 (FLAGBITS . 0))
(GC-TEST-TYPE 436 (BITS . 7))
(GC-TEST-TYPE 440 POINTER)
(GC-TEST-TYPE 442 POINTER)
(GC-TEST-TYPE 444 POINTER)
(GC-TEST-TYPE 446 XPOINTER)
(GC-TEST-TYPE 425 (BITS . 15))
(GC-TEST-TYPE 448 (BITS . 15))
(GC-TEST-TYPE 450 POINTER)
(GC-TEST-TYPE 452 POINTER)
(GC-TEST-TYPE 454 POINTER)
(GC-TEST-TYPE 449 (BITS . 15))
(GC-TEST-TYPE 456 POINTER)
(GC-TEST-TYPE 458 XPOINTER)
(GC-TEST-TYPE 458 (BITS . 7))
(GC-TEST-TYPE 460 POINTER)
(GC-TEST-TYPE 462 XPOINTER)
(GC-TEST-TYPE 462 (FLAGBITS . 0))
(GC-TEST-TYPE 464 POINTER)
(GC-TEST-TYPE 466 POINTER)
(GC-TEST-TYPE 466 (FLAGBITS . 0))
(GC-TEST-TYPE 468 POINTER)
(GC-TEST-TYPE 470 POINTER)
(GC-TEST-TYPE 472 XPOINTER)
(GC-TEST-TYPE 474 FIXP)
(GC-TEST-TYPE 476 FIXP)
(GC-TEST-TYPE 472 (BITS . 7))
(GC-TEST-TYPE 478 POINTER)
(GC-TEST-TYPE 480 POINTER)
(GC-TEST-TYPE 482 POINTER)
(GC-TEST-TYPE 484 POINTER)
(GC-TEST-TYPE 486 FIXP)
(GC-TEST-TYPE 488 POINTER)
(GC-TEST-TYPE 488 (FLAGBITS . 0))
(GC-TEST-TYPE 490 FIXP)
(GC-TEST-TYPE 492 POINTER)
(GC-TEST-TYPE 494 XPOINTER)
(GC-TEST-TYPE 496 POINTER)
(GC-TEST-TYPE 498 POINTER)
(GC-TEST-TYPE 498 (BITS . 7))
(GC-TEST-TYPE 500 POINTER)
(GC-TEST-TYPE 502 (BITS . 15))
(GC-TEST-TYPE 503 FIXP)
(GC-TEST-TYPE 506 POINTER)
(GC-TEST-TYPE 506 (FLAGBITS . 0))
(GC-TEST-TYPE 508 POINTER)
(GC-TEST-TYPE 505 (BITS . 15)))
'510)
(* |;;| "DATATYPE TESTS")
(* |;;| "CODE RECLAIMATION TESTS")
(DEFINEQ
(CODE-RECLAIM-TEST
(LAMBDA (LIMIT) (* \; "Edited 23-Jun-88 11:54 by jds")
(LET NIL
(* |;;| "Make sure there's a definition to compile.")
(OR (GETD 'CODE-RECLAIM-TEST-TEMP-FN)
(EVAL CODE-RECLAIM-TEST-TEMP-FN))
(PRINTOUT T " Starting code-block reclaim test" T)
(|for| I |from| 1 |to| LIMIT |do| (BKSYSBUF "ST
N
")
(COMPILE 'CODE-RECLAIM-TEST-TEMP-FN))
(PRINTOUT T " Starting MAPATOMS(GETD)" T)
(|for| I |from| 1 |to| LIMIT |do| (MAPATOMS (FUNCTION GETD))))))
)
(* |;;|
"The function that is repeatedly compiled to test that code-block constants inside code blocks are reclaimed."
)
(RPAQQ CODE-RECLAIM-TEST-TEMP-FN
(DEFINEQ (CODE-RECLAIM-TEST-TEMP-FN (ASDF)
(LET (I)
(FOR I FROM 1 TO 10 COLLECT (SQRT 4.5))
(ERSETQ (DATE))
(NLSETQ (DATE))
(ERSETQ (DATE))
(NLSETQ (DATE))
(ERSETQ (DATE))
(CL:FLET ((TEMP (ARG)
(SETQ ARG (FLOAT ARG))
(EXPT (SQRT I)
(SQRT (COS (/ I 180))))))
(CL:UNWIND-PROTECT
(FOR I FROM 1 TO 1000 COLLECT (TEMP I))
(SETQ I NIL)))))))
(PUTPROPS MAIKO-GC-TESTS COPYRIGHT ("John Sybalsky & Xerox Corporation" 1988))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (2908 5241 (MAIN-GC-TEST 2918 . 5239)) (5242 13684 (ITEMS-ON-STACK-TEST 5252 . 6415) (
MANY-BIGNUM-MAKER 6417 . 7289) (MANY-FIXP-MAKER 7291 . 8077) (MANY-FLOAT-MAKER 8079 . 8686) (
BOUNDARY-TESTS 8688 . 11155) (ARRAY-STRING-TEST 11157 . 13103) (VARIOUS-TYPES-TEST 13105 . 13682)) (
13685 18528 (TEDIT-CRUNCH-TEST 13695 . 15107) (LIST-MANIPULATION-TEST 15109 . 18526)) (18529 19213 (
ATOM-FULL-TEST 18539 . 18970) (STORAGE-FULL-TEST 18972 . 19211)) (19214 19732 (DATATYPE-TEST 19224 .
19730)) (44715 45405 (CODE-RECLAIM-TEST 44725 . 45403)))))
STOP

View File

@@ -1,925 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED " 2-Aug-88 21:52:05" {ERIS}<TEST>GC>HAND>MAIKO-GC-TESTS.\;7 46959
|changes| |to:| (FNS MAIN-GC-TEST LIST-MANIPULATION-TEST CODE-RECLAIM-TEST)
|previous| |date:| "23-Jun-88 16:06:34" {ERIS}<TEST>GC>HAND>MAIKO-GC-TESTS.\;6)
; Copyright (c) 1988 by John Sybalsky & Xerox Corporation. All rights reserved.
(PRETTYCOMPRINT MAIKO-GC-TESTSCOMS)
(RPAQQ MAIKO-GC-TESTSCOMS
((FILES DANCEROBJ GCHAX)
(ADDVARS (DISPLAYFONTDIRECTORIES "{ERIS}<TEST>GC>HAND-AUX>"
"{ERIS}<LISPCORE>XEROXPRIVATE>FONTS>")
(INTERPRESSFONTDIRECTORIES "{ERIS}<TEST>GC>HAND-AUX>"
"{ERIS}<LISPCORE>XEROXPRIVATE>FONTS>"))
(P (SETQ DISPLAYFONTEXTENSIONS '(DISPLAYFONT AC STRIKE)))
(FNS MAIN-GC-TEST)
(FNS ITEMS-ON-STACK-TEST MANY-BIGNUM-MAKER MANY-FIXP-MAKER MANY-FLOAT-MAKER BOUNDARY-TESTS
ARRAY-STRING-TEST VARIOUS-TYPES-TEST)
(FNS TEDIT-CRUNCH-TEST LIST-MANIPULATION-TEST)
(FNS ATOM-FULL-TEST STORAGE-FULL-TEST)
(COMS (FNS DATATYPE-TEST)
(RECORDS GC-TEST-TYPE)
(* |;;| "DATATYPE TESTS")
)
(COMS
(* |;;| "CODE RECLAIMATION TESTS")
(FNS CODE-RECLAIM-TEST)
(* |;;| "The function that is repeatedly compiled to test that code-block constants inside code blocks are reclaimed.")
(VARS (CODE-RECLAIM-TEST-TEMP-FN
'(DEFINEQ (CODE-RECLAIM-TEST-TEMP-FN
(ASDF)
(LET (I)
(FOR I FROM 1 TO 10 COLLECT (SQRT 4.5))
(ERSETQ (DATE))
(NLSETQ (DATE))
(ERSETQ (DATE))
(NLSETQ (DATE))
(ERSETQ (DATE))
(CL:FLET ((TEMP (ARG)
(SETQ ARG (FLOAT ARG))
(EXPT (SQRT I)
(SQRT (COS (/ I 180))))))
(CL:UNWIND-PROTECT
(FOR I FROM 1 TO 1000 COLLECT (TEMP I))
(SETQ I NIL)))))))))))
(FILESLOAD DANCEROBJ GCHAX)
(ADDTOVAR DISPLAYFONTDIRECTORIES "{ERIS}<TEST>GC>HAND-AUX>" "{ERIS}<LISPCORE>XEROXPRIVATE>FONTS>")
(ADDTOVAR INTERPRESSFONTDIRECTORIES "{ERIS}<TEST>GC>HAND-AUX>"
"{ERIS}<LISPCORE>XEROXPRIVATE>FONTS>")
(SETQ DISPLAYFONTEXTENSIONS '(DISPLAYFONT AC STRIKE))
(DEFINEQ
(MAIN-GC-TEST
(LAMBDA (LIMIT DRIBBLE-FILE STACK-COUNT BIGNUM-COUNT FIXP-COUNT FLOAT-COUNT TEDIT-COUNT LIST-COUNT
CODE-COUNT TYPE-COUNT LIST-LEN-LIMIT) (* \; "Edited 23-Jun-88 13:30 by jds")
(DRIBBLE (OR DRIBBLE-FILE "{LPT}"))
(PRINTOUT T ";;; ***********" T ";;; MAIKO GARBAGE COLLECTOR TESTS" T ";;; Run on " (DATE)
T ";;; Dribble to " (OR DRIBBLE-FILE "{LPT}")
T T)
(|for| I |from| 1 |to| (OR LIMIT 10) |do| (PRINTOUT T
"Starting Maiko GC tests, pass "
I T)
(ITEMS-ON-STACK-TEST (OR STACK-COUNT
100))
(MANY-BIGNUM-MAKER (OR BIGNUM-COUNT
1000))
(MANY-FIXP-MAKER (OR FIXP-COUNT 1000))
(MANY-FLOAT-MAKER (OR FLOAT-COUNT 1000
))
(TEDIT-CRUNCH-TEST (OR TEDIT-COUNT 5))
(ARRAY-STRING-TEST 3)
(LIST-MANIPULATION-TEST (OR LIST-COUNT
5)
LIST-LEN-LIMIT)
(BOUNDARY-TESTS)
(CODE-RECLAIM-TEST (OR CODE-COUNT 20))
(VARIOUS-TYPES-TEST (OR TYPE-COUNT 10)
)
(FRPTQ 100 (RECLAIM))
(STORAGE))
(ATOM-FULL-TEST)
(STORAGE-FULL-TEST)
(DRIBBLE NIL)))
)
(DEFINEQ
(ITEMS-ON-STACK-TEST
(LAMBDA (LIMIT) (* \; "Edited 25-May-88 11:56 by jds")
(PRINTOUT T " Starting ITEMS-ON-STACK test for " LIMIT " iterations." T)
(FOR I FROM 1 TO LIMIT DO (LET ((X (CREATE CHARLOOKS))
(Y (EXPT 1234.5 (RAND 3 7))))
(ERSETQ (FRPTQ 5 (RECLAIM))
(COND
((\\ISONFREELIST X)
(HELP
"X is free, but pointer is on stack."
))
((\\ISONFREELIST Y)
(HELP
"Y is free, but pointer is on stack."
))))))))
(MANY-BIGNUM-MAKER
(LAMBDA (LIMIT) (* \; "Edited 25-May-88 11:54 by jds")
(PRINTOUT T " Starting MANY-BIGNUM-MAKER test for " LIMIT " iterations." T)
(LET (X Y Z W)
(FOR I FROM 1 TO LIMIT DO (SETQ X (CL:* 12345678901234567890
(RAND 1 I)))
(SETQ Y (IQUOTIENT X 3))
(SETQ Z (IPLUS Y X X 34 2 9 (IMOD X 7)
(IREMAINDER Y 3)
(CL:FLOOR Y 2)
(CL:CEILING X 8)))
(SETQ W (/ Z Y))))))
(MANY-FIXP-MAKER
(LAMBDA (LIMIT) (* \; "Edited 25-May-88 11:54 by jds")
(PRINTOUT T " Starting MANY-FIXP-MAKER test for " LIMIT " iterations." T)
(LET (X Y Z W)
(FOR I FROM 1 TO LIMIT DO (SETQ X (CL:* 543 (RAND 1 I)))
(SETQ Y (IQUOTIENT X 3))
(SETQ Z (IPLUS Y X X 34 2 9 (IMOD X 7)
(IREMAINDER Y 3)
(CL:FLOOR Y 2)
(CL:CEILING X 8)))
(SETQ W (/ Z Y))))))
(MANY-FLOAT-MAKER
(LAMBDA (LIMIT) (* \; "Edited 25-May-88 11:55 by jds")
(PRINTOUT T " Starting MANY-FLOAT-MAKER test for " LIMIT " iterations." T)
(LET (X Y Z W)
(FOR I FROM 1 TO LIMIT DO (SETQ X (FTIMES 1.0 (RAND 0 1)))
(SETQ Y (+ (SQRT I)
(EXPT (SQRT (SQRT I))
3.4)))
(SETQ Z (LOG Y))))))
(BOUNDARY-TESTS
(LAMBDA NIL (* \; "Edited 26-May-88 11:54 by jds")
(* |;;| "Tests the transition into and out of big refcnts, and BIG refcnt's.")
(PRINTOUT T " Starting Refcnt-63 crossing test" T)
(LET* ((ITEM (|create| FMTSPEC))
(LIST (|for| I |from| 1 |to| 62 |collect| ITEM)))
(|for| I |from| 1 |to| 1000 |do| (|for| J |from| (LENGTH LIST)
|to| (+ 63 (RAND 1 10))
|do| (SETQ LIST (CONS ITEM LIST)))
(|for| J |from| (LENGTH LIST)
|to| (- 63 (RAND 3 12))
|do| (|pop| LIST))
(COND
((ZEROP (IMOD I 31))
(RECLAIM))))
(PRINTOUT T " Starting Refcount-500K <-> NIL test." T)
(|for| LOOP |from| 1 |to| 10 |do| (|for| I |from| 1 |to| 500000
|do| (SETQ LIST (CONS ITEM LIST)))
(SETQ LIST NIL))
(PRINTOUT T " Starting Refcount 1-2 boundary test." T)
(LET ((ITEM (LIST (|create| FMTSPEC))))
(|for| I |from| 1 |to| 5000 |do| (SETQ ITEM2 (CAR ITEM))
(SETQ ITEM2 NIL)))
(PRINTOUT T " Starting Refcount 1 + stack boundary test." T)
(LET ((ITEM (|create| FMTSPEC))
ITEM2)
(|for| I |from| 1 |to| 5000 |do| (SETQ ITEM2 (LIST ITEM))
(RPLACA ITEM2 NIL)))
(PRINTOUT T " Starting Refcount 0-1 boundary test." T)
(LET (ITEM)
(|for| I |from| 1 |to| 5000 |do| (SETQ ITEM (LIST (|create|
FMTSPEC)))
(RPLACA ITEM NIL))))))
(ARRAY-STRING-TEST
(LAMBDA (LIMIT REAL-STRESS) (* \; "Edited 23-Jun-88 12:23 by jds")
(* |;;| "Try out array & string creation, and substringing on the GC.")
(PRINTOUT T " Starting Array & String test." T)
(FOR I FROM 1 TO (OR LIMIT 10)
DO (LET (STRINGS ARRAYS)
(FOR ARRAY-COUNT FROM 1 TO 5000
COLLECT (CL:MAKE-ARRAY (RAND 10 (COND
(REAL-STRESS 65000)
(T (IMAX 100 (IQUOTIENT 65000
ARRAY-COUNT)))))))
(FOR I FROM 1 TO 5000 COLLECT (BITMAPCREATE (RAND 1 512)
(RAND 1 512)))
(SETQ STRINGS (FOR STRING-COUNT FROM 1 TO 5000
COLLECT (ALLOCSTRING (RAND 10
(COND
(REAL-STRESS 65000)
(T (IMAX 100 (IQUOTIENT 65000
STRING-COUNT
))))))))
(FOR STRING IN STRINGS
COLLECT (SUBSTRING STRING (RAND 1 (LRSH (NCHARS STRING)
1))
(RAND (ADD1 (LRSH (NCHARS STRING)
1))
(NCHARS STRING))))))))
(VARIOUS-TYPES-TEST
(LAMBDA (LIMIT) (* \; "Edited 23-Jun-88 12:04 by jds")
(* |;;|
 "Run thru creation and collection of various types that have caused trouble in the past. ")
(PRINTOUT T " Starting various type cases." T)
(FOR REPEAT-COUNT FROM 1 TO (OR LIMIT 10)
DO (|for| TYPE IN '(VMEMPAGEP) AS CREATION-LIMIT IN '(100)
|do| (FOR I FROM 1 TO CREATION-LIMIT COLLECT (NCREATE TYPE))
(DORECLAIM)))))
)
(DEFINEQ
(TEDIT-CRUNCH-TEST
(LAMBDA (LIMIT) (* \; "Edited 27-May-88 13:06 by jds")
(* |;;| "GC Testing -- stressing the world.")
(* |;;| "Hardcopy a big TEdit file to a {CORE} file, copy that to disk, and delete everything.")
(PRINTOUT T " Starting TEDIT-CRUNCH test for " LIMIT " iterations." T)
(FOR PASS FROM 1 TO LIMIT DO (PRINTOUT T " Round " PASS " started " (DATE)
"." T)
(LET ((TS (OPENTEXTSTREAM
'
|{ERIS}<Test>GC>Hand-Aux>ADVDICT-N-Z.TEDIT|
))
TLIST)
(TEDIT.HARDCOPY TS '{CORE}FOO.IP T)
(COPYFILE '{CORE}FOO.IP '{DSK}FOO.IP)
(DELFILE '{DSK}FOO.IP)
(DELFILE '{CORE}FOO.IP)
(CLOSEF (FETCH (TEXTOBJ TXTFILE)
OF (TEXTOBJ TS)))))))
(LIST-MANIPULATION-TEST
(LAMBDA (LIMIT LENGTH-LIMIT) (* \; "Edited 23-Jun-88 14:03 by jds")
(* |;;| "Do lots of list creation, popping, and consing, to make sure the GC works.")
(PRINTOUT T " Starting LIST-MANIPULATION test for " LIMIT " iterations." T)
(|for| PASS |from| 1 |to| LIMIT
|do| (PRINTOUT T " Round " PASS " started " (DATE)
"." T)
(LET ((TS (OPENTEXTSTREAM '|{ERIS}<sybalsky>Top10-87>Dictionaries>ADVDICT-A-M.TEDIT|))
(LEN (RAND 0 (OR LENGTH-LIMIT 100000)))
TLIST)
(SETQ TLIST (|for| I |from| 1 |to| LEN |collect| TS))
(|for| I |from| 1 |to| (RAND 1 (IMAX 1 (LRSH LEN 1)))
|do| (|pop| TLIST))
(|for| I |from| 1 |to| (RAND 1 100) |do| (SETQ TLIST
(CONS TS TLIST)))
(|for| I |from| 1 |to| (RAND 1 (IMAX 1 (LRSH (FLENGTH TLIST)
1)))
|do| (|pop| TLIST))
(|for| I |from| 1 |to| (RAND 1 2000) |do| (SETQ TLIST
(CONS TS TLIST)))
(|for| I |from| 1 |to| (RAND 1 (IMAX 1 (LRSH (FLENGTH TLIST)
1)))
|do| (|pop| TLIST))
(|for| \i |from| 1 |to| (RAND 1 1500)
|do| (SETQ TLIST (NCONC TLIST
(|for| J |from| 1
|to| (RAND 1 10)
|join| (|for| K |from| 1 |to|
3
|collect| (CONS TS K))))))
(|for| I |from| 1 |to| (RAND 1 (IMAX 1 (LRSH (FLENGTH TLIST)
1)))
|do| (|pop| TLIST))
(CLOSEF (|fetch| (TEXTOBJ TXTFILE) |of| (TEXTOBJ TS))))
(LET ((GC-ITEM (NCREATE 'VMEMPAGEP))
(LEN (RAND 10 500))
TLIST ELT)
(SETQ TLIST (|for| I |from| 1 |to| LEN |collect| NIL))
(|for| I |from| 1 |to| LEN |do| (SETQ ELT (CL:RANDOM LEN))
(RPLACA (CL:NTHCDR ELT TLIST)
GC-ITEM)
(RPLACA (CL:NTHCDR (SUB1 I)
TLIST)
GC-ITEM))
(|for| I |from| (SUB1 LEN) |to| 0 |by| -1
|do| (RPLACD (CL:NTHCDR I TLIST)
GC-ITEM))))))
)
(DEFINEQ
(ATOM-FULL-TEST
(LAMBDA NIL (* \; "Edited 26-May-88 11:39 by jds")
(PRINTOUT T " Starting ATOM-space full test.")
(LET ((CUR-ATOM-COUNT |\\AtomFrLst|))
(CL:UNWIND-PROTECT
(PROGN (SETQ |\\AtomFrLst| 64000)
(FOR I FROM 64000 TO 70000 DO (GENSYM 'GC-TEST)))
(SETQ |\\AtomFrLst| CUR-ATOM-COUNT)))))
(STORAGE-FULL-TEST
(LAMBDA NIL (* \; "Edited 26-May-88 11:47 by jds")
(PRINTOUT T " Starting Storage-full test." T)
(ERSETQ (FOR I FROM 1 COLLECT (ARRAY 100)))))
)
(DEFINEQ
(DATATYPE-TEST
(LAMBDA (LIMIT) (* \; "Edited 26-May-88 11:26 by jds")
(FOR I FROM 1 TO (OR LIMIT 10)
DO (FOR L FROM 1 TO 100 DO (FOR Y FROM 1 TO 20
COLLECT (CREATE GC-TEST-TYPE
FIELD-1 _ T))
(RECLAIM)))))
)
(DECLARE\: EVAL@COMPILE
(DATATYPE GC-TEST-TYPE (FIELD-1 FIELD-2 FIELD-3 (FIELD-4 BYTE)
(FIELD-5 FIXP)
FIELD-6
(FIELD-7 WORD)
FIELD-8 FIELD-9 FIELD-10 FIELD-11 FIELD-12 FIELD-13 (FIELD-14
FIXP)
FIELD-15
(FIELD-16 XPOINTER)
FIELD-17
(FIELD-18 BYTE)
(FIELD-19 FIXP)
FIELD-20
(FIELD-21 BYTE)
FIELD-22 FIELD-23 FIELD-24 (FIELD-25 BYTE)
FIELD-26
(FIELD-27 BYTE)
FIELD-28
(FIELD-29 BYTE)
FIELD-30
(FIELD-31 WORD)
FIELD-32
(FIELD-33 XPOINTER)
FIELD-34
(FIELD-35 FIXP)
FIELD-36 FIELD-37 FIELD-38 (FIELD-39 FLAG)
FIELD-40
(FIELD-41 FLAG)
FIELD-42
(FIELD-43 FIXP)
(FIELD-44 FIXP)
FIELD-45
(FIELD-46 XPOINTER)
FIELD-47 FIELD-48 FIELD-49 (FIELD-50 FLAG)
(FIELD-51 BYTE)
FIELD-52 FIELD-53 (FIELD-54 BYTE)
FIELD-55 FIELD-56 (FIELD-57 BYTE)
(FIELD-58 WORD)
FIELD-59 FIELD-60 (FIELD-61 XPOINTER)
FIELD-62 FIELD-63 (FIELD-64 XPOINTER)
(FIELD-65 XPOINTER)
FIELD-66 FIELD-67 FIELD-68 FIELD-69 (FIELD-70 FLAG)
FIELD-71 FIELD-72 (FIELD-73 WORD)
FIELD-74
(FIELD-75 FLAG)
FIELD-76 FIELD-77 FIELD-78 FIELD-79 (FIELD-80 FIXP)
(FIELD-81 FIXP)
FIELD-82 FIELD-83 FIELD-84 FIELD-85 (FIELD-86 XPOINTER)
(FIELD-87 BYTE)
(FIELD-88 XPOINTER)
FIELD-89
(FIELD-90 BYTE)
(FIELD-91 FLAG)
(FIELD-92 FIXP)
(FIELD-93 FIXP)
(FIELD-94 FLAG)
FIELD-95
(FIELD-96 FLAG)
FIELD-97
(FIELD-98 FLAG)
FIELD-99 FIELD-100 FIELD-101 FIELD-102 FIELD-103 (FIELD-104
XPOINTER)
FIELD-105 FIELD-106 FIELD-107 FIELD-108 (FIELD-109 BYTE)
FIELD-110
(FIELD-111 WORD)
FIELD-112
(FIELD-113 XPOINTER)
(FIELD-114 FLAG)
(FIELD-115 FIXP)
FIELD-116 FIELD-117 (FIELD-118 BYTE)
FIELD-119 FIELD-120 FIELD-121 FIELD-122 FIELD-123 (FIELD-124
XPOINTER)
(FIELD-125 BYTE)
(FIELD-126 XPOINTER)
FIELD-127 FIELD-128 (FIELD-129 FIXP)
(FIELD-130 FLAG)
FIELD-131 FIELD-132 FIELD-133 FIELD-134 (FIELD-135 WORD)
(FIELD-136 FLAG)
FIELD-137 FIELD-138 FIELD-139 (FIELD-140 WORD)
(FIELD-141 FLAG)
FIELD-142 FIELD-143 FIELD-144 (FIELD-145 FIXP)
FIELD-146 FIELD-147 FIELD-148 FIELD-149 (FIELD-150 FLAG)
FIELD-151 FIELD-152 FIELD-153 FIELD-154 (FIELD-155 FIXP)
FIELD-156
(FIELD-157 BYTE)
FIELD-158
(FIELD-159 FIXP)
(FIELD-160 WORD)
FIELD-161
(FIELD-162 WORD)
(FIELD-163 FIXP)
FIELD-164
(FIELD-165 FIXP)
FIELD-166
(FIELD-167 FLAG)
(FIELD-168 BYTE)
FIELD-169 FIELD-170 (FIELD-171 XPOINTER)
(FIELD-172 BYTE)
FIELD-173 FIELD-174 (FIELD-175 FLAG)
(FIELD-176 BYTE)
(FIELD-177 WORD)
FIELD-178
(FIELD-179 FIXP)
FIELD-180 FIELD-181 (FIELD-182 BYTE)
FIELD-183 FIELD-184 FIELD-185 FIELD-186 FIELD-187 (FIELD-188 BYTE)
(FIELD-189 FIXP)
FIELD-190 FIELD-191 FIELD-192 (FIELD-193 BYTE)
FIELD-194
(FIELD-195 WORD)
FIELD-196 FIELD-197 FIELD-198 FIELD-199 (FIELD-200 WORD)
FIELD-201
(FIELD-202 FLAG)
FIELD-203
(FIELD-204 XPOINTER)
FIELD-205 FIELD-206 FIELD-207 (FIELD-208 FLAG)
FIELD-209
(FIELD-210 WORD)
(FIELD-211 BYTE)
FIELD-212 FIELD-213 FIELD-214 (FIELD-215 FIXP)
FIELD-216 FIELD-217 (FIELD-218 XPOINTER)
FIELD-219
(FIELD-220 FLAG)
FIELD-221
(FIELD-222 FLAG)
(FIELD-223 WORD)
(FIELD-224 FLAG)
(FIELD-225 WORD)
FIELD-226 FIELD-227 FIELD-228 FIELD-229 FIELD-230 (FIELD-231
XPOINTER)
FIELD-232
(FIELD-233 WORD)
(FIELD-234 WORD)
FIELD-235 FIELD-236 FIELD-237 FIELD-238 FIELD-239 FIELD-240
FIELD-241 (FIELD-242 XPOINTER)
FIELD-243
(FIELD-244 WORD)
FIELD-245 FIELD-246 (FIELD-247 XPOINTER)
FIELD-248 FIELD-249 FIELD-250 FIELD-251 FIELD-252 FIELD-253
FIELD-254 FIELD-255 FIELD-256 FIELD-257 (FIELD-258 XPOINTER)
FIELD-259
(FIELD-260 FIXP)
FIELD-261 FIELD-262 (FIELD-263 XPOINTER)
FIELD-264
(FIELD-265 WORD)
(FIELD-266 FLAG)
FIELD-267 FIELD-268 FIELD-269 FIELD-270 FIELD-271 (FIELD-272 BYTE)
FIELD-273 FIELD-274 (FIELD-275 FLAG)
(FIELD-276 BYTE)
FIELD-277 FIELD-278 FIELD-279 (FIELD-280 XPOINTER)
(FIELD-281 WORD)
(FIELD-282 WORD)
FIELD-283 FIELD-284 FIELD-285 (FIELD-286 WORD)
FIELD-287
(FIELD-288 XPOINTER)
(FIELD-289 BYTE)
FIELD-290
(FIELD-291 XPOINTER)
(FIELD-292 FLAG)
FIELD-293 FIELD-294 (FIELD-295 FLAG)
FIELD-296 FIELD-297 (FIELD-298 XPOINTER)
(FIELD-299 FIXP)
(FIELD-300 FIXP)
(FIELD-301 BYTE)
FIELD-302 FIELD-303 FIELD-304 FIELD-305 (FIELD-306 FIXP)
FIELD-307
(FIELD-308 FLAG)
(FIELD-309 FIXP)
FIELD-310
(FIELD-311 XPOINTER)
FIELD-312 FIELD-313 (FIELD-314 BYTE)
FIELD-315
(FIELD-316 WORD)
(FIELD-317 FIXP)
FIELD-318
(FIELD-319 FLAG)
FIELD-320
(FIELD-321 WORD)))
)
(/DECLAREDATATYPE 'GC-TEST-TYPE
'(POINTER POINTER POINTER BYTE FIXP POINTER WORD POINTER POINTER POINTER POINTER POINTER
POINTER FIXP POINTER XPOINTER POINTER BYTE FIXP POINTER BYTE POINTER POINTER POINTER
BYTE POINTER BYTE POINTER BYTE POINTER WORD POINTER XPOINTER POINTER FIXP POINTER
POINTER POINTER FLAG POINTER FLAG POINTER FIXP FIXP POINTER XPOINTER POINTER POINTER
POINTER FLAG BYTE POINTER POINTER BYTE POINTER POINTER BYTE WORD POINTER POINTER
XPOINTER POINTER POINTER XPOINTER XPOINTER POINTER POINTER POINTER POINTER FLAG
POINTER POINTER WORD POINTER FLAG POINTER POINTER POINTER POINTER FIXP FIXP POINTER
POINTER POINTER POINTER XPOINTER BYTE XPOINTER POINTER BYTE FLAG FIXP FIXP FLAG
POINTER FLAG POINTER FLAG POINTER POINTER POINTER POINTER POINTER XPOINTER POINTER
POINTER POINTER POINTER BYTE POINTER WORD POINTER XPOINTER FLAG FIXP POINTER POINTER
BYTE POINTER POINTER POINTER POINTER POINTER XPOINTER BYTE XPOINTER POINTER POINTER
FIXP FLAG POINTER POINTER POINTER POINTER WORD FLAG POINTER POINTER POINTER WORD FLAG
POINTER POINTER POINTER FIXP POINTER POINTER POINTER POINTER FLAG POINTER POINTER
POINTER POINTER FIXP POINTER BYTE POINTER FIXP WORD POINTER WORD FIXP POINTER FIXP
POINTER FLAG BYTE POINTER POINTER XPOINTER BYTE POINTER POINTER FLAG BYTE WORD POINTER
FIXP POINTER POINTER BYTE POINTER POINTER POINTER POINTER POINTER BYTE FIXP POINTER
POINTER POINTER BYTE POINTER WORD POINTER POINTER POINTER POINTER WORD POINTER FLAG
POINTER XPOINTER POINTER POINTER POINTER FLAG POINTER WORD BYTE POINTER POINTER
POINTER FIXP POINTER POINTER XPOINTER POINTER FLAG POINTER FLAG WORD FLAG WORD POINTER
POINTER POINTER POINTER POINTER XPOINTER POINTER WORD WORD POINTER POINTER POINTER
POINTER POINTER POINTER POINTER XPOINTER POINTER WORD POINTER POINTER XPOINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER XPOINTER
POINTER FIXP POINTER POINTER XPOINTER POINTER WORD FLAG POINTER POINTER POINTER
POINTER POINTER BYTE POINTER POINTER FLAG BYTE POINTER POINTER POINTER XPOINTER WORD
WORD POINTER POINTER POINTER WORD POINTER XPOINTER BYTE POINTER XPOINTER FLAG POINTER
POINTER FLAG POINTER POINTER XPOINTER FIXP FIXP BYTE POINTER POINTER POINTER POINTER
FIXP POINTER FLAG FIXP POINTER XPOINTER POINTER POINTER BYTE POINTER WORD FIXP POINTER
FLAG POINTER WORD)
'((GC-TEST-TYPE 0 POINTER)
(GC-TEST-TYPE 2 POINTER)
(GC-TEST-TYPE 4 POINTER)
(GC-TEST-TYPE 4 (BITS . 7))
(GC-TEST-TYPE 6 FIXP)
(GC-TEST-TYPE 8 POINTER)
(GC-TEST-TYPE 10 (BITS . 15))
(GC-TEST-TYPE 12 POINTER)
(GC-TEST-TYPE 14 POINTER)
(GC-TEST-TYPE 16 POINTER)
(GC-TEST-TYPE 18 POINTER)
(GC-TEST-TYPE 20 POINTER)
(GC-TEST-TYPE 22 POINTER)
(GC-TEST-TYPE 24 FIXP)
(GC-TEST-TYPE 26 POINTER)
(GC-TEST-TYPE 28 XPOINTER)
(GC-TEST-TYPE 30 POINTER)
(GC-TEST-TYPE 30 (BITS . 7))
(GC-TEST-TYPE 32 FIXP)
(GC-TEST-TYPE 34 POINTER)
(GC-TEST-TYPE 34 (BITS . 7))
(GC-TEST-TYPE 36 POINTER)
(GC-TEST-TYPE 38 POINTER)
(GC-TEST-TYPE 40 POINTER)
(GC-TEST-TYPE 40 (BITS . 7))
(GC-TEST-TYPE 42 POINTER)
(GC-TEST-TYPE 42 (BITS . 7))
(GC-TEST-TYPE 44 POINTER)
(GC-TEST-TYPE 44 (BITS . 7))
(GC-TEST-TYPE 46 POINTER)
(GC-TEST-TYPE 11 (BITS . 15))
(GC-TEST-TYPE 48 POINTER)
(GC-TEST-TYPE 50 XPOINTER)
(GC-TEST-TYPE 52 POINTER)
(GC-TEST-TYPE 54 FIXP)
(GC-TEST-TYPE 56 POINTER)
(GC-TEST-TYPE 58 POINTER)
(GC-TEST-TYPE 60 POINTER)
(GC-TEST-TYPE 60 (FLAGBITS . 0))
(GC-TEST-TYPE 62 POINTER)
(GC-TEST-TYPE 62 (FLAGBITS . 0))
(GC-TEST-TYPE 64 POINTER)
(GC-TEST-TYPE 66 FIXP)
(GC-TEST-TYPE 68 FIXP)
(GC-TEST-TYPE 70 POINTER)
(GC-TEST-TYPE 72 XPOINTER)
(GC-TEST-TYPE 74 POINTER)
(GC-TEST-TYPE 76 POINTER)
(GC-TEST-TYPE 78 POINTER)
(GC-TEST-TYPE 78 (FLAGBITS . 0))
(GC-TEST-TYPE 76 (BITS . 7))
(GC-TEST-TYPE 80 POINTER)
(GC-TEST-TYPE 82 POINTER)
(GC-TEST-TYPE 82 (BITS . 7))
(GC-TEST-TYPE 84 POINTER)
(GC-TEST-TYPE 86 POINTER)
(GC-TEST-TYPE 86 (BITS . 7))
(GC-TEST-TYPE 88 (BITS . 15))
(GC-TEST-TYPE 90 POINTER)
(GC-TEST-TYPE 92 POINTER)
(GC-TEST-TYPE 94 XPOINTER)
(GC-TEST-TYPE 96 POINTER)
(GC-TEST-TYPE 98 POINTER)
(GC-TEST-TYPE 100 XPOINTER)
(GC-TEST-TYPE 102 XPOINTER)
(GC-TEST-TYPE 104 POINTER)
(GC-TEST-TYPE 106 POINTER)
(GC-TEST-TYPE 108 POINTER)
(GC-TEST-TYPE 110 POINTER)
(GC-TEST-TYPE 110 (FLAGBITS . 0))
(GC-TEST-TYPE 112 POINTER)
(GC-TEST-TYPE 114 POINTER)
(GC-TEST-TYPE 89 (BITS . 15))
(GC-TEST-TYPE 116 POINTER)
(GC-TEST-TYPE 116 (FLAGBITS . 0))
(GC-TEST-TYPE 118 POINTER)
(GC-TEST-TYPE 120 POINTER)
(GC-TEST-TYPE 122 POINTER)
(GC-TEST-TYPE 124 POINTER)
(GC-TEST-TYPE 126 FIXP)
(GC-TEST-TYPE 128 FIXP)
(GC-TEST-TYPE 130 POINTER)
(GC-TEST-TYPE 132 POINTER)
(GC-TEST-TYPE 134 POINTER)
(GC-TEST-TYPE 136 POINTER)
(GC-TEST-TYPE 138 XPOINTER)
(GC-TEST-TYPE 138 (BITS . 7))
(GC-TEST-TYPE 140 XPOINTER)
(GC-TEST-TYPE 142 POINTER)
(GC-TEST-TYPE 142 (BITS . 7))
(GC-TEST-TYPE 140 (FLAGBITS . 0))
(GC-TEST-TYPE 144 FIXP)
(GC-TEST-TYPE 146 FIXP)
(GC-TEST-TYPE 140 (FLAGBITS . 16))
(GC-TEST-TYPE 148 POINTER)
(GC-TEST-TYPE 148 (FLAGBITS . 0))
(GC-TEST-TYPE 150 POINTER)
(GC-TEST-TYPE 150 (FLAGBITS . 0))
(GC-TEST-TYPE 152 POINTER)
(GC-TEST-TYPE 154 POINTER)
(GC-TEST-TYPE 156 POINTER)
(GC-TEST-TYPE 158 POINTER)
(GC-TEST-TYPE 160 POINTER)
(GC-TEST-TYPE 162 XPOINTER)
(GC-TEST-TYPE 164 POINTER)
(GC-TEST-TYPE 166 POINTER)
(GC-TEST-TYPE 168 POINTER)
(GC-TEST-TYPE 170 POINTER)
(GC-TEST-TYPE 170 (BITS . 7))
(GC-TEST-TYPE 172 POINTER)
(GC-TEST-TYPE 174 (BITS . 15))
(GC-TEST-TYPE 176 POINTER)
(GC-TEST-TYPE 178 XPOINTER)
(GC-TEST-TYPE 178 (FLAGBITS . 0))
(GC-TEST-TYPE 180 FIXP)
(GC-TEST-TYPE 182 POINTER)
(GC-TEST-TYPE 184 POINTER)
(GC-TEST-TYPE 184 (BITS . 7))
(GC-TEST-TYPE 186 POINTER)
(GC-TEST-TYPE 188 POINTER)
(GC-TEST-TYPE 190 POINTER)
(GC-TEST-TYPE 192 POINTER)
(GC-TEST-TYPE 194 POINTER)
(GC-TEST-TYPE 196 XPOINTER)
(GC-TEST-TYPE 196 (BITS . 7))
(GC-TEST-TYPE 198 XPOINTER)
(GC-TEST-TYPE 200 POINTER)
(GC-TEST-TYPE 202 POINTER)
(GC-TEST-TYPE 204 FIXP)
(GC-TEST-TYPE 202 (FLAGBITS . 0))
(GC-TEST-TYPE 206 POINTER)
(GC-TEST-TYPE 208 POINTER)
(GC-TEST-TYPE 210 POINTER)
(GC-TEST-TYPE 212 POINTER)
(GC-TEST-TYPE 175 (BITS . 15))
(GC-TEST-TYPE 212 (FLAGBITS . 0))
(GC-TEST-TYPE 214 POINTER)
(GC-TEST-TYPE 216 POINTER)
(GC-TEST-TYPE 218 POINTER)
(GC-TEST-TYPE 220 (BITS . 15))
(GC-TEST-TYPE 218 (FLAGBITS . 0))
(GC-TEST-TYPE 222 POINTER)
(GC-TEST-TYPE 224 POINTER)
(GC-TEST-TYPE 226 POINTER)
(GC-TEST-TYPE 228 FIXP)
(GC-TEST-TYPE 230 POINTER)
(GC-TEST-TYPE 232 POINTER)
(GC-TEST-TYPE 234 POINTER)
(GC-TEST-TYPE 236 POINTER)
(GC-TEST-TYPE 236 (FLAGBITS . 0))
(GC-TEST-TYPE 238 POINTER)
(GC-TEST-TYPE 240 POINTER)
(GC-TEST-TYPE 242 POINTER)
(GC-TEST-TYPE 244 POINTER)
(GC-TEST-TYPE 246 FIXP)
(GC-TEST-TYPE 248 POINTER)
(GC-TEST-TYPE 248 (BITS . 7))
(GC-TEST-TYPE 250 POINTER)
(GC-TEST-TYPE 252 FIXP)
(GC-TEST-TYPE 221 (BITS . 15))
(GC-TEST-TYPE 254 POINTER)
(GC-TEST-TYPE 256 (BITS . 15))
(GC-TEST-TYPE 257 FIXP)
(GC-TEST-TYPE 260 POINTER)
(GC-TEST-TYPE 262 FIXP)
(GC-TEST-TYPE 264 POINTER)
(GC-TEST-TYPE 264 (FLAGBITS . 0))
(GC-TEST-TYPE 260 (BITS . 7))
(GC-TEST-TYPE 266 POINTER)
(GC-TEST-TYPE 268 POINTER)
(GC-TEST-TYPE 270 XPOINTER)
(GC-TEST-TYPE 270 (BITS . 7))
(GC-TEST-TYPE 272 POINTER)
(GC-TEST-TYPE 274 POINTER)
(GC-TEST-TYPE 274 (FLAGBITS . 0))
(GC-TEST-TYPE 272 (BITS . 7))
(GC-TEST-TYPE 259 (BITS . 15))
(GC-TEST-TYPE 276 POINTER)
(GC-TEST-TYPE 278 FIXP)
(GC-TEST-TYPE 280 POINTER)
(GC-TEST-TYPE 282 POINTER)
(GC-TEST-TYPE 282 (BITS . 7))
(GC-TEST-TYPE 284 POINTER)
(GC-TEST-TYPE 286 POINTER)
(GC-TEST-TYPE 288 POINTER)
(GC-TEST-TYPE 290 POINTER)
(GC-TEST-TYPE 292 POINTER)
(GC-TEST-TYPE 292 (BITS . 7))
(GC-TEST-TYPE 294 FIXP)
(GC-TEST-TYPE 296 POINTER)
(GC-TEST-TYPE 298 POINTER)
(GC-TEST-TYPE 300 POINTER)
(GC-TEST-TYPE 300 (BITS . 7))
(GC-TEST-TYPE 302 POINTER)
(GC-TEST-TYPE 304 (BITS . 15))
(GC-TEST-TYPE 306 POINTER)
(GC-TEST-TYPE 308 POINTER)
(GC-TEST-TYPE 310 POINTER)
(GC-TEST-TYPE 312 POINTER)
(GC-TEST-TYPE 305 (BITS . 15))
(GC-TEST-TYPE 314 POINTER)
(GC-TEST-TYPE 314 (FLAGBITS . 0))
(GC-TEST-TYPE 316 POINTER)
(GC-TEST-TYPE 318 XPOINTER)
(GC-TEST-TYPE 320 POINTER)
(GC-TEST-TYPE 322 POINTER)
(GC-TEST-TYPE 324 POINTER)
(GC-TEST-TYPE 324 (FLAGBITS . 0))
(GC-TEST-TYPE 326 POINTER)
(GC-TEST-TYPE 328 (BITS . 15))
(GC-TEST-TYPE 326 (BITS . 7))
(GC-TEST-TYPE 330 POINTER)
(GC-TEST-TYPE 332 POINTER)
(GC-TEST-TYPE 334 POINTER)
(GC-TEST-TYPE 336 FIXP)
(GC-TEST-TYPE 338 POINTER)
(GC-TEST-TYPE 340 POINTER)
(GC-TEST-TYPE 342 XPOINTER)
(GC-TEST-TYPE 344 POINTER)
(GC-TEST-TYPE 344 (FLAGBITS . 0))
(GC-TEST-TYPE 346 POINTER)
(GC-TEST-TYPE 346 (FLAGBITS . 0))
(GC-TEST-TYPE 329 (BITS . 15))
(GC-TEST-TYPE 346 (FLAGBITS . 16))
(GC-TEST-TYPE 348 (BITS . 15))
(GC-TEST-TYPE 350 POINTER)
(GC-TEST-TYPE 352 POINTER)
(GC-TEST-TYPE 354 POINTER)
(GC-TEST-TYPE 356 POINTER)
(GC-TEST-TYPE 358 POINTER)
(GC-TEST-TYPE 360 XPOINTER)
(GC-TEST-TYPE 362 POINTER)
(GC-TEST-TYPE 349 (BITS . 15))
(GC-TEST-TYPE 364 (BITS . 15))
(GC-TEST-TYPE 366 POINTER)
(GC-TEST-TYPE 368 POINTER)
(GC-TEST-TYPE 370 POINTER)
(GC-TEST-TYPE 372 POINTER)
(GC-TEST-TYPE 374 POINTER)
(GC-TEST-TYPE 376 POINTER)
(GC-TEST-TYPE 378 POINTER)
(GC-TEST-TYPE 380 XPOINTER)
(GC-TEST-TYPE 382 POINTER)
(GC-TEST-TYPE 365 (BITS . 15))
(GC-TEST-TYPE 384 POINTER)
(GC-TEST-TYPE 386 POINTER)
(GC-TEST-TYPE 388 XPOINTER)
(GC-TEST-TYPE 390 POINTER)
(GC-TEST-TYPE 392 POINTER)
(GC-TEST-TYPE 394 POINTER)
(GC-TEST-TYPE 396 POINTER)
(GC-TEST-TYPE 398 POINTER)
(GC-TEST-TYPE 400 POINTER)
(GC-TEST-TYPE 402 POINTER)
(GC-TEST-TYPE 404 POINTER)
(GC-TEST-TYPE 406 POINTER)
(GC-TEST-TYPE 408 POINTER)
(GC-TEST-TYPE 410 XPOINTER)
(GC-TEST-TYPE 412 POINTER)
(GC-TEST-TYPE 414 FIXP)
(GC-TEST-TYPE 416 POINTER)
(GC-TEST-TYPE 418 POINTER)
(GC-TEST-TYPE 420 XPOINTER)
(GC-TEST-TYPE 422 POINTER)
(GC-TEST-TYPE 424 (BITS . 15))
(GC-TEST-TYPE 422 (FLAGBITS . 0))
(GC-TEST-TYPE 426 POINTER)
(GC-TEST-TYPE 428 POINTER)
(GC-TEST-TYPE 430 POINTER)
(GC-TEST-TYPE 432 POINTER)
(GC-TEST-TYPE 434 POINTER)
(GC-TEST-TYPE 434 (BITS . 7))
(GC-TEST-TYPE 436 POINTER)
(GC-TEST-TYPE 438 POINTER)
(GC-TEST-TYPE 438 (FLAGBITS . 0))
(GC-TEST-TYPE 436 (BITS . 7))
(GC-TEST-TYPE 440 POINTER)
(GC-TEST-TYPE 442 POINTER)
(GC-TEST-TYPE 444 POINTER)
(GC-TEST-TYPE 446 XPOINTER)
(GC-TEST-TYPE 425 (BITS . 15))
(GC-TEST-TYPE 448 (BITS . 15))
(GC-TEST-TYPE 450 POINTER)
(GC-TEST-TYPE 452 POINTER)
(GC-TEST-TYPE 454 POINTER)
(GC-TEST-TYPE 449 (BITS . 15))
(GC-TEST-TYPE 456 POINTER)
(GC-TEST-TYPE 458 XPOINTER)
(GC-TEST-TYPE 458 (BITS . 7))
(GC-TEST-TYPE 460 POINTER)
(GC-TEST-TYPE 462 XPOINTER)
(GC-TEST-TYPE 462 (FLAGBITS . 0))
(GC-TEST-TYPE 464 POINTER)
(GC-TEST-TYPE 466 POINTER)
(GC-TEST-TYPE 466 (FLAGBITS . 0))
(GC-TEST-TYPE 468 POINTER)
(GC-TEST-TYPE 470 POINTER)
(GC-TEST-TYPE 472 XPOINTER)
(GC-TEST-TYPE 474 FIXP)
(GC-TEST-TYPE 476 FIXP)
(GC-TEST-TYPE 472 (BITS . 7))
(GC-TEST-TYPE 478 POINTER)
(GC-TEST-TYPE 480 POINTER)
(GC-TEST-TYPE 482 POINTER)
(GC-TEST-TYPE 484 POINTER)
(GC-TEST-TYPE 486 FIXP)
(GC-TEST-TYPE 488 POINTER)
(GC-TEST-TYPE 488 (FLAGBITS . 0))
(GC-TEST-TYPE 490 FIXP)
(GC-TEST-TYPE 492 POINTER)
(GC-TEST-TYPE 494 XPOINTER)
(GC-TEST-TYPE 496 POINTER)
(GC-TEST-TYPE 498 POINTER)
(GC-TEST-TYPE 498 (BITS . 7))
(GC-TEST-TYPE 500 POINTER)
(GC-TEST-TYPE 502 (BITS . 15))
(GC-TEST-TYPE 503 FIXP)
(GC-TEST-TYPE 506 POINTER)
(GC-TEST-TYPE 506 (FLAGBITS . 0))
(GC-TEST-TYPE 508 POINTER)
(GC-TEST-TYPE 505 (BITS . 15)))
'510)
(* |;;| "DATATYPE TESTS")
(* |;;| "CODE RECLAIMATION TESTS")
(DEFINEQ
(CODE-RECLAIM-TEST
(LAMBDA (LIMIT) (* \; "Edited 23-Jun-88 11:54 by jds")
(LET NIL
(* |;;| "Make sure there's a definition to compile.")
(OR (GETD 'CODE-RECLAIM-TEST-TEMP-FN)
(EVAL CODE-RECLAIM-TEST-TEMP-FN))
(PRINTOUT T " Starting code-block reclaim test" T)
(|for| I |from| 1 |to| LIMIT |do| (BKSYSBUF "ST
N
")
(COMPILE 'CODE-RECLAIM-TEST-TEMP-FN))
(PRINTOUT T " Starting MAPATOMS(GETD)" T)
(|for| I |from| 1 |to| LIMIT |do| (MAPATOMS (FUNCTION GETD)))
(PRINTOUT T " Starting MAPATOMS(MOVD to DUMMYFN)" T)
(FOR I FROM 1 TO LIMIT DO (MAPATOMS #'(LAMBDA (FN-NAME)
(AND (GETD FN-NAME)
(MOVD FN-NAME
'MAIKO-GC-TEST-DUMMY-FN))
))))))
)
(* |;;|
"The function that is repeatedly compiled to test that code-block constants inside code blocks are reclaimed."
)
(RPAQQ CODE-RECLAIM-TEST-TEMP-FN
(DEFINEQ (CODE-RECLAIM-TEST-TEMP-FN (ASDF)
(LET (I)
(FOR I FROM 1 TO 10 COLLECT (SQRT 4.5))
(ERSETQ (DATE))
(NLSETQ (DATE))
(ERSETQ (DATE))
(NLSETQ (DATE))
(ERSETQ (DATE))
(CL:FLET ((TEMP (ARG)
(SETQ ARG (FLOAT ARG))
(EXPT (SQRT I)
(SQRT (COS (/ I 180))))))
(CL:UNWIND-PROTECT
(FOR I FROM 1 TO 1000 COLLECT (TEMP I))
(SETQ I NIL)))))))
(PUTPROPS MAIKO-GC-TESTS COPYRIGHT ("John Sybalsky & Xerox Corporation" 1988))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (2794 5208 (MAIN-GC-TEST 2804 . 5206)) (5209 13651 (ITEMS-ON-STACK-TEST 5219 . 6382) (
MANY-BIGNUM-MAKER 6384 . 7256) (MANY-FIXP-MAKER 7258 . 8044) (MANY-FLOAT-MAKER 8046 . 8653) (
BOUNDARY-TESTS 8655 . 11122) (ARRAY-STRING-TEST 11124 . 13070) (VARIOUS-TYPES-TEST 13072 . 13649)) (
13652 18513 (TEDIT-CRUNCH-TEST 13662 . 15074) (LIST-MANIPULATION-TEST 15076 . 18511)) (18514 19198 (
ATOM-FULL-TEST 18524 . 18955) (STORAGE-FULL-TEST 18957 . 19196)) (19199 19717 (DATATYPE-TEST 19209 .
19715)) (44700 45875 (CODE-RECLAIM-TEST 44710 . 45873)))))
STOP

View File

@@ -1,13 +0,0 @@
;;; Test results for sysout of 12-Feb-88 18:51:29
;;; Tests run on 17-Feb-88 14:16:42
;;; Running tests from ({eris}<test>i/o>keyboard>hand>*.u;)
Test "load the functions for the prompter for interactive tests" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>ASKUSER.U;1"
:BEFORE forms for test "Testing AskUser" in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>ASKUSER.U;1" failed.
Test "load the functions for the prompter for interactive tests" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>PROMPTFORWORD.U;1"
:BEFORE forms for test "Testing PromptForWord" in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>PROMPTFORWORD.U;1" failed.
Test "load the functions for the prompter for interactive tests" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>READNUMBER.U;1"
:BEFORE forms for test "Testing ReadNumber" in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>READNUMBER.U;1" failed.
Test "load the functions for the prompter for interactive tests" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>TTYIN.U;1"
:BEFORE forms for test "Testing TTYIN" in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>TTYIN.U;1" failed.
(END-OF-TESTS)

View File

@@ -1,13 +0,0 @@
;;; Test results for sysout of 12-Feb-88 18:51:29
;;; Tests run on 17-Feb-88 14:21:48
;;; Running tests from ({eris}<test>i/o>keyboard>hand>*.u;)
Test "load the functions for the prompter for interactive tests" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>ASKUSER.U;1"
:BEFORE forms for test "Testing AskUser" in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>ASKUSER.U;1" failed.
Test "load the functions for the prompter for interactive tests" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>PROMPTFORWORD.U;1"
:BEFORE forms for test "Testing PromptForWord" in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>PROMPTFORWORD.U;1" failed.
Test "load the functions for the prompter for interactive tests" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>READNUMBER.U;1"
:BEFORE forms for test "Testing ReadNumber" in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>READNUMBER.U;1" failed.
Test "load the functions for the prompter for interactive tests" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>TTYIN.U;1"
:BEFORE forms for test "Testing TTYIN" in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>TTYIN.U;1" failed.
(END-OF-TESTS)

View File

@@ -1,15 +0,0 @@
;;; Test results for sysout of 12-Feb-88 18:51:29
;;; Tests run on 2-Mar-88 15:20:41
;;; Running tests from ({ERIS}<TEST>I/O>Keyboard>Hand>*.U)
Test "TTYIN, test default in the XCL exec" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>ASKUSER.U;1"
Test "Test decimal & abort" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>READNUMBER.U;1"
Test "Test number font" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>READNUMBER.U;1"
Test "Test can call from XCL" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>READNUMBER.U;1"
Test "Test create.numberpad.reader" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>READNUMBER.U;1"
Test "Test create.numberpad.reader" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>READNUMBER.U;1"
Test "Test shift select for TTYIN in XCL-TEST exec" failed in file "{ERIS}<TEST>I/O>KEYBOARD>HAND>TTYIN.U;1"
(END-OF-TESTS)

View File

@@ -1,253 +0,0 @@
;; Being tested: DEdit
;;
;; Source:
;;
;; Created By: Henry Cate III
;;
;; Creation Date: March 2, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>DEdit>high-level.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Just touch various commands"
:before (progn
(setq window-list (do-test-menu-Setup "Various commands in DEdit")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Test able to bring up SEdit"
(let* ((user-result (do-test-menu-Message window-list 'high
" Test able to bring up SEdit
If there is no free Interlisp exec, bring up a another one.
In the Interlisp exec type:
(FILESLOAD dedit)
(EDITMODE 'DEDIT)
(SETQ tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(ED 'tempx)
Click on the last option in the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (EQUAL '(1 4.5 6/7 il:\a il:|cd| il:|efg| "hello" "BYE" (il:|bye|) ("hi" (il:\b) il:|cd| 4)) (il:eval 'il:|tempx|))))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Now try placing something after"
(let* ((user-result (do-test-menu-Message window-list 'high
" Now try placing something after
Assumping DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
In an Interlisp exec type: \"(ED 'tempx)\"
Click twice on the litatom \"efg\".
Type \"h\" and press the carriage return.
Select the first option on the DEdit menu, \"After\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (EQUAL '(1 4.5 6/7 il:\a il:|cd| il:|efg| il:\h "hello" "BYE" (il:|bye|) ("hi" (il:\b) il:|cd| 4)) (il:eval 'il:|tempx|))))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Try placing something before"
(let* ((user-result (do-test-menu-Message window-list 'high
" Try placing something before
Assumping DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg h \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
In an Interlisp exec type: \"(ED 'tempx)\"
Click twice on the litatom \"bye\".
Type \"Good\" and press the carriage return.
Select the option on the DEdit menu, \"Before\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (EQUAL '(1 4.5 6/7 il:\a il:|cd| il:|efg| il:\h "hello" "BYE" (il:|Good| il:|bye|) ("hi" (il:\b) il:|cd| 4)) (il:eval 'il:|tempx|))))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Try deleting"
(let* ((user-result (do-test-menu-Message window-list 'high
" Try deleting
Assumping DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg h \"hello\" \"BYE\" (Good bye) \"hi\" (b) cd 4))
In an Interlisp exec type: \"(ED 'tempx)\"
Click twice on the litatom \"Good\".
Select the option on the DEdit menu, \"Delete\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (EQUAL '(1 4.5 6/7 il:\a il:|cd| il:|efg| il:\h "hello" "BYE" (il:|bye|) ("hi" (il:\b) il:|cd| 4)) (il:eval 'il:|tempx|))))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Try from XCL-text"
(let* ((user-result (do-test-menu-Message window-list 'high
" Try from XCL-text
Close the old DEdit window.
If there is no free Xerox Common Lisp exec, bring up a another one.
In the Xerox Common Lisp exec type:
(cl:in-package 'xcl-test)
(SETQ tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(ED 'tempx)
Click on the last option in the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (EQUAL '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Test replace"
(let* ((user-result (do-test-menu-Message window-list 'high
" Test replace
Assumping DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
In the XCL-test exec type: \"(ED 'tempx)\"
Click twice on the litatom \"efg\".
Type \"gfe\" and press the carriage return.
Select the option on the DEdit menu, \"Replace\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (equal '(1 4.5 6/7 a cd gfe "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Test switch"
(let* ((user-result (do-test-menu-Message window-list 'high
" Test switch
Assumping DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd gfe \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
In the XCL-test exec type: \"(ED 'tempx)\"
First click the litatom \"efg\".
Then click on the number \"4.5\".
Select the option on the DEdit menu, \"Switch\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (equal '(1 gfe 6/7 a cd 4.5 "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Try with dv."
(let* ((user-result (do-test-menu-Message window-list 'high
" Try with dv.
Close the old DEdit window.
In the Xerox Common Lisp exec type:
(SETQ tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(il:dv tempx)
Click on the last option in the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (EQUAL '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "parenthesize"
(let* ((user-result (do-test-menu-Message window-list 'high
" parenthesize
Assumping DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
In the XCL-test exec type: \"(il:dv 'tempx)\"
Click twice on the string \"hello\".
Select the option on the DEdit menu, \"()\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (equal '(1 4.5 6/7 a cd efg ("hello") "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Un parenthesize"
(let* ((user-result (do-test-menu-Message window-list 'high
" Un parenthesize
Assumping DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg (\"hello\") \"BYE\" (bye) (\"hi\" (b) cd 4))
In the XCL-test exec type: \"(il:dv 'tempx)\"
First click the list \"(b)\".
Select the option on the DEdit menu, \"() out\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (equal '(1 4.5 6/7 a cd efg ("hello") "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Now try editing a function"
(do-test-menu-Message window-list 'high
" Now try editing a function
Close the old DEdit window.
In the Xerox Common Lisp exec type:
(defun temp-silly-bottom-fun (a b c) (list a b c))
(defun temp-silly-fun (a b c) (temp-silly-bottom-fun a b c))
(ED 'temp-silly-fun)
Were you able to get this far? "))
(do-test "See if find works."
(do-test-menu-Message window-list 'high
" See if find works.
Assumping DEdit is editing the function temp-silly-fun
Click twice on the first occurance of the litatom \"b\"
Select the option on the DEdit menu, \"Find\"
Did DEdit find the second occurance of the litatom \"b\"? "))
(do-test "Test swap"
(do-test-menu-Message window-list 'high
" Test swap
Assumping DEdit is editing the function temp-silly-fun
First click on the first occurance of the litatom \"b\"
Then click on the second occurance of the litatom \"c\"
Select the option on the DEdit menu, \"Swap\"
Did the solid underline and dotted underline switch places? "))
(do-test "Test reprint"
(do-test-menu-Message window-list 'high
" Test reprint
Assumping DEdit is editing the function temp-silly-fun
Watch carefully,
Select the option on the DEdit menu, \"Reprint\"
Does the function get reprinted? (Do the underlines get reprinted?) "))
(do-test "Test editing of other functions"
(do-test-menu-Message window-list 'high
" Test editing of other functions
Assumping DEdit is editing the function temp-silly-fun
Click on the function call to \"temp-silly-bottom-fun\"
Select the option on the DEdit menu, \"Edit\"
Does the second function come up in DEdit? "))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the DEdit window by selecting Exit from both option window menus as they appear."))
) ; end of do-test-group
STOP

View File

@@ -1,254 +0,0 @@
;; Being tested: DEdit
;;
;; Source:
;;
;; Created By: Henry Cate III
;;
;; Creation Date: March 2, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>DEdit>high-level.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Just touch various commands"
:before (progn
(setq window-list (do-test-menu-Setup "Various commands in DEdit")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Test able to bring up SEdit"
(let* ((user-result (do-test-menu-Message window-list 'high
" Test able to bring up SEdit
If there is no free Interlisp exec, bring up a another one.
In the Interlisp exec type:
(FILESLOAD dedit)
(EDITMODE 'DEDIT)
(SETQ tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(ED 'tempx)
Click on the last option in the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (EQUAL '(1 4.5 6/7 il:\a il:|cd| il:|efg| "hello" "BYE" (il:|bye|) ("hi" (il:\b) il:|cd| 4)) (il:eval 'il:|tempx|))))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Now try placing something after"
(let* ((user-result (do-test-menu-Message window-list 'high
" Now try placing something after
Assuming DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
In an Interlisp exec type: \"(ED 'tempx)\"
Click twice on the litatom \"efg\".
Type \"h\" and press the carriage return.
Select the first option on the DEdit menu, \"After\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (EQUAL '(1 4.5 6/7 il:\a il:|cd| il:|efg| il:\h "hello" "BYE" (il:|bye|) ("hi" (il:\b) il:|cd| 4)) (il:eval 'il:|tempx|))))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Try placing something before"
(let* ((user-result (do-test-menu-Message window-list 'high
" Try placing something before
Assuming DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg h \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
In an Interlisp exec type: \"(ED 'tempx)\"
Click twice with the left mouse button on the litatom \"bye\".
Type \"Good\" and press the carriage return.
Select the option on the DEdit menu, \"Before\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (EQUAL '(1 4.5 6/7 il:\a il:|cd| il:|efg| il:\h "hello" "BYE" (il:|Good| il:|bye|) ("hi" (il:\b) il:|cd| 4)) (il:eval 'il:|tempx|))))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Try deleting"
(let* ((user-result (do-test-menu-Message window-list 'high
" Try deleting
Assuming DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg h \"hello\" \"BYE\" (Good bye) \"hi\" (b) cd 4))
In an Interlisp exec type: \"(ED 'tempx)\"
Click twice with the left mouse button on the litatom \"Good\".
Select the option on the DEdit menu, \"Delete\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (EQUAL '(1 4.5 6/7 il:\a il:|cd| il:|efg| il:\h "hello" "BYE" (il:|bye|) ("hi" (il:\b) il:|cd| 4)) (il:eval 'il:|tempx|))))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Try from XCL-text"
(let* ((user-result (do-test-menu-Message window-list 'high
" Try from XCL-text
Close the old DEdit window.
If there is no free Xerox Common Lisp exec, bring up a another one.
In the Xerox Common Lisp exec type:
(cl:in-package 'xcl-test)
(SETQ tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(ED 'tempx)
Click on the last option in the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (EQUAL '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Test replace"
(let* ((user-result (do-test-menu-Message window-list 'high
" Test replace
Assuming DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
In the XCL-test exec type: \"(ED 'tempx)\"
Click twice with the left mouse button on the litatom \"efg\".
Type \"gfe\" and press the carriage return.
Select the option on the DEdit menu, \"Replace\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (equal '(1 4.5 6/7 a cd gfe "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Test switch"
(let* ((user-result (do-test-menu-Message window-list 'high
" Test switch
Assuming DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd gfe \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
In the XCL-test exec type: \"(ED 'tempx)\"
First click the litatom \"efg\" with the left mouse button.
Then click on the number \"4.5\".
Select the option on the DEdit menu, \"Switch\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (equal '(1 gfe 6/7 a cd 4.5 "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Try with dv."
(let* ((user-result (do-test-menu-Message window-list 'high
" Try with dv.
Close the old DEdit window.
In the Xerox Common Lisp exec type:
(SETQ tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(il:dv tempx)
Click on the last option in the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (EQUAL '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "parenthesize"
(let* ((user-result (do-test-menu-Message window-list 'high
" parenthesize
Assuming DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
In the XCL-test exec type: \"(il:dv 'tempx)\"
Click twice with the left mouse button on the string \"hello\".
Select the option on the DEdit menu, \"()\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (equal '(1 4.5 6/7 a cd efg ("hello") "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Un parenthesize"
(let* ((user-result (do-test-menu-Message window-list 'high
" Un parenthesize
Assuming DEdit just finished editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg (\"hello\") \"BYE\" (bye) (\"hi\" (b) cd 4))
In the XCL-test exec type: \"(il:dv 'tempx)\"
First click the list \"(b)\" with the left mouse button on the \"(\".
Select the option on the DEdit menu, \"() out\"
Select the last option on the DEdit menu, \"Exit\"
Were you able to get this far? "))
(good-value (equal '(1 4.5 6/7 a cd efg ("hello") "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Now try editing a function"
(do-test-menu-Message window-list 'high
" Now try editing a function
Close the old DEdit window.
In the Xerox Common Lisp exec type:
(defun temp-silly-bottom-fun (a b c) (list a b c))
(defun temp-silly-fun (a b c) (temp-silly-bottom-fun a b c))
(ED 'temp-silly-fun)
Were you able to get this far? "))
(do-test "See if find works."
(do-test-menu-Message window-list 'high
" See if find works.
Assuming DEdit is editing the function temp-silly-fun
Click twice on the first occurance of the litatom \"b\"
Select the option on the DEdit menu, \"Find\"
Did DEdit find the second occurance of the litatom \"b\"? "))
(do-test "Test swap"
(do-test-menu-Message window-list 'high
" Test swap
Assuming DEdit is editing the function temp-silly-fun
First click with the left mouse button on the first occurance of the litatom \"b\"
Then click on the second occurance of the litatom \"c\"
Select the option on the DEdit menu, \"Swap\"
Did the solid underline and dotted underline switch places? "))
(do-test "Test reprint"
(do-test-menu-Message window-list 'high
" Test reprint
Assuming DEdit is editing the function temp-silly-fun
Select the entire function by clicking on the first \"(\" with the left mouse button.
Watch carefully,
Select the option on the DEdit menu, \"Reprint\"
Does the function get reprinted? (Do the underlines get reprinted?) "))
(do-test "Test editing of other functions"
(do-test-menu-Message window-list 'high
" Test editing of other functions
Assuming DEdit is editing the function temp-silly-fun
Click with the left mouse button on the function call to \"temp-silly-bottom-fun\"
Select the option on the DEdit menu, \"Edit\"
Does the second function come up in DEdit? "))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the DEdit window by selecting Exit from both option window menus as they appear."))
) ; end of do-test-group
STOP

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View File

@@ -1,44 +0,0 @@
;;; Test results for sysout of 10-Apr-87 10:19:34
;;; Tests run on 14-Apr-87 07:07:47
;;; Running tests from ({Eris}<Lispcore>Test>Debugger>debugger.u;)
il:ourfn is not broken.
il:ourfn is not broken.
Test "il:break of (sub-fn il:in superfn)" failed in file "DEBUGGER.U;14"
Test "AR 7618 BREAK :IN broken" failed in file "DEBUGGER.U;14"
il:ourfn is not broken.
il:ourfn is not broken.
Test "il:break-function :trace" failed in file "DEBUGGER.U;14"
our-fn is not broken.
il:ourfn is not broken.
Testing... "IL:HELPFLAG BREAK!"
Testing... "IL:HELPFLAG NIL"
Testing... "restore *test-mode*"
Test "IL:HELPFLAG IL:SETTOPVAL (AR 7845)" failed in file "DEBUGGER.U;14"
Test "simple unbreak" failed in file "DEBUGGER.U;14"
super-fn is not broken.
Test "unbreak of (sub-fn il:in superfn)" failed in file "DEBUGGER.U;14"
super-fn is not broken.
Test "unbreak of (sub-fn in superfn)" failed in file "DEBUGGER.U;14"
super-fn is not broken.
Test "unbreak of '(sub-fn il:in superfn)" failed in file "DEBUGGER.U;14"
Test "simple il:rebreak" failed in file "DEBUGGER.U;14"
Test "simple untrace" failed in file "DEBUGGER.U;14"
Test "(untrace) with broken fns" failed in file "DEBUGGER.U;14"
Test "(untrace (sub-fn in super-fn))" failed in file "DEBUGGER.U;14"
Test "trace il:brokenfns check" failed in file "DEBUGGER.U;14"
Test "il:broken prop check" failed in file "DEBUGGER.U;14"
Test "simple interpreted trace" failed in file "DEBUGGER.U;14"
Test "simple compiled trace" failed in file "DEBUGGER.U;14"
Test "trace of subfunction" failed in file "DEBUGGER.U;14"
Test "trace of recursive subfunction" failed in file "DEBUGGER.U;14"
udffn is not a function.
our-fn is not broken.
Test "trace of undefined subfunction" failed in file "DEBUGGER.U;14"
Test "simple il:advise il:around of defun" failed in file "DEBUGGER.U;14"
Test "il:advise redefined broken defun" failed in file "DEBUGGER.U;14"
Test "il:advise redefined advised defun (AR 8172)" failed in file "DEBUGGER.U;14"
Test "simple il:unadvise" failed in file "DEBUGGER.U;14"
Test "il:unadvise t" failed in file "DEBUGGER.U;14"
(END-OF-TESTS)

View File

@@ -1,38 +0,0 @@
;;; Test results for sysout of 3-Mar-88 16:23:58
;;; Tests run on 7-Apr-87 20:01:15
;;; Running tests from ({eris}<test>env>debugger>hand>debugger.u;1)
il:ourfn is not broken.
il:ourfn is not broken.
Test "AR 7618 BREAK :IN broken" failed in file "DEBUGGER.U;1"
il:ourfn is not broken.
il:ourfn is not broken.
Test "il:break-function :trace" failed in file "DEBUGGER.U;1"
our-fn is not broken.
il:ourfn is not broken.
Testing... "IL:HELPFLAG BREAK!"
Testing... "IL:HELPFLAG NIL"
Testing... "restore *test-mode*"
Test "IL:HELPFLAG IL:SETTOPVAL (AR 7845)" failed in file "DEBUGGER.U;1"
Test "simple unbreak" failed in file "DEBUGGER.U;1"
super-fn is not broken.
Test "unbreak of (sub-fn il:in superfn)" failed in file "DEBUGGER.U;1"
super-fn is not broken.
Test "unbreak of (sub-fn in superfn)" failed in file "DEBUGGER.U;1"
super-fn is not broken.
Test "unbreak of '(sub-fn il:in superfn)" failed in file "DEBUGGER.U;1"
Test "simple il:rebreak" failed in file "DEBUGGER.U;1"
Test "simple untrace" failed in file "DEBUGGER.U;1"
Test "(untrace) with broken fns" failed in file "DEBUGGER.U;1"
Test "(untrace (sub-fn in super-fn))" failed in file "DEBUGGER.U;1"
Test "trace il:brokenfns check" failed in file "DEBUGGER.U;1"
Test "il:broken prop check" failed in file "DEBUGGER.U;1"
Test "simple interpreted trace" failed in file "DEBUGGER.U;1"
Test "trace of subfunction" failed in file "DEBUGGER.U;1"
Test "simple il:advise il:around of defun" failed in file "DEBUGGER.U;1"
Test "il:advise redefined broken defun" failed in file "DEBUGGER.U;1"
Test "il:advise redefined advised defun (AR 8172)" failed in file "DEBUGGER.U;1"
Test "simple il:unadvise" failed in file "DEBUGGER.U;1"
Test "il:unadvise t" failed in file "DEBUGGER.U;1"
(END-OF-TESTS)

View File

@@ -1,26 +0,0 @@
;;; Test results for sysout of 3-Mar-88 16:23:58
;;; Tests run on 7-Apr-87 20:01:15
;;; Running tests from ({eris}<test>env>debugger>hand>debugger.u;1)
Test "AR 7618 BREAK :IN broken" failed in file "DEBUGGER.U;1"
Test "il:break-function :trace" failed in file "DEBUGGER.U;1"
Test "IL:HELPFLAG IL:SETTOPVAL (AR 7845)" failed in file "DEBUGGER.U;1"
Test "simple unbreak" failed in file "DEBUGGER.U;1"
Test "unbreak of (sub-fn il:in superfn)" failed in file "DEBUGGER.U;1"
Test "unbreak of (sub-fn in superfn)" failed in file "DEBUGGER.U;1"
Test "unbreak of '(sub-fn il:in superfn)" failed in file "DEBUGGER.U;1"
Test "simple il:rebreak" failed in file "DEBUGGER.U;1"
Test "simple untrace" failed in file "DEBUGGER.U;1"
Test "(untrace) with broken fns" failed in file "DEBUGGER.U;1"
Test "(untrace (sub-fn in super-fn))" failed in file "DEBUGGER.U;1"
Test "trace il:brokenfns check" failed in file "DEBUGGER.U;1"
Test "il:broken prop check" failed in file "DEBUGGER.U;1"
Test "simple interpreted trace" failed in file "DEBUGGER.U;1"
Test "trace of subfunction" failed in file "DEBUGGER.U;1"
Test "simple il:advise il:around of defun" failed in file "DEBUGGER.U;1"
Test "il:advise redefined broken defun" failed in file "DEBUGGER.U;1"
Test "il:advise redefined advised defun (AR 8172)" failed in file "DEBUGGER.U;1"
Test "simple il:unadvise" failed in file "DEBUGGER.U;1"
Test "il:unadvise t" failed in file "DEBUGGER.U;1"
(END-OF-TESTS)

View File

@@ -1,34 +0,0 @@
;;; Test results for sysout of 11-Mar-87 13:49:38
;;; Tests run on 24-Mar-87 11:22:16
;;; Running tests from ({Eris}<Lispcore>Test>Debugger>debugger.u;)
Non DO-TEST form at top level in "DEBUGGER.U;12"
(in-package "XCL-TEST")
Test "il:break of il:broken fns update of il:brokenfns" failed in file "DEBUGGER.U;12"
Test "il:break of il:advisedfns updating il:brokenfns" failed in file "DEBUGGER.U;12"
Test "il:break of (sub-fn il:in superfn)" failed in file "DEBUGGER.U;12"
Test "il:break-function :trace" failed in file "DEBUGGER.U;12"
Testing... "IL:HELPFLAG BREAK!"
Testing... "IL:HELPFLAG NIL"
Testing... "restore *test-mode*"
Test "IL:HELPFLAG IL:SETTOPVAL" failed in file "DEBUGGER.U;12"
Test "unbreak of (sub-fn il:in superfn)" failed in file "DEBUGGER.U;12"
Test "unbreak of (sub-fn in superfn)" failed in file "DEBUGGER.U;12"
Test "unbreak of '(sub-fn il:in superfn)" failed in file "DEBUGGER.U;12"
Test "simple il:rebreak" failed in file "DEBUGGER.U;12"
Test "simple untrace" failed in file "DEBUGGER.U;12"
Test "(untrace) with broken fns" failed in file "DEBUGGER.U;12"
Test "(untrace (sub-fn in super-fn))" failed in file "DEBUGGER.U;12"
Test "trace il:brokenfns check" failed in file "DEBUGGER.U;12"
Test "il:broken prop check" failed in file "DEBUGGER.U;12"
Test "simple interpreted trace" failed in file "DEBUGGER.U;12"
Test "trace of subfunction" failed in file "DEBUGGER.U;12"
Test "trace of recursive subfunction" failed in file "DEBUGGER.U;12"
Test "trace of undefined subfunction" failed in file "DEBUGGER.U;12"
Test "simple il:advise il:around of defun" failed in file "DEBUGGER.U;12"
Test "il:advise redefined broken defun" failed in file "DEBUGGER.U;12"
Test "il:advise redefined advised defun (AR 8172)" failed in file "DEBUGGER.U;12"
Test "simple il:unadvise" failed in file "DEBUGGER.U;12"
Test "il:unadvise t" failed in file "DEBUGGER.U;12"
(END-OF-TESTS)

View File

@@ -1,32 +0,0 @@
;;; Test results for sysout of 11-Mar-87 13:49:38
;;; Tests run on 24-Mar-87 11:55:56
;;; Running tests from ({Eris}<Lispcore>Test>Debugger>debugger.u;)
Test "il:break of il:broken fns update of il:brokenfns" failed in file "DEBUGGER.U;13"
Test "il:break of il:advisedfns updating il:brokenfns" failed in file "DEBUGGER.U;13"
Test "il:break of (sub-fn il:in superfn)" failed in file "DEBUGGER.U;13"
Test "il:break-function :trace" failed in file "DEBUGGER.U;13"
Testing... "IL:HELPFLAG BREAK!"
Testing... "IL:HELPFLAG NIL"
Testing... "restore *test-mode*"
Test "IL:HELPFLAG IL:SETTOPVAL" failed in file "DEBUGGER.U;13"
Test "unbreak of (sub-fn il:in superfn)" failed in file "DEBUGGER.U;13"
Test "unbreak of (sub-fn in superfn)" failed in file "DEBUGGER.U;13"
Test "unbreak of '(sub-fn il:in superfn)" failed in file "DEBUGGER.U;13"
Test "simple il:rebreak" failed in file "DEBUGGER.U;13"
Test "simple untrace" failed in file "DEBUGGER.U;13"
Test "(untrace) with broken fns" failed in file "DEBUGGER.U;13"
Test "(untrace (sub-fn in super-fn))" failed in file "DEBUGGER.U;13"
Test "trace il:brokenfns check" failed in file "DEBUGGER.U;13"
Test "il:broken prop check" failed in file "DEBUGGER.U;13"
Test "simple interpreted trace" failed in file "DEBUGGER.U;13"
Test "trace of subfunction" failed in file "DEBUGGER.U;13"
Test "trace of recursive subfunction" failed in file "DEBUGGER.U;13"
Test "trace of undefined subfunction" failed in file "DEBUGGER.U;13"
Test "simple il:advise il:around of defun" failed in file "DEBUGGER.U;13"
Test "il:advise redefined broken defun" failed in file "DEBUGGER.U;13"
Test "il:advise redefined advised defun (AR 8172)" failed in file "DEBUGGER.U;13"
Test "simple il:unadvise" failed in file "DEBUGGER.U;13"
Test "il:unadvise t" failed in file "DEBUGGER.U;13"
(END-OF-TESTS)

View File

@@ -1,51 +0,0 @@
;;; Test results for sysout of 18-Apr-87 20:24:31
;;; Tests run on 7-Apr-87 20:01:15
;;; Running tests from ({eris}<lispcore>test>debugger>*.u;)
Test "step Debugger (AR 7709)" failed in file "BREAKWINDOW.U;5"
Test "step Finish" failed in file "BREAKWINDOW.U;5"
Test "@ foo" failed in file "BREAKWINDOW.U;5"
Test "@ = exec-read (AR 8062)" failed in file "BREAKWINDOW.U;5"
Test "@ number (AR 8062)" failed in file "BREAKWINDOW.U;5"
Test "EDIT search for editable fn (AR 8137)" failed in file "BREAKWINDOW.U;5"
Test "EDIT selected fn (AR 6231)" failed in file "BREAKWINDOW.U;5"
il:ourfn is not broken.
il:ourfn is not broken.
Test "il:break of (sub-fn il:in superfn)" failed in file "DEBUGGER.U;14"
Test "AR 7618 BREAK :IN broken" failed in file "DEBUGGER.U;14"
il:ourfn is not broken.
il:ourfn is not broken.
Test "il:break-function :trace" failed in file "DEBUGGER.U;14"
our-fn is not broken.
il:ourfn is not broken.
Testing... "IL:HELPFLAG BREAK!"
Testing... "IL:HELPFLAG NIL"
Testing... "restore *test-mode*"
Test "IL:HELPFLAG IL:SETTOPVAL (AR 7845)" failed in file "DEBUGGER.U;14"
Test "simple unbreak" failed in file "DEBUGGER.U;14"
super-fn is not broken.
Test "unbreak of (sub-fn il:in superfn)" failed in file "DEBUGGER.U;14"
super-fn is not broken.
Test "unbreak of (sub-fn in superfn)" failed in file "DEBUGGER.U;14"
super-fn is not broken.
Test "unbreak of '(sub-fn il:in superfn)" failed in file "DEBUGGER.U;14"
Test "simple il:rebreak" failed in file "DEBUGGER.U;14"
Test "simple untrace" failed in file "DEBUGGER.U;14"
Test "(untrace) with broken fns" failed in file "DEBUGGER.U;14"
Test "(untrace (sub-fn in super-fn))" failed in file "DEBUGGER.U;14"
Test "trace il:brokenfns check" failed in file "DEBUGGER.U;14"
Test "il:broken prop check" failed in file "DEBUGGER.U;14"
Test "simple interpreted trace" failed in file "DEBUGGER.U;14"
Test "trace of subfunction" failed in file "DEBUGGER.U;14"
Test "trace of recursive subfunction" failed in file "DEBUGGER.U;14"
udffn is not a function.
our-fn is not broken.
Test "trace of undefined subfunction" failed in file "DEBUGGER.U;14"
Test "simple il:advise il:around of defun" failed in file "DEBUGGER.U;14"
Test "il:advise redefined broken defun" failed in file "DEBUGGER.U;14"
Test "il:advise redefined advised defun (AR 8172)" failed in file "DEBUGGER.U;14"
Test "simple il:unadvise" failed in file "DEBUGGER.U;14"
Test "il:unadvise t" failed in file "DEBUGGER.U;14"
(END-OF-TESTS)

View File

@@ -1,48 +0,0 @@
;;; Test results for sysout of 26-Feb-88 11:29:20
;;; Tests run on 2-Mar-88 13:56:25
;;; Running tests from ({Eris}<Test>Env>Debugger>Hand>*.u;)
Test "step space" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "use value PROCEED command from menu" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "use value typed PROCEED command" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "use value typed PR command" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "@ exec-read / 1 (AR 8062)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "@ = exec-read (AR 8062)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "@ number (AR 8062)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "EDIT search for editable fn (AR 8137)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "EDIT selected fn (AR 6231)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
il:ourfn is not broken.
il:ourfn is not broken.
Test "AR 7618 BREAK :IN broken" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
il:ourfn is not broken.
il:ourfn is not broken.
Test "il:break-function :trace" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
our-fn is not broken.
il:ourfn is not broken.
Testing... "IL:HELPFLAG BREAK!"
Testing... "IL:HELPFLAG NIL"
Testing... "restore *test-mode*"
Test "IL:HELPFLAG IL:SETTOPVAL (AR 7845)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "simple unbreak" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
super-fn is not broken.
Test "unbreak of (sub-fn il:in superfn)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
super-fn is not broken.
Test "unbreak of (sub-fn in superfn)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
super-fn is not broken.
Test "unbreak of '(sub-fn il:in superfn)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "simple il:rebreak" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "simple untrace" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "(untrace) with broken fns" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "(untrace (sub-fn in super-fn))" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "trace il:brokenfns check" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "il:broken prop check" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "simple interpreted trace" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "trace of subfunction" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "simple il:advise il:around of defun" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "il:advise redefined broken defun" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "il:advise redefined advised defun (AR 8172)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "simple il:unadvise" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "il:unadvise t" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
(END-OF-TESTS)

View File

@@ -1,32 +0,0 @@
;;; Test results for sysout of 26-Feb-88 11:29:20
;;; Tests run on 2-Mar-88 13:56:25
;;; Running tests from ({Eris}<Test>Env>Debugger>Hand>*.u;)
Test "@ exec-read / 1 (AR 8062)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "@ = exec-read (AR 8062)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "@ number (AR 8062)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "EDIT search for editable fn (AR 8137)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "EDIT selected fn (AR 6231)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U;1"
Test "AR 7618 BREAK :IN broken" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "il:break-function :trace" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "IL:HELPFLAG IL:SETTOPVAL (AR 7845)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "simple unbreak" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "unbreak of (sub-fn il:in superfn)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "unbreak of (sub-fn in superfn)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "unbreak of '(sub-fn il:in superfn)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "simple il:rebreak" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "simple untrace" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "(untrace) with broken fns" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "(untrace (sub-fn in super-fn))" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "trace il:brokenfns check" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "il:broken prop check" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "simple interpreted trace" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "trace of subfunction" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "simple il:advise il:around of defun" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "il:advise redefined broken defun" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "il:advise redefined advised defun (AR 8172)" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "simple il:unadvise" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
Test "il:unadvise t" failed in file "{ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U;1"
(END-OF-TESTS)

View File

@@ -1,37 +0,0 @@
;;; Test results for sysout of 26-Feb-88 11:29:20
;;; Tests run on 2-Mar-88 13:56:25
;;; Running tests from ({Eris}<Test>Env>Debugger>Hand>*.u;)
The following are in {ERIS}<TEST>ENV>DEBUGGER>HAND>BREAKWINDOW.U
Test "@ exec-read / 1 (AR 8062)" failed in file
Test "@ = exec-read (AR 8062)" failed in file
Test "@ number (AR 8062)" failed in file
Test "EDIT search for editable fn (AR 8137)" failed in file
Test "EDIT selected fn (AR 6231)" failed in file
The following are in {ERIS}<TEST>ENV>DEBUGGER>HAND>DEBUGGER.U
Test "AR 7618 BREAK :IN broken" failed in file
Test "il:break-function :trace" failed in file
Test "IL:HELPFLAG IL:SETTOPVAL (AR 7845)" failed in file
Test "simple unbreak" failed in file
Test "unbreak of (sub-fn il:in superfn)" failed in file
Test "unbreak of (sub-fn in superfn)" failed in file
Test "unbreak of '(sub-fn il:in superfn)" failed in file
Test "simple il:rebreak" failed in file
Test "simple untrace" failed in file
Test "(untrace) with broken fns" failed in file
Test "(untrace (sub-fn in super-fn))" failed in file
Test "trace il:brokenfns check" failed in file
Test "il:broken prop check" failed in file
Test "simple interpreted trace" failed in file
Test "trace of subfunction" failed in file
Test "simple il:advise il:around of defun" failed in file
Test "il:advise redefined broken defun" failed in file
Test "il:advise redefined advised defun (AR 8172)" failed in file
Test "simple il:unadvise" failed in file
Test "il:unadvise t" failed in file
(END-OF-TESTS)

Binary file not shown.

View File

@@ -1,75 +0,0 @@
;; Function To Be Tested: DA (Programmer's Assistant Command)
;;
;; Source: Xerox Common Lisp Implementation Notes (Lyric Beta Release)
;; Section 20.2 (The Evaluator), Page 28
;;
;;
;; Section: The Evaluator
;; Page: 9
;;
;; Created By: John Park
;;
;; Creation Date: Feb 10, 1987
;;
;; Last Update: Feb 26, 1987
;;
;; Filed As: {ERIS}<lispcore>integration>exec>da.u
;;
;;
;; Syntax: DA
;;
;; Function Description: Returns current date and time
;;
;; Argument(s): None
;;
;; Returns: See function description
;;
;; Constraints/Limitations: Due to the nature of Programmer's Assistant commands,
;; testing them will be accomplished using the interlisp function BKSYSBUF in
;; do-test form . Comments are incorporated within
;; each command file, which will be run by using the function bksysbuf.
;; Each test setup is titled "COMMAND-TEST-SETUP", which executes the command
;; string. The do-test form within the command file will return T or "Test "quote"
;; failed in file "unknown". " at the end of testing.
;; The test result will be logged automatically in the following file:
;; {ERIS}<lispcore>test>exec>test.report
(DO-TEST 'DA-TEST-SETUP
(PROGN
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXEC>TEST.REPORT")
(DEFUN R-FORMAT (STATUS)
(FORMAT *OUTPUT* "~%COMMAND: DA ~%STATUS: ~A DATE: ~A TESTER: ~A~%" STATUS (IL:DATE) IL:USERNAME))
(SETQ DA-COMMAND-STRING
"(SETQ MESS1 'Printing-current-date&time...)
(SETQ DATE (IL:DATE))
(PROGN
(PRINC MESS1)
(SLEEP 2)
(VALUES)
)
DA
(SETQ TODAY IL:IT)
; Now do-test will determine whether DA actually returns today's date
(DO-TEST 'DA-TEST-RESULT
(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
:IF-EXISTS :APPEND))
(IF (STRING-EQUAL DATE TODAY :END1 14 :END2 14)
(PROGN (R-FORMAT 'SUCCESS) T)
(PROGN (R-FORMAT 'FAIL) NIL))
(CLOSE *OUTPUT*)
)
)
")
(IL:BKSYSBUF DA-COMMAND-STRING)
)
)
STOP

View File

@@ -1,75 +0,0 @@
;; Function To Be Tested: DA (Programmer's Assistant Command)
;;
;; Source: Xerox Common Lisp Implementation Notes (Lyric Beta Release)
;; Section 20.2 (The Evaluator), Page 28
;;
;;
;; Section: The Evaluator
;; Page: 9
;;
;; Created By: John Park
;;
;; Creation Date: Feb 10, 1987
;;
;; Last Update: Feb 26, 1987
;;
;; Filed As: {ERIS}<lispcore>integration>exec>da.u
;;
;;
;; Syntax: DA
;;
;; Function Description: Returns current date and time
;;
;; Argument(s): None
;;
;; Returns: See function description
;;
;; Constraints/Limitations: Due to the nature of Programmer's Assistant commands,
;; testing them will be accomplished using the interlisp function BKSYSBUF in
;; do-test form . Comments are incorporated within
;; each command file, which will be run by using the function bksysbuf.
;; Each test setup is titled "COMMAND-TEST-SETUP", which executes the command
;; string. The do-test form within the command file will return T or "Test "quote"
;; failed in file "unknown". " at the end of testing.
;; The test result will be logged automatically in the following file:
;; {ERIS}<lispcore>test>exec>test.report
(DO-TEST 'DA-TEST-SETUP
(PROGN
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXEC>TEST.REPORT")
(DEFUN R-FORMAT (STATUS)
(FORMAT *OUTPUT* "~%COMMAND: DA ~%STATUS: ~A DATE: ~A TESTER: ~A~%" STATUS (IL:DATE) IL:USERNAME))
(SETQ DA-COMMAND-STRING
"(SETQ MESS1 'Printing-current-date&time...)
(SETQ DATE (IL:DATE))
(PROGN
(PRINC MESS1)
(SLEEP 2)
(VALUES)
)
DA
(SETQ TODAY IL:IT)
; Now do-test will determine whether DA actually returns today's date
(DO-TEST 'DA-TEST-RESULT
(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
:IF-EXISTS :APPEND :IF-DOES-NOT-EXIST :CREATE))
(IF (STRING-EQUAL DATE TODAY :END1 14 :END2 14)
(PROGN (R-FORMAT 'SUCCESS) T)
(PROGN (R-FORMAT 'FAIL) NIL))
(CLOSE *OUTPUT*)
)
)
")
(IL:BKSYSBUF DA-COMMAND-STRING)
)
)
STOP

View File

@@ -1,5 +0,0 @@
;;; Test results for sysout of 26-Feb-88 11:29:20
;;; Tests run on 29-Feb-88 10:19:34
;;; Running tests from ({ERIS}<TEST>Env>Exec>Hand>do-events.u;1)
(END-OF-TESTS)

View File

@@ -1,8 +0,0 @@
;;; Test results for sysout of 26-Feb-88 11:29:20
;;; Tests run on 29-Feb-88 10:54:35
;;; Running tests from ({ERIS}<TEST>Env>Exec>Hand>*.u;)
(Trouble reading {ERIS}<TEST>ENV>EXEC>HAND>DO-EVENTS.U;2)
(END-OF-TESTS)

View File

@@ -1,5 +0,0 @@
;;; Test results for sysout of 26-Feb-88 11:29:20
;;; Tests run on 29-Feb-88 11:25:26
;;; Running tests from ({ERIS}<TEST>Env>Exec>Hand>*.u;)
(END-OF-TESTS)

View File

@@ -1,289 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 12, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>command-help.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERIS}<LispCore>Integration>do-test-menu.def"))
T)
(do-test-group "Help"
:before (progn
(setq window-list (do-test-menu-Setup "Help")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Help: no selection/no caret"
(do-test-menu-Message window-list 'high
" Testing Help
If there is no free Xerox Common Lisp exec, bring up one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq number 3)
(defun temp-double (number) (* 2 number))
(defun temp-add-five (number) (+ 5 number))
(defun temp-call-other (number) (+ (temp-add-five number)
(temp-double number)))
(defun temp-garbage (start) (concatenate 'string start 23 5 (4 cd \"hi\") \" more\"))
(il:df temp-call-other)
Select Help from the popup menu.
Does SEdit display in it's prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Make sure the functions got entered in correctly"
(and
(eq 3 number)
(eq 26 (temp-double 13))
(eq 50 (temp-double 25))
(eq 10 (temp-add-five 5))
(eq 28 (temp-add-five 23))
(eq 11 (temp-call-other 2))
(eq 14 (temp-call-other 3))
))
(do-test "Help: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assumping SEdit is editing the function temp-call-other
Want to place the edit caret right after the function call to \"temp-double\" without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of \"temp-double\".
Type meta-H.
Does SEdit display in the SEdit prompt window \"(TEMP-DOUBLE NUMBER)\"? "))
(do-test "Help: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assumping SEdit is editing the function temp-call-other
Want to place the structure caret right between the \"temp-add-five\" and \"number\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-H.
Does SEdit display in the SEdit prompt window \"(TEMP-ADD-FIVE NUMBER)\"? "))
(do-test "Help: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assumping SEdit is editing the function temp-call-other
Select the last litatom \"number\" as a structure, by pressing the middle button with the cursor over the litatom.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Arguments not available for NUMBER\"? "))
; The response to this may change when AR 7703 is answered/fixed.
(do-test "Help: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assumping SEdit is editing the function temp-call-other
Close the SEdit window for temp-call-other
In the exec type: \"(il:df temp-garbage)\"
Select the string \" more\" as a structure, by pressing the middle button, with the cursor over the string.
Type meta-H.
Does it display a message of:
\"Arguments not available for more\"? "))
(do-test "Help: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assumping SEdit is editing the function temp-garbage.
Select the number \"5\" as a structure, by pressing the middle button, with the cursor over the number.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Arguments not available for 5\"? "))
(do-test "Help: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assumping SEdit is editing the function temp-garbage.
Select the list \"(4 cd \"hi\")\" as a structure, by pressing the middle button, with the cursor over one of the parentheses.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Arguments not available for (4 cd hi)\"? "))
(do-test "Help: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assumping SEdit is editing the function temp-garbage.
Select the \"d\" in the litatom \"cd\".
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Arguments not available for CD\"?"))
(do-test "Help: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assumping SEdit is editing the function temp-garbage.
Select the \"h\" in the string \"hi\".
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Help: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assumping SEdit is editing the function temp-garbage.
Select the \"2\" in the number \"23\".
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Arguments not available for 23\"? "))
(do-test "Help: delete a litatom"
(do-test-menu-Message window-list 'low
" Testing: try after deleting a litatom
Assumping SEdit is editing the function temp-garbage.
Close the SEdit window for temp-garbage.
In the exec type: \"(il:df temp-call-other)\"
Place the structure caret after the second litatom \"number\".
Type in the litatom \"ab\"
Type control-W, meta-H.
Does SEdit display in the SEdit prompt window:
\"(TEMP-ADD-FIVE NUMBER)\"? "))
(do-test "Help: delete a string"
(do-test-menu-Message window-list 'low
" Testing: try after deleting a string
Assumping SEdit is editing the function temp-call-other.
Place the structure caret after the third litatom \"number\".
Type in the string \"hello\"
Type control-W, meta-H.
Does SEdit display in the SEdit prompt window:
\"(TEMP-DOUBLE NUMBER)\"? "))
(do-test "Help: delete a number"
(do-test-menu-Message window-list 'low
" Testing: try after deleting a number
Assumping SEdit is editing the function temp-call-other.
Place the structure caret before the third litatom \"number\".
Type in the number \"34\"
Type control-W, meta-H.
Does SEdit display in the SEdit prompt window:
\"(TEMP-DOUBLE NUMBER)\"? "))
(do-test "Help: delete a list"
(do-test-menu-Message window-list 'low
" Testing: try after deleting a list
Assumping SEdit is editing the function temp-call-other.
Place the structure caret before the second litatom \"number\".
Type in the list \"(have a \"nice\" day)\"
Type control-W, meta-H.
Does SEdit display in the SEdit prompt window:
\"(TEMP-ADD-FIVE NUMBER)\"? "))
(do-test "Help: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assumping SEdit is editing the function temp-call-other.
Place the edit caret after the second litatom \"number\".
Type \" ef gh\".
Type meta-H
Now select the litatom \"number\" as a structure, and extend the selection to include the next two litatoms.
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Help: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assumping SEdit is editing the function temp-call-other.
Place the edit caret after the litatom \"gh\".
Type \" 12 3.4 5/6 (hi) (bye) \"string\" \"string2\" (list)\".
Now select the first string as a structure, and extend the selection to include the second string.
Type meta-H
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Help: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assumping SEdit is editing the function temp-call-other.
Select the number \"12\" as a structure, and extend the selection to include the next two numbers.
Type meta-H
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Help: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assumping SEdit is editing the function temp-call-other.
Select the list \"(hi)\" as a structure, and extend the selection to include the next list.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Help: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assumping SEdit is editing the function temp-call-other.
Select the litatoms \"ef\" as a structure, and extend the selection to include the next four items.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Help: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assumping SEdit is editing the function temp-call-other.
Select the litatom \"hi\" as a structure, and extend the selection to include the next four items.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Help: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assumping SEdit is editing the function temp-call-other.
Select the litatom \"ef\" as a structure, and extend the selection to include the rest.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"?
Type meta-H a couple times if neccesary to see."))
(do-test "Help: selection of entire structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the function temp-call-other.
Select the entire structure.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Arguments not available for (DEFUN TEMP-CALL-OTHER (NUMBER) (+ (TEMP-ADD-FIVE NUMBER EF GH 12 3.4 5/6 (HI) (BYE) \"string\" \"string2\" (list)) (TEMP-DOUBLE NUMBER)))\"? "))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,289 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 12, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>command-help.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Arglist"
:before (progn
(setq window-list (do-test-menu-Setup "Arglist")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Arglist: no selection/no caret"
(do-test-menu-Message window-list 'high
" Testing Arglist
If there is no free Xerox Common Lisp exec, bring up one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq number 3)
(defun temp-double (number) (* 2 number))
(defun temp-add-five (number) (+ 5 number))
(defun temp-call-other (number) (+ (temp-add-five number)
(temp-double number)))
(defun temp-garbage (start) (concatenate 'string start 23 5 (4 cd \"hi\") \" more\"))
(il:df temp-call-other)
Select Arglist from the popup menu.
Does SEdit display in its prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Make sure the functions got entered in correctly"
(and
(eq 3 number)
(eq 26 (temp-double 13))
(eq 50 (temp-double 25))
(eq 10 (temp-add-five 5))
(eq 28 (temp-add-five 23))
(eq 11 (temp-call-other 2))
(eq 14 (temp-call-other 3))
))
(do-test "Arglist: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing the function temp-call-other
Want to place the edit caret right after the litatom \"temp-double\" without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of \"temp-double\".
Type meta-H.
Does SEdit display in the SEdit prompt window \"(TEMP-DOUBLE NUMBER)\"? "))
(do-test "Arglist: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing the function temp-call-other
Want to place the structure caret right between the \"temp-add-five\" and \"number\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-H.
Does SEdit display in the SEdit prompt window \"(TEMP-ADD-FIVE NUMBER)\"? "))
(do-test "Arglist: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing the function temp-call-other
Select the last litatom \"number\" as a structure, by pressing the middle button with the cursor over the litatom.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Arguments not available for NUMBER\"? "))
; The response to this may change when AR 7703 is answered/fixed.
(do-test "Arglist: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing the function temp-call-other
Close the SEdit window for temp-call-other
In the exec type: \"(il:df temp-garbage)\"
Select the string \" more\" as a structure, by pressing the middle button, with the cursor over the string.
Type meta-H.
Does it display a message of:
\"Arguments not available for more\"? "))
(do-test "Arglist: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing the function temp-garbage.
Select the number \"5\" as a structure, by pressing the middle button, with the cursor over the number.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Arguments not available for 5\"? "))
(do-test "Arglist: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing the function temp-garbage.
Select the list \"(4 cd \"hi\")\" as a structure, by pressing the middle button, with the cursor over one of the parentheses.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Arguments not available for (4 cd hi)\"? "))
(do-test "Arglist: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming SEdit is editing the function temp-garbage.
Select the \"d\" in the litatom \"cd\".
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Arguments not available for CD\"?"))
(do-test "Arglist: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing the function temp-garbage.
Select the \"h\" in the string \"hi\".
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Arglist: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing the function temp-garbage.
Select the \"2\" in the number \"23\".
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Arguments not available for 23\"? "))
(do-test "Arglist: delete a litatom"
(do-test-menu-Message window-list 'low
" Testing: try after deleting a litatom
Assuming SEdit is editing the function temp-garbage.
Close the SEdit window for temp-garbage.
In the exec type: \"(il:df temp-call-other)\"
Place the structure caret after the second litatom \"number\".
Type in the litatom \"ab\"
Type control-W, meta-H.
Does SEdit display in the SEdit prompt window:
\"(TEMP-ADD-FIVE NUMBER)\"? "))
(do-test "Arglist: delete a string"
(do-test-menu-Message window-list 'low
" Testing: try after deleting a string
Assuming SEdit is editing the function temp-call-other.
Place the structure caret after the third litatom \"number\".
Type in the string \"hello\"
Type control-W, meta-H.
Does SEdit display in the SEdit prompt window:
\"(TEMP-DOUBLE NUMBER)\"? "))
(do-test "Arglist: delete a number"
(do-test-menu-Message window-list 'low
" Testing: try after deleting a number
Assuming SEdit is editing the function temp-call-other.
Place the structure caret before the third litatom \"number\".
Type in the number \"34\"
Type control-W, meta-H.
Does SEdit display in the SEdit prompt window:
\"(TEMP-DOUBLE NUMBER)\"? "))
(do-test "Arglist: delete a list"
(do-test-menu-Message window-list 'low
" Testing: try after deleting a list
Assuming SEdit is editing the function temp-call-other.
Place the structure caret before the second litatom \"number\".
Type in the list \"(have a \"nice\" day)\"
Type control-W, meta-H.
Does SEdit display in the SEdit prompt window:
\"(TEMP-ADD-FIVE NUMBER)\"? "))
(do-test "Arglist: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing the function temp-call-other.
Place the edit caret after the second litatom \"number\".
Type \" ef gh\".
Now select the litatom \"number\" as a structure, and extend the selection to include the next two litatoms.
Type meta-H
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Arglist: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing the function temp-call-other.
Place the edit caret after the litatom \"gh\".
Type \" 12 3.4 5/6 (hi) (bye) \"string\" \"string2\" (list)\".
Now select the first string as a structure, and extend the selection to include the second string.
Type meta-H
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Arglist: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing the function temp-call-other.
Select the number \"12\" as a structure, and extend the selection to include the next two numbers.
Type meta-H
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Arglist: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing the function temp-call-other.
Select the list \"(hi)\" as a structure, and extend the selection to include the next list.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Arglist: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing the function temp-call-other.
Select the litatoms \"ef\" as a structure, and extend the selection to include the next four items.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Arglist: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing the function temp-call-other.
Select the litatom \"hi\" as a structure, and extend the selection to include the next four items.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"? "))
(do-test "Arglist: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing the function temp-call-other.
Select the litatom \"ef\" as a structure, and extend the selection to include the rest.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Select function you want the arguments for.\"?
Type meta-H a couple times if neccesary to see."))
(do-test "Arglist: selection of entire structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the function temp-call-other.
Select the entire structure.
Type meta-H.
Does SEdit display in the SEdit prompt window:
\"Arguments not available for (DEFUN TEMP-CALL-OTHER (NUMBER) (+ (TEMP-ADD-FIVE NUMBER EF GH 12 3.4 5/6 (HI) (BYE) \"string\" \"string2\" (list)) (TEMP-DOUBLE NUMBER)))\"? "))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,336 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 19, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-extract.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Extract"
:before (progn
(setq window-list (do-test-menu-Setup "Extract")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Extract: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing Extract
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(il:dv tempx)
Select Extract from the pop up menu.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Extract: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select DONE from the SEdit popup menu.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: no selection/structure caret"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Want to place the structure caret right between \"(b)\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-/.
Were you able to get this far "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) "hi" (b) cd 4) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Extract: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) \"hi\" (b) cd 4)
Type meta-U.
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Nothing to extract.\"? "))
(do-test "Extract: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Nothing to extract.\"? "))
(do-test "Extract: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Nothing to extract.\"? "))
(do-test "Extract: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-/.
Were you able to get this far? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" bye ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Extract: select a comment"
(do-test-menu-Message window-list 'low
" Testing: select a comment
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" bye (\"hi\" (b) cd 4))
Type meta-U.
Place the edit caret after the number 1 and type \"; hello\", then select this as a structure.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"not implemented for comments.\"? "))
(do-test "Extract: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 ; hello 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U twice.
Select the \"d\" in the first litatom \"cd\".
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"h\" in the string \"hello\".
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: pending delete a number"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"4.5\" in pending delete mode.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the list \"(bye)\" in pending delete mode.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: pending delete of a comment"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a comment
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Place the structure caret the number \"1\".
Type in \"; hello\"
Select the comment in pending delete mode.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U twice.
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-/
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-/
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next number.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the entire structure.
Type meta-0.
Reselect the enterie structure.
Type meta-/, and control-L
Were you able to get this far? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Extract: selection of entire structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type control-x.
Select the entire structure in pending delete mode.
Type meta-m.
Pick the extract command on the attached menu.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,335 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 19, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-extract.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Extract"
:before (progn
(setq window-list (do-test-menu-Setup "Extract")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Extract: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing Extract
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(il:dv tempx)
Select Extract from the pop up menu.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Extract: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select DONE from the SEdit popup menu.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: no selection/structure caret"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Want to place the structure caret right between \"(b)\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-/.
Did the parentheses around ("hi" (B) CD 4) disappear? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) "hi" (b) cd 4) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Extract: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) \"hi\" (b) cd 4)
Type meta-U.
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Nothing to extract.\"? "))
(do-test "Extract: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Nothing to extract.\"? "))
(do-test "Extract: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Nothing to extract.\"? "))
(do-test "Extract: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-/.
Did the parentheses around (bye) disappear? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" bye ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Extract: select a comment"
(do-test-menu-Message window-list 'low
" Testing: select a comment
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" bye (\"hi\" (b) cd 4))
Type meta-U.
Place the edit caret after the number 1 and type \"; hello\", then select this as a structure.
Type meta-/.
Did the semicolon disappear and \"hello\" become just another atom in the list? "))
(do-test "Extract: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 ; hello 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U three times.
Select the \"d\" in the first litatom \"cd\".
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"h\" in the string \"hello\".
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: pending delete a number"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"4.5\" in pending delete mode.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the list \"(bye)\" in pending delete mode.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: pending delete of a comment"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a comment
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Place the structure caret the number \"1\".
Type in \"; hello\"
Select the comment in pending delete mode.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U twice.
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-/
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-/
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next number.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-/.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Extract: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the entire structure.
Type meta-0.
Reselect the entire structure.
Type meta-/, and control-L
Did you get back the original list? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Extract: selection of entire structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type control-x.
Select the entire structure in pending delete mode.
Type meta-m.
Pick the extract command on the attached menu.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,324 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 10, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-find.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Find"
:before (progn
(setq window-list (do-test-menu-Setup "Find")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Find: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing Find
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 4.5 6/7 a cd \"hello\" \"BYE\" (\"hi\" b cd 4)))
(il:dv tempx)
Select Find from the popup menu. Type in \"cd\".
Does it find the litatom \"cd\" and select it? "))
(good-value (equal '(1 4.5 6/7 a cd "hello" "BYE" ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" (\"hi\" b cd 4))
Type control-x.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-F. Type in \"6/7\".
Does it find the number \"6/7\" and select it? "))
(do-test "Find: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" (\"hi\" b cd 4))
Want to place the structure caret right between \"a\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-F. Enter the string \"hello\".
Does it find the number \"hello\" and select it? "))
(do-test "Find: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" (\"hi\" b cd 4))
Select the first litatom \"cd\" as a structure, by pressing the middle button with the cursor over the litatom.
Press the find key.
Does it find the second occurance of the litatom and select it? "))
(do-test "Find: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" (\"hi\" b cd 4))
Select the string \"hello\" as a structure, by pressing the middle button, with the cursor over the string.
Type meta-F.
Does it display a message of \"\"hello\" - Not found.\"? "))
(do-test "Find: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" (\"hi\" b cd 4))
Place the structure caret right after the string \"BYE\".
Type \" 4.5 (bye) (bye)\", and then control-x
Select the first number \"4.5\" as a structure, by pressing the middle button, with the cursor over the number.
Type meta-F.
Does it find the second occurance of the number and select it?"))
(good-value (equal '(1 4.5 6/7 a cd "hello" "BYE" 4.5 (bye) (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Select the first list \"(bye)\" as a structure, by pressing the middle button, with the cursor over one of the parentheses.
Type meta-F.
Does it find the second occurance of the list and select it?"))
(do-test "Find: select a comment"
(do-test-menu-Message window-list 'low
" Testing: select a comment
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Place the edit caret after the number 1 and type \"; hello\", then select this as a structure.
Type meta-F.
Does it display a message of \"(il:* il:\\; \" hello\") - Not found.\"? "))
(do-test "Find: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 ; hello 4.5 6/7 a cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Select the comment as a structure and press the delete key.
Type control-x.
Select the \"d\" in the first litatom \"cd\".
Type meta-F. Enter the litatom \"bye\"
(If it doesn't ask what to find indicate failure to the prompter.)
Does it find the first litatom \"bye\" and underline only it?"))
(do-test "Find: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Select the \"h\" in the string \"hello\".
Type meta-F. Enter the number \"4\"
(If it doesn't ask what to find indicate failure to the prompter.)
Does it find the number \"4\" and underline only it?"))
(do-test "Find: select part of a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-F. Enter the list \"(\"hi\" b cd 4)\"
(If it doesn't ask what to find indicate failure to the prompter.)
Does it find the list \"(\"hi\" b cd 4)\" and underline only it?"))
(good-value (equal '(1 4.5 6/7 a cd "hello" "BYE" 4.5 (bye) (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: delete a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Place the edit caret after the litatom \"a\".
Type control-W, meta-F. Enter the number \"4.5\".
Does it find the second \"4.5\"? "))
(good-value (equal '(1 4.5 6/7 cd "hello" "BYE" 4.5 (bye) (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: delete a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Place the structure caret after the string \"hello\".
Type control-W, meta-F. Enter the litatom \"bye\".
Does it find the first litatom \"bye\"? "))
(good-value (equal '(1 4.5 6/7 cd "BYE" 4.5 (bye) (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: delete a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 cd \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Place the edit caret right after the number \"6/7\" with no selection.
Type control-W, meta-F. Just press the carriage return.
Does it find the first litatom \"bye\"? "))
(good-value (equal '(1 4.5 cd "BYE" 4.5 (bye) (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: delete a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 cd \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Pick the first list of \"(bye)\" as a structure and press the delete key.
Type meta-F. And press the carriage return.
Does it find the litatom \"bye\"? "))
(good-value (equal '(1 4.5 cd "BYE" 4.5 (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: delete a comment"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a comment
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 cd \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Place the structure caret after the litatom \"cd\" and type \"; hello\", then select this as a structure with the caret to the right.
Press the delete key, type meta-F, and press the carriage return.
Does it find the litatom \"bye\"? "))
(good-value (equal '(1 4.5 cd "BYE" 4.5 (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: extended selection of litatoms"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 cd \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Place the edit caret after the litatom \"cd\".
Type \" ef gh\", and control-x.
Now select the litatom \"cd\" as a structure, and extend the selection to include the next two litatoms.
Type meta-m, in the Find field type in the string \"BYE\", then left button the Find item on the menu.
Does it find the string \"BYE\"? "))
(good-value (equal '(1 4.5 cd ef gh "BYE" 4.5 (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: extended selection of strings"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Place the edit caret after the litatom \"gh\".
Type \"(hi) (bye) \"string\" \"string2\" (list)\".
Now select the first string as a structure, and extend the selection to include the second string.
In the attach menu, left button the Find item on the menu.
Does it find the string \"BYE\"? "))
(good-value (equal '(1 4.5 cd ef gh (hi) (bye) "string" "string2" (list) "BYE" 4.5 (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh (hi) (bye) \"string\" \"string2\" (list) \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next number.
In the attach menu, left button the Find item on the menu.
Does it find the litatom \"BYE\"? "))
(do-test "Find: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh (hi) (bye) \"string\" \"string2\" (list) \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Select the list \"(hi)\" as a structure, and extend the selection to include the next list.
In the attach menu, change the Find field to be \"4.5\", then left button the Find item on the menu.
Does it find the second number \"4.5\"? "))
(do-test "Find: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh (hi) (bye) \"string\" \"string2\" (list) \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next four items.
In the attach menu, left button the Find item on the menu.
Does it find the second number \"4.5\"? "))
(do-test "Find: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh (hi) (bye) \"string\" \"string2\" (list) \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Select the litatom \"hi\" as a structure, and extend the selection to include the next four items.
In the attach menu, left button the Find item on the menu.
Does it find the second number \"4.5\"? "))
(do-test "Find: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh (hi) (bye) \"string\" \"string2\" (list) \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
In the attach menu, left button the Find item on the menu.
Does it say \"4.5 - Not found\"? "))
(do-test "Find: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh (hi) (bye) \"string\" \"string2\" (list) \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Select the entire structure.
In the attach menu, left button the Find item on the menu.
Does it say \"4.5 - Not found\"? "))
(good-value (equal '(1 4.5 cd ef gh (hi) (bye) "string" "string2" (list) "BYE" 4.5 (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,324 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 10, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-find.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Find"
:before (progn
(setq window-list (do-test-menu-Setup "Find")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Find: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing Find
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 4.5 6/7 a cd \"hello\" \"BYE\" (\"hi\" b cd 4)))
(il:dv tempx)
Select Find from the popup menu. Type in \"cd\".
Does it find the litatom \"cd\" and select it? "))
(good-value (equal '(1 4.5 6/7 a cd "hello" "BYE" ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" (\"hi\" b cd 4))
Type control-x.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-F. Type in \"6/7\".
Does it find the number \"6/7\" and select it? "))
(do-test "Find: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" (\"hi\" b cd 4))
Want to place the structure caret right between \"a\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and pressing the middle button.
Type meta-F. Enter the string \"hello\".
Does it find the string \"hello\" and select it? "))
(do-test "Find: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" (\"hi\" b cd 4))
Select the first litatom \"cd\" as a structure, by pressing the middle button with the cursor over the litatom.
Press the find key.
Does it find the second occurance of the litatom and select it? "))
(do-test "Find: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" (\"hi\" b cd 4))
Select the string \"hello\" as a structure, by pressing the middle button, with the cursor over the string.
Type meta-F.
Does it display a message of \"\"hello\" - Not found.\"? "))
(do-test "Find: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" (\"hi\" b cd 4))
Place the structure caret right after the string \"BYE\".
Type \" 4.5 (bye) (bye)\", and then control-x
Select the first number \"4.5\" as a structure, by pressing the middle button, with the cursor over the number.
Type meta-F.
Does it find the second occurance of the number and select it?"))
(good-value (equal '(1 4.5 6/7 a cd "hello" "BYE" 4.5 (bye) (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Select the first list \"(bye)\" as a structure, by pressing the middle button, with the cursor over one of the parentheses.
Type meta-F.
Does it find the second occurance of the list and select it?"))
(do-test "Find: select a comment"
(do-test-menu-Message window-list 'low
" Testing: select a comment
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Place the edit caret after the number 1 and type \"; hello\", then select this as a structure.
Type meta-F.
Does it display a message of \"(il:* il:\\; \" hello\") - Not found.\"? "))
(do-test "Find: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 ; hello 4.5 6/7 a cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Select the comment as a structure and press the delete key.
Type control-x.
Select the \"d\" in the first litatom \"cd\".
Type meta-F. Enter the litatom \"bye\"
(If it doesn't ask what to find indicate failure to the prompter.)
Does it find the first litatom \"bye\" and underline only it?"))
(do-test "Find: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Select the \"h\" in the string \"hello\".
Type meta-F. Enter the number \"4\"
(If it doesn't ask what to find indicate failure to the prompter.)
Does it find the number \"4\" and underline only it?"))
(do-test "Find: select part of a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-F. Enter the list \"(\"hi\" b cd 4)\"
(If it doesn't ask what to find indicate failure to the prompter.)
Does it find the list \"(\"hi\" b cd 4)\" and underline only it?"))
(good-value (equal '(1 4.5 6/7 a cd "hello" "BYE" 4.5 (bye) (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: delete a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Place the edit caret after the litatom \"a\".
Type control-W, meta-F. Enter the number \"4.5\".
Does it find the second \"4.5\"? "))
(good-value (equal '(1 4.5 6/7 cd "hello" "BYE" 4.5 (bye) (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: delete a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 cd \"hello\" \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Place the structure caret after the string \"hello\".
Type control-W, meta-F. Enter the litatom \"bye\".
Does it find the first litatom \"bye\" (and not the string)? "))
(good-value (equal '(1 4.5 6/7 cd "BYE" 4.5 (bye) (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: delete a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 cd \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Place the edit caret right after the number \"6/7\" with no selection.
Type control-W, meta-F. Just press the carriage return.
Does it find the first litatom \"bye\" (and not the string)? "))
(good-value (equal '(1 4.5 cd "BYE" 4.5 (bye) (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: delete a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 cd \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Pick the first list of \"(bye)\" as a structure and press the delete key.
Type meta-F. And press the carriage return.
Does it find the litatom \"bye\"? "))
(good-value (equal '(1 4.5 cd "BYE" 4.5 (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: delete a comment"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a comment
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 cd \"BYE\" 4.5 (bye) (bye) (\"hi\" b cd 4))
Place the structure caret after the litatom \"cd\" and type \"; hello\", then select this as a structure with the caret to the right.
Press the delete key, type meta-F, and press the carriage return.
Does it find the litatom \"bye\"? "))
(good-value (equal '(1 4.5 cd "BYE" 4.5 (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: extended selection of litatoms"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 cd \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Place the edit caret after the litatom \"cd\".
Type \" ef gh\", and control-x.
Now select the litatom \"cd\" as a structure, and extend the selection to include the next two litatoms.
Type meta-m, in the Find field type in the string \"BYE\", then left button the Find item on the menu.
Does it find the string \"BYE\"? "))
(good-value (equal '(1 4.5 cd ef gh "BYE" 4.5 (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: extended selection of strings"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Place the edit caret after the litatom \"gh\".
Type \"(hi) (bye) \"string\" \"string2\" (list)\".
Now select the first string as a structure, and extend the selection to include the second string.
In the attach menu, left button the Find item on the menu.
Does it find the string \"BYE\"? "))
(good-value (equal '(1 4.5 cd ef gh (hi) (bye) "string" "string2" (list) "BYE" 4.5 (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Find: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh (hi) (bye) \"string\" \"string2\" (list) \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next number.
In the attach menu, left button the Find item on the menu.
Does it find the string \"BYE\"? "))
(do-test "Find: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh (hi) (bye) \"string\" \"string2\" (list) \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Select the list \"(hi)\" as a structure, and extend the selection to include the next list.
In the attach menu, change the Find field to be \"4.5\", then left button the Find item on the menu.
Does it find the second number \"4.5\"? "))
(do-test "Find: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh (hi) (bye) \"string\" \"string2\" (list) \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next four items.
In the attach menu, left button the Find item on the menu.
Does it find the second number \"4.5\"? "))
(do-test "Find: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh (hi) (bye) \"string\" \"string2\" (list) \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Select the litatom \"hi\" as a structure, and extend the selection to include the next four items.
In the attach menu, left button the Find item on the menu.
Does it find the second number \"4.5\"? "))
(do-test "Find: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh (hi) (bye) \"string\" \"string2\" (list) \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
In the attach menu, left button the Find item on the menu.
Does it say \"4.5 - Not found\"? "))
(do-test "Find: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 cd ef gh (hi) (bye) \"string\" \"string2\" (list) \"BYE\" 4.5 (bye) (\"hi\" b cd 4))
Select the entire structure.
In the attach menu, left button the Find item on the menu.
Does it say \"At end; no more structure to search.\"? "))
(good-value (equal '(1 4.5 cd ef gh (hi) (bye) "string" "string2" (list) "BYE" 4.5 (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,175 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 4, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-high.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "High level, high priority test"
:before (progn
(setq window-list (do-test-menu-Setup "High-level")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Trouble typing with parentheses"
(let* (( user-result (do-test-menu-Message window-list 'high
" Testing parentheses
If needed, bring up a second exec and type: \"(cl:in-package 'xcl-test)\"
Then in the exec type:
(setq tempx '(5))
(il:SEdit tempx)
Put the edit caret after the five in the SEdit window.
Type:\"(()6 7 8\"
Now complete the edit by typing control x.
Were you able to get this far?"))
(good-value (equal '(5 (nil 6 7 8)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Trouble creating dotted pairs"
(let* (( user-result (do-test-menu-Message window-list 'high
"Assumping SEdit is editing tempx which currently equals (5 (nil 6 7 8))
Testing dotted pairs.
Put the edit caret after the 8.
Type: \" .9\"
Put the edit caret after the smaller list.
Type: \" .10\"
Now complete the edit by selecting DONE from the pop-up menu.
Were you able to get this far?"))
(good-value (equal '(5 (nil 6 7 8 . 9) . 10) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Trouble with single quote"
(let* (( user-result (do-test-menu-Message window-list 'high
"Assumping SEdit is editing tempx which currently equals (5 (nil 6 7 8 . 9) . 10)
Testing single quotes.
Pick the smaller list as a structure by holding both keys down over the open parenthensis.
Press the delete key.
Type: \"'(5 6 7\"
Now complete the edit by selecting DONE from the pop-up menu.
Were you able to get this far?"))
(good-value (equal '(5 (quote (5 6 7)) . 10) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Trouble with control x"
(let* (( user-result (do-test-menu-Message window-list 'high
"Assumping SEdit is editing tempx which currently equals (5 (quote (5 6 7)) . 10)
Testing control-w.
Pick the smaller list as a structure by holding both keys down over the close parenthensis.
Type control W.
Now complete the edit by typing control x.
Were you able to get this far?"))
(good-value (equal '(5 . 10) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Trouble with control ("
(do-test-menu-Message window-list 'high
"Assumping SEdit is editing tempx which currently equals (5 . 10)
Testing meta-(.
Select 10 as a structure.
Pick meta-( from the pop menu.
Check to see if the caret is in front of the ten.
Now complete the edit by typing control x.
Was the caret in front of the ten?"))
(do-test "Trouble with control ("
(do-test-menu-Message window-list 'high
"Assumping SEdit is editing tempx which currently equals (5 10)
Testing meta-A.
Place the edit caret after the ten.
Type: \" 11 12 13\"
Pick control-A from the pop-up menu.
Confirm yes it is ok to abort.
Were you able to get this far?"))
(do-test "Trouble with control-B"
(do-test-menu-Message window-list 'high
"Assumping tempx is currently equals (5 10)
Testing meta-B.
Type: \"(il:dv tempx)\"
Pick control-B from the pop menu and enter 3.
Now complete the edit by selecting DONE from the pop-up menu.
Do you see (#3r12 #3r101)?"))
(do-test "Trouble with control-J"
(let* (( user-result (do-test-menu-Message window-list 'high
"Assumping SEdit is editing tempx which currently equals (5 10)
Testing meta-J.
First restore the base by picking control-B from the popup menu and entering 10.
Delete everything inside the big list.
Type: \"x x x\"
Then select these three elements.
Pick control-J from the pop menu.
Now complete the edit by selecting DONE from the pop-up menu.
Were you able to get this far?"))
(good-value (equal '(xxx) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Trouble with control-M"
(do-test-menu-Message window-list 'high
"Assumping SEdit is editing tempx which currently equals (xxx)
Testing meta-M.
Pick control-M from the pop menu.
Now complete the edit by selecting DONE from the pop-up menu.
Does the menu come up and stay up?"))
(do-test "Trouble with control-U"
(do-test-menu-Message window-list 'high
"Assumping SEdit is editing tempx which currently equals (xxx)
Testing meta-U.
Place the edit structure caret after the symbol xxx.
Type: \" yyy\"
Select Undo from the menu.
Were you able to get this far?"))
(do-test "Trouble with control-R"
(let* (( user-result (do-test-menu-Message window-list 'high
"Assumping SEdit is editing tempx which currently equals (xxx)
Testing meta-R.
Place the edit structure caret after the symbol xxx.
Type: \" yyy\"
Select Undo, Redo, and Exit from the menu.
Were you able to get this far?"))
(good-value (equal '(xxx yyy) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
) ; end of do-test-group
STOP

View File

@@ -1,175 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 4, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-high.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "High level, high priority test"
:before (progn
(setq window-list (do-test-menu-Setup "High-level")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Trouble typing with parentheses"
(let* (( user-result (do-test-menu-Message window-list 'high
" Testing parentheses
If needed, bring up a second exec and type: \"(cl:in-package 'xcl-test)\"
Then in the exec type:
(setq tempx '(5))
(il:dv tempx)
Put the edit caret after the five in the SEdit window.
Type \"(() 6 7 8)\"
Now complete the edit by typing control x.
Were you able to get this far?"))
(good-value (equal '(5 (nil 6 7 8)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Trouble creating dotted pairs"
(let* (( user-result (do-test-menu-Message window-list 'high
" Testing dotted pairs.
Assuming SEdit is editing tempx which currently equals (5 (nil 6 7 8))
Put the edit caret after the 8.
Type \" .9\".
Put the edit caret after the smaller list.
Type \" .10\".
Now complete the edit by selecting DONE from the pop-up menu.
Were you able to get this far?"))
(good-value (equal '(5 (nil 6 7 8 . 9) . 10) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Trouble with single quote"
(let* (( user-result (do-test-menu-Message window-list 'high
" Testing single quotes.
Assuming SEdit is editing tempx which currently equals (5 (nil 6 7 8 . 9) . 10)
Pick the smaller list as a structure by pressing the middle button down over the open parenthensis.
Press the delete key.
Type \"'(5 6 7)\".
Now complete the edit by selecting DONE from the pop-up menu.
Were you able to get this far?"))
(good-value (equal '(5 (quote (5 6 7)) . 10) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Trouble with control-w"
(let* (( user-result (do-test-menu-Message window-list 'high
" Testing control-w.
Assuming SEdit is editing tempx which currently equals (5 '(5 6 7) . 10)
Pick the smaller list as a structure by pressing the middle button down over the close parenthensis.
Type control W.
Now complete the edit by typing control x.
Do you now have "(5 . 10)?"))
(good-value (equal '(5 . 10) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Trouble with meta-("
(do-test-menu-Message window-list 'high
" Testing meta-(.
Assuming SEdit is editing tempx which currently equals (5 . 10)
Select 10 as a structure.
Pick meta-( from the pop menu.
Check to see if the caret is in front of the ten.
Now complete the edit by typing control x.
Was the caret in front of the ten? "))
(do-test "Trouble with meta-A"
(do-test-menu-Message window-list 'high
" Testing meta-A.
Assuming SEdit is editing tempx which currently equals (5 10)
Place the edit caret after the ten.
Type \" 11 12 13\".
Pick meta-A from the pop-up menu.
Confirm yes it is ok to abort.
Were you able to get this far?"))
(do-test "Trouble with meta-B"
(do-test-menu-Message window-list 'high
" Testing meta-B.
Assuming tempx is currently equals (5 10)
Type: \"(il:dv tempx)\"
Pick meta-B from the pop menu and enter 3.
Now complete the edit by selecting DONE from the pop-up menu.
Do you see (#3r12 #3r101)?"))
(do-test "Trouble with meta-J"
(let* (( user-result (do-test-menu-Message window-list 'high
" Testing meta-J.
Assuming SEdit is editing tempx which currently equals (5 10)
First restore the base by picking meta-B from the popup menu and entering 10.
Delete everything inside the big list.
Type \"x x x\".
Then select these three elements.
Pick meta-J from the pop menu.
Now complete the edit by selecting DONE from the pop-up menu.
Did the three X's become one atom, XXX?"))
(good-value (equal '(xxx) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Trouble with meta-M"
(do-test-menu-Message window-list 'high
" Testing meta-M.
Assuming SEdit is editing tempx which currently equals (xxx)
Pick meta-M from the pop menu.
Now complete the edit by selecting DONE from the pop-up menu.
Does the menu come up and stay up?"))
(do-test "Trouble with meta-U"
(do-test-menu-Message window-list 'high
" Testing meta-U.
Assuming SEdit is editing tempx which currently equals (xxx)
Place the edit structure caret after the symbol xxx.
Type \" yyy\".
Select Undo from the menu.
Were you able to get this far?"))
(do-test "Trouble with meta-R"
(let* (( user-result (do-test-menu-Message window-list 'high
" Testing meta-R.
Assuming SEdit is editing tempx which currently equals (xxx)
Place the edit structure caret after the symbol xxx.
Type \" yyy\".
Select Undo, Redo, and Exit from the menu.
Were you able to get this far?"))
(good-value (equal '(xxx yyy) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
) ; end of do-test-group
STOP

View File

@@ -1,330 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 10, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-join.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Join"
:before (progn
(setq window-list (do-test-menu-Setup "Join")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Join: no selection/no caret"
(let* (( user-result(do-test-menu-Message window-list 'high
" Testing Join
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4)))
(il:dv tempx)
Select Join from the popup menu.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Join: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select DONE from the SEdit popup menu.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Want to place the structure caret right between \"b\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select a comment"
(do-test-menu-Message window-list 'low
" Testing: select a comment
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Place the edit caret after the number 1 and type \"; hello\", then select this as a structure.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 ; hello 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the comment as a structure and press the delete key.
Type control-x.
Select the \"d\" in the first litatom \"cd\".
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"h\" in the string \"hello\".
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select part of a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Join: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: pending delete a number"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"4.5\" in pending delete mode.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" in pending delete mode.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: pending delete of a comment"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a comment
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Place the structure caret the number \"1\".
Type in \"; hello\"
Select the comment in pending delete mode.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: extended selection of litatoms"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assumping SEdit is editing the variable tempx which currently equals:
(1 ; hello 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Delete the comment.
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-J
Were the litatoms joined together to form \"abcd\"? "))
(good-value (equal '(1 2 4.5 6/7 abcd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Join: extended selection of strings"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-J
Were the strings joined together to form the string \"helloBYE\"? "))
(good-value (equal '(1 2 4.5 6/7 abcd efg "helloBYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Join: extended selection of numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"helloBYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next number.
Type meta-J.
(If a break window pops up, uparrow out of it and indicate failure.)
Does SEdit display in the SEdit prompt window:
\"Can't join numbers.\"? "))
(good-value (equal '(1 2 4.5 6/7 abcd efg "helloBYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Join: extended selection of lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"helloBYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-J.
Were the lists joined together to form the list \"(bye \"hi\" b cd 4)\"? "))
(good-value (equal '(1 2 4.5 6/7 abcd efg "helloBYE" (bye "hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Join: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"helloBYE\" (bye \"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-J.
(If a break window pops up, uparrow out of it and indicate failure.)
Does SEdit display in the SEdit prompt window:
\"Can't join numbers.\"? "))
(do-test "Join: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"helloBYE\" (bye \"hi\" b cd 4))
Select the string \"helloBYE\" as a structure, and extend the selection to include the next item.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Each item to join must be of the same type.\"? "))
(do-test "Join: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"helloBYE\" (bye \"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Each item to join must be of the same type.\"? "))
(do-test "Join: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"helloBYE\" (bye \"hi\" b cd 4))
Select the entire structure.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(good-value (equal '(1 2 4.5 6/7 abcd efg "helloBYE" (bye "hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,330 +0,0 @@
; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 10, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-join.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Join"
:before (progn
(setq window-list (do-test-menu-Setup "Join")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Join: no selection/no caret"
(let* (( user-result(do-test-menu-Message window-list 'high
" Testing Join
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4)))
(il:dv tempx)
Select Join from the popup menu.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Join: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select DONE from the SEdit popup menu.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Want to place the structure caret right between \"b\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structuret, by pressing the left mouse button twice with the cursor over the string.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select a comment"
(do-test-menu-Message window-list 'low
" Testing: select a comment
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Place the edit caret after the number 1 and type \"; hello\", then select this as a structure.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 ; hello 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the comment as a structure and press the delete key.
Type control-x.
Select the \"d\" in the first litatom \"cd\".
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"h\" in the string \"hello\".
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: select part of a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Join: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: pending delete a number"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"4.5\" in pending delete mode.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" in pending delete mode.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: pending delete of a comment"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a comment
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Place the structure caret the number \"1\".
Type in \"; hello\"
Select the comment in pending delete mode.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(do-test "Join: extended selection of litatoms"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing the variable tempx which currently equals:
(1 ; hello 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Delete the comment.
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-J
Were the litatoms joined together to form \"abcd\"? "))
(good-value (equal '(1 2 4.5 6/7 abcd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Join: extended selection of strings"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-J
Were the strings joined together to form the string \"helloBYE\"? "))
(good-value (equal '(1 2 4.5 6/7 abcd efg "helloBYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Join: extended selection of numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"helloBYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next number.
Type meta-J.
(If a break window pops up, uparrow out of it and indicate failure.)
Does SEdit display in the SEdit prompt window:
\"Can't join numbers.\"? "))
(good-value (equal '(1 2 4.5 6/7 abcd efg "helloBYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Join: extended selection of lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"helloBYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-J.
Were the lists joined together to form the list \"(bye \"hi\" b cd 4)\"? "))
(good-value (equal '(1 2 4.5 6/7 abcd efg "helloBYE" (bye "hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Join: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"helloBYE\" (bye \"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-J.
(If a break window pops up, uparrow out of it and indicate failure.)
Does SEdit display in the SEdit prompt window:
\"Can't join numbers.\"? "))
(do-test "Join: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"helloBYE\" (bye \"hi\" b cd 4))
Select the string \"helloBYE\" as a structure, and extend the selection to include the next item.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Each item to join must be of the same type.\"? "))
(do-test "Join: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"helloBYE\" (bye \"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Each item to join must be of the same type.\"? "))
(do-test "Join: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 abcd efg \"helloBYE\" (bye \"hi\" b cd 4))
Select the entire structure.
Type meta-J.
Does SEdit display in the SEdit prompt window:
\"Select items to join.\"? "))
(good-value (equal '(1 2 4.5 6/7 abcd efg "helloBYE" (bye "hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Done&Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,315 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 13, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-menu.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Menu"
:before (progn
(setq window-list (do-test-menu-Setup "Menu")))
:after (progn
(do-test-menu-Cleanup window-list))
;;; Since each command is tested in its own test suite,
;;; only worry about if can bring up the menu.
(do-test "Menu: no selection/no caret"
(let* (( user-result(do-test-menu-Message window-list 'high
" Testing Menu
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4)))
(il:dv tempx)
Select Menu from the popup menu.
Does the attached menu come up? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Menu: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select DONE from the SEdit popup menu.
If the attached menu is up, close it.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Want to place the structure caret right between \"b\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select a comment"
(do-test-menu-Message window-list 'low
" Testing: select a comment
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Place the edit caret after the number 1 and type \"; hello\", then select this as a structure.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 ; hello 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the comment as a structure and press the delete key.
If the attached menu is up, close it.
Type control-x.
Select the \"d\" in the first litatom \"cd\".
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the \"h\" in the string \"hello\".
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the \"7\" in the number \"6/7\".
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button with the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: pending delete a number"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the number \"4.5\" in pending delete mode.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the list \"(bye)\" in pending delete mode.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: pending delete of a comment"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a comment
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Place the structure caret the number \"1\".
Type in \"; hello\"
Select the comment in pending delete mode.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assumping SEdit is editing the variable tempx which currently equals:
(1 ; hello 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Delete the comment.
If the attached menu is up, close it.
Select the litatom \"a\" as a structure, and extend the selection to include the next three litatoms.
Type meta-M
Does the attached menu come up? "))
(do-test "Menu: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-M
Does the attached menu come up? "))
(do-test "Menu: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the number \"1\" as a structure, and extend the selection to include the next number.
Type meta-M
Does the attached menu come up? "))
(do-test "Menu: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the number \"1\" as a structure, and extend the selection to include the next seven items.
Type meta-m.
Does the attached menu come up? "))
(do-test "Menu: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the three item.
Type meta-M.
Does SEdit display in the SEdit prompt window:
\"This SEdit already has a menu\"? "))
(do-test "Menu: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: selection of entire structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the entire structure.
Type meta-M.
Does the attached menu come up? "))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,315 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 13, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-menu.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Menu"
:before (progn
(setq window-list (do-test-menu-Setup "Menu")))
:after (progn
(do-test-menu-Cleanup window-list))
;;; Since each command is tested in its own test suite,
;;; only worry about if can bring up the menu.
(do-test "Menu: no selection/no caret"
(let* (( user-result(do-test-menu-Message window-list 'high
" Testing Menu
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4)))
(il:dv tempx)
Select AttachMenu from the popup menu.
Does the attached menu come up? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Menu: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select DONE from the SEdit popup menu.
If the attached menu is up, close it.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Want to place the structure caret right between \"b\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select a comment"
(do-test-menu-Message window-list 'low
" Testing: select a comment
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Place the edit caret after the number 1 and type \"; hello\", then select this as a structure.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 ; hello 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the comment as a structure and press the delete key.
If the attached menu is up, close it.
Type control-x.
Select the \"d\" in the first litatom \"cd\".
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the \"h\" in the string \"hello\".
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the \"7\" in the number \"6/7\".
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button with the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: pending delete a number"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the number \"4.5\" in pending delete mode.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the list \"(bye)\" in pending delete mode.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: pending delete of a comment"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a comment
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Place the structure caret the number \"1\".
Type in \"; hello\"
Select the comment in pending delete mode.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing the variable tempx which currently equals:
(1 ; hello 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Delete the comment.
If the attached menu is up, close it.
Select the litatom \"a\" as a structure, and extend the selection to include the next three litatoms.
Type meta-M
Does the attached menu come up? "))
(do-test "Menu: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-M
Does the attached menu come up? "))
(do-test "Menu: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the number \"1\" as a structure, and extend the selection to include the next number.
Type meta-M
Does the attached menu come up? "))
(do-test "Menu: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the number \"1\" as a structure, and extend the selection to include the next seven items.
Type meta-m.
Does the attached menu come up? "))
(do-test "Menu: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the three items.
Type meta-M.
Does SEdit display in the SEdit prompt window:
\"This SEdit already has a menu\"? "))
(do-test "Menu: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-M.
Does the attached menu come up? "))
(do-test "Menu: selection of entire structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
If the attached menu is up, close it.
Select the entire structure.
Type meta-M.
Does the attached menu come up? "))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Done&Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,367 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 16, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-meta-o.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "See/Change Definition"
:before (progn
(setq window-list (do-test-menu-Setup "See/Change Definition")))
:after (progn
(do-test-menu-Cleanup window-list))
;;; some different things to look at:
;;; optimizers: defoptimiziers
;;; structures: defstruct
;;; setfs: defsetf define-setf-method
;;; types: deftype
;;; variable: defglobalparameter, def-blobalvar, defconstant, defparameter, defvar
;;; functions: define-modify-macro, defmacro, definline, defun,
;;; define-type: def-define-type
;;; Have AR 7699 on the next three expected responses from meta-o
(do-test "See/Change Definition: no selection/no caret"
(do-test-menu-Message window-list 'high
" Testing See/Change Definition
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq number 3)
(setq cd '(a b wer))
(setq efg '(1 2 3 4 5))
(defoptimizer temp-add-five (number) (number) (+ 5 number))
(define-modify-macro my-restf (list) cdr)
(defmacro temp-double (number) `(+ ,number ,number))
(define-modify-macro my-doublef (number) my-double)
(defstruct temp-silly \"silly\" sing (in 0.0) (long \"ab\") low yeast)
(defun temp-double (number) (declare (optimize speed)) (* 2 number))
(defun temp-add-five (number) (+ 5 number))
(defun temp-call-other (number)
(let ((silly-temp (make-temp-silly)))
(+ (temp-add-five number) (temp-double number))))
(defun temp-garbage (x) '(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4)))
(ed 'temp-call-other)
Select Edit from the popup menu.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: Test get right definiton"
(do-test-menu-Message window-list 'high
" Testing: get the FNS definition
Assumping SEdit is editing the function temp-call-other.
Select \"make-temp-silly\"
Type meta-O.
Does the FNS definition for \"make-temp-silly\" popup in an SEdit window? "))
(do-test "See/Change Definition: Test get structures definiton"
(do-test-menu-Message window-list 'high
" Testing: get the structures definition
Assumping SEdit is editing the function temp-call-other & make-temp-silly.
Select \"temp-silly\" in the SEdit window for \"make-temp-silly\" about eight lines down the window.
Type meta-O.
Does the STRUCTURES definition for \"temp-silly\" popup in an SEdit window? "))
(do-test "See/Change Definition: Test get defoptimizer definiton"
(do-test-menu-Message window-list 'high
" Testing: get the defoptimizer definition
Assumping SEdit is editing the function temp-call-other & make-temp-silly, and the structure definition for temp-silly.
Close the SEdit window for temp-silly, and make-temp-silly.
Select \"temp-add-five\" in the SEdit window for \"temp-call-other\".
Type meta-O.
SEdit should ask \"Edit which definition of temp-add-five\".
Select \"optimizes\".
Did it ask and does the SEdit display in another SEdit window:
\"(defoptimizer temp-add-five (number) (number) (+ 5 number))\"? "))
(do-test "See/Change Definition: Test get optimizers definiton"
(do-test-menu-Message window-list 'high
" Testing: get the optimizers definition
Assumping SEdit is editing the function temp-call-other, and the optimizers definition for temp-add-five.
Close the SEdit window for temp-add-five.
Select \"temp-add-five\" in the SEdit window for \"temp-call-other\".
Type meta-O.
SEdit should ask \"Edit which definition of temp-add-five\".
Select \"functions\".
Did it ask and does the SEdit display in another SEdit window:
\"(defun temp-add-five (number) (+ 5 number))\"? "))
(do-test "See/Change Definition: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assumping SEdit is editing the function temp-call-other & temp-add-five.
Close both windows.
Type \"(ed 'temp-garbage)\"
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assumping SEdit is editing the function temp-garbage.
Want to place the structure caret right between \"b\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assumping SEdit is editing the function temp-garbage.
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-O.
(If asked to select a type of dummy definition to install, pick VARS.)
Does a second SEdit window pop up editing the var CD with a value o:
\"(a b wer)\"? "))
(do-test "See/Change Definition: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assumping SEdit is editing the function temp-garbage and the veariable CD.
Close the SEdit window for the variable CD.
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-O.
Select VARIABLE, then DEFVAR
Does SEdit display in the SEdit prompt window:
\"\"hello\" not editable.\"? "))
(do-test "See/Change Definition: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assumping SEdit is editing the function temp-garbage.
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-O.
Select OPTIMIZERS, DEFOPTIMIZER
Does SEdit display in the SEdit prompt window:
\"4.5 not editable.\"? "))
(do-test "See/Change Definition: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assumping SEdit is editing the function temp-garbage.
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-O.
Select DEFINE-TYPES, DEF-DEFINE-TYPE
Does SEdit display in the SEdit prompt window:
\"(bye) not editable.\"? "))
(do-test "See/Change Definition: select a comment"
(do-test-menu-Message window-list 'low
" Testing: select a comment
Assumping SEdit is editing the function temp-garbage.
Place the edit caret after the number 1 and type \"; hello\", then select this as a structure.
Type meta-O.
Select FUNCTIONS, DEFUN
Does SEdit display in the SEdit prompt window:
\"(il:* il:\\; \" hello\") not editable.\"? "))
(do-test "See/Change Definition: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assumping SEdit is editing the function temp-garbage.
Select the comment as a structure and press the delete key.
Type control-x.
Select the \"d\" in the first litatom \"cd\".
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assumping SEdit is editing the function temp-garbage and the variable cd.
Close the SEdit window for the variable \"cd\".
Select the \"h\" in the string \"hello\".
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assumping SEdit is editing the function temp-garbage.
Select the \"7\" in the number \"6/7\".
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assumping SEdit is editing the function temp-garbage.
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assumping SEdit is editing the function temp-garbage and the variable efg.
Close the SEdit window for efg.
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: pending delete a number"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assumping SEdit is editing the function temp-garbage.
Select the number \"4.5\" in pending delete mode.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assumping SEdit is editing the function temp-garbage.
Select the list \"(bye)\" in pending delete mode.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: pending delete of a comment"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a comment
Assumping SEdit is editing the function temp-garbage.
Place the structure caret the number \"1\".
Type in \"; hello\"
Select the comment in pending delete mode.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assumping SEdit is editing the function temp-garbage.
Delete the comment.
Select the litatom \"a\" as a structure, and extend the selection to include the next three litatoms.
Type meta-O
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assumping SEdit is editing the function temp-garbage.
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-O
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assumping SEdit is editing the function temp-garbage.
Select the number \"1\" as a structure, and extend the selection to include the next three numbers.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assumping SEdit is editing the function temp-garbage.
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assumping SEdit is editing the function temp-garbage.
Select the number \"1\" as a structure, and extend the selection to include the next seven items.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assumping SEdit is editing the function temp-garbage.
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assumping SEdit is editing the function temp-garbage.
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: selection of entire structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the function temp-garbage.
Select the entire structure.
Type meta-O.
Select FNS, NLAMBDA.
Does SEdit display in the SEdit prompt window:
\"(defun temp-garbage (x) (quote (1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (BYE) (\"hi\" b cd 4)))) not editable.\"? "))
;;; After testing the enter points test the command some.
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,365 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 16, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-meta-o.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "See/Change Definition"
:before (progn
(setq window-list (do-test-menu-Setup "See/Change Definition")))
:after (progn
(do-test-menu-Cleanup window-list))
;;; some different things to look at:
;;; optimizers: defoptimiziers
;;; structures: defstruct
;;; setfs: defsetf define-setf-method
;;; types: deftype
;;; variable: defglobalparameter, def-blobalvar, defconstant, defparameter, defvar
;;; functions: define-modify-macro, defmacro, definline, defun,
;;; define-type: def-define-type
;;; Have AR 7699 on the next three expected responses from meta-o
(do-test "See/Change Definition: no selection/no caret"
(do-test-menu-Message window-list 'high
" Testing See/Change Definition
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq number 3)
(setq cd '(a b wer))
(setq efg '(1 2 3 4 5))
(defoptimizer temp-add-five (number) (number) (+ 5 number))
(define-modify-macro my-restf (list) cdr)
(defmacro temp-double (number) `(+ ,number ,number))
(define-modify-macro my-doublef (number) my-double)
(defstruct temp-silly \"silly\" sing (in 0.0) (long \"ab\") low yeast)
(defun temp-double (number) (declare (optimize speed)) (* 2 number))
(defun temp-add-five (number) (+ 5 number))
(defun temp-call-other (number)
(let ((silly-temp (make-temp-silly)))
(+ (temp-add-five number) (temp-double number))))
(defun temp-garbage (x) '(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4)))
(ed 'temp-call-other)
Select Edit from the popup menu.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: Test get right definiton"
(do-test-menu-Message window-list 'high
" Testing: get the FNS definition
Assuming SEdit is editing the function temp-call-other.
Select \"make-temp-silly\"
Type meta-O.
Does the FNS definition for \"make-temp-silly\" popup in an SEdit window? "))
(do-test "See/Change Definition: Test get structures definiton"
(do-test-menu-Message window-list 'high
" Testing: get the structures definition
Assuming SEdit is editing the function temp-call-other & make-temp-silly.
Select \"temp-silly\" in the SEdit window for \"make-temp-silly\" about eight lines down the window.
Type meta-O.
Does the STRUCTURES definition for \"temp-silly\" popup in an SEdit window? "))
(do-test "See/Change Definition: Test get defoptimizer definiton"
(do-test-menu-Message window-list 'high
" Testing: get the defoptimizer definition
Assuming SEdit is editing the function temp-call-other & make-temp-silly, and the structure definition for temp-silly.
Close the SEdit window for temp-silly, and make-temp-silly.
Select \"temp-add-five\" in the SEdit window for \"temp-call-other\".
Type meta-O.
SEdit should ask \"Edit which definition of temp-add-five\".
Select \"optimizers\".
Did it ask and does the SEdit display in another SEdit window:
\"(defoptimizer temp-add-five (number) (number) (+ 5 number))\"? "))
(do-test "See/Change Definition: Test get optimizers definiton"
(do-test-menu-Message window-list 'high
" Testing: get the optimizers definition
Assuming SEdit is editing the function temp-call-other, and the optimizers definition for temp-add-five.
Close the SEdit window for temp-add-five.
Select \"temp-add-five\" in the SEdit window for \"temp-call-other\".
Type meta-O.
SEdit should ask \"Edit which definition of temp-add-five\".
Select \"functions\".
Did it ask and does the SEdit display in another SEdit window:
\"(defun temp-add-five (number) (+ 5 number))\"? "))
(do-test "See/Change Definition: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing the function temp-call-other & temp-add-five.
Close both windows.
Type \"(ed 'temp-garbage)\"
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing the function temp-garbage.
Want to place the structure caret right between \"b\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing the function temp-garbage.
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-O.
(If asked to select a type of dummy definition to install, pick VARS.)
Does a second SEdit window pop up editing the var CD with a value of:
\"(a b wer)\"? "))
(do-test "See/Change Definition: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing the function temp-garbage and the variable CD.
Close the SEdit window for the variable CD.
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-O.
Select VARIABLES, then DEFVAR
Does SEdit display in the SEdit prompt window:
\"\"hello\" has no VARIABLES definition.\"? "))
(do-test "See/Change Definition: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing the function temp-garbage.
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-O.
Select OPTIMIZERS, DEFOPTIMIZER
Does SEdit display in the SEdit prompt window:
\"4.5 not editable.\"? "))
(do-test "See/Change Definition: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing the function temp-garbage.
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-O.
Select DEFINE-TYPES, DEF-DEFINE-TYPE
Does SEdit display in the SEdit prompt window:
\"(BYE) has no DEFINE-TYPES definition.\"? "))
(do-test "See/Change Definition: select a comment"
(do-test-menu-Message window-list 'low
" Testing: select a comment
Assuming SEdit is editing the function temp-garbage.
Place the edit caret after the number 1 and type \"; hello\", then select this as a structure.
Type meta-O.
Select FUNCTIONS, DEFUN
Does SEdit display in the SEdit prompt window:
\"(il:* il:\\; \" hello\") has no FUNCTIONS definition.\"? "))
(do-test "See/Change Definition: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming SEdit is editing the function temp-garbage.
Select the comment as a structure and press the delete key.
Type control-x.
Select the \"d\" in the first litatom \"cd\".
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing the function temp-garbage and the variable cd.
Close the SEdit window for the variable \"cd\".
Select the \"h\" in the string \"hello\".
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing the function temp-garbage.
Select the \"7\" in the number \"6/7\".
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assuming SEdit is editing the function temp-garbage.
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assuming SEdit is editing the function temp-garbage.
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: pending delete a number"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assuming SEdit is editing the function temp-garbage.
Select the number \"4.5\" in pending delete mode.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assuming SEdit is editing the function temp-garbage.
Select the list \"(bye)\" in pending delete mode.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: pending delete of a comment"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a comment
Assuming SEdit is editing the function temp-garbage.
Place the structure caret the number \"1\".
Type in \"; hello\"
Select the comment in pending delete mode.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing the function temp-garbage.
Delete the comment.
Select the litatom \"a\" as a structure, and extend the selection to include the next three litatoms.
Type meta-O
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing the function temp-garbage.
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-O
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing the function temp-garbage.
Select the number \"1\" as a structure, and extend the selection to include the next three numbers.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing the function temp-garbage.
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing the function temp-garbage.
Select the number \"1\" as a structure, and extend the selection to include the next seven items.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing the function temp-garbage.
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing the function temp-garbage.
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-O.
Does SEdit display in the SEdit prompt window:
\"Select name of object to edit.\"? "))
(do-test "See/Change Definition: selection of entire structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the function temp-garbage.
Select the entire structure.
Type meta-O.
Select FNS, NLAMBDA.
Does SEdit display in the SEdit prompt window:
\"(defun temp-garbage (x) (quote (1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (BYE) (\"hi\" b cd 4)))) not editable.\"? "))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Done&Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,313 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 23, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-mutate.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Mutate"
:before (progn
(setq window-list (do-test-menu-Setup "Mutate")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Mutate: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing Mutate
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(defun temp-double (number) (* 2 number))
(defun temp-build-string (string)
(concatenate 'string string \" more\"))
(defun temp-car (list) (car list))
(defun temp-return-value () '(a list))
(setq tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(il:dv tempx)
Select Mutate from the pop up menu.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Mutate: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select DONE from the SEdit popup menu.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Want to place the structure caret right between \"(b)\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: select a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) \"hi\" (b) cd 4))
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-Z.
Enter \"temp-return-value\".
Does SEdit display in the SEdit prompt window:
\"Error during mutation. No changes made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Mutate: select a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-Z.
Enter \"temp-build-string\".
Were you able to get this far? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello more" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Mutate: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello more\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-Z.
Enter \"temp-double\"
Were you able to get this far? "))
(good-value (equal '(1 9.0 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Mutate: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 9.0 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-Z.
Enter \"temp-car\"
Were you able to get this far? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" bye ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Mutate: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" bye (\"hi\" (b) cd 4))
Type meta-U.
Select the \"d\" in the first litatom \"cd\".
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"h\" in the string \"hello\".
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the list \"(bye)\" in pending delete mode.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-Z
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-Z
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate\"? "))
(do-test "Mutate: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next two numbers.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) gh 4))
Select the entire structure.
Type meta-Z.
Enter \"temp-car\"
Were you able to get this far? "))
(good-value (equal 1 tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Mutate: Pending delete of whole structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the entire structure in pending delete mode.
Type meta-z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,313 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 23, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-mutate.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Mutate"
:before (progn
(setq window-list (do-test-menu-Setup "Mutate")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Mutate: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing Mutate
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(defun temp-double (number) (* 2 number))
(defun temp-build-string (string)
(concatenate 'string string \" more\"))
(defun temp-car (list) (car list))
(defun temp-return-value () '(a list))
(setq tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(il:dv tempx)
Select Mutate from the pop up menu.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Mutate: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select DONE from the SEdit popup menu.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Want to place the structure caret right between \"(b)\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: select a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) \"hi\" (b) cd 4))
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-Z.
Enter \"temp-return-value\".
Does SEdit display in the SEdit prompt window:
\"Error during mutation. No changes made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Mutate: select a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-Z.
Enter \"temp-build-string\".
Were you able to get this far? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello more" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Mutate: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello more\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-Z.
Enter \"temp-double\"
Were you able to get this far? "))
(good-value (equal '(1 9.0 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Mutate: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 9.0 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-Z.
Enter \"temp-car\"
Were you able to get this far? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" bye ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Mutate: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" bye (\"hi\" (b) cd 4))
Type meta-U.
Select the \"d\" in the first litatom \"cd\".
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"h\" in the string \"hello\".
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the list \"(bye)\" in pending delete mode.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-Z
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-Z
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate\"? "))
(do-test "Mutate: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next two numbers.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-Z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Mutate: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) gh 4))
Select the entire structure.
Type meta-Z.
Enter \"temp-car\"
Were you able to get this far? "))
(good-value (equal 1 tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Mutate: Pending delete of whole structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the entire structure in pending delete mode.
Type meta-z.
Does SEdit display in the SEdit prompt window:
\"Select whole structure to mutate.\"? "))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Done&Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,337 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 5, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>SEdit-command-low-paren.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Parenthesize current selection"
:before (progn
(setq window-list (do-test-menu-Setup "Parenthesize")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Parenthesize: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing parentheses
If needed, bring up a second exec and type: \"(cl:in-package 'xcl-test)\"
Then in the exec type:
(setq tempx '(1 23 ab cd \"how\" \"are\" \"you\" (\"hi\" \"bye\" a 23 4)))
(il:dv tempx)
Type meta-(.
Were you able to get this far?"))
(good-value (equal '(1 23 ab cd "how" "are" "you" ("hi" "bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: no selection/edit caret"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (1 23 ab cd \"how\" \"are\" \"you\" (\"hi\" \"bye\" a 23 4))
Testing: no selection/edit caret
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-(.
Were you able to get this far?"))
(good-value (equal '(1 23 ab cd "how" "are" "you" ("hi" "bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: no selection/structure caret"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (1 23 ab cd \"how\" \"are\" \"you\" (\"hi\" \"bye\" a 23 4))
Testing: no selection/structure caret
Want to place the structure caret right between \"ab\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-(.
Were you able to get this far?"))
(good-value (equal '(1 23 ab cd "how" "are" "you" ("hi" "bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (1 23 ab cd \"how\" \"are\" \"you\" (\"hi\" \"bye\" a 23 4))
Testing: select a litatom
Select the litatom \"ab\" as a structure, by pressing the middle button with the cursor over the litatom.
Type meta-).
Were you able to get this far?"))
(good-value (equal '(1 23 (ab) cd "how" "are" "you" ("hi" "bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select a string"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (1 23 (ab) cd \"how\" \"are\" \"you\" (\"hi\" \"bye\" a 23 4))
Testing: select a string
Select the string \"how\" as a structure, by pressing the middle button, with the cursor over the string.
Type meta-).
Were you able to get this far?"))
(good-value (equal '(1 23 (ab) cd ("how") "are" "you" ("hi" "bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (1 23 (ab) cd (\"how\") \"are\" \"you\" (\"hi\" \"bye\" a 23 4))
Testing: select a number
Select the number \"1\" as a structure, by pressing the middle button, with the cursor over the number.
Select PAREN from the popup menu.
Were you able to get this far?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" ("hi" "bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" (\"hi\" \"bye\" a 23 4))
Testing: select a list
Select the list (\"hi\" \"bye\" a 23 4) as a structure.
Type meta-9, and then control-x.
Were you able to get this far?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select a comment"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Testing: select a comment
Place the edit caret after the number 23 and type \"; hello\", then select this as a structure, and type meta-0.
Check to see if it has parenthesis around it, then select Abort from the pop-up menu.
Was the parenthesis around the comment?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select part of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Testing: select part of a litatom
Type: \"(il:dv tempx)\"
Select the \"d\" in the litatom \"cd\" and type meta-0.
Were you able to get this far?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select part of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Testing: select part of a string
Select the \"h\" in the string \"how\" and type meta-0.
Were you able to get this far?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select part of a number"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Testing: select part of a number
Select the \"2\" in the number \"23\" and type meta-0.
Were you able to get this far?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: delete a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Testing: try after deleting a litatom
Place the edit caret after the litatom \"ab\" with in the list.
Type \" ef\", then control-W and meta-0.
Were you able to get this far?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: delete a string"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Testing: try after deleting a string
Place the structure caret after the string \"hi\" with in the list.
Type a double quote, and then the word \"there\", put the structure caret right after this string, and type control-W and meta-0.
Were you able to get this far?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: delete a number"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Testing: try after deleting a number
Place the edit caret right after the number \"23\" with no selection.
Type control-W, and meta-(, control-x.
Were you able to get this far?"))
(good-value (equal '((1) (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: delete a list"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Testing: try after deleting a number
Place the structure caret right after the list \"((\"hi\" \"bye\" a 23 4))\" with no selection.
Type control-W, and meta-(, control-x.
Were you able to get this far?"))
(good-value (equal '((1) (ab) cd ("how") "are" "you") tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: delete a comment"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) (ab) cd (\"how\") \"are\" \"you\")
Testing: try after deleting a comment
Place the structure caret after the litatom \"cd\" and type \"; hello\", then select this as a structure with the caret to the right.
Press the delete key and type meta-(, control-x.
Were you able to get this far?"))
(good-value (equal '((1) (ab) cd ("how") "are" "you") tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of litatoms"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) (ab) cd (\"how\") \"are\" \"you\")
Testing: try extended selection of litatoms
Place the edit caret after the litatom \"cd\".
Type \" ef gh\".
Now select the litatom \"cd\" as a structure, and extend the selection to include the next two litatoms.
Type meta-(.
Were you able to get this far?"))
(good-value (equal '((1) (ab) (cd ef gh) ("how") "are" "you") tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of strings"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) (ab) (cd ef gh) (\"how\") \"are\" \"you\")
Testing: extended selection of strings
Select the string \"are\" as a structure, and extend the selection to include the next string.
Type meta-(.
Were you able to get this far?"))
(good-value (equal '((1) (ab) (cd ef gh) ("how") ("are" "you")) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) (ab) (cd ef gh) (\"how\") (\"are\" \"you\"))
Testing: extended selection of numbers
Place the structure caret after the list \"(1)\".
Type \" 2 3 4\".
Now select the number \"2\" as a structure, and extend the selection to include the next two numbers.
Type meta-).
Were you able to get this far?"))
(good-value (equal '((1) (2 3 4) (ab) (cd ef gh) ("how") ("are" "you")) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of lists"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) (2 3 4) (ab) (cd ef gh) (\"how\") (\"are\" \"you\"))
Testing: extended selection of lists
Select the list \"(2 3 4)\" as a structure, and extend the selection to include the next two lists.
Type meta-).
Were you able to get this far?"))
(good-value (equal '((1) ((2 3 4) (ab) (cd ef gh)) ("how") ("are" "you")) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of litatoms and numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) ((2 3 4) (ab) (cd ef gh)) (\"how\") (\"are\" \"you\"))
Testing: extended selection of litatoms and numbers
Select the list \"((2 3 4) (ab) (cd ef gh))\" as a structure and press the delete key.
Now type \" ab 23 cd 45\"
Select the litatom \"ab\" as a structure, and extend the selection to include the next three items.
Type meta-).
Were you able to get this far?"))
(good-value (equal '((1) (ab 23 cd 45) ("how") ("are" "you")) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of strings and lists"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) (ab 23 cd 45) (\"how\") (\"are\" \"you\"))
Testing: extended selection of strings and lists
Place the structure caret after the list \"(1)\".
Type \" (hi) \"hi\" (bye) \"bye\" (list-string)\"
Select the list \"(hi)\" as a structure, and extend the selection to include the next four items.
Select Paren from the popup menu.
Were you able to get this far?"))
(good-value (equal '((1) ((hi) "hi" (bye) "bye" (list-string)) (ab 23 cd 45) ("how") ("are" "you")) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of several things"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) ((hi) \"hi\" (bye) \"bye\" (list-string)) (ab 23 cd 45) (\"how\") (\"are\" \"you\"))
Testing: extended selection of several things
Select the second list as a structure, extend the select to include the rest of the items, and press the delete key.
Type \"23 a-litatom 45 \"hi\" bye (my small list)\"
Select the number \"23\" as a structure, and extend the selection to include the next six items.
Select Paren from the popup menu.
Were you able to get this far?"))
(good-value (equal '((1) (23 a-litatom 45 "hi" bye (my small list))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals ((1) (23 a-litatom 45 \"hi\" bye (my small list)))
Testing: selection of entire structure
Select the entire structure.
Select Paren from the popup menu.
Were you able to get this far?"))
(good-value (equal '(((1) (23 a-litatom 45 "hi" bye (my small list)))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
) ; end of do-test-group
STOP

View File

@@ -1,342 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 5, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>SEdit-command-low-paren.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Parenthesize current selection"
:before (progn
(setq window-list (do-test-menu-Setup "Parenthesize")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Parenthesize: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing parentheses
If needed, bring up a second exec and type: \"(cl:in-package 'xcl-test)\"
Then in the exec type:
(setq tempx '(1 23 ab cd \"how\" \"are\" \"you\" (\"hi\" \"bye\" a 23 4)))
(il:dv tempx)
Type meta-(.
Does the SEdit prompt window say \"Select structure to parenthesize.\"?"))
(good-value (equal '(1 23 ab cd "how" "are" "you" ("hi" "bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: no selection/edit caret"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing tempx which currently equals (1 23 ab cd \"how\" \"are\" \"you\" (\"hi\" \"bye\" a 23 4))
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-(.
Does the SEdit prompt window say \"Select structure to parenthesize.\"?"))
(good-value (equal '(1 23 ab cd "how" "are" "you" ("hi" "bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: no selection/structure caret"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing tempx which currently equals (1 23 ab cd \"how\" \"are\" \"you\" (\"hi\" \"bye\" a 23 4))
Want to place the structure caret right between \"ab\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-(.
Does the SEdit prompt window say \"Select structure to parenthesize.\"?"))
(good-value (equal '(1 23 ab cd "how" "are" "you" ("hi" "bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing tempx which currently equals (1 23 ab cd \"how\" \"are\" \"you\" (\"hi\" \"bye\" a 23 4))
Select the litatom \"ab\" as a structure, by pressing the middle button with the cursor over the litatom.
Type meta-).
Is the litatom AB now parenthesized?"))
(good-value (equal '(1 23 (ab) cd "how" "are" "you" ("hi" "bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing tempx which currently equals (1 23 (ab) cd \"how\" \"are\" \"you\" (\"hi\" \"bye\" a 23 4))
Select the string \"how\" as a structure, by pressing the middle button, with the cursor over the string.
Type meta-).
Is the string \"how\" now parenthesized?"))
(good-value (equal '(1 23 (ab) cd ("how") "are" "you" ("hi" "bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing tempx which currently equals (1 23 (ab) cd (\"how\") \"are\" \"you\" (\"hi\" \"bye\" a 23 4))
Select the number \"1\" as a structure, by pressing the middle button, with the cursor over the number.
Select PARENTHESIZE from the popup menu.
Is the number \"1\" now parenthesized?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" ("hi" "bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" (\"hi\" \"bye\" a 23 4))
Select the list (\"hi\" \"bye\" a 23 4) as a structure.
Type meta-9, and then control-x.
Is the list now parenthesized?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select a comment"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a comment
Assuming SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Place the edit caret after the number 23 and type \"; hello\", then select this as a structure, and type meta-0.
Check to see if it has parenthesis around it, then select Abort from the pop-up menu, clicking the left button to confirm the abort.
Was the parenthesis around the comment?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select part of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming tempx currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Type: \"(il:dv tempx)\"
Select the \"d\" in the litatom \"cd\" and type meta-0.
Does the SEdit prompt window say \"Select structure to parenthesize.\"?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select part of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Select the \"h\" in the string \"how\" and type meta-0.
Does the SEdit prompt window say \"Select structure to parenthesize.\"?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: select part of a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Select the \"2\" in the number \"23\" and type meta-0.
Does the SEdit prompt window say \"Select structure to parenthesize.\"?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: delete a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a litatom
Assuming SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Place the edit caret after the litatom \"ab\" with in the list.
Type \" ef\", then control-W and meta-0.
Does the SEdit prompt window say \"Select structure to parenthesize.\"?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: delete a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a string
Assuming SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Place the structure caret after the string \"hi\" with in the list.
Type a double quote, and then the word \"there\", put the structure caret right after this string, and type control-W and meta-0.
Does the SEdit prompt window say \"Select structure to parenthesize.\"?"))
(good-value (equal '((1) 23 (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: delete a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a number
Assuming SEdit is editing tempx which currently equals ((1) 23 (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Place the edit caret right after the number \"23\" with no selection.
Type control-W, and meta-(, control-x.
Does the SEdit prompt window say \"Select structure to parenthesize.\"?"))
(good-value (equal '((1) (ab) cd ("how") "are" "you" (("hi" "bye" a 23 4))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: delete a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a list
Assuming SEdit is editing tempx which currently equals ((1) (ab) cd (\"how\") \"are\" \"you\" ((\"hi\" \"bye\" a 23 4)))
Place the structure caret right after the list \"((\"hi\" \"bye\" a 23 4))\" with no selection.
Type control-W, and meta-(, control-x.
Does the SEdit prompt window say \"Select structure to parenthesize.\"?"))
(good-value (equal '((1) (ab) cd ("how") "are" "you") tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: delete a comment"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try after deleting a comment
Assuming SEdit is editing tempx which currently equals ((1) (ab) cd (\"how\") \"are\" \"you\")
Place the structure caret after the litatom \"cd\" and type \"; hello\", then select this as a structure with the caret to the right.
Press the delete key and type meta-(, control-x.
Does the SEdit prompt window say \"Select structure to parenthesize.\"?"))
(good-value (equal '((1) (ab) cd ("how") "are" "you") tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of litatoms"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing tempx which currently equals ((1) (ab) cd (\"how\") \"are\" \"you\")
Place the edit caret after the litatom \"cd\".
Type \" ef gh\".
Now select the litatom \"cd\" as a structure, and extend the selection to include the next two litatoms.
Type meta-(.
Are the three litatoms now parenthesized?"))
(good-value (equal '((1) (ab) (cd ef gh) ("how") "are" "you") tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of strings"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing tempx which currently equals ((1) (ab) (cd ef gh) (\"how\") \"are\" \"you\")
Select the string \"are\" as a structure, and extend the selection to include the next string.
Type meta-(.
Are the two strings now parenthesized?"))
(good-value (equal '((1) (ab) (cd ef gh) ("how") ("are" "you")) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing tempx which currently equals ((1) (ab) (cd ef gh) (\"how\") (\"are\" \"you\"))
Place the structure caret after the list \"(1)\".
Type \" 2 3 4\".
Now select the number \"2\" as a structure, and extend the selection to include the next two numbers.
Type meta-).
Are the three numbers now parenthesized?"))
(good-value (equal '((1) (2 3 4) (ab) (cd ef gh) ("how") ("are" "you")) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing tempx which currently equals ((1) (2 3 4) (ab) (cd ef gh) (\"how\") (\"are\" \"you\"))
Select the list \"(2 3 4)\" as a structure, and extend the selection to include the next two lists.
Type meta-).
Are the three lists now parenthesized?"))
(good-value (equal '((1) ((2 3 4) (ab) (cd ef gh)) ("how") ("are" "you")) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of litatoms and numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing tempx which currently equals ((1) ((2 3 4) (ab) (cd ef gh)) (\"how\") (\"are\" \"you\"))
Select the list \"((2 3 4) (ab) (cd ef gh))\" as a structure and press the delete key.
Now type \" ab 23 cd 45\"
Select the litatom \"ab\" as a structure, and extend the selection to include the next three items.
Type meta-).
Is the selection now parenthesized?"))
(good-value (equal '((1) (ab 23 cd 45) ("how") ("are" "you")) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of strings and lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing tempx which currently equals ((1) (ab 23 cd 45) (\"how\") (\"are\" \"you\"))
Place the structure caret after the list \"(1)\".
Type \" (hi) \"hi\" (bye) \"bye\" (list-string)\"
Select the list \"(hi)\" as a structure, and extend the selection to include the next four items.
Select Parenthesize from the popup menu.
Is the selection now parenthesized?"))
(good-value (equal '((1) ((hi) "hi" (bye) "bye" (list-string)) (ab 23 cd 45) ("how") ("are" "you")) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: extended selection of several things"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing tempx which currently equals ((1) ((hi) \"hi\" (bye) \"bye\" (list-string)) (ab 23 cd 45) (\"how\") (\"are\" \"you\"))
Select the second list as a structure, extend the select to include the rest of the items, and press the delete key.
Type \"23 a-litatom 45 \"hi\" bye (my small list)\"
Select the number \"23\" as a structure, and extend the selection to include the next five items.
Select Parenthesize from the popup menu.
Is the selection now parenthesized?"))
(good-value (equal '((1) (23 a-litatom 45 "hi" bye (my small list))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assuming SEdit is editing tempx which currently equals ((1) (23 a-litatom 45 \"hi\" bye (my small list)))
Testing: selection of entire structure
Select the entire structure.
Select Parenthesize from the popup menu.
Is the entire structure inside an extra set of parentheses?"))
(good-value (equal '(((1) (23 a-litatom 45 "hi" bye (my small list)))) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Parenthesize: clean-up"
(let* ((user-result (do-test-menu-Message window-list 'low
"Close the SEdit window.")))
))
) ; end of do-test-group
STOP

View File

@@ -1,384 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 21, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-substitute.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Substitute"
:before (progn
(setq window-list (do-test-menu-Setup "Substitute")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Substitute: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing Substitute
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(il:dv tempx)
Select Substitute from the pop up menu.
Does SEdit display in the SEdit prompt window:
\"Select structure to substitue within.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select DONE from the SEdit popup menu.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-S.
Does SEdit display in the SEdit prompt window:
\"Select structure to substitute within.\"? "))
(do-test "Substitute: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Want to place the structure caret right between \"(b)\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-S.
Does SEdit display in the SEdit prompt window:
\"Select structure to substitute within.\"? "))
(do-test "Substitute: select a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) \"hi\" (b) cd 4))
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-S.
Enter the litatom \"cd\" then the litatom \"cde\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cde efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: select a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cde efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-S.
Enter the string \"hello\" then the string \"HELLO\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "HELLO" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"HELLO\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-S.
Enter the number \"4.5\" then the number \"5.4\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 5.4 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 5.4 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-S.
Enter the list \"(bye)\" then the list \"(bye now)\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye now) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye now) (\"hi\" (b) cd 4))
Type meta-U.
Select the \"d\" in the first litatom \"cd\".
Type meta-S.
Does SEdit display in the SEdit prompt window:
\"Select structure to substitue within.\"? "))
(do-test "Substitute: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"h\" in the string \"hello\".
Type meta-S.
Does SEdit display in the SEdit prompt window:
\"Select structure to substitue within.\"? "))
(do-test "Substitute: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-S.
Does SEdit display in the SEdit prompt window:
\"Select structure to substitue within.\"? "))
(do-test "Substitute: pending delete of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-S.
First enter the litatom \"efg\" then the number \"999\".
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd 999 "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: pending delete of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd 999 \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-S.
First enter the string \"hello\" then the litatom \"we-2\".
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg we-2 "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
;Have an AR on this
;(do-test "Substitute: pending delete a number"
; (let* ((user-result (do-test-menu-Message window-list 'low
;" Testing: pending delete of a number
;Assumping SEdit is editing the variable tempx which currently equals:
; (1 4.5 6/7 a cd efg we-2 \"BYE\" (bye) (\"hi\" (b) cd 4))
;Type meta-U.
;Select the number \"4.5\" in pending delete mode.
;Type meta-S.
;Enter the number \"4.5\", then the list \"(a b c d)\".
;Does SEdit display in the SEdit prompt window:
; \"Select structure to extract.\"? "))
; (good-value (equal '(1 (a b c d) 6/7 a cd efg "hello" "BYE" (bye) ("hi" ;(b) cd 4)) tempx)))
; (and user-result (if (eq t user-result) good-value T))
; ))
(do-test "Substitute: pending delete of a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg we-2 \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the list \"(bye)\" in pending delete mode.
Type meta-S.
Enter the list \"(bye)\", then the number \"2\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" 2 ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of litatoms"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" 2 (\"hi\" (b) cd 4))
Type meta-U.
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-S
Enter the litatom \"a\", then the string \"Wedding song\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 "Wedding song" cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of strings"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 \"Wedding song\" cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-S
First enter the string \"hello\", then the number \"12\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg 12 "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg 12 \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the number \"1\" as a structure, and extend the selection to include the next two numbers.
Type meta-S.
First enter the number \"6/7\", then the list \"(56 65)\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 (56 65) a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 (56 65) a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-S.
First enter the list \"(b)\", then the litatom \"bcd\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" bcd cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of litatoms and numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" bcd cd 4))
Type meta-U.
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-S.
First enter the number \"1\", then the litatom \"qw\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(qw 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of strings and lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assumping SEdit is editing the variable tempx which currently equals:
(qw 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-S.
First enter the string \"BYE\", then the number \"7878\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" 7878 (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of several things"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" 7878 (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-S.
First enter the litatom \"cd\", then the litatom \"gh\"
Does SEdit display in the SEdit prompt window:
\"2 substitutions made.\"? "))
(good-value (equal '(1 4.5 6/7 a gh efg "hello" "BYE" (bye) ("hi" (b) gh 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a gh efg \"hello\" \"BYE\" (bye) (\"hi\" (b) gh 4))
Type meta-U.
Select the entire structure.
Type meta-S.
First enter the string \"Should not change value\", then the litatom \"not-there\"
Does SEdit display in the SEdit prompt window:
\"No substitutions made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: Pending delete of whole structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the entire structure in pending delete mode.
Type meta-m.
Enter the number 4 in the FIND field. and the number 5 in the SUBSTITUE field.
Pick the substitute command on the attached menu.
Does SEdit display in the SEdit prompt window:
\"Select structure to extract.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 5)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,383 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 21, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-substitute.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Substitute"
:before (progn
(setq window-list (do-test-menu-Setup "Substitute")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Substitute: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing Substitute
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(il:dv tempx)
Select Substitute from the pop up menu.
Does SEdit display in the SEdit prompt window:
\"Please select a structure to substitute within.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select DONE from the SEdit popup menu.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-S.
Does SEdit display in the SEdit prompt window:
\"Please select a structure to substitute within.\"? "))
(do-test "Substitute: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Want to place the structure caret right between \"(b)\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-S.
Does SEdit display in the SEdit prompt window:
\"Please select a structure to substitute within.\"? "))
(do-test "Substitute: select a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) \"hi\" (b) cd 4))
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-S.
Enter the litatom \"cd\" then the litatom \"cde\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cde efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: select a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cde efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-S.
Enter the string \"hello\" (with quotes) then the string \"HELLO\" (with quotes).
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "HELLO" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"HELLO\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-S.
Enter the number \"4.5\" then the number \"5.4\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 5.4 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 5.4 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-S.
Enter the list \"(bye)\" then the list \"(bye now)\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye now) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye now) (\"hi\" (b) cd 4))
Type meta-U.
Select the \"d\" in the first litatom \"cd\".
Type meta-S.
Does SEdit display in the SEdit prompt window:
\"Please select a structure to substitute within.\"? "))
(do-test "Substitute: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"h\" in the string \"hello\".
Type meta-S.
Does SEdit display in the SEdit prompt window:
\"Please select a structure to substitute within.\"? "))
(do-test "Substitute: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-S.
Does SEdit display in the SEdit prompt window:
\"Please select a structure to substitute within.\"? "))
(do-test "Substitute: pending delete of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-S.
First enter the litatom \"efg\" then the number \"999\".
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd 999 "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: pending delete of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd 999 \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-S.
First enter the string \"hello\" (with quotes) then the litatom \"we-2\" (without quotes).
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg we-2 "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: pending delete a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg we-2 \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the number \"4.5\" in pending delete mode.
Type meta-S.
Enter the number \"4.5\", then the list \"(a b c d)\".
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 (a b c d) 6/7 a cd efg "hello" "BYE" (bye) ("hi" ;(b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: pending delete of a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg we-2 \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the list \"(bye)\" in pending delete mode.
Type meta-S.
Enter the list \"(bye)\", then the number \"2\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" 2 ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of litatoms"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" 2 (\"hi\" (b) cd 4))
Type meta-U.
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-S
Enter the litatom \"a\", then the string \"Wedding song\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 "Wedding song" cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of strings"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 \"Wedding song\" cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-S
First enter the string \"hello\", then the number \"12\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg 12 "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg 12 \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the number \"1\" as a structure, and extend the selection to include the next two numbers.
Type meta-S.
First enter the number \"6/7\", then the list \"(56 65)\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 (56 65) a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 (56 65) a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-S.
First enter the list \"(b)\", then the litatom \"bcd\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" bcd cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of litatoms and numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" bcd cd 4))
Type meta-U.
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-S.
First enter the number \"1\", then the litatom \"qw\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(qw 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of strings and lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing the variable tempx which currently equals:
(qw 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-S.
First enter the string \"BYE\", then the number \"7878\"
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" 7878 (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: extended selection of several things"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" 7878 (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-S.
First enter the litatom \"cd\", then the litatom \"gh\"
Does SEdit display in the SEdit prompt window:
\"2 substitutions made.\"? "))
(good-value (equal '(1 4.5 6/7 a gh efg "hello" "BYE" (bye) ("hi" (b) gh 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a gh efg \"hello\" \"BYE\" (bye) (\"hi\" (b) gh 4))
Type meta-U.
Select the entire structure.
Type meta-S.
First enter the string \"Should not change value\", then the litatom \"not-there\"
Does SEdit display in the SEdit prompt window:
\"No substitutions made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Substitute: Pending delete of whole structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Type meta-U.
Select the entire structure in pending delete mode.
Type meta-m.
Enter the number 4 in the FIND field. and the number 5 in the SUBSTITUTE field.
Pick the substitute command on the attached menu.
Does SEdit display in the SEdit prompt window:
\"1 substitution made.\"? "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 5)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting EXIT from the attached menu."))
) ; end of do-test-group
STOP

View File

@@ -1,645 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 17, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-undo-redo.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Undo/Redo"
:before (progn
(setq window-list (do-test-menu-Setup "Undo/Redo")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Undo: no selection/no caret"
(let* (( user-result(do-test-menu-Message window-list 'high
" Testing Undo
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4)))
(ed 'tempx)
Select Undo from the popup menu.
Does it respond with:
\"Nothing to Undo\"? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: no selection/no caret"
(do-test-menu-Message window-list 'high
" Testing Redo
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select DONE from the popup menu.
Select Redo from the popup menu.
Does it respond with:
\"No Undo to Undo\"? "))
(do-test "Undo: no selection/edit caret"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"4.5\" and press the delete key.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: no selection/edit caret"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: no selection/structure caret"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Want to place the structure caret right between \"b\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: no selection/structure caret"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Place the structure caret between \"b\" and \"cd\".
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the third litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the fourth litatom \"efg\" as a structure.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"6/7\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" as a structure.
Type meta-R.
Select the string \"BYE\" and press the delete key.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select a comment"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a comment
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" (bye) (\"hi\" b cd 4))
Place the edit caret after the number 1 and type \"; hello\", then select this as a structure.
Type meta-U three times.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select a comment"
(do-test-menu-Message window-list 'low
" Testing: select a comment
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Place the edit caret after the number 2 and type \"; bye\", then select this as a structure.
Type meta-R.
Does SEdit display in the SEdit prompt window:
\"No Undo to Undo\"? "))
(do-test "Undo: select part of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 ; bye 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the comment as a structure and press the delete key.
Type control-x.
Place the strcuture caret after the litatom \"efg\"
Type: \"(Have a nice day please)\"
Select the \"d\" in the first litatom \"cd\".
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select part of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"f\" in the litatom \"efg\".
Type meta-R twice.
Does SEdit display in the SEdit prompt window:
\"No Undo to Undo.\"? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day please) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select part of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day please) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"h\" in the string \"hello\".
Type meta-U three times.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select part of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"B\" in the string \"BYE\".
Type meta-R twice.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select part of a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-U four times.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg () "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select part of a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg () \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"6\" in the number \"6/7\".
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: pending delete of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the litatom \"cd\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"c\" and then pressing the right button withe the cursor on the \"d\". This should create a box around the litatom \"cd\".
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg () "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: pending delete of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg () \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the litatom \"efg\" in pending delete mode.
Type meta-R four times.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: pending delete of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: pending delete of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" in pending delete mode bye.
Type meta-R twice.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day please) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: pending delete a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day please) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"6/7\" in pending delete mode.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: pending delete a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"6/7\" in pending delete mode.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day please) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: pending delete of a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day please) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" in pending delete mode.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: pending delete of a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" in pending delete mode.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day please) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of litatoms"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day please) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(Have a nice day please)\" and press the delete key.
Type control-x.
Select the litatom \"cd\" as a structure, and extend the selection to include the next litatom, type \"defgh\".
Select the litatom \"a\" and extend the selection to include the next two litatoms.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of litatoms"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-R
Were the litatoms joined together to form \"abcd\"? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of strings"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-U
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of strings"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-R
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next two numbers.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next number.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hi\" as a structure, and extend the selection to include the previous list.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of litatoms and numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of litatoms and numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of strings and lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of strings and lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of several things"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of several things"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the entire structure.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4)
Select the entire structure.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,645 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 17, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-undo-redo.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Undo/Redo"
:before (progn
(setq window-list (do-test-menu-Setup "Undo/Redo")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Undo: no selection/no caret"
(let* (( user-result(do-test-menu-Message window-list 'high
" Testing Undo
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4)))
(ed 'tempx)
Select Undo from the popup menu.
Does it respond with:
\"Nothing to Undo\"? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: no selection/no caret"
(do-test-menu-Message window-list 'high
" Testing Redo
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select DONE from the popup menu.
Select Redo from the popup menu.
Does it respond with:
\"No Undo to Undo\"? "))
(do-test "Undo: no selection/edit caret"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"4.5\" and press the delete key.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: no selection/edit caret"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: no selection/structure caret"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Want to place the structure caret right between \"b\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: no selection/structure caret"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Place the structure caret between \"b\" and \"cd\".
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the third litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the fourth litatom \"efg\" as a structure.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"6/7\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 4.5 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 4.5 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" as a structure.
Type meta-R.
Select the string \"BYE\" and press the delete key.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select a comment"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select a comment
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" (bye) (\"hi\" b cd 4))
Place the edit caret after the number 1 and type \"; hello\", then select this as a structure.
Type meta-U three times.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select a comment"
(do-test-menu-Message window-list 'low
" Testing: select a comment
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Place the edit caret after the number 2 and type \"; bye\", then select this as a structure.
Type meta-R.
Does SEdit display in the SEdit prompt window:
\"No Undo to Undo\"? "))
(do-test "Undo: select part of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 ; bye 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the comment as a structure and press the delete key.
Type control-x.
Place the strcuture caret after the litatom \"efg\"
Type: \"(Have a nice day please)\"
Select the \"d\" in the first litatom \"cd\".
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select part of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"f\" in the litatom \"efg\".
Type meta-R twice.
Does SEdit display in the SEdit prompt window:
\"No Undo to Undo.\"? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day please) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select part of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day please) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"h\" in the string \"hello\".
Type meta-U three times.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select part of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"B\" in the string \"BYE\".
Type meta-R twice.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: select part of a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-U four times.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg () "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: select part of a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg () \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the \"6\" in the number \"6/7\".
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: pending delete of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the litatom \"cd\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"c\" and then pressing the right button withe the cursor on the \"d\". This should create a box around the litatom \"cd\".
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg () "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: pending delete of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg () \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the litatom \"efg\" in pending delete mode.
Type meta-R four times.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: pending delete of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: pending delete of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" in pending delete mode.
Type meta-R twice.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day please) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: pending delete a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day please) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"6/7\" in pending delete mode.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: pending delete a number"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"6/7\" in pending delete mode.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day please) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: pending delete of a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day please) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" in pending delete mode.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: pending delete of a list"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" in pending delete mode.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg (Have a nice day please) "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of litatoms"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg (Have a nice day please) \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(Have a nice day please)\" and press the delete key.
Type control-x.
Select the litatom \"cd\" as a structure, and extend the selection to include the next litatom, type \"defgh\".
Select the litatom \"a\" and extend the selection to include the next two litatoms.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of litatoms"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-R
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of strings"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-U
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of strings"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-R
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next two numbers.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next number.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the list \"(bye)\" as a structure, and extend the selection to include the next list.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hi\" as a structure, and extend the selection to include the previous list.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of litatoms and numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of litatoms and numbers"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of strings and lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of strings and lists"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: extended selection of several things"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: extended selection of several things"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Undo: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b defgh \"hello\" \"BYE\" (bye) (\"hi\" b cd 4))
Select the entire structure.
Type meta-U.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b cd efg "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Redo: selection of entire structure"
(let* ((user-result (do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 2 6/7 a b cd efg \"hello\" \"BYE\" (bye) (\"hi\" b cd 4)
Select the entire structure.
Type meta-R.
Were you able to get this far? "))
(good-value (equal '(1 2 6/7 a b defgh "hello" "BYE" (bye) ("hi" b cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,362 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 6, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-control.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
;;; -----------------------------------------------------
;;;
;;; The following are the complete tests, a do-test-group per command
;;; From keyboard, popup menu, attached menu. Test for all possible
;;; combinations of selection and caret point:
;;; no selection/no caret
;;; no selection/edit caret
;;; no selection/structure caret
;;; selection of each lisp type: litatom, string, list, comment, gap
;;; selection of part of each type above
;;; pending delete selection of each type above
;;; extended selection ofobjects of the same type
;;; extended selection of objects of mixed type
;;; selection of entire structure
;;; pending delete selection of entire structure
;;;
;;; -----------------------------------------------------
(do-test-group "Redisplay, test against standard set"
:before (progn
(setq window-list (do-test-menu-Setup "Redisplay")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Redisplay:no selection/no caret"
(do-test-menu-Message window-list 'high
"If needed, bring up a second exec and type: \"(cl:in-package 'xcl-test)\"
Testing: no selection/no caret
In the exec type:
(setq tempx '(1 xy \"hi\" (\"bye\" a 23 4)))
(il:dv tempx)
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: no selection/edit caret"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (1 xy \"hi\" (\"bye\" a 23 4))
Testing: no selection/edit caret
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: no selection/structure caret"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (1 xy \"hi\" (\"bye\" a 23 4))
Testing: no selection/structure caret
Want to place the structure caret right between xy and \"hi\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: select a litatom"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (1 xy \"hi\" (\"bye\" a 23 4))
Testing: select a litatom
Select the litatom \"xy\" as a structure, by pressing the middle button.
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: select a string"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (1 xy \"hi\" (\"bye\" a 23 4))
Testing: select a string
Select the string \"hi\" as a structure.
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: select a number"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (1 xy \"hi\" (\"bye\" a 23 4))
Testing: select a number
Select the number \"1\" as a structure.
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: select a list"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (1 xy \"hi\" (\"bye\" a 23 4))
Testing: select a list
Select the list (\"bye\" a 23 4) as a structure.
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: select part of a litatom"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (1 xy \"hi\" (\"bye\" a 23 4))
Testing: select part of a litatom
Select the \"x\" in the litatom \"xy\" by pressing the left button.
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: select part of a string"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (1 xy \"hi\" (\"bye\" a 23 4))
Testing: select part of a string
Select the \"h\" in the string \"hi\".
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: select part of a number"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (1 xy \"hi\" (\"bye\" a 23 4))
Testing: select part of a number
Select the \"2\" in the number \"23\".
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: delete a litatom"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (1 xy \"hi\" (\"bye\" a 23 4))
Testing: delete a litatom
Delete the litatom \"xy\" by selecting it as a structure and pressing the delete key.
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: delete a string"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (1 \"hi\" (\"bye\" a 23 4))
Testing: delete a string
Delete the string \"hi\".
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: delete of a number"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (1 (\"bye\" a 23 4))
Testing: delete a number
Delete the number \"1\".
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: extended selection of objects of same type"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals ((\"bye\" a 23 4))
Testing: extended selection of objects of same type
Select the numbers 23 and 4, by picking the 23 with the left button, and the 4 with the right button.
Type control-L.
Was the SEdit window redisplayed?"))
(do-test "Redisplay: extended selection of objects of different types"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals ((\"bye\" a 23 4))
Testing: extended selection of objects of different types
Select all items in the smaller list.
Type control-L.
Was the SEdit window redisplayed?"))
) ; End of do-test-group
(do-test-group "Delete previous and done, test against standard set"
:before (progn
(setq window-list (do-test-menu-Setup "Delete previous")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Delete previous & done:no selection/no caret"
(let* (( user-result (do-test-menu-Message window-list 'high
" Testing parentheses
If needed, bring up a second exec and type: \"(cl:in-package 'xcl-test)\"
Then in the exec type:
(setq tempx '(1 2 34 ab cd ef gh \"hi\" \"how\" \"are\" \"you\" (\"bye\" a 23 4)))
(il:dv tempx)
Type control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal '(1 2 34 ab cd ef gh "hi" "how" "are" "you" ("bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Delete previous & done: no selection/edit caret"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (1 2 34 ab cd ef gh \"hi\" \"how\" \"are\" \"you\" (\"bye\" a 23 4))
Testing: no selection/edit caret
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal '(2 34 ab cd ef gh "hi" "how" "are" "you" ("bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Delete previous & done: no selection/structure caret"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (2 34 ab cd ef gh \"hi\" \"how\" \"are\" \"you\" (\"bye\" a 23 4))
Testing: no selection/structure caret
Want to place the structure caret right between \"ab\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal '(2 34 cd ef gh "hi" "how" "are" "you" ("bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Delete previous & done: select a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (2 34 cd ef gh \"hi\" \"how\" \"are\" \"you\" (\"bye\" a 23 4))
Testing: select a litatom
Select the litatom \"gh\" as a structure, by pressing the middle button with the cursor over the \"h\". The structure caret should end up to the right of \"gh\".
Type control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal '(2 34 cd ef "hi" "how" "are" "you" ("bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Delete previous & done: select a string"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (2 34 cd ef \"hi\" \"how\" \"are\" \"you\" (\"bye\" a 23 4))
Testing: select a string
Select the string \"hi\" as a structure, with the structure caret to the right of the string.
Type control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal '(2 34 cd ef "how" "are" "you" ("bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Delete previous & done: select a number"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (2 34 cd ef \"how\" \"are\" \"you\" (\"bye\" a 23 4))
Testing: select a number
Select the number \"2\" as a structure, with the structure caret to the right of the number.
Type control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal '(34 cd ef "how" "are" "you" ("bye" a 23 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Delete previous & done: select a list"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (34 cd ef \"how\" \"are\" \"you\" (\"bye\" a 23 4))
Testing: select a list
Select the list (\"bye\" a 23 4) as a structure, with the structure caret to the right of the list.
Type control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal '(34 cd ef "how" "are" "you") tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Delete previous & done: select part of a litatom"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (34 cd ef \"hi\" \"how\" \"are\" \"you\")
Testing: select part of a litatom
ÿÿPlace the edit caret in the middle of the litatom \"cd\".ÿ
Type control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal '(34 d ef "how" "are" "you") tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Delete previous & done: select part of a string"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (2 3 d ef \"how\" \"are\" \"you\")
Testing: select part of a string
ÿÿPlace the edit caret ÿafter the \"h\" in the string \"how\"ÿÿ.ÿ
Type control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal '(34 d ef "ow" "are" "you") tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Delete previous & done: select part of a number"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (34 d ef \"ow\" \"are\" \"you\")
Testing: select part of a number
ÿÿPlace the edit caret in the middle of the ÿnumberÿÿ \"ÿ34ÿÿ\".ÿ
Type control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal '(4 d ef "ow" "are" "you") tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Delete previous & done: delete a litatom after a delete"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (4 d ef \"ow\" \"are\" \"you\")
Testing: delete a litatom after a delete
Place the structure caret after the string \"ow\" with no selection.
Type control-W, control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal '(4 d "are" "you") tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Delete previous & done: delete a string after a delete"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (4 d \"are\" \"you\")
Testing: delete a string
Place the structure caret after the string \"you\" with selection of the string.
Type control-W, control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal '(4 d) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Delete previous & done: delete of a number after a delete"
(let* ((user-result (do-test-menu-Message window-list 'low
"Assumping SEdit is editing tempx which currently equals (4 d)
Testing: delete a number after a delete
Place the edit caret after the litatom \"d\" with no selection.
Type control-W, control-W, and a control-X.
Were you able to get this far?"))
(good-value (equal nil tempx)))
(and user-result (if (eq t user-result) good-value T))
))
) ; end of do-test-group
STOP

File diff suppressed because one or more lines are too long

View File

@@ -1,191 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 5, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>interrupts.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Interrupts"
:before (progn
(setq window-list (do-test-menu-Setup "Interrupts")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "no selection/no caret"
(do-test-menu-Message window-list 'high
"If you are not in the XCL-TEST package. Stop this assistant and change packages.
Create a second EXEC if needed.
Testing no selection/no caret
Type:
(setq tempx '(xy \"hi\" 5 (a 23 4 \"bye\")))
(il:SEdit tempx)
Type control-G. A menu should come up asking \"Interrupt which possess?\" just click outside of the menu.
Type control-B. A break window for SEdit should pop up. Continue on.
Did both interrupts go correctly?"))
(do-test "no selection/edit caret"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
Testing no selection/edit caret
Type: \"(il:dv tempx)\"
Want to place the edit caret right after the 5 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 5.
Type control-G. A menu should come up asking \"Interrupt which possess?\" just click outside of the menu.
Type control-B. A break window for SEdit should pop up. Continue on.
Did both interrupts go correctly?"))
(do-test "no selection/structure caret"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
Testing no selection/structure caret
Type: \"(il:dv tempx)\"
Want to place the structure caret right between \"hi\" and the 5 without selecting either \"hi\" or the 5. Do this by positioning the mouse cursor between the two items and press the middle button.
Type control-G, control-B.
Do both perform as specified before?"))
(do-test "select a litatom"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
Testing select a litatom
Type: \"(il:dv tempx)\"
Select the litatom \"xy\" as a structure, by pressing the middle button.
Type control-G and control-B
Do both perform as specified before?"))
(do-test "select a string"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
Testing select a string
Type: \"(il:dv tempx)\"
Select the string \"hi\" as a structure.
Type control-G and control-B
Do both perform as specified before?"))
(do-test "select a number"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
Testing select a number
Type: \"(il:dv tempx)\"
Select the number \"5\" as a structure.
Type control-G and control-B
Do both perform as specified before?"))
(do-test "select a list"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
Testing select a list
Type: \"(il:dv tempx)\"
Select the list (a 23 4 \"bye\") as a structure.
Type control-G and control-B
Do both perform as specified before?"))
(do-test "select part of a litatom"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
Testing select part of a litatom
Type: \"(il:dv tempx)\"
Select the \"x\" in the litatom \"xy\" by pressing the left button.
Type control-G and control-B
Do both perform as specified before?"))
(do-test "select part of a string"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
Testing select part of a string
Type: \"(il:dv tempx)\"
Select the \"h\" in the string \"hi\".
Type control-G and control-B
Do both perform as specified before?"))
(do-test "select part of a number"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
Testing select part of a number
Type: \"(il:dv tempx)\"
Select the \"2\" in the number \"23\".
Type control-G and control-B
Do both perform as specified before?"))
(do-test "delete a litatom"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
Testing delete a litatom
Type: \"(il:dv tempx)\"
Delete the litatom \"xy\" by selecting it as a structure and pressing the delete key.
Type control-G and control-B
Do both perform as specified before?"))
(do-test "delete a string"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (\"hi\" 5 (a 23 4 \"bye\"))
Testing delete a string
Type: \"(il:dv tempx)\"
Delete the string \"hi\".
Type control-G and control-B
Do both perform as specified before?"))
(do-test "delete of a number"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals (5 (a 23 4 \"bye\"))
Testing delete a number
Type: \"(il:dv tempx)\"
Delete the number \"5\".
Type control-G and control-B
Do both perform as specified before?"))
(do-test "extended selection of objects of same type"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals ((a 23 4 \"bye\"))
Testing extended selection of objects of same type
Type: \"(il:dv tempx)\"
Select the numbers 23 and 4, by picking the 23 with the left button, and the 4 with the right button.
Type control-G and control-B
Do both perform as specified before?"))
(do-test "extended selection of objects of different types"
(do-test-menu-Message window-list 'low
"Assumping tempx currently equals ((a 23 4 \"bye\"))
Testing extended selection of objects of different types
Type: \"(il:dv tempx)\"
Select all items in the smaller list.
Type control-G and control-B
Do both perform as specified before?"))
) ; end of do-test-group
STOP

View File

@@ -1,191 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 5, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>interrupts.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Interrupts"
:before (progn
(setq window-list (do-test-menu-Setup "Interrupts")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "no selection/no caret"
(do-test-menu-Message window-list 'high
"If you are not in the XCL-TEST package. Stop this assistant and change packages.
Create a second EXEC if needed.
Testing no selection/no caret
Type:
(setq tempx '(xy \"hi\" 5 (a 23 4 \"bye\")))
(il:dv tempx)
Type control-G. A menu should come up asking \"Interrupt which possess?\" just click outside of the menu.
Type control-B. A break window for SEdit should pop up. Continue on by typing \"ok\".
Did both interrupts go correctly?"))
(do-test "no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing no selection/edit caret
Assuming tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Want to place the edit caret right after the 5 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 5.
Type control-G. A menu should come up asking \"Interrupt which possess?\" just click outside of the menu.
Type control-B. A break window for SEdit should pop up. Continue on by typing \"ok\".
Did both interrupts go correctly?"))
(do-test "no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing no selection/structure caret
Assuming tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Want to place the structure caret right between \"hi\" and the 5 without selecting either \"hi\" or the 5. Do this by positioning the mouse cursor between the two items and press the middle button.
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
(do-test "select a litatom"
(do-test-menu-Message window-list 'low
" Testing select a litatom
Assuming tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Select the litatom \"xy\" as a structure, by pressing the middle button.
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
(do-test "select a string"
(do-test-menu-Message window-list 'low
" Testing select a string
Assuming tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Select the string \"hi\" as a structure.
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
(do-test "select a number"
(do-test-menu-Message window-list 'low
" Testing select a number
Assuming tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Select the number \"5\" as a structure.
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
(do-test "select a list"
(do-test-menu-Message window-list 'low
" Testing select a list
Assuming tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Select the list (a 23 4 \"bye\") as a structure.
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
(do-test "select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing select part of a litatom
Assuming tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Select the \"x\" in the litatom \"xy\" by pressing the left button.
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
(do-test "select part of a string"
(do-test-menu-Message window-list 'low
" Testing select part of a string
Assuming tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Select the \"h\" in the string \"hi\".
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
(do-test "select part of a number"
(do-test-menu-Message window-list 'low
" Testing select part of a number
Assuming tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Select the \"2\" in the number \"23\".
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
(do-test "delete a litatom"
(do-test-menu-Message window-list 'low
" Testing delete a litatom
Assuming tempx currently equals (xy \"hi\" 5 (a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Delete the litatom \"xy\" by selecting it as a structure and pressing the delete key.
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
(do-test "delete a string"
(do-test-menu-Message window-list 'low
" Testing delete a string
Assuming tempx currently equals (\"hi\" 5 (a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Delete the string \"hi\".
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
(do-test "delete of a number"
(do-test-menu-Message window-list 'low
" Testing delete a number
Assuming tempx currently equals (5 (a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Delete the number \"5\".
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
(do-test "extended selection of objects of same type"
(do-test-menu-Message window-list 'low
" Testing extended selection of objects of same type
Assuming tempx currently equals ((a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Select the numbers 23 and 4, by picking the 23 with the left button, and the 4 with the right button.
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
(do-test "extended selection of objects of different types"
(do-test-menu-Message window-list 'low
" Testing extended selection of objects of different types
Assuming tempx currently equals ((a 23 4 \"bye\"))
If needed, type: \"(il:dv tempx)\"
Select all items in the smaller list.
Type control-G, click outside the menu, then type control-B, and \"ok\".
Do both perform as specified before?"))
) ; end of do-test-group
STOP

View File

@@ -1,21 +0,0 @@
Command-abort.u failed
Command-base.u failed
Command-comment.u passed
Command-eval.u passed
Command-expand.u failed
Command-extract.u passed
Command-find.u failed
Command-help.u failed
Command-high.u passed
Command-join.u passed
Command-menu.u passed
Command-meta-o.u slow
Command-mutate.u passed
command-package.u passed
Command-paren.u passed
command-skip-next.u failed
Command-substitute.u failed
Command-undo-redo.u passed
Control.u passed
Interrupt.u
report.tedit

View File

@@ -1,20 +0,0 @@
Command-abort.u failed
Command-base.u failed
Command-comment.u passed
Command-eval.u passed
Command-expand.u failed
Command-extract.u passed
Command-find.u failed
Command-help.u failed
Command-high.u passed
Command-join.u passed
Command-menu.u passed
Command-meta-o.u slow
Command-mutate.u passed
command-package.u passed
Command-paren.u passed
command-skip-next.u failed
Command-substitute.u failed
Command-undo-redo.u passed
Control.u passed
Interrupt.u passed

View File

@@ -1,400 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 25, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-package.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Change Package"
:before (progn
(setq window-list (do-test-menu-Setup "Change Package")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Change Package: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing Change Package
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-packge 'xcl-test)\"
In the exec type:
(setq tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(ed 'tempx)
Select Change Package from the pop up menu.
Enter: \"il\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Change Package: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select DONE from the SEdit popup menu.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-P.
Enter: \"xcl\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Want to place the structure caret right between \"xcl-test::a\" and \"xcl-test::cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-P.
Enter: \"xcl-test\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XCL-TEST\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) \"hi\" (b) cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) \"hi\" (b) cd 4))
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-P.
Enter: \"xcl\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-P.
Enter: \"xcl\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-P twice.
Enter: \"INTERLISP\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the list \"(xcl-test::bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-P.
Enter: \"interlisp\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the \"d\" in the first litatom \"xcl-test::cd\".
Type meta-P.
Enter: \"XCL-TEST\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XCL-TEST\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"h\" in the string \"hello\".
Type meta-P.
Enter: \"XEROX-COMMON-LISP\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-P.
Enter: \"ZZZXXXYYY-SHOULD-NOT-EXIST\"
Check for two things.
First did SEdit display in the SEdit prompt window:
\"No such package: ZZZXXXYYY-SHOULD-NOT-EXIST\"?
Second does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
If it does both please indicate sucess. "))
(do-test "Change Package: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the litatom \"xcl-test::efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"xcl-test::efg\".
Type meta-P.
Enter: \"IL\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-P.
Enter: \"XCL-TEST\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XCL-TEST\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the list \"(bye)\" in pending delete mode.
Type meta-P.
Just press the carriage return.
Check for two things.
First does the SEdit banner still read:
\"Sedit TEMPX Package: XCL-TEST\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-P
Enter: \"il\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-P
Enter: \"IL\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next two numbers.
Type meta-P.
Enter: \"xcl\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the list \"(xcl-test::bye)\" as a structure, and extend the selection to include the next list.
Type meta-P.
Enter: \"il\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-P.
Enter: \"xcl\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-P.
Enter: \"XCL-TEST\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XCL-TEST\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-P.
Enter: \"XCL-TEST\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XCL-TEST\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: selection of entire structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) gh 4))
Select the entire structure.
Type meta-P.
Enter: \"il\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: Pending delete of whole structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the entire structure in pending delete mode.
Type meta-P.
Enter: \"xcl\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess."))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,401 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 25, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-package.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Change Package"
:before (progn
(setq window-list (do-test-menu-Setup "Change Package")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Change Package: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing Change Package
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(ed 'tempx)
Select Change Package from the pop up menu.
Enter: \"il\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Change Package: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select DONE from the SEdit popup menu.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-P.
Enter: \"xcl\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Want to place the structure caret right between \"xcl-test::a\" and \"xcl-test::cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-P.
Enter: \"xcl-test\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XCL-TEST\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) \"hi\" (b) cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) \"hi\" (b) cd 4))
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-P.
Enter: \"xcl\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-P.
Enter: \"xcl\"
Check for three things.
First, does the SEdit prompt window say \"Already editing in package XEROX-COMMON-LISP\."?
Does the SEdit banner still read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And third, does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does all these, please indicate sucess. "))
(do-test "Change Package: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-P twice.
Enter: \"INTERLISP\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the list \"(xcl-test::bye)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-P.
Enter: \"interlisp\"
Check for two things.
First does the SEdit banner still read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the \"d\" in the first litatom \"xcl-test::cd\".
Type meta-P.
Enter: \"XCL-TEST\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XCL-TEST\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the \"h\" in the string \"hello\".
Type meta-P.
Enter: \"XEROX-COMMON-LISP\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-P.
Enter: \"ZZZXXXYYY-SHOULD-NOT-EXIST\"
Check for two things.
First did SEdit display in the SEdit prompt window:
\"No such package: ZZZXXXYYY-SHOULD-NOT-EXIST\"?
Second does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
If it does both please indicate sucess. "))
(do-test "Change Package: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the litatom \"xcl-test::efg\" in pending delete mode by first pressing the middle button of the mouse with the cursor on the litatom and then pressing the right button with the cursor. This should create a box around the litatom \"xcl-test::efg\".
Type meta-P.
Enter: \"IL\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-P.
Enter: \"XCL-TEST\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XCL-TEST\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the list \"(bye)\" in pending delete mode.
Type meta-P.
Just press the carriage return.
Check for two things.
First does the SEdit banner still read:
\"Sedit TEMPX Package: XCL-TEST\"
And second does SEdit still display tempx to look like this:
\"(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-P
Enter: \"il\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-P
Enter: \"IL\"
Check for two things.
First does the SEdit banner still read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit still display tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next two numbers.
Type meta-P.
Enter: \"xcl\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the list \"(xcl-test::bye)\" as a structure, and extend the selection to include the next list.
Type meta-P.
Enter: \"il\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-P.
Enter: \"xcl\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-P.
Enter: \"XCL-TEST\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XCL-TEST\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-P.
Enter: \"XCL-TEST\"
Check for two things.
First does the SEdit banner still read:
\"Sedit TEMPX Package: XCL-TEST\"
And second does SEdit still display tempx like this:
\"(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: selection of entire structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) gh 4))
Select the entire structure.
Type meta-P.
Enter: \"il\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: INTERLISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess. "))
(do-test "Change Package: Pending delete of whole structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))
Select the entire structure in pending delete mode.
Type meta-P.
Enter: \"xcl\"
Check for two things.
First does the SEdit banner now read:
\"Sedit TEMPX Package: XEROX-COMMON-LISP\"
And second does SEdit redisplay tempx to look like this:
\"(1 4.5 6/7 xcl-test::a xcl-test::cd xcl-test::efg \"hello\" \"BYE\" (xcl-test::bye) (\"hi\" (xcl-test::b) xcl-test::cd 4))\"?
If it does both please indicate sucess."))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Done&Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,273 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 23, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-mutate.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Skip-Next"
:before (progn
(setq window-list (do-test-menu-Setup "Skip-Next")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Skip-Next: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing Skip-Next
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(ed 'tempx)
Select Skip-Next from the pop up menu.
Does SEdit either do nothing, or display a message complaing?
(AR 7699 is on it doing nothing.) "))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Skip-Next: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select DONE from the SEdit popup menu.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-N.
Does SEdit either do nothing, or display a message complaing?
(AR 7699 is on it doing nothing.) "))
(do-test "Skip-Next: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Place the edit caret after the litatom \"bye\" within the list and type: \" .\"
Want to place the structure caret right between \"a\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye . -x-) \"hi\" (b) cd 4))
Place the structure caret after the litatom \"efg\" and type \"'\"
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-N twice.
Does SEdit first place a box around the \"-x-\" with the quote, and then place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 9.0 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the list \"(bye . -x-)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the \"d\" in the first litatom \"cd\".
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the \"h\" in the string \"hello\".
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the list \"(bye . -x-)\" in pending delete mode.
Type meta-N.
Does SEdit place a box around the \"-x-\" in this list?
(AR 7907 was written for case where nothing happens.) "))
(do-test "Skip-Next: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-N
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-N
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next two numbers.
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the list \"(bye . -x-)\" as a structure, and extend the selection to include the next list.
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list?
(AR 7907 was written for case where nothing happens.) "))
(do-test "Skip-Next: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: selection of entire structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) gh 4))
Select the entire structure.
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: Pending delete of whole structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assumping SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the entire structure in pending delete mode.
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote?
(AR 7907 was written for case where nothing happens.)"))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Close from the window popup menu."))
) ; end of do-test-group
STOP

View File

@@ -1,268 +0,0 @@
;; Being tested: SEdit
;;
;; Source: {ERIS}<LispCore>DOC>SEDIT>SEDIT.TEDIT
;;
;; Created By: Henry Cate III
;;
;; Creation Date: February 23, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>SEdit>command-mutate.u
;;
;;
;;
(do-test "load the functions for the prompter for interactive tests"
(if (not (fboundp 'do-test-menu-setup))
(load "{ERINYES}<test>TOOLS>DO-TEST-MENU.dfasl"))
T)
(do-test-group "Skip-Next"
:before (progn
(setq window-list (do-test-menu-Setup "Skip-Next")))
:after (progn
(do-test-menu-Cleanup window-list))
(do-test "Skip-Next: no selection/no caret"
(let* ((user-result (do-test-menu-Message window-list 'high
" Testing Skip-Next
If there is no free Xerox Common Lisp exec, bring up a another one and type: \"(cl:in-package 'xcl-test)\"
In the exec type:
(setq tempx '(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4)))
(ed 'tempx)
Select Skip-Next from the pop up menu.
Does SEdit display the message \"Select point from which to start search for blanks.\"?"))
(good-value (equal '(1 4.5 6/7 a cd efg "hello" "BYE" (bye) ("hi" (b) cd 4)) tempx)))
(and user-result (if (eq t user-result) good-value T))
))
(do-test "Skip-Next: no selection/edit caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/edit caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Select DONE from the SEdit popup menu.
Want to place the edit caret right after the 1 without selecting it. Do this by pressing the left mouse button with the mouse cursor just to the right of the 1.
Type meta-N.
Does SEdit say \"No more blanks to fill in.\"?"))
(do-test "Skip-Next: no selection/structure caret"
(do-test-menu-Message window-list 'low
" Testing: no selection/structure caret
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye) (\"hi\" (b) cd 4))
Place the edit caret after the litatom \"bye\" within the list and type: \" .\"
Want to place the structure caret right between \"a\" and \"cd\" without selecting either item. Do this by positioning the mouse cursor between the two items and press the middle button.
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: select a litatom"
(do-test-menu-Message window-list 'low
" Testing: select a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg \"hello\" \"BYE\" (bye . -x-) \"hi\" (b) cd 4))
Place the structure caret after the litatom \"efg\" and type \"'\"
Select the first litatom \"cd\" as a structure, by pressing the left mouse button twice with the cursor over the litatom.
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: select a string"
(do-test-menu-Message window-list 'low
" Testing: select a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the string \"hello\" as a structure, by pressing the left mouse button twice with the cursor over the string.
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list (after the \"BYE . \")? "))
(do-test "Skip-Next: select a number"
(do-test-menu-Message window-list 'low
" Testing: select a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the number \"4.5\" as a structure, by pressing the left mouse button twice with the cursor over the number.
Type meta-N twice.
Does SEdit first place a box around the \"-x-\" with the quote, and then place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: select a list"
(do-test-menu-Message window-list 'low
" Testing: select a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 9.0 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the list \"(bye . -x-)\" as a structure, by pressing the left mouse button three times with the cursor over the \"y\".
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: select part of a litatom"
(do-test-menu-Message window-list 'low
" Testing: select part of a litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the \"d\" in the first litatom \"cd\".
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: select part of a string"
(do-test-menu-Message window-list 'low
" Testing: select part of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the \"h\" in the string \"hello\".
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: select part of a number"
(do-test-menu-Message window-list 'low
" Testing: select part of a number
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the \"7\" in the number \"6/7\".
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: pending delete of a litatom"
(do-test-menu-Message window-list 'low
" Testing: pending delete of litatom
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the litatom \"efg\" in pending delete mode by first pressing the left button of the mouse with the cursor on the \"e\" and then pressing the right button withe the cursor on the \"g\". This should create a box around the litatom \"efg\".
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: pending delete of a string"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a string
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the string \"hello\" in pending delete mode bye clicking on the \"h\", then pressing the right mouse button with the cursor to the right of the string.
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: pending delete of a list"
(do-test-menu-Message window-list 'low
" Testing: pending delete of a list
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the list \"(bye . -x-)\" in pending delete mode.
Type meta-N.
Does SEdit say \"No more blanks to fill in.\"?"))
(do-test "Skip-Next: extended selection of litatoms"
(do-test-menu-Message window-list 'low
" Testing: try extended selection of litatoms
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the litatom \"a\" as a structure, and extend the selection to include the next two litatoms.
Type meta-N
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: extended selection of strings"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Now select the string \"hello\" as a structure, and extend the selection to include the second string.
Type meta-N
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: extended selection of numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next two numbers.
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: extended selection of lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the list \"(bye . -x-)\" as a structure, and extend the selection to include the next list.
Type meta-N.
Does SEdit say \"No more blanks to fill in.\"?"))
(do-test "Skip-Next: extended selection of litatoms and numbers"
(do-test-menu-Message window-list 'low
" Testing: extended selection of litatoms and numbers
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the next five items.
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: extended selection of strings and lists"
(do-test-menu-Message window-list 'low
" Testing: extended selection of strings and lists
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the string \"hello\" as a structure, and extend the selection to include the next three items.
Type meta-N.
Does SEdit place a box around the \"-x-\" in the first list? "))
(do-test "Skip-Next: extended selection of several things"
(do-test-menu-Message window-list 'low
" Testing: extended selection of several things
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the number \"1\" as a structure, and extend the selection to include the rest.
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: selection of entire structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) gh 4))
Select the entire structure.
Type meta-N.
Does SEdit place a box around the \"-x-\" with the quote? "))
(do-test "Skip-Next: Pending delete of whole structure"
(do-test-menu-Message window-list 'low
" Testing: selection of entire structure
Assuming SEdit is editing the variable tempx which currently equals:
(1 4.5 6/7 a cd efg '-x- \"hello\" \"BYE\" (bye . -x-) (\"hi\" (b) cd 4))
Select the entire structure in pending delete mode.
Type meta-N.
Does SEdit say \"No more blanks to fill in.\"?"))
(do-test "Clean up"
(do-test-menu-message window-list 'high
"Close the SEdit window by selecting Done&Close from the window popup menu."))
) ; end of do-test-group
STOP

Some files were not shown because too many files have changed in this diff Show More