This is my patch patch.1j for perl5.001.
authorAndy Dougherty <doughera@lafcol.lafayette.edu>
Mon, 5 Jun 1995 02:03:44 +0000 (02:03 +0000)
committerAndy Dougherty <doughera@lafcol.lafayette.edu>
Mon, 5 Jun 1995 02:03:44 +0000 (02:03 +0000)
To apply, change to your perl directory and apply with
    patch -p1 -N  < thispatch.

After you apply this patch, I would recommend:
    rm config.sh
    sh Configure [whatever options you use]
    make depend
    make
    make test

Here are the highlights:
    Linux fixes:  Now correctly sets & uses stdio _ptr and _cnt
    tricks only when feasible (Configure, config_h.SH, config_H,
    doio.c, sv.c x2p/str.c)

    #!path-to-perl fixed to use $binexp instead of $bin.  This should
    really be fixed to do the correct perl start-up stuff.  Volunteers?
    (c2ph.SH, h2ph.SH, h2xs.SH, makeaperl.SH, perldoc.SH,
    pod/pod2*.SH, x2p/find2perl.SH, x2p/s2p.SH)

    hint updates:  hints/apollo.sh, hints/linux.sh, hints/freebsd.sh,
    hints/sco_3.sh.

    xsubpp version 1.7.  (includes CASE support)

    pod/perlbot updates.

    my lib/AutoLoader patch (to use @INC).

    [ON]DBM_File/Makefile.PL now have a few hint files.

    Other sundry small things.

Patch and enjoy,

Andy Dougherty doughera@lafcol.lafayette.edu
Dept. of Physics
Lafayette College Easton, PA  18042

Here's the file-by-file breakdown of what's included:

Configure
    Checks if File_ptr(fp) and File_cnt(fp) can be assigned to.

    Fix typo:  s/sytem/system/

MANIFEST
    Include new extension hint files.

README
    Some clarifications, thanks to John Stoeffel.  Tell users how to
    not use dynamic loading.

c2ph.SH
    Use $binexp instead of $bin.

config_H
    Updated to match config_h.SH.

config_h.SH
    Include defines for whether File_ptr(fp) and File_cnt(fp)
    can be assigned to.

doio.c
    Use defines for whether File_ptr(fp) and File_cnt(fp) can be assigned to.

ext/DynaLoader/DynaLoader.pm
    Improve error messages and a little documentation.

ext/NDBM_File/hints/solaris.pl
    New hint file.

ext/ODBM_File/Makefile.PL
    Removed -ldbm.nfs, since it's now in the sco hint file.

ext/ODBM_File/hints/sco.pl
ext/ODBM_File/hints/solaris.pl
ext/ODBM_File/hints/svr4.pl
    New hint files.

h2ph.SH
h2xs.SH
    Use $binexp instead of $bin.

hints/apollo.sh
hints/freebsd.sh
hints/linux.sh
hints/sco_3.sh
    Updated.

lib/AutoLoader.pm
    Eliminate else clause in sub import.

    Handle case where @INC contains relative paths.

lib/ExtUtils/xsubpp
    Update to version 1.7.  This includes CASE support.

lib/I18N/Collate.pm
    Updated documentation.

lib/ftp.pl
    Look for socket.ph or sys/socket.ph

lib/getcwd.pl
    Use defined().

makeaperl.SH
    Use $binexp instead of $bin.

perl.c
    fputs("\tUnofficial patchlevel 1j.\n",stdout);

perldoc.SH
    Use $binexp instead of $bin.

    Turn off debugging messages.

pod/perlbot.pod
    Updated.

pod/pod2html.SH
pod/pod2latex.SH
pod/pod2man.SH
    Use $binexp instead of $bin.

sv.c
    Use defines for whether File_ptr(fp) and File_cnt(fp) can be assigned to.

toke.c
    Fix spelling of ambiguous.

x2p/find2perl.SH
x2p/s2p.SH
    Use $binexp instead of $bin.

x2p/str.c
    Use defines for whether File_ptr(fp) and File_cnt(fp) can be assigned to.

36 files changed:
Configure
MANIFEST
README
c2ph.SH
config_H
config_h.SH
doio.c
ext/DynaLoader/DynaLoader.pm
ext/NDBM_File/hints/solaris.pl [new file with mode: 0644]
ext/ODBM_File/Makefile.PL
ext/ODBM_File/hints/sco.pl [new file with mode: 0644]
ext/ODBM_File/hints/solaris.pl [new file with mode: 0644]
ext/ODBM_File/hints/svr4.pl [new file with mode: 0644]
h2ph.SH
h2xs.SH
hints/apollo.sh
hints/freebsd.sh
hints/linux.sh
hints/sco_3.sh
lib/AutoLoader.pm
lib/ExtUtils/xsubpp
lib/I18N/Collate.pm
lib/ftp.pl
lib/getcwd.pl
makeaperl.SH
perl.c
perldoc.SH
pod/perlbot.pod
pod/pod2html.SH
pod/pod2latex.SH
pod/pod2man.SH
sv.c
toke.c
x2p/find2perl.SH
x2p/s2p.SH
x2p/str.c

index e2910d544a1fa705f3b31365406640f1b3153caa..bf08892e0477db113d2606a8db468fb1274c30c3 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
 
 # $Id: Head.U,v 3.0.1.7 1995/03/21 08:46:15 ram Exp $
 #
-# Generated on Wed May 31 09:14:05 EDT 1995 [metaconfig 3.0 PL55]
+# Generated on Mon Jun  5 12:18:53 EDT 1995 [metaconfig 3.0 PL55]
 
 cat >/tmp/c1$$ <<EOF
 ARGGGHHHH!!!!!
@@ -349,6 +349,8 @@ d_sockpair=''
 sockethdr=''
 socketlib=''
 d_statblks=''
+d_stdio_cnt_lval=''
+d_stdio_ptr_lval=''
 d_stdiobase=''
 d_stdstdio=''
 stdio_base=''
@@ -5610,23 +5612,31 @@ echo " "
 if $contains '_IO_fpos_t' `./findhdr stdio.h` >/dev/null 2>&1 ; then
        echo "(Looks like you have stdio.h from Linux.)"
        case "$stdio_ptr" in
-       '') stdio_ptr='((fp)->_IO_read_ptr)';;
+       '') stdio_ptr='((fp)->_IO_read_ptr)'
+               ptr_lval=$define
+               ;;
        esac
        case "$stdio_cnt" in
-       '') stdio_cnt='((fp)->_IO_read_end - (fp)->_IO_read_ptr)';;
+       '') stdio_cnt='((fp)->_IO_read_end - (fp)->_IO_read_ptr)'
+               cnt_lval=$undef
+               ;;
        esac
        case "$stdio_base" in
        '') stdio_base='((fp)->_IO_read_base)';;
        esac
        case "$stdio_bufsiz" in
-       '') stdio_bufsiz='((fp)->_IO_read_end - (fp)->_IO_read_base))';;
+       '') stdio_bufsiz='((fp)->_IO_read_end - (fp)->_IO_read_base)';;
        esac
 else
        case "$stdio_ptr" in
-       '') stdio_ptr='((fp)->_ptr)';;
+       '') stdio_ptr='((fp)->_ptr)'
+               ptr_lval=$define
+               ;;
        esac
        case "$stdio_cnt" in
-       '') stdio_cnt='((fp)->_cnt)';;
+       '') stdio_cnt='((fp)->_cnt)'
+               cnt_lval=$define
+               ;;
        esac
        case "$stdio_base" in
        '') stdio_base='((fp)->_base)';;
@@ -5667,6 +5677,26 @@ $rm -f try.c try
 set d_stdstdio
 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 ;;
+*) val=$undef ;;
+esac
+set d_stdio_ptr_lval
+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 ;;
+*) val=$undef ;;
+esac
+set d_stdio_cnt_lval
+eval $setvar
+
+
 : see if _base is also standard
 val="$undef"
 case "$d_stdstdio" in
@@ -5834,7 +5864,7 @@ if set times val -f d_times; eval $csym; $val; then
        eval $typedef
        dflt="$clocktype"
        echo " "
-       rp="What type is returned by times() on this sytem?"
+       rp="What type is returned by times() on this system?"
        . ./myread
        clocktype="$ans"
 else
@@ -7472,7 +7502,7 @@ if set time val -f d_time; eval $csym; $val; then
        eval $typedef
        dflt="$timetype"
        echo " "
-       rp="What type is returned by time() on this sytem?"
+       rp="What type is returned by time() on this system?"
        . ./myread
        timetype="$ans"
 else
@@ -8174,6 +8204,8 @@ d_sitelib='$d_sitelib'
 d_socket='$d_socket'
 d_sockpair='$d_sockpair'
 d_statblks='$d_statblks'
