summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTim Bunce <TimBunce@ig.ac.uk>1998-04-27 20:20:21 +0000
committerTim Bunce <TimBunce@ig.ac.uk>1998-04-27 20:20:21 +0000
commitd025ca46400c7512aecdac529e5947db11ee4d09 (patch)
tree9153cc96dbec6e58348e312c4f8afe3c33977b9b
parent01b98041a151cfef9042b58f2d2a3dcaecd28e58 (diff)
downloadperl-d025ca46400c7512aecdac529e5947db11ee4d09.tar.gz
[difference between patch application from Change 897 and Change 904]
------ CORE LANGUAGE ------ Title: "Protect join() against double reads on undef and SvGMAGICALs" From: Chip Salzenberg <chip@perlsupport.com>, Tim Bunce <Tim.Bunce@ig.co.uk> Msg-ID: <19980424080630.D13985@perl.org> Files: doop.c Title: "fixes for various noises under PERL_DESTRUCT_LEVEL" From: Gurusamy Sarathy <gsar@engin.umich.edu> Msg-ID: <199804231926.PAA23969@aatma.engin.umich.edu> Files: perl.c Title: "Fix nice_chunk memory leak" From: Gurusamy Sarathy <gsar@engin.umich.edu> Msg-ID: <199804052347.TAA15699@aatma.engin.umich.edu> Files: sv.c ------ DOCUMENTATION ------ Title: "perlcall is Perl from C, not C from Perl" From: Steve A Fink <sfink@cs.berkeley.edu> Files: pod/perlembed.pod Title: "(repost) new text for perlsec", "new text for perlsec" From: Tom Phoenix <rootbeer@teleport.com> Msg-ID: <Pine.GSO.3.96.980423161605.5518N-100000@user2.teleport.com> Files: pod/perlsec.pod ------ EXTENSIONS ------ Title: "NDBM_File man page needs Fcntl" From: "Danny R. Faught" <faught@mailhost.rsn.hp.com> Msg-ID: <199707011500.IAA00601@palrel3.hp.com> Files: ext/NDBM_File/NDBM_File.pm ------ LIBRARY ------ Title: "Documentation discrepancy: pragmatic modules" From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, h.sanden@elsevier.nl (Hugo van der Sanden) Msg-ID: <199804221525.RAA12695@dorlas.elsevier.nl>, <E0ySPhk-00034f-00@taurus.cus.cam.ac.uk> Files: lib/strict.pm lib/subs.pm lib/vars.pm ------ PORTABILITY - GENERAL ------ Title: "Updated hints file for svr4" From: Andy Dougherty <doughera@lafcol.lafayette.edu> Msg-ID: <Pine.SUN.3.96.980423110522.26621A-100000@newton.phys> Files: hints/svr4.sh Title: "Pumpkin update -- shared libperl.so location" From: Andy Dougherty <doughera@lafcol.lafayette.edu> Msg-ID: <Pine.SUN.3.96.980424115837.6222A-100000@newton.phys> Files: Porting/pumpkin.pod ------ UTILITIES ------ Title: "Major update to h2ph.PL" From: Billy <wdconsta@cs.adelaide.edu.au> Msg-ID: <Pine.SV4.3.93.980424031837.20782A-200000@ermintrude.teaching.cs.adelaide.edu.au> Files: utils/h2ph.PL p4raw-link: @897 on //depot/maint-5.004/perl: f06f9b6fc5a686f0169ee2a91b32d5e7125a44ae p4raw-id: //depot/maint-5.004/perl@904
-rw-r--r--Porting/pumpkin.pod122
-rw-r--r--doop.c2
-rw-r--r--ext/NDBM_File/NDBM_File.pm3
-rw-r--r--hints/svr4.sh118
-rw-r--r--lib/strict.pm2
-rw-r--r--lib/subs.pm2
-rw-r--r--lib/vars.pm2
-rw-r--r--perl.c5
-rw-r--r--pod/perlembed.pod2
-rw-r--r--pod/perlfunc.pod8
-rw-r--r--pp_sys.c2
-rw-r--r--utils/h2ph.PL190
12 files changed, 336 insertions, 122 deletions
diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod
index 6706c6c3c4..8381901d86 100644
--- a/Porting/pumpkin.pod
+++ b/Porting/pumpkin.pod
@@ -217,9 +217,11 @@ patch these directly; patch the data files instead.
F<Configure> and F<config_h.SH> are also automatically generated by
B<metaconfig>. In general, you should patch the metaconfig units
-instead of patching these files directly. However, minor changes to
+instead of patching these files directly. However, very minor changes to
F<Configure> may be made in between major sync-ups with the metaconfig
-units, which tends to be complicated operations.
+units, which tends to be complicated operations. But be careful, this
+can quickly spiral out of control. Running metaconfig is not really
+hard.
=head1 How to Make a Distribution
@@ -467,6 +469,23 @@ ought to go in the Changes file or whether they ought to be available
separately in the patch file (or both). There is no disagreement that
detailed descriptions ought to be easily available somewhere.
+=head2 Todo
+
+The F<Todo> file contains a roughly-catgorized unordered list of
+aspects of Perl that could use enhancement, features that could be
+added, areas that could be cleaned up, and so on. During your term as
+pumpkin-holder, you will probably address some of these issues, and
+perhaps identify others which, while you decide not to address them
+this time around, may be tackled in the future. Update the file
+reflect the situation as it stands when you hand over the pumpkin.
+
+You might like, early in your pumpkin-holding career, to see if you
+can find champions for partiticular issues on the to-do list: an issue
+owned is an issue more likely to be resolved.
+
+There are also some more porting-specific L<Todo> items later in this
+file.
+
=head2 OS/2-specific updates
In the os2 directory is F<diff.configure>, a set of OS/2-specific
@@ -1030,6 +1049,62 @@ distribution modules. If you do
then perl.c will put /my/override ahead of ARCHLIB and PRIVLIB.
+=head2 Shared libperl.so location
+
+Why isn't the shared libperl.so installed in /usr/lib/ along
+with "all the other" shared libraries? Instead, it is installed
+in $archlib, which is typically something like
+
+ /usr/local/lib/perl5/archname/5.00404
+
+and is architecture- and version-specific.
+
+The basic reason why a shared libperl.so gets put in $archlib is so that
+you can have more than one version of perl on the system at the same time,
+and have each refer to its own libperl.so.
+
+Three examples might help. All of these work now; none would work if you
+put libperl.so in /usr/lib.
+
+=over
+
+=item 1.
+
+Suppose you want to have both threaded and non-threaded perl versions
+around. Configure will name both perl libraries "libperl.so" (so that
+you can link to them with -lperl). The perl binaries tell them apart
+by having looking in the appropriate $archlib directories.
+
+=item 2.
+
+Suppose you have perl5.004_04 installed and you want to try to compile
+it again, perhaps with different options or after applying a patch.
+If you already have libperl.so installed in /usr/lib/, then it may be
+either difficult or impossible to get ld.so to find the new libperl.so
+that you're trying to build. If, instead, libperl.so is tucked away in
+$archlib, then you can always just change $archlib in the current perl
+you're trying to build so that ld.so won't find your old libperl.so.
+(The INSTALL file suggests you do this when building a debugging perl.)
+
+=item 3.
+
+The shared perl library is not a "well-behaved" shared library with
+proper major and minor version numbers, so you can't necessarily
+have perl5.004_04 and perl5.004_05 installed simultaneously. Suppose
+perl5.004_04 were to install /usr/lib/libperl.so.4.4, and perl5.004_05
+were to install /usr/lib/libperl.so.4.5. Now, when you try to run
+perl5.004_04, ld.so might try to load libperl.so.4.5, since it has
+the right "major version" number. If this works at all, it almost
+certainly defeats the reason for keeping perl5.004_04 around. Worse,
+with development subversions, you certaily can't guarantee that
+libperl.so.4.4 and libperl.so.4.55 will be compatible.
+
+Anyway, all this leads to quite obscure failures that are sure to drive
+casual users crazy. Even experienced users will get confused :-). Upon
+reflection, I'd say leave libperl.so in $archlib.
+
+=back
+
=head1 Upload Your Work to CPAN
You can upload your work to CPAN if you have a CPAN id. Check out
@@ -1090,6 +1165,47 @@ Configure so that most of them aren't needed.
Some of the hint file information (particularly dynamic loading stuff)
ought to be fed back into the main metaconfig distribution.
+=item Catch GNU Libc "Stub" functions
+
+Some functions (such as lchown()) are present in libc, but are
+unimplmented. That is, they always fail and set errno=ENOSYS.
+
+Thomas Bushnell provided the following sample code and the explanation
+that follows:
+
+ /* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char FOO(); below. */
+ #include <assert.h>
+ /* Override any gcc2 internal prototype to avoid an error. */
+ /* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+ char FOO();
+
+ int main() {
+
+ /* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+ #if defined (__stub_FOO) || defined (__stub___FOO)
+ choke me
+ #else
+ FOO();
+ #endif
+
+ ; return 0; }
+
+The choice of <assert.h> is essentially arbitrary. The GNU libc
+macros are found in <gnu/stubs.h>. You can include that file instead
+of <assert.h> (which itself includes <gnu/stubs.h>) if you test for
+its existence first. <assert.h> is assumed to exist on every system,
+which is why it's used here. Any GNU libc header file will include
+the stubs macros. If either __stub_NAME or __stub___NAME is defined,
+then the function doesn't actually exist. Tests using <assert.h> work
+on every system around.
+
+The declaration of FOO is there to override builtin prototypes for
+ANSI C functions.
+
=back
=head2 Probably good ideas waiting for round tuits
@@ -1177,4 +1293,4 @@ All opinions expressed herein are those of the authorZ<>(s).
=head1 LAST MODIFIED
-$Id: pumpkin.pod,v 1.13 1997/08/28 18:26:40 doughera Released $
+$Id: pumpkin.pod,v 1.13.1 1998/04/24 12:03:17 doughera Released $
diff --git a/doop.c b/doop.c
index 1cc825a5a3..24777873d8 100644
--- a/doop.c
+++ b/doop.c
@@ -103,7 +103,7 @@ register SV **sp;
sv_upgrade(sv, SVt_PV);
if (SvLEN(sv) < len + items) { /* current length is way too short */
while (items-- > 0) {
- if (*mark) {
+ if (*mark && !SvGMAGIC(*mark) && SvOK(*mark)) {
SvPV(*mark, tmplen);
len += tmplen;
}
diff --git a/ext/NDBM_File/NDBM_File.pm b/ext/NDBM_File/NDBM_File.pm
index 47b1f5aa3c..ed4fe2b36f 100644
--- a/ext/NDBM_File/NDBM_File.pm
+++ b/ext/NDBM_File/NDBM_File.pm
@@ -12,7 +12,7 @@ require DynaLoader;
@ISA = qw(Tie::Hash DynaLoader);
-$VERSION = "1.00";
+$VERSION = "1.01";
bootstrap NDBM_File $VERSION;
@@ -27,6 +27,7 @@ NDBM_File - Tied access to ndbm files
=head1 SYNOPSIS
use NDBM_File;
+ use Fcntl; # for O_ constants
tie(%h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640);
diff --git a/hints/svr4.sh b/hints/svr4.sh
index eb875e1707..33991e24e4 100644
--- a/hints/svr4.sh
+++ b/hints/svr4.sh
@@ -1,15 +1,19 @@
# svr4 hints, System V Release 4.x
-# Last modified 1995/01/28 by Tye McQueen, tye@metronet.com
+# Last modified 1996/10/25 by Tye McQueen, tye@metronet.com
+# Merged 1998/04/24 with perl5.004_04 distribution by
+# Andy Dougherty <doughera@lafayette.edu>
+
# Use Configure -Dcc=gcc to use gcc.
case "$cc" in
'') cc='/bin/cc'
test -f $cc || cc='/usr/ccs/bin/cc'
;;
esac
+
# We include support for using libraries in /usr/ucblib, but the setting
-# of libswanted excludes some libraries found there. You may want to
-# prevent "ucb" from being removed from libswanted and see if perl will
-# build on your system.
+# of libswanted excludes some libraries found there. If you run into
+# problems, you may have to remove "ucb" from libswanted. Just delete
+# the comment '#' from the sed command below.
ldflags='-L/usr/ccs/lib -L/usr/ucblib'
ccflags='-I/usr/include -I/usr/ucbinclude'
# Don't use problematic libraries:
@@ -17,26 +21,62 @@ libswanted=`echo " $libswanted " | sed -e 's/ malloc / /'` # -e 's/ ucb / /'`
# libmalloc.a - Probably using Perl's malloc() anyway.
# libucb.a - Remove it if you have problems ld'ing. We include it because
# it is needed for ODBM_File and NDBM_File extensions.
+
if [ -r /usr/ucblib/libucb.a ]; then # If using BSD-compat. library:
- d_gconvert='undef' # Unusuable under UnixWare 1.1 [use gcvt() instead]
+ d_Gconvert='gcvt' # Try gcvt() before gconvert().
# Use the "native" counterparts, not the BSD emulation stuff:
d_bcmp='undef' d_bcopy='undef' d_bzero='undef' d_safebcpy='undef'
d_index='undef' d_killpg='undef' d_getprior='undef' d_setprior='undef'
- d_setlinebuf='undef' d_setregid='undef' d_setreuid='undef'
+ d_setlinebuf='undef'
+ # d_setregid='undef' d_setreuid='undef' # ???
fi
-d_suidsafe='define' # "./Configure -d" can't figure this out easilly
-usevfork='false'
-# Configure may fail to find lstat() since it's a static/inline
-# function in <sys/stat.h> on Unisys U6000 SVR4, and possibly
-# other SVR4 derivatives.
-d_lstat=define
+# UnixWare has /usr/lib/libc.so.1, /usr/lib/libc.so.1.1, and
+# /usr/ccs/lib/libc.so. Configure chooses libc.so.1.1 while it
+# appears that /usr/ccs/lib/libc.so contains more symbols:
+#
+# Try the following if you want to use nm-extraction. We'll just
+# skip the nm-extraction phase, since searching for all the different
+# library versions will be hard to keep up-to-date.
+#
+# if [ "" = "$libc" -a -f /usr/ccs/lib/libc.so -a \
+# -f /usr/lib/libc.so.1 -a -f /usr/lib/libc.so.1.1 ]; then
+# if nm -h /usr/ccs/lib/libc.so | egrep '\<_?select$' >/dev/null; then
+# if nm -h /usr/lib/libc.so.1 | egrep '\<_?select$'` >/dev/null ||
+# nm -h /usr/lib/libc.so.1.1 | egrep '\<_?select$'` >/dev/null; then
+# :
+# else
+# libc=/usr/ccs/lib/libc.so
+# fi
+# fi
+# fi
+#
+# Don't bother with nm. Just compile & link a small C program.
+case "$usenm" in
+'') usenm=false;;
+esac
+
+# Broken C-Shell tests (Thanks to Tye McQueen):
+# The OS-specific checks may be obsoleted by the this generic test.
+ sh_cnt=`sh -c 'echo /*' | wc -c`
+ csh_cnt=`csh -f -c 'glob /*' 2>/dev/null | wc -c`
+ csh_cnt=`expr 1 + $csh_cnt`
+if [ "$sh_cnt" -ne "$csh_cnt" ]; then
+ echo "You're csh has a broken 'glob', disabling..." >&2
+ d_csh='undef'
+fi
+
+# Unixware-specific problems. The undocumented -X argument to uname
+# is probably a reasonable way of detecting UnixWare.
+# UnixWare has a broken csh. (This might already be detected above).
+# In Unixware 2.1.1 the fields in FILE* got renamed!
+$ Unixware 1.1 can't cast large floats to 32-bit ints.
+#
+# Leave leading tabs on the next two lines so Configure doesn't
+# propagate these variables to config.sh
+ uw_ver=`uname -v`
+ uw_isuw=`uname -X 2>&1 | grep Release`
-# UnixWare has a broken csh. The undocumented -X argument to uname is probably
-# a reasonable way of detecting UnixWare. Also in 2.1.1 the fields in
-# FILE* got renamed! Plus 1.1 can't cast large floats to 32-bit ints.
-uw_ver=`uname -v`
-uw_isuw=`uname -X 2>&1 | grep Release`
if [ "$uw_isuw" = "Release = 4.2" ]; then
case $uw_ver in
1.1)
@@ -47,33 +87,43 @@ fi
if [ "$uw_isuw" = "Release = 4.2MP" ]; then
case $uw_ver in
2.1)
- d_csh='undef'
- ;;
+ d_csh='undef'
+ ;;
2.1.*)
- d_csh='undef'
- stdio_cnt='((fp)->__cnt)'
- d_stdio_cnt_lval='define'
- stdio_ptr='((fp)->__ptr)'
- d_stdio_ptr_lval='define'
- ;;
+ d_csh='undef'
+ stdio_cnt='((fp)->__cnt)'
+ d_stdio_cnt_lval='define'
+ stdio_ptr='((fp)->__ptr)'
+ d_stdio_ptr_lval='define'
+ ;;
esac
fi
+# End of Unixware-specific tests.
# DDE SMES Supermax Enterprise Server
case "`uname -sm`" in
"UNIX_SV SMES")
- if test "$cc" = '/bin/cc' -o "$gccversion" = ""
- then
- # for cc we need -K PIC (not -K pic)
- cccdlflags="$cccdlflags -K PIC"
- fi
- # the *grent functions are in libgen.
- libswanted="$libswanted gen"
- # csh is broken (also) in SMES
- d_csh='undef'
+ # the *grent functions are in libgen.
+ libswanted="$libswanted gen"
+ # csh is broken (also) in SMES
+ # This may already be detected by the generic test above.
+ d_csh='undef'
+ case "$cc" in
+ *gcc*) ;;
+ *) # for cc we need -K PIC (not -K pic)
+ cccdlflags="$cccdlflags -K PIC"
;;
+ esac
+ ;;
esac
+# Configure may fail to find lstat() since it's a static/inline function
+# in <sys/stat.h> on Unisys U6000 SVR4, UnixWare 2.x, and possibly other
+# SVR4 derivatives. (Though UnixWare has it in /usr/ccs/lib/libc.so.)
+d_lstat=define
+
+d_suidsafe='define' # "./Configure -d" can't figure this out easilly
+
cat <<'EOM' >&4
If you wish to use dynamic linking, you must use
diff --git a/lib/strict.pm b/lib/strict.pm
index 176af387a0..b15e47ef2d 100644
--- a/lib/strict.pm
+++ b/lib/strict.pm
@@ -67,7 +67,7 @@ appears in curly braces or on the left hand side of the "=E<gt>" symbol.
=back
-See L<perlmod/Pragmatic Modules>.
+See L<perlmodlib/Pragmatic Modules>.
=cut
diff --git a/lib/subs.pm b/lib/subs.pm
index 512bc9be9a..aa332a6785 100644
--- a/lib/subs.pm
+++ b/lib/subs.pm
@@ -20,7 +20,7 @@ C<use subs> declarations are not BLOCK-scoped. They are thus effective
for the entire file in which they appear. You may not rescind such
declarations with C<no vars> or C<no subs>.
-See L<perlmod/Pragmatic Modules> and L<strict/strict subs>.
+See L<perlmodlib/Pragmatic Modules> and L<strict/strict subs>.
=cut
diff --git a/lib/vars.pm b/lib/vars.pm
index 5723ac6c2c..5256d1199f 100644
--- a/lib/vars.pm
+++ b/lib/vars.pm
@@ -61,6 +61,6 @@ outside of the package), it can act as an acceptable substitute by
pre-declaring global symbols, ensuring their availability to the
later-loaded routines.
-See L<perlmod/Pragmatic Modules>.
+See L<perlmodlib/Pragmatic Modules>.
=cut
diff --git a/perl.c b/perl.c
index 51f4a1099b..9635b85d3d 100644
--- a/perl.c
+++ b/perl.c
@@ -208,6 +208,7 @@ register PerlInterpreter *sv_interp;
op_free(main_root);
main_root = Nullop;
}
+ curcop = &compiling;
main_start = Nullop;
SvREFCNT_dec(main_cv);
main_cv = Nullcv;
@@ -1590,6 +1591,7 @@ Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
/* compliments of Tom Christiansen */
/* unexec() can be found in the Gnu emacs distribution */
+/* Known to work with -DUNEXEC and using unexelf.c from GNU emacs-20.2 */
void
my_unexec()
@@ -1597,7 +1599,7 @@ my_unexec()
#ifdef UNEXEC
SV* prog;
SV* file;
- int status;
+ int status = 1;
extern int etext;
prog = newSVpv(BIN_EXP, 0);
@@ -1606,6 +1608,7 @@ my_unexec()
sv_catpv(file, ".perldump");
unexec(SvPVX(file), SvPVX(prog), &etext, sbrk(0), 0);
+ /* unexec prints msg to stderr in case of failure */
exit(status);
#else
# ifdef VMS
diff --git a/pod/perlembed.pod b/pod/perlembed.pod
index b72e70ba3a..5ca71910e6 100644
--- a/pod/perlembed.pod
+++ b/pod/perlembed.pod
@@ -12,7 +12,7 @@ Do you want to:
=item B<Use C from Perl?>
-Read L<perlcall> and L<perlxs>.
+Read L<perlxs>, L<perlxstut> and L<h2xs>.
=item B<Use a Unix program from Perl?>
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index dc83291c2b..df13b4a987 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -2626,13 +2626,11 @@ or
require "Foo::Bar" ; # not a bareword because of the ""
The require function will look for the "Foo::Bar" file in the @INC array and
-will complain about not finding "Foo::Bar" there. In this case you must do :
+will complain about not finding "Foo::Bar" there. In this case you can do :
- $class = 'Foo/Bar.pm';
- require $class ;
+ eval "require $class";
-For a yet-more-powerful import facility, see L</use> and
-L<perlmod>.
+For a yet-more-powerful import facility, see L</use> and L<perlmod>.
=item reset EXPR
diff --git a/pp_sys.c b/pp_sys.c
index 87007f9f8a..12cc36e31b 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -47,10 +47,8 @@
#endif
#if defined(HOST_NOT_FOUND) && !defined(h_errno)
-#ifndef h_errno
extern int h_errno;
#endif
-#endif
#ifdef HAS_PASSWD
# ifdef I_PWD
diff --git a/utils/h2ph.PL b/utils/h2ph.PL
index 5c17e97ca0..2c685e0383 100644
--- a/utils/h2ph.PL
+++ b/utils/h2ph.PL
@@ -1,7 +1,7 @@
#!/usr/local/bin/perl
use Config;
-use File::Basename qw(&basename &dirname);
+use File::Basename qw(basename dirname);
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -38,8 +38,7 @@ use Config;
use File::Path qw(mkpath);
use Getopt::Std;
-getopts('d:rlh');
-
+getopts('Dd:rlh');
my $Exit = 0;
@@ -76,8 +75,7 @@ while (defined ($file = next_file())) {
if ($file eq '-') {
open(IN, "-");
open(OUT, ">-");
- }
- else {
+ } else {
($outfile = $file) =~ s/\.h$/.ph/ || next;
print "$file -> $outfile\n";
if ($file =~ m|^(.*)/|) {
@@ -94,6 +92,7 @@ while (defined ($file = next_file())) {
$_ .= <IN>;
chop;
}
+ print OUT "# $_\n" if $opt_D;
if (s:/\*:\200:g) {
s:\*/:\201:g;
s/\200[^\201]*\201//g; # delete single line comments
@@ -103,7 +102,7 @@ while (defined ($file = next_file())) {
redo;
}
}
- if (s/^#\s*//) {
+ if (s/^\s*#\s*//) {
if (s/^define\s+(\w+)//) {
$name = $1;
$new = '';
@@ -122,86 +121,121 @@ while (defined ($file = next_file())) {
}
s/^\s+//;
expr();
- $new =~ s/(["\\])/\\$1/g;
+ $new =~ s/(["\\])/\\$1/g; #"]);
+ $new = reindent($new);
+ $args = reindent($args);
if ($t ne '') {
- $new =~ s/(['\\])/\\$1/g;
+ $new =~ s/(['\\])/\\$1/g; #']);
if ($opt_h) {
print OUT $t,
- "eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name $proto\{\n$t ${args}eval \"$new\";\n$t}' unless defined(\&$name);\n";
+ "eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name $proto\{\n$t ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
$eval_index++;
} else {
print OUT $t,
- "eval 'sub $name $proto\{\n$t ${args}eval \"$new\";\n$t}' unless defined(\&$name);\n";
+ "eval 'sub $name $proto\{\n$t ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
}
- }
- else {
- print OUT "unless defined(\&$name) {\nsub $name $proto\{\n ${args}eval \"$new\";\n}\n}\n";
+ } else {
+ print OUT "unless(defined(\&$name)) {\n sub $name $proto\{\n\t${args}eval q($new);\n }\n}\n";
}
%curargs = ();
- }
- else {
+ } else {
s/^\s+//;
expr();
$new = 1 if $new eq '';
+ $new = reindent($new);
+ $args = reindent($args);
if ($t ne '') {
- $new =~ s/(['\\])/\\$1/g;
+ $new =~ s/(['\\])/\\$1/g; #']);
if ($opt_h) {
print OUT $t,"eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name () {",$new,";}' unless defined(\&$name);\n";
$eval_index++;
} else {
print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n";
}
- }
- else {
- print OUT $t,"unless(defined(\&$name)) {\nsub $name () {",$new,";}\n}\n";
+ } else {
+ print OUT $t,"unless(defined(\&$name)) {\n sub $name () {\t",$new,";}\n}\n";
}
}
- }
- elsif (/^include\s*<(.*)>/) {
- ($incl = $1) =~ s/\.h$/.ph/;
+ } elsif (/^(include|import)\s*[<"](.*)[>"]/) {
+ ($incl = $2) =~ s/\.h$/.ph/;
print OUT $t,"require '$incl';\n";
- }
- elsif (/^ifdef\s+(\w+)/) {
- print OUT $t,"if (defined &$1) {\n";
+ } elsif(/^include_next\s*[<"](.*)[>"]/) {
+ ($incl = $1) =~ s/\.h$/.ph/;
+ # should've read up on #include_next properly before attempting
+ # to implement it...
+ #
+ #print OUT $t, "{\n";
+ #$tab += 4;
+ #$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ #print OUT $t, "my(\$INC) = shift(\@INC);\n";
+ #print OUT $t, "require '$incl';\n";
+ #print OUT $t, "unshift(\@INC, \$INC);}\n";
+ #$tab -= 4;
+ #$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ #print OUT $t, "}\n";
+ #
+ # try this instead:
+ print OUT ($t, "my(\$i) = 0;\n");
+ print OUT ($t, "if(exists(\$INC{$incl})) {\n");
$tab += 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (/^ifndef\s+(\w+)/) {
- print OUT $t,"if (!defined &$1) {\n";
+ print OUT ($t, "++\$i while (\$i <= \$#INC",
+ " and \$INC[\$i].'/$incl' ne \$INC{'$incl'});\n");
+ print OUT ($t, "\$i = 0 if \$INC[\$i].'/$incl' ne",
+ " \$INC{'$incl'};\n");
+ $tab -= 4;
+ $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ print OUT ($t, "}\n");
+ print OUT ($t,
+ "eval(\"require '\" . ",
+ "(\$i ? \$INC[\$i].'/' : '') . \"\$incl';\");");
+ # any better? require is smart enough not to try and include a
+ # file twice, i believe, so require-ing the same actual file
+ # should end up just being a null operation...
+ } elsif (/^ifdef\s+(\w+)/) {
+ print OUT $t,"if(defined(&$1)) {\n";
$tab += 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (s/^if\s+//) {
+ } elsif (/^ifndef\s+(\w+)/) {
+ print OUT $t,"unless(defined(&$1)) {\n";
+ $tab += 4;
+ $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ } elsif (s/^if\s+//) {
$new = '';
$inif = 1;
expr();
$inif = 0;
- print OUT $t,"if ($new) {\n";
+ print OUT $t,"if($new) {\n";
$tab += 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (s/^elif\s+//) {
+ } elsif (s/^elif\s+//) {
$new = '';
$inif = 1;
expr();
$inif = 0;
$tab -= 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- print OUT $t,"}\n${t}elsif ($new) {\n";
+ print OUT $t,"}\n elsif($new) {\n";
$tab += 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (/^else/) {
+ } elsif (/^else/) {
$tab -= 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- print OUT $t,"}\n${t}else {\n";
+ print OUT $t,"} else {\n";
$tab += 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (/^endif/) {
+ } elsif (/^endif/) {
$tab -= 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
print OUT $t,"}\n";
+ } elsif(/^undef\s+(\w+)/) {
+ print OUT $t, "undef(&$1) if defined(&$1);\n";
+ } elsif(/^error\s+(.*)/) {
+ print OUT $t, "die(\"$1\");\n";
+ } elsif(/^warning\s+(.*)/) {
+ print OUT $t, "warn(\"$1\");\n";
+ } elsif(/^ident\s+(.*)/) {
+ print OUT $t, "# $1\n";
}
}
}
@@ -210,10 +244,20 @@ while (defined ($file = next_file())) {
exit $Exit;
+sub reindent($) {
+ my($text) = shift;
+ $text =~ s/\n/\n /g;
+ $text =~ s/ /\t/g;
+ $text;
+}
+
sub expr {
+ if(keys(%curargs)) {
+ my($joined_args) = join('|', keys(%curargs));
+ }
while ($_ ne '') {
- s/^\&\&// && do { $new .= "&&"; next;}; # handle && operator
- s/^\&//; # hack for things that take the address of
+ s/^\&\&// && do { $new .= " &&"; next;}; # handle && operator
+ s/^\&([\(a-z\)]+)/$1/i; # hack for things that take the address of
s/^(\s+)// && do {$new .= ' '; next;};
s/^(0X[0-9A-F]+)[UL]*//i && do {$new .= lc($1); next;};
s/^(-?\d+\.\d+E[-+]\d+)F?//i && do {$new .= $1; next;};
@@ -222,8 +266,7 @@ sub expr {
s/^'((\\"|[^"])*)'// && do {
if ($curargs{$1}) {
$new .= "ord('\$$1')";
- }
- else {
+ } else {
$new .= "ord('$1')";
}
next;
@@ -260,11 +303,22 @@ sub expr {
}
s/\([\w\s]+[\*\s]*\)// && next; # then eliminate them.
};
- # struct/union member:
- s/^([_A-Z]\w*((\.|->)[_A-Z]\w*)+)//i && do {
+ # struct/union member, including arrays:
+ s/^([_A-Z]\w*(\[[^\]]+\])?((\.|->)[_A-Z]\w*(\[[^\]]+\])?)+)//i && do {
$id = $1;
- $id =~ s/(\.|(->))([^\.-]*)/->\{$3\}/g;
- $new .= ' ($' . $id . ')';
+ $id =~ s/(\.|(->))([^\.\-]*)/->\{$3\}/g;
+ $id =~ s/\b([^\$])($joined_args)/$1\$$2/g if length($joined_args);
+ while($id =~ /\[\s*([^\$\&\d\]]+)\]/) {
+ my($index) = $1;
+ $index =~ s/\s//g;
+ if(exists($curargs{$index})) {
+ $index = "\$$index";
+ } else {
+ $index = "&$index";
+ }
+ $id =~ s/\[\s*([^\$\&\d\]]+)\]/[$index]/;
+ }
+ $new .= " (\$$id)";
};
s/^([_a-zA-Z]\w*)// && do {
$id = $1;
@@ -272,41 +326,33 @@ sub expr {
s/^\s+(\w+)//;
$id .= ' ' . $1;
$isatype{$id} = 1;
- }
- elsif ($id =~ /^((un)?signed)|(long)|(short)$/) {
+ } elsif ($id =~ /^((un)?signed)|(long)|(short)$/) {
while (s/^\s+(\w+)//) { $id .= ' ' . $1; }
$isatype{$id} = 1;
}
if ($curargs{$id}) {
- $new .= '$' . $id;
- }
- elsif ($id eq 'defined') {
+ $new .= "\$$id";
+ $new .= '->' if /^[\[\{]/;
+ } elsif ($id eq 'defined') {
$new .= 'defined';
- }
- elsif (/^\(/) {
+ } elsif (/^\(/) {
s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat
$new .= " &$id";
- }
- elsif ($isatype{$id}) {
+ } elsif ($isatype{$id}) {
if ($new =~ /{\s*$/) {
$new .= "'$id'";
- }
- elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
+ } elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
$new =~ s/\(\s*$//;
s/^[\s*]*\)//;
- }
- else {
+ } else {
$new .= q(').$id.q(');
}
- }
- else {
+ } else {
if ($inif && $new !~ /defined\s*\($/) {
$new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
- }
- elsif (/^\[/) {
- $new .= ' $' . $id;
- }
- else {
+ } elsif (/^\[/) {
+ $new .= " \$$id";
+ } else {
$new .= ' &' . $id;
}
}
@@ -334,7 +380,7 @@ sub next_file
} else {
print STDERR "Skipping directory `$file'\n";
}
- } else {
+ } else {
print STDERR "Skipping `$file': not a file or directory\n";
}
}
@@ -356,8 +402,11 @@ sub expand_glob
# expand_glob() is going to be called until $ARGV[0] isn't a
# directory; so push directories, and unshift everything else.
- if (-d "$directory/$_") { push @ARGV, "$directory/$_" }
- else { unshift @ARGV, "$directory/$_" }
+ if (-d "$directory/$_") {
+ push @ARGV, "$directory/$_";
+ } else {
+ unshift @ARGV, "$directory/$_";
+ }
}
closedir DIR;
}
@@ -382,7 +431,6 @@ sub link_if_possible
unlink "$Dest_dir/$dirlink" or
print STDERR "Could not remove link $Dest_dir/$dirlink: $!\n";
}
-
if (eval 'symlink($target, "$Dest_dir/$dirlink")') {
print "Linking $target -> $Dest_dir/$dirlink\n";