diff options
| -rwxr-xr-x | Configure | 41 | ||||
| -rw-r--r-- | MANIFEST | 3 | ||||
| -rw-r--r-- | Makefile.SH | 32 | ||||
| -rw-r--r-- | embed.h | 9 | ||||
| -rw-r--r-- | embed.pl | 67 | ||||
| -rwxr-xr-x | embed_h.sh | 53 | ||||
| -rw-r--r-- | ext/GDBM_File/GDBM_File.xs | 10 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | hints/freebsd.sh | 39 | ||||
| -rw-r--r-- | installman | 12 | ||||
| -rwxr-xr-x | installperl | 41 | ||||
| -rw-r--r-- | interp.sym | 1 | ||||
| -rw-r--r-- | keywords.h | 477 | ||||
| -rwxr-xr-x | keywords.pl | 1 | ||||
| -rw-r--r-- | lib/Exporter.pm | 29 | ||||
| -rw-r--r-- | lib/ExtUtils/MakeMaker.pm | 69 | ||||
| -rwxr-xr-x | lib/ExtUtils/xsubpp | 224 | ||||
| -rw-r--r-- | lib/lib.pm | 103 | ||||
| -rw-r--r-- | op.c | 32 | ||||
| -rw-r--r-- | op.h | 2 | ||||
| -rw-r--r-- | perl.c | 2 | ||||
| -rw-r--r-- | perl.h | 1 | ||||
| -rw-r--r-- | perldoc.SH | 2 | ||||
| -rw-r--r-- | pod/perl.pod | 2 | ||||
| -rwxr-xr-x | pod/pod2html.SH | 18 | ||||
| -rw-r--r-- | pp.c | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 26 | ||||
| -rw-r--r-- | pp_hot.c | 10 | ||||
| -rw-r--r-- | proto.h | 7 | ||||
| -rw-r--r-- | regcomp.c | 15 | ||||
| -rw-r--r-- | regcomp.h | 4 | ||||
| -rw-r--r-- | regexec.c | 13 | ||||
| -rw-r--r-- | toke.c | 22 | ||||
| -rw-r--r-- | x2p/util.c | 4 | ||||
| -rw-r--r-- | x2p/util.h | 4 |
35 files changed, 874 insertions, 504 deletions
@@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.7 1995/03/21 08:46:15 ram Exp $ # -# Generated on Tue Jun 6 12:25:20 EDT 1995 [metaconfig 3.0 PL55] +# Generated on Thu Jun 22 10:38:35 EDT 1995 [metaconfig 3.0 PL55] cat >/tmp/c1$$ <<EOF ARGGGHHHH!!!!! @@ -5478,7 +5478,8 @@ END fi echo "and it returns ($shmattype)." >&4 : see if a prototype for shmat is available - $cppstdin $cppflags $cppminus < $usrinc/sys/shm.h > shmat.c 2>/dev/null + xxx=`./findhdr sys/shm.h` + $cppstdin $cppflags $cppminus < $xxx > shmat.c 2>/dev/null if $contains 'shmat.*(' shmat.c >/dev/null 2>&1; then val="$define" else @@ -5523,7 +5524,10 @@ to search by default in addition to $privlib. If you don't want to use such an additional directory, answer 'none'. EOM -dflt=none +case "$sitelib" in +'') dflt=none ;; +*) dflt="$sitelib" ;; +esac fn=d~+n rp='Local directory for additional library files?' . ./getfile @@ -5533,27 +5537,32 @@ fi sitelib="$ans" sitelibexp="$ansexp" if $afs; then - $cat <<EOM + case "$sitelib" in + '') installsitelib="$sitelibexp" + ;; + *) $cat <<EOM Since you are running AFS, I need to distinguish the directory in which private files reside from the directory in which they are installed (and from which they are presumably copied to the former directory by occult means). EOM - case "$installsitelib" in - '') dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installsitelib";; + case "$installsitelib" in + '') dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installsitelib";; + esac + fn=de~ + rp='Where will additional local files be installed?' + . ./getfile + installsitelib="$ans" + ;; esac - fn=de~ - rp='Where will additional local files be installed?' - . ./getfile - installsitelib="$ans" else installsitelib="$sitelibexp" fi case "$sitelibexp" in -''|' ') d_sitelib=undef ;; +'') d_sitelib=undef ;; *) d_sitelib=define ;; esac @@ -5708,8 +5717,8 @@ eval $setvar : Can _ptr be used as an lvalue. Only makes sense if we : have a known stdio implementation. -case "$d_stdstdio" in -$define) val=$ptr_lval ;; +case "$d_stdstdio$ptr_lval" in +$define$define) val=$define ;; *) val=$undef ;; esac set d_stdio_ptr_lval @@ -5718,8 +5727,8 @@ eval $setvar : Can _cnt be used as an lvalue. Only makes sense if we : have a known stdio implementation. -case "$d_stdstdio" in -$define) val=$cnt_lval ;; +case "$d_stdstdio$cnt_lval" in +$define$define) val=$define ;; *) val=$undef ;; esac set d_stdio_cnt_lval @@ -79,7 +79,7 @@ emacs/perldb.el Emacs debugging emacs/perldb.pl Emacs debugging emacs/tedstuff Some optional patches embed.h Maps symbols to safer names -embed_h.sh Produces embed.h +embed.pl Produces embed.h ext/DB_File/DB_File.pm Berkeley DB extension Perl module ext/DB_File/DB_File.xs Berkeley DB extension external subroutines ext/DB_File/DB_File_BS Berkeley DB extension mkbootstrap fodder @@ -307,6 +307,7 @@ lib/hostname.pl Old hostname code lib/importenv.pl Perl routine to get environment into variables lib/integer.pm For "use integer" lib/less.pm For "use less" +lib/lib.pm For "use lib" lib/look.pl A "look" equivalent lib/newgetopt.pl A perl library supporting long option parsing lib/open2.pl Open a two-ended pipe diff --git a/Makefile.SH b/Makefile.SH index cdd6333781..1dabfdeac5 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -185,7 +185,9 @@ all: makefile miniperl $(private) $(public) $(dynamic_ext) # @echo " "; echo " Making docs"; cd pod; $(MAKE) all; # Phony target to force checking subdirectories. +# Apparently some makes require an action for the FORCE target. FORCE: + @true # The $& notation tells Sequent machines that it can do a parallel make, # and is harmless otherwise. @@ -252,23 +254,6 @@ sperl.o: perl.c perly.h patchlevel.h $(h) $(CCCMD) -DIAMSUID sperl.c $(RMS) sperl.c -# The following three header files are generated automatically -# The correct versions should be already supplied with the perl kit, -# in case you don't have perl or 'sh' available. -# The - is to ignore error return codes in case you have the source -# installed read-only or you don't have perl yet. -keywords.h: keywords.pl - @echo "Don't worry if this fails." - - perl keywords.pl - -opcode.h: opcode.pl - @echo "Don't worry if this fails." - - perl opcode.pl - -embed.h: embed_h.sh global.sym interp.sym - @echo "Don't worry if this fails." - - sh embed_h.sh - # We have to call our ./makedir because Ultrix 4.3 make can't handle the line # test -d lib/auto || mkdir lib/auto # @@ -321,6 +306,19 @@ perly.c: perly.y perly.h: perly.y -@touch perly.h +# The following three header files are generated automatically +# keywords.h: keywords.pl +# opcode.h: opcode.pl +# embed.h: embed.pl global.sym interp.sym +# The correct versions should be already supplied with the perl kit, +# in case you don't have perl available. +# To force them to run, type +# make regen_headers +regen_headers: FORCE + perl keywords.pl + perl opcode.pl + perl embed.pl + # Extensions: # Names added to $(dynamic_ext) or $(static_ext) will automatically # get built. There should ordinarily be no need to change any of @@ -357,6 +357,7 @@ #define doeval Perl_doeval #define dofindlabel Perl_dofindlabel #define dopoptoeval Perl_dopoptoeval +#define dowantarray Perl_dowantarray #define dump_all Perl_dump_all #define dump_eval Perl_dump_eval #define dump_gv Perl_dump_gv @@ -861,10 +862,10 @@ #define q Perl_q #define ref Perl_ref #define refkids Perl_refkids -#define regcomp Perl_regcomp +#define pregcomp Perl_pregcomp #define regdump Perl_regdump -#define regexec Perl_regexec -#define regfree Perl_regfree +#define pregexec Perl_pregexec +#define pregfree Perl_pregfree #define regnext Perl_regnext #define regprop Perl_regprop #define repeatcpy Perl_repeatcpy @@ -1088,6 +1089,7 @@ #define ofslen (curinterp->Iofslen) #define oldlastpm (curinterp->Ioldlastpm) #define oldname (curinterp->Ioldname) +#define op_mask (curinterp->Iop_mask) #define origargc (curinterp->Iorigargc) #define origargv (curinterp->Iorigargv) #define origfilename (curinterp->Iorigfilename) @@ -1244,6 +1246,7 @@ #define Iofslen ofslen #define Ioldlastpm oldlastpm #define Ioldname oldname +#define Iop_mask op_mask #define Iorigargc origargc #define Iorigargv origargv #define Iorigfilename origfilename diff --git a/embed.pl b/embed.pl new file mode 100644 index 0000000000..118b911c71 --- /dev/null +++ b/embed.pl @@ -0,0 +1,67 @@ +#!/usr/bin/perl + +open(EM, ">embed.h") || die "Can't create embed.h: $!\n"; + +print EM <<'END'; +/* This file is derived from global.sym and interp.sym */ + +/* (Doing namespace management portably in C is really gross.) */ + +#ifdef EMBED + +/* globals we need to hide from the world */ +END + +open(GL, "<global.sym") || die "Can't open global.sym: $!\n"; + +while(<GL>) { + s/[ \t]*#.*//; # Delete comments. + next unless /\S/; + s/(.*)/#define $1\t\tPerl_$1/; + s/(................\t)\t/$1/; + print EM $_; +} + +close(GL) || warn "Can't close global.sym: $!\n"; + +print EM <<'END'; + +#endif /* EMBED */ + +/* Put interpreter specific symbols into a struct? */ + +#ifdef MULTIPLICITY + +END + +open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n"; +while (<INT>) { + s/[ \t]*#.*//; # Delete comments. + next unless /\S/; + s/(.*)/#define $1\t\t(curinterp->I$1)/; + s/(................\t)\t/$1/; + print EM $_; +} +close(INT) || warn "Can't close interp.sym: $!\n"; + +print EM <<'END'; + +#else /* not multiple, so translate interpreter symbols the other way... */ + +END + +open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n"; +while (<INT>) { + s/[ \t]*#.*//; # Delete comments. + next unless /\S/; + s/(.*)/#define I$1\t\t$1/; + s/(................\t)\t/$1/; + print EM $_; +} +close(INT) || warn "Can't close interp.sym: $!\n"; + +print EM <<'END'; + +#endif /* MULTIPLICITY */ +END + diff --git a/embed_h.sh b/embed_h.sh deleted file mode 100755 index e098c1ed82..0000000000 --- a/embed_h.sh +++ /dev/null @@ -1,53 +0,0 @@ -#!/bin/sh - -rm -f embed.h -cat <<'END' >embed.h -/* This file is derived from global.sym and interp.sym */ - -/* (Doing namespace management portably in C is really gross.) */ - -#ifdef EMBED - -/* globals we need to hide from the world */ -END - -sed <global.sym >>embed.h \ - -e 's/[ ]*#.*//' \ - -e '/^[ ]*$/d' \ - -e 's/\(.*\)/#define \1 Perl_\1/' \ - -e 's/\(................ \) /\1/' - -cat <<'END' >> embed.h - -#endif /* EMBED */ - -/* Put interpreter specific symbols into a struct? */ - -#ifdef MULTIPLICITY - -END - - -sed <interp.sym >>embed.h \ - -e 's/[ ]*#.*//' \ - -e '/^[ ]*$/d' \ - -e 's/\(.*\)/#define \1 (curinterp->I\1)/' \ - -e 's/\(................ \) /\1/' - -cat <<'END' >> embed.h - -#else /* not multiple, so translate interpreter symbols the other way... */ - -END - -sed <interp.sym >>embed.h \ - -e 's/[ ]*#.*//' \ - -e '/^[ ]*$/d' \ - -e 's/\(.*\)/#define I\1 \1/' \ - -e 's/\(................ \) /\1/' - -cat <<'END' >> embed.h - -#endif /* MULTIPLICITY */ -END - diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs index 0a0b71779e..81b42d8824 100644 --- a/ext/GDBM_File/GDBM_File.xs +++ b/ext/GDBM_File/GDBM_File.xs @@ -29,6 +29,16 @@ char *s; return -1; } +/* Versions of gdbm prior to 1.7x might not have the gdbm_sync, + gdbm_exists, and gdbm_setopt functions. Apparently Slackware + (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991). +*/ +#ifndef GDBM_FAST +#define gdbm_exists(db,key) not_here("gdbm_exists") +#define gdbm_sync(db) (void) not_here("gdbm_sync") +#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt") +#endif + static double constant(name, arg) char *name; diff --git a/global.sym b/global.sym index e400760174..ec0181aa93 100644 --- a/global.sym +++ b/global.sym @@ -357,6 +357,7 @@ do_vop doeval dofindlabel dopoptoeval +dowantarray dump_all dump_eval dump_gv diff --git a/hints/freebsd.sh b/hints/freebsd.sh index 74bae055bf..756ad78981 100644 --- a/hints/freebsd.sh +++ b/hints/freebsd.sh @@ -14,9 +14,6 @@ # Ollivier Robert <Ollivier.Robert@keltia.frmug.fr.net> # Date: Fri, 12 May 1995 14:30:38 +0200 (MET DST) # -# FreeBSD has the dynamic loading dl*() functions in /usr/lib/crt0.o, -# so Configure doesn't find them (unless you abandon the nm scan). -# # The two flags "-fpic -DPIC" are used to indicate a # will-be-shared object. Configure will guess the -fpic, (and the # -DPIC is not used by perl proper) but the full define is included to @@ -31,9 +28,7 @@ case "$osvers" in 0.*|1.0*) usedl="$undef" ;; -1.1*) d_dlopen="$define" - cccdlflags='-DPIC -fpic' - lddlflags="-Bshareable $lddlflags" +1.1*) malloctype='void *' groupstype='int' d_setregid='undef' @@ -41,10 +36,7 @@ case "$osvers" in d_setrgid='undef' d_setruid='undef' ;; -2.0-RELEASE*) - d_dlopen="$define" - cccdlflags='-DPIC -fpic' - lddlflags="-Bshareable $lddlflags" +2.0-release*) d_setregid='undef' d_setreuid='undef' d_setrgid='undef' @@ -55,17 +47,26 @@ case "$osvers" in # It does not covert all 2.1-current versions as the output of uname # changed a few times. # -2.0.5*|2.0-BUILD|2.1*) - d_dlopen="$define" - cccdlflags='-DPIC -fpic' +2.0.5*|2.0-built*|2.1*) + usevfork='true' + d_dosuid='define' + ;; +# +# Guesses at what will be needed after 2.1 +*) usevfork='true' + d_dosuid='define' + ;; +esac + +# Dynamic Loading flags have not changed much, so they are separated +# out here to avoid duplicating them everywhere. +case "$osvers" in +0.*|1.0*) ;; +*) cccdlflags='-DPIC -fpic' lddlflags="-Bshareable $lddlflags" - # Are these defines necessary? Doesn't Configure find them - # correctly? - d_setregid='define' - d_setreuid='define' - d_setrgid='define' - d_setruid='define' + ;; esac + # Avoid telldir prototype conflict in pp_sys.c (FreeBSD uses const DIR *) # Configure should test for this. Volunteers? pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' diff --git a/installman b/installman index f184fd5b56..b6765632fe 100644 --- a/installman +++ b/installman @@ -64,8 +64,16 @@ sub runpod2man { # We insist on using the current version of pod2man in case there # are enhancements or changes from previous installed versions. - $pod2man = "../pod/pod2man"; - -x $pod2man || die "Executable $pod2man not found.\n"; + # The error message doesn't include the '..' because the user + # won't be aware that we've chdir to $poddir. + -x "../pod/pod2man" || die "Executable pod/pod2man not found.\n"; + + # We want to be sure to use the current perl. We can't rely on + # the installed perl because it might not be actually installed + # yet. (The user may have set the $install* Configure variables + # to point to some temporary home, from which the executable gets + # installed by occult means.) + $pod2man = "../perl -I ../lib ../pod/pod2man"; &makedir($mandir); # Make a list of all the .pm and .pod files in the directory. We will diff --git a/installperl b/installperl index 0530d154f2..87b81ac2f1 100755 --- a/installperl +++ b/installperl @@ -69,10 +69,10 @@ if ($d_shrplib) { # First we install the version-numbered executables. -&unlink("$installbin/perl$ver"); +&safe_unlink("$installbin/perl$ver"); &cmd("cp perl $installbin/perl$ver"); -&unlink("$installbin/sperl$ver"); +&safe_unlink("$installbin/sperl$ver"); if ($d_dosuid) { &cmd("cp suidperl $installbin/sperl$ver"); &chmod(04711, "$installbin/sperl$ver"); @@ -83,13 +83,13 @@ exit 0 if $versiononly; # Make links to ordinary names if installbin directory isn't current directory. if (! &samepath($installbin, '.')) { - &unlink("$installbin/perl", "$installbin/suidperl"); + &safe_unlink("$installbin/perl", "$installbin/suidperl"); &link("$installbin/perl$ver", "$installbin/perl"); &link("$installbin/sperl$ver", "$installbin/suidperl") if $d_dosuid; } if (! &samepath($installbin, 'x2p')) { - &unlink("$installbin/a2p"); + &safe_unlink("$installbin/a2p"); &cmd("cp x2p/a2p $installbin/a2p"); &chmod(0755, "$installbin/a2p"); } @@ -248,6 +248,22 @@ sub unlink { } } +sub safe_unlink { + local(@names) = @_; + + foreach $name (@names) { + next unless -e $name; + print STDERR " unlink $name\n"; + next if $nonono; + next if unlink($name); + warn "Couldn't unlink $name: $!\n"; + if ($! =~ /busy/i) { + print STDERR " mv $name $name.old\n"; + &rename($name, "$name.old") || warn "Couldn't rename $name: $!\n"; + } + } +} + sub cmd { local($cmd) = @_; print STDERR " $cmd\n"; @@ -257,6 +273,19 @@ sub cmd { } } +sub rename { + local($from,$to) = @_; + unless (unlink($to)) { + my($i); + for ($i = 1; $i < 50; $i++) { + last if rename($to, "$to.$i"); + } + return 0 if $i >= 50; # Give up! + } + link($from,$to) || return 0; + unlink($from); +} + sub link { local($from,$to) = @_; @@ -304,6 +333,10 @@ sub installlib { $dir =~ s#^\.(?![^/])/?##; my $name = $_; + + # ignore patch backups and the .exists files. + return if $name =~ m{\.orig$|~$|^\.exists}; + $name = "$dir/$name" if $dir ne ''; my $installlib = $installprivlib; diff --git a/interp.sym b/interp.sym index 8747e0490f..4bd3e72ca6 100644 --- a/interp.sym +++ b/interp.sym @@ -96,6 +96,7 @@ ofs ofslen oldlastpm oldname +op_mask origargc origargv origfilename diff --git a/keywords.h b/keywords.h index 49f4d20944..a764b10ba0 100644 --- a/keywords.h +++ b/keywords.h @@ -1,241 +1,242 @@ #define KEY_NULL 0 #define KEY___LINE__ 1 #define KEY___FILE__ 2 -#define KEY___END__ 3 -#define KEY_AUTOLOAD 4 -#define KEY_BEGIN 5 -#define KEY_CORE 6 -#define KEY_DESTROY 7 -#define KEY_END 8 -#define KEY_EQ 9 -#define KEY_GE 10 -#define KEY_GT 11 -#define KEY_LE 12 -#define KEY_LT 13 -#define KEY_NE 14 -#define KEY_abs 15 -#define KEY_accept 16 -#define KEY_alarm 17 -#define KEY_and 18 -#define KEY_atan2 19 -#define KEY_bind 20 -#define KEY_binmode 21 -#define KEY_bless 22 -#define KEY_caller 23 -#define KEY_chdir 24 -#define KEY_chmod 25 -#define KEY_chomp 26 -#define KEY_chop 27 -#define KEY_chown 28 -#define KEY_chr 29 -#define KEY_chroot 30 -#define KEY_close 31 -#define KEY_closedir 32 -#define KEY_cmp 33 -#define KEY_connect 34 -#define KEY_continue 35 -#define KEY_cos 36 -#define KEY_crypt 37 -#define KEY_dbmclose 38 -#define KEY_dbmopen 39 -#define KEY_defined 40 -#define KEY_delete 41 -#define KEY_die 42 -#define KEY_do 43 -#define KEY_dump 44 -#define KEY_each 45 -#define KEY_else 46 -#define KEY_elsif 47 -#define KEY_endgrent 48 -#define KEY_endhostent 49 -#define KEY_endnetent 50 -#define KEY_endprotoent 51 -#define KEY_endpwent 52 -#define KEY_endservent 53 -#define KEY_eof 54 -#define KEY_eq 55 -#define KEY_eval 56 -#define KEY_exec 57 -#define KEY_exists 58 -#define KEY_exit 59 -#define KEY_exp 60 -#define KEY_fcntl 61 -#define KEY_fileno 62 -#define KEY_flock 63 -#define KEY_for 64 -#define KEY_foreach 65 -#define KEY_fork 66 -#define KEY_format 67 -#define KEY_formline 68 -#define KEY_ge 69 -#define KEY_getc 70 -#define KEY_getgrent 71 -#define KEY_getgrgid 72 -#define KEY_getgrnam 73 -#define KEY_gethostbyaddr 74 -#define KEY_gethostbyname 75 -#define KEY_gethostent 76 -#define KEY_getlogin 77 -#define KEY_getnetbyaddr 78 -#define KEY_getnetbyname 79 -#define KEY_getnetent 80 -#define KEY_getpeername 81 -#define KEY_getpgrp 82 -#define KEY_getppid 83 -#define KEY_getpriority 84 -#define KEY_getprotobyname 85 -#define KEY_getprotobynumber 86 -#define KEY_getprotoent 87 -#define KEY_getpwent 88 -#define KEY_getpwnam 89 -#define KEY_getpwuid 90 -#define KEY_getservbyname 91 -#define KEY_getservbyport 92 -#define KEY_getservent 93 -#define KEY_getsockname 94 -#define KEY_getsockopt 95 -#define KEY_glob 96 -#define KEY_gmtime 97 -#define KEY_goto 98 -#define KEY_grep 99 -#define KEY_gt 100 -#define KEY_hex 101 -#define KEY_if 102 -#define KEY_index 103 -#define KEY_int 104 -#define KEY_ioctl 105 -#define KEY_join 106 -#define KEY_keys 107 -#define KEY_kill 108 -#define KEY_last 109 -#define KEY_lc 110 -#define KEY_lcfirst 111 -#define KEY_le 112 -#define KEY_length 113 -#define KEY_link 114 -#define KEY_listen 115 -#define KEY_local 116 -#define KEY_localtime 117 -#define KEY_log 118 -#define KEY_lstat 119 -#define KEY_lt 120 -#define KEY_m 121 -#define KEY_map 122 -#define KEY_mkdir 123 -#define KEY_msgctl 124 -#define KEY_msgget 125 -#define KEY_msgrcv 126 -#define KEY_msgsnd 127 -#define KEY_my 128 -#define KEY_ne 129 -#define KEY_next 130 -#define KEY_no 131 -#define KEY_not 132 -#define KEY_oct 133 -#define KEY_open 134 -#define KEY_opendir 135 -#define KEY_or 136 -#define KEY_ord 137 -#define KEY_pack 138 -#define KEY_package 139 -#define KEY_pipe 140 -#define KEY_pop 141 -#define KEY_pos 142 -#define KEY_print 143 -#define KEY_printf 144 -#define KEY_push 145 -#define KEY_q 146 -#define KEY_qq 147 -#define KEY_quotemeta 148 -#define KEY_qw 149 -#define KEY_qx 150 -#define KEY_rand 151 -#define KEY_read 152 -#define KEY_readdir 153 -#define KEY_readline 154 -#define KEY_readlink 155 -#define KEY_readpipe 156 -#define KEY_recv 157 -#define KEY_redo 158 -#define KEY_ref 159 -#define KEY_rename 160 -#define KEY_require 161 -#define KEY_reset 162 -#define KEY_return 163 -#define KEY_reverse 164 -#define KEY_rewinddir 165 -#define KEY_rindex 166 -#define KEY_rmdir 167 -#define KEY_s 168 -#define KEY_scalar 169 -#define KEY_seek 170 -#define KEY_seekdir 171 -#define KEY_select 172 -#define KEY_semctl 173 -#define KEY_semget 174 -#define KEY_semop 175 -#define KEY_send 176 -#define KEY_setgrent 177 -#define KEY_sethostent 178 -#define KEY_setnetent 179 -#define KEY_setpgrp 180 -#define KEY_setpriority 181 -#define KEY_setprotoent 182 -#define KEY_setpwent 183 -#define KEY_setservent 184 -#define KEY_setsockopt 185 -#define KEY_shift 186 -#define KEY_shmctl 187 -#define KEY_shmget 188 -#define KEY_shmread 189 -#define KEY_shmwrite 190 -#define KEY_shutdown 191 -#define KEY_sin 192 -#define KEY_sleep 193 -#define KEY_socket 194 -#define KEY_socketpair 195 -#define KEY_sort 196 -#define KEY_splice 197 -#define KEY_split 198 -#define KEY_sprintf 199 -#define KEY_sqrt 200 -#define KEY_srand 201 -#define KEY_stat 202 -#define KEY_study 203 -#define KEY_sub 204 -#define KEY_substr 205 -#define KEY_symlink 206 -#define KEY_syscall 207 -#define KEY_sysread 208 -#define KEY_system 209 -#define KEY_syswrite 210 -#define KEY_tell 211 -#define KEY_telldir 212 -#define KEY_tie 213 -#define KEY_time 214 -#define KEY_times 215 -#define KEY_tr 216 -#define KEY_truncate 217 -#define KEY_uc 218 -#define KEY_ucfirst 219 -#define KEY_umask 220 -#define KEY_undef 221 -#define KEY_unless 222 -#define KEY_unlink 223 -#define KEY_unpack 224 -#define KEY_unshift 225 -#define KEY_untie 226 -#define KEY_until 227 -#define KEY_use 228 -#define KEY_utime 229 -#define KEY_values 230 -#define KEY_vec 231 -#define KEY_wait 232 -#define KEY_waitpid 233 -#define KEY_wantarray 234 -#define KEY_warn 235 -#define KEY_while 236 -#define KEY_write 237 -#define KEY_x 238 -#define KEY_xor 239 -#define KEY_y 240 +#define KEY___DATA__ 3 +#define KEY___END__ 4 +#define KEY_AUTOLOAD 5 +#define KEY_BEGIN 6 +#define KEY_CORE 7 +#define KEY_DESTROY 8 +#define KEY_END 9 +#define KEY_EQ 10 +#define KEY_GE 11 +#define KEY_GT 12 +#define KEY_LE 13 +#define KEY_LT 14 +#define KEY_NE 15 +#define KEY_abs 16 +#define KEY_accept 17 +#define KEY_alarm 18 +#define KEY_and 19 +#define KEY_atan2 20 +#define KEY_bind 21 +#define KEY_binmode 22 +#define KEY_bless 23 +#define KEY_caller 24 +#define KEY_chdir 25 +#define KEY_chmod 26 +#define KEY_chomp 27 +#define KEY_chop 28 +#define KEY_chown 29 +#define KEY_chr 30 +#define KEY_chroot 31 +#define KEY_close 32 +#define KEY_closedir 33 +#define KEY_cmp 34 +#define KEY_connect 35 +#define KEY_continue 36 +#define KEY_cos 37 +#define KEY_crypt 38 +#define KEY_dbmclose 39 +#define KEY_dbmopen 40 +#define KEY_defined 41 +#define KEY_delete 42 +#define KEY_die 43 +#define KEY_do 44 +#define KEY_dump 45 +#define KEY_each 46 +#define KEY_else 47 +#define KEY_elsif 48 +#define KEY_endgrent 49 +#define KEY_endhostent 50 +#define KEY_endnetent 51 +#define KEY_endprotoent 52 +#define KEY_endpwent 53 +#define KEY_endservent 54 +#define KEY_eof 55 +#define KEY_eq 56 +#define KEY_eval 57 +#define KEY_exec 58 +#define KEY_exists 59 +#define KEY_exit 60 +#define KEY_exp 61 +#define KEY_fcntl 62 +#define KEY_fileno 63 +#define KEY_flock 64 +#define KEY_for 65 +#define KEY_foreach 66 +#define KEY_fork 67 +#define KEY_format 68 +#define KEY_formline 69 +#define KEY_ge 70 +#define KEY_getc 71 +#define KEY_getgrent 72 +#define KEY_getgrgid 73 +#define KEY_getgrnam 74 +#define KEY_gethostbyaddr 75 +#define KEY_gethostbyname 76 +#define KEY_gethostent 77 +#define KEY_getlogin 78 +#define KEY_getnetbyaddr 79 +#define KEY_getnetbyname 80 +#define KEY_getnetent 81 +#define KEY_getpeername 82 +#define KEY_getpgrp 83 +#define KEY_getppid 84 +#define KEY_getpriority 85 +#define KEY_getprotobyname 86 +#define KEY_getprotobynumber 87 +#define KEY_getprotoent 88 +#define KEY_getpwent 89 +#define KEY_getpwnam 90 +#define KEY_getpwuid 91 +#define KEY_getservbyname 92 +#define KEY_getservbyport 93 +#define KEY_getservent 94 +#define KEY_getsockname 95 +#define KEY_getsockopt 96 +#define KEY_glob 97 +#define KEY_gmtime 98 +#define KEY_goto 99 +#define KEY_grep 100 +#define KEY_gt 101 +#define KEY_hex 102 +#define KEY_if 103 +#define KEY_index 104 +#define KEY_int 105 +#define KEY_ioctl 106 +#define KEY_join 107 +#define KEY_keys 108 +#define KEY_kill 109 +#define KEY_last 110 +#define KEY_lc 111 +#define KEY_lcfirst 112 +#define KEY_le 113 +#define KEY_length 114 +#define KEY_link 115 +#define KEY_listen 116 +#define KEY_local 117 +#define KEY_localtime 118 +#define KEY_log 119 +#define KEY_lstat 120 +#define KEY_lt 121 +#define KEY_m 122 +#define KEY_map 123 +#define KEY_mkdir 124 +#define KEY_msgctl 125 +#define KEY_msgget 126 +#define KEY_msgrcv 127 +#define KEY_msgsnd 128 +#define KEY_my 129 +#define KEY_ne 130 +#define KEY_next 131 +#define KEY_no 132 +#define KEY_not 133 +#define KEY_oct 134 +#define KEY_open 135 +#define KEY_opendir 136 +#define KEY_or 137 +#define KEY_ord 138 +#define KEY_pack 139 +#define KEY_package 140 +#define KEY_pipe 141 +#define KEY_pop 142 +#define KEY_pos 143 +#define KEY_print 144 +#define KEY_printf 145 +#define KEY_push 146 +#define KEY_q 147 +#define KEY_qq 148 +#define KEY_quotemeta 149 +#define KEY_qw 150 +#define KEY_qx 151 +#define KEY_rand 152 +#define KEY_read 153 +#define KEY_readdir 154 +#define KEY_readline 155 +#define KEY_readlink 156 +#define KEY_readpipe 157 +#define KEY_recv 158 +#define KEY_redo 159 +#define KEY_ref 160 +#define KEY_rename 161 +#define KEY_require 162 +#define KEY_reset 163 +#define KEY_return 164 +#define KEY_reverse 165 +#define KEY_rewinddir 166 +#define KEY_rindex 167 +#define KEY_rmdir 168 +#define KEY_s 169 +#define KEY_scalar 170 +#define KEY_seek 171 +#define KEY_seekdir 172 +#define KEY_select 173 +#define KEY_semctl 174 +#define KEY_semget 175 +#define KEY_semop 176 +#define KEY_send 177 +#define KEY_setgrent 178 +#define KEY_sethostent 179 +#define KEY_setnetent 180 +#define KEY_setpgrp 181 +#define KEY_setpriority 182 +#define KEY_setprotoent 183 +#define KEY_setpwent 184 +#define KEY_setservent 185 +#define KEY_setsockopt 186 +#define KEY_shift 187 +#define KEY_shmctl 188 +#define KEY_shmget 189 +#define KEY_shmread 190 +#define KEY_shmwrite 191 +#define KEY_shutdown 192 +#define KEY_sin 193 +#define KEY_sleep 194 +#define KEY_socket 195 +#define KEY_socketpair 196 +#define KEY_sort 197 +#define KEY_splice 198 +#define KEY_split 199 +#define KEY_sprintf 200 +#define KEY_sqrt 201 +#define KEY_srand 202 +#define KEY_stat 203 +#define KEY_study 204 +#define KEY_sub 205 +#define KEY_substr 206 +#define KEY_symlink 207 +#define KEY_syscall 208 +#define KEY_sysread 209 +#define KEY_system 210 +#define KEY_syswrite 211 +#define KEY_tell 212 +#define KEY_telldir 213 +#define KEY_tie 214 +#define KEY_time 215 +#define KEY_times 216 +#define KEY_tr 217 +#define KEY_truncate 218 +#define KEY_uc 219 +#define KEY_ucfirst 220 +#define KEY_umask 221 +#define KEY_undef 222 +#define KEY_unless 223 +#define KEY_unlink 224 +#define KEY_unpack 225 +#define KEY_unshift 226 +#define KEY_untie 227 +#define KEY_until 228 +#define KEY_use 229 +#define KEY_utime 230 +#define KEY_values 231 +#define KEY_vec 232 +#define KEY_wait 233 +#define KEY_waitpid 234 +#define KEY_wantarray 235 +#define KEY_warn 236 +#define KEY_while 237 +#define KEY_write 238 +#define KEY_x 239 +#define KEY_xor 240 +#define KEY_y 241 diff --git a/keywords.pl b/keywords.pl index d3426be313..8cbaa83835 100755 --- a/keywords.pl +++ b/keywords.pl @@ -26,6 +26,7 @@ __END__ NULL __LINE__ __FILE__ +__DATA__ __END__ AUTOLOAD BEGIN diff --git a/lib/Exporter.pm b/lib/Exporter.pm index ca1ff3547c..0a7abc5286 100644 --- a/lib/Exporter.pm +++ b/lib/Exporter.pm @@ -36,6 +36,16 @@ Application says: You can set C<$Exporter::Verbose=1;> to see how the specifications are being processed and what is actually being imported into modules. +=head2 Module Version Checking + +The Exporter module will convert an attempt to import a number from a +module into a call to $module_name->require_version($value). This can +be used to validate that the version of the module being used is +greater than or equal to the required version. + +The Exporter module supplies a default require_version method which +checks the value of $VERSION in the exporting module. + =cut require 5.001; @@ -111,7 +121,15 @@ sub export { foreach $sym (@imports) { if (!$exports{$sym}) { - if ($sym !~ s/^&// || !$exports{$sym}) { + if ($sym =~ m/^\d/) { + $pkg->require_version($sym); + # If the version number was the only thing specified + # then we should act as if nothing was specified: + if (@imports == 1) { + @imports = @exports; + last; + } + } elsif ($sym !~ s/^&// || !$exports{$sym}) { warn qq["$sym" is not exported by the $pkg module ], "at $callfile line $callline\n"; $oops++; @@ -152,4 +170,13 @@ sub export_tags { map {$tags{$_} ? @{$tags{$_}} : $_} @_ ? @_ : keys %tags); } +sub require_version { + my($self, $wanted) = @_; + my $pkg = ref $self || $self; + my $version = ${"${pkg}::VERSION"} || "(undef)"; + Carp::croak("$pkg $wanted required--this is only version $version") + if $version < $wanted; + $version; +} + 1; diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index 06b4ab59e5..b073ffc99a 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -1,6 +1,6 @@ package ExtUtils::MakeMaker; -$Version = 4.15; # Last edited $Date: 1995/06/06 14:04:00 $ by Andreas Koenig +$Version = 4.16; # Last edited $Date: 1995/06/18 16:04:00 $ by Tim Bunce $Version_OK = 4.13; # Makefiles older than $Version_OK will die # (Will be checked from MakeMaker version 4.13 onwards) @@ -263,13 +263,13 @@ sub help {print $Attrib_Help;} 'clean' => {}, 'realclean' => {}, 'dist' => {}, - 'test' => {}, 'install' => {}, 'force' => {}, 'perldepend' => {}, 'makefile' => {}, - 'postamble' => {}, - 'staticmake' => {}, + 'staticmake' => {}, # Sadly this defines more macros + 'test' => {}, + 'postamble' => {}, # should always be last ); %MM_Sections = @MM_Sections_spec; # looses section ordering @MM_Sections = grep(!ref, @MM_Sections_spec); # keeps order @@ -765,7 +765,8 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) $xs{$name} = $c; $c{$c} = 1; } elsif ($name =~ /\.c$/){ - $c{$name} = 1; + $c{$name} = 1 + unless $name =~ m/perlmain\.c/; # See MAP_TARGET } elsif ($name =~ /\.h$/){ $h{$name} = 1; } elsif ($name =~ /\.(p[ml]|pod)$/){ @@ -1842,21 +1843,40 @@ sub test { my(@m); push(@m," TEST_VERBOSE=0 +TEST_TYPE=test_$att{LINKTYPE} -test :: all +test :: \$(TEST_TYPE) "); - push(@m, <<"END") if $tests; - \$(FULLPERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) -e 'use Test::Harness qw(&runtests \$\$verbose); \$\$verbose=\$(TEST_VERBOSE); runtests \@ARGV;' $tests -END - push(@m, <<'END') if -f "test.pl"; - $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) test.pl -END push(@m, map("\tcd $_ && test -f $att{MAKEFILE} && \$(MAKE) test \$(PASTHRU2)\n", @{$att{DIR}})); - push(@m, "\t\@echo 'No tests defined for \$(NAME) extension.'\n") unless @m > 1; + push(@m, "\t\@echo 'No tests defined for \$(NAME) extension.'\n") + unless $tests or -f "test.pl" or @{$att{DIR}}; + push(@m, "\n"); + + push(@m, "test_dynamic :: all\n"); + push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests; + push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl"; + push(@m, "\n"); + + push(@m, "test_static :: all \$(MAP_TARGET)\n"); + push(@m, $self->test_via_harness('./$(MAP_TARGET)', $tests)) if $tests; + push(@m, $self->test_via_script('./$(MAP_TARGET)', 'test.pl')) if -f "test.pl"; + push(@m, "\n"); + join("", @m); } +sub test_via_harness { + my($self, $perl, $tests) = @_; + "\t$perl".q! -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' !."$tests\n"; +} + +sub test_via_script { + my($self, $perl, $script) = @_; + "\t$perl".' -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) test.pl +'; +} + sub install { my($self, %attribs) = @_; @@ -2129,10 +2149,10 @@ inst_perl: pure_inst_perl doc_inst_perl pure_inst_perl: \$(MAP_TARGET) $att{CP} \$(MAP_TARGET) \$(INSTALLBIN)/\$(MAP_TARGET) -realclean :: map_clean +clean :: map_clean map_clean : - $att{RM_F} $tmp/perlmain.o $tmp/perlmain.c $makefilename extralibs.ld + $att{RM_F} $tmp/perlmain.o $tmp/perlmain.c \$(MAP_TARGET) extralibs.ld }; join '', @m; @@ -2761,6 +2781,25 @@ directories in LDLOADLIBS. Add -I$(PERL_ARCHLIB) -I$(PERL_LIB) to calls to xsubpp. +=head v4.16 June 18, 1995, by Tim Bunce + +Split test: target into test_static: and test_dynamic: with automatic +selection based on LINKTYPE. The test_static: target automatically +builds a local ./perl binary containing the extension and executes the +tests using that binary. This fixes problems that users were having +dealing with building and testing static extensions. It also simplifies +the process down to the standard: make + make test. + +MakeMaker no longer incorrectly considers a perlmain.c file to be part +of an extensions source files. The map_clean target is now invoked by +clean not realclean and now deletes MAP_TARGET but does not delete +Makefile (since that's done properly elsewhere). + +Since the staticmake section defines macros that the test target now +needs the test section is written into the makefile after the +staticmake section. The postamble section has been made last again, as +it should be. + =head1 TODO Needs more complete documentation. diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index e46b732e37..dbfb352ee5 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -6,7 +6,7 @@ xsubpp - compiler to convert Perl XS code into C code =head1 SYNOPSIS -B<xsubpp> [B<-C++>] [B<-except>] [B<-typemap typemap>] file.xs +B<xsubpp> [B<-C++>] [B<-except>] [B<-typemap typemap>]... file.xs =head1 DESCRIPTION @@ -156,21 +156,60 @@ When an error or warning message is printed C<xsubpp> will now attempt to identify the exact line in the C<.xs> file where the fault occurs. This can be achieved in the majority of cases. +=head2 1.8 + +Changes by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>, 6 June 1995. + +Accept backslash-newline as in C. Allow preprocessor directives +anywhere. Ignore whitespace in front of comments and on blank lines. + +=head2 1.9 + +Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 21 June 1995. + +=over 5 + +=item 1. + +Changed duplicate function error to a warning. + +=item 2. + +Changed the comment placed at the top of the C<.c> file to be more like +the comment used by MakeMaker. + +=item 3. + +When parsing the type for an XSUB parameter I<xsubpp> can now accept +definitions like this: + + char *fred + +i.e. the '*' is recognised as part of the type, rather than the first +character of the variable. + +=item 4. + +Fixed a problem with command line parsing - I<xsubpp> was not properly +detecting the case where there was no filename present on the command +line. + +=back + =head1 SEE ALSO -perl(1) +perl(1), perlapi(1) =cut -use FileHandle ; - # Global Constants -$XSUBPP_version = "1.7" ; +$XSUBPP_version = "1.9" ; $usage = "Usage: xsubpp [-C++] [-except] [-typemap typemap] file.xs\n"; -SWITCH: while ($ARGV[0] =~ s/^-//) { +SWITCH: while ($ARGV[0] =~ /^-/) { $flag = shift @ARGV; + $flag =~ s/^-// ; $spat = shift, next SWITCH if $flag eq 's'; $cplusplus = 1, next SWITCH if $flag eq 'C++'; $except = 1, next SWITCH if $flag eq 'except'; @@ -178,7 +217,7 @@ SWITCH: while ($ARGV[0] =~ s/^-//) { die $usage; } @ARGV == 1 or die $usage; -chop($pwd = `pwd`); +chomp($pwd = `pwd`); # Check for error message from VMS if ($pwd =~ /unrecognized command verb/) { $Is_VMS = 1; $pwd = $ENV{DEFAULT} } ($dir, $filename) = $ARGV[0] =~ m#(.*)/(.*)# @@ -197,6 +236,7 @@ sub TidyType # rationalise any '*' by joining them into bunches and removing whitespace s#\s*(\*+)\s*#$1#g; + s#(\*+)# $1 #g ; # change multiple whitespace into a single space s/\s+/ /g ; @@ -221,16 +261,16 @@ foreach $typemap (@tm) { unless -T $typemap ; open(TYPEMAP, $typemap) or warn ("Warning: could not open typemap file '$typemap': $!\n"), next; - $mode = Typemap; + $mode = 'Typemap'; $junk = "" ; $current = \$junk; while (<TYPEMAP>) { - next if /^#/; - if (/^INPUT\s*$/) { $mode = Input, next } - if (/^OUTPUT\s*$/) { $mode = Output, next } - if (/^TYPEMAP\s*$/) { $mode = Typemap, next } - if ($mode eq Typemap) { - chop; + next if /^\s*#/; + if (/^INPUT\s*$/) { $mode = 'Input'; next; } + if (/^OUTPUT\s*$/) { $mode = 'Output'; next; } + if (/^TYPEMAP\s*$/) { $mode = 'Typemap'; next; } + if ($mode eq 'Typemap') { + chomp; my $line = $_ ; TrimWhitespace($_) ; # skip blank lines and comment lines @@ -242,7 +282,7 @@ foreach $typemap (@tm) { TrimWhitespace($kind) ; $type_kind{TidyType("@words")} = $kind ; } - elsif ($mode eq Input) { + elsif ($mode eq 'Input') { if (/^\s/) { $$current .= $_; } @@ -271,7 +311,7 @@ foreach $key (keys %input_expr) { } sub Q { - local $text = shift; + my($text) = @_; $text =~ tr/#//d; $text =~ s/\[\[/{/g; $text =~ s/\]\]/}/g; @@ -281,77 +321,85 @@ sub Q { open(F, $filename) or die "cannot open $filename: $!\n"; # Identify the version of xsubpp used -$TimeStamp = localtime ; print <<EOM ; -/* - * This file was generated automatically by xsubpp version $XSUBPP_version - * from $filename on $TimeStamp +/* + * This file was generated automatically by xsubpp version $XSUBPP_version from the + * contents of $filename. Don't edit this file, edit $filename instead. + * + * ANY CHANGES MADE HERE WILL BE LOST! * */ - + EOM while (<F>) { - last if ($Module, $foo, $Package, $foo1, $Prefix) = - /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/; + last if ($Module, $Package, $Prefix) = + /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/; print $_; } -exit 0 if $_ eq ""; -$lastline = $_; +&Exit unless defined $_; + +my $lastline = $_; +my $lastline_no = $.; + +# Read next xsub into @line from ($lastline, <F>). sub fetch_para { # parse paragraph @line = (); @line_no = () ; - if ($lastline ne "") { - if ($lastline =~ - /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/) { - $Module = $1; - $foo = $2; - $Package = $3; - $foo1 = $4; - $Prefix = $5; - ($Module_cname = $Module) =~ s/\W/_/g; - ($Packid = $Package) =~ s/:/_/g; - $Packprefix = $Package; - $Packprefix .= "::" if defined $Packprefix && $Packprefix ne ""; - while (<F>) { - chop; - next if /^#/ && - !/^#[ \t]*(if|ifdef|ifndef|else|elif|endif|define|undef)\b/; - last if /^\S/; - } - push(@line, $_), push(@line_no, input_line_number F) if $_ ne ""; - } - else { - push(@line, $lastline); - push(@line_no, $lastline_no) ; - } + return 0 unless defined $lastline; + + if ($lastline =~ + /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) { + $Module = $1; + $Package = $2; + $Prefix = $3; + ($Module_cname = $Module) =~ s/\W/_/g; + ($Packid = $Package) =~ s/:/_/g; + $Packprefix = $Package; + $Packprefix .= "::" if defined $Packprefix && $Packprefix ne ""; $lastline = ""; - while (<F>) { - next if /^#/ && - !/^#[ \t]*(if|ifdef|ifndef|else|elif|endif|define|undef)\b/; - chop; - if (/^\S/ && @line && $line[-1] eq "") { - $lastline = $_; - $lastline_no = input_line_number F ; - last; - } - else { - push(@line, $_); - push(@line_no, input_line_number F) ; - } + } + + for(;;) { + if ($lastline !~ /^\s*#/ || + $lastline =~ /^#[ \t]*((if|ifn?def|else|elif|endif|define|undef|pragma)\b|include\s*["<].*[>"])/) { + last if $lastline =~ /^\S/ && @line && $line[-1] eq ""; + push(@line, $lastline); + push(@line_no, $lastline_no) ; } - pop(@line), pop(@line_no) while @line && $line[-1] =~ /^\s*$/; + + # Read next line and continuation lines + last unless defined($lastline = <F>); + $lastline_no = $.; + my $tmp_line; + $lastline .= $tmp_line + while ($lastline =~ /\\\n$/ && defined($tmp_line = <F>)); + + # chomp $lastline; + $lastline =~ s/^\s+$//; } - $PPCODE = grep(/PPCODE:/, @line); - scalar @line; + pop(@line), pop(@line_no) while @line && $line[-1] eq ""; + $PPCODE = grep(/^\s*PPCODE\s*:/, @line); + 1; } PARAGRAPH: while (&fetch_para) { + # Print initial preprocessor statements and blank lines + print shift(@line), "\n" + while @line && $line[0] !~ /^[^\#]/; + + next PARAGRAPH unless @line; + + death ("Code is not inside a function") + if $line[0] =~ /^\s/; + # initialize info arrays + # my(%args_match,%var_types,%var_addr); + # my($class,$static,$elipsis,$wantRETVAL,%arg_list); undef(%args_match); undef(%var_types); undef(%var_addr); @@ -363,9 +411,9 @@ while (&fetch_para) { undef(%arg_list) ; # extract return type, function name and arguments - $ret_type = TidyType(shift(@line)); + my($ret_type) = TidyType(shift(@line)); - if ($ret_type =~ /^BOOT:/) { + if ($ret_type =~ /^BOOT\s*:/) { push (@BootCode, @line, "", "") ; next PARAGRAPH ; } @@ -391,7 +439,7 @@ while (&fetch_para) { ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/; # Check for duplicate function definition - blurt("Error: ignoring duplicate function definition '$func_name'"), next PARAGRAPH + Warn("Warning: duplicate function definition '$func_name' detected") if defined $Func_name{"${Packid}_$func_name"} ; $Func_name{"${Packid}_$func_name"} ++ ; @@ -534,6 +582,15 @@ EOF blurt("Error: invalid argument declaration '$line'"), next unless @words >= 2 ; my $var_name = pop @words ; + + # move any *'s from the variable name to the type + push(@words, $1) + if $var_name =~ s/^(\*+)// ; + + # check that removing the *'s hasn't eaten the whole variable + blurt("Error: invalid argument declaration '$line'"), next + if $var_name eq '' ; + my $var_type = "@words" ; # catch many errors similar to: SV<tab>* name @@ -593,7 +650,7 @@ EOF $args_match{"RETVAL"} = 0; $var_types{"RETVAL"} = $ret_type; } - if (/^\s*PPCODE:/) { + if (/^\s*PPCODE\s*:/) { print $deferred; while (@line) { $_ = shift(@line); @@ -602,7 +659,7 @@ EOF print "$_\n"; } print "\tPUTBACK;\n\treturn;\n"; - } elsif (/^\s*CODE:/) { + } elsif (/^\s*CODE\s*:/) { print $deferred; while (@line) { $_ = shift(@line); @@ -618,6 +675,7 @@ EOF print "\n\t"; if ($ret_type ne "void") { print "RETVAL = "; + $wantRETVAL = 1; } if (defined($static)) { if ($func_name =~ /^new/) { @@ -629,11 +687,9 @@ EOF } elsif (defined($class)) { print "THIS->"; } - if (defined($spat) && $func_name =~ /^($spat)(.*)$/) { - $func_name = $2; - } + $func_name =~ s/^($spat)// + if defined($spat); print "$func_name($func_args);\n"; - $wantRETVAL = 1 unless $ret_type eq "void"; } } @@ -644,7 +700,7 @@ EOF my %outargs ; while (@line) { $_ = shift(@line); - last if /^\s*CLEANUP|CASE\s*:/; + last if /^\s*(CLEANUP|CASE)\s*:/; TrimWhitespace($_) ; next if /^$/ ; my ($outarg, $outcode) = /^(\S+)\s*(.*)/ ; @@ -746,9 +802,14 @@ if (@BootCode) print " /* End of Initialisation Section */\n\n" ; } -print " ST(0) = &sv_yes;\n"; -print " XSRETURN(1);\n"; -print "}\n"; +print Q<<"EOF";; +# ST(0) = &sv_yes; +# XSRETURN(1); +#]] +EOF + +&Exit; + sub output_init { local($type, $num, $init) = @_; @@ -874,7 +935,7 @@ sub generate_output { } sub map_type { - local($type) = @_; + my($type) = @_; $type =~ s/:/_/g; if ($type =~ /^array\(([^,]*),(.*)\)/) { @@ -884,7 +945,10 @@ sub map_type { } } + +sub Exit { # If this is VMS, the exit status has meaning to the shell, so we # use a predictable value (SS$_Abort) rather than an arbitrary # number. -exit ($Is_VMS ? 44 : $errors) ; + exit ($Is_VMS ? 44 : $errors) ; +} diff --git a/lib/lib.pm b/lib/lib.pm new file mode 100644 index 0000000000..a0fe89b13d --- /dev/null +++ b/lib/lib.pm @@ -0,0 +1,103 @@ +package lib; + +@ORIG_INC = (); # (avoid typo warning) +@ORIG_INC = @INC; # take a handy copy of 'original' value + + +sub import { + shift; + unshift(@INC, @_); +} + + +sub unimport { + shift; + my $mode = shift if $_[0] =~ m/^:[A-Z]+/; + + my %names; + foreach(@_) { ++$names{$_} }; + + if ($mode and $mode eq ':ALL') { + # Remove ALL instances of each named directory. + @INC = grep { !exists $names{$_} } @INC; + } else { + # Remove INITIAL instance(s) of each named directory. + @INC = grep { --$names{$_} < 0 } @INC; + } +} + +__END__ + +=head1 NAME + +lib - manipulate @INC at compile time + +=head1 SYNOPSIS + + use lib LIST; + + no lib LIST; + +=head1 DESCRIPTION + +This is a small simple module which simplifies the manipulation of @INC +at compile time. + +It is typically used to add extra directories to perl's search path so +that later C<use> or C<require> statements will find modules which are +not located on perl's default search path. + + +=head2 ADDING DIRECTORIES TO @INC + +The parameters to C<use lib> are added to the start of the perl search +path. Saying + + use lib LIST; + +is the same as saying + + BEGIN { unshift(@INC, LIST) } + + +=head2 DELETING DIRECTORIES FROM @INC + +You should normally only add directories to @INC. If you need to +delete directories from @INC take care to only delete those which you +added yourself or which you are certain are not needed by other modules +in your script. Other modules may have added directories which they +need for correct operation. + +By default the C<no lib> statement deletes the I<first> instance of +each named directory from @INC. To delete multiple instances of the +same name from @INC you can specify the name multiple times. + +To delete I<all> instances of I<all> the specified names from @INC you can +specify ':ALL' as the first parameter of C<no lib>. For example: + + no lib qw(:ALL .); + + +=head2 RESTORING ORIGINAL @INC + +When the lib module is first loaded it records the current value of @INC +in an array C<@lib::ORIG_INC>. To restore @INC to that value you +can say either + + @INC = @lib::ORIG_INC; + +or + + no lib @INC; + use lib @lib::ORIG_INC; + +=head1 SEE ALSO + +AddINC - optional module which deals with paths relative to the source file. + +=head1 AUTHOR + +Tim Bunce, 2nd June 1995. + +=cut + @@ -18,6 +18,18 @@ #include "EXTERN.h" #include "perl.h" +#ifdef USE_OP_MASK +/* + * In the following definition, the ", (OP *) op" is just to make the compiler + * think the expression is of the right type: croak actually does a longjmp. + */ +#define CHECKOP(type,op) ((op_mask && op_mask[type]) ? \ + (croak("%s trapped by operation mask", op_name[type]), (OP *) op) \ + : (*check[type])((OP *) op)) +#else +#define CHECKOP(type,op) (*check[type])(op) +#endif /* USE_OP_MASK */ + static I32 list_assignment _((OP *op)); static OP *bad_type _((I32 n, char *t, OP *op, OP *kid)); static OP *modkids _((OP *op, I32 type)); @@ -410,7 +422,7 @@ OP *op; /* FALL THROUGH */ case OP_PUSHRE: case OP_MATCH: - regfree(cPMOP->op_pmregexp); + pregfree(cPMOP->op_pmregexp); SvREFCNT_dec(cPMOP->op_pmshort); break; default: @@ -1441,7 +1453,7 @@ OP* op; op->op_ppaddr = ppaddr[type]; op->op_flags |= flags; - op = (*check[type])(op); + op = CHECKOP(type, op); if (op->op_type != type) return op; @@ -1617,7 +1629,7 @@ I32 flags; scalar(op); if (opargs[type] & OA_TARGET) op->op_targ = pad_alloc(type, SVs_PADTMP); - return (*check[type])(op); + return CHECKOP(type, op); } OP * @@ -1640,7 +1652,7 @@ OP* first; unop->op_flags = flags | OPf_KIDS; unop->op_private = 1; - unop = (UNOP*)(*check[type])((OP*)unop); + unop = (UNOP*) CHECKOP(type, unop); if (unop->op_next) return (OP*)unop; @@ -1673,7 +1685,7 @@ OP* last; first->op_sibling = last; } - binop = (BINOP*)(*check[type])((OP*)binop); + binop = (BINOP*)CHECKOP(type, binop); if (binop->op_next) return (OP*)binop; @@ -1794,7 +1806,7 @@ OP *repl; p = SvPV(pat, plen); pm->op_pmflags |= PMf_SKIPWHITE; } - pm->op_pmregexp = regcomp(p, p + plen, pm); + pm->op_pmregexp = pregcomp(p, p + plen, pm); if (strEQ("\\s+", pm->op_pmregexp->precomp)) pm->op_pmflags |= PMf_WHITE; hoistmust(pm); @@ -1905,7 +1917,7 @@ SV *sv; scalar((OP*)svop); if (opargs[type] & OA_TARGET) svop->op_targ = pad_alloc(type, SVs_PADTMP); - return (*check[type])((OP*)svop); + return CHECKOP(type, svop); } OP * @@ -1925,7 +1937,7 @@ GV *gv; scalar((OP*)gvop); if (opargs[type] & OA_TARGET) gvop->op_targ = pad_alloc(type, SVs_PADTMP); - return (*check[type])((OP*)gvop); + return CHECKOP(type, gvop); } OP * @@ -1945,7 +1957,7 @@ char *pv; scalar((OP*)pvop); if (opargs[type] & OA_TARGET) pvop->op_targ = pad_alloc(type, SVs_PADTMP); - return (*check[type])((OP*)pvop); + return CHECKOP(type, pvop); } OP * @@ -1967,7 +1979,7 @@ OP *cont; scalar((OP*)cvop); if (opargs[type] & OA_TARGET) cvop->op_targ = pad_alloc(type, SVs_PADTMP); - return (*check[type])((OP*)cvop); + return CHECKOP(type, cvop); } void @@ -41,7 +41,7 @@ typedef U16 PADOFFSET; U8 op_flags; \ U8 op_private; -#define GIMME (op->op_flags & OPf_KNOW ? op->op_flags & OPf_LIST : cxstack[cxstack_ix].blk_gimme & G_ARRAY) +#define GIMME (op->op_flags & OPf_KNOW ? op->op_flags & OPf_LIST : dowantarray()) /* Public flags */ #define OPf_LIST 1 /* Do operator in list context. */ @@ -996,7 +996,7 @@ char *s; return s; case 'v': printf("\nThis is perl, version %s\n\n",patchlevel); - fputs("\tUnofficial patchlevel 1l.\n",stdout); + fputs("\tUnofficial patchlevel 1m.\n",stdout); fputs("\nCopyright 1987-1994, Larry Wall\n",stdout); #ifdef MSDOS fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n", @@ -1294,6 +1294,7 @@ IEXT bool Idirty; /* In the middle of tearing things down? */ IEXT U8 Ilocalizing; /* are we processing a local() list? */ IEXT bool Itainted; /* using variables controlled by $< */ IEXT bool Itainting; /* doing taint checks */ +IEXT char * Iop_mask IINIT(NULL); /* masked operations for safe evals */ /* trace state */ IEXT I32 Idlevel; diff --git a/perldoc.SH b/perldoc.SH index f184d9323f..54d4bfcfa5 100644 --- a/perldoc.SH +++ b/perldoc.SH @@ -97,7 +97,7 @@ if(@ARGV<1) { die <<EOF; Usage: $0 [-h] PageName|ModuleName -We suggest you use C<perldoc perldoc> to get aquainted +We suggest you use "perldoc perldoc" to get aquainted with the system. EOF } diff --git a/pod/perl.pod b/pod/perl.pod index 1f54df73a3..bab8a91cc0 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -31,6 +31,8 @@ of sections: perlguts Perl internal functions for those doing extensions perlcall Perl calling conventions from C perlovl Perl overloading semantics + perlembed Perl how to embed perl in your C or C++ app + perlpod Perl plain old documentation perlbook Perl book information (If you're intending to read these straight through for the first time, diff --git a/pod/pod2html.SH b/pod/pod2html.SH index 6aaa5d20e0..af5161377d 100755 --- a/pod/pod2html.SH +++ b/pod/pod2html.SH @@ -92,7 +92,7 @@ for $count (0,1){ <!-- \$Log\$ --> <HTML> HTML__EOQ - <TITLE> \U$pod\E </TITLE> + <TITLE>\U$pod\E</TITLE> HTML__EOQQ } @@ -341,11 +341,11 @@ sub picrefs { } } if ($char =~ /[IF]/) { - return "<EM> $bigkey </EM>"; + return "<EM>$bigkey</EM>"; } elsif($char =~ /C/) { - return "<CODE> $bigkey </CODE>"; + return "<CODE>$bigkey</CODE>"; } else { - return "<STRONG> $bigkey </STRONG>"; + return "<STRONG>$bigkey</STRONG>"; } } @@ -380,18 +380,18 @@ sub lrefs { $item =~ s/\(\)$//; if (!$item) { if (!defined $section && defined $Podnames{$page}) { - return "\n$type$page.html\">\nthe <EM> $page </EM> manpage<\/A>\n"; + return "\n$type$page.html\">\nthe <EM>$page</EM> manpage<\/A>\n"; } else { (warn "Bizarre entry $page/$item") if $Debug; - return "the <EM> $_[0] </EM> manpage\n"; + return "the <EM>$_[0]</EM> manpage\n"; } } if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) { - $text = "<EM> $item </EM>"; + $text = "<EM>$item</EM>"; $ref = "Headers"; } else { - $text = "<EM> $item </EM>"; + $text = "<EM>$item</EM>"; $ref = "Items"; } for $podname ($pod, @inclusions){ @@ -429,7 +429,7 @@ sub varrefs { } } Debug( "vars", "bummer, $var not a var"); - return "<STRONG> $var </STRONG>"; + return "<STRONG>$var</STRONG>"; } sub gensym { @@ -3391,7 +3391,7 @@ PP(pp_split) else { maxiters += (strend - s) * rx->nparens; while (s < strend && --limit && - regexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) { + pregexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) { if (rx->subbase && rx->subbase != orig) { m = s; @@ -68,11 +68,11 @@ PP(pp_regcomp) { t = SvPV(tmpstr, len); if (pm->op_pmregexp) { - regfree(pm->op_pmregexp); + pregfree(pm->op_pmregexp); pm->op_pmregexp = Null(REGEXP*); /* crucial if regcomp aborts */ } - pm->op_pmregexp = regcomp(t, t + len, pm); + pm->op_pmregexp = pregcomp(t, t + len, pm); if (!pm->op_pmregexp->prelen && curpm) pm = curpm; @@ -108,7 +108,7 @@ PP(pp_substcont) rx->subbase = cx->sb_subbase; /* Are we done */ - if (cx->sb_once || !regexec(rx, s, cx->sb_strend, orig, + if (cx->sb_once || !pregexec(rx, s, cx->sb_strend, orig, s == m, Nullsv, cx->sb_safebase)) { SV *targ = cx->sb_targ; @@ -780,6 +780,21 @@ char *label; return i; } +I32 +dowantarray() +{ + I32 cxix; + + cxix = dopoptosub(cxstack_ix); + if (cxix < 0) + return G_SCALAR; + + if (cxstack[cxix].blk_gimme == G_ARRAY) + return G_ARRAY; + else + return G_SCALAR; +} + static I32 dopoptosub(startingblock) I32 startingblock; @@ -2045,6 +2060,11 @@ PP(pp_require) ENTER; SAVETMPS; lex_start(sv_2mortal(newSVpv("",0))); + if (rsfp_filters){ + save_aptr(&rsfp_filters); + rsfp_filters = NULL; + } + rsfp = tryrsfp; name = savepv(name); SAVEFREEPV(name); @@ -752,7 +752,7 @@ play_it_again: pm->op_pmshort = Nullsv; /* opt is being useless */ } } - if (regexec(rx, s, strend, truebase, minmatch, + if (pregexec(rx, s, strend, truebase, minmatch, SvSCREAM(TARG) ? TARG : Nullsv, safebase)) { curpm = pm; @@ -1311,7 +1311,7 @@ PP(pp_subst) c = SvPV(dstr, clen); if (clen <= rx->minlen) { /* can do inplace substitution */ - if (regexec(rx, s, strend, orig, 0, + if (pregexec(rx, s, strend, orig, 0, SvSCREAM(TARG) ? TARG : Nullsv, safebase)) { if (force_on_match) { force_on_match = 0; @@ -1392,7 +1392,7 @@ PP(pp_subst) d += clen; } s = rx->endp[0]; - } while (regexec(rx, s, strend, orig, s == m, + } while (pregexec(rx, s, strend, orig, s == m, Nullsv, TRUE)); /* (don't match same null twice) */ if (s != d) { i = strend - s; @@ -1410,7 +1410,7 @@ PP(pp_subst) } else c = Nullch; - if (regexec(rx, s, strend, orig, 0, + if (pregexec(rx, s, strend, orig, 0, SvSCREAM(TARG) ? TARG : Nullsv, safebase)) { long_way: if (force_on_match) { @@ -1443,7 +1443,7 @@ PP(pp_subst) sv_catpvn(dstr, c, clen); if (once) break; - } while (regexec(rx, s, strend, orig, s == m, Nullsv, + } while (pregexec(rx, s, strend, orig, s == m, Nullsv, safebase)); sv_catpvn(dstr, s, strend - s); @@ -95,6 +95,7 @@ long do_tell _((GV* gv)); I32 do_trans _((SV* sv, OP* arg)); void do_vecset _((SV* sv)); void do_vop _((I32 optype, SV* sv, SV* left, SV* right)); +I32 dowantarray _((void)); void dump_all _((void)); void dump_eval _((void)); #ifdef DUMP_FDS /* See util.c */ @@ -323,12 +324,12 @@ void pop_scope _((void)); OP* prepend_elem _((I32 optype, OP* head, OP* tail)); void push_return _((OP* op)); void push_scope _((void)); -regexp* regcomp _((char* exp, char* xend, PMOP* pm)); +regexp* pregcomp _((char* exp, char* xend, PMOP* pm)); OP* ref _((OP* op, I32 type)); OP* refkids _((OP* op, I32 type)); void regdump _((regexp* r)); -I32 regexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, I32 safebase)); -void regfree _((struct regexp* r)); +I32 pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, I32 safebase)); +void pregfree _((struct regexp* r)); char* regnext _((char* p)); char* regprop _((char* op)); void repeatcpy _((char* to, char* from, I32 len, I32 count)); @@ -14,9 +14,14 @@ * blame Henry for some of the lack of readability. */ +/* The names of the functions have been changed from regcomp and + * regexec to pregcomp and pregexec in order to avoid conflicts + * with the POSIX routines of the same names. +*/ + /*SUPPRESS 112*/ /* - * regcomp and regexec -- regsub and regerror are not used in perl + * pregcomp and pregexec -- regsub and regerror are not used in perl * * Copyright (c) 1986 by University of Toronto. * Written by Henry Spencer. Not derived from licensed software. @@ -88,7 +93,7 @@ #define TRYAGAIN 0x8 /* Weeded out a declaration. */ /* - * Forward declarations for regcomp()'s friends. + * Forward declarations for pregcomp()'s friends. */ static char *reg _((I32, I32 *)); @@ -107,7 +112,7 @@ static void regtail _((char *, char *)); static char* nextchar _((void)); /* - - regcomp - compile a regular expression into internal code + - pregcomp - compile a regular expression into internal code * * We can't allocate space until we know how big the compiled form will be, * but we can't compile it (and thus know how big it is) until we've got a @@ -122,7 +127,7 @@ static char* nextchar _((void)); * of the structure of the compiled regexp. [I'll say.] */ regexp * -regcomp(exp,xend,pm) +pregcomp(exp,xend,pm) char* exp; char* xend; PMOP* pm; @@ -1608,7 +1613,7 @@ char *op; #endif /* DEBUGGING */ void -regfree(r) +pregfree(r) struct regexp *r; { if (!r) @@ -16,10 +16,10 @@ * Regstart and reganch permit very fast decisions on suitable starting points * for a match, cutting down the work a lot. Regmust permits fast rejection * of lines that cannot possibly match. The regmust tests are costly enough - * that regcomp() supplies a regmust only if the r.e. contains something + * that pregcomp() supplies a regmust only if the r.e. contains something * potentially expensive (at present, the only such thing detected is * or + * at the start of the r.e., which can involve a lot of backup). Regmlen is - * supplied because the test in regexec() needs it and regcomp() is computing + * supplied because the test in pregexec() needs it and pregcomp() is computing * it anyway. * [regmust is now supplied always. The tests that use regmust have a * heuristic that disables the test if it usually matches.] @@ -14,9 +14,14 @@ * blame Henry for some of the lack of readability. */ +/* The names of the functions have been changed from regcomp and + * regexec to pregcomp and pregexec in order to avoid conflicts + * with the POSIX routines of the same names. +*/ + /*SUPPRESS 112*/ /* - * regcomp and regexec -- regsub and regerror are not used in perl + * pregcomp and pregexec -- regsub and regerror are not used in perl * * Copyright (c) 1986 by University of Toronto. * Written by Henry Spencer. Not derived from licensed software. @@ -132,7 +137,7 @@ regcppop() #define regcpblow(cp) leave_scope(cp) /* - * regexec and friends + * pregexec and friends */ /* @@ -144,10 +149,10 @@ static I32 regrepeat _((char *p, I32 max)); static I32 regtry _((regexp *prog, char *startpos)); /* - - regexec - match a regexp against a string + - pregexec - match a regexp against a string */ I32 -regexec(prog, stringarg, strend, strbeg, minend, screamer, safebase) +pregexec(prog, stringarg, strend, strbeg, minend, screamer, safebase) register regexp *prog; char *stringarg; register char *strend; /* pointer to null at end of string */ @@ -1018,7 +1018,8 @@ filter_add(funcp, datasv) IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */ if (filter_debug) warn("filter_add func %lx (%s)", funcp, SvPV(datasv,na)); - av_push(rsfp_filters, datasv); + av_unshift(rsfp_filters, 1); + av_store(rsfp_filters, 0, datasv) ; return(datasv); } @@ -1033,8 +1034,10 @@ filter_del(funcp) if (!rsfp_filters || AvFILL(rsfp_filters)<0) return; /* if filter is on top of stack (usual case) just pop it off */ - if (IoDIRP(FILTER_DATA(AvFILL(rsfp_filters))) == (void*)funcp){ - sv_free(av_pop(rsfp_filters)); + if (IoDIRP(FILTER_DATA(0)) == (void*)funcp){ + /* sv_free(av_pop(rsfp_filters)); */ + sv_free(av_shift(rsfp_filters)); + return; } /* we need to search for the correct entry and clear it */ @@ -1051,12 +1054,12 @@ filter_read(idx, buf_sv, maxlen) { filter_t funcp; SV *datasv = NULL; + if (!rsfp_filters) return -1; if (idx > AvFILL(rsfp_filters)){ /* Any more filters? */ /* Provide a default input filter to make life easy. */ /* Note that we append to the line. This is handy. */ - /* We ignore maxlen here */ if (filter_debug) warn("filter_read %d: from rsfp\n", idx); if (maxlen) { @@ -2417,12 +2420,18 @@ yylex() TERM(THING); } + case KEY___DATA__: case KEY___END__: { GV *gv; /*SUPPRESS 560*/ - if (!in_eval) { - gv = gv_fetchpv("main::DATA",TRUE, SVt_PVIO); + if (!in_eval || tokenbuf[2] == 'D') { + char dname[256]; + char *pname = "main"; + if (tokenbuf[2] == 'D') + pname = HvNAME(curstash ? curstash : defstash); + sprintf(dname,"%s::DATA", pname); + gv = gv_fetchpv(dname,TRUE, SVt_PVIO); SvMULTI_on(gv); if (!GvIO(gv)) GvIOp(gv) = newIO(); @@ -3308,6 +3317,7 @@ I32 len; if (d[1] == '_') { if (strEQ(d,"__LINE__")) return -KEY___LINE__; if (strEQ(d,"__FILE__")) return -KEY___FILE__; + if (strEQ(d,"__DATA__")) return KEY___DATA__; if (strEQ(d,"__END__")) return KEY___END__; } break; diff --git a/x2p/util.c b/x2p/util.c index aa8a7a3a7e..5c3554b7e3 100644 --- a/x2p/util.c +++ b/x2p/util.c @@ -190,7 +190,7 @@ int newlen; } /*VARARGS1*/ -int +void croak(pat,a1,a2,a3,a4) char *pat; int a1,a2,a3,a4; @@ -200,7 +200,7 @@ int a1,a2,a3,a4; } /*VARARGS1*/ -int +void fatal(pat,a1,a2,a3,a4) char *pat; int a1,a2,a3,a4; diff --git a/x2p/util.h b/x2p/util.h index f3ee2a0417..35f796121c 100644 --- a/x2p/util.h +++ b/x2p/util.h @@ -24,10 +24,10 @@ int makedir(); char * cpy2 _(( char *to, char *from, int delim )); char * cpytill _(( char *to, char *from, int delim )); -int croak _(( char *pat, int a1, int a2, int a3, int a4 )); +void croak _(( char *pat, int a1, int a2, int a3, int a4 )); void growstr _(( char **strptr, int *curlen, int newlen )); char * instr _(( char *big, char *little )); -int Myfatal (); +void Myfatal (); char * safecpy _(( char *to, char *from, int len )); char * savestr _(( char *str )); void warn (); |