+d_stdio_cnt_lval='$d_stdio_cnt_lval'
+d_stdio_ptr_lval='$d_stdio_ptr_lval'
 d_stdiobase='$d_stdiobase'
 d_stdstdio='$d_stdstdio'
 d_strchr='$d_strchr'
index 4dcea9ac3e306f6ce0339807b7f5e025ac700ee3..152048ba347b42eee0e1fbfef98ea3c958e81aac 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -107,10 +107,14 @@ ext/GDBM_File/typemap             GDBM extension interface types
 ext/NDBM_File/Makefile.PL      NDBM extension makefile writer
 ext/NDBM_File/NDBM_File.pm     NDBM extension Perl module
 ext/NDBM_File/NDBM_File.xs     NDBM extension external subroutines
+ext/NDBM_File/hints/solaris.pl Hint for NDBM_File for named architecture
 ext/NDBM_File/typemap          NDBM extension interface types
 ext/ODBM_File/Makefile.PL      ODBM extension makefile writer
 ext/ODBM_File/ODBM_File.pm     ODBM extension Perl module
 ext/ODBM_File/ODBM_File.xs     ODBM extension external subroutines
+ext/ODBM_File/hints/sco.pl     Hint for ODBM_File for named architecture
+ext/ODBM_File/hints/solaris.pl Hint for ODBM_File for named architecture
+ext/ODBM_File/hints/svr4.pl    Hint for ODBM_File for named architecture
 ext/ODBM_File/typemap          ODBM extension interface types
 ext/POSIX/Makefile.PL          POSIX extension makefile writer
 ext/POSIX/POSIX.pm             POSIX extension Perl module
diff --git a/README b/README
index 23bc7cafee3aaf73ef540d28b021847d23f2ec9a..66ab6fa5cfe9557bf3911bdc6bb677d13a7930ae 100644 (file)
--- a/README
+++ b/README
@@ -68,25 +68,34 @@ Installation
     run ok, the defaults will usually be right.  It will then proceed to
     make config.h, config.sh, and Makefile.  You may have to explicitly
     say     sh Configure    to ensure that Configure is run under sh.
-    If you're a hotshot, run Configure -d to take all the defaults,
-    edit config.sh to patch up any flaws, and then run Configure -S.
+    If you're a hotshot, run Configure -d to take all the defaults
+    and edit config.sh to patch up any flaws.
+
+    If you later make any changes to config.sh, you should propagate
+    them to all the .SH files by running  Configure -S.
 
     Configure supports a number of useful options.  Run Configure -h 
     to get a listing.  To compile with gcc, for example, you can run 
     Configure -Dcc=gcc, or answer 'gcc' at the cc prompt.  
     
-    If you wish to use gcc (or another alternative compiler))
+    If you wish to use gcc (or another alternative compiler)
     you should use  Configure -Dcc=gcc.  That way, the the hints
     files can set appropriate defaults.
+
+    By default, perl will be installed in /usr/local/{bin, lib, man}.
+    You can specify a different 'prefix' for the default installation
+    directory, when Configure prompts you or by using the Configure
+    command line option -Dprefix='/some/directory'.
     
+    By default, perl will use dynamic extensions if your system
+    supports it.  If you want to force perl to be compiled statically,
+    you can either choose this when Configure prompts you or by using
+    the Configure command line option -Uusedl
+
     If you change compilers or make other significant changes, you should
     probably _not_ re-use your old config.sh.  Simply remove it or
-    rename it, e.g. mv config.sh config.sh.old.
-    
-    By default, perl will be installed in /usr/local/{bin, lib, man}.
-    You can specify a different prefix for the default installation
-    directory, when Configure prompts you or by using something like
-    Configure -Dprefix=/whatever.
+    rename it, e.g. mv config.sh config.sh.old.  Then rerun Configure
+    with the options you want to use.
 
     You can also supply a file config.over to over-ride Configure's
     guesses.  It will get loaded up at the very end, just before
@@ -106,7 +115,9 @@ Installation
     can be done in cflags.SH.  For instance, to turn off the optimizer
     on toke.c, find the line in the switch structure for toke.c and
     put the command optimize='-g' before the ;;.  To change the C flags
-    for all the files, edit config.sh and change either $ccflags or $optimize.
+    for all the files, edit config.sh and change either $ccflags or $optimize,
+    and then re-run  Configure -S ; make depend.
+
 
 3)  make depend
 
diff --git a/c2ph.SH b/c2ph.SH
index 57e7822bb1a06b2b0412a98859e570c13834ab9b..b8b87499744b7d0b58c911ee7c556ffe1553098a 100755 (executable)
--- a/c2ph.SH
+++ b/c2ph.SH
@@ -21,7 +21,7 @@ echo "Extracting c2ph (with variable substitutions)"
 : by putting a backslash in front.  You may delete these comments.
 rm -f c2ph
 $spitshell >c2ph <<!GROK!THIS!
-#!$bin/perl
+#!$binexp/perl
 #
 !GROK!THIS!
 
index aaba37e9dbe60fe7a47efa29db386ff32963bb71..0ed7b110c3d63072ed746fa42747bb6ca1f0ae30 100644 (file)
--- a/config_H
+++ b/config_H
@@ -14,7 +14,7 @@
  * $Id: Config_h.U,v 3.0.1.3 1995/01/30 14:25:39 ram Exp $
  */
 
-/* Configuration time: Tue May 30 13:05:37 EDT 1995
+/* Configuration time: Fri Jun  2 14:50:10 EDT 1995
  * Configured by: andy
  * Target system: crystal crystal 3.2 2 i386 
  */
  *     FILE structure pointed to by its argument. This macro will always be
  *     defined if USE_STDIO_PTR is defined.
  */
+/* STDIO_PTR_LVALUE:
+ *     This symbol is defined if the FILE_ptr macro can be used as an
+ *     lvalue.
+ */
 /* FILE_cnt:
  *     This macro is used to access the _cnt field (or equivalent) of the
  *     FILE structure pointed to by its argument. This macro will always be
  *     defined if USE_STDIO_PTR is defined.
  */
+/* STDIO_CNT_LVALUE:
+ *     This symbol is defined if the FILE_cnt macro can be used as an
+ *     lvalue.
+ */
 #ifdef USE_STDIO_PTR
 #define FILE_ptr(fp)   ((fp)->_ptr)
+#define STDIO_PTR_LVALUE
 #define FILE_cnt(fp)   ((fp)->_cnt)
+#define STDIO_CNT_LVALUE
 #endif
 
 /* FILE_base:
index 6752206f557f459468164442ac17bfac6fd7c589..90f523ce0abb7671e6765c2504cc218ca4a782d4 100755 (executable)
@@ -772,14 +772,24 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!'
  *     FILE structure pointed to by its argument. This macro will always be
  *     defined if USE_STDIO_PTR is defined.
  */
+/* STDIO_PTR_LVALUE:
+ *     This symbol is defined if the FILE_ptr macro can be used as an
+ *     lvalue.
+ */
 /* FILE_cnt:
  *     This macro is used to access the _cnt field (or equivalent) of the
  *     FILE structure pointed to by its argument. This macro will always be
  *     defined if USE_STDIO_PTR is defined.
  */
+/* STDIO_CNT_LVALUE:
+ *     This symbol is defined if the FILE_cnt macro can be used as an
+ *     lvalue.
+ */
 #ifdef USE_STDIO_PTR
 #define FILE_ptr(fp)   $stdio_ptr
+#$d_stdio_ptr_lval STDIO_PTR_LVALUE
 #define FILE_cnt(fp)   $stdio_cnt
