lwall@netlabs.com (Larry Wall) (04/18/91)
Submitted-by: Larry Wall <lwall@netlabs.com>
Posting-number: Volume 18, Issue 45
Archive-name: perl/part27
[There are 36 kits for perl version 4.0.]
#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 36 through sh. When all 36 kits have been run, read README.
echo "This is perl 4.0 kit 27 (of 36). If kit 27 is complete, the line"
echo '"'"End of kit 27 (of 36)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir emacs t t/op x2p 2>/dev/null
echo Extracting MANIFEST
sed >MANIFEST <<'!STUFFY!FUNK!' -e 's/X//'
XConfigure Run this first
XCopying The GNU General Public License
XEXTERN.h Included before foreign .h files
XINTERN.h Included before domestic .h files
XMANIFEST This list of files
XMakefile.SH Precursor to Makefile
XPACKINGLIST Which files came from which kits
XREADME The Instructions
XREADME.uport Special instructions for Microports
XREADME.xenix Special instructions for Xenix
XWishlist Some things that may or may not happen
Xarg.h Public declarations for the above
Xarray.c Numerically subscripted arrays
Xarray.h Public declarations for the above
Xcflags.SH A script that emits C compilation flags per file
Xclient A client to test sockets
Xcmd.c Command interpreter
Xcmd.h Public declarations for the above
Xconfig.H Sample config.h
Xconfig_h.SH Produces config.h
Xcons.c Routines to construct cmd nodes of a parse tree
Xconsarg.c Routines to construct arg nodes of a parse tree
Xdoarg.c Scalar expression evaluation
Xdoio.c I/O operations
Xdolist.c Array expression evaluation
Xdump.c Debugging output
Xeg/ADB An adb wrapper to put in your crash dir
Xeg/README Intro to example perl scripts
Xeg/changes A program to list recently changed files
Xeg/down A program to do things to subdirectories
Xeg/dus A program to do du -s on non-mounted dirs
Xeg/findcp A find wrapper that implements a -cp switch
Xeg/findtar A find wrapper that pumps out a tar file
Xeg/g/gcp A program to do a global rcp
Xeg/g/gcp.man Manual page for gcp
Xeg/g/ged A program to do a global edit
Xeg/g/ghosts A sample /etc/ghosts file
Xeg/g/gsh A program to do a global rsh
Xeg/g/gsh.man Manual page for gsh
Xeg/muck A program to find missing make dependencies
Xeg/muck.man Manual page for muck
Xeg/myrup A program to find lightly loaded machines
Xeg/nih Script to insert #! workaround
Xeg/relink A program to change symbolic links
Xeg/rename A program to rename files
Xeg/rmfrom A program to feed doomed filenames to
Xeg/scan/scan_df Scan for filesystem anomalies
Xeg/scan/scan_last Scan for login anomalies
Xeg/scan/scan_messages Scan for console message anomalies
Xeg/scan/scan_passwd Scan for passwd file anomalies
Xeg/scan/scan_ps Scan for process anomalies
Xeg/scan/scan_sudo Scan for sudo anomalies
Xeg/scan/scan_suid Scan for setuid anomalies
Xeg/scan/scanner An anomaly reporter
Xeg/shmkill A program to remove unused shared memory
Xeg/sysvipc/README Intro to Sys V IPC examples
Xeg/sysvipc/ipcmsg Example of SYS V IPC message queues
Xeg/sysvipc/ipcsem Example of Sys V IPC semaphores
Xeg/sysvipc/ipcshm Example of Sys V IPC shared memory
Xeg/travesty A program to print travesties of its input text
Xeg/van/empty A program to empty the trashcan
Xeg/van/unvanish A program to undo what vanish does
Xeg/van/vanexp A program to expire vanished files
Xeg/van/vanish A program to put files in a trashcan
Xeg/who A sample who program
Xemacs/perldb.pl Emacs debugging
Xemacs/perldb.el Emacs debugging
Xemacs/perl-mode.el Emacs major mode for perl
Xemacs/tedstuff Some optional patches
Xeval.c The expression evaluator
Xform.c Format processing
Xform.h Public declarations for the above
Xgettest A little script to test the get* routines
Xh2ph.SH A thing to turn C .h file into perl .ph files
Xh2pl/README How to turn .ph files into .pl files
Xh2pl/cbreak.pl cbreak routines using .ph
Xh2pl/cbreak2.pl cbreak routines using .pl
Xh2pl/eg/sizeof.ph Sample sizeof array initialization
Xh2pl/eg/sys/errno.pl Sample translated errno.pl
Xh2pl/eg/sys/ioctl.pl Sample translated ioctl.pl
Xh2pl/eg/sysexits.pl Sample translated sysexits.pl
Xh2pl/getioctlsizes Program to extract types from ioctl.h
Xh2pl/mksizes Program to make %sizeof array.
Xh2pl/mkvars Program to make .pl from .ph files
Xh2pl/tcbreak cbreak test routine using .ph
Xh2pl/tcbreak2 cbreak test routine using .pl
Xhandy.h Handy definitions
Xhash.c Associative arrays
Xhash.h Public declarations for the above
Xhints/3b2.sh
Xhints/aix_rs.sh
Xhints/aix_rt.sh
Xhints/apollo_C6_7.sh
Xhints/aux.sh
Xhints/dnix.sh
Xhints/dynix.sh
Xhints/fps.sh
Xhints/genix.sh
Xhints/hp9000_300.sh
Xhints/hp9000_400.sh
Xhints/hpux.sh
Xhints/i386.sh
Xhints/mips.sh
Xhints/ncr_tower.sh
Xhints/next.sh
Xhints/osf_1.sh
Xhints/sco_2_3_0.sh
Xhints/sco_2_3_1.sh
Xhints/sco_2_3_2.sh
Xhints/sco_2_3_3.sh
Xhints/sco_3.sh
Xhints/sgi.sh
Xhints/sunos_3_4.sh
Xhints/sunos_3_5.sh
Xhints/sunos_4_0_1.sh
Xhints/sunos_4_0_2.sh
Xhints/ultrix_3.sh
Xhints/ultrix_4.sh
Xhints/uts.sh
Xinstallperl Perl script to do "make install" dirty work
Xioctl.pl Sample ioctl.pl
Xlib/abbrev.pl An abbreviation table builder
Xlib/bigfloat.pl An arbitrary precision floating point package
Xlib/bigint.pl An arbitrary precision integer arithmetic package
Xlib/bigrat.pl An arbitrary precision rational arithmetic package
Xlib/cacheout.pl Manages output filehandles when you need too many
Xlib/complete.pl A command completion subroutine
Xlib/ctime.pl A ctime workalike
Xlib/dumpvar.pl A variable dumper
Xlib/flush.pl Routines to do single flush
Xlib/getopt.pl Perl library supporting option parsing
Xlib/getopts.pl Perl library supporting option parsing
Xlib/importenv.pl Perl routine to get environment into variables
Xlib/look.pl A "look" equivalent
Xlib/perldb.pl Perl debugging routines
Xlib/pwd.pl Routines to keep track of PWD environment variable
Xlib/stat.pl Perl library supporting stat function
Xlib/syslog.pl Perl library supporting syslogging
Xlib/termcap.pl Perl library supporting termcap usage
Xlib/timelocal.pl Perl library supporting inverse of localtime, gmtime
Xlib/validate.pl Perl library supporting wholesale file mode validation
Xmakedepend.SH Precursor to makedepend
Xmakedir.SH Precursor to makedir
Xmalloc.c A version of malloc you might not want
Xmsdos/Changes.dds Expanation of MS-DOS patches by Diomidis Spinellis
Xmsdos/Makefile MS-DOS makefile
Xmsdos/README.msdos Compiling and usage information
Xmsdos/Wishlist.dds My wishlist
Xmsdos/config.h Definitions for msdos
Xmsdos/chdir.c A chdir that can change drives
Xmsdos/dir.h MS-DOS header for directory access functions
Xmsdos/directory.c MS-DOS directory access functions.
Xmsdos/eg/crlf.bat Convert files from unix to MS-DOS line termination
Xmsdos/eg/drives.bat List the system drives and their characteristics
Xmsdos/eg/lf.bat Convert files from MS-DOS to Unix line termination
Xmsdos/glob.c A command equivalent to csh glob
Xmsdos/msdos.c MS-DOS ioctl, sleep, gete?[gu]if, spawn, aspawn
Xmsdos/popen.c My_popen and my_pclose for MS-DOS
Xmsdos/usage.c How to invoke perl under MS-DOS
Xos2/Makefile Makefile for OS/2
Xos2/README.OS2 Notes for OS/2
Xos2/a2p.cs Compiler script for a2p
Xos2/a2p.def Linker defs for a2p
Xos2/alarm.c An implementation of alarm()
Xos2/alarm.h Header file for same
Xos2/config.h Configuration file for OS/2
Xos2/dir.h Directory header
Xos2/director.c Directory routines
Xos2/eg/alarm.pl Example of alarm code
Xos2/eg/os2.pl Sample script for OS/2
Xos2/eg/syscalls.pl Example of syscall on OS/2
Xos2/glob.c Globbing routines
Xos2/makefile Make file
Xos2/mktemp.c Mktemp() using TMP
Xos2/os2.c Unix compatibility functions
Xos2/perl.bad names of protect-only API calls for BIND
Xos2/perl.cs Compiler script for perl
Xos2/perl.def Linker defs for perl
Xos2/perldb.dif Changes to make the debugger work
Xos2/perlglob.bad names of protect-only API calls for BIND
Xos2/perlglob.cs Compiler script for perlglob
Xos2/perlglob.def Linker defs for perlglob
Xos2/perlsh.cmd Poor man's shell for os2
Xos2/popen.c Code for opening pipes
Xos2/s2p.cmd s2p as command file
Xos2/selfrun.bat A self running perl script for DOS
Xos2/selfrun.cmd Example of extproc feature
Xos2/suffix.c Code for creating backup filenames
Xpatchlevel.h The current patch level of perl
Xperl.c main()
Xperl.h Global declarations
Xperl.man The manual page(s)
Xperlsh A poor man's perl shell
Xperly.y Yacc grammar for perl
Xperly.fixer A program to remove yacc stack limitations
Xregcomp.c Regular expression compiler
Xregcomp.h Private declarations for above
Xregexec.c Regular expression evaluator
Xregexp.h Public declarations for the above
Xserver A server to test sockets
Xspat.h Search pattern declarations
Xstab.c Symbol table stuff
Xstab.h Public declarations for the above
Xstr.c String handling package
Xstr.h Public declarations for the above
Xt/README Instructions for regression tests
Xt/TEST The regression tester
Xt/base/cond.t See if conditionals work
Xt/base/if.t See if if works
Xt/base/lex.t See if lexical items work
Xt/base/pat.t See if pattern matching works
Xt/base/term.t See if various terms work
Xt/cmd/elsif.t See if else-if works
Xt/cmd/for.t See if for loops work
Xt/cmd/mod.t See if statement modifiers work
Xt/cmd/subval.t See if subroutine values work
Xt/cmd/switch.t See if switch optimizations work
Xt/cmd/while.t See if while loops work
Xt/comp/cmdopt.t See if command optimization works
Xt/comp/cpp.t See if C preprocessor works
Xt/comp/decl.t See if declarations work
Xt/comp/multiline.t See if multiline strings work
Xt/comp/package.t See if packages work
Xt/comp/script.t See if script invokation works
Xt/comp/term.t See if more terms work
Xt/io/argv.t See if ARGV stuff works
Xt/io/dup.t See if >& works right
Xt/io/fs.t See if directory manipulations work
Xt/io/inplace.t See if inplace editing works
Xt/io/pipe.t See if secure pipes work
Xt/io/print.t See if print commands work
Xt/io/tell.t See if file seeking works
Xt/lib/big.t See if lib/bigint.pl works
Xt/op/append.t See if . works
Xt/op/array.t See if array operations work
Xt/op/auto.t See if autoincrement et all work
Xt/op/chop.t See if chop works
Xt/op/cond.t See if conditional expressions work
Xt/op/dbm.t See if dbm binding works
Xt/op/delete.t See if delete works
Xt/op/do.t See if subroutines work
Xt/op/each.t See if associative iterators work
Xt/op/eval.t See if eval operator works
Xt/op/exec.t See if exec and system work
Xt/op/exp.t See if math functions work
Xt/op/flip.t See if range operator works
Xt/op/fork.t See if fork works
Xt/op/glob.t See if <*> works
Xt/op/goto.t See if goto works
Xt/op/groups.t See if $( works
Xt/op/index.t See if index works
Xt/op/int.t See if int works
Xt/op/join.t See if join works
Xt/op/list.t See if array lists work
Xt/op/local.t See if local works
Xt/op/magic.t See if magic variables work
Xt/op/mkdir.t See if mkdir works
Xt/op/oct.t See if oct and hex work
Xt/op/ord.t See if ord works
Xt/op/pack.t See if pack and unpack work
Xt/op/pat.t See if esoteric patterns work
Xt/op/push.t See if push and pop work
Xt/op/range.t See if .. works
Xt/op/read.t See if read() works
Xt/op/regexp.t See if regular expressions work
Xt/op/repeat.t See if x operator works
Xt/op/s.t See if substitutions work
Xt/op/sleep.t See if sleep works
Xt/op/sort.t See if sort works
Xt/op/split.t See if split works
Xt/op/sprintf.t See if sprintf works
Xt/op/stat.t See if stat works
Xt/op/study.t See if study works
Xt/op/substr.t See if substr works
Xt/op/time.t See if time functions work
Xt/op/undef.t See if undef works
Xt/op/unshift.t See if unshift works
Xt/op/vec.t See if vectors work
Xt/op/write.t See if write works
Xt/op/re_tests Input file for op.regexp
Xtoke.c The tokener
Xusersub.c User supplied (possibly proprietary) subroutines
Xusub/README Instructions for user supplied subroutines
Xusub/Makefile Makefile for curseperl
Xusub/curses.mus Glue routines for BSD curses
Xusub/man2mus A manual page to .mus translator
Xusub/mus A .mus to .c translator
Xusub/pager A sample pager in curseperl
Xusub/usersub.c An initialization file to call curses glue routines
Xutil.c Utility routines
Xutil.h Public declarations for the above
Xx2p/EXTERN.h Same as above
Xx2p/INTERN.h Same as above
Xx2p/Makefile.SH Precursor to Makefile
Xx2p/a2p.h Global declarations
Xx2p/a2p.man Manual page for awk to perl translator
Xx2p/a2p.y A yacc grammer for awk
Xx2p/a2py.c Awk compiler, sort of
Xx2p/find2perl.SH A find to perl translator
Xx2p/handy.h Handy definitions
Xx2p/hash.c Associative arrays again
Xx2p/hash.h Public declarations for the above
Xx2p/s2p.SH Sed to perl translator
Xx2p/s2p.man Manual page for sed to perl translator
Xx2p/str.c String handling package
Xx2p/str.h Public declarations for the above
Xx2p/util.c Utility routines
Xx2p/util.h Public declarations for the above
Xx2p/walk.c Parse tree walker
!STUFFY!FUNK!
echo Extracting emacs/tedstuff
sed >emacs/tedstuff <<'!STUFFY!FUNK!' -e 's/X//'
XArticle 4417 of comp.lang.perl:
XPath: jpl-devvax!elroy.jpl.nasa.gov!decwrl!mcnc!uvaarpa!mmdf
XFrom: ted@evi.com (Ted Stefanik)
XNewsgroups: comp.lang.perl
XSubject: Correction to Perl fatal error marking in GNU Emacs
XMessage-ID: <1991Feb27.065853.15801@uvaarpa.Virginia.EDU>
XDate: 27 Feb 91 06:58:53 GMT
XSender: mmdf@uvaarpa.Virginia.EDU (Uvaarpa Mail System)
XReply-To: ted@evi.com (Ted Stefanik)
XOrganization: The Internet
XLines: 282
X
XReading my own message, it occurred to me that I didn't quite satisfy the
Xrequest of stef@zweig.sun (Stephane Payrard):
X
X| Does anyone has extended perdb/perdb.el to position the
X| point to the first syntax error? It would be cool.
X
XWhat I posted is a way to use the "M-x compile" command to test perl scripts.
X(Needless to say, the script cannot be not interactive; you can't provide input
Xto a *compilation* buffer). When creating new Perl programs, I use "M-x
Xcompile" until I'm sure that they are syntatically correct; if syntax errors
Xoccur, C-x` takes me to each in sequence. After I'm sure the syntax is
Xcorrect, I start worrying about semantics, and switch to "M-x perldb" if
Xnecessary.
X
XTherefore, the stuff I posted works great with "M-x compile", but not at all
Xwith "M-x perldb".
X
XNext, let me update what I posted. I found that perl's die() command doesn't
Xprint the same format error message as perl does when it dies with a syntax
Xerror. If you put the following in your ".emacs" file, it causes C-x` to
Xrecognize both kinds of errors:
X
X(load-library "compile")
X(setq compilation-error-regexp
X "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\|[^ \n]+ \\(at \\)*line [0-9]+\\)")
X
XLast, so I don't look like a total fool, let me propose a way to satisfy
XStephane Payrard's original request (repeated again):
X
X| Does anyone has extended perdb/perdb.el to position the
X| point to the first syntax error? It would be cool.
X
XI'm not satisfied with just the "first syntax error". Perl's parser is better
Xthan most about not getting out of sync; therefore, if it reports multiple
Xerrors, you can usually be assured they are all real errors.
X
XSo... I hacked in the "next-error" function from "compile.el" to form
X"perldb-next-error". You can apply the patches at the end of this message
Xto add "perldb-next-error" to your "perldb.el".
X
XNotes:
X 1) The patch binds "perldb-next-error" to C-x~ (because ~ is the shift
X of ` on my keyboard, and C-x~ is not yet taken in my version of EMACS).
X
X 2) "next-error" is meant to work on a single *compilation* buffer; any new
X "M-x compile" or "M-x grep" command will clear the old *compilation*
X buffer and reset the compilation-error parser to start at the top of the
X *compilation* buffer.
X
X "perldb-next-error", on the other hand, has to deal with multiple
X *perldb-<foo>* buffers, each of which keep growing. "perldb-next-error"
X correctly handles the constantly growing *perldb-<foo>* buffers by
X keeping track of the last reported error in the "current-perldb-buffer".
X
X Sadly however, when you invoke a new "M-x perldb" on a different Perl
X script, "perldb-next-error" will start parsing the new *perldb-<bar>*
X buffer at the top (even if it was previously parsed), and will completely
X lose the marker of the last reported error in *perldb-<foo>*.
X
X 3) "perldb-next-error" still uses "compilation-error-regexp" to find
X fatal errors. Therefore, both the "M-x compile"/C-x` scheme and
X the "M-x perldb"/C-x~ scheme can be used to find fatal errors that
X match the common "compilation-error-regexp". You *will* want to install
X that "compilation-error-regexp" stuff into your .emacs file.
X
X 4) The patch was developed and tested with GNU Emacs 18.55.
X
X 5) Since the patch was ripped off from compile.el, the code is (of
X course) subject to the GNU copyleft.
X
X*** perldb.el.orig Wed Feb 27 00:44:27 1991
X--- perldb.el Wed Feb 27 00:44:30 1991
X***************
X*** 199,205 ****
X
X (defun perldb-set-buffer ()
X (cond ((eq major-mode 'perldb-mode)
X! (setq current-perldb-buffer (current-buffer)))))
X
X ;; This function is responsible for inserting output from Perl
X ;; into the buffer.
X--- 199,211 ----
X
X (defun perldb-set-buffer ()
X (cond ((eq major-mode 'perldb-mode)
X! (cond ((not (eq current-perldb-buffer (current-buffer)))
X! (perldb-forget-errors)
X! (setq perldb-parsing-end 2)) ;; 2 to defeat grep defeater
X! (t
X! (if (> perldb-parsing-end (point-max))
X! (setq perldb-parsing-end (max (point-max) 2)))))
X! (setq current-perldb-buffer (current-buffer)))))
X
X ;; This function is responsible for inserting output from Perl
X ;; into the buffer.
X***************
X*** 291,297 ****
X ;; process-buffer is current-buffer
X (unwind-protect
X (progn
X! ;; Write something in *compilation* and hack its mode line,
X (set-buffer (process-buffer proc))
X ;; Force mode line redisplay soon
X (set-buffer-modified-p (buffer-modified-p))
X--- 297,303 ----
X ;; process-buffer is current-buffer
X (unwind-protect
X (progn
X! ;; Write something in *perldb-<foo>* and hack its mode line,
X (set-buffer (process-buffer proc))
X ;; Force mode line redisplay soon
X (set-buffer-modified-p (buffer-modified-p))
X***************
X*** 421,423 ****
X--- 427,593 ----
X (switch-to-buffer-other-window current-perldb-buffer)
X (goto-char (dot-max))
X (insert-string comm)))
X+
X+ (defvar perldb-error-list nil
X+ "List of error message descriptors for visiting erring functions.
X+ Each error descriptor is a list of length two.
X+ Its car is a marker pointing to an error message.
X+ Its cadr is a marker pointing to the text of the line the message is about,
X+ or nil if that is not interesting.
X+ The value may be t instead of a list;
X+ this means that the buffer of error messages should be reparsed
X+ the next time the list of errors is wanted.")
X+
X+ (defvar perldb-parsing-end nil
X+ "Position of end of buffer when last error messages parsed.")
X+
X+ (defvar perldb-error-message "No more fatal Perl errors"
X+ "Message to print when no more matches for compilation-error-regexp are found")
X+
X+ (defun perldb-next-error (&optional argp)
X+ "Visit next perldb error message and corresponding source code.
X+ This operates on the output from the \\[perldb] command.
X+ If all preparsed error messages have been processed,
X+ the error message buffer is checked for new ones.
X+ A non-nil argument (prefix arg, if interactive)
X+ means reparse the error message buffer and start at the first error."
X+ (interactive "P")
X+ (if (or (eq perldb-error-list t)
X+ argp)
X+ (progn (perldb-forget-errors)
X+ (setq perldb-parsing-end 2))) ;; 2 to defeat grep defeater
X+ (if perldb-error-list
X+ nil
X+ (save-excursion
X+ (switch-to-buffer current-perldb-buffer)
X+ (perldb-parse-errors)))
X+ (let ((next-error (car perldb-error-list)))
X+ (if (null next-error)
X+ (error (concat perldb-error-message
X+ (if (and (get-buffer-process current-perldb-buffer)
X+ (eq (process-status
X+ (get-buffer-process
X+ current-perldb-buffer))
X+ 'run))
X+ " yet" ""))))
X+ (setq perldb-error-list (cdr perldb-error-list))
X+ (if (null (car (cdr next-error)))
X+ nil
X+ (switch-to-buffer (marker-buffer (car (cdr next-error))))
X+ (goto-char (car (cdr next-error)))
X+ (set-marker (car (cdr next-error)) nil))
X+ (let* ((pop-up-windows t)
X+ (w (display-buffer (marker-buffer (car next-error)))))
X+ (set-window-point w (car next-error))
X+ (set-window-start w (car next-error)))
X+ (set-marker (car next-error) nil)))
X+
X+ ;; Set perldb-error-list to nil, and
X+ ;; unchain the markers that point to the error messages and their text,
X+ ;; so that they no longer slow down gap motion.
X+ ;; This would happen anyway at the next garbage collection,
X+ ;; but it is better to do it right away.
X+ (defun perldb-forget-errors ()
X+ (if (eq perldb-error-list t)
X+ (setq perldb-error-list nil))
X+ (while perldb-error-list
X+ (let ((next-error (car perldb-error-list)))
X+ (set-marker (car next-error) nil)
X+ (if (car (cdr next-error))
X+ (set-marker (car (cdr next-error)) nil)))
X+ (setq perldb-error-list (cdr perldb-error-list))))
X+
X+ (defun perldb-parse-errors ()
X+ "Parse the current buffer as error messages.
X+ This makes a list of error descriptors, perldb-error-list.
X+ For each source-file, line-number pair in the buffer,
X+ the source file is read in, and the text location is saved in perldb-error-list.
X+ The function next-error, assigned to \\[next-error], takes the next error off the list
X+ and visits its location."
X+ (setq perldb-error-list nil)
X+ (message "Parsing error messages...")
X+ (let (text-buffer
X+ last-filename last-linenum)
X+ ;; Don't reparse messages already seen at last parse.
X+ (goto-char perldb-parsing-end)
X+ ;; Don't parse the first two lines as error messages.
X+ ;; This matters for grep.
X+ (if (bobp)
X+ (forward-line 2))
X+ (while (re-search-forward compilation-error-regexp nil t)
X+ (let (linenum filename
X+ error-marker text-marker)
X+ ;; Extract file name and line number from error message.
X+ (save-restriction
X+ (narrow-to-region (match-beginning 0) (match-end 0))
X+ (goto-char (point-max))
X+ (skip-chars-backward "[0-9]")
X+ ;; If it's a lint message, use the last file(linenum) on the line.
X+ ;; Normally we use the first on the line.
X+ (if (= (preceding-char) ?\()
X+ (progn
X+ (narrow-to-region (point-min) (1+ (buffer-size)))
X+ (end-of-line)
X+ (re-search-backward compilation-error-regexp)
X+ (skip-chars-backward "^ \t\n")
X+ (narrow-to-region (point) (match-end 0))
X+ (goto-char (point-max))
X+ (skip-chars-backward "[0-9]")))
X+ ;; Are we looking at a "filename-first" or "line-number-first" form?
X+ (if (looking-at "[0-9]")
X+ (progn
X+ (setq linenum (read (current-buffer)))
X+ (goto-char (point-min)))
X+ ;; Line number at start, file name at end.
X+ (progn
X+ (goto-char (point-min))
X+ (setq linenum (read (current-buffer)))
X+ (goto-char (point-max))
X+ (skip-chars-backward "^ \t\n")))
X+ (setq filename (perldb-grab-filename)))
X+ ;; Locate the erring file and line.
X+ (if (and (equal filename last-filename)
X+ (= linenum last-linenum))
X+ nil
X+ (beginning-of-line 1)
X+ (setq error-marker (point-marker))
X+ ;; text-buffer gets the buffer containing this error's file.
X+ (if (not (equal filename last-filename))
X+ (setq text-buffer
X+ (and (file-exists-p (setq last-filename filename))
X+ (find-file-noselect filename))
X+ last-linenum 0))
X+ (if text-buffer
X+ ;; Go to that buffer and find the erring line.
X+ (save-excursion
X+ (set-buffer text-buffer)
X+ (if (zerop last-linenum)
X+ (progn
X+ (goto-char 1)
X+ (setq last-linenum 1)))
X+ (forward-line (- linenum last-linenum))
X+ (setq last-linenum linenum)
X+ (setq text-marker (point-marker))
X+ (setq perldb-error-list
X+ (cons (list error-marker text-marker)
X+ perldb-error-list)))))
X+ (forward-line 1)))
X+ (setq perldb-parsing-end (point-max)))
X+ (message "Parsing error messages...done")
X+ (setq perldb-error-list (nreverse perldb-error-list)))
X+
X+ (defun perldb-grab-filename ()
X+ "Return a string which is a filename, starting at point.
X+ Ignore quotes and parentheses around it, as well as trailing colons."
X+ (if (eq (following-char) ?\")
X+ (save-restriction
X+ (narrow-to-region (point)
X+ (progn (forward-sexp 1) (point)))
X+ (goto-char (point-min))
X+ (read (current-buffer)))
X+ (buffer-substring (point)
X+ (progn
X+ (skip-chars-forward "^ :,\n\t(")
X+ (point)))))
X+
X+ (define-key ctl-x-map "~" 'perldb-next-error)
X
X
!STUFFY!FUNK!
echo Extracting x2p/s2p.SH
sed >x2p/s2p.SH <<'!STUFFY!FUNK!' -e 's/X//'
X: This forces SH files to create target in same directory as SH file.
X: This is so that make depend always knows where to find SH derivatives.
Xcase "$0" in
X*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
Xesac
Xcase $CONFIG in
X'')
X if test ! -f config.sh; then
X ln ../config.sh . || \
X ln -s ../config.sh . || \
X ln ../../config.sh . || \
X ln ../../../config.sh . || \
X (echo "Can't find config.sh."; exit 1)
X fi 2>/dev/null
X . ./config.sh
X ;;
Xesac
Xecho "Extracting s2p (with variable substitutions)"
X: This section of the file will have variable substitutions done on it.
X: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
X: Protect any dollar signs and backticks that you do not want interpreted
X: by putting a backslash in front. You may delete these comments.
X$spitshell >s2p <<!GROK!THIS!
X#!$bin/perl
X
X\$bin = '$bin';
X!GROK!THIS!
X
X: In the following dollars and backticks do not need the extra backslash.
X$spitshell >>s2p <<'!NO!SUBS!'
X
X# $Header: s2p.SH,v 4.0 91/03/20 01:57:59 lwall Locked $
X#
X# $Log: s2p.SH,v $
X# Revision 4.0 91/03/20 01:57:59 lwall
X# 4.0 baseline.
X#
X#
X
X$indent = 4;
X$shiftwidth = 4;
X$l = '{'; $r = '}';
X
Xwhile ($ARGV[0] =~ /^-/) {
X $_ = shift;
X last if /^--/;
X if (/^-D/) {
X $debug++;
X open(BODY,'>-');
X next;
X }
X if (/^-n/) {
X $assumen++;
X next;
X }
X if (/^-p/) {
X $assumep++;
X next;
X }
X die "I don't recognize this switch: $_\n";
X}
X
Xunless ($debug) {
X open(BODY,">/tmp/sperl$$") ||
X &Die("Can't open temp file: $!\n");
X}
X
Xif (!$assumen && !$assumep) {
X print BODY <<'EOT';
Xwhile ($ARGV[0] =~ /^-/) {
X $_ = shift;
X last if /^--/;
X if (/^-n/) {
X $nflag++;
X next;
X }
X die "I don't recognize this switch: $_\\n";
X}
X
XEOT
X}
X
Xprint BODY <<'EOT';
X
X#ifdef PRINTIT
X#ifdef ASSUMEP
X$printit++;
X#else
X$printit++ unless $nflag;
X#endif
X#endif
XLINE: while (<>) {
XEOT
X
XLINE: while (<>) {
X
X # Wipe out surrounding whitespace.
X
X s/[ \t]*(.*)\n$/$1/;
X
X # Perhaps it's a label/comment.
X
X if (/^:/) {
X s/^:[ \t]*//;
X $label = &make_label($_);
X if ($. == 1) {
X $toplabel = $label;
X }
X $_ = "$label:";
X if ($lastlinewaslabel++) {
X $indent += 4;
X print BODY &tab, ";\n";
X $indent -= 4;
X }
X if ($indent >= 2) {
X $indent -= 2;
X $indmod = 2;
X }
X next;
X } else {
X $lastlinewaslabel = '';
X }
X
X # Look for one or two address clauses
X
X $addr1 = '';
X $addr2 = '';
X if (s/^([0-9]+)//) {
X $addr1 = "$1";
X }
X elsif (s/^\$//) {
X $addr1 = 'eof()';
X }
X elsif (s|^/||) {
X $addr1 = &fetchpat('/');
X }
X if (s/^,//) {
X if (s/^([0-9]+)//) {
X $addr2 = "$1";
X } elsif (s/^\$//) {
X $addr2 = "eof()";
X } elsif (s|^/||) {
X $addr2 = &fetchpat('/');
X } else {
X &Die("Invalid second address at line $.\n");
X }
X $addr1 .= " .. $addr2";
X }
X
X # Now we check for metacommands {, }, and ! and worry
X # about indentation.
X
X s/^[ \t]+//;
X # a { to keep vi happy
X if ($_ eq '}') {
X $indent -= 4;
X next;
X }
X if (s/^!//) {
X $if = 'unless';
X $else = "$r else $l\n";
X } else {
X $if = 'if';
X $else = '';
X }
X if (s/^{//) { # a } to keep vi happy
X $indmod = 4;
X $redo = $_;
X $_ = '';
X $rmaybe = '';
X } else {
X $rmaybe = "\n$r";
X if ($addr2 || $addr1) {
X $space = ' ' x $shiftwidth;
X } else {
X $space = '';
X }
X $_ = &transmogrify();
X }
X
X # See if we can optimize to modifier form.
X
X if ($addr1) {
X if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
X $_ !~ / if / && $_ !~ / unless /) {
X s/;$/ $if $addr1;/;
X $_ = substr($_,$shiftwidth,1000);
X } else {
X $_ = "$if ($addr1) $l\n$change$_$rmaybe";
X }
X $change = '';
X next LINE;
X }
X} continue {
X @lines = split(/\n/,$_);
X for (@lines) {
X unless (s/^ *<<--//) {
X print BODY &tab;
X }
X print BODY $_, "\n";
X }
X $indent += $indmod;
X $indmod = 0;
X if ($redo) {
X $_ = $redo;
X $redo = '';
X redo LINE;
X }
X}
Xif ($lastlinewaslabel++) {
X $indent += 4;
X print BODY &tab, ";\n";
X $indent -= 4;
X}
X
Xprint BODY "}\n";
Xif ($appendseen || $tseen || !$assumen) {
X $printit++ if $dseen || (!$assumen && !$assumep);
X print BODY <<'EOT';
X
Xcontinue {
X#ifdef PRINTIT
X#ifdef DSEEN
X#ifdef ASSUMEP
X print if $printit++;
X#else
X if ($printit)
X { print; }
X else
X { $printit++ unless $nflag; }
X#endif
X#else
X print if $printit;
X#endif
X#else
X print;
X#endif
X#ifdef TSEEN
X $tflag = '';
X#endif
X#ifdef APPENDSEEN
X if ($atext) { print $atext; $atext = ''; }
X#endif
X}
XEOT
X}
X
Xclose BODY;
X
Xunless ($debug) {
X open(HEAD,">/tmp/sperl2$$.c")
X || &Die("Can't open temp file 2: $!\n");
X print HEAD "#define PRINTIT\n" if ($printit);
X print HEAD "#define APPENDSEEN\n" if ($appendseen);
X print HEAD "#define TSEEN\n" if ($tseen);
X print HEAD "#define DSEEN\n" if ($dseen);
X print HEAD "#define ASSUMEN\n" if ($assumen);
X print HEAD "#define ASSUMEP\n" if ($assumep);
X if ($opens) {print HEAD "$opens\n";}
X open(BODY,"/tmp/sperl$$")
X || &Die("Can't reopen temp file: $!\n");
X while (<BODY>) {
X print HEAD $_;
X }
X close HEAD;
X
X print <<"EOT";
X#!$bin/perl
Xeval 'exec $bin/perl -S \$0 \$*'
X if \$running_under_some_shell;
X
XEOT
X open(BODY,"cc -E /tmp/sperl2$$.c |") ||
X &Die("Can't reopen temp file: $!\n");
X while (<BODY>) {
X /^# [0-9]/ && next;
X /^[ \t]*$/ && next;
X s/^<><>//;
X print;
X }
X}
X
X&Cleanup;
Xexit;
X
Xsub Cleanup {
X chdir "/tmp";
X unlink "sperl$$", "sperl2$$", "sperl2$$.c";
X}
Xsub Die {
X &Cleanup;
X die $_[0];
X}
Xsub tab {
X "\t" x ($indent / 8) . ' ' x ($indent % 8);
X}
Xsub make_filehandle {
X local($_) = $_[0];
X local($fname) = $_;
X s/[^a-zA-Z]/_/g;
X s/^_*//;
X substr($_,0,1) =~ y/a-z/A-Z/ if /^[a-z]/;
X if (!$seen{$_}) {
X $opens .= <<"EOT";
Xopen($_,'>$fname') || die "Can't create $fname";
XEOT
X }
X $seen{$_} = $_;
X}
X
Xsub make_label {
X local($label) = @_;
X $label =~ s/[^a-zA-Z0-9]/_/g;
X if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
X $label = substr($label,0,8);
X
X # Could be a reserved word, so capitalize it.
X substr($label,0,1) =~ y/a-z/A-Z/
X if $label =~ /^[a-z]/;
X
X $label;
X}
X
Xsub transmogrify {
X { # case
X if (/^d/) {
X $dseen++;
X chop($_ = <<'EOT');
X<<--#ifdef PRINTIT
X$printit = '';
X<<--#endif
Xnext LINE;
XEOT
X next;
X }
X
X if (/^n/) {
X chop($_ = <<'EOT');
X<<--#ifdef PRINTIT
X<<--#ifdef DSEEN
X<<--#ifdef ASSUMEP
Xprint if $printit++;
X<<--#else
Xif ($printit)
X { print; }
Xelse
X { $printit++ unless $nflag; }
X<<--#endif
X<<--#else
Xprint if $printit;
X<<--#endif
X<<--#else
Xprint;
X<<--#endif
X<<--#ifdef APPENDSEEN
Xif ($atext) {print $atext; $atext = '';}
X<<--#endif
X$_ = <>;
X<<--#ifdef TSEEN
X$tflag = '';
X<<--#endif
XEOT
X next;
X }
X
X if (/^a/) {
X $appendseen++;
X $command = $space . '$atext .=' . "\n<<--'";
X $lastline = 0;
X while (<>) {
X s/^[ \t]*//;
X s/^[\\]//;
X unless (s|\\$||) { $lastline = 1;}
X s/'/\\'/g;
X s/^([ \t]*\n)/<><>$1/;
X $command .= $_;
X $command .= '<<--';
X last if $lastline;
X }
X $_ = $command . "';";
X last;
X }
X
X if (/^[ic]/) {
X if (/^c/) { $change = 1; }
X $addr1 = '$iter = (' . $addr1 . ')';
X $command = $space . 'if ($iter == 1) { print'
X . "\n<<--'";
X $lastline = 0;
X while (<>) {
X s/^[ \t]*//;
X s/^[\\]//;
X unless (s/\\$//) { $lastline = 1;}
X s/'/\\'/g;
X s/^([ \t]*\n)/<><>$1/;
X $command .= $_;
X $command .= '<<--';
X last if $lastline;
X }
X $_ = $command . "';}";
X if ($change) {
X $dseen++;
X $change = "$_\n";
X chop($_ = <<"EOT");
X<<--#ifdef PRINTIT
X$space\$printit = '';
X<<--#endif
X${space}next LINE;
XEOT
X }
X last;
X }
X
X if (/^s/) {
X $delim = substr($_,1,1);
X $len = length($_);
X $repl = $end = 0;
X $inbracket = 0;
X for ($i = 2; $i < $len; $i++) {
X $c = substr($_,$i,1);
X if ($c eq $delim) {
X if ($inbracket) {
X substr($_, $i, 0) = '\\';
X $i++;
X $len++;
X }
X else {
X if ($repl) {
X $end = $i;
X last;
X } else {
X $repl = $i;
X }
X }
X }
X elsif ($c eq '\\') {
X $i++;
X if ($i >= $len) {
X $_ .= 'n';
X $_ .= <>;
X $len = length($_);
X $_ = substr($_,0,--$len);
X }
X elsif (substr($_,$i,1) =~ /^[n]$/) {
X ;
X }
X elsif (!$repl &&
X substr($_,$i,1) =~ /^[(){}\w]$/) {
X $i--;
X $len--;
X substr($_, $i, 1) = '';
X }
X elsif (!$repl &&
X substr($_,$i,1) =~ /^[<>]$/) {
X substr($_,$i,1) = 'b';
X }
X }
X elsif ($c eq '[' && !$repl) {
X $i++ if substr($_,$i,1) eq '^';
X $i++ if substr($_,$i,1) eq ']';
X $inbracket = 1;
X }
X elsif ($c eq ']') {
X $inbracket = 0;
X }
X elsif (!$repl && index("()+",$c) >= 0) {
X substr($_, $i, 0) = '\\';
X $i++;
X $len++;
X }
X }
X &Die("Malformed substitution at line $.\n")
X unless $end;
X $pat = substr($_, 0, $repl + 1);
X $repl = substr($_, $repl+1, $end-$repl-1);
X $end = substr($_, $end + 1, 1000);
X $dol = '$';
X $repl =~ s/\$/\\$/;
X $repl =~ s'&'$&'g;
X $repl =~ s/[\\]([0-9])/$dol$1/g;
X $subst = "$pat$repl$delim";
X $cmd = '';
X while ($end) {
X if ($end =~ s/^g//) {
X $subst .= 'g';
X next;
X }
X if ($end =~ s/^p//) {
X $cmd .= ' && (print)';
X next;
X }
X if ($end =~ s/^w[ \t]*//) {
X $fh = &make_filehandle($end);
X $cmd .= " && (print $fh \$_)";
X $end = '';
X next;
X }
X &Die("Unrecognized substitution command".
X "($end) at line $.\n");
X }
X chop ($_ = <<"EOT");
X<<--#ifdef TSEEN
X$subst && \$tflag++$cmd;
X<<--#else
X$subst$cmd;
X<<--#endif
XEOT
X next;
X }
X
X if (/^p/) {
X $_ = 'print;';
X next;
X }
X
X if (/^w/) {
X s/^w[ \t]*//;
X $fh = &make_filehandle($_);
X $_ = "print $fh \$_;";
X next;
X }
X
X if (/^r/) {
X $appendseen++;
X s/^r[ \t]*//;
X $file = $_;
X $_ = "\$atext .= `cat $file 2>/dev/null`;";
X next;
X }
X
X if (/^P/) {
X $_ = 'print $1 if /(^.*\n)/;';
X next;
X }
X
X if (/^D/) {
X chop($_ = <<'EOT');
Xs/^.*\n//;
Xredo LINE if $_;
Xnext LINE;
XEOT
X next;
X }
X
X if (/^N/) {
X chop($_ = <<'EOT');
X$_ .= <>;
X<<--#ifdef TSEEN
X$tflag = '';
X<<--#endif
XEOT
X next;
X }
X
X if (/^h/) {
X $_ = '$hold = $_;';
X next;
X }
X
X if (/^H/) {
X $_ = '$hold .= $_ ? $_ : "\n";';
X next;
X }
X
X if (/^g/) {
X $_ = '$_ = $hold;';
X next;
X }
X
X if (/^G/) {
X $_ = '$_ .= $hold ? $hold : "\n";';
X next;
X }
X
X if (/^x/) {
X $_ = '($_, $hold) = ($hold, $_);';
X next;
X }
X
X if (/^b$/) {
X $_ = 'next LINE;';
X next;
X }
X
X if (/^b/) {
X s/^b[ \t]*//;
X $lab = &make_label($_);
X if ($lab eq $toplabel) {
X $_ = 'redo LINE;';
X } else {
X $_ = "goto $lab;";
X }
X next;
X }
X
X if (/^t$/) {
X $_ = 'next LINE if $tflag;';
X $tseen++;
X next;
X }
X
X if (/^t/) {
X s/^t[ \t]*//;
X $lab = &make_label($_);
X $_ = q/if ($tflag) {$tflag = ''; /;
X if ($lab eq $toplabel) {
X $_ .= 'redo LINE;}';
X } else {
X $_ .= "goto $lab;}";
X }
X $tseen++;
X next;
X }
X
X if (/^=/) {
X $_ = 'print "$.\n";';
X next;
X }
X
X if (/^q/) {
X chop($_ = <<'EOT');
Xclose(ARGV);
X@ARGV = ();
Xnext LINE;
XEOT
X next;
X }
X } continue {
X if ($space) {
X s/^/$space/;
X s/(\n)(.)/$1$space$2/g;
X }
X last;
X }
X $_;
X}
X
Xsub fetchpat {
X local($outer) = @_;
X local($addr) = $outer;
X local($inbracket);
X local($prefix,$delim,$ch);
X
X # Process pattern one potential delimiter at a time.
X
X DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
X $prefix = $1;
X $delim = $2;
X if ($delim eq '\\') {
X s/(.)//;
X $ch = $1;
X $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
X $ch = 'b' if $ch =~ /^[<>]$/;
X $delim .= $ch;
X }
X elsif ($delim eq '[') {
X $inbracket = 1;
X s/^\^// && ($delim .= '^');
X s/^]// && ($delim .= ']');
X }
X elsif ($delim eq ']') {
X $inbracket = 0;
X }
X elsif ($inbracket || $delim ne $outer) {
X $delim = '\\' . $delim;
X }
X $addr .= $prefix;
X $addr .= $delim;
X if ($delim eq $outer && !$inbracket) {
X last DELIM;
X }
X }
X $addr;
X}
X
X!NO!SUBS!
Xchmod 755 s2p
X$eunicefix s2p
!STUFFY!FUNK!
echo Extracting x2p/a2p.y
sed >x2p/a2p.y <<'!STUFFY!FUNK!' -e 's/X//'
X%{
X/* $Header: a2p.y,v 4.0 91/03/20 01:57:21 lwall Locked $
X *
X * Copyright (c) 1989, Larry Wall
X *
X * You may distribute under the terms of the GNU General Public License
X * as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log: a2p.y,v $
X * Revision 4.0 91/03/20 01:57:21 lwall
X * 4.0 baseline.
X *
X */
X
X#include "INTERN.h"
X#include "a2p.h"
X
Xint root;
Xint begins = Nullop;
Xint ends = Nullop;
X
X%}
X%token BEGIN END
X%token REGEX
X%token SEMINEW NEWLINE COMMENT
X%token FUN1 FUNN GRGR
X%token PRINT PRINTF SPRINTF SPLIT
X%token IF ELSE WHILE FOR IN
X%token EXIT NEXT BREAK CONTINUE RET
X%token GETLINE DO SUB GSUB MATCH
X%token FUNCTION USERFUN DELETE
X
X%right ASGNOP
X%right '?' ':'
X%left OROR
X%left ANDAND
X%left IN
X%left NUMBER VAR SUBSTR INDEX
X%left MATCHOP
X%left RELOP '<' '>'
X%left OR
X%left STRING
X%left '+' '-'
X%left '*' '/' '%'
X%right UMINUS
X%left NOT
X%right '^'
X%left INCR DECR
X%left FIELD VFIELD
X
X%%
X
Xprogram : junk hunks
X { root = oper4(OPROG,$1,begins,$2,ends); }
X ;
X
Xbegin : BEGIN '{' maybe states '}' junk
X { begins = oper4(OJUNK,begins,$3,$4,$6); in_begin = FALSE;
X $$ = Nullop; }
X ;
X
Xend : END '{' maybe states '}'
X { ends = oper3(OJUNK,ends,$3,$4); $$ = Nullop; }
X | end NEWLINE
X { $$ = $1; }
X ;
X
Xhunks : hunks hunk junk
X { $$ = oper3(OHUNKS,$1,$2,$3); }
X | /* NULL */
X { $$ = Nullop; }
X ;
X
Xhunk : patpat
X { $$ = oper1(OHUNK,$1); need_entire = TRUE; }
X | patpat '{' maybe states '}'
X { $$ = oper2(OHUNK,$1,oper2(OJUNK,$3,$4)); }
X | FUNCTION USERFUN '(' arg_list ')' maybe '{' maybe states '}'
X { fixfargs($2,$4,0); $$ = oper5(OUSERDEF,$2,$4,$6,$8,$9); }
X | '{' maybe states '}'
X { $$ = oper2(OHUNK,Nullop,oper2(OJUNK,$2,$3)); }
X | begin
X | end
X ;
X
Xarg_list: expr_list
X { $$ = rememberargs($$); }
X ;
X
Xpatpat : cond
X { $$ = oper1(OPAT,$1); }
X | cond ',' cond
X { $$ = oper2(ORANGE,$1,$3); }
X ;
X
Xcond : expr
X | match
X | rel
X | compound_cond
X ;
X
Xcompound_cond
X : '(' compound_cond ')'
X { $$ = oper1(OCPAREN,$2); }
X | cond ANDAND maybe cond
X { $$ = oper3(OCANDAND,$1,$3,$4); }
X | cond OROR maybe cond
X { $$ = oper3(OCOROR,$1,$3,$4); }
X | NOT cond
X { $$ = oper1(OCNOT,$2); }
X ;
X
Xrel : expr RELOP expr
X { $$ = oper3(ORELOP,$2,$1,$3); }
X | expr '>' expr
X { $$ = oper3(ORELOP,string(">",1),$1,$3); }
X | expr '<' expr
X { $$ = oper3(ORELOP,string("<",1),$1,$3); }
X | '(' rel ')'
X { $$ = oper1(ORPAREN,$2); }
X ;
X
Xmatch : expr MATCHOP expr
X { $$ = oper3(OMATCHOP,$2,$1,$3); }
X | expr MATCHOP REGEX
X { $$ = oper3(OMATCHOP,$2,$1,oper1(OREGEX,$3)); }
X | REGEX %prec MATCHOP
X { $$ = oper1(OREGEX,$1); }
X | '(' match ')'
X { $$ = oper1(OMPAREN,$2); }
X ;
X
Xexpr : term
X { $$ = $1; }
X | expr term
X { $$ = oper2(OCONCAT,$1,$2); }
X | variable ASGNOP cond
X { $$ = oper3(OASSIGN,$2,$1,$3);
X if ((ops[$1].ival & 255) == OFLD)
X lval_field = TRUE;
X if ((ops[$1].ival & 255) == OVFLD)
X lval_field = TRUE;
X }
X ;
X
Xterm : variable
X { $$ = $1; }
X | NUMBER
X { $$ = oper1(ONUM,$1); }
X | STRING
X { $$ = oper1(OSTR,$1); }
X | term '+' term
X { $$ = oper2(OADD,$1,$3); }
X | term '-' term
X { $$ = oper2(OSUBTRACT,$1,$3); }
X | term '*' term
X { $$ = oper2(OMULT,$1,$3); }
X | term '/' term
X { $$ = oper2(ODIV,$1,$3); }
X | term '%' term
X { $$ = oper2(OMOD,$1,$3); }
X | term '^' term
X { $$ = oper2(OPOW,$1,$3); }
X | term IN VAR
X { $$ = oper2(ODEFINED,aryrefarg($3),$1); }
X | term '?' term ':' term
X { $$ = oper3(OCOND,$1,$3,$5); }
X | variable INCR
X { $$ = oper1(OPOSTINCR,$1); }
X | variable DECR
X { $$ = oper1(OPOSTDECR,$1); }
X | INCR variable
X { $$ = oper1(OPREINCR,$2); }
X | DECR variable
X { $$ = oper1(OPREDECR,$2); }
X | '-' term %prec UMINUS
X { $$ = oper1(OUMINUS,$2); }
X | '+' term %prec UMINUS
X { $$ = oper1(OUPLUS,$2); }
X | '(' cond ')'
X { $$ = oper1(OPAREN,$2); }
X | GETLINE
X { $$ = oper0(OGETLINE); }
X | GETLINE VAR
X { $$ = oper1(OGETLINE,$2); }
X | GETLINE '<' expr
X { $$ = oper3(OGETLINE,Nullop,string("<",1),$3);
X if (ops[$3].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
X | GETLINE VAR '<' expr
X { $$ = oper3(OGETLINE,$2,string("<",1),$4);
X if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
X | term 'p' GETLINE
X { $$ = oper3(OGETLINE,Nullop,string("|",1),$1);
X if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
X | term 'p' GETLINE VAR
X { $$ = oper3(OGETLINE,$4,string("|",1),$1);
X if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
X | FUN1
X { $$ = oper0($1); need_entire = do_chop = TRUE; }
X | FUN1 '(' ')'
X { $$ = oper1($1,Nullop); need_entire = do_chop = TRUE; }
X | FUN1 '(' expr ')'
X { $$ = oper1($1,$3); }
X | FUNN '(' expr_list ')'
X { $$ = oper1($1,$3); }
X | USERFUN '(' expr_list ')'
X { $$ = oper2(OUSERFUN,$1,$3); }
X | SPRINTF expr_list
X { $$ = oper1(OSPRINTF,$2); }
X | SUBSTR '(' expr ',' expr ',' expr ')'
X { $$ = oper3(OSUBSTR,$3,$5,$7); }
X | SUBSTR '(' expr ',' expr ')'
X { $$ = oper2(OSUBSTR,$3,$5); }
X | SPLIT '(' expr ',' VAR ',' expr ')'
X { $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),$7); }
X | SPLIT '(' expr ',' VAR ',' REGEX ')'
X { $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),oper1(OREGEX,$7));}
X | SPLIT '(' expr ',' VAR ')'
X { $$ = oper2(OSPLIT,$3,aryrefarg(numary($5))); }
X | INDEX '(' expr ',' expr ')'
X { $$ = oper2(OINDEX,$3,$5); }
X | MATCH '(' expr ',' REGEX ')'
X { $$ = oper2(OMATCH,$3,oper1(OREGEX,$5)); }
X | MATCH '(' expr ',' expr ')'
X { $$ = oper2(OMATCH,$3,$5); }
X | SUB '(' expr ',' expr ')'
X { $$ = oper2(OSUB,$3,$5); }
X | SUB '(' REGEX ',' expr ')'
X { $$ = oper2(OSUB,oper1(OREGEX,$3),$5); }
X | GSUB '(' expr ',' expr ')'
X { $$ = oper2(OGSUB,$3,$5); }
X | GSUB '(' REGEX ',' expr ')'
X { $$ = oper2(OGSUB,oper1(OREGEX,$3),$5); }
X | SUB '(' expr ',' expr ',' expr ')'
X { $$ = oper3(OSUB,$3,$5,$7); }
X | SUB '(' REGEX ',' expr ',' expr ')'
X { $$ = oper3(OSUB,oper1(OREGEX,$3),$5,$7); }
X | GSUB '(' expr ',' expr ',' expr ')'
X { $$ = oper3(OGSUB,$3,$5,$7); }
X | GSUB '(' REGEX ',' expr ',' expr ')'
X { $$ = oper3(OGSUB,oper1(OREGEX,$3),$5,$7); }
X ;
X
Xvariable: VAR
X { $$ = oper1(OVAR,$1); }
X | VAR '[' expr_list ']'
X { $$ = oper2(OVAR,aryrefarg($1),$3); }
X | FIELD
X { $$ = oper1(OFLD,$1); }
X | VFIELD term
X { $$ = oper1(OVFLD,$2); }
X ;
X
Xexpr_list
X : expr
X | clist
X | /* NULL */
X { $$ = Nullop; }
X ;
X
Xclist : expr ',' maybe expr
X { $$ = oper3(OCOMMA,$1,$3,$4); }
X | clist ',' maybe expr
X { $$ = oper3(OCOMMA,$1,$3,$4); }
X | '(' clist ')' /* these parens are invisible */
X { $$ = $2; }
X ;
X
Xjunk : junk hunksep
X { $$ = oper2(OJUNK,$1,$2); }
X | /* NULL */
X { $$ = Nullop; }
X ;
X
Xhunksep : ';'
X { $$ = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
X | SEMINEW
X { $$ = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
X | NEWLINE
X { $$ = oper0(ONEWLINE); }
X | COMMENT
X { $$ = oper1(OCOMMENT,$1); }
X ;
X
Xmaybe : maybe nlstuff
X { $$ = oper2(OJUNK,$1,$2); }
X | /* NULL */
X { $$ = Nullop; }
X ;
X
Xnlstuff : NEWLINE
X { $$ = oper0(ONEWLINE); }
X | COMMENT
X { $$ = oper1(OCOMMENT,$1); }
X ;
X
Xseparator
X : ';' maybe
X { $$ = oper2(OJUNK,oper0(OSEMICOLON),$2); }
X | SEMINEW maybe
X { $$ = oper2(OJUNK,oper0(OSNEWLINE),$2); }
X | NEWLINE maybe
X { $$ = oper2(OJUNK,oper0(OSNEWLINE),$2); }
X | COMMENT maybe
X { $$ = oper2(OJUNK,oper1(OSCOMMENT,$1),$2); }
X ;
X
Xstates : states statement
X { $$ = oper2(OSTATES,$1,$2); }
X | /* NULL */
X { $$ = Nullop; }
X ;
X
Xstatement
X : simple separator maybe
X { $$ = oper2(OJUNK,oper2(OSTATE,$1,$2),$3); }
X | ';' maybe
X { $$ = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSEMICOLON),$2)); }
X | SEMINEW maybe
X { $$ = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSNEWLINE),$2)); }
X | compound
X ;
X
Xsimpnull: simple
X | /* NULL */
X { $$ = Nullop; }
X ;
X
Xsimple
X : expr
X | PRINT expr_list redir expr
X { $$ = oper3(OPRINT,$2,$3,$4);
X do_opens = TRUE;
X saw_ORS = saw_OFS = TRUE;
X if (!$2) need_entire = TRUE;
X if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
X | PRINT expr_list
X { $$ = oper1(OPRINT,$2);
X if (!$2) need_entire = TRUE;
X saw_ORS = saw_OFS = TRUE;
X }
X | PRINTF expr_list redir expr
X { $$ = oper3(OPRINTF,$2,$3,$4);
X do_opens = TRUE;
X if (!$2) need_entire = TRUE;
X if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
X | PRINTF expr_list
X { $$ = oper1(OPRINTF,$2);
X if (!$2) need_entire = TRUE;
X }
X | BREAK
X { $$ = oper0(OBREAK); }
X | NEXT
X { $$ = oper0(ONEXT); }
X | EXIT
X { $$ = oper0(OEXIT); }
X | EXIT expr
X { $$ = oper1(OEXIT,$2); }
X | CONTINUE
X { $$ = oper0(OCONTINUE); }
X | RET
X { $$ = oper0(ORETURN); }
X | RET expr
X { $$ = oper1(ORETURN,$2); }
X | DELETE VAR '[' expr ']'
X { $$ = oper2(ODELETE,aryrefarg($2),$4); }
X ;
X
Xredir : '>' %prec FIELD
X { $$ = oper1(OREDIR,string(">",1)); }
X | GRGR
X { $$ = oper1(OREDIR,string(">>",2)); }
X | '|'
X { $$ = oper1(OREDIR,string("|",1)); }
X ;
X
Xcompound
X : IF '(' cond ')' maybe statement
X { $$ = oper2(OIF,$3,bl($6,$5)); }
X | IF '(' cond ')' maybe statement ELSE maybe statement
X { $$ = oper3(OIF,$3,bl($6,$5),bl($9,$8)); }
X | WHILE '(' cond ')' maybe statement
X { $$ = oper2(OWHILE,$3,bl($6,$5)); }
X | DO maybe statement WHILE '(' cond ')'
X { $$ = oper2(ODO,bl($3,$2),$6); }
X | FOR '(' simpnull ';' cond ';' simpnull ')' maybe statement
X { $$ = oper4(OFOR,$3,$5,$7,bl($10,$9)); }
X | FOR '(' simpnull ';' ';' simpnull ')' maybe statement
X { $$ = oper4(OFOR,$3,string("",0),$6,bl($9,$8)); }
X | FOR '(' expr ')' maybe statement
X { $$ = oper2(OFORIN,$3,bl($6,$5)); }
X | '{' maybe states '}' maybe
X { $$ = oper3(OBLOCK,oper2(OJUNK,$2,$3),Nullop,$5); }
X ;
X
X%%
X#include "a2py.c"
!STUFFY!FUNK!
echo Extracting t/op/sort.t
sed >t/op/sort.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: sort.t,v 4.0 91/03/20 01:54:38 lwall Locked $
X
Xprint "1..8\n";
X
Xsub reverse { $a lt $b ? 1 : $a gt $b ? -1 : 0; }
X
X@harry = ('dog','cat','x','Cain','Abel');
X@george = ('gone','chased','yz','Punished','Axed');
X
X$x = join('', sort @harry);
Xprint ($x eq 'AbelCaincatdogx' ? "ok 1\n" : "not ok 1\n");
X
X$x = join('', sort reverse @harry);
Xprint ($x eq 'xdogcatCainAbel' ? "ok 2\n" : "not ok 2\n");
X
X$x = join('', sort @george, 'to', @harry);
Xprint ($x eq 'AbelAxedCainPunishedcatchaseddoggonetoxyz'?"ok 3\n":"not ok 3\n");
X
X@a = ();
X@b = reverse @a;
Xprint ("@b" eq "" ? "ok 4\n" : "not ok 4 (@b)\n");
X
X@a = (1);
X@b = reverse @a;
Xprint ("@b" eq "1" ? "ok 5\n" : "not ok 5 (@b)\n");
X
X@a = (1,2);
X@b = reverse @a;
Xprint ("@b" eq "2 1" ? "ok 6\n" : "not ok 6 (@b)\n");
X
X@a = (1,2,3);
X@b = reverse @a;
Xprint ("@b" eq "3 2 1" ? "ok 7\n" : "not ok 7 (@b)\n");
X
X@a = (1,2,3,4);
X@b = reverse @a;
Xprint ("@b" eq "4 3 2 1" ? "ok 8\n" : "not ok 8 (@b)\n");
!STUFFY!FUNK!
echo " "
echo "End of kit 27 (of 36)"
cat /dev/null >kit27isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36; do
if test -f kit${iskit}isdone; then
run="$run $iskit"
else
todo="$todo $iskit"
fi
done
case $todo in
'')
echo "You have run all your kits. Please read README and then type Configure."
for combo in *:AA; do
if test -f "$combo"; then
realfile=`basename $combo :AA`
cat $realfile:[A-Z][A-Z] >$realfile
rm -rf $realfile:[A-Z][A-Z]
fi
done
rm -rf kit*isdone
chmod 755 Configure
;;
*) echo "You have run$run."
echo "You still need to run$todo."
;;
esac
: Someone might mail this, so...
exit
exit 0 # Just in case...
--
Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM
Sterling Software, IMD UUCP: uunet!sparky!kent
Phone: (402) 291-8300 FAX: (402) 291-4362
Please send comp.sources.misc-related mail to kent@uunet.uu.net.