+#$d_stdio_cnt_lval STDIO_CNT_LVALUE
 #endif
 
 /* FILE_base:
diff --git a/doio.c b/doio.c
index 7f2aee130a3583f619ae982ca33a3ddd0711953f..1a5c786ca63195fc41e291c3e89b4b7b11c46b6d 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -577,7 +577,7 @@ GV *gv;
            (void)ungetc(ch, IoIFP(io));
            return FALSE;
        }
-#ifdef USE_STDIO_PTR
+#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
        if (FILE_cnt(IoIFP(io)) < -1)
            FILE_cnt(IoIFP(io)) = -1;
 #endif
index 82721d193651c89c260918d29466937d118c4f18..00466c3f2a6f15835a23a9bfe2f9bc49f8978274 100644 (file)
@@ -9,25 +9,25 @@ dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_find_symbol(), dl
 =head1 SYNOPSIS
 
     require DynaLoader;
-    push (@ISA, 'DynaLoader');
+    @ISA = qw(... DynaLoader ...);
 
 
 =head1 DESCRIPTION
 
-This specification defines a standard generic interface to the dynamic
+This document defines a standard generic interface to the dynamic
 linking mechanisms available on many platforms.  Its primary purpose is
 to implement automatic dynamic loading of Perl modules.
 
+This document serves as both a specification for anyone wishing to
+implement the DynaLoader for a new platform and as a guide for
+anyone wishing to use the DynaLoader directly in an application.
+
 The DynaLoader is designed to be a very simple high-level
 interface that is sufficiently general to cover the requirements
 of SunOS, HP-UX, NeXT, Linux, VMS and other platforms.
 
-It is also hoped that the interface will cover the needs of OS/2,
-NT etc and allow pseudo-dynamic linking (using C<ld -A> at runtime).
-
-This document serves as both a specification for anyone wishing to
-implement the DynaLoader for a new platform and as a guide for
-anyone wishing to use the DynaLoader directly in an application.
+It is also hoped that the interface will cover the needs of OS/2, NT
+etc and also allow pseudo-dynamic linking (using C<ld -A> at runtime).
 
 It must be stressed that the DynaLoader, by itself, is practically
 useless for accessing non-Perl libraries because it provides almost no
@@ -153,8 +153,8 @@ prefix and suffix appropriate to the platform: "$name.o", "lib$name.*"
 and "$name".
 
 If any directories are included in @names they are searched before
-@dl_library_path.  Directories may be specified as B<-Ldir>.  Any other names
-are treated as filenames to be searched for.
+@dl_library_path.  Directories may be specified as B<-Ldir>.  Any other
+names are treated as filenames to be searched for.
 
 Using arguments of the form C<-Ldir> and C<-lname> is recommended.
 
@@ -174,8 +174,8 @@ order to deal with symbolic names for files (i.e., VMS's Logical Names).
 
 To support these systems a dl_expandspec() function can be implemented
 either in the F<dl_*.xs> file or code can be added to the autoloadable
-dl_expandspec(0 function in F<DynaLoader.pm>).  See F<DynaLoader.pm> for more
-information.
+dl_expandspec() function in F<DynaLoader.pm>.  See F<DynaLoader.pm> for
+more information.
 
 =item dl_load_file()
 
@@ -232,7 +232,8 @@ Example
 
 Return a list of symbol names which remain undefined after load_file().
 Returns C<()> if not known.  Don't worry if your platform does not provide
-a mechanism for this.  Most do not need it and hence do not provide it.
+a mechanism for this.  Most do not need it and hence do not provide it,
+they just return an empty list.
 
 
 =item dl_install_xsub()
@@ -308,15 +309,15 @@ calls &{"${module}::bootstrap"} to bootstrap the module
 
 =head1 AUTHOR
 
+Tim Bunce, 11 August 1994.
+
 This interface is based on the work and comments of (in no particular
 order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno
-Siegel, Thomas Neumann, Paul Marquess, Charles Bailey, and others.
+Siegel, Thomas Neumann, Paul Marquess, Charles Bailey, myself and others.
 
 Larry Wall designed the elegant inherited bootstrap mechanism and
 implemented the first Perl 5 dynamic loader using it.
 
-Tim Bunce, 11 August 1994.
-
 =cut
 
 #
@@ -328,8 +329,7 @@ Tim Bunce, 11 August 1994.
 
 # Quote from Tolkien sugested by Anno Siegel.
 #
-# Read ext/DynaLoader/README and DynaLoader.doc for
-# detailed information.
+# Read ext/DynaLoader/README for detailed information.
 #
 # Tim.Bunce@ig.co.uk, August 1994
 
@@ -394,10 +394,13 @@ sub bootstrap {
     local($module) = $args[0];
     local(@dirs, $file);
 
-    croak "Usage: DynaLoader::bootstrap(module)"
-       unless ($module);
+    confess "Usage: DynaLoader::bootstrap(module)" unless $module;
 
-    croak "Can't load module $module, dynamic loading not available in this perl"
+    # A common error on platforms which don't support dynamic loading.
+    # Since it's fatal and potentially confusing we give a detailed message.
+    croak("Can't load module $module, dynamic loading not available in this perl.\n".
+       "  (You may need to build a new perl executable which either supports\n".
+       "  dynamic loading or has the $module module statically linked into it.)\n")
        unless defined(&dl_load_file);
 
     print STDERR "DynaLoader::bootstrap($module)\n" if $dl_debug;
@@ -496,9 +499,11 @@ sub dl_findfile {
         # Deal with directories first:
         #  Using a -L prefix is the preferred option (faster and more robust)
         if (m:^-L:){ s/^-L//; push(@dirs, $_); next; }
+
         #  Otherwise we try to try to spot directories by a heuristic
         #  (this is a more complicated issue than it first appears)
         if (m:/: && -d $_){   push(@dirs, $_); next; }
+
         # VMS: we may be using native VMS directry syntax instead of
         # Unix emulation, so check this as well
         if ($vms && /[:>\]]/ && -d $_){   push(@dirs, $_); next; }
diff --git a/ext/NDBM_File/hints/solaris.pl b/ext/NDBM_File/hints/solaris.pl
new file mode 100644 (file)
index 0000000..8d2fe12
--- /dev/null
@@ -0,0 +1,3 @@
+# -lucb has been reported to be fatal for perl5 on Solaris.
+# Thus we deliberately don't include it here.
+$att{LIBS} = ["-L/usr/local/lib -lndbm", "-ldbm"];
index 7a80882863d988ab85cf3d9c950ac7ab6de629e4..10eef6faf48a0bd47f6829eba70591e6d05f5497 100644 (file)
@@ -1,2 +1,2 @@
 use ExtUtils::MakeMaker;
-WriteMakefile(LIBS => ["-ldbm.nfs", "-ldbm -lucb"]);
+WriteMakefile(LIBS => ["-ldbm -lucb"]);
diff --git a/ext/ODBM_File/hints/sco.pl b/ext/ODBM_File/hints/sco.pl
new file mode 100644 (file)
index 0000000..42a4d99
--- /dev/null
@@ -0,0 +1,4 @@
+# Some versions of SCO contain a broken -ldbm library that is missing
+# dbmclose.  Some of those might have a fixed library installed as
+# -ldbm.nfs.
+$att{LIBS} = ['-ldbm.nfs', '-ldbm'];
diff --git a/ext/ODBM_File/hints/solaris.pl b/ext/ODBM_File/hints/solaris.pl
new file mode 100644 (file)
index 0000000..0dd1240
--- /dev/null
@@ -0,0 +1,3 @@
+# -lucb has been reported to be fatal for perl5 on Solaris.
+# Thus we deliberately don't include it here.
+$att{LIBS} = ['-ldbm'];
diff --git a/ext/ODBM_File/hints/svr4.pl b/ext/ODBM_File/hints/svr4.pl
new file mode 100644 (file)
index 0000000..04d40e0
--- /dev/null
@@ -0,0 +1,4 @@
+# Some SVR4 systems may need to link against routines in -lucb for
+# odbm.  Some may also need to link against -lc to pick up things like
+# ecvt.
+$att{LIBS} = ['-ldbm -lucb -lc'];
diff --git a/h2ph.SH b/h2ph.SH
index fbab3b4345179acb39b8c1a00552f68651f45fa3..cb36adad80e50e0c439949ace70527ebcab68c93 100755 (executable)
--- a/h2ph.SH
+++ b/h2ph.SH
@@ -21,7 +21,7 @@ echo "Extracting h2ph (with variable substitutions)"
 : by putting a backslash in front.  You may delete these comments.
 rm -f h2ph
 $spitshell >h2ph <<!GROK!THIS!
-#!$bin/perl
+#!$binexp/perl
 'di ';
 'ds 00 \"';
 'ig 00 ';
diff --git a/h2xs.SH b/h2xs.SH
index aa5f331f6d9065b6aca2f6829dc607b771265735..c4224b351c64595bbe3eb4aabec1f236ecd077bc 100755 (executable)
--- a/h2xs.SH
+++ b/h2xs.SH
@@ -18,7 +18,7 @@ case "$0" in
 esac
 echo "Extracting h2xs (with variable substitutions)"
 $spitshell >h2xs <<!GROK!THIS!
-#!$bin/perl
+#!$binexp/perl
 !GROK!THIS!
 
 $spitshell >>h2xs <<'!NO!SUBS!'
index dd06084c3f0bdab722e25cea1ed2609ee5ce88b1..26180396341e9d8b7c59d8c2bfd3a16008a99253 100644 (file)
@@ -1,6 +1,20 @@
-optimize=''
-ccflags='-A cpu,mathchip -W0,-opt,2'
+# Info from Johann Klasek <jk@auto.tuwien.ac.at>
+# Merged by Andy Dougherty  <doughera@lafcol.lafayette.edu>
+# Last revised Fri Jun  2 11:21:27 EDT 1995
 
+# uname -a looks like
+# DomainOS newton 10.4.1 bsd4.3 425t
+
+# We want to use both BSD includes and some of the features from the
+# /sys5 includes.
+ccflags="$ccflags -A cpu,mathchip -I/usr/include -I/sys5/usr/include"
+
+# These adjustments are necessary (why?) to compile malloc.c.
+freetype='void'
+i_malloc='undef'
+malloctype='void *'
+
+# This info is left over from perl4.  
 cat <<'EOF'
 Some tests may fail unless you use 'chacl -B'.  Also, op/stat
 test 2 may fail occasionally because Apollo doesn't guarantee
@@ -8,6 +22,8 @@ that mtime will be equal to ctime on a newly created unmodified
 file.  Finally, the sleep test will sometimes fail.  See the
 sleep(3) man page to learn why.
 
+See hints/apollo.sh for hints on running h2ph.
+
 And a note on ccflags:
 
     Lastly, while -A cpu,mathchip generates optimal code for your DN3500
@@ -18,3 +34,18 @@ And a note on ccflags:
                                                -- Steve Vinoski
 
 EOF
+
+# Running h2ph, on the other hand, presents a challenge. 
+
+#The perl header files have to be generated with following commands
+
+#sed 's|/usr/include|/sys5/usr/include|g' h2ph >h2ph.new && chmod +x h2ph.new
+#(set cdir=`pwd`; cd /sys5/usr/include; $cdir/h2ph.new sys/* )
+#(set cdir=`pwd`; cd /usr/include; $cdir/h2ph * sys/* machine/*)
+
+#The SYS5 headers (only sys) are overlayed by the BSD headers.  It  seems
+#all ok, but once I am going into details,  a  lot  of  limitations  from
+#'h2ph' are coming up. Lines like "#define NODEV (dev_t)(-1)"  result  in
+#syntax errors as converted by h2ph. 
+
+# Generally, h2ph might need a lot of help.
index c3a9830a8933b53ac93efcc916faaa84e025a7fc..74bae055bf945553151387cbdc5e5a3edb2606f2 100644 (file)
@@ -33,7 +33,7 @@ case "$osvers" in
        ;;
 1.1*)  d_dlopen="$define"
        cccdlflags='-DPIC -fpic'
-       lddlflags='-Bshareable $lddlflags'
+       lddlflags="-Bshareable $lddlflags"
        malloctype='void *'
        groupstype='int'
        d_setregid='undef'
@@ -44,7 +44,7 @@ case "$osvers" in
 2.0-RELEASE*)
        d_dlopen="$define"
        cccdlflags='-DPIC -fpic'
-       lddlflags='-Bshareable $lddlflags'
+       lddlflags="-Bshareable $lddlflags"
        d_setregid='undef'
        d_setreuid='undef'
        d_setrgid='undef'
@@ -58,7 +58,7 @@ case "$osvers" in
 2.0.5*|2.0-BUILD|2.1*)
        d_dlopen="$define"
        cccdlflags='-DPIC -fpic'
-       lddlflags='-Bshareable $lddlflags'
+       lddlflags="-Bshareable $lddlflags"
        # Are these defines necessary?  Doesn't Configure find them
        # correctly?
        d_setregid='define'
index 66c28dc01c2589345178bb397c1f9059320953a4..b8dbc25698ab64b424ab37142390b272645c8693 100644 (file)
@@ -80,8 +80,8 @@ else
 You don't have an ELF gcc.  I will use dld if possible.  If you are
 using a version of DLD earlier than 3.2.6, or don't have it at all, you
 should probably upgrade. If you are forced to use 3.2.4, you should
-uncomment a couple of lines in hints/linux.sh and rerun Configure to
-disallow shared libraries.
+uncomment a couple of lines in hints/linux.sh and restart Configure so
+that shared libraries will be disallowed.
 
 EOM
     lddlflags="-r $lddlflags"
@@ -96,23 +96,28 @@ EOM
     #ldflags="-static"
     #so='none'
 fi
-rm -rf try.c a.out
 
-case "$BASH_VERSION" in
-1.14.3*)
-    cat <<'EOM'
+rm -f try.c a.out
 
-If you get failure of op/exec test #5 during the test phase, you probably
-have a buggy version of bash. Upgrading to a recent version (1.14.4 or
-later) should fix the problem.
+if /bin/bash -c exit; then
+  echo You appear to have a working bash. Good.
+else
+  cat << 'EOM'
+Warning: it would appear you have a defective bash shell installed. This is
+likely to give you a failure of op/exec test #5 during the test phase of the
+build, Upgrading to a recent version (1.14.4 or later) should fix the
+problem.
 
 EOM
-;;
-esac
+
+fi
 
 # In addition, on some systems there is a problem with perl and NDBM, which
 # causes AnyDBM and NDBM_File to lock up. This is evidenced in the tests as
 # AnyDBM just freezing.  Currently we disable NDBM for all linux systems.
 # If someone can suggest a more robust test, that would be appreciated.
+# This will generate a harmless message:
+# Hmm...You had some extra variables I don't know about...I'll try to keep 'em.
+#      Propagating recommended variable d_dbm_open
 d_dbm_open=undef
 
index 11682e196897ead591f496fed0b44e047107e20c..daf3aec0088454543b48a779255bc5c162af8b0c 100644 (file)
@@ -39,3 +39,7 @@ usenm='false'
 # If you want to use nm, you'll probably have to use nm -p.  The
 # following does that for you:
 nm_opt='-p'
+
+# I have received one report that you can't include utime.h in
+# pp_sys.c.  Uncomment the following line if that happens to you:
+# i_utime=undef
index 449498c3673f15f137d72ed767e473f21ca523a6..b38915872c7adbf562d27b0d40d251d57bf13ff8 100644 (file)
@@ -43,22 +43,30 @@ AUTOLOAD {
     goto &$AUTOLOAD;
 }
                             
-sub import
-{
- my ($callclass, $callfile, $callline,$path,$callpack) = caller(0);
- ($callpack = $callclass) =~ s#::#/#;
- if (defined($path = $INC{$callpack . '.pm'}))
-  {
-   if ($path =~ s#^(.*)$callpack\.pm$#$1auto/$callpack/autosplit.ix# && -e $path) 
-    {
-     eval {require $path}; 
-     carp $@ if ($@);  
+sub import {
+    my ($callclass, $callfile, $callline,$path,$callpack) = caller(0);
+    ($callpack = $callclass) =~ s#::#/#;
+    # Try to find the autosplit index file.  Eg., if the call package
+    # is POSIX, then $INC{POSIX.pm} is something like
+    # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in
+    # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that.
+    #
+    # However, if @INC is a relative path, this might not work.  If,
+    # for example, @INC = ('lib'), then
+    # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require
+    # 'auto/POSIX/autosplit.ix' (without the leading 'lib').
+    #
+    if (defined($path = $INC{$callpack . '.pm'})) {
+       # Try absolute path name.
+       $path =~ s#^(.*)$callpack\.pm$#$1auto/$callpack/autosplit.ix#;
+       eval { require $path; };
+       # If that failed, try relative path with normal @INC searching.
+       if ($@) {
+           $path ="auto/$callpack/autosplit.ix";
+           eval { require $path; };
+       }
+       carp $@ if ($@);  
     } 
-   else 
-    {
-     croak "Have not loaded $callpack.pm";
-    }
-  }
 }
 
 1;
index 3be47e005ca8c69abf8647b87ef5c5e083fec077..e46b732e378572ae0902d9c819400460eb64e43f 100755 (executable)
@@ -132,14 +132,40 @@ a type and name pair.
 When parsing the OUTPUT arguments check that they are all present in
 the corresponding input argument definitions.
 
+=head2 1.5 
+
+Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 1 June 1995.
+
+Started tidy up to allow clean run using C<-w> flag. 
+
+Added some more error checking.
+
+The CASE: functionality now works.
+
+=head2 1.6 
+
+Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 3 June 1995.
+
+Added some more error checking.
+
+=head2 1.7 
+
+Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 5 June 1995.
+
+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.
+
 =head1 SEE ALSO
 
 perl(1)
 
 =cut
 
+use FileHandle ;
+
 # Global Constants
-$XSUBPP_version = "1.4" ;
+$XSUBPP_version = "1.7" ;
 
 $usage = "Usage: xsubpp [-C++] [-except] [-typemap typemap] file.xs\n";
 
@@ -155,8 +181,8 @@ SWITCH: while ($ARGV[0] =~ s/^-//) {
 chop($pwd = `pwd`);
 # Check for error message from VMS
 if ($pwd =~ /unrecognized command verb/) { $Is_VMS = 1; $pwd = $ENV{DEFAULT} }
-($dir, $filename) = @ARGV[0] =~ m#(.*)/(.*)#
-       or ($dir, $filename) = @ARGV[0] =~ m#(.*[>\]])(.*)#
+($dir, $filename) = $ARGV[0] =~ m#(.*)/(.*)#
+       or ($dir, $filename) = $ARGV[0] =~ m#(.*[>\]])(.*)#
        or ($dir, $filename) = ('.', $ARGV[0]);
 chdir($dir);
 
@@ -196,6 +222,7 @@ foreach $typemap (@tm) {
     open(TYPEMAP, $typemap) 
        or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
     $mode = Typemap;
+    $junk = "" ;
     $current = \$junk;
     while (<TYPEMAP>) {
        next if /^#/;
@@ -209,7 +236,7 @@ foreach $typemap (@tm) {
            # skip blank lines and comment lines
            next if /^$/ or /^#/ ;
            my @words = split (' ') ;
-           blurt("Error: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 columns\n"), next 
+           warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 columns\n"), next 
                unless @words >= 2 ;
            my $kind = pop @words ;
             TrimWhitespace($kind) ;
@@ -251,6 +278,8 @@ sub Q {
     $text;
 }
 
+open(F, $filename) or die "cannot open $filename: $!\n";
+
 # Identify the version of xsubpp used
 $TimeStamp = localtime ;
 print <<EOM ;
@@ -263,8 +292,6 @@ print <<EOM ;
 EOM
  
 
-open(F, $filename) or die "cannot open $filename: $!\n";
-
 while (<F>) {
     last if ($Module, $foo, $Package, $foo1, $Prefix) =
        /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/;
@@ -276,6 +303,7 @@ $lastline = $_;
 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*$/) {
@@ -294,10 +322,11 @@ sub fetch_para {
                    !/^#[ \t]*(if|ifdef|ifndef|else|elif|endif|define|undef)\b/;
                last if /^\S/;
            }
-           push(@line, $_) if $_ ne "";
+           push(@line, $_), push(@line_no, input_line_number F) if $_ ne "";
        }
        else {
            push(@line, $lastline);
+            push(@line_no, $lastline_no) ;
        }
        $lastline = "";
        while (<F>) {
@@ -306,18 +335,21 @@ sub fetch_para {
            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) ;
            }
        }
-       pop(@line) while @line && $line[-1] =~ /^\s*$/;
+       pop(@line), pop(@line_no) while @line && $line[-1] =~ /^\s*$/;
     }
     $PPCODE = grep(/PPCODE:/, @line);
     scalar @line;
 }
 
+PARAGRAPH:
 while (&fetch_para) {
     # initialize info arrays
     undef(%args_match);
@@ -332,21 +364,37 @@ while (&fetch_para) {
 
     # extract return type, function name and arguments
     $ret_type = TidyType(shift(@line));
+
     if ($ret_type =~ /^BOOT:/) {
         push (@BootCode, @line, "", "") ;
-        next ;
+        next PARAGRAPH ;
     }
+
+    # a function definition needs at least 2 lines
+    blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
+       unless @line ;
+
     if ($ret_type =~ /^static\s+(.*)$/) {
            $static = 1;
            $ret_type = $1;
     }
     $func_header = shift(@line);
-    ($func_name, $orig_args) =  $func_header =~ /^([\w:]+)\s*\((.*)\)$/;
+    blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
+       unless $func_header =~ /^([\w:]+)\s*\((.*)\)$/;
+
+    ($func_name, $orig_args) =  ($1, $2) ;
     if ($func_name =~ /(.*)::(.*)/) {
            $class = $1;
            $func_name = $2;
     }
+    $Prefix = '' unless defined $Prefix ; # keep -w happy
     ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
+
+    # Check for duplicate function definition
+    blurt("Error: ignoring duplicate function definition '$func_name'"), next PARAGRAPH
+       if defined $Func_name{"${Packid}_$func_name"} ;
+    $Func_name{"${Packid}_$func_name"} ++ ;
+
     push(@Func_name, "${Packid}_$func_name");
     push(@Func_pname, $pname);
     @args = split(/\s*,\s*/, $orig_args);
@@ -368,7 +416,7 @@ while (&fetch_para) {
            if ($args[$i] =~ s/\.\.\.//) {
                    $elipsis = 1;
                    $min_args--;
-                   if ($args[i] eq '' && $i == $num_args - 1) {
+                   if ($args[$i] eq '' && $i == $num_args - 1) {
                        pop(@args);
                        last;
                    }
@@ -421,22 +469,31 @@ EOF
     # Now do a block of some sort.
 
     $condnum = 0;
+    $else_cond = 0 ;
     if (!@line) {
        @line = "CLEANUP:";
     }
     while (@line) {
-       if ($_[0] =~ s/^\s*CASE\s*:\s*//) {
+       if ($line[0] =~ s/^\s*CASE\s*:\s*//) {
            $cond = shift(@line);
+            TrimWhitespace($cond) ;
            if ($condnum == 0) {
-               print "    if ($cond)\n";
+               # Check $cond is not blank
+               blurt("Error: First CASE: needs a condition") 
+                   if $cond eq '' ;
+               print "    if ($cond)\n"
            }
            elsif ($cond ne '') {
                print "    else if ($cond)\n";
            }
            else {
+               blurt ("Error: Too many CASE: statements without a condition")
+                   unless $else_cond ;
+               ++ $else_cond  ;
                print "    else\n";
            }
            $condnum++;
+            $_ = '' ;
        }
 
        if ($except) {
@@ -454,6 +511,8 @@ EOF
        $thisdone = 0;
        $retvaldone = 0;
        $deferred = "";
+       %arg_list = () ;
+        $gotRETVAL = 0;
        while (@line) {
                $_ = shift(@line);
                last if /^\s*NOT_IMPLEMENTED_YET/;
@@ -463,8 +522,13 @@ EOF
                 # skip blank lines 
                 next if /^$/ ;
                my $line = $_ ;
+
+                # remove trailing semicolon if no initialisation
+                s/\s*;+\s*$//g unless /=/ ;
+
                # check for optional initialisation code
-               my $var_init = $1 if s/\s*(=.*)$// ;
+               my $var_init = '' ;
+               $var_init = $1 if s/\s*(=.*)$// ;
 
                 my @words = split (' ') ;
                 blurt("Error: invalid argument declaration '$line'"), next
@@ -472,9 +536,6 @@ EOF
                 my $var_name = pop @words ;
                my $var_type = "@words" ;
 
-               # catch C style argument declaration (this could be made alowable syntax)
-               warn("Warning: ignored semicolon in $pname argument declaration '$_'\n")
-                       if ($var_name =~ s/;//g); # eg SV *<tab>name;
                # catch many errors similar to: SV<tab>* name
                blurt("Error: invalid $pname argument name '$var_name' (type '$var_type')\n")
                        unless ($var_name =~ m/^&?\w+$/);
@@ -493,7 +554,7 @@ EOF
                print "\t" . &map_type($var_type);
                $var_num = $args_match{$var_name};
                if ($var_addr{$var_name}) {
-                       $func_args =~ s/\b($var_name)\b/&\1/;
+                       $func_args =~ s/\b($var_name)\b/&$1/;
                }
                if ($var_init !~ /^=\s*NO_INIT\s*$/) {
                        if ($var_init !~ /^\s*$/) {
@@ -536,7 +597,7 @@ EOF
                        print $deferred;
                        while (@line) {
                                $_ = shift(@line);
-                               die "PPCODE must be last thing"
+                               death ("PPCODE must be last thing")
                                    if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/;
                                print "$_\n";
                        }
@@ -572,26 +633,25 @@ EOF
                                $func_name = $2;
                        }
                        print "$func_name($func_args);\n";
-                       $wantRETVAL = 1 
-                           unless $ret_type eq "void";
+                       $wantRETVAL = 1 unless $ret_type eq "void";
                }
        }
 
        # do output variables
        if (/^\s*OUTPUT\s*:/) {
-               my $gotRETVAL ;
+               $gotRETVAL = 0;
+               my $RETVAL_code ;
                my %outargs ;
                while (@line) {
                        $_ = shift(@line);
-                       last if /^\s*CLEANUP\s*:/;
+                       last if /^\s*CLEANUP|CASE\s*:/;
                        TrimWhitespace($_) ;
                        next if /^$/ ;
                        my ($outarg, $outcode) = /^(\S+)\s*(.*)/ ;
                        if (!$gotRETVAL and $outarg eq 'RETVAL') {
                            # deal with RETVAL last
-                           push(@line, $_) ;
+                           $RETVAL_code = $outcode ;
                            $gotRETVAL = 1 ;
-                           undef ($wantRETVAL) ;
                            next ;
                        }
                        blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next
@@ -608,11 +668,18 @@ EOF
                                    $outarg); 
                        }
                }
+
+               if ($gotRETVAL) {
+                       if ($RETVAL_code) 
+                            { print "\t$RETVAL_code\n" }
+                       else 
+                           { &generate_output($ret_type, 0, 'RETVAL') }
+               }
        }
 
        # all OUTPUT done, so now push the return value on the stack
        &generate_output($ret_type, 0, "RETVAL")
-            if $wantRETVAL ;
+            if $wantRETVAL and ! $gotRETVAL ;
 
        # do cleanup
        if (/^\s*CLEANUP\s*:/) {
@@ -690,7 +757,25 @@ sub output_init {
     eval qq/print " $init\\\n"/;
 }
 
-sub blurt { warn @_; $errors++ }
+sub Warn
+{
+    # work out the line number
+    my $line_no = $line_no[@line_no - @line -1] ;
+    print STDERR "@_ in $filename, line $line_no\n" ;
+}
+
+sub blurt 
+{ 
+    Warn @_ ;
+    $errors ++ 
+}
+
+sub death
+{
+    Warn @_ ;
+    exit 1 ;
+}
 
 sub generate_init {
     local($type, $num, $var) = @_;
@@ -700,7 +785,9 @@ sub generate_init {
     local($tk);
 
     $type = TidyType($type) ;
-    blurt("Error: '$type' not in typemap"), return unless defined($type_kind{$type});
+    blurt("Error: '$type' not in typemap"), return 
+       unless defined($type_kind{$type});
+
     ($ntype = $type) =~ s/\s*\*/Ptr/g;
     $subtype = $ntype;
     $subtype =~ s/Ptr$//;
@@ -708,8 +795,14 @@ sub generate_init {
     $tk = $type_kind{$type};
     $tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/;
     $type =~ s/:/_/g;
+    blurt("Error: No INPUT definition for type '$type' found"), return
+        unless defined $input_expr{$tk} ;
     $expr = $input_expr{$tk};
     if ($expr =~ /DO_ARRAY_ELEM/) {
+        blurt("Error: '$subtype' not in typemap"), return 
+           unless defined($type_kind{$subtype});
+        blurt("Error: No INPUT definition for type '$subtype' found"), return
+            unless defined $input_expr{$type_kind{$subtype}} ;
        $subexpr = $input_expr{$type_kind{$subtype}};
        $subexpr =~ s/ntype/subtype/g;
        $subexpr =~ s/\$arg/ST(ix_$var)/g;
@@ -743,6 +836,8 @@ sub generate_output {
     } else {
            blurt("Error: '$type' not in typemap"), return
                unless defined($type_kind{$type});
+            blurt("Error: No OUTPUT definition for type '$type' found"), return
+                unless defined $output_expr{$type_kind{$type}} ;
            ($ntype = $type) =~ s/\s*\*/Ptr/g;
            $ntype =~ s/\(\)//g;
            $subtype = $ntype;
@@ -750,6 +845,10 @@ sub generate_output {
            $subtype =~ s/Array$//;
            $expr = $output_expr{$type_kind{$type}};
            if ($expr =~ /DO_ARRAY_ELEM/) {
+               blurt("Error: '$subtype' not in typemap"), return
+                   unless defined($type_kind{$subtype});
+                blurt("Error: No OUTPUT definition for type '$subtype' found"), return
+                    unless defined $output_expr{$type_kind{$subtype}} ;
                $subexpr = $output_expr{$type_kind{$subtype}};
                $subexpr =~ s/ntype/subtype/g;
                $subexpr =~ s/\$arg/ST(ix_$var)/g;
@@ -771,12 +870,6 @@ sub generate_output {
            elsif ($arg =~ /^ST\(\d+\)$/) {
                eval "print qq\a$expr\a";
            }
-           elsif ($arg =~ /^ST\(\d+\)$/) {
-               eval "print qq\a$expr\a";
-           }
-           elsif ($arg =~ /^ST\(\d+\)$/) {
-               eval "print qq\a$expr\a";
-           }
     }
 }
 
@@ -794,4 +887,4 @@ sub map_type {
 # 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) ;
index 35c802536760fd16d298c79b7c123b2d3c33b280..170032c1b322349cc28d8b93bb71560e5258b1c8 100644 (file)
@@ -23,14 +23,21 @@ You can compare $s1 and $s2 above with
 
 to extract the data itself, you'll need a dereference: $$s1
 
-This uses POSIX::setlocale The basic collation conversion is done by
+This uses POSIX::setlocale. The basic collation conversion is done by
 strxfrm() which terminates at NUL characters being a decent C routine.
 collate_xfrm() handles embedded NUL characters gracefully.  Due to C<cmp>
 and overload magic, C<lt>, C<le>, C<eq>, C<ge>, and C<gt> work also.  The
 available locales depend on your operating system; try whether C<locale
--a> shows them or the more direct approach C<ls /usr/lib/nls/loc> or C<ls
-/usr/lib/nls>.  The locale names are probably something like
-"xx_XX.(ISO)?8859-N".
+-a> shows them or man pages for "locale" or "nlsinfo" or
+the direct approach C<ls /usr/lib/nls/loc> or C<ls
+/usr/lib/nls>.  Not all the locales that your vendor supports
+are necessarily installed: please consult your operating system's
+documentation.
+
+The locale names are probably something like
+C<"xx_XX.(ISO)?8859-N"> or C<"xx_XX.(ISO)?8859N">, for example
+C<"fr_CH.ISO8859-1"> is the Swiss (CH) variant of French (fr),
+ISO Latin (8859) 1 (-1) which is the Western European character set.
 
 =cut
 
@@ -54,7 +61,7 @@ available locales depend on your operating system; try whether C<locale
 # Overloads:   cmp # 3)
 #
 # Usage:       use Collate;
-#              setlocale(&LC_COLLATE, 'locale-of-your-choice'); # 4)
+#              setlocale(LC_COLLATE, 'locale-of-your-choice'); # 4)
 #              $s1 = new Collate "scalar_data_1";
 #              $s2 = new Collate "scalar_data_2";
 #              
@@ -68,12 +75,19 @@ available locales depend on your operating system; try whether C<locale
 #                 collate_xfrm handles embedded NUL characters gracefully.
 #              3) due to cmp and overload magic, lt le eq ge gt work also
 #              4) the available locales depend on your operating system;
-#                 try whether "locale -a" shows them or the more direct
+#                 try whether "locale -a" shows them or man pages for
+#                 "locale" or "nlsinfo" work or the more direct
 #                 approach "ls /usr/lib/nls/loc" or "ls /usr/lib/nls".
+#                 Not all the locales that your vendor supports
+#                 are necessarily installed: please consult your
+#                 operating system's documentation.
 #                 The locale names are probably something like
-#                 'xx_XX.(ISO)?8859-N'.
+#                 'xx_XX.(ISO)?8859-N' or 'xx_XX.(ISO)?8859N',
+#                 for example 'fr_CH.ISO8859-1' is the Swiss (CH)
+#                 variant of French (fr), ISO Latin (8859) 1 (-1)
+#                 which is the Western European character set.
 #
-# Updated:     19940913 1341 GMT
+# Updated:     19950602 1601 GMT
 #
 # ---
 
index e87a9b260c7dadd337238beda4f7df8ac04609e2..f366cdb6fdb8c127c4bbca60f6dbe9f3fd05c1f2 100644 (file)
@@ -89,7 +89,7 @@
 #
 
 require 'chat2.pl';
-require 'socket.ph';
+eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" || die "socket.ph missing: $!\n";
 
 
 package ftp;
index a3214ba715dfbbe2699f2fcbde342eab7194dacb..8db8e20c0698f6b9b6edf49cb33ad38ce71149de 100644 (file)
@@ -36,7 +36,7 @@ sub getcwd
        {
            do
            {
-               unless ($dir = readdir(getcwd'PARENT))                  #'))
+               unless (defined ($dir = readdir(getcwd'PARENT)))        #'))
                {
                    warn "readdir($dotdots): $!";
                    closedir(getcwd'PARENT);                            #');
index c65b41d644cfc2069a8dd87c0f570feb894c224f..bb266f4e345c99a2a940e4531120e6993f21e74b 100644 (file)
@@ -18,7 +18,7 @@ case "$0" in
 esac
 echo "Extracting makeaperl (with variable substitutions)"
 $spitshell >makeaperl <<!GROK!THIS!
-#!$bin/perl
+#!$binexp/perl
 !GROK!THIS!
 
 $spitshell >>makeaperl <<'!NO!SUBS!'
diff --git a/perl.c b/perl.c
index eee8e0f902494eb15e3575a3bcc765a27f81d6e1..00c7b3c2d57318ac42a29add4b7b603745e0f459 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -996,7 +996,7 @@ char *s;
        return s;
     case 'v':
        printf("\nThis is perl, version %s\n\n",patchlevel);
-       fputs("\tUnofficial patchlevel 1i.\n",stdout);
+       fputs("\tUnofficial patchlevel 1j.\n",stdout);
        fputs("\nCopyright 1987-1994, Larry Wall\n",stdout);
 #ifdef MSDOS
        fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
index e752f56c14b0cd1e8785b611e965858962bb0a82..f184d9323fc48069c44e7da599e195ff3e4d64e9 100644 (file)
@@ -18,7 +18,7 @@ case "$0" in
 esac
 echo "Extracting perldoc (with variable substitutions)"
 $spitshell >perldoc <<!GROK!THIS!
-#!$bin/perl
+#!$binexp/perl
 !GROK!THIS!
 
 $spitshell >>perldoc <<'!NO!SUBS!'
@@ -149,7 +149,7 @@ sub containspod {
 sub searchfor {
        my($s,@dirs) = @_;
        $s =~ s!::!/!g;
-       printf STDERR "looking for $s in @dirs\n";
+       printf STDERR "looking for $s in @dirs\n";
        
        foreach $dir (@dirs) {
                if( -f "$dir/$s.pod") { return "$dir/$s.pod" }
index fb94560948ec461a6af21c5050f6fb7184cab532..de2207a9617acca9699f88f7250727e6288f908d 100644 (file)
@@ -1,6 +1,6 @@
 =head1 NAME
 
-perlbot - Bag'o Object Tricks For Perl5 (the BOT)
+perlbot - Bag'o Object Tricks (the BOT)
 
 =head1 INTRODUCTION
 
@@ -8,11 +8,72 @@ The following collection of tricks and hints is intended to whet curious
 appetites about such things as the use of instance variables and the
 mechanics of object and class relationships.  The reader is encouraged to
 consult relevant textbooks for discussion of Object Oriented definitions and
-methodology.  This is not intended as a comprehensive guide to Perl5's
-object oriented features, nor should it be construed as a style guide.
+methodology.  This is not intended as a tutorial for object-oriented
+programming or as a comprehensive guide to Perl's object oriented features,
+nor should it be construed as a style guide.
 
 The Perl motto still holds:  There's more than one way to do it.
 
+=head1 OO SCALING TIPS
+
+=over 5
+
+=item 1
+
+Do not attempt to verify the type of $self.  That'll break if the class is
+inherited, when the type of $self is valid but its package isn't what you
+expect.  See rule 5.
+
+=item 2
+
+If an object-oriented (OO) or indirect-object (IO) syntax was used, then the
+object is probably the correct type and there's no need to become paranoid
+about it.  Perl isn't a paranoid language anyway.  If people subvert the OO
+or IO syntax then they probably know what they're doing and you should let
+them do it.  See rule 1.
+
+=item 3
+
+Use the two-argument form of bless().  Let a subclass use your constructor.
+See L<INHERITING A CONSTRUCTOR>.
+
+=item 4
+
+The subclass is allowed to know things about its immediate superclass, the
+superclass is allowed to know nothing about a subclass.
+
+=item 5
+
+Don't be trigger happy with inheritance.  A "using", "containing", or
+"delegation" relationship (some sort of aggregation, at least) is often more
+appropriate.  See L<OBJECT RELATIONSHIPS>, L<USING RELATIONSHIP WITH SDBM>,
+and L<"DELEGATION">.
+
+=item 6
+
+The object is the namespace.  Make package globals accessible via the
+object.  This will remove the guess work about the symbol's home package.
+See L<CLASS CONTEXT AND THE OBJECT>.
+
+=item 7
+
+IO syntax is certainly less noisy, but it is also prone to ambiguities which
+can cause difficult-to-find bugs.  Allow people to use the sure-thing OO
+syntax, even if you don't like it.
+
+=item 8
+
+Do not use function-call syntax on a method.  You're going to be bitten
+someday.  Someone might move that method into a superclass and your code
+will be broken.  On top of that you're feeding the paranoia in rule 2.
+
+=item 9
+
+Don't assume you know the home package of a method.  You're making it
+difficult for someone to override that method.  See L<THINKING OF CODE REUSE>.
+
+=back
+
 =head1 INSTANCE VARIABLES
 
 An anonymous array or anonymous hash can be used to hold instance
@@ -26,7 +87,7 @@ variables.  Named parameters are also demonstrated.
                my $self = {};
                $self->{'High'} = $params{'High'};
                $self->{'Low'}  = $params{'Low'};
-               bless $self;
+               bless $self, $type;
        }
 
 
@@ -38,20 +99,19 @@ variables.  Named parameters are also demonstrated.
                my $self = [];
                $self->[0] = $params{'Left'};
                $self->[1] = $params{'Right'};
-               bless $self;
+               bless $self, $type;
        }
 
        package main;
 
-       $a = new Foo ( 'High' => 42, 'Low' => 11 );
+       $a = Foo->new( 'High' => 42, 'Low' => 11 );
        print "High=$a->{'High'}\n";
        print "Low=$a->{'Low'}\n";
 
-       $b = new Bar ( 'Left' => 78, 'Right' => 40 );
+       $b = Bar->new( 'Left' => 78, 'Right' => 40 );
        print "Left=$b->[0]\n";
        print "Right=$b->[1]\n";
 
-
 =head1 SCALAR INSTANCE VARIABLES
 
 An anonymous scalar can be used when only one instance variable is needed.
@@ -62,12 +122,12 @@ An anonymous scalar can be used when only one instance variable is needed.
                my $type = shift;
                my $self;
                $self = shift;
-               bless \$self;
+               bless \$self, $type;
        }
 
        package main;
 
-       $a = new Foo 42;
+       $a = Foo->new( 42 );
        print "a=$$a\n";
 
 
@@ -81,23 +141,25 @@ object.
        package Bar;
 
        sub new {
+               my $type = shift;
                my $self = {};
                $self->{'buz'} = 42;
-               bless $self;
+               bless $self, $type;
        }
 
        package Foo;
        @ISA = qw( Bar );
 
        sub new {
-               my $self = new Bar;
+               my $type = shift;
+               my $self = Bar->new;
                $self->{'biz'} = 11;
-               bless $self;
+               bless $self, $type;
        }
 
        package main;
 
-       $a = new Foo;
+       $a = Foo->new;
        print "buz = ", $a->{'buz'}, "\n";
        print "biz = ", $a->{'biz'}, "\n";
 
@@ -111,23 +173,25 @@ relationships between objects.
        package Bar;
 
        sub new {
+               my $type = shift;
                my $self = {};
                $self->{'buz'} = 42;
-               bless $self;
+               bless $self, $type;
        }
 
        package Foo;
 
        sub new {
+               my $type = shift;
                my $self = {};
-               $self->{'Bar'} = new Bar ();
+               $self->{'Bar'} = Bar->new;
                $self->{'biz'} = 11;
-               bless $self;
+               bless $self, $type;
        }
 
        package main;
 
-       $a = new Foo;
+       $a = Foo->new;
        print "buz = ", $a->{'Bar'}->{'buz'}, "\n";
        print "biz = ", $a->{'biz'}, "\n";
 
@@ -154,7 +218,10 @@ method without actually knowing where that method is defined.
        @ISA = qw( Bar Baz );
        @Foo::Inherit::ISA = @ISA;  # Access to overridden methods.
 
-       sub new { bless [] }
+       sub new {
+               my $type = shift;
+               bless [], $type;
+       }
        sub grr { print "grumble\n" }
        sub goo {
                my $self = shift;
@@ -171,27 +238,28 @@ method without actually knowing where that method is defined.
 
        package main;
 
-       $foo = new Foo;
+       $foo = Foo->new;
        $foo->mumble;
        $foo->grr;
        $foo->goo;
        $foo->google;
 
 
-=head1 USING RELATIONSHIP WITH SDBM 
+=head1 USING RELATIONSHIP WITH SDBM
 
 This example demonstrates an interface for the SDBM class.  This creates a
 "using" relationship between the SDBM class and the new class Mydbm.
 
-       use SDBM_File;
-       use POSIX;
-
        package Mydbm;
 
+       require SDBM_File;
+       require TieHash;
+       @ISA = qw( TieHash );
+
        sub TIEHASH {
-           my $self = shift;
+           my $type = shift;
            my $ref  = SDBM_File->new(@_);
-           bless {'dbm' => $ref};
+           bless {'dbm' => $ref}, $type;
        }
        sub FETCH {
            my $self = shift;
@@ -209,6 +277,7 @@ This example demonstrates an interface for the SDBM class.  This creates a
        }
 
        package main;
+       use Fcntl qw( O_RDWR O_CREAT );
 
        tie %foo, Mydbm, "Sdbm", O_RDWR|O_CREAT, 0640;
        $foo{'bar'} = 123;
@@ -230,7 +299,10 @@ that it is impossible to override the BAZ() method.
 
        package FOO;
 
-       sub new { bless {} }
+       sub new {
+               my $type = shift;
+               bless {}, $type;
+       }
        sub bar {
                my $self = shift;
                $self->FOO::private::BAZ;
@@ -253,7 +325,10 @@ FOO::private::BAZ().
 
        package FOO;
 
-       sub new { bless {} }
+       sub new {
+               my $type = shift;
+               bless {}, $type;
+       }
        sub bar {
                my $self = shift;
                $self->FOO::private::BAZ;
@@ -267,7 +342,10 @@ FOO::private::BAZ().
 
        package GOOP;
        @ISA = qw( FOO );
-       sub new { bless {} }
+       sub new {
+               my $type = shift;
+               bless {}, $type;
+       }
 
        sub BAZ {
                print "in GOOP::BAZ\n";
@@ -284,7 +362,10 @@ method GOOP::BAZ() to be used in place of FOO::BAZ().
 
        package FOO;
 
-       sub new { bless {} }
+       sub new {
+               my $type = shift;
+               bless {}, $type;
+       }
        sub bar {
                my $self = shift;
                $self->BAZ;
@@ -297,7 +378,10 @@ method GOOP::BAZ() to be used in place of FOO::BAZ().
        package GOOP;
        @ISA = qw( FOO );
 
-       sub new { bless {} }
+       sub new {
+               my $type = shift;
+               bless {}, $type;
+       }
        sub BAZ {
                print "in GOOP::BAZ\n";
        }
@@ -330,9 +414,10 @@ method where that data is located.
        %fizzle = ( 'Password' => 'XYZZY' );
 
        sub new {
+               my $type = shift;
                my $self = {};
                $self->{'fizzle'} = \%fizzle;
-               bless $self;
+               bless $self, $type;
        }
 
        sub enter {
@@ -353,9 +438,10 @@ method where that data is located.
        %fizzle = ( 'Password' => 'Rumple' );
 
        sub new {
+               my $type = shift;
                my $self = Bar->new;
                $self->{'fizzle'} = \%fizzle;
-               bless $self;
+               bless $self, $type;
        }
 
        package main;
index d37cbbe87c781a87f49eb90963e495773da0b5ca..6aaa5d20e0a4790329c492f936eac2fc0631ae41 100755 (executable)
@@ -17,8 +17,8 @@ esac
 echo "Extracting pod/pod2html (with variable substitutions)"
 rm -f pod2html
 $spitshell >pod2html <<!GROK!THIS!
-#!$bin/perl
-eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
+#!$binexp/perl
+eval 'exec perl -S \$0 \${1+"\$@"}'
        if \$running_under_some_shell;
 !GROK!THIS!
 
index 7c9d1f67899992250bfd9ad4de6057a557ec2483..45f64232be2e5218ed277addc6c4264722bef6b9 100755 (executable)
@@ -17,8 +17,8 @@ esac
 echo "Extracting pod/pod2latex (with variable substitutions)"
 rm -f pod2latex
 $spitshell >pod2latex <<!GROK!THIS!
-#!$bin/perl
-eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
+#!$binexp/perl
+eval 'exec perl -S \$0 \${1+"\$@"}'
        if \$running_under_some_shell;
 !GROK!THIS!
 
index 1528b0190c093dbe124ed85e86be1c125f2c2276..a1be14d4e526f629b484ad0a838b4e40088decd8 100755 (executable)
@@ -17,8 +17,8 @@ esac
 echo "Extracting pod/pod2man (with variable substitutions)"
 rm -f pod2man
 $spitshell >pod2man <<!GROK!THIS!
-#!$bin/perl
-eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
+#!$binexp/perl
+eval 'exec perl -S \$0 \${1+"\$@"}'
        if \$running_under_some_shell;
 !GROK!THIS!
 
diff --git a/sv.c b/sv.c
index f97c5646bfe0473cf77ae13b708d6aec5755623d..93a462f64e9ae305c89f8fb569123f73664e8617 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2368,7 +2368,7 @@ register FILE *fp;
 I32 append;
 {
     register char *bp;         /* we're going to steal some values */
-#ifdef USE_STDIO_PTR
+#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
     register I32 cnt;          /*  from the stdio struct and put EVERYTHING */
     register STDCHAR *ptr;     /*   in the innermost loop into registers */
     STRLEN bpx;
@@ -2398,7 +2398,8 @@ I32 append;
            }
        } while (i != EOF);
     }
-#ifdef USE_STDIO_PTR   /* Here is some breathtakingly efficient cheating */
+#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
+    /* Here is some breathtakingly efficient cheating */
     cnt = FILE_cnt(fp);                        /* get count into register */
     (void)SvPOK_only(sv);              /* validate pointer */
     if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
@@ -2466,8 +2467,8 @@ thats_really_all_folks:
     *bp = '\0';
     SvCUR_set(sv, bp - SvPVX(sv));     /* set length */
 
-#else /* !USE_STDIO_PTR */     /* The big, slow, and stupid way */
-
+#else /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
+    /*The big, slow, and stupid way */
     {
        char buf[8192];
        register char * bpe = buf + sizeof(buf) - 3;
@@ -2499,7 +2500,7 @@ screamer:
        }
     }
 
-#endif /* USE_STDIO_PTR */
+#endif /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
 
     if (rspara) {
         while (i != EOF) {
diff --git a/toke.c b/toke.c
index 9b9db64ed4fd13b77e50154f21cd77bf32c6d12e..0d3f74a98e5b6d5db8e1480e1a9385eca3c0bd03 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2366,7 +2366,7 @@ yylex()
                        TOKEN('&');
                    }
                    if (lastchar == '-')
-                       warn("Ambiguious use of -%s resolved as -&%s()",
+                       warn("Ambiguous use of -%s resolved as -&%s()",
                                tokenbuf, tokenbuf);
                    last_lop = oldbufptr;
                    last_lop_op = OP_ENTERSUB;
@@ -2401,7 +2401,7 @@ yylex()
                if (lastchar && strchr("*%&", lastchar)) {
                    warn("Operator or semicolon missing before %c%s",
                        lastchar, tokenbuf);
-                   warn("Ambiguious use of %c resolved as operator %c",
+                   warn("Ambiguous use of %c resolved as operator %c",
                        lastchar, lastchar);
                }
                TOKEN(WORD);
index 8ab7f9c39422c5937ee6683ea29b5091fd605af6..3652bde07c6b22e0779c526bcc27dd07b5b3aa8c 100755 (executable)
@@ -23,7 +23,7 @@ echo "Extracting x2p/find2perl (with variable substitutions)"
 : by putting a backslash in front.  You may delete these comments.
 rm -f find2perl
 $spitshell >find2perl <<!GROK!THIS!
-#!$bin/perl
+#!$binexp/perl
 # 
 # Modified September 26, 1993 to provide proper handling of years after 1999
 #   Tom Link <tml+@pitt.edu>
index 5819fd9a219b00c6075e676a65603d726fce77af..a4d5a39dfc6008d015b5e8ff71c64c5a0a2c71cf 100755 (executable)
@@ -24,9 +24,9 @@ echo "Extracting x2p/s2p (with variable substitutions)"
 : by putting a backslash in front.  You may delete these comments.
 rm -f s2p
 $spitshell >s2p <<!GROK!THIS!
-#!$bin/perl
+#!$binexp/perl
 
-eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
+eval 'exec perl -S \$0 \${1+"\$@"}'
        if \$running_under_some_shell;
 
 \$bin = '$bin';
index 9e9d2da4b86d8f3dd6fefd98168a46afd61a16bc..e9dd34400f0dd715654416ef9d21c31341e03d85 100644 (file)
--- a/x2p/str.c
+++ b/x2p/str.c
@@ -287,7 +287,8 @@ str_gets(str,fp)
 register STR *str;
 register FILE *fp;
 {
-#ifdef USE_STDIO_PTR           /* Here is some breathtakingly efficient cheating */
+#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
+    /* Here is some breathtakingly efficient cheating */
 
     register char *bp;         /* we're going to steal some values */
     register int cnt;          /*  from the stdio struct and put EVERYTHING */
@@ -339,7 +340,8 @@ thats_all_folks:
     *bp = '\0';
     str->str_cur = bp - str->str_ptr;  /* set length */
 
-#else /* !USE_STDIO_PTR */     /* The big, slow, and stupid way */
+#else /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
+    /* The big, slow, and stupid way */
 
     static char buf[4192];
 
@@ -348,7 +350,7 @@ thats_all_folks:
     else
        str_set(str, No);
 
-#endif /* USE_STDIO_PTR */
+#endif /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
 
     return str->str_cur ? str->str_ptr : Nullch;
 }