The Grand Trek: move the *.t files from t/ to lib/ and ext/.

No doubt I made some mistakes like missed some files or
misnamed some files.  The naming rules were more or less:
(1) if the module is from CPAN, follows its ways, be it
    t/*.t or test.pl.
(2) otherwise if there are multiple tests for a module
    put them in a t/
(3) otherwise if there's only one test put it in Module.t
(4) helper files go to module/ (locale, strict, warnings)
(5) use longer filenames now that we can (but e.g. the
    compat-0.6.t and the Text::Balanced test files still
    were renamed to be more civil against the 8.3 people)
installperl was updated appropriately not to install the
*.t files or the help files from under lib.

TODO: some helper files still remain under t/ that could
follow their 'masters'.  UPDATE: On second thoughts, why
should they.  They can continue to live under t/lib, and
in fact the locale/strict/warnings helpers that were moved
could be moved back.  This way the amount of non-installable
stuff under lib/ stays smaller.

p4raw-id: //depot/perl@10676

diff --git a/MANIFEST b/MANIFEST
index 05fc4ece7ece35ceaba84a002b12c178db1cda5d..46a98955c533f7d9bb131c6c134fbfa18916bc91 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,32 +1,32 @@
-AUTHORS                        Contact info for contributors
-Artistic               The "Artistic License"
-Changes                        Differences from previous version
-Changes5.000           Differences between 4.x and 5.000
-Changes5.001           Differences between 5.000 and 5.001
-Changes5.002           Differences between 5.001 and 5.002
-Changes5.003           Differences between 5.002 and 5.003
-Changes5.004           Differences between 5.003 and 5.004
-Changes5.005           Differences between 5.004 and 5.005
-Changes5.6             Differences between 5.005 and 5.6
-Configure              Portability tool
-Copying                        The GNU General Public License
-Cross/README           Cross-compilation.
-EXTERN.h               Included before foreign .h files
-INSTALL                        Detailed installation instructions
-INTERN.h               Included before domestic .h files
-MANIFEST               This list of files
-Makefile.SH            A script that generates Makefile
-Makefile.micro         microperl Makefile
-NetWare/CLIBsdio.h     Netware port
-NetWare/CLIBstr.h      Netware port
-NetWare/CLIBstuf.c     Netware port
-NetWare/CLIBstuf.h     Netware port
-NetWare/Main.c Netware port
-NetWare/Makefile       Netware port
-NetWare/NWTInfo.c      Netware port
-NetWare/NWUtil.c       Netware port
-NetWare/Nwmain.c       Netware port
-NetWare/Nwpipe.c       Netware port
+AUTHORS                                Contact info for contributors
+Artistic                       The "Artistic License"
+Changes                                Differences from previous version
+Changes5.000                   Differences between 4.x and 5.000
+Changes5.001                   Differences between 5.000 and 5.001
+Changes5.002                   Differences between 5.001 and 5.002
+Changes5.003                   Differences between 5.002 and 5.003
+Changes5.004                   Differences between 5.003 and 5.004
+Changes5.005                   Differences between 5.004 and 5.005
+Changes5.6                     Differences between 5.005 and 5.6
+Configure                      Portability tool
+Copying                                The GNU General Public License
+Cross/README                   Cross-compilation
+EXTERN.h                       Included before foreign .h files
+INSTALL                                Detailed installation instructions
+INTERN.h                       Included before domestic .h files
+MANIFEST                       This list of files
+Makefile.SH                    A script that generates Makefile
+Makefile.micro                 microperl Makefile
+NetWare/CLIBsdio.h             Netware port
+NetWare/CLIBstr.h              Netware port
+NetWare/CLIBstuf.c             Netware port
+NetWare/CLIBstuf.h             Netware port
+NetWare/Main.c                 Netware port
+NetWare/Makefile               Netware port
+NetWare/NWTInfo.c              Netware port
+NetWare/NWUtil.c               Netware port
+NetWare/Nwmain.c               Netware port
+NetWare/Nwpipe.c               Netware port
 NetWare/bat/BldNWExt.bat       Netware port
 NetWare/bat/Buildtype.bat      Netware port
 NetWare/bat/MPKBuild.bat       Netware port
@@ -36,36 +36,36 @@ NetWare/bat/Setnlmsdk.bat   Netware port
 NetWare/bat/Setwatcom.bat      Netware port
 NetWare/bat/ToggleD2.bat       Netware port
 NetWare/bat/ToggleXDC.bat      Netware port
-NetWare/config.wc      Netware port
-NetWare/config_H.wc    Netware port
-NetWare/config_h.PL    Netware port
-NetWare/config_sh.PL   Netware port
-NetWare/deb.h  Netware port
-NetWare/dl_netware.xs  Netware port
-NetWare/intdef.h       Netware port
-NetWare/interface.c    Netware port
-NetWare/interface.h    Netware port
-NetWare/iperlhost.h    Netware port
-NetWare/netware.h      Netware port
-NetWare/nw5.c  Netware port
-NetWare/nw5iop.h       Netware port
-NetWare/nw5sck.c       Netware port
-NetWare/nw5sck.h       Netware port
-NetWare/nw5thread.c    Netware port
-NetWare/nw5thread.h    Netware port
-NetWare/nwperlsys.c    Netware port
-NetWare/nwperlsys.h    Netware port
-NetWare/nwpipe.h       Netware port
-NetWare/nwplglob.c     Netware port
-NetWare/nwplglob.h     Netware port
-NetWare/nwtinfo.h      Netware port
-NetWare/nwutil.h       Netware port
-NetWare/t/NWModify.pl  Netware port
-NetWare/t/NWScripts.pl Netware port
-NetWare/t/Readme.txt   Netware port
+NetWare/config.wc              Netware port
+NetWare/config_H.wc            Netware port
+NetWare/config_h.PL            Netware port
+NetWare/config_sh.PL           Netware port
+NetWare/deb.h                  Netware port
+NetWare/dl_netware.xs          Netware port
+NetWare/intdef.h               Netware port
+NetWare/interface.c            Netware port
+NetWare/interface.h            Netware port
+NetWare/iperlhost.h            Netware port
+NetWare/netware.h              Netware port
+NetWare/nw5.c                  Netware port
+NetWare/nw5iop.h               Netware port
+NetWare/nw5sck.c               Netware port
+NetWare/nw5sck.h               Netware port
+NetWare/nw5thread.c            Netware port
+NetWare/nw5thread.h            Netware port
+NetWare/nwperlsys.c            Netware port
+NetWare/nwperlsys.h            Netware port
+NetWare/nwpipe.h               Netware port
+NetWare/nwplglob.c             Netware port
+NetWare/nwplglob.h             Netware port
+NetWare/nwtinfo.h              Netware port
+NetWare/nwutil.h               Netware port
+NetWare/t/NWModify.pl          Netware port
+NetWare/t/NWScripts.pl         Netware port
+NetWare/t/Readme.txt           Netware port
 NetWare/testnlm/echo/echo.c    Netware port
 NetWare/testnlm/type/type.c    Netware port
-NetWare/win32ish.h     Netware port
+NetWare/win32ish.h             Netware port
 Policy_sh.SH           Hold site-wide preferences between Configure runs.
 Porting/Contract       Social contract for contributed modules in Perl core
 Porting/Glossary       Glossary of config.sh variables
@@ -101,7 +101,7 @@ README.macos                Notes about Mac OS (Classic)
 README.micro           Notes about microperl
 README.mint            Notes about Atari MiNT port
 README.mpeix           Notes about MPE/iX port
-README.netware Netware port
+README.netware         Notes about Netware port
 README.os2             Notes about OS/2 port
 README.os390           Notes about OS/390 (nee MVS) port
 README.plan9           Notes about Plan9 port
@@ -133,8 +133,8 @@ cygwin/cygwin.c             Additional code for Cygwin port
 cygwin/ld2.in          ld wrapper template for Cygwin port
 cygwin/perlld.in       dll generator template for Cygwin port
 deb.c                  Debugging routines
-djgpp/config.over       DOS/DJGPP port
-djgpp/configure.bat     DOS/DJGPP port
+djgpp/config.over      DOS/DJGPP port
+djgpp/configure.bat    DOS/DJGPP port
 djgpp/djgpp.c          DOS/DJGPP port
 djgpp/djgppsed.sh      DOS/DJGPP port
 djgpp/fixpmain         DOS/DJGPP port
@@ -154,8 +154,9 @@ epoc/epoc.c         EPOC port
 epoc/epoc_stubs.c      EPOC port
 epoc/epocish.c         EPOC port
 epoc/epocish.h         EPOC port
-epoc/link.pl            EPOC port link a exe
+epoc/link.pl           EPOC port link a exe
 ext/B/B.pm             Compiler backend support functions and methods
+ext/B/B.t              See if B works
 ext/B/B.xs             Compiler backend external subroutines
 ext/B/B/Asmdata.pm     Compiler backend data for assembler
 ext/B/B/Assembler.pm   Compiler backend assembler support functions
@@ -177,10 +178,14 @@ ext/B/B/assemble  Assemble compiler bytecode
 ext/B/B/cc_harness     Simplistic wrapper for using -MO=CC compiler
 ext/B/B/disassemble    Disassemble compiler bytecode output
 ext/B/B/makeliblinks   Make a simplistic XSUB .so symlink tree for compiler
+ext/B/Debug.t          See if B::Debug works
+ext/B/Deparse.t                See if B::Deparse works
 ext/B/Makefile.PL      Compiler backend makefile writer
 ext/B/NOTES            Compiler backend notes
 ext/B/O.pm             Compiler front-end module (-MO=...)
 ext/B/README           Compiler backend README
+ext/B/Showlex.t                See if B::ShowLex works
+ext/B/Stash.t          See if B::Stash works
 ext/B/TESTS            Compiler backend test data
 ext/B/Todo             Compiler backend Todo list
 ext/B/defsubs_h.PL     Generator for constant subroutines
@@ -190,7 +195,7 @@ ext/B/ramblings/flip-flop   Compiler ramblings: notes on flip-flop
 ext/B/ramblings/magic          Compiler ramblings: notes on magic
 ext/B/ramblings/reg.alloc      Compiler ramblings: register allocation
 ext/B/ramblings/runtime.porting        Compiler ramblings: porting PP enging
-ext/B/typemap          Compiler backend interface types
+ext/B/typemap                  Compiler backend interface types
 ext/ByteLoader/ByteLoader.pm   Bytecode loader Perl module
 ext/ByteLoader/ByteLoader.xs   Bytecode loader external subroutines
 ext/ByteLoader/Makefile.PL     Bytecode loader makefile writer
@@ -198,16 +203,20 @@ ext/ByteLoader/bytecode.h Bytecode header for bytecode loader
 ext/ByteLoader/byterun.c       Runtime support for bytecode loader
 ext/ByteLoader/byterun.h       Header for byterun.c
 ext/ByteLoader/hints/sunos.pl  Hints for named architecture
-ext/Cwd/Cwd.xs                 Cwd extension external subroutines
-ext/Cwd/Makefile.PL            Cwd extension makefile maker
-ext/DB_File/Changes            Berkeley DB extension change log
-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
-ext/DB_File/Makefile.PL                Berkeley DB extension makefile writer
-ext/DB_File/dbinfo             Berkeley DB database version checker
+ext/Cwd/Cwd.t          See if Cwd works
+ext/Cwd/Cwd.xs         Cwd extension external subroutines
+ext/Cwd/Makefile.PL    Cwd extension makefile maker
+ext/DB_File/Changes    Berkeley DB extension change log
+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
+ext/DB_File/Makefile.PL        Berkeley DB extension makefile writer
+ext/DB_File/dbinfo     Berkeley DB database version checker
 ext/DB_File/hints/dynixptx.pl  Hint for DB_File for named architecture
 ext/DB_File/hints/sco.pl       Hint for DB_File for named architecture
+ext/DB_File/t/db-btree.t       See if DB_File works
+ext/DB_File/t/db-hash.t                See if DB_File works
+ext/DB_File/t/db-recno.t       See if DB_File works
 ext/DB_File/typemap            Berkeley DB extension interface types
 ext/DB_File/version.c          Berkeley DB extension interface version check
 ext/Data/Dumper/Changes                Data pretty printer, changelog
@@ -215,6 +224,8 @@ ext/Data/Dumper/Dumper.pm   Data pretty printer, module
 ext/Data/Dumper/Dumper.xs      Data pretty printer, externals
 ext/Data/Dumper/Makefile.PL    Data pretty printer, makefile writer
 ext/Data/Dumper/Todo           Data pretty printer, futures
+ext/Data/Dumper/t/dumper.t     See if Data::Dumper works
+ext/Data/Dumper/t/overload.t   See if Data::Dumper works for overloaded data
 ext/Devel/DProf/Changes                Perl code profiler changelog
 ext/Devel/DProf/DProf.pm       Perl code profiler
 ext/Devel/DProf/DProf.xs       Perl code profiler
@@ -223,13 +234,18 @@ ext/Devel/DProf/Todo              Perl code profiler todo list
 ext/Devel/Peek/Changes         Data debugging tool, changelog
 ext/Devel/Peek/Makefile.PL     Data debugging tool, makefile writer
 ext/Devel/Peek/Peek.pm         Data debugging tool, module and pod
+ext/Devel/Peek/Peek.t          See if Devel::Peek works
 ext/Devel/Peek/Peek.xs         Data debugging tool, externals
-ext/Digest/MD5/Changes Digest::MD5 extension changes
-ext/Digest/MD5/MD5.pm  Digest::MD5 extension
-ext/Digest/MD5/MD5.xs  Digest::MD5 extension
+ext/Digest/MD5/Changes         Digest::MD5 extension changes
+ext/Digest/MD5/MD5.pm          Digest::MD5 extension
+ext/Digest/MD5/MD5.xs          Digest::MD5 extension
 ext/Digest/MD5/Makefile.PL     Digest::MD5 extension makefile writer
 ext/Digest/MD5/hints/irix_6.pl Hints for named architecture
-ext/Digest/MD5/typemap Digest::MD5 extension
+ext/Digest/MD5/t/aaa.t         See if Digest::MD5 extension works
+ext/Digest/MD5/t/align.t       See if Digest::MD5 extension works
+ext/Digest/MD5/t/badfile.t     See if Digest::MD5 extension works
+ext/Digest/MD5/t/files.t       See if Digest::MD5 extension works
+ext/Digest/MD5/typemap         Digest::MD5 extension
 ext/DynaLoader/DynaLoader_pm.PL        Dynamic Loader perl module
 ext/DynaLoader/Makefile.PL     Dynamic Loader makefile writer
 ext/DynaLoader/README          Dynamic Loader notes and intro
@@ -252,6 +268,7 @@ ext/DynaLoader/hints/aix.pl Hint for DynaLoader for named architecture
 ext/DynaLoader/hints/linux.pl  Hint for DynaLoader for named architecture
 ext/DynaLoader/hints/netbsd.pl Hint for DynaLoader for named architecture
 ext/DynaLoader/hints/openbsd.pl        Hint for DynaLoader for named architecture
+ext/Encode.t                   See if Encode works
 ext/Encode/Encode.pm           Encode extension
 ext/Encode/Encode.xs           Encode extension
 ext/Encode/Encode/EncodeFormat.pod     Encoding table format
@@ -304,12 +321,12 @@ ext/Encode/Encode/euc-kr.enc      Encoding tables
 ext/Encode/Encode/gb12345.enc  Encoding tables
 ext/Encode/Encode/gb1988.enc   Encoding tables
 ext/Encode/Encode/gb2312.enc   Encoding tables
-ext/Encode/Encode/gsm0338.enc          Encoding tables
+ext/Encode/Encode/gsm0338.enc  Encoding tables
 ext/Encode/Encode/iso2022-jp.enc       Encoding tables
 ext/Encode/Encode/iso2022-kr.enc       Encoding tables
-ext/Encode/Encode/iso2022.enc          Encoding tables
-ext/Encode/Encode/iso8859-1.enc                Encoding tables
-ext/Encode/Encode/iso8859-1.ucm                Encoding tables
+ext/Encode/Encode/iso2022.enc  Encoding tables
+ext/Encode/Encode/iso8859-1.enc        Encoding tables
+ext/Encode/Encode/iso8859-1.ucm        Encoding tables
 ext/Encode/Encode/iso8859-10.enc       Encoding tables
 ext/Encode/Encode/iso8859-10.ucm       Encoding tables
 ext/Encode/Encode/iso8859-13.enc       Encoding tables
@@ -320,56 +337,59 @@ ext/Encode/Encode/iso8859-15.enc  Encoding tables
 ext/Encode/Encode/iso8859-15.ucm       Encoding tables
 ext/Encode/Encode/iso8859-16.enc       Encoding tables
 ext/Encode/Encode/iso8859-16.ucm       Encoding tables
-ext/Encode/Encode/iso8859-2.enc                Encoding tables
-ext/Encode/Encode/iso8859-2.ucm                Encoding tables
-ext/Encode/Encode/iso8859-3.enc                Encoding tables
-ext/Encode/Encode/iso8859-3.ucm                Encoding tables
-ext/Encode/Encode/iso8859-4.enc                Encoding tables
-ext/Encode/Encode/iso8859-4.ucm                Encoding tables
-ext/Encode/Encode/iso8859-5.enc                Encoding tables
-ext/Encode/Encode/iso8859-5.ucm                Encoding tables
-ext/Encode/Encode/iso8859-6.enc                Encoding tables
-ext/Encode/Encode/iso8859-6.ucm                Encoding tables
-ext/Encode/Encode/iso8859-7.enc                Encoding tables
-ext/Encode/Encode/iso8859-7.ucm                Encoding tables
-ext/Encode/Encode/iso8859-8.enc                Encoding tables
-ext/Encode/Encode/iso8859-8.ucm                Encoding tables
-ext/Encode/Encode/iso8859-9.enc                Encoding tables
-ext/Encode/Encode/iso8859-9.ucm                Encoding tables
-ext/Encode/Encode/jis0201.enc          Encoding tables
-ext/Encode/Encode/jis0208.enc          Encoding tables
-ext/Encode/Encode/jis0212.enc          Encoding tables
-ext/Encode/Encode/koi8-r.enc           Encoding tables
-ext/Encode/Encode/koi8-r.ucm           Encoding tables
-ext/Encode/Encode/ksc5601.enc          Encoding tables
+ext/Encode/Encode/iso8859-2.enc        Encoding tables
+ext/Encode/Encode/iso8859-2.ucm        Encoding tables
+ext/Encode/Encode/iso8859-3.enc        Encoding tables
+ext/Encode/Encode/iso8859-3.ucm        Encoding tables
+ext/Encode/Encode/iso8859-4.enc        Encoding tables
+ext/Encode/Encode/iso8859-4.ucm        Encoding tables
+ext/Encode/Encode/iso8859-5.enc        Encoding tables
+ext/Encode/Encode/iso8859-5.ucm        Encoding tables
+ext/Encode/Encode/iso8859-6.enc        Encoding tables
+ext/Encode/Encode/iso8859-6.ucm        Encoding tables
+ext/Encode/Encode/iso8859-7.enc        Encoding tables
+ext/Encode/Encode/iso8859-7.ucm        Encoding tables
+ext/Encode/Encode/iso8859-8.enc        Encoding tables
+ext/Encode/Encode/iso8859-8.ucm        Encoding tables
+ext/Encode/Encode/iso8859-9.enc        Encoding tables
+ext/Encode/Encode/iso8859-9.ucm        Encoding tables
+ext/Encode/Encode/jis0201.enc  Encoding tables
+ext/Encode/Encode/jis0208.enc  Encoding tables
+ext/Encode/Encode/jis0212.enc  Encoding tables
+ext/Encode/Encode/koi8-r.enc   Encoding tables
+ext/Encode/Encode/koi8-r.ucm   Encoding tables
+ext/Encode/Encode/ksc5601.enc  Encoding tables
 ext/Encode/Encode/macCentEuro.enc      Encoding tables
 ext/Encode/Encode/macCroatian.enc      Encoding tables
 ext/Encode/Encode/macCyrillic.enc      Encoding tables
 ext/Encode/Encode/macDingbats.enc      Encoding tables
-ext/Encode/Encode/macGreek.enc         Encoding tables
+ext/Encode/Encode/macGreek.enc Encoding tables
 ext/Encode/Encode/macIceland.enc       Encoding tables
-ext/Encode/Encode/macJapan.enc         Encoding tables
-ext/Encode/Encode/macRoman.enc         Encoding tables
+ext/Encode/Encode/macJapan.enc Encoding tables
+ext/Encode/Encode/macRoman.enc Encoding tables
 ext/Encode/Encode/macRomania.enc       Encoding tables
-ext/Encode/Encode/macThai.enc          Encoding tables
+ext/Encode/Encode/macThai.enc  Encoding tables
 ext/Encode/Encode/macTurkish.enc       Encoding tables
 ext/Encode/Encode/macUkraine.enc       Encoding tables
-ext/Encode/Encode/posix-bc.enc         Encoding tables
-ext/Encode/Encode/posix-bc.ucm         Encoding tables
-ext/Encode/Encode/shiftjis.enc         Encoding tables
-ext/Encode/Encode/symbol.enc           Encoding tables
+ext/Encode/Encode/posix-bc.enc Encoding tables
+ext/Encode/Encode/posix-bc.ucm Encoding tables
+ext/Encode/Encode/shiftjis.enc Encoding tables
+ext/Encode/Encode/symbol.enc   Encoding tables
 ext/Encode/Encode/symbol.ucm   Encoding tables
-ext/Encode/Makefile.PL         Encode extension
-ext/Encode/Todo                        Encode extension
-ext/Encode/compile             Encode extension
-ext/Encode/encengine.c         Encode extension
-ext/Encode/encode.h            Encode extension
-ext/Errno/ChangeLog            Errno perl module change log
-ext/Errno/Errno_pm.PL          Errno perl module create script
-ext/Errno/Makefile.PL          Errno extension makefile writer
-ext/Fcntl/Fcntl.pm             Fcntl extension Perl module
-ext/Fcntl/Fcntl.xs             Fcntl extension external subroutines
-ext/Fcntl/Makefile.PL          Fcntl extension makefile writer
+ext/Encode/Makefile.PL Encode extension
+ext/Encode/Todo                Encode extension
+ext/Encode/compile     Encode extension
+ext/Encode/encengine.c Encode extension
+ext/Encode/encode.h    Encode extension
+ext/Errno/ChangeLog    Errno perl module change log
+ext/Errno/Errno.t      See if Errno works
+ext/Errno/Errno_pm.PL  Errno perl module create script
+ext/Errno/Makefile.PL  Errno extension makefile writer
+ext/Fcntl/Fcntl.pm     Fcntl extension Perl module
+ext/Fcntl/Fcntl.t      See if Fcntl works
+ext/Fcntl/Fcntl.xs     Fcntl extension external subroutines
+ext/Fcntl/Makefile.PL  Fcntl extension makefile writer
+ext/Fcntl/syslfs.t     See if large files work for sysio
 ext/File/Glob/Changes          File::Glob extension changelog
 ext/File/Glob/Glob.pm          File::Glob extension module
 ext/File/Glob/Glob.xs          File::Glob extension external subroutines
@@ -380,9 +400,11 @@ ext/File/Glob/bsd_glob.h   File::Glob extension header file
 ext/Filter/Util/Call/Call.pm   Filter::Util::Call extension module
 ext/Filter/Util/Call/Call.xs   Filter::Util::Call extension external subroutines
 ext/Filter/Util/Call/Makefile.PL       Filter::Util::Call extension makefile writer
+ext/Filter/t/call.t            See if Filter::Util::Call works
 ext/GDBM_File/GDBM_File.pm     GDBM extension Perl module
 ext/GDBM_File/GDBM_File.xs     GDBM extension external subroutines
 ext/GDBM_File/Makefile.PL      GDBM extension makefile writer
+ext/GDBM_File/gdbm.t           See if GDBM_File works
 ext/GDBM_File/hints/sco.pl     Hint for GDBM_File for named architecture
 ext/GDBM_File/typemap          GDBM extension interface types
 ext/IO/ChangeLog               IO perl module change log
@@ -400,6 +422,20 @@ ext/IO/lib/IO/Select.pm            IO system select() interface
 ext/IO/lib/IO/Socket.pm                IO socket handle package
 ext/IO/lib/IO/Socket/INET.pm   IO INET specific socket methods
 ext/IO/lib/IO/Socket/UNIX.pm   IO UNIX specific socket methods
+ext/IO/lib/IO/t/io_const.t     See if constants from IO work
+ext/IO/lib/IO/t/io_dir.t       See if directory-related methods from IO work
+ext/IO/lib/IO/t/io_dup.t       See if dup()-related methods from IO work
+ext/IO/lib/IO/t/io_linenum.t   See if I/O line numbers are tracked correctly
+ext/IO/lib/IO/t/io_multihomed.t        See if INET sockets work with multi-homed hosts
+ext/IO/lib/IO/t/io_pipe.t      See if pipe()-related methods from IO work
+ext/IO/lib/IO/t/io_poll.t      See if poll()-related methods from IO work
+ext/IO/lib/IO/t/io_sel.t       See if select()-related methods from IO work
+ext/IO/lib/IO/t/io_sock.t      See if INET socket-related methods from IO work
+ext/IO/lib/IO/t/io_taint.t     See if the untaint method from IO works
+ext/IO/lib/IO/t/io_tell.t      See if seek()/tell()-related methods from IO work
+ext/IO/lib/IO/t/io_udp.t       See if UDP socket-related methods from IO work
+ext/IO/lib/IO/t/io_unix.t      See if UNIX socket-related methods from IO work
+ext/IO/lib/IO/t/io_xs.t                See if XSUB methods from IO work
 ext/IO/poll.c                  IO poll() emulation using select()
 ext/IO/poll.h                  IO poll() emulation using select()
 ext/IPC/SysV/ChangeLog         IPC::SysV extension Perl module
@@ -414,17 +450,33 @@ ext/IPC/SysV/hints/cygwin.pl      Hint for IPC::SysV for named architecture
 ext/IPC/SysV/hints/next_3.pl   Hint for IPC::SysV for named architecture
 ext/IPC/SysV/t/msg.t           IPC::SysV extension Perl module
 ext/IPC/SysV/t/sem.t           IPC::SysV extension Perl module
-ext/List/Util/ChangeLog        Util extension
+ext/List/Util/ChangeLog                Util extension
 ext/List/Util/Makefile.PL      Util extension
 ext/List/Util/README           Util extension
-ext/List/Util/Util.xs  Util extension
+ext/List/Util/Util.xs          Util extension
 ext/List/Util/lib/List/Util.pm List::Util
 ext/List/Util/lib/Scalar/Util.pm       Scalar::Util
+ext/List/Util/t/blessed.t      Scalar::Util
+ext/List/Util/t/dualvar.t      Scalar::Util
+ext/List/Util/t/first.t                List::Util
+ext/List/Util/t/max.t          List::Util
+ext/List/Util/t/maxstr.t       List::Util
+ext/List/Util/t/min.t          List::Util
+ext/List/Util/t/minstr.t       List::Util
+ext/List/Util/t/readonly.t     Scalar::Util
+ext/List/Util/t/reduce.t       List::Util
+ext/List/Util/t/reftype.t      Scalar::Util
+ext/List/Util/t/sum.t          List::Util
+ext/List/Util/t/tainted.t      Scalar::Util
+ext/List/Util/t/weak.t         Scalar::Util
 ext/MIME/Base64/Base64.pm      MIME::Base64 extension
 ext/MIME/Base64/Base64.xs      MIME::Base64 extension
 ext/MIME/Base64/Changes                MIME::Base64 extension
 ext/MIME/Base64/Makefile.PL    MIME::Base64 extension
 ext/MIME/Base64/QuotedPrint.pm MIME::Base64 extension
+ext/MIME/Base64/t/base64.t     See whether MIME::Base64 works
+ext/MIME/Base64/t/qp.t         See whether MIME::QuotedPrint works
+ext/MIME/Base64/t/unicode.t    See whether MIME::Base64 works
 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
@@ -434,6 +486,7 @@ ext/NDBM_File/hints/dynixptx.pl     Hint for NDBM_File for named architecture
 ext/NDBM_File/hints/sco.pl     Hint for NDBM_File for named architecture
 ext/NDBM_File/hints/solaris.pl Hint for NDBM_File for named architecture
 ext/NDBM_File/hints/svr4.pl    Hint for NDBM_File for named architecture
+ext/NDBM_File/ndbm.t           See if NDBM_File works
 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
@@ -445,282 +498,317 @@ 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/hints/ultrix.pl  Hint for ODBM_File for named architecture
+ext/ODBM_File/odbm.t           See if ODBM_File works
+ext/ODBM_File/sdbm.t           See if SDBM_File works
 ext/ODBM_File/typemap          ODBM extension interface types
 ext/Opcode/Makefile.PL         Opcode extension makefile writer
 ext/Opcode/Opcode.pm           Opcode extension Perl module
+ext/Opcode/Opcode.t            See if Opcode works
 ext/Opcode/Opcode.xs           Opcode extension external subroutines
 ext/Opcode/Safe.pm             Safe extension Perl module
 ext/Opcode/ops.pm              "Pragma" form of Opcode extension Perl module
+ext/Opcode/ops.t               See if Opcode works
 ext/POSIX/Makefile.PL          POSIX extension makefile writer
 ext/POSIX/POSIX.pm             POSIX extension Perl module
 ext/POSIX/POSIX.pod            POSIX extension documentation
+ext/POSIX/POSIX.t              See if POSIX works
 ext/POSIX/POSIX.xs             POSIX extension external subroutines
 ext/POSIX/hints/bsdos.pl       Hint for POSIX for named architecture
 ext/POSIX/hints/dynixptx.pl    Hint for POSIX for named architecture
-ext/POSIX/hints/freebsd.pl      Hint for POSIX for named architecture
-ext/POSIX/hints/linux.pl        Hint for POSIX for named architecture
-ext/POSIX/hints/mint.pl         Hint for POSIX for named architecture
-ext/POSIX/hints/netbsd.pl       Hint for POSIX for named architecture
-ext/POSIX/hints/next_3.pl       Hint for POSIX for named architecture
+ext/POSIX/hints/freebsd.pl     Hint for POSIX for named architecture
+ext/POSIX/hints/linux.pl       Hint for POSIX for named architecture
+ext/POSIX/hints/mint.pl                Hint for POSIX for named architecture
+ext/POSIX/hints/netbsd.pl      Hint for POSIX for named architecture
+ext/POSIX/hints/next_3.pl      Hint for POSIX for named architecture
 ext/POSIX/hints/openbsd.pl     Hint for POSIX for named architecture
 ext/POSIX/hints/sunos_4.pl     Hint for POSIX for named architecture
 ext/POSIX/hints/svr4.pl                Hint for POSIX for named architecture
 ext/POSIX/hints/uts.pl         Hint for POSIX for named architecture
+ext/POSIX/sigaction.t          See if POSIX::sigaction works
 ext/POSIX/typemap              POSIX extension interface types
+ext/PerlIO/PerlIO.t            See if PerlIO works
 ext/PerlIO/Scalar/Makefile.PL  PerlIO layer for scalars
 ext/PerlIO/Scalar/Scalar.pm    PerlIO layer for scalars
 ext/PerlIO/Scalar/Scalar.xs    PerlIO layer for scalars
 ext/PerlIO/Via/Makefile.PL     PerlIO layer for layers in perl
 ext/PerlIO/Via/Via.pm          PerlIO layer for layers in perl
 ext/PerlIO/Via/Via.xs          PerlIO layer for layers in perl
+ext/PerlIO/t/scalar.t          Test of PerlIO::Scalar
 ext/SDBM_File/Makefile.PL      SDBM extension makefile writer
 ext/SDBM_File/SDBM_File.pm     SDBM extension Perl module
 ext/SDBM_File/SDBM_File.xs     SDBM extension external subroutines
-ext/SDBM_File/sdbm/CHANGES             SDBM kit
-ext/SDBM_File/sdbm/COMPARE             SDBM kit
-ext/SDBM_File/sdbm/Makefile.PL         SDBM kit
-ext/SDBM_File/sdbm/README              SDBM kit
-ext/SDBM_File/sdbm/README.too          SDBM kit
-ext/SDBM_File/sdbm/biblio              SDBM kit
-ext/SDBM_File/sdbm/dba.c               SDBM kit
-ext/SDBM_File/sdbm/dbd.c               SDBM kit
-ext/SDBM_File/sdbm/dbe.1               SDBM kit
-ext/SDBM_File/sdbm/dbe.c               SDBM kit
-ext/SDBM_File/sdbm/dbu.c               SDBM kit
-ext/SDBM_File/sdbm/grind               SDBM kit
-ext/SDBM_File/sdbm/hash.c              SDBM kit
+ext/SDBM_File/sdbm/CHANGES     SDBM kit
+ext/SDBM_File/sdbm/COMPARE     SDBM kit
+ext/SDBM_File/sdbm/Makefile.PL SDBM kit
+ext/SDBM_File/sdbm/README      SDBM kit
+ext/SDBM_File/sdbm/README.too  SDBM kit
+ext/SDBM_File/sdbm/biblio      SDBM kit
+ext/SDBM_File/sdbm/dba.c       SDBM kit
+ext/SDBM_File/sdbm/dbd.c       SDBM kit
+ext/SDBM_File/sdbm/dbe.1       SDBM kit
+ext/SDBM_File/sdbm/dbe.c       SDBM kit
+ext/SDBM_File/sdbm/dbu.c       SDBM kit
+ext/SDBM_File/sdbm/grind       SDBM kit
+ext/SDBM_File/sdbm/hash.c      SDBM kit
 ext/SDBM_File/sdbm/linux.patches       SDBM kit
 ext/SDBM_File/sdbm/makefile.sdbm       SDBM kit
-ext/SDBM_File/sdbm/pair.c              SDBM kit
-ext/SDBM_File/sdbm/pair.h              SDBM kit
-ext/SDBM_File/sdbm/readme.ms           SDBM kit
-ext/SDBM_File/sdbm/sdbm.3              SDBM kit
-ext/SDBM_File/sdbm/sdbm.c              SDBM kit
-ext/SDBM_File/sdbm/sdbm.h              SDBM kit
-ext/SDBM_File/sdbm/tune.h              SDBM kit
-ext/SDBM_File/sdbm/util.c              SDBM kit
+ext/SDBM_File/sdbm/pair.c      SDBM kit
+ext/SDBM_File/sdbm/pair.h      SDBM kit
+ext/SDBM_File/sdbm/readme.ms   SDBM kit
+ext/SDBM_File/sdbm/sdbm.3      SDBM kit
+ext/SDBM_File/sdbm/sdbm.c      SDBM kit
+ext/SDBM_File/sdbm/sdbm.h      SDBM kit
+ext/SDBM_File/sdbm/tune.h      SDBM kit
+ext/SDBM_File/sdbm/util.c      SDBM kit
 ext/SDBM_File/typemap          SDBM extension interface types
-ext/Socket/Makefile.PL Socket extension makefile writer
-ext/Socket/Socket.pm   Socket extension Perl module
-ext/Socket/Socket.xs   Socket extension external subroutines
+ext/Safe/safe1.t               See if Safe works
+ext/Safe/safe2.t               See if Safe works
+ext/Socket/Makefile.PL         Socket extension makefile writer
+ext/Socket/Socket.pm           Socket extension Perl module
+ext/Socket/Socket.t            See if Socket works
+ext/Socket/Socket.xs           Socket extension external subroutines
 ext/Storable/ChangeLog         Storable extension
 ext/Storable/MANIFEST          Storable extension
 ext/Storable/Makefile.PL       Storable extension
 ext/Storable/README            Storable extension
 ext/Storable/Storable.pm       Storable extension
 ext/Storable/Storable.xs       Storable extension
+ext/Storable/t/blessed.t       See if Storable works
+ext/Storable/t/canonical.t     See if Storable works
+ext/Storable/t/compat06.t      See if Storable works
+ext/Storable/t/dclone.t                See if Storable works
+ext/Storable/t/forgive.t       See if Storable works
+ext/Storable/t/freeze.t                See if Storable works
+ext/Storable/t/lock.t          See if Storable works
+ext/Storable/t/overload.t      See if Storable works
+ext/Storable/t/recurse.t       See if Storable works
+ext/Storable/t/retrieve.t      See if Storable works
+ext/Storable/t/store.t         See if Storable works
+ext/Storable/t/tied.t          See if Storable works
+ext/Storable/t/tied_hook.t     See if Storable works
+ext/Storable/t/tied_items.t    See if Storable works
+ext/Storable/t/utf8.t          See if Storable works
 ext/Sys/Hostname/Hostname.pm   Sys::Hostname extension Perl module
+ext/Sys/Hostname/Hostname.t    See if Sys::Hostname works
 ext/Sys/Hostname/Hostname.xs   Sys::Hostname extension external subroutines
 ext/Sys/Hostname/Makefile.PL   Sys::Hostname extension makefile writer
 ext/Sys/Syslog/Makefile.PL     Sys::Syslog extension makefile writer
 ext/Sys/Syslog/Syslog.pm       Sys::Syslog extension Perl module
 ext/Sys/Syslog/Syslog.xs       Sys::Syslog extension external subroutines
-ext/Thread/Makefile.PL Thread extension makefile writer
-ext/Thread/Notes       Thread notes
-ext/Thread/README      Thread README
-ext/Thread/Thread.pm   Thread extension Perl module
-ext/Thread/Thread.xs   Thread extension external subroutines
+ext/Sys/Syslog/syslog.t                See if Sys::Syslog works
+ext/Thread/Makefile.PL         Thread extension makefile writer
+ext/Thread/Notes               Thread notes
+ext/Thread/README              Thread README
+ext/Thread/Thread.pm           Thread extension Perl module
+ext/Thread/Thread.xs           Thread extension external subroutines
 ext/Thread/Thread/Queue.pm     Thread synchronised queue objects
 ext/Thread/Thread/Semaphore.pm Thread semaphore objects
 ext/Thread/Thread/Signal.pm    Start a thread to run signal handlers
 ext/Thread/Thread/Specific.pm  Thread specific data access
-ext/Thread/create.t    Test thread creation
-ext/Thread/die.t       Test thread die()
-ext/Thread/die2.t      Test thread die() differently
-ext/Thread/io.t                Test threads doing simple I/O
-ext/Thread/join.t      Test thread joining
-ext/Thread/join2.t     Test thread joining differently
-ext/Thread/list.t      Test getting list of all threads
-ext/Thread/lock.t      Test lock primitive
-ext/Thread/queue.t     Test Thread::Queue module
-ext/Thread/specific.t  Test thread-specific user data
-ext/Thread/sync.t      Test thread synchronisation
-ext/Thread/sync2.t     Test thread synchronisation
-ext/Thread/typemap     Thread extension interface types
-ext/Thread/unsync.t    Test thread implicit synchronisation
-ext/Thread/unsync2.t   Test thread implicit synchronisation
-ext/Thread/unsync3.t   Test thread implicit synchronisation
-ext/Thread/unsync4.t   Test thread implicit synchronisation
-ext/Time/HiRes/Changes Time::HiRes extension
-ext/Time/HiRes/HiRes.pm        Time::HiRes extension
-ext/Time/HiRes/HiRes.xs        Time::HiRes extension
+ext/Thread/create.t            Test thread creation
+ext/Thread/die.t               Test thread die()
+ext/Thread/die2.t              Test thread die() differently
+ext/Thread/io.t                        Test threads doing simple I/O
+ext/Thread/join.t              Test thread joining
+ext/Thread/join2.t             Test thread joining differently
+ext/Thread/list.t              Test getting list of all threads
+ext/Thread/lock.t              Test lock primitive
+ext/Thread/queue.t             Test Thread::Queue module
+ext/Thread/specific.t          Test thread-specific user data
+ext/Thread/sync.t              Test thread synchronisation
+ext/Thread/sync2.t             Test thread synchronisation
+ext/Thread/thr5005.t           Test 5.005-style threading (skipped if no use5005threads)
+ext/Thread/typemap             Thread extension interface types
+ext/Thread/unsync.t            Test thread implicit synchronisation
+ext/Thread/unsync2.t           Test thread implicit synchronisation
+ext/Thread/unsync3.t           Test thread implicit synchronisation
+ext/Thread/unsync4.t           Test thread implicit synchronisation
+ext/Time/HiRes/Changes         Time::HiRes extension
+ext/Time/HiRes/HiRes.pm                Time::HiRes extension
+ext/Time/HiRes/HiRes.t         Test for Time::HiRes
+ext/Time/HiRes/HiRes.xs                Time::HiRes extension
 ext/Time/HiRes/Makefile.PL     Time::HiRes extension
 ext/Time/Piece/Makefile.PL     Time::Piece extension
-ext/Time/Piece/Piece.pm        Time::Piece extension
-ext/Time/Piece/Piece.xs        Time::Piece extension
-ext/Time/Piece/README  Time::Piece extension
+ext/Time/Piece/Piece.pm                Time::Piece extension
+ext/Time/Piece/Piece.t         Test for Time::Piece
+ext/Time/Piece/Piece.xs                Time::Piece extension
+ext/Time/Piece/README          Time::Piece extension
 ext/Time/Piece/Seconds.pm      Time::Piece extension
 ext/XS/Typemap/Makefile.PL     XS::Typemap extension
 ext/XS/Typemap/README          XS::Typemap extension
 ext/XS/Typemap/Typemap.pm      XS::Typemap extension
+ext/XS/Typemap/Typemap.t       test that typemaps work
 ext/XS/Typemap/Typemap.xs      XS::Typemap extension
 ext/XS/Typemap/stdio.c         XS::Typemap extension
 ext/XS/Typemap/typemap         XS::Typemap extension
-ext/attrs/Makefile.PL  attrs extension makefile writer
-ext/attrs/attrs.pm     attrs extension Perl module
-ext/attrs/attrs.xs     attrs extension external subroutines
-ext/re/Makefile.PL     re extension makefile writer
-ext/re/hints/mpeix.pl  Hints for re for named architecture
-ext/re/re.pm           re extension Perl module
-ext/re/re.xs           re extension external subroutines
-ext/util/make_ext      Used by Makefile to execute extension Makefiles
-ext/util/mkbootstrap   Turns ext/*/*_BS into bootstrap info
-fakesdio.h             stdio in terms of PerlIO
-fakethr.h              Fake threads header
-form.h                 Public declarations for the above
-global.sym             Symbols that need hiding when embedded
-globals.c              File to declare global symbols (for shared library)
-globvar.sym            Global variables that need hiding when embedded
-gv.c                   Glob value code
-gv.h                   Glob value header
-h2pl/README            How to turn .ph files into .pl files
-h2pl/cbreak.pl         cbreak routines using .ph
-h2pl/cbreak2.pl                cbreak routines using .pl
-h2pl/eg/sizeof.ph      Sample sizeof array initialization
-h2pl/eg/sys/errno.pl   Sample translated errno.pl
-h2pl/eg/sys/ioctl.pl   Sample translated ioctl.pl
-h2pl/eg/sysexits.pl    Sample translated sysexits.pl
-h2pl/getioctlsizes     Program to extract types from ioctl.h
-h2pl/mksizes           Program to make %sizeof array
-h2pl/mkvars            Program to make .pl from .ph files
-h2pl/tcbreak           cbreak test routine using .ph
-h2pl/tcbreak2          cbreak test routine using .pl
-handy.h                        Handy definitions
-hints/3b1.sh           Hints for named architecture
-hints/3b1cc            Hints for named architecture
-hints/README.hints     Notes about hints
-hints/aix.sh           Hints for named architecture
-hints/altos486.sh      Hints for named architecture
-hints/amigaos.sh       Hints for named architecture
-hints/apollo.sh                Hints for named architecture
-hints/atheos.sh                Hints for named architecture
-hints/aux_3.sh         Hints for named architecture
-hints/beos.sh          Hints for named architecture
-hints/broken-db.msg    Warning message for systems with broken DB library
-hints/bsdos.sh         Hints for named architecture
-hints/convexos.sh      Hints for named architecture
-hints/cxux.sh          Hints for named architecture
-hints/cygwin.sh                Hints for named architecture
-hints/darwin.sh                Hints for named architecture
-hints/dcosx.sh         Hints for named architecture
-hints/dec_osf.sh       Hints for named architecture
-hints/dgux.sh          Hints for named architecture
-hints/dos_djgpp.sh     Hints for named architecture
-hints/dynix.sh         Hints for named architecture
-hints/dynixptx.sh      Hints for named architecture
-hints/epix.sh          Hints for named architecture
-hints/esix4.sh         Hints for named architecture
-hints/fps.sh           Hints for named architecture
-hints/freebsd.sh       Hints for named architecture
-hints/genix.sh         Hints for named architecture
-hints/gnu.sh           Hints for named architecture
-hints/greenhills.sh    Hints for named architecture
-hints/hpux.sh          Hints for named architecture
-hints/i386.sh          Hints for named architecture
-hints/irix_4.sh                Hints for named architecture
-hints/irix_5.sh                Hints for named architecture
-hints/irix_6.sh                Hints for named architecture
-hints/irix_6_0.sh      Hints for named architecture
-hints/irix_6_1.sh      Hints for named architecture
-hints/isc.sh           Hints for named architecture
-hints/isc_2.sh         Hints for named architecture
-hints/linux.sh         Hints for named architecture
-hints/lynxos.sh                Hints for named architecture
-hints/machten.sh       Hints for named architecture
-hints/machten_2.sh     Hints for named architecture
-hints/mint.sh          Hints for named architecture
-hints/mips.sh          Hints for named architecture
-hints/mpc.sh           Hints for named architecture
-hints/mpeix.sh         Hints for named architecture
-hints/ncr_tower.sh     Hints for named architecture
-hints/netbsd.sh                Hints for named architecture
-hints/newsos4.sh       Hints for named architecture
-hints/next_3.sh                Hints for named architecture
-hints/next_3_0.sh      Hints for named architecture
-hints/next_4.sh                Hints for named architecture
-hints/nonstopux.sh     Hints for named architecture
-hints/openbsd.sh       Hints for named architecture
-hints/opus.sh          Hints for named architecture
-hints/os2.sh           Hints for named architecture
-hints/os390.sh         Hints for named architecture
-hints/posix-bc.sh      Hints for named architecture
-hints/powerux.sh       Hints for named architecture
-hints/qnx.sh           Hints for named architecture
-hints/rhapsody.sh      Hints for named architecture
-hints/sco.sh           Hints for named architecture
-hints/sco_2_3_0.sh     Hints for named architecture
-hints/sco_2_3_1.sh     Hints for named architecture
-hints/sco_2_3_2.sh     Hints for named architecture
-hints/sco_2_3_3.sh     Hints for named architecture
-hints/sco_2_3_4.sh     Hints for named architecture
-hints/solaris_2.sh     Hints for named architecture
-hints/stellar.sh       Hints for named architecture
-hints/sunos_4_0.sh     Hints for named architecture
-hints/sunos_4_1.sh     Hints for named architecture
-hints/svr4.sh          Hints for named architecture
-hints/svr5.sh          Hints for named architecture
-hints/ti1500.sh                Hints for named architecture
-hints/titanos.sh       Hints for named architecture
-hints/ultrix_4.sh      Hints for named architecture
-hints/umips.sh         Hints for named architecture
-hints/unicos.sh                Hints for named architecture
-hints/unicosmk.sh      Hints for named architecture
-hints/unisysdynix.sh   Hints for named architecture
-hints/utekv.sh         Hints for named architecture
-hints/uts.sh           Hints for named architecture
-hints/uwin.sh          Hints for named architecture
-hints/vmesa.sh         Hints for named architecture
-hv.c                   Hash value code
-hv.h                   Hash value header
-installhtml            Perl script to install html files for pods
-installman             Perl script to install man pages for pods
-installperl            Perl script to do "make install" dirty work
-intrpvar.h             Variables held in each interpreter instance
-iperlsys.h             Perl's interface to the system
-jpl/ChangeLog          Java/Perl Lingo change log
-jpl/JNI/Changes                Java Native Interface changes
-jpl/JNI/Closer.java    Java Native Interface example
-jpl/JNI/JNI.pm         Java Native Interface module
-jpl/JNI/JNI.xs         Java Native Interface module
-jpl/JNI/JNIConfig      Java Native Interface config
-jpl/JNI/JNIConfig.Win32        Java Native Interface config
-jpl/JNI/JNIConfig.kaffe        Java Native Interface config
+ext/attrs.t                    See if attrs works with C<sub : attrs>
+ext/attrs/Makefile.PL          attrs extension makefile writer
+ext/attrs/attrs.pm             attrs extension Perl module
+ext/attrs/attrs.xs             attrs extension external subroutines
+ext/re/Makefile.PL             re extension makefile writer
+ext/re/hints/mpeix.pl          Hints for re for named architecture
+ext/re/re.pm                   re extension Perl module
+ext/re/re.xs                   re extension external subroutines
+ext/util/make_ext              Used by Makefile to execute extension Makefiles
+ext/util/mkbootstrap           Turns ext/*/*_BS into bootstrap info
+fakesdio.h                     stdio in terms of PerlIO
+fakethr.h                      Fake threads header
+form.h                         Public declarations for formats
+global.sym                     Symbols that need hiding when embedded
+globals.c                      File to declare global symbols (for shared library)
+globvar.sym                    Global variables that need hiding when embedded
+gv.c                           Glob value code
+gv.h                           Glob value header
+h2pl/README                    How to turn .ph files into .pl files
+h2pl/cbreak.pl                 cbreak routines using .ph
+h2pl/cbreak2.pl                        cbreak routines using .pl
+h2pl/eg/sizeof.ph              Sample sizeof array initialization
+h2pl/eg/sys/errno.pl           Sample translated errno.pl
+h2pl/eg/sys/ioctl.pl           Sample translated ioctl.pl
+h2pl/eg/sysexits.pl            Sample translated sysexits.pl
+h2pl/getioctlsizes             Program to extract types from ioctl.h
+h2pl/mksizes                   Program to make %sizeof array
+h2pl/mkvars                    Program to make .pl from .ph files
+h2pl/tcbreak                   cbreak test routine using .ph
+h2pl/tcbreak2                  cbreak test routine using .pl
+handy.h                                Handy definitions
+hints/3b1.sh                   Hints for named architecture
+hints/3b1cc                    Hints for named architecture
+hints/README.hints             Notes about hints
+hints/aix.sh                   Hints for named architecture
+hints/altos486.sh              Hints for named architecture
+hints/amigaos.sh               Hints for named architecture
+hints/apollo.sh                        Hints for named architecture
+hints/atheos.sh                        Hints for named architecture
+hints/aux_3.sh                 Hints for named architecture
+hints/beos.sh                  Hints for named architecture
+hints/broken-db.msg            Warning message for systems with broken DB library
+hints/bsdos.sh                 Hints for named architecture
+hints/convexos.sh              Hints for named architecture
+hints/cxux.sh                  Hints for named architecture
+hints/cygwin.sh                        Hints for named architecture
+hints/darwin.sh                        Hints for named architecture
+hints/dcosx.sh                 Hints for named architecture
+hints/dec_osf.sh               Hints for named architecture
+hints/dgux.sh                  Hints for named architecture
+hints/dos_djgpp.sh             Hints for named architecture
+hints/dynix.sh                 Hints for named architecture
+hints/dynixptx.sh              Hints for named architecture
+hints/epix.sh                  Hints for named architecture
+hints/esix4.sh                 Hints for named architecture
+hints/fps.sh                   Hints for named architecture
+hints/freebsd.sh               Hints for named architecture
+hints/genix.sh                 Hints for named architecture
+hints/gnu.sh                   Hints for named architecture
+hints/greenhills.sh            Hints for named architecture
+hints/hpux.sh                  Hints for named architecture
+hints/i386.sh                  Hints for named architecture
+hints/irix_4.sh                        Hints for named architecture
+hints/irix_5.sh                        Hints for named architecture
+hints/irix_6.sh                        Hints for named architecture
+hints/irix_6_0.sh              Hints for named architecture
+hints/irix_6_1.sh              Hints for named architecture
+hints/isc.sh                   Hints for named architecture
+hints/isc_2.sh                 Hints for named architecture
+hints/linux.sh                 Hints for named architecture
+hints/lynxos.sh                        Hints for named architecture
+hints/machten.sh               Hints for named architecture
+hints/machten_2.sh             Hints for named architecture
+hints/mint.sh                  Hints for named architecture
+hints/mips.sh                  Hints for named architecture
+hints/mpc.sh                   Hints for named architecture
+hints/mpeix.sh                 Hints for named architecture
+hints/ncr_tower.sh             Hints for named architecture
+hints/netbsd.sh                        Hints for named architecture
+hints/newsos4.sh               Hints for named architecture
+hints/next_3.sh                        Hints for named architecture
+hints/next_3_0.sh              Hints for named architecture
+hints/next_4.sh                        Hints for named architecture
+hints/nonstopux.sh             Hints for named architecture
+hints/openbsd.sh               Hints for named architecture
+hints/opus.sh                  Hints for named architecture
+hints/os2.sh                   Hints for named architecture
+hints/os390.sh                 Hints for named architecture
+hints/posix-bc.sh              Hints for named architecture
+hints/powerux.sh               Hints for named architecture
+hints/qnx.sh                   Hints for named architecture
+hints/rhapsody.sh              Hints for named architecture
+hints/sco.sh                   Hints for named architecture
+hints/sco_2_3_0.sh             Hints for named architecture
+hints/sco_2_3_1.sh             Hints for named architecture
+hints/sco_2_3_2.sh             Hints for named architecture
+hints/sco_2_3_3.sh             Hints for named architecture
+hints/sco_2_3_4.sh             Hints for named architecture
+hints/solaris_2.sh             Hints for named architecture
+hints/stellar.sh               Hints for named architecture
+hints/sunos_4_0.sh             Hints for named architecture
+hints/sunos_4_1.sh             Hints for named architecture
+hints/svr4.sh                  Hints for named architecture
+hints/svr5.sh                  Hints for named architecture
+hints/ti1500.sh                        Hints for named architecture
+hints/titanos.sh               Hints for named architecture
+hints/ultrix_4.sh              Hints for named architecture
+hints/umips.sh                 Hints for named architecture
+hints/unicos.sh                        Hints for named architecture
+hints/unicosmk.sh              Hints for named architecture
+hints/unisysdynix.sh           Hints for named architecture
+hints/utekv.sh                 Hints for named architecture
+hints/uts.sh                   Hints for named architecture
+hints/uwin.sh                  Hints for named architecture
+hints/vmesa.sh                 Hints for named architecture
+hv.c                           Hash value code
+hv.h                           Hash value header
+installhtml                    Perl script to install html files for pods
+installman                     Perl script to install man pages for pods
+installperl                    Perl script to do "make install" dirty work
+intrpvar.h                     Variables held in each interpreter instance
+iperlsys.h                     Perl's interface to the system
+jpl/ChangeLog                  Java/Perl Lingo change log
+jpl/JNI/Changes                        Java Native Interface changes
+jpl/JNI/Closer.java            Java Native Interface example
+jpl/JNI/JNI.pm                 Java Native Interface module
+jpl/JNI/JNI.xs                 Java Native Interface module
+jpl/JNI/JNIConfig              Java Native Interface config
+jpl/JNI/JNIConfig.Win32                Java Native Interface config
+jpl/JNI/JNIConfig.kaffe                Java Native Interface config
 jpl/JNI/JNIConfig.noembed      Java Native Interface config
 jpl/JNI/JNIConfig.standard     Java Native Interface config
-jpl/JNI/Makefile.PL    Java Native Interface makefile generator
-jpl/JNI/test.pl                Java Native Interface tests
-jpl/JNI/typemap                Java/Perl interface typemap
-jpl/JNI/typemap.gcc    Java/Perl interface typemap
-jpl/JNI/typemap.win32  Java/Perl interface typemap
-jpl/JPL/AutoLoader.pm  Java/Perl compiler module
-jpl/JPL/Class.pm       Java/Perl compiler module
-jpl/JPL/Compile.pm     Java/Perl compiler module
-jpl/JPL/Makefile.PL    Java/Perl makefile generator
-jpl/JPL_Rolo/JPL_Rolo.jpl                      Rolodex sample application
-jpl/JPL_Rolo/Makefile.PL                       Makefile generator
-jpl/JPL_Rolo/README                            Instructions
-jpl/JPL_Rolo/cardfile                          Rolodex sample application
-jpl/PerlInterpreter/Makefile.PL                        Makefile generator
-jpl/PerlInterpreter/PerlInterpreter.c          Perl interpreter abstraction
-jpl/PerlInterpreter/PerlInterpreter.h          Perl interpreter abstraction
+jpl/JNI/Makefile.PL            Java Native Interface makefile generator
+jpl/JNI/test.pl                        Java Native Interface tests
+jpl/JNI/typemap                        Java/Perl interface typemap
+jpl/JNI/typemap.gcc            Java/Perl interface typemap
+jpl/JNI/typemap.win32          Java/Perl interface typemap
+jpl/JPL/AutoLoader.pm          Java/Perl compiler module
+jpl/JPL/Class.pm               Java/Perl compiler module
+jpl/JPL/Compile.pm             Java/Perl compiler module
+jpl/JPL/Makefile.PL            Java/Perl makefile generator
+jpl/JPL_Rolo/JPL_Rolo.jpl      Rolodex sample application
+jpl/JPL_Rolo/Makefile.PL       Makefile generator
+jpl/JPL_Rolo/README            Instructions
+jpl/JPL_Rolo/cardfile          Rolodex sample application
+jpl/PerlInterpreter/Makefile.PL        Makefile generator
+jpl/PerlInterpreter/PerlInterpreter.c  Perl interpreter abstraction
+jpl/PerlInterpreter/PerlInterpreter.h  Perl interpreter abstraction
 jpl/PerlInterpreter/PerlInterpreter.java       Perl interpreter abstraction
-jpl/README                                     JPL instructions
-jpl/README.JUST-JNI                            JPL instructions
-jpl/SETVARS.PL                                 JPL setup
-jpl/Sample/Makefile.PL                         JPL sample makefile generator
-jpl/Sample/Sample.jpl                          JPL sample
-jpl/Test/Makefile.PL                           JPL tests makefile generator
-jpl/Test/Test.jpl                              JPL tests
-jpl/bin/jpl                                    JPL compiler
-jpl/docs/Tutorial.pod                          Perl and Java Tutorial
-jpl/get_jdk/README     Instructions for using get_jdk.pl
-jpl/get_jdk/get_jdk.pl JDK download tool
-jpl/get_jdk/jdk_hosts  JDK availability list
-jpl/install-jpl                JPL install utility
-keywords.h             The keyword numbers
-keywords.pl            Program to write keywords.h
-lib/AnyDBM_File.pm     Perl module to emulate dbmopen
-lib/Attribute/Handlers.pm      Attribute::Handlers
+jpl/README                     JPL instructions
+jpl/README.JUST-JNI            JPL instructions
+jpl/SETVARS.PL                 JPL setup
+jpl/Sample/Makefile.PL         JPL sample makefile generator
+jpl/Sample/Sample.jpl          JPL sample
+jpl/Test/Makefile.PL           JPL tests makefile generator
+jpl/Test/Test.jpl              JPL tests
+jpl/bin/jpl                    JPL compiler
+jpl/docs/Tutorial.pod          Perl and Java Tutorial
+jpl/get_jdk/README             Instructions for using get_jdk.pl
+jpl/get_jdk/get_jdk.pl         JDK download tool
+jpl/get_jdk/jdk_hosts          JDK availability list
+jpl/install-jpl                        JPL install utility
+keywords.h                     The keyword numbers
+keywords.pl                    Program to write keywords.h
+lib/AnyDBM_File.pm             Perl module to emulate dbmopen
+lib/AnyDBM_File.t              See if AnyDBM_File works
+lib/Attribute/Handlers.pm              Attribute::Handlers
+lib/Attribute/Handlers.t               See if Attribute::Handlers works
 lib/Attribute/Handlers/demo/Demo.pm    Attribute::Handlers demo
 lib/Attribute/Handlers/demo/Descriptions.pm    Attribute::Handlers demo
 lib/Attribute/Handlers/demo/MyClass.pm Attribute::Handlers demo
@@ -735,18 +823,20 @@ lib/Attribute/Handlers/demo/demo_hashdir.pl       Attribute::Handlers demo
 lib/Attribute/Handlers/demo/demo_phases.pl     Attribute::Handlers demo
 lib/Attribute/Handlers/demo/demo_range.pl      Attribute::Handlers demo
 lib/Attribute/Handlers/demo/demo_rawdata.pl    Attribute::Handlers demo
-lib/AutoLoader.pm      Autoloader base class
-lib/AutoSplit.pm       Split up autoload functions
-lib/Benchmark.pm       Measure execution time
-lib/CGI.pm             Web server interface ("Common Gateway Interface")
-lib/CGI/Apache.pm      Support for Apache's Perl module
-lib/CGI/Carp.pm                Log server errors with helpful context
-lib/CGI/Cookie.pm      Interface to Netscape Cookies
-lib/CGI/Fast.pm                Support for FastCGI (persistent server process)
-lib/CGI/Pretty.pm      Output nicely formatted HTML
-lib/CGI/Push.pm                Support for server push
-lib/CGI/Switch.pm      Simple interface for multiple server types
-lib/CGI/Util.pm                Utility functions
+lib/AutoLoader.pm              Autoloader base class
+lib/AutoLoader.t               See if AutoLoader works
+lib/AutoSplit.pm               Split up autoload functions
+lib/Benchmark.pm               Measure execution time
+lib/Benchmark.t                        Perl code profiler testsuite driver
+lib/CGI.pm                     Web server interface ("Common Gateway Interface")
+lib/CGI/Apache.pm              Support for Apache's Perl module
+lib/CGI/Carp.pm                        Log server errors with helpful context
+lib/CGI/Cookie.pm              Interface to Netscape Cookies
+lib/CGI/Fast.pm                        Support for FastCGI (persistent server process)
+lib/CGI/Pretty.pm              Output nicely formatted HTML
+lib/CGI/Push.pm                        Support for server push
+lib/CGI/Switch.pm              Simple interface for multiple server types
+lib/CGI/Util.pm                        Utility functions
 lib/CGI/eg/RunMeFirst          Setup script for CGI examples
 lib/CGI/eg/caution.xbm         CGI example
 lib/CGI/eg/clickable_image.cgi CGI example
@@ -769,32 +859,51 @@ lib/CGI/eg/popup.cgi              CGI example
 lib/CGI/eg/save_state.cgi      CGI example
 lib/CGI/eg/tryit.cgi           CGI example
 lib/CGI/eg/wilogo_gif.uu       CGI example
-lib/CPAN.pm            Interface to Comprehensive Perl Archive Network
-lib/CPAN/FirstTime.pm  Utility for creating CPAN config files
-lib/CPAN/Nox.pm                Runs CPAN while avoiding compiled extensions
-lib/Carp.pm            Error message base class
-lib/Carp/Heavy.pm      Error message workhorse
-lib/Class/ISA.pm       Class::ISA
-lib/Class/Struct.pm    Declare struct-like datatypes as Perl classes
-lib/Cwd.pm             Various cwd routines (getcwd, fastcwd, chdir)
-lib/DB.pm              Debugger API (draft)
-lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm
-lib/Digest.pm  Digest extensions
-lib/DirHandle.pm       like FileHandle only for directories
-lib/Dumpvalue.pm       Screen dump of perl values
-lib/English.pm         Readable aliases for short variables
-lib/Env.pm             Map environment into ordinary variables
-lib/Exporter.pm                Exporter base class
-lib/Exporter/Heavy.pm  Complicated routines for Exporter
-lib/ExtUtils/Command.pm        Utilities for Make on non-UNIX platforms
+lib/CGI/t/form.t               See if CGI.pm works
+lib/CGI/t/function.t           See if CGI.pm works
+lib/CGI/t/html.t               See if CGI.pm works
+lib/CGI/t/pretty.t             See if CGI.pm works
+lib/CGI/t/request.t            See if CGI.pm works
+lib/CGI/t/util.t               See if CGI.pm works
+lib/CPAN.pm                    Interface to Comprehensive Perl Archive Network
+lib/CPAN/FirstTime.pm          Utility for creating CPAN config files
+lib/CPAN/Nox.pm                        Runs CPAN while avoiding compiled extensions
+lib/CPAN/t/loadme.t            See if CPAN the module works
+lib/CPAN/t/vcmp.t              See if CPAN the module works
+lib/Carp.pm                    Error message base class
+lib/Carp.t                     See if Carp works
+lib/Carp/Heavy.pm              Error message workhorse
+lib/Class/ISA.pm               Class::ISA
+lib/Class/ISA/test.pl          See if Class::ISA works
+lib/Class/Struct.pm            Declare struct-like datatypes as Perl classes
+lib/Class/Struct.t             See if Class::Struct works
+lib/Cwd.pm                     Various cwd routines (getcwd, fastcwd, chdir)
+lib/DB.pm                      Debugger API (draft)
+lib/Devel/SelfStubber.pm       Generate stubs for SelfLoader.pm
+lib/Devel/SelfStubber.t                See if Devel::SelfStubber works
+lib/Digest.pm                  Digest extensions
+lib/Digest.t                   See if Digest extensions work
+lib/DirHandle.pm               like FileHandle only for directories
+lib/DirHandle.t                        See if DirHandle works
+lib/Dumpvalue.pm               Screen dump of perl values
+lib/English.pm                 Readable aliases for short variables
+lib/English.t                  See if English works
+lib/Env.pm                     Map environment into ordinary variables
+lib/Env/array.t                        See if Env works
+lib/Env/env.t                  See if Env works for arrays
+lib/Exporter.pm                        Exporter base class
+lib/Exporter.t                 See if Exporter works
+lib/Exporter/Heavy.pm          Complicated routines for Exporter
+lib/ExtUtils.t                 See if extutils work
+lib/ExtUtils/Command.pm                Utilities for Make on non-UNIX platforms
 lib/ExtUtils/Constant.pm       generate XS code to import C header constants
-lib/ExtUtils/Embed.pm  Utilities for embedding Perl in C programs
-lib/ExtUtils/Install.pm        Handles 'make install' on extensions
+lib/ExtUtils/Embed.pm          Utilities for embedding Perl in C programs
+lib/ExtUtils/Install.pm                Handles 'make install' on extensions
 lib/ExtUtils/Installed.pm      Information on installed extensions
-lib/ExtUtils/Liblist.pm        Locates libraries
+lib/ExtUtils/Liblist.pm                Locates libraries
 lib/ExtUtils/MANIFEST.SKIP     The default MANIFEST.SKIP
 lib/ExtUtils/MM_Cygwin.pm      MakeMaker methods for Cygwin
-lib/ExtUtils/MM_NW5.pm Netware port
+lib/ExtUtils/MM_NW5.pm         MakeMaker methods for NetWare
 lib/ExtUtils/MM_OS2.pm         MakeMaker methods for OS/2
 lib/ExtUtils/MM_Unix.pm                MakeMaker base class for Unix
 lib/ExtUtils/MM_VMS.pm         MakeMaker methods for VMS
@@ -804,73 +913,119 @@ lib/ExtUtils/Manifest.pm Utilities to write MANIFEST files
 lib/ExtUtils/Mkbootstrap.pm    Writes a bootstrap file (see MakeMaker)
 lib/ExtUtils/Mksymlists.pm     Writes a linker options file for extensions
 lib/ExtUtils/Packlist.pm       Manipulates .packlist files
-lib/ExtUtils/inst      Give information about installed extensions
+lib/ExtUtils/inst              Give information about installed extensions
 lib/ExtUtils/testlib.pm                Fixes up @INC to use just-built extension
 lib/ExtUtils/typemap           Extension interface types
 lib/ExtUtils/xsubpp            External subroutine preprocessor
-lib/Fatal.pm           Make errors in functions/builtins fatal
-lib/File/Basename.pm   Emulate the basename program
-lib/File/CheckTree.pm  Perl module supporting wholesale file mode validation
-lib/File/Compare.pm    Emulation of cmp command
-lib/File/Copy.pm       Emulation of cp command
-lib/File/DosGlob.pm    Win32 DOS-globbing module
-lib/File/Find.pm       Routines to do a find
-lib/File/Path.pm       Do things like `mkdir -p' and `rm -r'
-lib/File/Spec.pm       portable operations on file names
-lib/File/Spec/Epoc.pm  portable operations on EPOC file names
+lib/Fatal.pm                   Make errors in functions/builtins fatal
+lib/Fatal.t                    See if Fatal works
+lib/File/Basename.pm           Emulate the basename program
+lib/File/Basename.t            See if File::Basename works
+lib/File/CheckTree.pm          Perl module supporting wholesale file mode validation
+lib/File/CheckTree.t           See if File::CheckTree works
+lib/File/Compare.pm            Emulation of cmp command
+lib/File/Compare.t             See if File::Compare works
+lib/File/Copy.pm               Emulation of cp command
+lib/File/Copy.t                        See if File::Copy works
+lib/File/DosGlob.pm            Win32 DOS-globbing module
+lib/File/DosGlob.t             See if File::DosGlob works
+lib/File/Find.pm               Routines to do a find
+lib/File/Find/find.t           See if File::Find works
+lib/File/Find/taint.t          See if File::Find works with taint
+lib/File/Glob/basic.t          See if File::Glob works
+lib/File/Glob/case.t           See if File::Glob works
+lib/File/Glob/global.t         See if File::Glob works
+lib/File/Glob/taint.t          See if File::Glob works
+lib/File/Path.pm               Do things like `mkdir -p' and `rm -r'
+lib/File/Path.t                        See if File::Path works
+lib/File/Spec.pm               portable operations on file names
+lib/File/Spec.t                        See if File::Spec works
+lib/File/Spec/Epoc.pm          portable operations on EPOC file names
 lib/File/Spec/Functions.pm     Function interface to File::Spec object methods
-lib/File/Spec/Mac.pm   portable operations on Mac file names
-lib/File/Spec/OS2.pm   portable operations on OS2 file names
-lib/File/Spec/Unix.pm  portable operations on Unix file names
-lib/File/Spec/VMS.pm   portable operations on VMS file names
-lib/File/Spec/Win32.pm portable operations on Win32 file names
-lib/File/Temp.pm       create safe temporary files and file handles
-lib/File/stat.pm       By-name interface to Perl's builtin stat
-lib/FileCache.pm       Keep more files open than the system permits
-lib/FileHandle.pm      Backward-compatible front end to IO extension
-lib/Filter/Simple.pm   Simple frontend to Filter::Util::Call
-lib/FindBin.pm         Find name of currently executing program
-lib/Getopt/Long.pm     Fetch command options (GetOptions)
-lib/Getopt/Std.pm      Fetch command options (getopt, getopts)
-lib/I18N/Collate.pm    Routines to do strxfrm-based collation
-lib/I18N/LangTags.pm   I18N::LangTags
+lib/File/Spec/Functions.t      See if File::Spec::Functions works
+lib/File/Spec/Mac.pm           portable operations on Mac file names
+lib/File/Spec/OS2.pm           portable operations on OS2 file names
+lib/File/Spec/Unix.pm          portable operations on Unix file names
+lib/File/Spec/VMS.pm           portable operations on VMS file names
+lib/File/Spec/Win32.pm         portable operations on Win32 file names
+lib/File/Temp.pm               create safe temporary files and file handles
+lib/File/Temp/mktemp.t         See if File::Temp works
+lib/File/Temp/posix.t          See if File::Temp works
+lib/File/Temp/security.t       See if File::Temp works
+lib/File/Temp/tempfile.t       See if File::Temp works
+lib/File/stat.pm               By-name interface to Perl's builtin stat
+lib/File/stat.t                        See if File::stat works
+lib/FileCache.pm               Keep more files open than the system permits
+lib/FileCache.t                        See if FileCache works
+lib/FileHandle.pm              Backward-compatible front end to IO extension
+lib/FileHandle.t               See if FileHandle works
+lib/Filter/Simple.pm           Simple frontend to Filter::Util::Call
+lib/Filter/Simple/test.pl      See if Filter::Simple works
+lib/FindBin.pm                 Find name of currently executing program
+lib/FindBin.t                  See if FindBin works
+lib/Getopt/Long.pm             Fetch command options (GetOptions)
+lib/Getopt/Long/basic.t                See if Getopt::Long works
+lib/Getopt/Long/compat.t       See if Getopt::Long works
+lib/Getopt/Long/linkage.t      See if Getopt::Long works
+lib/Getopt/Long/oo.t           See if Getopt::Long works
+lib/Getopt/Std.pm              Fetch command options (getopt, getopts)
+lib/Getopt/Std.t               See if Getopt::Std and Getopt::Long work
+lib/I18N/Collate.pm            Routines to do strxfrm-based collation
+lib/I18N/Collate.t             See if I18N::Collate works
+lib/I18N/LangTags.pm           I18N::LangTags
 lib/I18N/LangTags/List.pod     list of tags for human languages
-lib/IPC/Open2.pm       Open a two-ended pipe
-lib/IPC/Open3.pm       Open a three-ended pipe!
-lib/Locale/Constants.pm        Locale::Codes
-lib/Locale/Country.pm  Locale::Codes
-lib/Locale/Currency.pm Locale::Codes
-lib/Locale/Language.pm Locale::Codes
-lib/Locale/Maketext.pm Locale::Maketext
-lib/Locale/Maketext.pod        Locale::Maketext documentation
+lib/I18N/LangTags/test.pl      See if I18N::LangTags works
+lib/IPC/Open2.pm               Open a two-ended pipe
+lib/IPC/Open2.t                        See if IPC::Open2 works
+lib/IPC/Open3.pm               Open a three-ended pipe!
+lib/IPC/Open3.t                        See if IPC::Open3 works
+lib/IPC/SysV.t                 See if IPC::SysV works
+lib/Locale/Codes/t/all.t       See if Locale::Codes work
+lib/Locale/Codes/t/constants.t See if Locale::Codes work
+lib/Locale/Codes/t/country.t   See if Locale::Codes work
+lib/Locale/Codes/t/currency.t  See if Locale::Codes work
+lib/Locale/Codes/t/languages.t See if Locale::Codes work
+lib/Locale/Codes/t/uk.t                See if Locale::Codes work
+lib/Locale/Constants.pm                Locale::Codes
+lib/Locale/Country.pm          Locale::Codes
+lib/Locale/Currency.pm         Locale::Codes
+lib/Locale/Language.pm         Locale::Codes
+lib/Locale/Maketext.pm         Locale::Maketext
+lib/Locale/Maketext.pod                Locale::Maketext documentation
+lib/Locale/Maketext.t          See if Locale::Maketext works
 lib/Locale/Maketext/TPJ13.pod  Locale::Maketext documentation article
-lib/Math/BigFloat.pm   An arbitrary precision floating-point arithmetic package
-lib/Math/BigInt.pm     An arbitrary precision integer arithmetic package
-lib/Math/Complex.pm    A Complex package
-lib/Math/Trig.pm       A simple interface to complex trigonometry
-lib/Memoize.pm Memoize
+lib/Math/BigFloat.pm           An arbitrary precision floating-point arithmetic package
+lib/Math/BigInt.pm             An arbitrary precision integer arithmetic package
+lib/Math/BigInt/t/bigfltpm.t   See if BigFloat.pm works
+lib/Math/BigInt/t/bigintpm.t   See if BigInt.pm works
+lib/Math/BigInt/t/mbimbf.t     BigInt/BigFloat accuracy, precicion and fallback, round_mode
+lib/Math/Complex.pm            A Complex package
+lib/Math/Complex.t             See if Math::Complex works
+lib/Math/Trig.pm               A simple interface to complex trigonometry
+lib/Math/Trig.t                        See if Math::Trig works
+lib/Memoize.pm                 Memoize
 lib/Memoize/AnyDBM_File.pm     Memoize
-lib/Memoize/Expire.pm  Memoize
+lib/Memoize/Expire.pm          Memoize
 lib/Memoize/ExpireFile.pm      Memoize
 lib/Memoize/ExpireTest.pm      Memoize
 lib/Memoize/NDBM_File.pm       Memoize
-lib/Memoize/README     Memoize
+lib/Memoize/README             Memoize
 lib/Memoize/SDBM_File.pm       Memoize
-lib/Memoize/Saves.pm   Memoize
-lib/Memoize/Storable.pm        Memoize
-lib/Memoize/TODO       Memoize
-lib/Memoize/t/array.t  Memoize
+lib/Memoize/Saves.pm           Memoize
+lib/Memoize/Storable.pm                Memoize
+lib/Memoize/TODO               Memoize
+lib/Memoize/t/array.t          Memoize
 lib/Memoize/t/correctness.t    Memoize
-lib/Memoize/t/errors.t Memoize
-lib/Memoize/t/expire.t Memoize
+lib/Memoize/t/errors.t         Memoize
+lib/Memoize/t/expire.t         Memoize
 lib/Memoize/t/expire_file.t    Memoize
 lib/Memoize/t/expire_module_n.t        Memoize
 lib/Memoize/t/expire_module_t.t        Memoize
-lib/Memoize/t/flush.t  Memoize
+lib/Memoize/t/flush.t          Memoize
 lib/Memoize/t/normalize.t      Memoize
 lib/Memoize/t/prototype.t      Memoize
-lib/Memoize/t/speed.t  Memoize
-lib/Memoize/t/tie.t    Memoize
+lib/Memoize/t/speed.t          Memoize
+lib/Memoize/t/tie.t            Memoize
 lib/Memoize/t/tie_gdbm.t       Memoize
 lib/Memoize/t/tie_ndbm.t       Memoize
 lib/Memoize/t/tie_sdbm.t       Memoize
@@ -878,473 +1033,571 @@ lib/Memoize/t/tie_storable.t   Memoize
 lib/Memoize/t/tiefeatures.t    Memoize
 lib/Memoize/t/unmemoize.t      Memoize
 lib/NEXT.pm            Pseudo-class NEXT for method redispatch
+lib/NEXT/test.pl               See if NEXT works
 lib/Net/ChangeLog.libnet       libnet
-lib/Net/Cmd.pm libnet
-lib/Net/Config.eg      libnet
-lib/Net/Config.pm      libnet
-lib/Net/Domain.pm      libnet
-lib/Net/DummyInetd.pm  libnet
-lib/Net/FTP.pm libnet
-lib/Net/FTP/A.pm       libnet
-lib/Net/FTP/E.pm       libnet
-lib/Net/FTP/I.pm       libnet
-lib/Net/FTP/L.pm       libnet
-lib/Net/FTP/dataconn.pm        libnet
-lib/Net/Hostname.eg    libnet
-lib/Net/NNTP.pm        libnet
-lib/Net/Netrc.pm       libnet
-lib/Net/PH.pm  libnet
-lib/Net/POP3.pm        libnet
-lib/Net/Ping.pm                Hello, anybody home?
-lib/Net/README.config  libnet
-lib/Net/README.libnet  libnet
-lib/Net/SMTP.pm        libnet
-lib/Net/SNPP.pm        libnet
-lib/Net/Time.pm        libnet
-lib/Net/demos/ftp      libnet
-lib/Net/demos/inetd    libnet
-lib/Net/demos/nntp     libnet
+lib/Net/Cmd.pm                 libnet
+lib/Net/Config.eg              libnet
+lib/Net/Config.pm              libnet
+lib/Net/Domain.pm              libnet
+lib/Net/DummyInetd.pm          libnet
+lib/Net/FTP.pm                 libnet
+lib/Net/FTP/A.pm               libnet
+lib/Net/FTP/E.pm               libnet
+lib/Net/FTP/I.pm               libnet
+lib/Net/FTP/L.pm               libnet
+lib/Net/FTP/dataconn.pm                libnet
+lib/Net/Hostname.eg            libnet
+lib/Net/NNTP.pm                        libnet
+lib/Net/Netrc.pm               libnet
+lib/Net/PH.pm                  libnet
+lib/Net/POP3.pm                        libnet
+lib/Net/Ping.pm                        Hello, anybody home?
+lib/Net/README.config          libnet
+lib/Net/README.libnet          libnet
+lib/Net/SMTP.pm                        libnet
+lib/Net/SNPP.pm                        libnet
+lib/Net/Time.pm                        libnet
+lib/Net/demos/ftp              libnet
+lib/Net/demos/inetd            libnet
+lib/Net/demos/nntp             libnet
 lib/Net/demos/nntp.mirror      libnet
-lib/Net/demos/pop3     libnet
-lib/Net/demos/smtp.self        libnet
-lib/Net/demos/snpp     libnet
-lib/Net/demos/time     libnet
-lib/Net/hostent.pm     By-name interface to Perl's builtin gethost*
-lib/Net/libnet.ppd     libnet
-lib/Net/libnetFAQ.pod  libnet
-lib/Net/netent.pm      By-name interface to Perl's builtin getnet*
-lib/Net/protoent.pm    By-name interface to Perl's builtin getproto*
-lib/Net/servent.pm     By-name interface to Perl's builtin getserv*
-lib/Net/t/ftp.t        libnet
-lib/Net/t/hostname.t   libnet
-lib/Net/t/nntp.t       libnet
-lib/Net/t/ph.t libnet
-lib/Net/t/require.t    libnet
-lib/Net/t/smtp.t       libnet
-lib/PerlIO.pm          PerlIO support module
-lib/Pod/Checker.pm     Pod-Parser - check POD documents for syntax errors
-lib/Pod/Find.pm                used by pod/splitpod
-lib/Pod/Functions.pm   used by pod/splitpod
-lib/Pod/Html.pm                Convert POD data to HTML
-lib/Pod/InputObjects.pm        Pod-Parser - define objects for input streams
-lib/Pod/LaTeX.pm       Convert POD data to LaTeX
-lib/Pod/Man.pm         Convert POD data to *roff
-lib/Pod/ParseUtils.pm  Pod-Parser - pod utility functions
-lib/Pod/Parser.pm      Pod-Parser - define base class for parsing POD
-lib/Pod/Plainer.pm     Pod migration utility module
-lib/Pod/Select.pm      Pod-Parser - select portions of POD docs
-lib/Pod/Text.pm                Pod-Parser - convert POD data to formatted ASCII text
-lib/Pod/Text/Color.pm  Convert POD data to color ASCII text
+lib/Net/demos/pop3             libnet
+lib/Net/demos/smtp.self                libnet
+lib/Net/demos/snpp             libnet
+lib/Net/demos/time             libnet
+lib/Net/hostent.pm             By-name interface to Perl's builtin gethost*
+lib/Net/hostent.t              See if Net::hostent works
+lib/Net/libnet.ppd             libnet
+lib/Net/libnetFAQ.pod          libnet
+lib/Net/netent.pm              By-name interface to Perl's builtin getnet*
+lib/Net/netent.t               See if Net::netent works
+lib/Net/protoent.pm            By-name interface to Perl's builtin getproto*
+lib/Net/protoent.t             See if Net::protoent works
+lib/Net/servent.pm             By-name interface to Perl's builtin getserv*
+lib/Net/servent.t              See if Net::servtent works
+lib/Net/t/ftp.t                        libnet
+lib/Net/t/hostname.t           libnet
+lib/Net/t/nntp.t               libnet
+lib/Net/t/ph.t                 libnet
+lib/Net/t/require.t            libnet
+lib/Net/t/smtp.t               libnet
+lib/PerlIO.pm                  PerlIO support module
+lib/Pod/Checker.pm             Pod-Parser - check POD documents for syntax errors
+lib/Pod/Find.pm                        used by pod/splitpod
+lib/Pod/Functions.pm           used by pod/splitpod
+lib/Pod/Html.pm                        Convert POD data to HTML
+lib/Pod/InputObjects.pm                Pod-Parser - define objects for input streams
+lib/Pod/LaTeX.pm               Convert POD data to LaTeX
+lib/Pod/Man.pm                 Convert POD data to *roff
+lib/Pod/ParseUtils.pm          Pod-Parser - pod utility functions
+lib/Pod/Parser.pm              Pod-Parser - define base class for parsing POD
+lib/Pod/Plainer.pm             Pod migration utility module
+lib/Pod/Select.pm              Pod-Parser - select portions of POD docs
+lib/Pod/Text.pm                        Pod-Parser - convert POD data to formatted ASCII text
+lib/Pod/Text/Color.pm          Convert POD data to color ASCII text
 lib/Pod/Text/Overstrike.pm     Convert POD data to formatted overstrike text
-lib/Pod/Text/Termcap.pm        Convert POD data to ASCII text with format escapes
-lib/Pod/Usage.pm       Pod-Parser - print usage messages
-lib/Search/Dict.pm     Perform binary search on dictionaries
-lib/SelectSaver.pm     Enforce proper select scoping
-lib/SelfLoader.pm      Load functions only on demand
-lib/Shell.pm           Make AUTOLOADed system() calls
-lib/Switch.pm          Switch for Perl
-lib/Symbol.pm          Symbol table manipulation routines
-lib/Term/ANSIColor.pm  Perl module supporting termcap usage
-lib/Term/Cap.pm                Perl module supporting termcap usage
-lib/Term/Complete.pm   A command completion subroutine
-lib/Term/ReadLine.pm   Stub readline library
-lib/Test.pm            A simple framework for writing test scripts
-lib/Test/Harness.pm    A test harness
-lib/Text/Abbrev.pm     An abbreviation table builder
-lib/Text/Abbrev.t      Test Text::Abbrev
-lib/Text/Balanced.pm   Text::Balanced
-lib/Text/Balanced.pod  Text::Balanced
-lib/Text/ParseWords.pm Perl module to split words on arbitrary delimiter
-lib/Text/Soundex.pm    Perl module to implement Soundex
-lib/Text/Tabs.pm       Do expand and unexpand
-lib/Text/Wrap.pm       Paragraph formatter
-lib/Tie/Array.pm       Base class for tied arrays
-lib/Tie/Handle.pm      Base class for tied handles
-lib/Tie/Hash.pm                Base class for tied hashes
-lib/Tie/RefHash.pm     Base class for tied hashes with references as keys
-lib/Tie/Scalar.pm      Base class for tied scalars
-lib/Tie/SubstrHash.pm  Compact hash for known key, value and table size
-lib/Time/Local.pm      Reverse translation of localtime, gmtime
-lib/Time/gmtime.pm     By-name interface to Perl's builtin gmtime
-lib/Time/localtime.pm  By-name interface to Perl's builtin localtime
-lib/Time/tm.pm         Internal object for Time::{gm,local}time
-lib/UNIVERSAL.pm       Base class for ALL classes
-lib/User/grent.pm      By-name interface to Perl's builtin getgr*
-lib/User/pwent.pm      By-name interface to Perl's builtin getpw*
-lib/Win32.pod          Documentation for Win32 extras
-lib/abbrev.pl          An abbreviation table builder
-lib/assert.pl          assertion and panic with stack trace
-lib/attributes.pm      For "sub foo : attrlist"
-lib/autouse.pm         Load and call a function only when it's used
-lib/base.pm            Establish IS-A relationship at compile time
-lib/bigfloat.pl                An arbitrary precision floating point package
-lib/bigint.pl          An arbitrary precision integer arithmetic package
-lib/bigrat.pl          An arbitrary precision rational arithmetic package
-lib/blib.pm            For "use blib"
-lib/bytes.pm           Pragma to enable byte operations
-lib/bytes_heavy.pl     Support routines for byte pragma
-lib/cacheout.pl                Manages output filehandles when you need too many
-lib/charnames.pm       Character names
-lib/complete.pl                A command completion subroutine
-lib/constant.pm                For "use constant"
-lib/ctime.pl           A ctime workalike
-lib/diagnostics.pm     Print verbose diagnostics
-lib/dotsh.pl           Code to "dot" in a shell script
-lib/dumpvar.pl         A variable dumper
-lib/exceptions.pl      catch and throw routines
-lib/fastcwd.pl         a faster but more dangerous getcwd
-lib/fields.pm          Set up object field names for pseudo-hash-using classes
-lib/filetest.pm                For "use filetest"
-lib/find.pl            A find emulator--used by find2perl
-lib/finddepth.pl       A depth-first find emulator--used by find2perl
-lib/flush.pl           Routines to do single flush
-lib/ftp.pl             FTP code (obsolete, use Net::FTP instead)
-lib/getcwd.pl          A getcwd() emulator
-lib/getopt.pl          Perl library supporting option parsing
-lib/getopts.pl         Perl library supporting option parsing
-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.PL          For "use lib", produces lib/lib.pm
-lib/locale.pm          For "use locale"
-lib/look.pl            A "look" equivalent
-lib/newgetopt.pl       A perl library supporting long option parsing
-lib/open.pm            Pragma to specify default I/O disciplines
-lib/open2.pl           Open a two-ended pipe (uses IPC::Open2)
-lib/open3.pl           Open a three-ended pipe (uses IPC::Open3)
-lib/overload.pm                Module for overloading perl operators
-lib/perl5db.pl         Perl debugging routines
-lib/pwd.pl             Routines to keep track of PWD environment variable
-lib/shellwords.pl      Perl library to split into words with shell quoting
-lib/sigtrap.pm         For trapping an abort and giving traceback
-lib/stat.pl            Perl library supporting stat function
-lib/strict.pm          For "use strict"
-lib/subs.pm            Declare overriding subs
-lib/syslog.pl          Perl library supporting syslogging
-lib/tainted.pl         Old code for tainting
-lib/termcap.pl         Perl library supporting termcap usage
-lib/timelocal.pl       Perl library supporting inverse of localtime, gmtime
-lib/unicode/ArabLink.pl                                Unicode character database
-lib/unicode/ArabLnkGrp.pl                      Unicode character database
-lib/unicode/ArabShap.txt                       Unicode character database
-lib/unicode/BidiMirr.txt                       Unicode character database
-lib/unicode/Bidirectional.pl                   Unicode character database
-lib/unicode/Blocks.pl                          Unicode character database
-lib/unicode/Blocks.txt                         Unicode character database
-lib/unicode/CaseFold.txt                       Unicode character database
-lib/unicode/Category.pl                                Unicode character database
-lib/unicode/CombiningClass.pl                  Unicode character database
-lib/unicode/CompExcl.txt                       Unicode character database
-lib/unicode/Decomposition.pl                   Unicode character database
-lib/unicode/EAWidth.txt                                Unicode character database
-lib/unicode/In.pl                              Unicode character database
-lib/unicode/In/0.pl                            Unicode character database
-lib/unicode/In/1.pl                            Unicode character database
-lib/unicode/In/10.pl                           Unicode character database
-lib/unicode/In/11.pl                           Unicode character database
-lib/unicode/In/12.pl                           Unicode character database
-lib/unicode/In/13.pl                           Unicode character database
-lib/unicode/In/14.pl                           Unicode character database
-lib/unicode/In/15.pl                           Unicode character database
-lib/unicode/In/16.pl                           Unicode character database
-lib/unicode/In/17.pl                           Unicode character database
-lib/unicode/In/18.pl                           Unicode character database
-lib/unicode/In/19.pl                           Unicode character database
-lib/unicode/In/2.pl                            Unicode character database
-lib/unicode/In/20.pl                           Unicode character database
-lib/unicode/In/21.pl                           Unicode character database
-lib/unicode/In/22.pl                           Unicode character database
-lib/unicode/In/23.pl                           Unicode character database
-lib/unicode/In/24.pl                           Unicode character database
-lib/unicode/In/25.pl                           Unicode character database
-lib/unicode/In/26.pl                           Unicode character database
-lib/unicode/In/27.pl                           Unicode character database
-lib/unicode/In/28.pl                           Unicode character database
-lib/unicode/In/29.pl                           Unicode character database
-lib/unicode/In/3.pl                            Unicode character database
-lib/unicode/In/30.pl                           Unicode character database
-lib/unicode/In/31.pl                           Unicode character database
-lib/unicode/In/32.pl                           Unicode character database
-lib/unicode/In/33.pl                           Unicode character database
-lib/unicode/In/34.pl                           Unicode character database
-lib/unicode/In/35.pl                           Unicode character database
-lib/unicode/In/36.pl                           Unicode character database
-lib/unicode/In/37.pl                           Unicode character database
-lib/unicode/In/38.pl                           Unicode character database
-lib/unicode/In/39.pl                           Unicode character database
-lib/unicode/In/4.pl                            Unicode character database
-lib/unicode/In/40.pl                           Unicode character database
-lib/unicode/In/41.pl                           Unicode character database
-lib/unicode/In/42.pl                           Unicode character database
-lib/unicode/In/43.pl                           Unicode character database
-lib/unicode/In/44.pl                           Unicode character database
-lib/unicode/In/45.pl                           Unicode character database
-lib/unicode/In/46.pl                           Unicode character database
-lib/unicode/In/47.pl                           Unicode character database
-lib/unicode/In/48.pl                           Unicode character database
-lib/unicode/In/49.pl                           Unicode character database
-lib/unicode/In/5.pl                            Unicode character database
-lib/unicode/In/50.pl                           Unicode character database
-lib/unicode/In/51.pl                           Unicode character database
-lib/unicode/In/52.pl                           Unicode character database
-lib/unicode/In/53.pl                           Unicode character database
-lib/unicode/In/54.pl                           Unicode character database
-lib/unicode/In/55.pl                           Unicode character database
-lib/unicode/In/56.pl                           Unicode character database
-lib/unicode/In/57.pl                           Unicode character database
-lib/unicode/In/58.pl                           Unicode character database
-lib/unicode/In/59.pl                           Unicode character database
-lib/unicode/In/6.pl                            Unicode character database
-lib/unicode/In/60.pl                           Unicode character database
-lib/unicode/In/61.pl                           Unicode character database
-lib/unicode/In/62.pl                           Unicode character database
-lib/unicode/In/63.pl                           Unicode character database
-lib/unicode/In/64.pl                           Unicode character database
-lib/unicode/In/65.pl                           Unicode character database
-lib/unicode/In/66.pl                           Unicode character database
-lib/unicode/In/67.pl                           Unicode character database
-lib/unicode/In/68.pl                           Unicode character database
-lib/unicode/In/69.pl                           Unicode character database
-lib/unicode/In/7.pl                            Unicode character database
-lib/unicode/In/70.pl                           Unicode character database
-lib/unicode/In/71.pl                           Unicode character database
-lib/unicode/In/72.pl                           Unicode character database
-lib/unicode/In/73.pl                           Unicode character database
-lib/unicode/In/74.pl                           Unicode character database
-lib/unicode/In/75.pl                           Unicode character database
-lib/unicode/In/76.pl                           Unicode character database
-lib/unicode/In/77.pl                           Unicode character database
-lib/unicode/In/78.pl                           Unicode character database
-lib/unicode/In/79.pl                           Unicode character database
-lib/unicode/In/8.pl                            Unicode character database
-lib/unicode/In/80.pl                           Unicode character database
-lib/unicode/In/81.pl                           Unicode character database
-lib/unicode/In/82.pl                           Unicode character database
-lib/unicode/In/83.pl                           Unicode character database
-lib/unicode/In/84.pl                           Unicode character database
-lib/unicode/In/85.pl                           Unicode character database
-lib/unicode/In/86.pl                           Unicode character database
-lib/unicode/In/87.pl                           Unicode character database
-lib/unicode/In/88.pl                           Unicode character database
-lib/unicode/In/89.pl                           Unicode character database
-lib/unicode/In/9.pl                            Unicode character database
-lib/unicode/In/90.pl                           Unicode character database
-lib/unicode/In/91.pl                           Unicode character database
-lib/unicode/In/92.pl                           Unicode character database
-lib/unicode/In/93.pl                           Unicode character database
-lib/unicode/In/94.pl                           Unicode character database
-lib/unicode/In/95.pl                           Unicode character database
-lib/unicode/Index.txt                          Unicode character database
-lib/unicode/Is/ASCII.pl                                Unicode character database
-lib/unicode/Is/Alnum.pl                                Unicode character database
-lib/unicode/Is/Alpha.pl                                Unicode character database
-lib/unicode/Is/BidiAL.pl                       Unicode character database
-lib/unicode/Is/BidiAN.pl                       Unicode character database
-lib/unicode/Is/BidiB.pl                                Unicode character database
-lib/unicode/Is/BidiBN.pl                       Unicode character database
-lib/unicode/Is/BidiCS.pl                       Unicode character database
-lib/unicode/Is/BidiEN.pl                       Unicode character database
-lib/unicode/Is/BidiES.pl                       Unicode character database
-lib/unicode/Is/BidiET.pl                       Unicode character database
-lib/unicode/Is/BidiL.pl                                Unicode character database
-lib/unicode/Is/BidiLRE.pl                      Unicode character database
-lib/unicode/Is/BidiLRO.pl                      Unicode character database
-lib/unicode/Is/BidiNSM.pl                      Unicode character database
-lib/unicode/Is/BidiON.pl                       Unicode character database
-lib/unicode/Is/BidiPDF.pl                      Unicode character database
-lib/unicode/Is/BidiR.pl                                Unicode character database
-lib/unicode/Is/BidiRLE.pl                      Unicode character database
-lib/unicode/Is/BidiRLO.pl                      Unicode character database
-lib/unicode/Is/BidiS.pl                                Unicode character database
-lib/unicode/Is/BidiWS.pl                       Unicode character database
-lib/unicode/Is/Blank.pl                                Unicode character database
-lib/unicode/Is/C.pl                            Unicode character database
-lib/unicode/Is/Cc.pl                           Unicode character database
-lib/unicode/Is/Cf.pl                           Unicode character database
-lib/unicode/Is/Cn.pl                           Unicode character database
-lib/unicode/Is/Cntrl.pl                                Unicode character database
-lib/unicode/Is/Co.pl                           Unicode character database
-lib/unicode/Is/Cs.pl                           Unicode character database
-lib/unicode/Is/DCcircle.pl                     Unicode character database
-lib/unicode/Is/DCcompat.pl                     Unicode character database
-lib/unicode/Is/DCfinal.pl                      Unicode character database
-lib/unicode/Is/DCfont.pl                       Unicode character database
-lib/unicode/Is/DCfraction.pl                   Unicode character database
-lib/unicode/Is/DCinitial.pl                    Unicode character database
-lib/unicode/Is/DCisolated.pl                   Unicode character database
-lib/unicode/Is/DCmedial.pl                     Unicode character database
-lib/unicode/Is/DCnarrow.pl                     Unicode character database
-lib/unicode/Is/DCnoBreak.pl                    Unicode character database
-lib/unicode/Is/DCsmall.pl                      Unicode character database
-lib/unicode/Is/DCsquare.pl                     Unicode character database
-lib/unicode/Is/DCsub.pl                                Unicode character database
-lib/unicode/Is/DCsuper.pl                      Unicode character database
-lib/unicode/Is/DCvertical.pl                   Unicode character database
-lib/unicode/Is/DCwide.pl                       Unicode character database
-lib/unicode/Is/DecoCanon.pl                    Unicode character database
-lib/unicode/Is/DecoCompat.pl                   Unicode character database
-lib/unicode/Is/Digit.pl                                Unicode character database
-lib/unicode/Is/Graph.pl                                Unicode character database
-lib/unicode/Is/L.pl                            Unicode character database
-lib/unicode/Is/LbrkAI.pl                       Unicode character database
-lib/unicode/Is/LbrkAL.pl                       Unicode character database
-lib/unicode/Is/LbrkB2.pl                       Unicode character database
-lib/unicode/Is/LbrkBA.pl                       Unicode character database
-lib/unicode/Is/LbrkBB.pl                       Unicode character database
-lib/unicode/Is/LbrkBK.pl                       Unicode character database
-lib/unicode/Is/LbrkCB.pl                       Unicode character database
-lib/unicode/Is/LbrkCL.pl                       Unicode character database
-lib/unicode/Is/LbrkCM.pl                       Unicode character database
-lib/unicode/Is/LbrkCR.pl                       Unicode character database
-lib/unicode/Is/LbrkEX.pl                       Unicode character database
-lib/unicode/Is/LbrkGL.pl                       Unicode character database
-lib/unicode/Is/LbrkHY.pl                       Unicode character database
-lib/unicode/Is/LbrkID.pl                       Unicode character database
-lib/unicode/Is/LbrkIN.pl                       Unicode character database
-lib/unicode/Is/LbrkIS.pl                       Unicode character database
-lib/unicode/Is/LbrkLF.pl                       Unicode character database
-lib/unicode/Is/LbrkNS.pl                       Unicode character database
-lib/unicode/Is/LbrkNU.pl                       Unicode character database
-lib/unicode/Is/LbrkOP.pl                       Unicode character database
-lib/unicode/Is/LbrkPO.pl                       Unicode character database
-lib/unicode/Is/LbrkPR.pl                       Unicode character database
-lib/unicode/Is/LbrkQU.pl                       Unicode character database
-lib/unicode/Is/LbrkSA.pl                       Unicode character database
-lib/unicode/Is/LbrkSG.pl                       Unicode character database
-lib/unicode/Is/LbrkSP.pl                       Unicode character database
-lib/unicode/Is/LbrkSY.pl                       Unicode character database
-lib/unicode/Is/LbrkXX.pl                       Unicode character database
-lib/unicode/Is/LbrkZW.pl                       Unicode character database
-lib/unicode/Is/Ll.pl                           Unicode character database
-lib/unicode/Is/Lm.pl                           Unicode character database
-lib/unicode/Is/Lo.pl                           Unicode character database
-lib/unicode/Is/Lower.pl                                Unicode character database
-lib/unicode/Is/Lt.pl                           Unicode character database
-lib/unicode/Is/Lu.pl                           Unicode character database
-lib/unicode/Is/M.pl                            Unicode character database
-lib/unicode/Is/Mc.pl                           Unicode character database
-lib/unicode/Is/Me.pl                           Unicode character database
-lib/unicode/Is/Mirrored.pl                     Unicode character database
-lib/unicode/Is/Mn.pl                           Unicode character database
-lib/unicode/Is/N.pl                            Unicode character database
-lib/unicode/Is/Nd.pl                           Unicode character database
-lib/unicode/Is/Nl.pl                           Unicode character database
-lib/unicode/Is/No.pl                           Unicode character database
-lib/unicode/Is/P.pl                            Unicode character database
-lib/unicode/Is/Pc.pl                           Unicode character database
-lib/unicode/Is/Pd.pl                           Unicode character database
-lib/unicode/Is/Pe.pl                           Unicode character database
-lib/unicode/Is/Pf.pl                           Unicode character database
-lib/unicode/Is/Pi.pl                           Unicode character database
-lib/unicode/Is/Po.pl                           Unicode character database
-lib/unicode/Is/Print.pl                                Unicode character database
-lib/unicode/Is/Ps.pl                           Unicode character database
-lib/unicode/Is/Punct.pl                                Unicode character database
-lib/unicode/Is/S.pl                            Unicode character database
-lib/unicode/Is/Sc.pl                           Unicode character database
-lib/unicode/Is/Sk.pl                           Unicode character database
-lib/unicode/Is/Sm.pl                           Unicode character database
-lib/unicode/Is/So.pl                           Unicode character database
-lib/unicode/Is/Space.pl                                Unicode character database
-lib/unicode/Is/SpacePerl.pl                    Unicode character database
-lib/unicode/Is/SylA.pl                         Unicode character database
-lib/unicode/Is/SylAA.pl                                Unicode character database
-lib/unicode/Is/SylAAI.pl                       Unicode character database
-lib/unicode/Is/SylAI.pl                                Unicode character database
-lib/unicode/Is/SylC.pl                         Unicode character database
-lib/unicode/Is/SylE.pl                         Unicode character database
-lib/unicode/Is/SylEE.pl                                Unicode character database
-lib/unicode/Is/SylI.pl                         Unicode character database
-lib/unicode/Is/SylII.pl                                Unicode character database
-lib/unicode/Is/SylN.pl                         Unicode character database
-lib/unicode/Is/SylO.pl                         Unicode character database
-lib/unicode/Is/SylOO.pl                                Unicode character database
-lib/unicode/Is/SylU.pl                         Unicode character database
-lib/unicode/Is/SylV.pl                         Unicode character database
-lib/unicode/Is/SylWA.pl                                Unicode character database
-lib/unicode/Is/SylWAA.pl                       Unicode character database
-lib/unicode/Is/SylWC.pl                                Unicode character database
-lib/unicode/Is/SylWE.pl                                Unicode character database
-lib/unicode/Is/SylWEE.pl                       Unicode character database
-lib/unicode/Is/SylWI.pl                                Unicode character database
-lib/unicode/Is/SylWII.pl                       Unicode character database
-lib/unicode/Is/SylWO.pl                                Unicode character database
-lib/unicode/Is/SylWOO.pl                       Unicode character database
-lib/unicode/Is/SylWU.pl                                Unicode character database
-lib/unicode/Is/SylWV.pl                                Unicode character database
-lib/unicode/Is/Syllable.pl                     Unicode character database
-lib/unicode/Is/Upper.pl                                Unicode character database
-lib/unicode/Is/Word.pl                         Unicode character database
-lib/unicode/Is/XDigit.pl                       Unicode character database
-lib/unicode/Is/Z.pl                            Unicode character database
-lib/unicode/Is/Zl.pl                           Unicode character database
-lib/unicode/Is/Zp.pl                           Unicode character database
-lib/unicode/Is/Zs.pl                           Unicode character database
-lib/unicode/Jamo.txt                           Unicode character database
-lib/unicode/JamoShort.pl                       Unicode character database
-lib/unicode/LineBrk.txt                                Unicode character database
-lib/unicode/Makefile                           Unicode character database
-lib/unicode/Name.pl                            Unicode character database
-lib/unicode/NamesList.html                     Unicode character database
-lib/unicode/NamesList.txt                      Unicode character database
-lib/unicode/Number.pl                          Unicode character database
-lib/unicode/PropList.html                      Unicode character database
-lib/unicode/PropList.txt                       Unicode character database
-lib/unicode/README.perl                                Unicode character database
-lib/unicode/ReadMe.txt                         Unicode character database info
-lib/unicode/Scripts.txt                                Unicode character database
-lib/unicode/SpecCase.txt                       Unicode character database
-lib/unicode/To/Digit.pl                                Unicode character database
-lib/unicode/To/Lower.pl                                Unicode character database
-lib/unicode/To/Title.pl                                Unicode character database
-lib/unicode/To/Upper.pl                                Unicode character database
-lib/unicode/UCD.html                           Unicode character database
-lib/unicode/Unicode.html                       Unicode character database
-lib/unicode/Unicode.txt                                Unicode character database
+lib/Pod/Text/Termcap.pm                Convert POD data to ASCII text with format escapes
+lib/Pod/Usage.pm               Pod-Parser - print usage messages
+lib/Search/Dict.pm             Perform binary search on dictionaries
+lib/Search/Dict.t              See if Search::Dict works
+lib/SelectSaver.pm             Enforce proper select scoping
+lib/SelectSaver.t              See if SelectSaver works
+lib/SelfLoader.pm              Load functions only on demand
+lib/SelfLoader.t               See if SelfLoader works
+lib/Shell.pm                   Make AUTOLOADed system() calls
+lib/Switch.pm                  Switch for Perl
+lib/Switch/test.pl             Test whether switch works
+lib/Symbol.pm                  Symbol table manipulation routines
+lib/Symbol.t                   See if Symbol works
+lib/Term/ANSIColor.pm          Perl module supporting termcap usage
+lib/Term/ANSIColor/test.pl     See if Term::ANSIColor works
+lib/Term/Cap.pm                        Perl module supporting termcap usage
+lib/Term/Complete.pm           A command completion subroutine
+lib/Term/ReadLine.pm           Stub readline library
+lib/Test.pm                    A simple framework for writing test scripts
+lib/Test/Harness.pm            A test harness
+lib/Test/Harness.t             See if Test::Harness works
+lib/Test/t/fail.t              See if Test works
+lib/Test/t/mix.t               See if Test works
+lib/Test/t/onfail.t            See if Test works
+lib/Test/t/qr.t                        See if Test works
+lib/Test/t/skip.t              See if Test works
+lib/Test/t/success.t           See if Test works
+lib/Test/t/todo.t              See if Test works
+lib/Text/Abbrev.pm             An abbreviation table builder
+lib/Text/Abbrev.t              Test Text::Abbrev
+lib/Text/Balanced.pm           Text::Balanced
+lib/Text/Balanced.pod          Text::Balanced
+lib/Text/Balanced/t/genxt.t    See if Text::Balanced works
+lib/Text/Balanced/t/xbrak.t    See if Text::Balanced works
+lib/Text/Balanced/t/xcode.t    See if Text::Balanced works
+lib/Text/Balanced/t/xdeli.t    See if Text::Balanced works
+lib/Text/Balanced/t/xmult.t    See if Text::Balanced works
+lib/Text/Balanced/t/xquot.t    See if Text::Balanced works
+lib/Text/Balanced/t/xtagg.t    See if Text::Balanced works
+lib/Text/Balanced/t/xvari.t    See if Text::Balanced works
+lib/Text/ParseWords.pm         Perl module to split words on arbitrary delimiter
+lib/Text/ParseWords.t          See if Text::ParseWords works
+lib/Text/Soundex.pm            Perl module to implement Soundex
+lib/Text/Soundex.t             See if Soundex works
+lib/Text/Tabs.pm               Do expand and unexpand
+lib/Text/Tabs.t                        See if Text::Tabs works
+lib/Text/Wrap.pm               Paragraph formatter
+lib/Text/Wrap/fill.t           See if Text::Wrap::fill works
+lib/Text/Wrap/wrap.t           See if Text::Wrap::wrap works
+lib/Tie/Array.pm               Base class for tied arrays
+lib/Tie/Array/push.t           Test for Tie::Array
+lib/Tie/Array/splice.t         Test for Tie::Array::SPLICE
+lib/Tie/Array/std.t            Test for Tie::StdArray
+lib/Tie/Array/stdpush.t                Test for Tie::StdArray
+lib/Tie/Handle.pm              Base class for tied handles
+lib/Tie/Handle/stdhandle.t     Test for Tie::StdHandle
+lib/Tie/Hash.pm                        Base class for tied hashes
+lib/Tie/RefHash.pm             Base class for tied hashes with references as keys
+lib/Tie/RefHash.t              Test for Tie::RefHash and Tie::RefHash::Nestable
+lib/Tie/Scalar.pm              Base class for tied scalars
+lib/Tie/SubstrHash.pm          Compact hash for known key, value and table size
+lib/Tie/SubstrHash.t           Test for Tie::SubstrHash
+lib/Time/Local.pm              Reverse translation of localtime, gmtime
+lib/Time/Local.t               See if Time::Local works
+lib/Time/gmtime.pm             By-name interface to Perl's builtin gmtime
+lib/Time/gmtime.t              Test for Time::gmtime
+lib/Time/localtime.pm          By-name interface to Perl's builtin localtime
+lib/Time/localtime.t           Test for Time::localtime
+lib/Time/tm.pm                 Internal object for Time::{gm,local}time
+lib/UNIVERSAL.pm               Base class for ALL classes
+lib/User/grent.pm              By-name interface to Perl's builtin getgr*
+lib/User/grent.t               See if User::grwent works
+lib/User/pwent.pm              By-name interface to Perl's builtin getpw*
+lib/User/pwent.t               See if User::pwent works
+lib/Win32.pod                  Documentation for Win32 extras
+lib/abbrev.pl                  An abbreviation table builder
+lib/assert.pl                  assertion and panic with stack trace
+lib/attributes.pm              For "sub foo : attrlist"
+lib/autouse.pm                 Load and call a function only when it's used
+lib/autouse.t                  See if autouse works
+lib/base.pm                    Establish IS-A relationship at compile time
+lib/bigfloat.pl                        An arbitrary precision floating point package
+lib/bigfloat.t                 See if bigfloat.pl works
+lib/bigint.pl                  An arbitrary precision integer arithmetic package
+lib/bigint.t                   See if bigint.pl works
+lib/bigrat.pl                  An arbitrary precision rational arithmetic package
+lib/blib.pm                    For "use blib"
+lib/bytes.pm                   Pragma to enable byte operations
+lib/bytes_heavy.pl             Support routines for byte pragma
+lib/cacheout.pl                        Manages output filehandles when you need too many
+lib/charnames.pm               Character names
+lib/charnames.t                        See if character names work
+lib/complete.pl                        A command completion subroutine
+lib/constant.pm                        For "use constant"
+lib/constant.t                 See if compile-time constants work
+lib/ctime.pl                   A ctime workalike
+lib/diagnostics.pm             Print verbose diagnostics
+lib/diagnostics.t              See if diagnostics.pm works
+lib/dotsh.pl                   Code to "dot" in a shell script
+lib/dumpvar.pl                 A variable dumper
+lib/exceptions.pl              catch and throw routines
+lib/fastcwd.pl                 a faster but more dangerous getcwd
+lib/fields.pm                  Set up object field names for pseudo-hash-using classes
+lib/fields.t                   See if base/fields works
+lib/filetest.pm                        For "use filetest"
+lib/find.pl                    A find emulator--used by find2perl
+lib/finddepth.pl               A depth-first find emulator--used by find2perl
+lib/flush.pl                   Routines to do single flush
+lib/ftp.pl                     FTP code (obsolete, use Net::FTP instead)
+lib/getcwd.pl                  A getcwd() emulator
+lib/getopt.pl                  Perl library supporting option parsing
+lib/getopts.pl                 Perl library supporting option parsing
+lib/h2ph.t                     See if h2ph works like it should
+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.PL                  For "use lib", produces lib/lib.pm
+lib/locale.pm                  For "use locale"
+lib/locale.t                   See if locale support works
+lib/locale/latin1              Part of locale.t in Latin 1
+lib/locale/utf8                        Part of locale.t in UTF8
+lib/look.pl                    A "look" equivalent
+lib/newgetopt.pl               A perl library supporting long option parsing
+lib/open.pm                    Pragma to specify default I/O disciplines
+lib/open2.pl                   Open a two-ended pipe (uses IPC::Open2)
+lib/open3.pl                   Open a three-ended pipe (uses IPC::Open3)
+lib/overload.pm                        Module for overloading perl operators
+lib/overload.t                 See if operator overloading works
+lib/perl5db.pl                 Perl debugging routines
+lib/ph.t                       See if h2ph works
+lib/pwd.pl                     Routines to keep track of PWD environment variable
+lib/shellwords.pl              Perl library to split into words with shell quoting
+lib/sigtrap.pm                 For trapping an abort and giving traceback
+lib/stat.pl                    Perl library supporting stat function
+lib/strict.pm                  For "use strict"
+lib/strict.t                   See if strictures work
+lib/strict/refs                        Tests of "use strict 'refs'" for strict.t
+lib/strict/subs                        Tests of "use strict 'subs'" for strict.t
+lib/strict/vars                        Tests of "use strict 'vars'" for strict.t
+lib/subs.pm                    Declare overriding subs
+lib/subs.t                     See if subroutine pseudo-importation works
+lib/syslog.pl                  Perl library supporting syslogging
+lib/tainted.pl                 Old code for tainting
+lib/termcap.pl                 Perl library supporting termcap usage
+lib/timelocal.pl               Perl library supporting inverse of localtime, gmtime
+lib/unicode/ArabLink.pl                Unicode character database
+lib/unicode/ArabLnkGrp.pl      Unicode character database
+lib/unicode/ArabShap.txt       Unicode character database
+lib/unicode/BidiMirr.txt       Unicode character database
+lib/unicode/Bidirectional.pl   Unicode character database
+lib/unicode/Blocks.pl          Unicode character database
+lib/unicode/Blocks.txt         Unicode character database
+lib/unicode/CaseFold.txt       Unicode character database
+lib/unicode/Category.pl                Unicode character database
+lib/unicode/CombiningClass.pl  Unicode character database
+lib/unicode/CompExcl.txt       Unicode character database
+lib/unicode/Decomposition.pl   Unicode character database
+lib/unicode/EAWidth.txt                Unicode character database
+lib/unicode/In.pl              Unicode character database
+lib/unicode/In/0.pl            Unicode character database
+lib/unicode/In/1.pl            Unicode character database
+lib/unicode/In/10.pl           Unicode character database
+lib/unicode/In/11.pl           Unicode character database
+lib/unicode/In/12.pl           Unicode character database
+lib/unicode/In/13.pl           Unicode character database
+lib/unicode/In/14.pl           Unicode character database
+lib/unicode/In/15.pl           Unicode character database
+lib/unicode/In/16.pl           Unicode character database
+lib/unicode/In/17.pl           Unicode character database
+lib/unicode/In/18.pl           Unicode character database
+lib/unicode/In/19.pl           Unicode character database
+lib/unicode/In/2.pl            Unicode character database
+lib/unicode/In/20.pl           Unicode character database
+lib/unicode/In/21.pl           Unicode character database
+lib/unicode/In/22.pl           Unicode character database
+lib/unicode/In/23.pl           Unicode character database
+lib/unicode/In/24.pl           Unicode character database
+lib/unicode/In/25.pl           Unicode character database
+lib/unicode/In/26.pl           Unicode character database
+lib/unicode/In/27.pl           Unicode character database
+lib/unicode/In/28.pl           Unicode character database
+lib/unicode/In/29.pl           Unicode character database
+lib/unicode/In/3.pl            Unicode character database
+lib/unicode/In/30.pl           Unicode character database
+lib/unicode/In/31.pl           Unicode character database
+lib/unicode/In/32.pl           Unicode character database
+lib/unicode/In/33.pl           Unicode character database
+lib/unicode/In/34.pl           Unicode character database
+lib/unicode/In/35.pl           Unicode character database
+lib/unicode/In/36.pl           Unicode character database
+lib/unicode/In/37.pl           Unicode character database
+lib/unicode/In/38.pl           Unicode character database
+lib/unicode/In/39.pl           Unicode character database
+lib/unicode/In/4.pl            Unicode character database
+lib/unicode/In/40.pl           Unicode character database
+lib/unicode/In/41.pl           Unicode character database
+lib/unicode/In/42.pl           Unicode character database
+lib/unicode/In/43.pl           Unicode character database
+lib/unicode/In/44.pl           Unicode character database
+lib/unicode/In/45.pl           Unicode character database
+lib/unicode/In/46.pl           Unicode character database
+lib/unicode/In/47.pl           Unicode character database
+lib/unicode/In/48.pl           Unicode character database
+lib/unicode/In/49.pl           Unicode character database
+lib/unicode/In/5.pl            Unicode character database
+lib/unicode/In/50.pl           Unicode character database
+lib/unicode/In/51.pl           Unicode character database
+lib/unicode/In/52.pl           Unicode character database
+lib/unicode/In/53.pl           Unicode character database
+lib/unicode/In/54.pl           Unicode character database
+lib/unicode/In/55.pl           Unicode character database
+lib/unicode/In/56.pl           Unicode character database
+lib/unicode/In/57.pl           Unicode character database
+lib/unicode/In/58.pl           Unicode character database
+lib/unicode/In/59.pl           Unicode character database
+lib/unicode/In/6.pl            Unicode character database
+lib/unicode/In/60.pl           Unicode character database
+lib/unicode/In/61.pl           Unicode character database
+lib/unicode/In/62.pl           Unicode character database
+lib/unicode/In/63.pl           Unicode character database
+lib/unicode/In/64.pl           Unicode character database
+lib/unicode/In/65.pl           Unicode character database
+lib/unicode/In/66.pl           Unicode character database
+lib/unicode/In/67.pl           Unicode character database
+lib/unicode/In/68.pl           Unicode character database
+lib/unicode/In/69.pl           Unicode character database
+lib/unicode/In/7.pl            Unicode character database
+lib/unicode/In/70.pl           Unicode character database
+lib/unicode/In/71.pl           Unicode character database
+lib/unicode/In/72.pl           Unicode character database
+lib/unicode/In/73.pl           Unicode character database
+lib/unicode/In/74.pl           Unicode character database
+lib/unicode/In/75.pl           Unicode character database
+lib/unicode/In/76.pl           Unicode character database
+lib/unicode/In/77.pl           Unicode character database
+lib/unicode/In/78.pl           Unicode character database
+lib/unicode/In/79.pl           Unicode character database
+lib/unicode/In/8.pl            Unicode character database
+lib/unicode/In/80.pl           Unicode character database
+lib/unicode/In/81.pl           Unicode character database
+lib/unicode/In/82.pl           Unicode character database
+lib/unicode/In/83.pl           Unicode character database
+lib/unicode/In/84.pl           Unicode character database
+lib/unicode/In/85.pl           Unicode character database
+lib/unicode/In/86.pl           Unicode character database
+lib/unicode/In/87.pl           Unicode character database
+lib/unicode/In/88.pl           Unicode character database
+lib/unicode/In/89.pl           Unicode character database
+lib/unicode/In/9.pl            Unicode character database
+lib/unicode/In/90.pl           Unicode character database
+lib/unicode/In/91.pl           Unicode character database
+lib/unicode/In/92.pl           Unicode character database
+lib/unicode/In/93.pl           Unicode character database
+lib/unicode/In/94.pl           Unicode character database
+lib/unicode/In/95.pl           Unicode character database
+lib/unicode/Index.txt          Unicode character database
+lib/unicode/Is/ASCII.pl                Unicode character database
+lib/unicode/Is/Alnum.pl                Unicode character database
+lib/unicode/Is/Alpha.pl                Unicode character database
+lib/unicode/Is/BidiAL.pl       Unicode character database
+lib/unicode/Is/BidiAN.pl       Unicode character database
+lib/unicode/Is/BidiB.pl                Unicode character database
+lib/unicode/Is/BidiBN.pl       Unicode character database
+lib/unicode/Is/BidiCS.pl       Unicode character database
+lib/unicode/Is/BidiEN.pl       Unicode character database
+lib/unicode/Is/BidiES.pl       Unicode character database
+lib/unicode/Is/BidiET.pl       Unicode character database
+lib/unicode/Is/BidiL.pl                Unicode character database
+lib/unicode/Is/BidiLRE.pl      Unicode character database
+lib/unicode/Is/BidiLRO.pl      Unicode character database
+lib/unicode/Is/BidiNSM.pl      Unicode character database
+lib/unicode/Is/BidiON.pl       Unicode character database
+lib/unicode/Is/BidiPDF.pl      Unicode character database
+lib/unicode/Is/BidiR.pl                Unicode character database
+lib/unicode/Is/BidiRLE.pl      Unicode character database
+lib/unicode/Is/BidiRLO.pl      Unicode character database
+lib/unicode/Is/BidiS.pl                Unicode character database
+lib/unicode/Is/BidiWS.pl       Unicode character database
+lib/unicode/Is/Blank.pl                Unicode character database
+lib/unicode/Is/C.pl            Unicode character database
+lib/unicode/Is/Cc.pl           Unicode character database
+lib/unicode/Is/Cf.pl           Unicode character database
+lib/unicode/Is/Cn.pl           Unicode character database
+lib/unicode/Is/Cntrl.pl                Unicode character database
+lib/unicode/Is/Co.pl           Unicode character database
+lib/unicode/Is/Cs.pl           Unicode character database
+lib/unicode/Is/DCcircle.pl     Unicode character database
+lib/unicode/Is/DCcompat.pl     Unicode character database
+lib/unicode/Is/DCfinal.pl      Unicode character database
+lib/unicode/Is/DCfont.pl       Unicode character database
+lib/unicode/Is/DCfraction.pl   Unicode character database
+lib/unicode/Is/DCinitial.pl    Unicode character database
+lib/unicode/Is/DCisolated.pl   Unicode character database
+lib/unicode/Is/DCmedial.pl     Unicode character database
+lib/unicode/Is/DCnarrow.pl     Unicode character database
+lib/unicode/Is/DCnoBreak.pl    Unicode character database
+lib/unicode/Is/DCsmall.pl      Unicode character database
+lib/unicode/Is/DCsquare.pl     Unicode character database
+lib/unicode/Is/DCsub.pl                Unicode character database
+lib/unicode/Is/DCsuper.pl      Unicode character database
+lib/unicode/Is/DCvertical.pl   Unicode character database
+lib/unicode/Is/DCwide.pl       Unicode character database
+lib/unicode/Is/DecoCanon.pl    Unicode character database
+lib/unicode/Is/DecoCompat.pl   Unicode character database
+lib/unicode/Is/Digit.pl                Unicode character database
+lib/unicode/Is/Graph.pl                Unicode character database
+lib/unicode/Is/L.pl            Unicode character database
+lib/unicode/Is/LbrkAI.pl       Unicode character database
+lib/unicode/Is/LbrkAL.pl       Unicode character database
+lib/unicode/Is/LbrkB2.pl       Unicode character database
+lib/unicode/Is/LbrkBA.pl       Unicode character database
+lib/unicode/Is/LbrkBB.pl       Unicode character database
+lib/unicode/Is/LbrkBK.pl       Unicode character database
+lib/unicode/Is/LbrkCB.pl       Unicode character database
+lib/unicode/Is/LbrkCL.pl       Unicode character database
+lib/unicode/Is/LbrkCM.pl       Unicode character database
+lib/unicode/Is/LbrkCR.pl       Unicode character database
+lib/unicode/Is/LbrkEX.pl       Unicode character database
+lib/unicode/Is/LbrkGL.pl       Unicode character database
+lib/unicode/Is/LbrkHY.pl       Unicode character database
+lib/unicode/Is/LbrkID.pl       Unicode character database
+lib/unicode/Is/LbrkIN.pl       Unicode character database
+lib/unicode/Is/LbrkIS.pl       Unicode character database
+lib/unicode/Is/LbrkLF.pl       Unicode character database
+lib/unicode/Is/LbrkNS.pl       Unicode character database
+lib/unicode/Is/LbrkNU.pl       Unicode character database
+lib/unicode/Is/LbrkOP.pl       Unicode character database
+lib/unicode/Is/LbrkPO.pl       Unicode character database
+lib/unicode/Is/LbrkPR.pl       Unicode character database
+lib/unicode/Is/LbrkQU.pl       Unicode character database
+lib/unicode/Is/LbrkSA.pl       Unicode character database
+lib/unicode/Is/LbrkSG.pl       Unicode character database
+lib/unicode/Is/LbrkSP.pl       Unicode character database
+lib/unicode/Is/LbrkSY.pl       Unicode character database
+lib/unicode/Is/LbrkXX.pl       Unicode character database
+lib/unicode/Is/LbrkZW.pl       Unicode character database
+lib/unicode/Is/Ll.pl           Unicode character database
+lib/unicode/Is/Lm.pl           Unicode character database
+lib/unicode/Is/Lo.pl           Unicode character database
+lib/unicode/Is/Lower.pl                Unicode character database
+lib/unicode/Is/Lt.pl           Unicode character database
+lib/unicode/Is/Lu.pl           Unicode character database
+lib/unicode/Is/M.pl            Unicode character database
+lib/unicode/Is/Mc.pl           Unicode character database
+lib/unicode/Is/Me.pl           Unicode character database
+lib/unicode/Is/Mirrored.pl     Unicode character database
+lib/unicode/Is/Mn.pl           Unicode character database
+lib/unicode/Is/N.pl            Unicode character database
+lib/unicode/Is/Nd.pl           Unicode character database
+lib/unicode/Is/Nl.pl           Unicode character database
+lib/unicode/Is/No.pl           Unicode character database
+lib/unicode/Is/P.pl            Unicode character database
+lib/unicode/Is/Pc.pl           Unicode character database
+lib/unicode/Is/Pd.pl           Unicode character database
+lib/unicode/Is/Pe.pl           Unicode character database
+lib/unicode/Is/Pf.pl           Unicode character database
+lib/unicode/Is/Pi.pl           Unicode character database
+lib/unicode/Is/Po.pl           Unicode character database
+lib/unicode/Is/Print.pl                Unicode character database
+lib/unicode/Is/Ps.pl           Unicode character database
+lib/unicode/Is/Punct.pl                Unicode character database
+lib/unicode/Is/S.pl            Unicode character database
+lib/unicode/Is/Sc.pl           Unicode character database
+lib/unicode/Is/Sk.pl           Unicode character database
+lib/unicode/Is/Sm.pl           Unicode character database
+lib/unicode/Is/So.pl           Unicode character database
+lib/unicode/Is/Space.pl                Unicode character database
+lib/unicode/Is/SpacePerl.pl    Unicode character database
+lib/unicode/Is/SylA.pl         Unicode character database
+lib/unicode/Is/SylAA.pl                Unicode character database
+lib/unicode/Is/SylAAI.pl       Unicode character database
+lib/unicode/Is/SylAI.pl                Unicode character database
+lib/unicode/Is/SylC.pl         Unicode character database
+lib/unicode/Is/SylE.pl         Unicode character database
+lib/unicode/Is/SylEE.pl                Unicode character database
+lib/unicode/Is/SylI.pl         Unicode character database
+lib/unicode/Is/SylII.pl                Unicode character database
+lib/unicode/Is/SylN.pl         Unicode character database
+lib/unicode/Is/SylO.pl         Unicode character database
+lib/unicode/Is/SylOO.pl                Unicode character database
+lib/unicode/Is/SylU.pl         Unicode character database
+lib/unicode/Is/SylV.pl         Unicode character database
+lib/unicode/Is/SylWA.pl                Unicode character database
+lib/unicode/Is/SylWAA.pl       Unicode character database
+lib/unicode/Is/SylWC.pl                Unicode character database
+lib/unicode/Is/SylWE.pl                Unicode character database
+lib/unicode/Is/SylWEE.pl       Unicode character database
+lib/unicode/Is/SylWI.pl                Unicode character database
+lib/unicode/Is/SylWII.pl       Unicode character database
+lib/unicode/Is/SylWO.pl                Unicode character database
+lib/unicode/Is/SylWOO.pl       Unicode character database
+lib/unicode/Is/SylWU.pl                Unicode character database
+lib/unicode/Is/SylWV.pl                Unicode character database
+lib/unicode/Is/Syllable.pl     Unicode character database
+lib/unicode/Is/Upper.pl                Unicode character database
+lib/unicode/Is/Word.pl         Unicode character database
+lib/unicode/Is/XDigit.pl       Unicode character database
+lib/unicode/Is/Z.pl            Unicode character database
+lib/unicode/Is/Zl.pl           Unicode character database
+lib/unicode/Is/Zp.pl           Unicode character database
+lib/unicode/Is/Zs.pl           Unicode character database
+lib/unicode/Jamo.txt           Unicode character database
+lib/unicode/JamoShort.pl       Unicode character database
+lib/unicode/LineBrk.txt                Unicode character database
+lib/unicode/Makefile           Unicode character database
+lib/unicode/Name.pl            Unicode character database
+lib/unicode/NamesList.html     Unicode character database
+lib/unicode/NamesList.txt      Unicode character database
+lib/unicode/Number.pl          Unicode character database
+lib/unicode/PropList.html      Unicode character database
+lib/unicode/PropList.txt       Unicode character database
+lib/unicode/README.perl                Unicode character database
+lib/unicode/ReadMe.txt         Unicode character database info
+lib/unicode/Scripts.txt                Unicode character database
+lib/unicode/SpecCase.txt       Unicode character database
+lib/unicode/To/Digit.pl                Unicode character database
+lib/unicode/To/Lower.pl                Unicode character database
+lib/unicode/To/Title.pl                Unicode character database
+lib/unicode/To/Upper.pl                Unicode character database
+lib/unicode/UCD.html           Unicode character database
+lib/unicode/Unicode.html       Unicode character database
+lib/unicode/Unicode.txt                Unicode character database
 lib/unicode/distinct.pm                Perl pragma to strictly distinguish UTF8 data and non-UTF data
-lib/unicode/mktables.PL                                Unicode character database generator
-lib/unicode/rename                             Filename mappings used
-lib/unicode/syllables.txt                      Unicode character database
-lib/unicode/version                            The version of the Unicode
-lib/utf8.pm                                    Pragma to control Unicode support
-lib/utf8_heavy.pl                              Support routines for utf8 pragma
-lib/validate.pl                Perl library supporting wholesale file mode validation
-lib/vars.pm            Declare pseudo-imported global variables
-lib/warnings.pm                For "use warnings"
+lib/unicode/mktables.PL                Unicode character database generator
+lib/unicode/rename             Filename mappings used
+lib/unicode/syllables.txt      Unicode character database
+lib/unicode/version            The version of the Unicode
+lib/utf8.pm                    Pragma to control Unicode support
+lib/utf8.t                     See if utf8 operations work
+lib/utf8_heavy.pl              Support routines for utf8 pragma
+lib/validate.pl                        Perl library supporting wholesale file mode validation
+lib/vars.pm                    Declare pseudo-imported global variables
+lib/vars.t                     See if "use vars" work
+lib/warnings.pm                        For "use warnings"
+lib/warnings.t         See if warning controls work
+lib/warnings/1global           Tests of global warnings for warnings.t
+lib/warnings/2use              Tests for "use warnings" for warnings.t
+lib/warnings/3both             Tests for interaction of $^W and "use warnings"
+lib/warnings/4lint             Tests for -W switch
+lib/warnings/5nolint           Tests for -X switch
+lib/warnings/6default          Tests default warnings
+lib/warnings/7fatal            Tests fatal warnings
+lib/warnings/8signal           Tests warnings + __WARN__ and __DIE__
+lib/warnings/9enabled          Tests warnings
+lib/warnings/av                        Tests for av.c for warnings.t
+lib/warnings/doio              Tests for doio.c for warnings.t
+lib/warnings/doop              Tests for doop.c for warnings.t
+lib/warnings/gv                        Tests for gv.c for warnings.t
+lib/warnings/hv                        Tests for hv.c for warnings.t
+lib/warnings/malloc            Tests for malloc.c for warnings.t
+lib/warnings/mg                        Tests for mg.c for warnings.t
+lib/warnings/op                        Tests for op.c for warnings.t
+lib/warnings/perl              Tests for perl.c for warnings.t
+lib/warnings/perlio            Tests for perlio.c for warnings.t
+lib/warnings/perly             Tests for perly.y for warnings.t
+lib/warnings/pp                        Tests for pp.c for warnings.t
+lib/warnings/pp_ctl            Tests for pp_ctl.c for warnings.t
+lib/warnings/pp_hot            Tests for pp_hot.c for warnings.t
+lib/warnings/pp_sys            Tests for pp_sys.c for warnings.t
+lib/warnings/regcomp           Tests for regcomp.c for warnings.t
+lib/warnings/regexec           Tests for regexec.c for warnings.t
 lib/warnings/register.pm       For "use warnings::register"
-locale.c               locale-specific utility functions
-makeaperl.SH           perl script that produces a new perl binary
-makedef.pl             Create symbol export lists for linking
-makedepend.SH          Precursor to makedepend
-makedir.SH             Precursor to makedir
-malloc.c               A version of malloc you might not want
-mg.c                   Magic code
-mg.h                   Magic header
-minimod.pl             Writes lib/ExtUtils/Miniperl.pm
-miniperlmain.c         Basic perl w/o dynamic loading or extensions
-mint/Makefile          MiNT port
-mint/README            MiNT port
-mint/errno.h           MiNT port
-mint/pwd.c             MiNT port
-mint/stdio.h           MiNT port
-mint/sys/time.h                MiNT port
-mint/time.h            MiNT port
-mpeix/mpeixish.h       MPE/iX port
-mpeix/nm               MPE/iX port
-mpeix/relink           MPE/iX port
-mv-if-diff             Script to mv a file if it changed
-myconfig.SH            Prints summary of the current configuration
-nostdio.h              Cause compile error on stdio calls
-numeric.c              Miscellaneous numeric conversion routines
-objXSUB.h              Scoping macros for Perl Object in extensions
-op.c                   Opcode syntax tree code
-op.h                   Opcode syntax tree header
-opcode.h               Automatically generated opcode header
-opcode.pl              Opcode header generatore
-opnames.h              Automatically generated opcode header
-os2/Changes            Changelog for OS/2 port
-os2/Makefile.SHs       Shared library generation for OS/2
+lib/warnings/run               Tests for run.c for warnings.t
+lib/warnings/sv                        Tests for sv.c for warnings.t
+lib/warnings/taint             Tests for taint.c for warnings.t
+lib/warnings/toke              Tests for toke.c for warnings.t
+lib/warnings/universal         Tests for universal.c for warnings.t
+lib/warnings/utf8              Tests for utf8.c for warnings.t
+lib/warnings/util              Tests for util.c for warnings.t
+locale.c                       locale-specific utility functions
+makeaperl.SH                   perl script that produces a new perl binary
+makedef.pl                     Create symbol export lists for linking
+makedepend.SH                  Precursor to makedepend
+makedir.SH                     Precursor to makedir
+malloc.c                       A version of malloc you might not want
+mg.c                           Magic code
+mg.h                           Magic header
+minimod.pl                     Writes lib/ExtUtils/Miniperl.pm
+miniperlmain.c                 Basic perl w/o dynamic loading or extensions
+mint/Makefile                  MiNT port
+mint/README                    MiNT port
+mint/errno.h                   MiNT port
+mint/pwd.c                     MiNT port
+mint/stdio.h                   MiNT port
+mint/sys/time.h                        MiNT port
+mint/time.h                    MiNT port
+mpeix/mpeixish.h               MPE/iX port
+mpeix/nm                       MPE/iX port
+mpeix/relink                   MPE/iX port
+mv-if-diff                     Script to mv a file if it changed
+myconfig.SH                    Prints summary of the current configuration
+nostdio.h                      Cause compile error on stdio calls
+numeric.c                      Miscellaneous numeric conversion routines
+objXSUB.h                      Scoping macros for Perl Object in extensions
+op.c                           Opcode syntax tree code
+op.h                           Opcode syntax tree header
+opcode.h                       Automatically generated opcode header
+opcode.pl                      Opcode header generatore
+opnames.h                      Automatically generated opcode header
+os2/Changes                    Changelog for OS/2 port
+os2/Makefile.SHs               Shared library generation for OS/2
 os2/OS2/ExtAttr/Changes                EA access module
 os2/OS2/ExtAttr/ExtAttr.pm     EA access module
 os2/OS2/ExtAttr/ExtAttr.xs     EA access module
@@ -1365,7 +1618,7 @@ os2/OS2/Process/Makefile.PL       system() constants in a module
 os2/OS2/Process/Process.pm     system() constants in a module
 os2/OS2/Process/Process.xs     system() constants in a module
 os2/OS2/REXX/Changes           DLL access module
-os2/OS2/REXX/DLL/Changes               DLL access module
+os2/OS2/REXX/DLL/Changes       DLL access module
 os2/OS2/REXX/DLL/DLL.pm                DLL access module
 os2/OS2/REXX/DLL/DLL.xs                DLL access module
 os2/OS2/REXX/DLL/MANIFEST      DLL access module
@@ -1384,778 +1637,525 @@ os2/OS2/REXX/t/rx_tievar.t    DLL access module
 os2/OS2/REXX/t/rx_tieydb.t     DLL access module
 os2/OS2/REXX/t/rx_varset.t     DLL access module
 os2/OS2/REXX/t/rx_vrexx.t      DLL access module
-os2/diff.configure     Patches to Configure
-os2/dl_os2.c           Addon for dl_open
-os2/dlfcn.h            Addon for dl_open
-os2/os2.c              Additional code for OS/2
-os2/os2.sym            Additional symbols to export
-os2/os2add.sym         Overriding symbols to export
-os2/os2ish.h           Header for OS/2
-os2/os2thread.h                pthread-like typedefs
-os2/perl2cmd.pl                Corrects installed binaries under OS/2
-patchlevel.h           The current patch level of perl
-perl.c                 main()
-perl.h                 Global declarations
-perlapi.c              Perl API functions
-perlapi.h              Perl API function declarations
-perlio.c               C code for PerlIO abstraction
-perlio.h               PerlIO abstraction
-perlio.sym             Symbols for PerlIO abstraction
-perliol.h              PerlIO Layer definition
-perlsdio.h             Fake stdio using perlio
-perlsfio.h             Prototype sfio mapping for PerlIO
-perlsh                 A poor man's perl shell
-perlvars.h             Global variables
-perly.c                        A byacc'ed perly.y
-perly.fixer            A program to remove yacc stack limitations
-perly.h                        The header file for perly.c
-perly.y                        Yacc grammar for perl
-perly_c.diff           Fixup perly.c to allow recursion
-perlyline.pl           Perl code to fix #line directives and gcc warnings in perly.c
-plan9/aperl            Shell to make Perl error messages Acme-friendly
-plan9/arpa/inet.h      Plan9 port: replacement C header file
-plan9/buildinfo                Plan9 port: configuration information
-plan9/config.plan9     Plan9 port: config.h template
-plan9/exclude          Plan9 port: tests to skip
-plan9/fndvers          Plan9 port: update Perl version in config.plan9
-plan9/genconfig.pl     Plan9 port: generate config.sh
-plan9/mkfile           Plan9 port: Mk driver for build
-plan9/myconfig.plan9   Plan9 port: script to print config summary
-plan9/plan9.c          Plan9 port: Plan9-specific C routines
-plan9/plan9ish.h       Plan9 port: Plan9-specific C header file
-plan9/setup.rc         Plan9 port: script for easy build+install
-plan9/versnum          Plan9 port: script to print version number
-pod/Makefile.SH                generate Makefile whichs makes pods into something else
-pod/buildtoc.PL                generate buildtoc which generates perltoc.pod
-pod/checkpods.PL       Tool to check for common errors in pods
-pod/perl.pod           Top level perl documentation
-pod/perl5004delta.pod  Changes from 5.003 to 5.004
-pod/perl5005delta.pod  Changes from 5.004 to 5.005
-pod/perl56delta.pod    Changes from 5.005 to 5.6
-pod/perl570delta.pod   Changes from 5.6 to 5.7.0
-pod/perl571delta.pod   Changes from 5.7.0 to 5.7.1
-pod/perl572delta.pod   Changes from 5.7.1 to 5.7.2
-pod/perlapi.pod         Perl API documentation (autogenerated)
-pod/perlapio.pod       PerlIO IO API info
-pod/perlbook.pod       Perl book information
-pod/perlboot.pod       Beginner's Object-oriented Tutorial
-pod/perlbot.pod                Object-oriented Bag o' Tricks
-pod/perlcall.pod       Callback info
-pod/perlclib.pod       Internal replacements for standard C library functions
-pod/perlcompile.pod    Info on using the Compiler suite
-pod/perldata.pod       Data structure info
-pod/perldbmfilter.pod  Info about DBM Filters
-pod/perldebguts.pod    Debugger guts info
-pod/perldebtut.pod     Perl debugging tutorial
-pod/perldebug.pod      Debugger info
-pod/perldelta.pod      Changes since last version
-pod/perldiag.pod       Diagnostic info
-pod/perldsc.pod                Data Structures Cookbook
-pod/perlebcdic.pod     Considerations for running Perl on EBCDIC platforms
-pod/perlembed.pod      Embedding info
-pod/perlfaq.pod                Frequently Asked Questions, Top Level
-pod/perlfaq1.pod       Frequently Asked Questions, Part 1
-pod/perlfaq2.pod       Frequently Asked Questions, Part 2
-pod/perlfaq3.pod       Frequently Asked Questions, Part 3
-pod/perlfaq4.pod       Frequently Asked Questions, Part 4
-pod/perlfaq5.pod       Frequently Asked Questions, Part 5
-pod/perlfaq6.pod       Frequently Asked Questions, Part 6
-pod/perlfaq7.pod       Frequently Asked Questions, Part 7
-pod/perlfaq8.pod       Frequently Asked Questions, Part 8
-pod/perlfaq9.pod       Frequently Asked Questions, Part 9
-pod/perlfilter.pod     Source filters info
-pod/perlfork.pod       Info about fork()
-pod/perlform.pod       Format info
-pod/perlfunc.pod       Function info
-pod/perlguts.pod       Internals info
-pod/perlhack.pod       Perl hackers guide
-pod/perlhist.pod       Perl history info
-pod/perlintern.pod      Perl internal function docs (autogenrated)
-pod/perliol.pod                Internals of PerlIO with layers.
-pod/perlipc.pod                IPC info
-pod/perllexwarn.pod    Lexical Warnings info
-pod/perllocale.pod     Locale support info
-pod/perllol.pod                How to use lists of lists
-pod/perlmod.pod                Module mechanism info
-pod/perlmodinstall.pod Installing CPAN Modules
-pod/perlmodlib.PL      Generate pod/perlmodlib.pod
-pod/perlmodlib.pod     Module policy info
-pod/perlnewmod.pod     Preparing a new module for distribution
-pod/perlnumber.pod     Semantics of numbers and numeric operations
-pod/perlobj.pod                Object info
-pod/perlop.pod         Operator info
-pod/perlopentut.pod    open() tutorial
-pod/perlpod.pod                Pod info
-pod/perlport.pod       Portability guide
-pod/perlre.pod         Regular expression info
-pod/perlref.pod                References info
-pod/perlreftut.pod     Mark's references tutorial
-pod/perlrequick.pod    Quick start guide for Perl regular expressions
-pod/perlretut.pod      Tutorial for Perl regular expressions
-pod/perlrun.pod                Execution info
-pod/perlsec.pod                Security info
-pod/perlstyle.pod      Style info
-pod/perlsub.pod                Subroutine info
-pod/perlsyn.pod                Syntax info
-pod/perlthrtut.pod     Threads tutorial
-pod/perltie.pod                Tieing an object class into a simple variable
-pod/perltoc.pod                Table of Contents info
-pod/perltodo.pod       Todo list explained
-pod/perltoot.pod       Tom's object-oriented tutorial
-pod/perltootc.pod      Tom's object-oriented tutorial (more on class data)
-pod/perltrap.pod       Trap info
-pod/perlunicode.pod    Unicode support info
-pod/perlutil.pod       Accompanying utilities explained
-pod/perlvar.pod                Variable info
-pod/perlxs.pod         XS api info
-pod/perlxstut.pod      XS tutorial
-pod/pod2html.PL                Precursor for translator to turn pod into HTML
-pod/pod2latex.PL       Precursor for translator to turn pod into LaTeX
-pod/pod2man.PL         Precursor for translator to turn pod into manpage
-pod/pod2text.PL                Precursor for translator to turn pod into text
-pod/pod2usage.PL       Pod-Parser - print usage messages from POD docs
-pod/podchecker.PL      Pod-Parser - Pod::Checker::podchecker() CLI
-pod/podselect.PL       Pod-Parser - Pod::Select::podselect() CLI
-pod/roffitall          troff the whole man page set
-pod/rofftoc            Generate a table of contents in troff format
-pod/splitman           Splits perlfunc into multiple man pages
-pod/splitpod           Splits perlfunc into multiple pod pages
-pp.c                   Push/Pop code
-pp.h                   Push/Pop code defs
-pp.sym                 Push/Pop code symbols
-pp_ctl.c               Push/Pop code for control flow
-pp_hot.c               Push/Pop code for heavily used opcodes
-pp_proto.h             C++ definitions for Push/Pop code
-pp_sys.c               Push/Pop code for system interaction
-proto.h                        Prototypes
-qnx/ar                 QNX implementation of "ar" utility
-qnx/cpp                        QNX implementation of preprocessor filter
-regcomp.c              Regular expression compiler
-regcomp.h              Private declarations for above
-regcomp.pl             Builder of regnodes.h
-regcomp.sym            Data for regnodes.h
-regexec.c              Regular expression evaluator
-regexp.h               Public declarations for the above
-regnodes.h             Description of nodes of RE engine
-run.c                  The interpreter loop
-scope.c                        Scope entry and exit code
-scope.h                        Scope entry and exit header
-sv.c                   Scalar value code
-sv.h                   Scalar value header
-t/README               Instructions for regression tests
-t/TEST                 The regression tester
-t/TestInit.pm          Preamble library for core tests
-t/base/commonsense.t   See if configuration meets basic needs
-t/base/cond.t          See if conditionals work
-t/base/if.t            See if if works
-t/base/lex.t           See if lexical items work
-t/base/pat.t           See if pattern matching works
-t/base/rs.t            See if record-read works
-t/base/term.t          See if various terms work
-t/cmd/elsif.t          See if else-if works
-t/cmd/for.t            See if for loops work
-t/cmd/mod.t            See if statement modifiers work
-t/cmd/subval.t         See if subroutine values work
-t/cmd/switch.t         See if switch optimizations work
-t/cmd/while.t          See if while loops work
-t/comp/bproto.t                See if builtins conform to their prototypes
-t/comp/cmdopt.t                See if command optimization works
-t/comp/colon.t         See if colons are parsed correctly
-t/comp/cpp.aux         main file for cpp.t
-t/comp/cpp.t           See if C preprocessor works
-t/comp/decl.t          See if declarations work
-t/comp/multiline.t     See if multiline strings work
-t/comp/package.t       See if packages work
-t/comp/proto.t         See if function prototypes work
-t/comp/redef.t         See if we get correct warnings on redefined subs
-t/comp/require.t       See if require works
-t/comp/script.t                See if script invokation works
-t/comp/term.t          See if more terms work
-t/comp/use.t           See if pragmas work
-t/harness              Finer diagnostics from test suite
-t/io/argv.t            See if ARGV stuff works
-t/io/dup.t             See if >& works right
-t/io/fflush.t          See if auto-flush on fork/exec/system/qx works
-t/io/fs.t              See if directory manipulations work
-t/io/inplace.t         See if inplace editing works
-t/io/iprefix.t         See if inplace editing works with prefixes
-t/io/nargv.t           See if nested ARGV stuff works
-t/io/open.t            See if open works
-t/io/openpid.t         See if open works for subprocesses
-t/io/pipe.t            See if secure pipes work
-t/io/print.t           See if print commands work
-t/io/read.t            See if read works
-t/io/tell.t            See if file seeking works
-t/io/utf8.t            See if file seeking works
-t/lib/1_compile.t      See if the various libraries and extensions compile
-t/lib/MyFilter.pm      Helper file for t/lib/filter-simple.t
-t/lib/Test/fail.t      See if Test works
-t/lib/Test/mix.t       See if Test works
-t/lib/Test/onfail.t    See if Test works
-t/lib/Test/qr.t        See if Test works
-t/lib/Test/skip.t      See if Test works
-t/lib/Test/success.t   See if Test works
-t/lib/Test/todo.t      See if Test works
-t/lib/ansicolor.t      See if Term::ANSIColor works
-t/lib/anydbm.t         See if AnyDBM_File works
-t/lib/attrhand.t       See if Attribute::Handlers works
-t/lib/attrs.t          See if attrs works with C<sub : attrs>
-t/lib/autoloader.t     See if AutoLoader works
-t/lib/b-debug.t         See if B::Debug works
-t/lib/b-deparse.t       See if B::Deparse works
-t/lib/b-showlex.t       See if B::ShowLex works
-t/lib/b-stash.t         See if B::Stash works
-t/lib/b.t              See if B works
-t/lib/basename.t       See if File::Basename works
-t/lib/bigfloat.t       See if bigfloat.pl works
-t/lib/bigfltpm.t       See if BigFloat.pm works
-t/lib/bigint.t         See if bigint.pl works
-t/lib/bigintpm.t       See if BigInt.pm works
-t/lib/carp.t           See if Carp works
-t/lib/cgi-esc.t                See if CGI.pm works
-t/lib/cgi-form.t       See if CGI.pm works
-t/lib/cgi-function.t   See if CGI.pm works
-t/lib/cgi-html.t       See if CGI.pm works
-t/lib/cgi-pretty.t     See if CGI.pm works
-t/lib/cgi-request.t    See if CGI.pm works
-t/lib/charnames.t      See if character names work
-t/lib/checktree.t      See if File::CheckTree works
-t/lib/class-isa.t      See if Class::ISA works
-t/lib/class-struct.t   See if Class::Struct works
-t/lib/complex.t                See if Math::Complex works
-t/lib/compmod.pl       Helper for 1_compile.t
-t/lib/cpan-loadme.t    See if CPAN the module works
-t/lib/cpan-vcmp.t      See if CPAN the module works
-t/lib/cwd.t            See if Cwd works
-t/lib/db-btree.t       See if DB_File works
-t/lib/db-hash.t                See if DB_File works
-t/lib/db-recno.t       See if DB_File works
-t/lib/digest.t See if Digest extensions work
-t/lib/dirhand.t                See if DirHandle works
-t/lib/dosglob.t                See if File::DosGlob works
-t/lib/dprof.t          Perl code profiler testsuite driver
-t/lib/dprof/V.pm       Perl code profiler tests
-t/lib/dprof/test1_t    Perl code profiler tests
-t/lib/dprof/test1_v    Perl code profiler tests
-t/lib/dprof/test2_t    Perl code profiler tests
-t/lib/dprof/test2_v    Perl code profiler tests
-t/lib/dprof/test3_t    Perl code profiler tests
-t/lib/dprof/test3_v    Perl code profiler tests
-t/lib/dprof/test4_t    Perl code profiler tests
-t/lib/dprof/test4_v    Perl code profiler tests
-t/lib/dprof/test5_t    Perl code profiler tests
-t/lib/dprof/test5_v    Perl code profiler tests
-t/lib/dprof/test6_t    Perl code profiler tests
-t/lib/dprof/test6_v    Perl code profiler tests
-t/lib/dumper-ovl.t     See if Data::Dumper works for overloaded data
-t/lib/dumper.t         See if Data::Dumper works
-t/lib/encode.t         See if Encode works
-t/lib/english.t                See if English works
-t/lib/env-array.t      See if Env works for arrays
-t/lib/env.t            See if Env works
-t/lib/errno.t          See if Errno works
-t/lib/exporter.t        See if Exporter works
-t/lib/extutils.t       See if extutils work
-t/lib/fatal.t           See if Fatal works
-t/lib/fcntl.t           See if Fcntl works
-t/lib/fields.t          See if base/fields works
-t/lib/filecache.t      See if FileCache works
-t/lib/filecomp.t       See if File::Compare works
-t/lib/filecopy.t       See if File::Copy works
-t/lib/filefind.t       See if File::Find works
-t/lib/filefunc.t       See if File::Spec::Functions works
-t/lib/filehand.t       See if FileHandle works
-t/lib/filepath.t       See if File::Path works
-t/lib/filespec.t       See if File::Spec works
-t/lib/filestat.t       See if File::stat works
-t/lib/filter-simple.t  See if Filter::Simple works
-t/lib/filter-util.pl   See if Filter::Util::Call works
-t/lib/filter-util.t    See if Filter::Util::Call works
-t/lib/findbin.t                See if FindBin works
-t/lib/findtaint.t      See if File::Find works with taint
-t/lib/ftmp-mktemp.t    See if File::Temp works
-t/lib/ftmp-posix.t     See if File::Temp works
-t/lib/ftmp-security.t  See if File::Temp works
-t/lib/ftmp-tempfile.t  See if File::Temp works
-t/lib/gdbm.t           See if GDBM_File works
-t/lib/getopt.t         See if Getopt::Std and Getopt::Long work
-t/lib/glob-basic.t     See if File::Glob works
-t/lib/glob-case.t      See if File::Glob works
-t/lib/glob-global.t    See if File::Glob works
-t/lib/glob-taint.t     See if File::Glob works
-t/lib/gol-basic.t      See if Getopt::Long works
-t/lib/gol-compat.t     See if Getopt::Long works
-t/lib/gol-linkage.t    See if Getopt::Long works
-t/lib/gol-oo.t         See if Getopt::Long works
-t/lib/h2ph.h           Test header file for h2ph
-t/lib/h2ph.pht         Generated output from h2ph.h by h2ph, for comparison
-t/lib/h2ph.t           See if h2ph works like it should
-t/lib/hostname.t       See if Sys::Hostname works
-t/lib/i18n-collate.t   See if I18N::Collate works
-t/lib/i18n-langtags.t  See if I18N::LangTags work
-t/lib/io_const.t       See if constants from IO work
-t/lib/io_dir.t         See if directory-related methods from IO work
-t/lib/io_dup.t         See if dup()-related methods from IO work
-t/lib/io_linenum.t     See if I/O line numbers are tracked correctly
-t/lib/io_multihomed.t  See if INET sockets work with multi-homed hosts
-t/lib/io_pipe.t                See if pipe()-related methods from IO work
-t/lib/io_poll.t                See if poll()-related methods from IO work
-t/lib/io_scalar.t      Test of PerlIO::Scalar
-t/lib/io_sel.t         See if select()-related methods from IO work
-t/lib/io_sock.t                See if INET socket-related methods from IO work
-t/lib/io_taint.t       See if the untaint method from IO works
-t/lib/io_tell.t                See if seek()/tell()-related methods from IO work
-t/lib/io_udp.t         See if UDP socket-related methods from IO work
-t/lib/io_unix.t                See if UNIX socket-related methods from IO work
-t/lib/io_xs.t          See if XSUB methods from IO work
-t/lib/ipc_sysv.t       See if IPC::SysV works
-t/lib/lc-all.t See if Locale::Codes work
-t/lib/lc-constants.t   See if Locale::Codes work
-t/lib/lc-country.t     See if Locale::Codes work
-t/lib/lc-currency.t    See if Locale::Codes work
-t/lib/lc-language.t    See if Locale::Codes work
-t/lib/lc-maketext.t    See if Locale::Maketext works
-t/lib/lc-uk.t  See if Locale::Codes work
-t/lib/mbimbf.t BigInt/BigFloat accuracy, precicion and fallback, round_mode
-t/lib/md5-aaa.t        See if Digest::MD5 extension works
-t/lib/md5-align.t      See if Digest::MD5 extension works
-t/lib/md5-badf.t       See if Digest::MD5 extension works
-t/lib/md5-file.t       See if Digest::MD5 extension works
-t/lib/mimeb64.t                        see whether MIME::Base64 works
-t/lib/mimeb64u.t               see whether MIME::Base64 works
-t/lib/mimeqp.t         see whether MIME::QuotedPrint works
-t/lib/ndbm.t           See if NDBM_File works
-t/lib/net-hostent.t    See if Net::hostent works
-t/lib/net-nent.t       See if Net::netent works
-t/lib/net-pent.t       See if Net::protoent works
-t/lib/net-sent.t       See if Net::servtent works
-t/lib/next.t           See if NEXT works
-t/lib/odbm.t           See if ODBM_File works
-t/lib/opcode.t         See if Opcode works
-t/lib/open2.t          See if IPC::Open2 works
-t/lib/open3.t          See if IPC::Open3 works
-t/lib/ops.t            See if Opcode works
-t/lib/parsewords.t     See if Text::ParseWords works
-t/lib/peek.t           See if Devel::Peek works
-t/lib/perlio.t         See if PerlIO works
-t/lib/ph.t             See if h2ph works
-t/lib/posix.t          See if POSIX works
-t/lib/safe1.t          See if Safe works
-t/lib/safe2.t          See if Safe works
-t/lib/sample-tests/bailout              Test data for Test::Harness
-t/lib/sample-tests/combined             Test data for Test::Harness
-t/lib/sample-tests/descriptive          Test data for Test::Harness
-t/lib/sample-tests/duplicates           Test data for Test::Harness
-t/lib/sample-tests/header_at_end        Test data for Test::Harness
-t/lib/sample-tests/no_nums              Test data for Test::Harness
-t/lib/sample-tests/simple               Test data for Test::Harness
-t/lib/sample-tests/simple_fail          Test data for Test::Harness
-t/lib/sample-tests/skip                 Test data for Test::Harness
-t/lib/sample-tests/skip_all             Test data for Test::Harness
-t/lib/sample-tests/todo                 Test data for Test::Harness
-t/lib/sample-tests/with_comments        Test data for Test::Harness
-t/lib/sdbm.t           See if SDBM_File works
-t/lib/searchdict.t     See if Search::Dict works
-t/lib/selectsaver.t    See if SelectSaver works
-t/lib/selfloader.t     See if SelfLoader works
-t/lib/selfstubber.t    See if Devel::SelfStubber works
-t/lib/sigaction.t       See if POSIX::sigaction works
-t/lib/socket.t         See if Socket works
-t/lib/soundex.t                See if Soundex works
-t/lib/st-06compat.t    See if Storable works
-t/lib/st-blessed.t     See if Storable works
-t/lib/st-canonical.t   See if Storable works
-t/lib/st-dclone.t      See if Storable works
-t/lib/st-dump.pl       See if Storable works
-t/lib/st-forgive.t     See if Storable works
-t/lib/st-freeze.t      See if Storable works
-t/lib/st-lock.t                See if Storable works
-t/lib/st-overload.t    See if Storable works
-t/lib/st-recurse.t     See if Storable works
-t/lib/st-retrieve.t    See if Storable works
-t/lib/st-store.t       See if Storable works
-t/lib/st-tied.t                See if Storable works
-t/lib/st-tiedhook.t    See if Storable works
-t/lib/st-tieditems.t   See if Storable works
-t/lib/st-utf8.t                See if Storable works
-t/lib/switch.t         Test whether switch works
-t/lib/symbol.t         See if Symbol works
-t/lib/syslfs.t         See if large files work for sysio
-t/lib/syslog.t         See if Sys::Syslog works
-t/lib/tb-genxt.t       See if Text::Balanced works
-t/lib/tb-xbrak.t       See if Text::Balanced works
-t/lib/tb-xcode.t       See if Text::Balanced works
-t/lib/tb-xdeli.t       See if Text::Balanced works
-t/lib/tb-xmult.t       See if Text::Balanced works
-t/lib/tb-xquot.t       See if Text::Balanced works
-t/lib/tb-xtagg.t       See if Text::Balanced works
-t/lib/tb-xvari.t       See if Text::Balanced works
-t/lib/test-harness.t    See if Test::Harness works
-t/lib/textfill.t       See if Text::Wrap::fill works
-t/lib/texttabs.t       See if Text::Tabs works
-t/lib/textwrap.t       See if Text::Wrap::wrap works
-t/lib/thr5005.t                Test 5.005-style threading (skipped if no use5005threads)
-t/lib/tie-push.t       Test for Tie::Array
-t/lib/tie-refhash.t    Test for Tie::RefHash and Tie::RefHash::Nestable
-t/lib/tie-splice.t     Test for Tie::Array::SPLICE
-t/lib/tie-stdarray.t   Test for Tie::StdArray
-t/lib/tie-stdhandle.t  Test for Tie::StdHandle
-t/lib/tie-stdpush.t    Test for Tie::StdArray
-t/lib/tie-substrhash.t Test for Tie::SubstrHash
-t/lib/time-gmtime.t    Test for Time::gmtime
-t/lib/time-hires.t     Test for Time::HiRes
-t/lib/time-localtime.t Test for Time::localtime
-t/lib/time-piece.t     Test for Time::Piece
-t/lib/timelocal.t      See if Time::Local works
-t/lib/trig.t           See if Math::Trig works
-t/lib/u-blessed.t      Scalar::Util
-t/lib/u-dualvar.t      Scalar::Util
-t/lib/u-first.t                List::Util
-t/lib/u-max.t          List::Util
-t/lib/u-maxstr.t       List::Util
-t/lib/u-min.t          List::Util
-t/lib/u-minstr.t       List::Util
-t/lib/u-readonly.t     Scalar::Util
-t/lib/u-reduce.t       List::Util
-t/lib/u-reftype.t      Scalar::Util
-t/lib/u-sum.t          List::Util
-t/lib/u-tainted.t      Scalar::Util
-t/lib/u-weak.t         Scalar::Util
-t/lib/user-grent.t     See if User::grwent works
-t/lib/user-pwent.t     See if User::pwent works
-t/lib/xs-typemap.t     test that typemaps work
-t/op/64bitint.t                See if 64 bit integers work
-t/op/anonsub.t         See if anonymous subroutines work
-t/op/append.t          See if . works
-t/op/args.t            See if operations on @_ work
-t/op/arith.t           See if arithmetic works
-t/op/array.t           See if array operations work
-t/op/assignwarn.t      See if OP= operators warn correctly for undef targets
-t/op/attrs.t           See if attributes on declarations work
-t/op/auto.t            See if autoincrement et all work
-t/op/avhv.t            See if pseudo-hashes work
-t/op/bless.t           See if bless works
-t/op/bop.t             See if bitops work
-t/op/chars.t           See if character escapes work
-t/op/chop.t            See if chop works
-t/op/closure.t         See if closures work
-t/op/cmp.t             See if the various string and numeric compare work
-t/op/concat.t          See if string concatenation works
-t/op/cond.t            See if conditional expressions work
-t/op/context.t         See if context propagation works
-t/op/defins.t          See if auto-insert of defined() works
-t/op/delete.t          See if delete works
-t/op/die.t             See if die works
-t/op/die_exit.t                See if die and exit status interaction works
-t/op/do.t              See if subroutines work
-t/op/each.t            See if hash iterators work
-t/op/eval.t            See if eval operator works
-t/op/exec.t            See if exec and system work
-t/op/exists_sub.t      See if exists(&sub) works
-t/op/exp.t             See if math functions work
-t/op/fh.t              See if filehandles work
-t/op/filetest.t                See if file tests work
-t/op/flip.t            See if range operator works
-t/op/fork.t            See if fork works
-t/op/glob.t            See if <*> works
-t/op/gmagic.t          See if GMAGIC works
-t/op/goto.t            See if goto works
-t/op/goto_xs.t         See if "goto &sub" works on XSUBs
-t/op/grent.t           See if getgr*() functions work
-t/op/grep.t            See if grep() and map() work
-t/op/groups.t          See if $( works
-t/op/gv.t              See if typeglobs work
-t/op/hashwarn.t                See if warnings for bad hash assignments work
-t/op/inc.t             See if inc/dec of integers near 32 bit limit work
-t/op/index.t           See if index works
-t/op/int.t             See if int works
-t/op/join.t            See if join works
-t/op/length.t          See if length works
-t/op/lex_assign.t      See if ops involving lexicals or pad temps work
-t/op/lfs.t             See if large files work for perlio
-t/op/list.t            See if array lists work
-t/op/local.t           See if local works
-t/op/loopctl.t         See if next/last/redo work
-t/op/lop.t             See if logical operators work
-t/op/magic.t           See if magic variables work
-t/op/method.t          See if method calls work
-t/op/misc.t            See if miscellaneous bugs have been fixed
-t/op/mkdir.t           See if mkdir works
-t/op/my.t              See if lexical scoping works
-t/op/my_stash.t                See if my Package works
-t/op/nothr5005.t       local @_ test which does not work under use5005threads
-t/op/numconvert.t      See if accessing fields does not change numeric values
-t/op/oct.t             See if oct and hex work
-t/op/ord.t             See if ord works
-t/op/override.t                See if operator overriding works
-t/op/pack.t            See if pack and unpack work
-t/op/pat.t             See if esoteric patterns work
-t/op/pos.t             See if pos works
-t/op/push.t            See if push and pop work
-t/op/pwent.t           See if getpw*() functions work
-t/op/quotemeta.t       See if quotemeta works
-t/op/rand.t            See if rand works
-t/op/range.t           See if .. works
-t/op/re_tests          Regular expressions for regexp.t
-t/op/read.t            See if read() works
-t/op/readdir.t         See if readdir() works
-t/op/recurse.t         See if deep recursion works
-t/op/ref.t             See if refs and objects work
-t/op/regexp.t          See if regular expressions work
-t/op/regexp_noamp.t    See if regular expressions work with optimizations
-t/op/regmesg.t         See if one can get regular expression errors
-t/op/repeat.t          See if x operator works
-t/op/reverse.t         See if reverse operator works
-t/op/runlevel.t                See if die() works from perl_call_*()
-t/op/sleep.t           See if sleep works
-t/op/sort.t            See if sort works
-t/op/splice.t           See if splice works
-t/op/split.t           See if split works
-t/op/sprintf.t         See if sprintf works
-t/op/stat.t            See if stat works
-t/op/study.t           See if study works
-t/op/subst.t           See if substitution works
-t/op/subst_amp.t       See if $&-related substitution works
-t/op/subst_wamp.t      See if substitution works with $& present
-t/op/substr.t          See if substr works
-t/op/sysio.t           See if sysread and syswrite work
-t/op/taint.t           See if tainting works
-t/op/tie.t             See if tie/untie functions work
-t/op/tiearray.t                See if tie for arrays works
-t/op/tiehandle.t       See if tie for handles works
-t/op/time.t            See if time functions work
-t/op/tr.t              See if tr works
-t/op/undef.t           See if undef works
-t/op/universal.t       See if UNIVERSAL class works
-t/op/unshift.t         See if unshift works
-t/op/utf8decode.t      See if UTF-8 decoding works
-t/op/vec.t             See if vectors work
-t/op/ver.t             See if v-strings and the %v format flag work
-t/op/wantarray.t       See if wantarray works
-t/op/write.t           See if write works (formats work)
-t/pod/emptycmd.t       Test empty pod directives
-t/pod/emptycmd.xr      Expected results for emptycmd.t
-t/pod/find.t           See if Pod::Find works
-t/pod/for.t            Test =for directive
-t/pod/for.xr           Expected results for for.t
-t/pod/headings.t       Test =head directives
-t/pod/headings.xr      Expected results for headings.t
-t/pod/include.t                Test =include directive
-t/pod/include.xr       Expected results for include.t
-t/pod/included.t       Test =include directive
-t/pod/included.xr      Expected results for included.t
-t/pod/lref.t           Test L<...> sequences
-t/pod/lref.xr          Expected results for lref.t
-t/pod/multiline_items.t        Test multiline =items
+os2/diff.configure             Patches to Configure
+os2/dl_os2.c                   Addon for dl_open
+os2/dlfcn.h                    Addon for dl_open
+os2/os2.c                      Additional code for OS/2
+os2/os2.sym                    Additional symbols to export
+os2/os2add.sym                 Overriding symbols to export
+os2/os2ish.h                   Header for OS/2
+os2/os2thread.h                        pthread-like typedefs
+os2/perl2cmd.pl                        Corrects installed binaries under OS/2
+patchlevel.h                   The current patch level of perl
+perl.c                         main()
+perl.h                         Global declarations
+perlapi.c                      Perl API functions
+perlapi.h                      Perl API function declarations
+perlio.c                       C code for PerlIO abstraction
+perlio.h                       PerlIO abstraction
+perlio.sym                     Symbols for PerlIO abstraction
+perliol.h                      PerlIO Layer definition
+perlsdio.h                     Fake stdio using perlio
+perlsfio.h                     Prototype sfio mapping for PerlIO
+perlsh                         A poor man's perl shell
+perlvars.h                     Global variables
+perly.c                                A byacc'ed perly.y
+perly.fixer                    A program to remove yacc stack limitations
+perly.h                                The header file for perly.c
+perly.y                                Yacc grammar for perl
+perly_c.diff                   Fixup perly.c to allow recursion
+perlyline.pl                   Perl code to fix #line directives and gcc warnings in perly.c
+plan9/aperl                    Shell to make Perl error messages Acme-friendly
+plan9/arpa/inet.h              Plan9 port: replacement C header file
+plan9/buildinfo                        Plan9 port: configuration information
+plan9/config.plan9             Plan9 port: config.h template
+plan9/exclude                  Plan9 port: tests to skip
+plan9/fndvers                  Plan9 port: update Perl version in config.plan9
+plan9/genconfig.pl             Plan9 port: generate config.sh
+plan9/mkfile                   Plan9 port: Mk driver for build
+plan9/myconfig.plan9           Plan9 port: script to print config summary
+plan9/plan9.c                  Plan9 port: Plan9-specific C routines
+plan9/plan9ish.h               Plan9 port: Plan9-specific C header file
+plan9/setup.rc                 Plan9 port: script for easy build+install
+plan9/versnum                  Plan9 port: script to print version number
+pod/Makefile.SH                        generate Makefile whichs makes pods into something else
+pod/buildtoc.PL                        generate buildtoc which generates perltoc.pod
+pod/checkpods.PL               Tool to check for common errors in pods
+pod/perl.pod                   Top level perl documentation
+pod/perl5004delta.pod          Changes from 5.003 to 5.004
+pod/perl5005delta.pod          Changes from 5.004 to 5.005
+pod/perl56delta.pod            Changes from 5.005 to 5.6
+pod/perl570delta.pod           Changes from 5.6 to 5.7.0
+pod/perl571delta.pod           Changes from 5.7.0 to 5.7.1
+pod/perl572delta.pod           Changes from 5.7.1 to 5.7.2
+pod/perlapi.pod                        Perl API documentation (autogenerated)
+pod/perlapio.pod               PerlIO IO API info
+pod/perlbook.pod               Perl book information
+pod/perlboot.pod               Beginner's Object-oriented Tutorial
+pod/perlbot.pod                        Object-oriented Bag o' Tricks
+pod/perlcall.pod               Callback info
+pod/perlclib.pod               Internal replacements for standard C library functions
+pod/perlcompile.pod            Info on using the Compiler suite
+pod/perldata.pod               Data structure info
+pod/perldbmfilter.pod          Info about DBM Filters
+pod/perldebguts.pod            Debugger guts info
+pod/perldebtut.pod             Perl debugging tutorial
+pod/perldebug.pod              Debugger info
+pod/perldelta.pod              Changes since last version
+pod/perldiag.pod               Diagnostic info
+pod/perldsc.pod                        Data Structures Cookbook
+pod/perlebcdic.pod             Considerations for running Perl on EBCDIC platforms
+pod/perlembed.pod              Embedding info
+pod/perlfaq.pod                        Frequently Asked Questions, Top Level
+pod/perlfaq1.pod               Frequently Asked Questions, Part 1
+pod/perlfaq2.pod               Frequently Asked Questions, Part 2
+pod/perlfaq3.pod               Frequently Asked Questions, Part 3
+pod/perlfaq4.pod               Frequently Asked Questions, Part 4
+pod/perlfaq5.pod               Frequently Asked Questions, Part 5
+pod/perlfaq6.pod               Frequently Asked Questions, Part 6
+pod/perlfaq7.pod               Frequently Asked Questions, Part 7
+pod/perlfaq8.pod               Frequently Asked Questions, Part 8
+pod/perlfaq9.pod               Frequently Asked Questions, Part 9
+pod/perlfilter.pod             Source filters info
+pod/perlfork.pod               Info about fork()
+pod/perlform.pod               Format info
+pod/perlfunc.pod               Function info
+pod/perlguts.pod               Internals info
+pod/perlhack.pod               Perl hackers guide
+pod/perlhist.pod               Perl history info
+pod/perlintern.pod             Perl internal function docs (autogenrated)
+pod/perliol.pod                        Internals of PerlIO with layers.
+pod/perlipc.pod                        IPC info
+pod/perllexwarn.pod            Lexical Warnings info
+pod/perllocale.pod             Locale support info
+pod/perllol.pod                        How to use lists of lists
+pod/perlmod.pod                        Module mechanism info
+pod/perlmodinstall.pod         Installing CPAN Modules
+pod/perlmodlib.PL              Generate pod/perlmodlib.pod
+pod/perlmodlib.pod             Module policy info
+pod/perlnewmod.pod             Preparing a new module for distribution
+pod/perlnumber.pod             Semantics of numbers and numeric operations
+pod/perlobj.pod                        Object info
+pod/perlop.pod                 Operator info
+pod/perlopentut.pod            open() tutorial
+pod/perlpod.pod                        Pod info
+pod/perlport.pod               Portability guide
+pod/perlre.pod                 Regular expression info
+pod/perlref.pod                        References info
+pod/perlreftut.pod             Mark's references tutorial
+pod/perlrequick.pod            Quick start guide for Perl regular expressions
+pod/perlretut.pod              Tutorial for Perl regular expressions
+pod/perlrun.pod                        Execution info
+pod/perlsec.pod                        Security info
+pod/perlstyle.pod              Style info
+pod/perlsub.pod                        Subroutine info
+pod/perlsyn.pod                        Syntax info
+pod/perlthrtut.pod             Threads tutorial
+pod/perltie.pod                        Tieing an object class into a simple variable
+pod/perltoc.pod                        Table of Contents info
+pod/perltodo.pod               Todo list explained
+pod/perltoot.pod               Tom's object-oriented tutorial
+pod/perltootc.pod              Tom's object-oriented tutorial (more on class data)
+pod/perltrap.pod               Trap info
+pod/perlunicode.pod            Unicode support info
+pod/perlutil.pod               Accompanying utilities explained
+pod/perlvar.pod                        Variable info
+pod/perlxs.pod                 XS api info
+pod/perlxstut.pod              XS tutorial
+pod/pod2html.PL                        Precursor for translator to turn pod into HTML
+pod/pod2latex.PL               Precursor for translator to turn pod into LaTeX
+pod/pod2man.PL                 Precursor for translator to turn pod into manpage
+pod/pod2text.PL                        Precursor for translator to turn pod into text
+pod/pod2usage.PL               Pod-Parser - print usage messages from POD docs
+pod/podchecker.PL              Pod-Parser - Pod::Checker::podchecker() CLI
+pod/podselect.PL               Pod-Parser - Pod::Select::podselect() CLI
+pod/roffitall                  troff the whole man page set
+pod/rofftoc                    Generate a table of contents in troff format
+pod/splitman                   Splits perlfunc into multiple man pages
+pod/splitpod                   Splits perlfunc into multiple pod pages
+pp.c                           Push/Pop code
+pp.h                           Push/Pop code defs
+pp.sym                         Push/Pop code symbols
+pp_ctl.c                       Push/Pop code for control flow
+pp_hot.c                       Push/Pop code for heavily used opcodes
+pp_proto.h                     C++ definitions for Push/Pop code
+pp_sys.c                       Push/Pop code for system interaction
+proto.h                                Prototypes
+qnx/ar                         QNX implementation of "ar" utility
+qnx/cpp                                QNX implementation of preprocessor filter
+regcomp.c                      Regular expression compiler
+regcomp.h                      Private declarations for above
+regcomp.pl                     Builder of regnodes.h
+regcomp.sym                    Data for regnodes.h
+regexec.c                      Regular expression evaluator
+regexp.h                       Public declarations for the above
+regnodes.h                     Description of nodes of RE engine
+run.c                          The interpreter loop
+scope.c                                Scope entry and exit code
+scope.h                                Scope entry and exit header
+sv.c                           Scalar value code
+sv.h                           Scalar value header
+t/README                       Instructions for regression tests
+t/TEST                         The regression tester
+t/TestInit.pm                  Preamble library for core tests
+t/base/commonsense.t           See if configuration meets basic needs
+t/base/cond.t                  See if conditionals work
+t/base/if.t                    See if if works
+t/base/lex.t                   See if lexical items work
+t/base/pat.t                   See if pattern matching works
+t/base/rs.t                    See if record-read works
+t/base/term.t                  See if various terms work
+t/cmd/elsif.t                  See if else-if works
+t/cmd/for.t                    See if for loops work
+t/cmd/mod.t                    See if statement modifiers work
+t/cmd/subval.t                 See if subroutine values work
+t/cmd/switch.t                 See if switch optimizations work
+t/cmd/while.t                  See if while loops work
+t/comp/bproto.t                        See if builtins conform to their prototypes
+t/comp/cmdopt.t                        See if command optimization works
+t/comp/colon.t                 See if colons are parsed correctly
+t/comp/cpp.aux                 main file for cpp.t
+t/comp/cpp.t                   See if C preprocessor works
+t/comp/decl.t                  See if declarations work
+t/comp/multiline.t             See if multiline strings work
+t/comp/package.t               See if packages work
+t/comp/proto.t                 See if function prototypes work
+t/comp/redef.t                 See if we get correct warnings on redefined subs
+t/comp/require.t               See if require works
+t/comp/script.t                        See if script invokation works
+t/comp/term.t                  See if more terms work
+t/comp/use.t                   See if pragmas work
+t/harness                      Finer diagnostics from test suite
+t/io/argv.t                    See if ARGV stuff works
+t/io/dup.t                     See if >& works right
+t/io/fflush.t                  See if auto-flush on fork/exec/system/qx works
+t/io/fs.t                      See if directory manipulations work
+t/io/inplace.t                 See if inplace editing works
+t/io/iprefix.t                 See if inplace editing works with prefixes
+t/io/nargv.t                   See if nested ARGV stuff works
+t/io/open.t                    See if open works
+t/io/openpid.t                 See if open works for subprocesses
+t/io/pipe.t                    See if secure pipes work
+t/io/print.t                   See if print commands work
+t/io/read.t                    See if read works
+t/io/tell.t                    See if file seeking works
+t/io/utf8.t                    See if file seeking works
+t/lib/1_compile.t              See if the various libraries and extensions compile
+t/lib/MyFilter.pm              Helper file for t/lib/filter-simple.t
+t/lib/compmod.pl               Helper for 1_compile.t
+t/lib/dprof/V.pm               Perl code profiler tests
+t/lib/dprof/test1_t            Perl code profiler tests
+t/lib/dprof/test1_v            Perl code profiler tests
+t/lib/dprof/test2_t            Perl code profiler tests
+t/lib/dprof/test2_v            Perl code profiler tests
+t/lib/dprof/test3_t            Perl code profiler tests
+t/lib/dprof/test3_v            Perl code profiler tests
+t/lib/dprof/test4_t            Perl code profiler tests
+t/lib/dprof/test4_v            Perl code profiler tests
+t/lib/dprof/test5_t            Perl code profiler tests
+t/lib/dprof/test5_v            Perl code profiler tests
+t/lib/dprof/test6_t            Perl code profiler tests
+t/lib/dprof/test6_v            Perl code profiler tests
+t/lib/filter-util.pl           See if Filter::Util::Call works
+t/lib/h2ph.h                   Test header file for h2ph
+t/lib/h2ph.pht                 Generated output from h2ph.h by h2ph, for comparison
+t/lib/sample-tests/bailout             Test data for Test::Harness
+t/lib/sample-tests/combined            Test data for Test::Harness
+t/lib/sample-tests/descriptive         Test data for Test::Harness
+t/lib/sample-tests/duplicates          Test data for Test::Harness
+t/lib/sample-tests/header_at_end       Test data for Test::Harness
+t/lib/sample-tests/no_nums             Test data for Test::Harness
+t/lib/sample-tests/simple              Test data for Test::Harness
+t/lib/sample-tests/simple_fail         Test data for Test::Harness
+t/lib/sample-tests/skip                        Test data for Test::Harness
+t/lib/sample-tests/skip_all            Test data for Test::Harness
+t/lib/sample-tests/todo                        Test data for Test::Harness
+t/lib/sample-tests/with_comments       Test data for Test::Harness
+t/lib/st-dump.pl               See if Storable works
+t/op/64bitint.t                        See if 64 bit integers work
+t/op/anonsub.t                 See if anonymous subroutines work
+t/op/append.t                  See if . works
+t/op/args.t                    See if operations on @_ work
+t/op/arith.t                   See if arithmetic works
+t/op/array.t                   See if array operations work
+t/op/assignwarn.t              See if OP= operators warn correctly for undef targets
+t/op/attrs.t                   See if attributes on declarations work
+t/op/auto.t                    See if autoincrement et all work
+t/op/avhv.t                    See if pseudo-hashes work
+t/op/bless.t                   See if bless works
+t/op/bop.t                     See if bitops work
+t/op/chars.t                   See if character escapes work
+t/op/chop.t                    See if chop works
+t/op/closure.t                 See if closures work
+t/op/cmp.t                     See if the various string and numeric compare work
+t/op/concat.t                  See if string concatenation works
+t/op/cond.t                    See if conditional expressions work
+t/op/context.t                 See if context propagation works
+t/op/defins.t                  See if auto-insert of defined() works
+t/op/delete.t                  See if delete works
+t/op/die.t                     See if die works
+t/op/die_exit.t                        See if die and exit status interaction works
+t/op/do.t                      See if subroutines work
+t/op/each.t                    See if hash iterators work
+t/op/eval.t                    See if eval operator works
+t/op/exec.t                    See if exec and system work
+t/op/exists_sub.t              See if exists(&sub) works
+t/op/exp.t                     See if math functions work
+t/op/fh.t                      See if filehandles work
+t/op/filetest.t                        See if file tests work
+t/op/flip.t                    See if range operator works
+t/op/fork.t                    See if fork works
+t/op/glob.t                    See if <*> works
+t/op/gmagic.t                  See if GMAGIC works
+t/op/goto.t                    See if goto works
+t/op/goto_xs.t                 See if "goto &sub" works on XSUBs
+t/op/grent.t                   See if getgr*() functions work
+t/op/grep.t                    See if grep() and map() work
+t/op/groups.t                  See if $( works
+t/op/gv.t                      See if typeglobs work
+t/op/hashwarn.t                        See if warnings for bad hash assignments work
+t/op/inc.t                     See if inc/dec of integers near 32 bit limit work
+t/op/index.t                   See if index works
+t/op/int.t                     See if int works
+t/op/join.t                    See if join works
+t/op/length.t                  See if length works
+t/op/lex_assign.t              See if ops involving lexicals or pad temps work
+t/op/lfs.t                     See if large files work for perlio
+t/op/list.t                    See if array lists work
+t/op/local.t                   See if local works
+t/op/loopctl.t                 See if next/last/redo work
+t/op/lop.t                     See if logical operators work
+t/op/magic.t                   See if magic variables work
+t/op/method.t                  See if method calls work
+t/op/misc.t                    See if miscellaneous bugs have been fixed
+t/op/mkdir.t                   See if mkdir works
+t/op/my.t                      See if lexical scoping works
+t/op/my_stash.t                        See if my Package works
+t/op/nothr5005.t               local @_ test which does not work under use5005threads
+t/op/numconvert.t              See if accessing fields does not change numeric values
+t/op/oct.t                     See if oct and hex work
+t/op/ord.t                     See if ord works
+t/op/override.t                        See if operator overriding works
+t/op/pack.t                    See if pack and unpack work
+t/op/pat.t                     See if esoteric patterns work
+t/op/pos.t                     See if pos works
+t/op/push.t                    See if push and pop work
+t/op/pwent.t                   See if getpw*() functions work
+t/op/quotemeta.t               See if quotemeta works
+t/op/rand.t                    See if rand works
+t/op/range.t                   See if .. works
+t/op/re_tests                  Regular expressions for regexp.t
+t/op/read.t                    See if read() works
+t/op/readdir.t                 See if readdir() works
+t/op/recurse.t                 See if deep recursion works
+t/op/ref.t                     See if refs and objects work
+t/op/regexp.t                  See if regular expressions work
+t/op/regexp_noamp.t            See if regular expressions work with optimizations
+t/op/regmesg.t                 See if one can get regular expression errors
+t/op/repeat.t                  See if x operator works
+t/op/reverse.t                 See if reverse operator works
+t/op/runlevel.t                        See if die() works from perl_call_*()
+t/op/sleep.t                   See if sleep works
+t/op/sort.t                    See if sort works
+t/op/splice.t                  See if splice works
+t/op/split.t                   See if split works
+t/op/sprintf.t                 See if sprintf works
+t/op/stat.t                    See if stat works
+t/op/study.t                   See if study works
+t/op/sub_lval.t                        See if lvalue subroutines work
+t/op/subst.t                   See if substitution works
+t/op/subst_amp.t               See if $&-related substitution works
+t/op/subst_wamp.t              See if substitution works with $& present
+t/op/substr.t                  See if substr works
+t/op/sysio.t                   See if sysread and syswrite work
+t/op/taint.t                   See if tainting works
+t/op/tie.t                     See if tie/untie functions work
+t/op/tiearray.t                        See if tie for arrays works
+t/op/tiehandle.t               See if tie for handles works
+t/op/time.t                    See if time functions work
+t/op/tr.t                      See if tr works
+t/op/undef.t                   See if undef works
+t/op/universal.t               See if UNIVERSAL class works
+t/op/unshift.t                 See if unshift works
+t/op/utf8decode.t              See if UTF-8 decoding works
+t/op/vec.t                     See if vectors work
+t/op/ver.t                     See if v-strings and the %v format flag work
+t/op/wantarray.t               See if wantarray works
+t/op/write.t                   See if write works (formats work)
+t/pod/emptycmd.t               Test empty pod directives
+t/pod/emptycmd.xr              Expected results for emptycmd.t
+t/pod/find.t                   See if Pod::Find works
+t/pod/for.t                    Test =for directive
+t/pod/for.xr                   Expected results for for.t
+t/pod/headings.t               Test =head directives
+t/pod/headings.xr              Expected results for headings.t
+t/pod/include.t                        Test =include directive
+t/pod/include.xr               Expected results for include.t
+t/pod/included.t               Test =include directive
+t/pod/included.xr              Expected results for included.t
+t/pod/lref.t                   Test L<...> sequences
+t/pod/lref.xr                  Expected results for lref.t
+t/pod/multiline_items.t                Test multiline =items
 t/pod/multiline_items.xr       Test multiline =items
-t/pod/nested_items.t   Test nested =items
-t/pod/nested_items.xr  Expected results for nested_items.t
-t/pod/nested_seqs.t    Test nested interior sequences
-t/pod/nested_seqs.xr   Expected results for nested_seqs.t
-t/pod/oneline_cmds.t   Test single paragraph ==cmds
-t/pod/oneline_cmds.xr  Expected results for oneline_cmds.t
-t/pod/plainer.t                Test Pod::Plainer
-t/pod/pod2usage.t      Test Pod::Usage
-t/pod/pod2usage.xr     Expected results for pod2usage.t
-t/pod/poderrs.t                Test POD errors
-t/pod/poderrs.xr       Expected results for emptycmd.t
-t/pod/podselect.t      Test Pod::Select
-t/pod/podselect.xr     Expected results for podselect.t
-t/pod/special_seqs.t   Test "special" interior sequences
-t/pod/special_seqs.xr  Expected results for emptycmd.t
-t/pod/testcmp.pl       Module to compare output against expected results
-t/pod/testp2pt.pl      Module to test Pod::PlainText for a given file
-t/pod/testpchk.pl      Module to test Pod::Checker for a given file
-t/pod/testpods/lib/Pod/Stuff.pm        Sample data for find.t
-t/pragma/autouse.t     See if autouse works
-t/pragma/constant.t    See if compile-time constants work
-t/pragma/diagnostics.t See if diagnostics.pm works
-t/pragma/locale.t      See if locale support works
-t/pragma/locale/latin1 Part of locale.t in Latin 1
-t/pragma/locale/utf8   Part of locale.t in UTF8
-t/pragma/overload.t    See if operator overloading works
-t/pragma/strict-refs   Tests of "use strict 'refs'" for strict.t
-t/pragma/strict-subs   Tests of "use strict 'subs'" for strict.t
-t/pragma/strict-vars   Tests of "use strict 'vars'" for strict.t
-t/pragma/strict.t      See if strictures work
-t/pragma/sub_lval.t    See if lvalue subroutines work
-t/pragma/subs.t                See if subroutine pseudo-importation works
-t/pragma/utf8.t                See if utf8 operations work
-t/pragma/vars.t                See if "use vars" work
-t/pragma/warn/1global  Tests of global warnings for warnings.t
-t/pragma/warn/2use     Tests for "use warnings" for warnings.t
-t/pragma/warn/3both    Tests for interaction of $^W and "use warnings"
-t/pragma/warn/4lint    Tests for -W switch
-t/pragma/warn/5nolint  Tests for -X switch
-t/pragma/warn/6default Tests default warnings
-t/pragma/warn/7fatal   Tests fatal warnings
-t/pragma/warn/8signal  Tests warnings + __WARN__ and __DIE__
-t/pragma/warn/9enabled Tests warnings
-t/pragma/warn/av       Tests for av.c for warnings.t
-t/pragma/warn/doio     Tests for doio.c for warnings.t
-t/pragma/warn/doop     Tests for doop.c for warnings.t
-t/pragma/warn/gv       Tests for gv.c for warnings.t
-t/pragma/warn/hv       Tests for hv.c for warnings.t
-t/pragma/warn/malloc   Tests for malloc.c for warnings.t
-t/pragma/warn/mg       Tests for mg.c for warnings.t
-t/pragma/warn/op       Tests for op.c for warnings.t
-t/pragma/warn/perl     Tests for perl.c for warnings.t
-t/pragma/warn/perlio   Tests for perlio.c for warnings.t
-t/pragma/warn/perly    Tests for perly.y for warnings.t
-t/pragma/warn/pp       Tests for pp.c for warnings.t
-t/pragma/warn/pp_ctl   Tests for pp_ctl.c for warnings.t
-t/pragma/warn/pp_hot   Tests for pp_hot.c for warnings.t
-t/pragma/warn/pp_sys   Tests for pp_sys.c for warnings.t
-t/pragma/warn/regcomp  Tests for regcomp.c for warnings.t
-t/pragma/warn/regexec  Tests for regexec.c for warnings.t
-t/pragma/warn/run      Tests for run.c for warnings.t
-t/pragma/warn/sv       Tests for sv.c for warnings.t
-t/pragma/warn/taint    Tests for taint.c for warnings.t
-t/pragma/warn/toke     Tests for toke.c for warnings.t
-t/pragma/warn/universal        Tests for universal.c for warnings.t
-t/pragma/warn/utf8     Tests for utf8.c for warnings.t
-t/pragma/warn/util     Tests for util.c for warnings.t
-t/pragma/warnings.t    See if warning controls work
-t/run/runenv.t         Test if perl honors its environment variables.
-taint.c                        Tainting code
-thrdvar.h              Per-thread variables
-thread.h               Threading header
-toke.c                 The tokener
-uconfig.h              Configuration header for microperl
-uconfig.sh             Configuration script for microperl
-universal.c            The default UNIVERSAL package methods
-unixish.h              Defines that are assumed on Unix
-utf8.c                 Unicode routines
-utf8.h                 Unicode header
-utfebcdic.h            Unicode on EBCDIC (UTF-EBCDIC, tr16) header
-util.c                 Utility routines
-util.h                 Dummy header
-utils.lst              Lists utilities bundled with Perl
-utils/Makefile         Extract the utility scripts
-utils/c2ph.PL          program to translate dbx stabs to perl
-utils/dprofpp.PL       Perl code profile post-processor
-utils/h2ph.PL          A thing to turn C .h files into perl .ph files
-utils/h2xs.PL          Program to make .xs files from C header files
-utils/libnetcfg.PL     libnet
-utils/perlbug.PL       A simple tool to submit a bug report
-utils/perlcc.PL                Front-end for compiler
-utils/perldoc.PL       A simple tool to find & display perl's documentation
-utils/pl2pm.PL         A pl to pm translator
-utils/splain.PL                Stand-alone version of diagnostics.pm
-uts/strtol_wrap.c      strtol wrapper for UTS
-vmesa/Makefile         VM/ESA Makefile
-vmesa/vmesa.c          VM/ESA-specific C code for Perl core
-vmesa/vmesaish.h       VM/ESA-specific C header for Perl core
-vms/descrip_mms.template               Template MM[SK] description file for build
+t/pod/nested_items.t           Test nested =items
+t/pod/nested_items.xr          Expected results for nested_items.t
+t/pod/nested_seqs.t            Test nested interior sequences
+t/pod/nested_seqs.xr           Expected results for nested_seqs.t
+t/pod/oneline_cmds.t           Test single paragraph ==cmds
+t/pod/oneline_cmds.xr          Expected results for oneline_cmds.t
+t/pod/plainer.t                        Test Pod::Plainer
+t/pod/pod2usage.t              Test Pod::Usage
+t/pod/pod2usage.xr             Expected results for pod2usage.t
+t/pod/poderrs.t                        Test POD errors
+t/pod/poderrs.xr               Expected results for emptycmd.t
+t/pod/podselect.t              Test Pod::Select
+t/pod/podselect.xr             Expected results for podselect.t
+t/pod/special_seqs.t           Test "special" interior sequences
+t/pod/special_seqs.xr          Expected results for emptycmd.t
+t/pod/testcmp.pl               Module to compare output against expected results
+t/pod/testp2pt.pl              Module to test Pod::PlainText for a given file
+t/pod/testpchk.pl              Module to test Pod::Checker for a given file
+t/pod/testpods/lib/Pod/Stuff.pm                        Sample data for find.t
+t/run/runenv.t                 Test if perl honors its environment variables.
+taint.c                                Tainting code
+thrdvar.h                      Per-thread variables
+thread.h                       Threading header
+toke.c                         The tokener
+uconfig.h                      Configuration header for microperl
+uconfig.sh                     Configuration script for microperl
+universal.c                    The default UNIVERSAL package methods
+unixish.h                      Defines that are assumed on Unix
+utf8.c                         Unicode routines
+utf8.h                         Unicode header
+utfebcdic.h                    Unicode on EBCDIC (UTF-EBCDIC, tr16) header
+util.c                         Utility routines
+util.h                         Dummy header
+utils.lst                      Lists utilities bundled with Perl
+utils/Makefile                 Extract the utility scripts
+utils/c2ph.PL                  program to translate dbx stabs to perl
+utils/dprofpp.PL               Perl code profile post-processor
+utils/h2ph.PL                  A thing to turn C .h files into perl .ph files
+utils/h2xs.PL                  Program to make .xs files from C header files
+utils/libnetcfg.PL             libnet
+utils/perlbug.PL               A simple tool to submit a bug report
+utils/perlcc.PL                        Front-end for compiler
+utils/perldoc.PL               A simple tool to find & display perl's documentation
+utils/pl2pm.PL                 A pl to pm translator
+utils/splain.PL                        Stand-alone version of diagnostics.pm
+uts/strtol_wrap.c              strtol wrapper for UTS
+vmesa/Makefile                 VM/ESA Makefile
+vmesa/vmesa.c                  VM/ESA-specific C code for Perl core
+vmesa/vmesaish.h               VM/ESA-specific C header for Perl core
+vms/descrip_mms.template       Template MM[SK] description file for build
 vms/ext/DCLsym/0README.txt     ReadMe file for VMS::DCLsym
 vms/ext/DCLsym/DCLsym.pm       Perl access to CLI symbols
 vms/ext/DCLsym/DCLsym.xs       Perl access to CLI symbols
 vms/ext/DCLsym/Makefile.PL     MakeMaker driver for VMS::DCLsym
-vms/ext/DCLsym/test.pl regression tests for VMS::DCLsym
-vms/ext/Filespec.pm    VMS-Unix file syntax interconversion
+vms/ext/DCLsym/test.pl         regression tests for VMS::DCLsym
+vms/ext/Filespec.pm            VMS-Unix file syntax interconversion
 vms/ext/Stdio/0README.txt      ReadMe file for VMS::Stdio
 vms/ext/Stdio/Makefile.PL      MakeMaker driver for VMS::Stdio
-vms/ext/Stdio/Stdio.pm VMS options to stdio routines
-vms/ext/Stdio/Stdio.xs VMS options to stdio routines
-vms/ext/Stdio/test.pl  regression tests for VMS::Stdio
-vms/ext/XSSymSet.pm    manage linker symbols when building extensions
-vms/ext/filespec.t     See if VMS::Filespec funtions work
-vms/ext/vmsish.pm      Control VMS-specific behavior of Perl core
-vms/ext/vmsish.t       Tests for vmsish.pm
-vms/gen_shrfls.pl      generate options files and glue for shareable image
-vms/genconfig.pl       retcon config.sh from config.h
-vms/genopt.com         hack to write options files in case of broken makes
-vms/make_command.com   record MM[SK] command used to build Perl
-vms/mms2make.pl                convert descrip.mms to make syntax
-vms/munchconfig.c      performs shell $var substitution for VMS
-vms/myconfig.com       record local configuration info for bug report
-vms/perlvms.pod                VMS-specific additions to Perl documentation
-vms/perly_c.vms                perly.c with fixed declarations for global syms
-vms/perly_h.vms                perly.h with fixed declarations for global syms
-vms/sockadapt.c                glue for SockshShr socket support
-vms/sockadapt.h                glue for SockshShr socket support
-vms/test.com           DCL driver for regression tests
-vms/vms.c              VMS-specific C code for Perl core
-vms/vms_yfix.pl                convert Unix perly.[ch] to VMS perly_[ch].vms
-vms/vmsish.h           VMS-specific C header for Perl core
-vms/vmspipe.com                VMS-specific piped command helper script
-vms/writemain.pl       Generate perlmain.c from miniperlmain.c+extensions
-vos/Changes            Changes made to port Perl to the VOS operating system
-vos/build.cm           VOS command macro to build Perl
-vos/compile_perl.cm    VOS command macro to build multiple version of Perl
-vos/config.alpha.def   definitions used by config.pl
-vos/config.alpha.h     config.h for use with alpha VOS POSIX.1 support
-vos/config.ga.def      definitions used by config.pl
-vos/config.ga.h                config.h for use with generally-available VOS POSIX.1 support
-vos/config.pl          script to convert a config_h.SH to a config.h
-vos/configure_perl.cm  VOS command macro to configure perl before building
-vos/install_perl.cm    VOS command macro to install perl after building
-vos/perl.bind          VOS bind control file
-vos/test_vos_dummies.c Test program for "vos_dummies.c"
-vos/vos_dummies.c      Wrappers to soak up undefined functions
-vos/vosish.h           VOS-specific header file
-warnings.h             The warning numbers
-warnings.pl            Program to write warnings.h and lib/warnings.pm
-win32/FindExt.pm       Scan for extensions
-win32/Makefile         Win32 makefile for NMAKE (Visual C++ build)
-win32/bin/exetype.pl   Set executable type to CONSOLE or WINDOWS
-win32/bin/mdelete.bat  multifile delete
-win32/bin/perlglob.pl  Win32 globbing
-win32/bin/pl2bat.pl    wrap perl scripts into batch files
-win32/bin/runperl.pl   run perl script via batch file namesake
-win32/bin/search.pl    Win32 port
-win32/buildext.pl      Build extensions once miniperl is built
-win32/config.bc                Win32 base line config.sh (Borland C++ build)
-win32/config.gc                Win32 base line config.sh (mingw32/gcc build)
-win32/config.vc                Win32 base line config.sh (Visual C++ build)
-win32/config_H.bc      Win32 config header (Borland C++ build)
-win32/config_H.gc      Win32 config header (GNU build)?
-win32/config_H.vc      Win32 config header (Visual C++ build)
-win32/config_h.PL      Perl code to convert Win32 config.sh to config.h
-win32/config_sh.PL     Perl code to update Win32 config.sh from Makefile
-win32/des_fcrypt.patch Win32 port
-win32/distclean.bat    Remove _ALL_ files not listed here in MANIFEST
-win32/dl_win32.xs      Win32 port
-win32/genmk95.pl        Perl code to generate command.com-usable makefile.95
+vms/ext/Stdio/Stdio.pm         VMS options to stdio routines
+vms/ext/Stdio/Stdio.xs         VMS options to stdio routines
+vms/ext/Stdio/test.pl          regression tests for VMS::Stdio
+vms/ext/XSSymSet.pm            manage linker symbols when building extensions
+vms/ext/filespec.t             See if VMS::Filespec funtions work
+vms/ext/vmsish.pm              Control VMS-specific behavior of Perl core
+vms/ext/vmsish.t               Tests for vmsish.pm
+vms/gen_shrfls.pl              generate options files and glue for shareable image
+vms/genconfig.pl               retcon config.sh from config.h
+vms/genopt.com                 hack to write options files in case of broken makes
+vms/make_command.com           record MM[SK] command used to build Perl
+vms/mms2make.pl                        convert descrip.mms to make syntax
+vms/munchconfig.c              performs shell $var substitution for VMS
+vms/myconfig.com               record local configuration info for bug report
+vms/perlvms.pod                        VMS-specific additions to Perl documentation
+vms/perly_c.vms                        perly.c with fixed declarations for global syms
+vms/perly_h.vms                        perly.h with fixed declarations for global syms
+vms/sockadapt.c                        glue for SockshShr socket support
+vms/sockadapt.h                        glue for SockshShr socket support
+vms/test.com                   DCL driver for regression tests
+vms/vms.c                      VMS-specific C code for Perl core
+vms/vms_yfix.pl                        convert Unix perly.[ch] to VMS perly_[ch].vms
+vms/vmsish.h                   VMS-specific C header for Perl core
+vms/vmspipe.com                        VMS-specific piped command helper script
+vms/writemain.pl               Generate perlmain.c from miniperlmain.c+extensions
+vos/Changes                    Changes made to port Perl to the VOS operating system
+vos/build.cm                   VOS command macro to build Perl
+vos/compile_perl.cm            VOS command macro to build multiple version of Perl
+vos/config.alpha.def           definitions used by config.pl
+vos/config.alpha.h             config.h for use with alpha VOS POSIX.1 support
+vos/config.ga.def              definitions used by config.pl
+vos/config.ga.h                        config.h for use with generally-available VOS POSIX.1 support
+vos/config.pl                  script to convert a config_h.SH to a config.h
+vos/configure_perl.cm          VOS command macro to configure perl before building
+vos/install_perl.cm            VOS command macro to install perl after building
+vos/perl.bind                  VOS bind control file
+vos/test_vos_dummies.c         Test program for "vos_dummies.c"
+vos/vos_dummies.c              Wrappers to soak up undefined functions
+vos/vosish.h                   VOS-specific header file
+warnings.h                     The warning numbers
+warnings.pl                    Program to write warnings.h and lib/warnings.pm
+win32/FindExt.pm               Scan for extensions
+win32/Makefile                 Win32 makefile for NMAKE (Visual C++ build)
+win32/bin/exetype.pl           Set executable type to CONSOLE or WINDOWS
+win32/bin/mdelete.bat          multifile delete
+win32/bin/perlglob.pl          Win32 globbing
+win32/bin/pl2bat.pl            wrap perl scripts into batch files
+win32/bin/runperl.pl           run perl script via batch file namesake
+win32/bin/search.pl            Win32 port
+win32/buildext.pl              Build extensions once miniperl is built
+win32/config.bc                        Win32 base line config.sh (Borland C++ build)
+win32/config.gc                        Win32 base line config.sh (mingw32/gcc build)
+win32/config.vc                        Win32 base line config.sh (Visual C++ build)
+win32/config_H.bc              Win32 config header (Borland C++ build)
+win32/config_H.gc              Win32 config header (GNU build)?
+win32/config_H.vc              Win32 config header (Visual C++ build)
+win32/config_h.PL              Perl code to convert Win32 config.sh to config.h
+win32/config_sh.PL             Perl code to update Win32 config.sh from Makefile
+win32/des_fcrypt.patch         Win32 port
+win32/distclean.bat            Remove _ALL_ files not listed here in MANIFEST
+win32/dl_win32.xs              Win32 port
+win32/genmk95.pl               Perl code to generate command.com-usable makefile.95
 win32/include/arpa/inet.h      Win32 port
 win32/include/dirent.h         Win32 port
 win32/include/netdb.h          Win32 port
 win32/include/sys/socket.h     Win32 port
-win32/makefile.mk       Win32 makefile for DMAKE (BC++, VC++ builds)
-win32/perlglob.c       Win32 port
-win32/perlhost.h       Perl "host" implementation
-win32/perllib.c                Win32 port
-win32/pod.mak          Win32 port
-win32/runperl.c                Win32 port
-win32/sncfnmcs.pl      Win32 port
-win32/splittree.pl     Win32 port
-win32/vdir.h           Perl "host" virtual directory manager
-win32/vmem.h           Perl "host" memory manager
-win32/win32.c          Win32 port
-win32/win32.h          Win32 port
-win32/win32io.c                Win32 PerlIO layer support
-win32/win32iop.h       Win32 port
-win32/win32sck.c       Win32 port
-win32/win32thread.c    Win32 functions for threads
-win32/win32thread.h    Win32 port mapping to threads
-writemain.SH           Generate perlmain.c from miniperlmain.c+extensions
-x2p/EXTERN.h           Same as above
-x2p/INTERN.h           Same as above
-x2p/Makefile.SH                Precursor to Makefile
-x2p/a2p.c              Output of a2p.y run through byacc
-x2p/a2p.h              Global declarations
-x2p/a2p.pod            Pod for awk to perl translator
-x2p/a2p.y              A yacc grammer for awk
-x2p/a2py.c             Awk compiler, sort of
-x2p/cflags.SH          A script that emits C compilation flags per file
-x2p/find2perl.PL       A find to perl translator
-x2p/hash.c             Hashes again
-x2p/hash.h             Public declarations for the above
-x2p/proto.h            Dummy header
-x2p/s2p.PL             Sed to perl translator
-x2p/str.c              String handling package
-x2p/str.h              Public declarations for the above
-x2p/util.c             Utility routines
-x2p/util.h             Public declarations for the above
-x2p/walk.c             Parse tree walker
-xsutils.c              Additional bundled package methods not in UNIVERSAL::
+win32/makefile.mk              Win32 makefile for DMAKE (BC++, VC++ builds)
+win32/perlglob.c               Win32 port
+win32/perlhost.h               Perl "host" implementation
+win32/perllib.c                        Win32 port
+win32/pod.mak                  Win32 port
+win32/runperl.c                        Win32 port
+win32/sncfnmcs.pl              Win32 port
+win32/splittree.pl             Win32 port
+win32/vdir.h                   Perl "host" virtual directory manager
+win32/vmem.h                   Perl "host" memory manager
+win32/win32.c                  Win32 port
+win32/win32.h                  Win32 port
+win32/win32io.c                        Win32 PerlIO layer support
+win32/win32iop.h               Win32 port
+win32/win32sck.c               Win32 port
+win32/win32thread.c            Win32 functions for threads
+win32/win32thread.h            Win32 port mapping to threads
+writemain.SH                   Generate perlmain.c from miniperlmain.c+extensions
+x2p/EXTERN.h                   Same as above
+x2p/INTERN.h                   Same as above
+x2p/Makefile.SH                        Precursor to Makefile
+x2p/a2p.c                      Output of a2p.y run through byacc
+x2p/a2p.h                      Global declarations
+x2p/a2p.pod                    Pod for awk to perl translator
+x2p/a2p.y                      A yacc grammer for awk
+x2p/a2py.c                     Awk compiler, sort of
+x2p/cflags.SH                  A script that emits C compilation flags per file
+x2p/find2perl.PL               A find to perl translator
+x2p/hash.c                     Hashes again
+x2p/hash.h                     Public declarations for the above
+x2p/proto.h                    Dummy header
+x2p/s2p.PL                     Sed to perl translator
+x2p/str.c                      String handling package
+x2p/str.h                      Public declarations for the above
+x2p/util.c                     Utility routines
+x2p/util.h                     Public declarations for the above
+x2p/walk.c                     Parse tree walker
+xsutils.c                      Additional bundled package methods not in UNIVERSAL::

diff --git a/ext/B/B.t b/ext/B/B.t
new file mode 100755 (executable)
index 0000000..f21f489
--- /dev/null
+++ b/ext/B/B.t
@@ -0,0 +1,63 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') {
+       @INC = qw(: ::lib ::macos:lib);
+    } else {
+       @INC = '.';
+       push @INC, '../lib';
+    }
+}
+
+$|  = 1;
+use warnings;
+use strict;
+use Config;
+
+print "1..2\n";
+
+my $test = 1;
+
+sub ok { print "ok $test\n"; $test++ }
+
+use B;
+
+
+package Testing::Symtable;
+use vars qw($This @That %wibble $moo %moo);
+my $not_a_sym = 'moo';
+
+sub moo { 42 }
+sub car { 23 }
+
+
+package Testing::Symtable::Foo;
+sub yarrow { "Hock" }
+
+package Testing::Symtable::Bar;
+sub hock { "yarrow" }
+
+package main;
+use vars qw(%Subs);
+local %Subs = ();
+B::walksymtable(\%Testing::Symtable::, 'find_syms', sub { $_[0] =~ /Foo/ },
+                'Testing::Symtable::');
+
+sub B::GV::find_syms {
+    my($symbol) = @_;
+
+    $main::Subs{$symbol->STASH->NAME . '::' . $symbol->NAME}++;
+}
+
+my @syms = map { 'Testing::Symtable::'.$_ } qw(This That wibble moo car
+                                               BEGIN);
+push @syms, "Testing::Symtable::Foo::yarrow";
+
+# Make sure we hit all the expected symbols.
+print "not " unless join('', sort @syms) eq join('', sort keys %Subs);
+ok;
+
+# Make sure we only hit them each once.
+print "not " unless !grep $_ != 1, values %Subs;
+ok;

diff --git a/ext/B/Debug.t b/ext/B/Debug.t
new file mode 100644 (file)
index 0000000..286dac3
--- /dev/null
+++ b/ext/B/Debug.t
@@ -0,0 +1,70 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') {
+       @INC = qw(: ::lib ::macos:lib);
+    } else {
+       @INC = '.';
+       push @INC, '../lib';
+    }
+}
+
+$|  = 1;
+use warnings;
+use strict;
+use Config;
+
+print "1..3\n";
+
+my $test = 1;
+
+sub ok { print "ok $test\n"; $test++ }
+
+
+my $a;
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MacOS = $^O eq 'MacOS';
+
+my $path = join " ", map { qq["-I$_"] } @INC;
+my $redir = $Is_MacOS ? "" : "2>&1";
+
+$a = `$^X $path "-MO=Debug" -e 1 $redir`;
+print "not " unless $a =~
+/\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
+ok;
+
+
+$a = `$^X $path "-MO=Terse" -e 1 $redir`;
+print "not " unless $a =~
+/\bLISTOP\b.*leave.*\n    OP\b.*enter.*\n    COP\b.*nextstate.*\n    OP\b.*null/s;
+ok;
+
+$a = `$^X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
+$a =~ s/\(0x[^)]+\)//g;
+$a =~ s/\[[^\]]+\]//g;
+$a =~ s/-e syntax OK//;
+$a =~ s/[^a-z ]+//g;
+$a =~ s/\s+/ /g;
+$a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
+$a =~ s/^\s+//;
+$a =~ s/\s+$//;
+my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
+if ($is_thread) {
+    $b=<<EOF;
+leave enter nextstate label leaveloop enterloop null and defined null
+threadsv readline gv lineseq nextstate aassign null pushmark split pushre
+threadsv const null pushmark rvav gv nextstate subst const unstack nextstate
+EOF
+} else {
+    $b=<<EOF;
+leave enter nextstate label leaveloop enterloop null and defined null
+null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
+null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate
+EOF
+}
+$b=~s/\n/ /g;$b=~s/\s+/ /g;
+$b =~ s/\s+$//;
+print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
+ok;
+

diff --git a/ext/B/Deparse.t b/ext/B/Deparse.t
new file mode 100644 (file)
index 0000000..048ce31
--- /dev/null
+++ b/ext/B/Deparse.t
@@ -0,0 +1,176 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') {
+       @INC = qw(: ::lib ::macos:lib);
+    } else {
+       @INC = '.';
+       push @INC, '../lib';
+    }
+}
+
+$|  = 1;
+use warnings;
+use strict;
+use Config;
+
+print "1..14\n";
+
+use B::Deparse;
+my $deparse = B::Deparse->new() or print "not ";
+my $i=1;
+print "ok ", $i++, "\n";
+
+
+# Tell B::Deparse about our ambient pragmas
+{ my ($hint_bits, $warning_bits);
+ BEGIN {($hint_bits, $warning_bits) = ($^H, ${^WARNING_BITS})}
+ $deparse->ambient_pragmas (
+     hint_bits    => $hint_bits,
+     warning_bits => $warning_bits,
+     '$['         => 0 + $[
+ );
+}
+
+$/ = "\n####\n";
+while (<DATA>) {
+    chomp;
+    s/#.*$//mg;
+
+    my ($input, $expected);
+    if (/(.*)\n>>>>\n(.*)/s) {
+       ($input, $expected) = ($1, $2);
+    }
+    else {
+       ($input, $expected) = ($_, $_);
+    }
+
+    my $coderef = eval "sub {$input}";
+
+    if ($@) {
+       print "not ok ", $i++, "\n";
+       print "# $@";
+    }
+    else {
+       my $deparsed = $deparse->coderef2text( $coderef );
+       my $regex = quotemeta($expected);
+       do {
+           no warnings 'misc';
+           $regex =~ s/\s+/\s+/g;
+       };
+
+       my $ok = ($deparsed =~ /^\{\s*$regex\s*\}$/);
+       print ($ok ? "ok " : "not ok ");
+       print $i++, "\n";
+       if (!$ok) {
+           print "# EXPECTED:\n";
+           $regex =~ s/^/# /mg;
+           print "$regex\n";
+
+           print "\n# GOT: \n";
+           $deparsed =~ s/^/# /mg;
+           print "$deparsed\n";
+       }
+    }
+}
+
+use constant 'c', 'stuff';
+print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
+print "ok ", $i++, "\n";
+
+$a = 0;
+print "not " if "{\n    (-1) ** \$a;\n}"
+               ne $deparse->coderef2text(sub{(-1) ** $a });
+print "ok ", $i++, "\n";
+
+# XXX ToDo - constsub that returns a reference
+#use constant cr => ['hello'];
+#my $string = "sub " . $deparse->coderef2text(\&cr);
+#my $val = (eval $string)->();
+#print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello';
+#print "ok ", $i++, "\n";
+
+my $a;
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MacOS = $^O eq 'MacOS';
+
+my $path = join " ", map { qq["-I$_"] } @INC;
+my $redir = $Is_MacOS ? "" : "2>&1";
+
+$a = `$^X $path "-MO=Deparse" -anle 1 $redir`;
+$a =~ s/-e syntax OK\n//g;
+$a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
+$a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
+$b = <<'EOF';
+
+LINE: while (defined($_ = <ARGV>)) {
+    chomp $_;
+    @F = split(" ", $_, 0);
+    '???';
+}
+
+EOF
+print "# [$a]\n\# vs expected\n# [$b]\nnot " if $a ne $b;
+print "ok ", $i++, "\n";
+
+__DATA__
+# 1
+1;
+####
+# 2
+{
+    no warnings;
+    '???';
+    2;
+}
+####
+# 3
+my $test;
+++$test and $test /= 2;
+>>>>
+my $test;
+$test /= 2 if ++$test;
+####
+# 4
+-((1, 2) x 2);
+####
+# 5
+{
+    my $test = sub : lvalue {
+       my $x;
+    }
+    ;
+}
+####
+# 6
+{
+    my $test = sub : method {
+       my $x;
+    }
+    ;
+}
+####
+# 7
+{
+    my $test = sub : locked method {
+       my $x;
+    }
+    ;
+}
+####
+# 8
+{
+    234;
+}
+continue {
+    123;
+}
+####
+# 9
+my $x;
+print $main::x;
+####
+# 10
+my @x;
+print $main::x[1];

diff --git a/ext/B/Showlex.t b/ext/B/Showlex.t
new file mode 100644 (file)
index 0000000..a21f03b
--- /dev/null
+++ b/ext/B/Showlex.t
@@ -0,0 +1,39 @@
+#!./perl
+
+BEGIN {
+    if ($^O eq 'MacOS') {
+       @INC = qw(: ::lib ::macos:lib);
+    }
+}
+
+$|  = 1;
+use warnings;
+use strict;
+use Config;
+
+print "1..1\n";
+
+my $test = 1;
+
+sub ok { print "ok $test\n"; $test++ }
+
+my $a;
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MacOS = $^O eq 'MacOS';
+
+my $path = join " ", map { qq["-I$_"] } @INC;
+my $redir = $Is_MacOS ? "" : "2>&1";
+my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
+
+if ($is_thread) {
+    print "# use5005threads: test $test skipped\n";
+} else {
+    $a = `$^X $path "-MO=Showlex" -e "my %one" $redir`;
+    if (ord('A') != 193) { # ASCIIish
+        print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
+    }
+    else { # EBCDICish C<1: PVNV (0x1a7ede34) "%\226\225\205">
+        print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%\\[0-9].*sv_undef.*HV/s;
+    }
+}
+ok;

diff --git a/ext/B/Stash.t b/ext/B/Stash.t
new file mode 100644 (file)
index 0000000..bc9d896
--- /dev/null
+++ b/ext/B/Stash.t
@@ -0,0 +1,60 @@
+#!./perl
+
+BEGIN {
+    if ($^O eq 'MacOS') {
+       @INC = qw(: ::lib ::macos:lib);
+    }
+}
+
+$|  = 1;
+use warnings;
+use strict;
+use Config;
+
+print "1..1\n";
+
+my $test = 1;
+
+sub ok { print "ok $test\n"; $test++ }
+
+
+my $a;
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MacOS = $^O eq 'MacOS';
+
+my $path = join " ", map { qq["-I$_"] } @INC;
+my $redir = $Is_MacOS ? "" : "2>&1";
+
+
+chomp($a = `$^X $path "-MB::Stash" "-Mwarnings" -e1`);
+$a = join ',', sort split /,/, $a;
+$a =~ s/-u(PerlIO|open)(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define';
+$a =~ s/-uWin32,// if $^O eq 'MSWin32';
+$a =~ s/-uNetWare,// if $^O eq 'NetWare';
+$a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
+$a =~ s/-uCwd,// if $^O eq 'cygwin';
+  $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
+     . '-umain,-ustrict,-uutf8,-uwarnings';
+if ($Is_VMS) {
+    $a =~ s/-uFile,-uFile::Copy,//;
+    $a =~ s/-uVMS,-uVMS::Filespec,//;
+    $a =~ s/-uSocket,//; # Socket is optional/compiler version dependent
+}
+
+{
+    no strict 'vars';
+    use vars '$OS2::is_aout';
+}
+if (($Config{static_ext} eq ' ' ||
+     ($Config{static_ext} eq 'Socket' && $Is_VMS))
+    && !($^O eq 'os2' and $OS2::is_aout)
+       ) {
+    if (ord('A') == 193) { # EBCDIC sort order is qw(a A) not qw(A a)
+       $b = join ',', sort split /,/, $b;
+    }
+    print "# [$a]\n# vs.\n# [$b]\nnot " if $a ne $b;
+    ok;
+} else {
+    print "ok $test # skipped: one or more static extensions\n"; $test++;
+}
+

diff --git a/ext/Cwd/Cwd.t b/ext/Cwd/Cwd.t
new file mode 100644 (file)
index 0000000..09b45d6
--- /dev/null
+++ b/ext/Cwd/Cwd.t
@@ -0,0 +1,134 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Config;
+use Cwd;
+use strict;
+use warnings;
+
+print "1..14\n";
+
+# check imports
+print +(defined(&cwd) && 
+       defined(&getcwd) &&
+       defined(&fastcwd) &&
+       defined(&fastgetcwd) ?
+        "" : "not "), "ok 1\n";
+print +(!defined(&chdir) &&
+       !defined(&abs_path) &&
+       !defined(&fast_abs_path) ?
+       "" : "not "), "ok 2\n";
+
+# XXX force Cwd to bootsrap its XSUBs since we have set @INC = "../lib"
+# XXX and subsequent chdir()s can make them impossible to find
+eval { fastcwd };
+
+# Must find an external pwd (or equivalent) command.
+
+my $pwd_cmd =
+    ($^O eq "MSWin32" || $^O eq "NetWare") ? "cd" : (grep { -x && -f } map { "$_/pwd" }
+                              split m/$Config{path_sep}/, $ENV{PATH})[0];
+
+if ($^O eq 'VMS') { $pwd_cmd = 'SHOW DEFAULT'; }
+
+if (defined $pwd_cmd) {
+    chomp(my $start = `$pwd_cmd`);
+    # Win32's cd returns native C:\ style
+    $start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
+    # DCL SHOW DEFAULT has leading spaces
+    $start =~ s/^\s+// if $^O eq 'VMS';
+    if ($?) {
+       for (3..6) {
+           print "ok $_ # Skip: '$pwd_cmd' failed\n";
+       }
+    } else {
+       my $cwd        = cwd;
+       my $getcwd     = getcwd;
+       my $fastcwd    = fastcwd;
+       my $fastgetcwd = fastgetcwd;
+       print +($cwd        eq $start ? "" : "not "), "ok 3\n";
+       print +($getcwd     eq $start ? "" : "not "), "ok 4\n";
+       print +($fastcwd    eq $start ? "" : "not "), "ok 5\n";
+       print +($fastgetcwd eq $start ? "" : "not "), "ok 6\n";
+    }
+} else {
+    for (3..6) {
+       print "ok $_ # Skip: no pwd command found\n";
+    }
+}
+
+mkdir "pteerslt", 0777;
+mkdir "pteerslt/path", 0777;
+mkdir "pteerslt/path/to", 0777;
+mkdir "pteerslt/path/to/a", 0777;
+mkdir "pteerslt/path/to/a/dir", 0777;
+Cwd::chdir "pteerslt/path/to/a/dir";
+my $cwd        = cwd;
+my $getcwd     = getcwd;
+my $fastcwd    = fastcwd;
+my $fastgetcwd = fastgetcwd;
+my $want = "t/pteerslt/path/to/a/dir";
+print "# cwd        = '$cwd'\n";
+print "# getcwd     = '$getcwd'\n";
+print "# fastcwd    = '$fastcwd'\n";
+print "# fastgetcwd = '$fastgetcwd'\n";
+# This checked out OK on ODS-2 and ODS-5:
+$want = "T\.PTEERSLT\.PATH\.TO\.A\.DIR\]" if $^O eq 'VMS';
+print +($cwd        =~ m|$want$| ? "" : "not "), "ok 7\n";
+print +($getcwd     =~ m|$want$| ? "" : "not "), "ok 8\n";
+print +($fastcwd    =~ m|$want$| ? "" : "not "), "ok 9\n";
+print +($fastgetcwd =~ m|$want$| ? "" : "not "), "ok 10\n";
+
+# Cwd::chdir should also update $ENV{PWD}
+print "#$ENV{PWD}\n";
+print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n";
+Cwd::chdir ".."; rmdir "dir";
+print "#$ENV{PWD}\n";
+Cwd::chdir ".."; rmdir "a";
+print "#$ENV{PWD}\n";
+Cwd::chdir ".."; rmdir "to";
+print "#$ENV{PWD}\n";
+Cwd::chdir ".."; rmdir "path";
+print "#$ENV{PWD}\n";
+Cwd::chdir ".."; rmdir "pteerslt";
+print "#$ENV{PWD}\n";
+if ($^O eq 'VMS') {
+    # This checked out OK on ODS-2 and ODS-5:
+    print +($ENV{PWD}  =~ m|\bT\]$| ? "" : "not "), "ok 12\n";
+}
+else {
+    print +($ENV{PWD}  =~ m|\bt$| ? "" : "not "), "ok 12\n";
+}
+
+if ($Config{d_symlink}) {
+    mkdir "pteerslt", 0777;
+    mkdir "pteerslt/path", 0777;
+    mkdir "pteerslt/path/to", 0777;
+    mkdir "pteerslt/path/to/a", 0777;
+    mkdir "pteerslt/path/to/a/dir", 0777;
+    symlink "pteerslt/path/to/a/dir" => "linktest";
+
+    my $abs_path      =  Cwd::abs_path("linktest");
+    my $fast_abs_path =  Cwd::fast_abs_path("linktest");
+    my $want          = "t/pteerslt/path/to/a/dir";
+
+    print "# abs_path      $abs_path\n";
+    print "# fast_abs_path $fast_abs_path\n";
+    print "# want          $want\n";
+    print +($abs_path      =~ m|$want$| ? "" : "not "), "ok 13\n";
+    print +($fast_abs_path =~ m|$want$| ? "" : "not "), "ok 14\n";
+
+    rmdir "pteerslt/path/to/a/dir";
+    rmdir "pteerslt/path/to/a";
+    rmdir "pteerslt/path/to";
+    rmdir "pteerslt/path";
+    rmdir "pteerslt";
+    unlink "linktest";
+} else {
+    print "ok 13 # skipped\n";
+    print "ok 14 # skipped\n";
+}

diff --git a/ext/DB_File/t/db-btree.t b/ext/DB_File/t/db-btree.t
new file mode 100755 (executable)
index 0000000..4b4a796
--- /dev/null
+++ b/ext/DB_File/t/db-btree.t
@@ -0,0 +1,1296 @@
+#!./perl -w
+
+BEGIN {
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDB_File\b/) {
+       print "1..0 # Skip: DB_File was not built\n";
+       exit 0;
+    }
+}
+
+use warnings;
+use strict;
+use DB_File; 
+use Fcntl;
+
+print "1..157\n";
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+ 
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+sub lexical
+{
+    my(@a) = unpack ("C*", $a) ;
+    my(@b) = unpack ("C*", $b) ;
+
+    my $len = (@a > @b ? @b : @a) ;
+    my $i = 0 ;
+
+    foreach $i ( 0 .. $len -1) {
+        return $a[$i] - $b[$i] if $a[$i] != $b[$i] ;
+    }
+
+    return @a - @b ;
+}
+
+{
+    package Redirect ;
+    use Symbol ;
+
+    sub new
+    {
+        my $class = shift ;
+        my $filename = shift ;
+       my $fh = gensym ;
+       open ($fh, ">$filename") || die "Cannot open $filename: $!" ;
+       my $real_stdout = select($fh) ;
+       return bless [$fh, $real_stdout ] ;
+
+    }
+    sub DESTROY
+    {
+        my $self = shift ;
+       close $self->[0] ;
+       select($self->[1]) ;
+    }
+}
+
+sub docat
+{ 
+    my $file = shift;
+    #local $/ = undef unless wantarray ;
+    open(CAT,$file) || die "Cannot open $file: $!";
+    my @result = <CAT>;
+    close(CAT);
+    wantarray ? @result : join("", @result) ;
+}   
+
+sub docat_del
+{ 
+    my $file = shift;
+    #local $/ = undef unless wantarray ;
+    open(CAT,$file) || die "Cannot open $file: $!";
+    my @result = <CAT>;
+    close(CAT);
+    unlink $file ;
+    wantarray ? @result : join("", @result) ;
+}   
+
+
+my $db185mode =  ($DB_File::db_version == 1 && ! $DB_File::db_185_compat) ;
+my $null_keys_allowed = ($DB_File::db_ver < 2.004010 
+                               || $DB_File::db_ver >= 3.1 );
+
+my $Dfile = "dbbtree.tmp";
+unlink $Dfile;
+
+umask(0);
+
+# Check the interface to BTREEINFO
+
+my $dbh = new DB_File::BTREEINFO ;
+ok(1, ! defined $dbh->{flags}) ;
+ok(2, ! defined $dbh->{cachesize}) ;
+ok(3, ! defined $dbh->{psize}) ;
+ok(4, ! defined $dbh->{lorder}) ;
+ok(5, ! defined $dbh->{minkeypage}) ;
+ok(6, ! defined $dbh->{maxkeypage}) ;
+ok(7, ! defined $dbh->{compare}) ;
+ok(8, ! defined $dbh->{prefix}) ;
+
+$dbh->{flags} = 3000 ;
+ok(9, $dbh->{flags} == 3000) ;
+
+$dbh->{cachesize} = 9000 ;
+ok(10, $dbh->{cachesize} == 9000);
+
+$dbh->{psize} = 400 ;
+ok(11, $dbh->{psize} == 400) ;
+
+$dbh->{lorder} = 65 ;
+ok(12, $dbh->{lorder} == 65) ;
+
+$dbh->{minkeypage} = 123 ;
+ok(13, $dbh->{minkeypage} == 123) ;
+
+$dbh->{maxkeypage} = 1234 ;
+ok(14, $dbh->{maxkeypage} == 1234 );
+
+$dbh->{compare} = 1234 ;
+ok(15, $dbh->{compare} == 1234) ;
+
+$dbh->{prefix} = 1234 ;
+ok(16, $dbh->{prefix} == 1234 );
+
+# Check that an invalid entry is caught both for store & fetch
+eval '$dbh->{fred} = 1234' ;
+ok(17, $@ =~ /^DB_File::BTREEINFO::STORE - Unknown element 'fred' at/ ) ;
+eval 'my $q = $dbh->{fred}' ;
+ok(18, $@ =~ /^DB_File::BTREEINFO::FETCH - Unknown element 'fred' at/ ) ;
+
+# Now check the interface to BTREE
+
+my ($X, %h) ;
+ok(19, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ;
+
+my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+ok(20, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare');
+
+my ($key, $value, $i);
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+ok(21, !$i ) ;
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+ok(22, $h{'abc'} eq 'ABC' );
+ok(23, ! defined $h{'jimmy'} ) ;
+ok(24, ! exists $h{'jimmy'} ) ;
+ok(25,  defined $h{'abc'} ) ;
+
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+
+#$h{'b'} = 'B';
+$X->STORE('b', 'B') ;
+
+$h{'c'} = 'C';
+
+#$h{'d'} = 'D';
+$X->put('d', 'D') ;
+
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'X';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+
+# IMPORTANT - $X must be undefined before the untie otherwise the
+#             underlying DB close routine will not get called.
+undef $X ;
+untie(%h);
+
+# tie to the same file again
+ok(26, $X = tie(%h,'DB_File',$Dfile, O_RDWR, 0640, $DB_BTREE)) ;
+
+# Modify an entry from the previous tie
+$h{'g'} = 'G';
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+$X->DELETE('goner3');
+
+my @keys = keys(%h);
+my @values = values(%h);
+
+ok(27, $#keys == 29 && $#values == 29) ;
+
+$i = 0 ;
+while (($key,$value) = each(%h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+       $key =~ y/a-z/A-Z/;
+       $i++ if $key eq $value;
+    }
+}
+
+ok(28, $i == 30) ;
+
+@keys = ('blurfl', keys(%h), 'dyick');
+ok(29, $#keys == 31) ;
+
+#Check that the keys can be retrieved in order
+my @b = keys %h ;
+my @c = sort lexical @b ;
+ok(30, ArrayCompare(\@b, \@c)) ;
+
+$h{'foo'} = '';
+ok(31, $h{'foo'} eq '' ) ;
+
+# Berkeley DB from version 2.4.10 to 3.0 does not allow null keys.
+# This feature was reenabled in version 3.1 of Berkeley DB.
+my $result = 0 ;
+if ($null_keys_allowed) {
+    $h{''} = 'bar';
+    $result = ( $h{''} eq 'bar' );
+}
+else
+  { $result = 1 }
+ok(32, $result) ;
+
+# check cache overflow and numeric keys and contents
+my $ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+ok(33, $ok);
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+ok(34, $size > 0 );
+
+@h{0..200} = 200..400;
+my @foo = @h{0..200};
+ok(35, join(':',200..400) eq join(':',@foo) );
+
+# Now check all the non-tie specific stuff
+
+
+# Check R_NOOVERWRITE flag will make put fail when attempting to overwrite
+# an existing record.
+ 
+my $status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ;
+ok(36, $status == 1 );
+ 
+# check that the value of the key 'x' has not been changed by the 
+# previous test
+ok(37, $h{'x'} eq 'X' );
+
+# standard put
+$status = $X->put('key', 'value') ;
+ok(38, $status == 0 );
+
+#check that previous put can be retrieved
+$value = 0 ;
+$status = $X->get('key', $value) ;
+ok(39, $status == 0 );
+ok(40, $value eq 'value' );
+
+# Attempting to delete an existing key should work
+
+$status = $X->del('q') ;
+ok(41, $status == 0 );
+if ($null_keys_allowed) {
+    $status = $X->del('') ;
+} else {
+    $status = 0 ;
+}
+ok(42, $status == 0 );
+
+# Make sure that the key deleted, cannot be retrieved
+ok(43, ! defined $h{'q'}) ;
+ok(44, ! defined $h{''}) ;
+
+undef $X ;
+untie %h ;
+
+ok(45, $X = tie(%h, 'DB_File',$Dfile, O_RDWR, 0640, $DB_BTREE ));
+
+# Attempting to delete a non-existant key should fail
+
+$status = $X->del('joe') ;
+ok(46, $status == 1 );
+
+# Check the get interface
+
+# First a non-existing key
+$status = $X->get('aaaa', $value) ;
+ok(47, $status == 1 );
+
+# Next an existing key
+$status = $X->get('a', $value) ;
+ok(48, $status == 0 );
+ok(49, $value eq 'A' );
+
+# seq
+# ###
+
+# use seq to find an approximate match
+$key = 'ke' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+ok(50, $status == 0 );
+ok(51, $key eq 'key' );
+ok(52, $value eq 'value' );
+
+# seq when the key does not match
+$key = 'zzz' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+ok(53, $status == 1 );
+
+
+# use seq to set the cursor, then delete the record @ the cursor.
+
+$key = 'x' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+ok(54, $status == 0 );
+ok(55, $key eq 'x' );
+ok(56, $value eq 'X' );
+$status = $X->del(0, R_CURSOR) ;
+ok(57, $status == 0 );
+$status = $X->get('x', $value) ;
+ok(58, $status == 1 );
+
+# ditto, but use put to replace the key/value pair.
+$key = 'y' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+ok(59, $status == 0 );
+ok(60, $key eq 'y' );
+ok(61, $value eq 'Y' );
+
+$key = "replace key" ;
+$value = "replace value" ;
+$status = $X->put($key, $value, R_CURSOR) ;
+ok(62, $status == 0 );
+ok(63, $key eq 'replace key' );
+ok(64, $value eq 'replace value' );
+$status = $X->get('y', $value) ;
+ok(65, 1) ; # hard-wire to always pass. the previous test ($status == 1)
+           # only worked because of a bug in 1.85/6
+
+# use seq to walk forwards through a file 
+
+$status = $X->seq($key, $value, R_FIRST) ;
+ok(66, $status == 0 );
+my $previous = $key ;
+
+$ok = 1 ;
+while (($status = $X->seq($key, $value, R_NEXT)) == 0)
+{
+    ($ok = 0), last if ($previous cmp $key) == 1 ;
+}
+
+ok(67, $status == 1 );
+ok(68, $ok == 1 );
+
+# use seq to walk backwards through a file 
+$status = $X->seq($key, $value, R_LAST) ;
+ok(69, $status == 0 );
+$previous = $key ;
+
+$ok = 1 ;
+while (($status = $X->seq($key, $value, R_PREV)) == 0)
+{
+    ($ok = 0), last if ($previous cmp $key) == -1 ;
+    #print "key = [$key] value = [$value]\n" ;
+}
+
+ok(70, $status == 1 );
+ok(71, $ok == 1 );
+
+
+# check seq FIRST/LAST
+
+# sync
+# ####
+
+$status = $X->sync ;
+ok(72, $status == 0 );
+
+
+# fd
+# ##
+
+$status = $X->fd ;
+ok(73, $status != 0 );
+
+
+undef $X ;
+untie %h ;
+
+unlink $Dfile;
+
+# Now try an in memory file
+my $Y;
+ok(74, $Y = tie(%h, 'DB_File',undef, O_RDWR|O_CREAT, 0640, $DB_BTREE ));
+
+# fd with an in memory file should return failure
+$status = $Y->fd ;
+ok(75, $status == -1 );
+
+
+undef $Y ;
+untie %h ;
+
+# Duplicate keys
+my $bt = new DB_File::BTREEINFO ;
+$bt->{flags} = R_DUP ;
+my ($YY, %hh);
+ok(76, $YY = tie(%hh, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $bt )) ;
+
+$hh{'Wall'} = 'Larry' ;
+$hh{'Wall'} = 'Stone' ; # Note the duplicate key
+$hh{'Wall'} = 'Brick' ; # Note the duplicate key
+$hh{'Wall'} = 'Brick' ; # Note the duplicate key and value
+$hh{'Smith'} = 'John' ;
+$hh{'mouse'} = 'mickey' ;
+
+# first work in scalar context
+ok(77, scalar $YY->get_dup('Unknown') == 0 );
+ok(78, scalar $YY->get_dup('Smith') == 1 );
+ok(79, scalar $YY->get_dup('Wall') == 4 );
+
+# now in list context
+my @unknown = $YY->get_dup('Unknown') ;
+ok(80, "@unknown" eq "" );
+
+my @smith = $YY->get_dup('Smith') ;
+ok(81, "@smith" eq "John" );
+
+{
+my @wall = $YY->get_dup('Wall') ;
+my %wall ;
+@wall{@wall} = @wall ;
+ok(82, (@wall == 4 && $wall{'Larry'} && $wall{'Stone'} && $wall{'Brick'}) );
+}
+
+# hash
+my %unknown = $YY->get_dup('Unknown', 1) ;
+ok(83, keys %unknown == 0 );
+
+my %smith = $YY->get_dup('Smith', 1) ;
+ok(84, keys %smith == 1 && $smith{'John'}) ;
+
+my %wall = $YY->get_dup('Wall', 1) ;
+ok(85, keys %wall == 3 && $wall{'Larry'} == 1 && $wall{'Stone'} == 1 
+               && $wall{'Brick'} == 2);
+
+undef $YY ;
+untie %hh ;
+unlink $Dfile;
+
+
+# test multiple callbacks
+my $Dfile1 = "btree1" ;
+my $Dfile2 = "btree2" ;
+my $Dfile3 = "btree3" ;
+ 
+my $dbh1 = new DB_File::BTREEINFO ;
+$dbh1->{compare} = sub { 
+       no warnings 'numeric' ;
+       $_[0] <=> $_[1] } ; 
+ 
+my $dbh2 = new DB_File::BTREEINFO ;
+$dbh2->{compare} = sub { $_[0] cmp $_[1] } ;
+ 
+my $dbh3 = new DB_File::BTREEINFO ;
+$dbh3->{compare} = sub { length $_[0] <=> length $_[1] } ;
+ 
+ 
+my (%g, %k);
+tie(%h, 'DB_File',$Dfile1, O_RDWR|O_CREAT, 0640, $dbh1 ) ; 
+tie(%g, 'DB_File',$Dfile2, O_RDWR|O_CREAT, 0640, $dbh2 ) ;
+tie(%k, 'DB_File',$Dfile3, O_RDWR|O_CREAT, 0640, $dbh3 ) ;
+ 
+my @Keys = qw( 0123 12 -1234 9 987654321 def  ) ;
+my (@srt_1, @srt_2, @srt_3);
+{ 
+  no warnings 'numeric' ;
+  @srt_1 = sort { $a <=> $b } @Keys ; 
+}
+@srt_2 = sort { $a cmp $b } @Keys ;
+@srt_3 = sort { length $a <=> length $b } @Keys ;
+ 
+foreach (@Keys) {
+    $h{$_} = 1 ;
+    $g{$_} = 1 ;
+    $k{$_} = 1 ;
+}
+ 
+sub ArrayCompare
+{
+    my($a, $b) = @_ ;
+ 
+    return 0 if @$a != @$b ;
+ 
+    foreach (1 .. length @$a)
+    {
+        return 0 unless $$a[$_] eq $$b[$_] ;
+    }
+ 
+    1 ;
+}
+ 
+ok(86, ArrayCompare (\@srt_1, [keys %h]) );
+ok(87, ArrayCompare (\@srt_2, [keys %g]) );
+ok(88, ArrayCompare (\@srt_3, [keys %k]) );
+
+untie %h ;
+untie %g ;
+untie %k ;
+unlink $Dfile1, $Dfile2, $Dfile3 ;
+
+# clear
+# #####
+
+ok(89, tie(%h, 'DB_File', $Dfile1, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
+foreach (1 .. 10)
+  { $h{$_} = $_ * 100 }
+
+# check that there are 10 elements in the hash
+$i = 0 ;
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+ok(90, $i == 10);
+
+# now clear the hash
+%h = () ;
+
+# check it is empty
+$i = 0 ;
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+ok(91, $i == 0);
+
+untie %h ;
+unlink $Dfile1 ;
+
+{
+    # check that attempting to tie an array to a DB_BTREE will fail
+
+    my $filename = "xyz" ;
+    my @x ;
+    eval { tie @x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE ; } ;
+    ok(92, $@ =~ /^DB_File can only tie an associative array to a DB_BTREE database/) ;
+    unlink $filename ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use warnings ;
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use warnings ;
+   use strict ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use DB_File;
+   @ISA=qw(DB_File);
+   @EXPORT = @DB_File::EXPORT ;
+
+   sub STORE { 
+       my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+       my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub put { 
+       my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::put($key, $value * 3) ;
+   }
+
+   sub get { 
+       my $self = shift ;
+        $self->SUPER::get($_[0], $_[1]) ;
+       $_[1] -= 2 ;
+   }
+
+   sub A_new_method
+   {
+       my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+       return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }    
+    eval 'use SubDB ; ';
+    main::ok(93, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+       $X = tie(%h, "SubDB","dbbtree.tmp", O_RDWR|O_CREAT, 0640, $DB_BTREE );
+       ' ;
+
+    main::ok(94, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(95, $@ eq "") ;
+    main::ok(96, $ret == 5) ;
+
+    my $value = 0;
+    $ret = eval '$X->put("joe", 4) ; $X->get("joe", $value) ; return $value' ;
+    main::ok(97, $@ eq "") ;
+    main::ok(98, $ret == 10) ;
+
+    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
+    main::ok(99, $@ eq "" ) ;
+    main::ok(100, $ret == 1) ;
+
+    $ret = eval '$X->A_new_method("joe") ' ;
+    main::ok(101, $@ eq "") ;
+    main::ok(102, $ret eq "[[11]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", "dbbtree.tmp" ;
+
+}
+
+{
+   # DBM Filter tests
+   use warnings ;
+   use strict ;
+   my (%h, $db) ;
+   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   unlink $Dfile;
+
+   sub checkOutput
+   {
+       my($fk, $sk, $fv, $sv) = @_ ;
+       return
+           $fetch_key eq $fk && $store_key eq $sk && 
+          $fetch_value eq $fv && $store_value eq $sv &&
+          $_ eq 'original' ;
+   }
+   
+   ok(103, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
+
+   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
+   $db->filter_store_key   (sub { $store_key = $_ }) ;
+   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
+   $db->filter_store_value (sub { $store_value = $_ }) ;
+
+   $_ = "original" ;
+
+   $h{"fred"} = "joe" ;
+   #                   fk   sk     fv   sv
+   ok(104, checkOutput( "", "fred", "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(105, $h{"fred"} eq "joe");
+   #                   fk    sk     fv    sv
+   ok(106, checkOutput( "", "fred", "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(107, $db->FIRSTKEY() eq "fred") ;
+   #                    fk     sk  fv  sv
+   ok(108, checkOutput( "fred", "", "", "")) ;
+
+   # replace the filters, but remember the previous set
+   my ($old_fk) = $db->filter_fetch_key   
+                       (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
+   my ($old_sk) = $db->filter_store_key   
+                       (sub { $_ = lc $_ ; $store_key = $_ }) ;
+   my ($old_fv) = $db->filter_fetch_value 
+                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
+   my ($old_sv) = $db->filter_store_value 
+                       (sub { s/o/x/g; $store_value = $_ }) ;
+   
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"Fred"} = "Joe" ;
+   #                   fk   sk     fv    sv
+   ok(109, checkOutput( "", "fred", "", "Jxe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(110, $h{"Fred"} eq "[Jxe]");
+   #                   fk   sk     fv    sv
+   ok(111, checkOutput( "", "fred", "[Jxe]", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(112, $db->FIRSTKEY() eq "FRED") ;
+   #                   fk   sk     fv    sv
+   ok(113, checkOutput( "FRED", "", "", "")) ;
+
+   # put the original filters back
+   $db->filter_fetch_key   ($old_fk);
+   $db->filter_store_key   ($old_sk);
+   $db->filter_fetch_value ($old_fv);
+   $db->filter_store_value ($old_sv);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"fred"} = "joe" ;
+   ok(114, checkOutput( "", "fred", "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(115, $h{"fred"} eq "joe");
+   ok(116, checkOutput( "", "fred", "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(117, $db->FIRSTKEY() eq "fred") ;
+   ok(118, checkOutput( "fred", "", "", "")) ;
+
+   # delete the filters
+   $db->filter_fetch_key   (undef);
+   $db->filter_store_key   (undef);
+   $db->filter_fetch_value (undef);
+   $db->filter_store_value (undef);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"fred"} = "joe" ;
+   ok(119, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(120, $h{"fred"} eq "joe");
+   ok(121, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(122, $db->FIRSTKEY() eq "fred") ;
+   ok(123, checkOutput( "", "", "", "")) ;
+
+   undef $db ;
+   untie %h;
+   unlink $Dfile;
+}
+
+{    
+    # DBM Filter with a closure
+
+    use warnings ;
+    use strict ;
+    my (%h, $db) ;
+
+    unlink $Dfile;
+    ok(124, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
+
+    my %result = () ;
+
+    sub Closure
+    {
+        my ($name) = @_ ;
+       my $count = 0 ;
+       my @kept = () ;
+
+       return sub { ++$count ; 
+                    push @kept, $_ ; 
+                    $result{$name} = "$name - $count: [@kept]" ;
+                  }
+    }
+
+    $db->filter_store_key(Closure("store key")) ;
+    $db->filter_store_value(Closure("store value")) ;
+    $db->filter_fetch_key(Closure("fetch key")) ;
+    $db->filter_fetch_value(Closure("fetch value")) ;
+
+    $_ = "original" ;
+
+    $h{"fred"} = "joe" ;
+    ok(125, $result{"store key"} eq "store key - 1: [fred]");
+    ok(126, $result{"store value"} eq "store value - 1: [joe]");
+    ok(127, ! defined $result{"fetch key"} );
+    ok(128, ! defined $result{"fetch value"} );
+    ok(129, $_ eq "original") ;
+
+    ok(130, $db->FIRSTKEY() eq "fred") ;
+    ok(131, $result{"store key"} eq "store key - 1: [fred]");
+    ok(132, $result{"store value"} eq "store value - 1: [joe]");
+    ok(133, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(134, ! defined $result{"fetch value"} );
+    ok(135, $_ eq "original") ;
+
+    $h{"jim"}  = "john" ;
+    ok(136, $result{"store key"} eq "store key - 2: [fred jim]");
+    ok(137, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(138, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(139, ! defined $result{"fetch value"} );
+    ok(140, $_ eq "original") ;
+
+    ok(141, $h{"fred"} eq "joe");
+    ok(142, $result{"store key"} eq "store key - 3: [fred jim fred]");
+    ok(143, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(144, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(145, $result{"fetch value"} eq "fetch value - 1: [joe]");
+    ok(146, $_ eq "original") ;
+
+    undef $db ;
+    untie %h;
+    unlink $Dfile;
+}              
+
+{
+   # DBM Filter recursion detection
+   use warnings ;
+   use strict ;
+   my (%h, $db) ;
+   unlink $Dfile;
+
+   ok(147, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
+
+   $db->filter_store_key (sub { $_ = $h{$_} }) ;
+
+   eval '$h{1} = 1234' ;
+   ok(148, $@ =~ /^recursion detected in filter_store_key at/ );
+   
+   undef $db ;
+   untie %h;
+   unlink $Dfile;
+}
+
+
+{
+   # Examples from the POD
+
+
+  my $file = "xyzt" ;
+  {
+    my $redirect = new Redirect $file ;
+
+    # BTREE example 1
+    ###
+
+    use warnings FATAL => qw(all) ;
+    use strict ;
+    use DB_File ;
+
+    my %h ;
+
+    sub Compare
+    {
+        my ($key1, $key2) = @_ ;
+        "\L$key1" cmp "\L$key2" ;
+    }
+
+    # specify the Perl sub that will do the comparison
+    $DB_BTREE->{'compare'} = \&Compare ;
+
+    unlink "tree" ;
+    tie %h, "DB_File", "tree", O_RDWR|O_CREAT, 0640, $DB_BTREE 
+        or die "Cannot open file 'tree': $!\n" ;
+
+    # Add a key/value pair to the file
+    $h{'Wall'} = 'Larry' ;
+    $h{'Smith'} = 'John' ;
+    $h{'mouse'} = 'mickey' ;
+    $h{'duck'}  = 'donald' ;
+
+    # Delete
+    delete $h{"duck"} ;
+
+    # Cycle through the keys printing them in order.
+    # Note it is not necessary to sort the keys as
+    # the btree will have kept them in order automatically.
+    foreach (keys %h)
+      { print "$_\n" }
+
+    untie %h ;
+
+    unlink "tree" ;
+  }  
+
+  delete $DB_BTREE->{'compare'} ;
+
+  ok(149, docat_del($file) eq <<'EOM') ;
+mouse
+Smith
+Wall
+EOM
+   
+  {
+    my $redirect = new Redirect $file ;
+
+    # BTREE example 2
+    ###
+
+    use warnings FATAL => qw(all) ;
+    use strict ;
+    use DB_File ;
+
+    use vars qw($filename %h ) ;
+
+    $filename = "tree" ;
+    unlink $filename ;
+ 
+    # Enable duplicate records
+    $DB_BTREE->{'flags'} = R_DUP ;
+ 
+    tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
+       or die "Cannot open $filename: $!\n";
+ 
+    # Add some key/value pairs to the file
+    $h{'Wall'} = 'Larry' ;
+    $h{'Wall'} = 'Brick' ; # Note the duplicate key
+    $h{'Wall'} = 'Brick' ; # Note the duplicate key and value
+    $h{'Smith'} = 'John' ;
+    $h{'mouse'} = 'mickey' ;
+
+    # iterate through the associative array
+    # and print each key/value pair.
+    foreach (keys %h)
+      { print "$_      -> $h{$_}\n" }
+
+    untie %h ;
+
+    unlink $filename ;
+  }  
+
+  ok(150, docat_del($file) eq ($db185mode ? <<'EOM' : <<'EOM') ) ;
+Smith  -> John
+Wall   -> Brick
+Wall   -> Brick
+Wall   -> Brick
+mouse  -> mickey
+EOM
+Smith  -> John
+Wall   -> Larry
+Wall   -> Larry
+Wall   -> Larry
+mouse  -> mickey
+EOM
+
+  {
+    my $redirect = new Redirect $file ;
+
+    # BTREE example 3
+    ###
+
+    use warnings FATAL => qw(all) ;
+    use strict ;
+    use DB_File ;
+ 
+    use vars qw($filename $x %h $status $key $value) ;
+
+    $filename = "tree" ;
+    unlink $filename ;
+ 
+    # Enable duplicate records
+    $DB_BTREE->{'flags'} = R_DUP ;
+ 
+    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
+       or die "Cannot open $filename: $!\n";
+ 
+    # Add some key/value pairs to the file
+    $h{'Wall'} = 'Larry' ;
+    $h{'Wall'} = 'Brick' ; # Note the duplicate key
+    $h{'Wall'} = 'Brick' ; # Note the duplicate key and value
+    $h{'Smith'} = 'John' ;
+    $h{'mouse'} = 'mickey' ;
+ 
+    # iterate through the btree using seq
+    # and print each key/value pair.
+    $key = $value = 0 ;
+    for ($status = $x->seq($key, $value, R_FIRST) ;
+         $status == 0 ;
+         $status = $x->seq($key, $value, R_NEXT) )
+      {  print "$key   -> $value\n" }
+ 
+ 
+    undef $x ;
+    untie %h ;
+  }
+
+  ok(151, docat_del($file) eq ($db185mode == 1 ? <<'EOM' : <<'EOM') ) ;
+Smith  -> John
+Wall   -> Brick
+Wall   -> Brick
+Wall   -> Larry
+mouse  -> mickey
+EOM
+Smith  -> John
+Wall   -> Larry
+Wall   -> Brick
+Wall   -> Brick
+mouse  -> mickey
+EOM
+
+
+  {
+    my $redirect = new Redirect $file ;
+
+    # BTREE example 4
+    ###
+
+    use warnings FATAL => qw(all) ;
+    use strict ;
+    use DB_File ;
+ 
+    use vars qw($filename $x %h ) ;
+
+    $filename = "tree" ;
+ 
+    # Enable duplicate records
+    $DB_BTREE->{'flags'} = R_DUP ;
+ 
+    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
+       or die "Cannot open $filename: $!\n";
+ 
+    my $cnt  = $x->get_dup("Wall") ;
+    print "Wall occurred $cnt times\n" ;
+
+    my %hash = $x->get_dup("Wall", 1) ;
+    print "Larry is there\n" if $hash{'Larry'} ;
+    print "There are $hash{'Brick'} Brick Walls\n" ;
+
+    my @list = sort $x->get_dup("Wall") ;
+    print "Wall =>     [@list]\n" ;
+
+    @list = $x->get_dup("Smith") ;
+    print "Smith =>    [@list]\n" ;
+ 
+    @list = $x->get_dup("Dog") ;
+    print "Dog =>      [@list]\n" ; 
+ 
+    undef $x ;
+    untie %h ;
+  }
+
+  ok(152, docat_del($file) eq <<'EOM') ;
+Wall occurred 3 times
+Larry is there
+There are 2 Brick Walls
+Wall =>        [Brick Brick Larry]
+Smith =>       [John]
+Dog => []
+EOM
+
+  {
+    my $redirect = new Redirect $file ;
+
+    # BTREE example 5
+    ###
+
+    use warnings FATAL => qw(all) ;
+    use strict ;
+    use DB_File ;
+ 
+    use vars qw($filename $x %h $found) ;
+
+    my $filename = "tree" ;
+ 
+    # Enable duplicate records
+    $DB_BTREE->{'flags'} = R_DUP ;
+ 
+    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
+       or die "Cannot open $filename: $!\n";
+
+    $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ; 
+    print "Larry Wall is $found there\n" ;
+    
+    $found = ( $x->find_dup("Wall", "Harry") == 0 ? "" : "not") ; 
+    print "Harry Wall is $found there\n" ;
+    
+    undef $x ;
+    untie %h ;
+  }
+
+  ok(153, docat_del($file) eq <<'EOM') ;
+Larry Wall is  there
+Harry Wall is not there
+EOM
+
+  {
+    my $redirect = new Redirect $file ;
+
+    # BTREE example 6
+    ###
+
+    use warnings FATAL => qw(all) ;
+    use strict ;
+    use DB_File ;
+ 
+    use vars qw($filename $x %h $found) ;
+
+    my $filename = "tree" ;
+ 
+    # Enable duplicate records
+    $DB_BTREE->{'flags'} = R_DUP ;
+ 
+    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
+       or die "Cannot open $filename: $!\n";
+
+    $x->del_dup("Wall", "Larry") ;
+
+    $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ; 
+    print "Larry Wall is $found there\n" ;
+    
+    undef $x ;
+    untie %h ;
+
+    unlink $filename ;
+  }
+
+  ok(154, docat_del($file) eq <<'EOM') ;
+Larry Wall is not there
+EOM
+
+  {
+    my $redirect = new Redirect $file ;
+
+    # BTREE example 7
+    ###
+
+    use warnings FATAL => qw(all) ;
+    use strict ;
+    use DB_File ;
+    use Fcntl ;
+
+    use vars qw($filename $x %h $st $key $value) ;
+
+    sub match
+    {
+        my $key = shift ;
+        my $value = 0;
+        my $orig_key = $key ;
+        $x->seq($key, $value, R_CURSOR) ;
+        print "$orig_key\t-> $key\t-> $value\n" ;
+    }
+
+    $filename = "tree" ;
+    unlink $filename ;
+
+    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE
+        or die "Cannot open $filename: $!\n";
+ 
+    # Add some key/value pairs to the file
+    $h{'mouse'} = 'mickey' ;
+    $h{'Wall'} = 'Larry' ;
+    $h{'Walls'} = 'Brick' ; 
+    $h{'Smith'} = 'John' ;
+ 
+
+    $key = $value = 0 ;
+    print "IN ORDER\n" ;
+    for ($st = $x->seq($key, $value, R_FIRST) ;
+        $st == 0 ;
+         $st = $x->seq($key, $value, R_NEXT) )
+       
+      {  print "$key   -> $value\n" }
+ 
+    print "\nPARTIAL MATCH\n" ;
+
+    match "Wa" ;
+    match "A" ;
+    match "a" ;
+
+    undef $x ;
+    untie %h ;
+
+    unlink $filename ;
+
+  }
+
+  ok(155, docat_del($file) eq <<'EOM') ;
+IN ORDER
+Smith  -> John
+Wall   -> Larry
+Walls  -> Brick
+mouse  -> mickey
+
+PARTIAL MATCH
+Wa     -> Wall -> Larry
+A      -> Smith        -> John
+a      -> mouse        -> mickey
+EOM
+
+}
+
+#{
+#   # R_SETCURSOR
+#   use strict ;
+#   my (%h, $db) ;
+#   unlink $Dfile;
+#
+#   ok(156, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
+#
+#   $h{abc} = 33 ;
+#   my $k = "newest" ;
+#   my $v = 44 ;
+#   my $status = $db->put($k, $v, R_SETCURSOR) ;
+#   print "status = [$status]\n" ;
+#   ok(157, $status == 0) ;
+#   $status = $db->del($k, R_CURSOR) ;
+#   print "status = [$status]\n" ;
+#   ok(158, $status == 0) ;
+#   $k = "newest" ;
+#   ok(159, $db->get($k, $v, R_CURSOR)) ;
+#
+#   ok(160, keys %h == 1) ;
+#   
+#   undef $db ;
+#   untie %h;
+#   unlink $Dfile;
+#}
+
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use DB_File ;
+
+    unlink $Dfile;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    tie %h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_BTREE
+       or die "Can't open file: $!\n" ;
+    $h{ABC} = undef;
+    ok(156, $a eq "") ;
+    untie %h ;
+    unlink $Dfile;
+}
+
+{
+    # test that %hash = () doesn't produce the warning
+    #     Argument "" isn't numeric in entersub
+    use warnings ;
+    use strict ;
+    use DB_File ;
+
+    unlink $Dfile;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    tie %h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_BTREE
+       or die "Can't open file: $!\n" ;
+    %h = (); ;
+    ok(157, $a eq "") ;
+    untie %h ;
+    unlink $Dfile;
+}
+
+exit ;

diff --git a/ext/DB_File/t/db-hash.t b/ext/DB_File/t/db-hash.t
new file mode 100755 (executable)
index 0000000..6f2ef37
--- /dev/null
+++ b/ext/DB_File/t/db-hash.t
@@ -0,0 +1,743 @@
+#!./perl -w
+
+BEGIN {
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDB_File\b/) {
+       print "1..0 # Skip: DB_File was not built\n";
+       exit 0;
+    }
+}
+
+use strict;
+use warnings;
+use DB_File; 
+use Fcntl;
+
+print "1..111\n";
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+ 
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+{
+    package Redirect ;
+    use Symbol ;
+
+    sub new
+    {
+        my $class = shift ;
+        my $filename = shift ;
+       my $fh = gensym ;
+       open ($fh, ">$filename") || die "Cannot open $filename: $!" ;
+       my $real_stdout = select($fh) ;
+       return bless [$fh, $real_stdout ] ;
+
+    }
+    sub DESTROY
+    {
+        my $self = shift ;
+       close $self->[0] ;
+       select($self->[1]) ;
+    }
+}
+
+sub docat_del
+{ 
+    my $file = shift;
+    local $/ = undef;
+    open(CAT,$file) || die "Cannot open $file: $!";
+    my $result = <CAT>;
+    close(CAT);
+    unlink $file ;
+    return $result;
+}   
+
+my $Dfile = "dbhash.tmp";
+my $null_keys_allowed = ($DB_File::db_ver < 2.004010 
+                               || $DB_File::db_ver >= 3.1 );
+
+unlink $Dfile;
+
+umask(0);
+
+# Check the interface to HASHINFO
+
+my $dbh = new DB_File::HASHINFO ;
+
+ok(1, ! defined $dbh->{bsize}) ;
+ok(2, ! defined $dbh->{ffactor}) ;
+ok(3, ! defined $dbh->{nelem}) ;
+ok(4, ! defined $dbh->{cachesize}) ;
+ok(5, ! defined $dbh->{hash}) ;
+ok(6, ! defined $dbh->{lorder}) ;
+
+$dbh->{bsize} = 3000 ;
+ok(7, $dbh->{bsize} == 3000 );
+
+$dbh->{ffactor} = 9000 ;
+ok(8, $dbh->{ffactor} == 9000 );
+
+$dbh->{nelem} = 400 ;
+ok(9, $dbh->{nelem} == 400 );
+
+$dbh->{cachesize} = 65 ;
+ok(10, $dbh->{cachesize} == 65 );
+
+$dbh->{hash} = "abc" ;
+ok(11, $dbh->{hash} eq "abc" );
+
+$dbh->{lorder} = 1234 ;
+ok(12, $dbh->{lorder} == 1234 );
+
+# Check that an invalid entry is caught both for store & fetch
+eval '$dbh->{fred} = 1234' ;
+ok(13, $@ =~ /^DB_File::HASHINFO::STORE - Unknown element 'fred' at/ );
+eval 'my $q = $dbh->{fred}' ;
+ok(14, $@ =~ /^DB_File::HASHINFO::FETCH - Unknown element 'fred' at/ );
+
+
+# Now check the interface to HASH
+my ($X, %h);
+ok(15, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
+
+my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+ok(16, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare');
+
+my ($key, $value, $i);
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+ok(17, !$i );
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+ok(18, $h{'abc'} eq 'ABC' );
+ok(19, !defined $h{'jimmy'} );
+ok(20, !exists $h{'jimmy'} );
+ok(21, exists $h{'abc'} );
+
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+
+#$h{'b'} = 'B';
+$X->STORE('b', 'B') ;
+
+$h{'c'} = 'C';
+
+#$h{'d'} = 'D';
+$X->put('d', 'D') ;
+
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'X';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+
+# IMPORTANT - $X must be undefined before the untie otherwise the
+#             underlying DB close routine will not get called.
+undef $X ;
+untie(%h);
+
+
+# tie to the same file again, do not supply a type - should default to HASH
+ok(22, $X = tie(%h,'DB_File',$Dfile, O_RDWR, 0640) );
+
+# Modify an entry from the previous tie
+$h{'g'} = 'G';
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+$X->DELETE('goner3');
+
+my @keys = keys(%h);
+my @values = values(%h);
+
+ok(23, $#keys == 29 && $#values == 29) ;
+
+$i = 0 ;
+while (($key,$value) = each(%h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+       $key =~ y/a-z/A-Z/;
+       $i++ if $key eq $value;
+    }
+}
+
+ok(24, $i == 30) ;
+
+@keys = ('blurfl', keys(%h), 'dyick');
+ok(25, $#keys == 31) ;
+
+$h{'foo'} = '';
+ok(26, $h{'foo'} eq '' );
+
+# Berkeley DB from version 2.4.10 to 3.0 does not allow null keys.
+# This feature was reenabled in version 3.1 of Berkeley DB.
+my $result = 0 ;
+if ($null_keys_allowed) {
+    $h{''} = 'bar';
+    $result = ( $h{''} eq 'bar' );
+}
+else
+  { $result = 1 }
+ok(27, $result) ;
+
+# check cache overflow and numeric keys and contents
+my $ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+ok(28, $ok );
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+ok(29, $size > 0 );
+
+@h{0..200} = 200..400;
+my @foo = @h{0..200};
+ok(30, join(':',200..400) eq join(':',@foo) );
+
+
+# Now check all the non-tie specific stuff
+
+# Check NOOVERWRITE will make put fail when attempting to overwrite
+# an existing record.
+ 
+my $status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ;
+ok(31, $status == 1 );
+ 
+# check that the value of the key 'x' has not been changed by the 
+# previous test
+ok(32, $h{'x'} eq 'X' );
+
+# standard put
+$status = $X->put('key', 'value') ;
+ok(33, $status == 0 );
+
+#check that previous put can be retrieved
+$value = 0 ;
+$status = $X->get('key', $value) ;
+ok(34, $status == 0 );
+ok(35, $value eq 'value' );
+
+# Attempting to delete an existing key should work
+
+$status = $X->del('q') ;
+ok(36, $status == 0 );
+
+# Make sure that the key deleted, cannot be retrieved
+{
+    no warnings 'uninitialized' ;
+    ok(37, $h{'q'} eq undef );
+}
+
+# Attempting to delete a non-existant key should fail
+
+$status = $X->del('joe') ;
+ok(38, $status == 1 );
+
+# Check the get interface
+
+# First a non-existing key
+$status = $X->get('aaaa', $value) ;
+ok(39, $status == 1 );
+
+# Next an existing key
+$status = $X->get('a', $value) ;
+ok(40, $status == 0 );
+ok(41, $value eq 'A' );
+
+# seq
+# ###
+
+# ditto, but use put to replace the key/value pair.
+
+# use seq to walk backwards through a file - check that this reversed is
+
+# check seq FIRST/LAST
+
+# sync
+# ####
+
+$status = $X->sync ;
+ok(42, $status == 0 );
+
+
+# fd
+# ##
+
+$status = $X->fd ;
+ok(43, $status != 0 );
+
+undef $X ;
+untie %h ;
+
+unlink $Dfile;
+
+# clear
+# #####
+
+ok(44, tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
+foreach (1 .. 10)
+  { $h{$_} = $_ * 100 }
+
+# check that there are 10 elements in the hash
+$i = 0 ;
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+ok(45, $i == 10);
+
+# now clear the hash
+%h = () ;
+
+# check it is empty
+$i = 0 ;
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+ok(46, $i == 0);
+
+untie %h ;
+unlink $Dfile ;
+
+
+# Now try an in memory file
+ok(47, $X = tie(%h, 'DB_File',undef, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
+
+# fd with an in memory file should return fail
+$status = $X->fd ;
+ok(48, $status == -1 );
+
+undef $X ;
+untie %h ;
+
+{
+    # check ability to override the default hashing
+    my %x ;
+    my $filename = "xyz" ;
+    my $hi = new DB_File::HASHINFO ;
+    $::count = 0 ;
+    $hi->{hash} = sub { ++$::count ; length $_[0] } ;
+    ok(49, tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $hi ) ;
+    $h{"abc"} = 123 ;
+    ok(50, $h{"abc"} == 123) ;
+    untie %x ;
+    unlink $filename ;
+    ok(51, $::count >0) ;
+}
+
+{
+    # check that attempting to tie an array to a DB_HASH will fail
+
+    my $filename = "xyz" ;
+    my @x ;
+    eval { tie @x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_HASH ; } ;
+    ok(52, $@ =~ /^DB_File can only tie an associative array to a DB_HASH database/) ;
+    unlink $filename ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use warnings ;
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use warnings ;
+   use strict ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use DB_File;
+   @ISA=qw(DB_File);
+   @EXPORT = @DB_File::EXPORT ;
+
+   sub STORE { 
+       my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+       my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub put { 
+       my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::put($key, $value * 3) ;
+   }
+
+   sub get { 
+       my $self = shift ;
+        $self->SUPER::get($_[0], $_[1]) ;
+       $_[1] -= 2 ;
+   }
+
+   sub A_new_method
+   {
+       my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+       return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }             
+    eval 'use SubDB ; ';
+    main::ok(53, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+       $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640, $DB_HASH );
+       ' ;
+
+    main::ok(54, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(55, $@ eq "") ;
+    main::ok(56, $ret == 5) ;
+
+    my $value = 0;
+    $ret = eval '$X->put("joe", 4) ; $X->get("joe", $value) ; return $value' ;
+    main::ok(57, $@ eq "") ;
+    main::ok(58, $ret == 10) ;
+
+    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
+    main::ok(59, $@ eq "" ) ;
+    main::ok(60, $ret == 1) ;
+
+    $ret = eval '$X->A_new_method("joe") ' ;
+    main::ok(61, $@ eq "") ;
+    main::ok(62, $ret eq "[[11]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", "dbhash.tmp" ;
+
+}
+
+{
+   # DBM Filter tests
+   use warnings ;
+   use strict ;
+   my (%h, $db) ;
+   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   unlink $Dfile;
+
+   sub checkOutput
+   {
+       my($fk, $sk, $fv, $sv) = @_ ;
+       return
+           $fetch_key eq $fk && $store_key eq $sk && 
+          $fetch_value eq $fv && $store_value eq $sv &&
+          $_ eq 'original' ;
+   }
+   
+   ok(63, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
+
+   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
+   $db->filter_store_key   (sub { $store_key = $_ }) ;
+   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
+   $db->filter_store_value (sub { $store_value = $_ }) ;
+
+   $_ = "original" ;
+
+   $h{"fred"} = "joe" ;
+   #                   fk   sk     fv   sv
+   ok(64, checkOutput( "", "fred", "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(65, $h{"fred"} eq "joe");
+   #                   fk    sk     fv    sv
+   ok(66, checkOutput( "", "fred", "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(67, $db->FIRSTKEY() eq "fred") ;
+   #                    fk     sk  fv  sv
+   ok(68, checkOutput( "fred", "", "", "")) ;
+
+   # replace the filters, but remember the previous set
+   my ($old_fk) = $db->filter_fetch_key   
+                       (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
+   my ($old_sk) = $db->filter_store_key   
+                       (sub { $_ = lc $_ ; $store_key = $_ }) ;
+   my ($old_fv) = $db->filter_fetch_value 
+                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
+   my ($old_sv) = $db->filter_store_value 
+                       (sub { s/o/x/g; $store_value = $_ }) ;
+   
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"Fred"} = "Joe" ;
+   #                   fk   sk     fv    sv
+   ok(69, checkOutput( "", "fred", "", "Jxe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(70, $h{"Fred"} eq "[Jxe]");
+   #                   fk   sk     fv    sv
+   ok(71, checkOutput( "", "fred", "[Jxe]", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(72, $db->FIRSTKEY() eq "FRED") ;
+   #                   fk   sk     fv    sv
+   ok(73, checkOutput( "FRED", "", "", "")) ;
+
+   # put the original filters back
+   $db->filter_fetch_key   ($old_fk);
+   $db->filter_store_key   ($old_sk);
+   $db->filter_fetch_value ($old_fv);
+   $db->filter_store_value ($old_sv);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"fred"} = "joe" ;
+   ok(74, checkOutput( "", "fred", "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(75, $h{"fred"} eq "joe");
+   ok(76, checkOutput( "", "fred", "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(77, $db->FIRSTKEY() eq "fred") ;
+   ok(78, checkOutput( "fred", "", "", "")) ;
+
+   # delete the filters
+   $db->filter_fetch_key   (undef);
+   $db->filter_store_key   (undef);
+   $db->filter_fetch_value (undef);
+   $db->filter_store_value (undef);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"fred"} = "joe" ;
+   ok(79, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(80, $h{"fred"} eq "joe");
+   ok(81, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(82, $db->FIRSTKEY() eq "fred") ;
+   ok(83, checkOutput( "", "", "", "")) ;
+
+   undef $db ;
+   untie %h;
+   unlink $Dfile;
+}
+
+{    
+    # DBM Filter with a closure
+
+    use warnings ;
+    use strict ;
+    my (%h, $db) ;
+
+    unlink $Dfile;
+    ok(84, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
+
+    my %result = () ;
+
+    sub Closure
+    {
+        my ($name) = @_ ;
+       my $count = 0 ;
+       my @kept = () ;
+
+       return sub { ++$count ; 
+                    push @kept, $_ ; 
+                    $result{$name} = "$name - $count: [@kept]" ;
+                  }
+    }
+
+    $db->filter_store_key(Closure("store key")) ;
+    $db->filter_store_value(Closure("store value")) ;
+    $db->filter_fetch_key(Closure("fetch key")) ;
+    $db->filter_fetch_value(Closure("fetch value")) ;
+
+    $_ = "original" ;
+
+    $h{"fred"} = "joe" ;
+    ok(85, $result{"store key"} eq "store key - 1: [fred]");
+    ok(86, $result{"store value"} eq "store value - 1: [joe]");
+    ok(87, ! defined $result{"fetch key"} );
+    ok(88, ! defined $result{"fetch value"} );
+    ok(89, $_ eq "original") ;
+
+    ok(90, $db->FIRSTKEY() eq "fred") ;
+    ok(91, $result{"store key"} eq "store key - 1: [fred]");
+    ok(92, $result{"store value"} eq "store value - 1: [joe]");
+    ok(93, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(94, ! defined $result{"fetch value"} );
+    ok(95, $_ eq "original") ;
+
+    $h{"jim"}  = "john" ;
+    ok(96, $result{"store key"} eq "store key - 2: [fred jim]");
+    ok(97, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(98, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(99, ! defined $result{"fetch value"} );
+    ok(100, $_ eq "original") ;
+
+    ok(101, $h{"fred"} eq "joe");
+    ok(102, $result{"store key"} eq "store key - 3: [fred jim fred]");
+    ok(103, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(104, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(105, $result{"fetch value"} eq "fetch value - 1: [joe]");
+    ok(106, $_ eq "original") ;
+
+    undef $db ;
+    untie %h;
+    unlink $Dfile;
+}              
+
+{
+   # DBM Filter recursion detection
+   use warnings ;
+   use strict ;
+   my (%h, $db) ;
+   unlink $Dfile;
+
+   ok(107, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
+
+   $db->filter_store_key (sub { $_ = $h{$_} }) ;
+
+   eval '$h{1} = 1234' ;
+   ok(108, $@ =~ /^recursion detected in filter_store_key at/ );
+   
+   undef $db ;
+   untie %h;
+   unlink $Dfile;
+}
+
+
+{
+   # Examples from the POD
+
+  my $file = "xyzt" ;
+  {
+    my $redirect = new Redirect $file ;
+
+    use warnings FATAL => qw(all);
+    use strict ;
+    use DB_File ;
+    use vars qw( %h $k $v ) ;
+
+    unlink "fruit" ;
+    tie %h, "DB_File", "fruit", O_RDWR|O_CREAT, 0640, $DB_HASH 
+        or die "Cannot open file 'fruit': $!\n";
+
+    # Add a few key/value pairs to the file
+    $h{"apple"} = "red" ;
+    $h{"orange"} = "orange" ;
+    $h{"banana"} = "yellow" ;
+    $h{"tomato"} = "red" ;
+
+    # Check for existence of a key
+    print "Banana Exists\n\n" if $h{"banana"} ;
+
+    # Delete a key/value pair.
+    delete $h{"apple"} ;
+
+    # print the contents of the file
+    while (($k, $v) = each %h)
+      { print "$k -> $v\n" }
+
+    untie %h ;
+
+    unlink "fruit" ;
+  }  
+
+  ok(109, docat_del($file) eq <<'EOM') ;
+Banana Exists
+
+orange -> orange
+tomato -> red
+banana -> yellow
+EOM
+   
+}
+
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use DB_File ;
+
+    unlink $Dfile;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    tie %h, 'DB_File', $Dfile or die "Can't open file: $!\n" ;
+    $h{ABC} = undef;
+    ok(110, $a eq "") ;
+    untie %h ;
+    unlink $Dfile;
+}
+
+{
+    # test that %hash = () doesn't produce the warning
+    #     Argument "" isn't numeric in entersub
+    use warnings ;
+    use strict ;
+    use DB_File ;
+
+    unlink $Dfile;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    tie %h, 'DB_File', $Dfile or die "Can't open file: $!\n" ;
+    %h = (); ;
+    ok(111, $a eq "") ;
+    untie %h ;
+    unlink $Dfile;
+}
+
+exit ;

diff --git a/ext/DB_File/t/db-recno.t b/ext/DB_File/t/db-recno.t
new file mode 100755 (executable)
index 0000000..6dd913c
--- /dev/null
+++ b/ext/DB_File/t/db-recno.t
@@ -0,0 +1,889 @@
+#!./perl -w
+
+BEGIN {
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDB_File\b/) {
+       print "1..0 # Skip: DB_File was not built\n";
+       exit 0;
+    }
+}
+
+use DB_File; 
+use Fcntl;
+use strict ;
+use warnings;
+use vars qw($dbh $Dfile $bad_ones $FA) ;
+
+# full tied array support started in Perl 5.004_57
+# Double check to see if it is available.
+
+{
+    sub try::TIEARRAY { bless [], "try" }
+    sub try::FETCHSIZE { $FA = 1 }
+    $FA = 0 ;
+    my @a ; 
+    tie @a, 'try' ;
+    my $a = @a ;
+}
+
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+
+    return $result ;
+}
+
+{
+    package Redirect ;
+    use Symbol ;
+
+    sub new
+    {
+        my $class = shift ;
+        my $filename = shift ;
+       my $fh = gensym ;
+       open ($fh, ">$filename") || die "Cannot open $filename: $!" ;
+       my $real_stdout = select($fh) ;
+       return bless [$fh, $real_stdout ] ;
+
+    }
+    sub DESTROY
+    {
+        my $self = shift ;
+       close $self->[0] ;
+       select($self->[1]) ;
+    }
+}
+
+sub docat
+{
+    my $file = shift;
+    local $/ = undef;
+    open(CAT,$file) || die "Cannot open $file:$!";
+    my $result = <CAT>;
+    close(CAT);
+    return $result;
+}
+
+sub docat_del
+{ 
+    my $file = shift;
+    local $/ = undef;
+    open(CAT,$file) || die "Cannot open $file: $!";
+    my $result = <CAT>;
+    close(CAT);
+    unlink $file ;
+    return $result;
+}   
+
+sub bad_one
+{
+    print STDERR <<EOM unless $bad_ones++ ;
+#
+# Some older versions of Berkeley DB version 1 will fail tests 51,
+# 53 and 55.
+#
+# You can safely ignore the errors if you're never going to use the
+# broken functionality (recno databases with a modified bval). 
+# Otherwise you'll have to upgrade your DB library.
+#
+# If you want to use Berkeley DB version 1, then 1.85 and 1.86 are the
+# last versions that were released. Berkeley DB version 2 is continually
+# being updated -- Check out http://www.sleepycat.com/ for more details.
+#
+EOM
+}
+
+print "1..128\n";
+
+my $Dfile = "recno.tmp";
+unlink $Dfile ;
+
+umask(0);
+
+# Check the interface to RECNOINFO
+
+my $dbh = new DB_File::RECNOINFO ;
+ok(1, ! defined $dbh->{bval}) ;
+ok(2, ! defined $dbh->{cachesize}) ;
+ok(3, ! defined $dbh->{psize}) ;
+ok(4, ! defined $dbh->{flags}) ;
+ok(5, ! defined $dbh->{lorder}) ;
+ok(6, ! defined $dbh->{reclen}) ;
+ok(7, ! defined $dbh->{bfname}) ;
+
+$dbh->{bval} = 3000 ;
+ok(8, $dbh->{bval} == 3000 );
+
+$dbh->{cachesize} = 9000 ;
+ok(9, $dbh->{cachesize} == 9000 );
+
+$dbh->{psize} = 400 ;
+ok(10, $dbh->{psize} == 400 );
+
+$dbh->{flags} = 65 ;
+ok(11, $dbh->{flags} == 65 );
+
+$dbh->{lorder} = 123 ;
+ok(12, $dbh->{lorder} == 123 );
+
+$dbh->{reclen} = 1234 ;
+ok(13, $dbh->{reclen} == 1234 );
+
+$dbh->{bfname} = 1234 ;
+ok(14, $dbh->{bfname} == 1234 );
+
+
+# Check that an invalid entry is caught both for store & fetch
+eval '$dbh->{fred} = 1234' ;
+ok(15, $@ =~ /^DB_File::RECNOINFO::STORE - Unknown element 'fred' at/ );
+eval 'my $q = $dbh->{fred}' ;
+ok(16, $@ =~ /^DB_File::RECNOINFO::FETCH - Unknown element 'fred' at/ );
+
+# Now check the interface to RECNOINFO
+
+my $X  ;
+my @h ;
+ok(17, $X = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
+
+ok(18, ((stat($Dfile))[2] & 0777) == ($^O eq 'os2' ? 0666 : 0640)
+       ||  $^O eq 'MSWin32' ||  $^O eq 'NetWare' || $^O eq 'amigaos') ;
+
+#my $l = @h ;
+my $l = $X->length ;
+ok(19, ($FA ? @h == 0 : !$l) );
+
+my @data = qw( a b c d ever f g h  i j k longername m n o p) ;
+
+$h[0] = shift @data ;
+ok(20, $h[0] eq 'a' );
+
+my $ i;
+foreach (@data)
+  { $h[++$i] = $_ }
+
+unshift (@data, 'a') ;
+
+ok(21, defined $h[1] );
+ok(22, ! defined $h[16] );
+ok(23, $FA ? @h == @data : $X->length == @data );
+
+
+# Overwrite an entry & check fetch it
+$h[3] = 'replaced' ;
+$data[3] = 'replaced' ;
+ok(24, $h[3] eq 'replaced' );
+
+#PUSH
+my @push_data = qw(added to the end) ;
+($FA ? push(@h, @push_data) : $X->push(@push_data)) ;
+push (@data, @push_data) ;
+ok(25, $h[++$i] eq 'added' );
+ok(26, $h[++$i] eq 'to' );
+ok(27, $h[++$i] eq 'the' );
+ok(28, $h[++$i] eq 'end' );
+
+# POP
+my $popped = pop (@data) ;
+my $value = ($FA ? pop @h : $X->pop) ;
+ok(29, $value eq $popped) ;
+
+# SHIFT
+$value = ($FA ? shift @h : $X->shift) ;
+my $shifted = shift @data ;
+ok(30, $value eq $shifted );
+
+# UNSHIFT
+
+# empty list
+($FA ? unshift @h,() : $X->unshift) ;
+ok(31, ($FA ? @h == @data : $X->length == @data ));
+
+my @new_data = qw(add this to the start of the array) ;
+$FA ? unshift (@h, @new_data) : $X->unshift (@new_data) ;
+unshift (@data, @new_data) ;
+ok(32, $FA ? @h == @data : $X->length == @data );
+ok(33, $h[0] eq "add") ;
+ok(34, $h[1] eq "this") ;
+ok(35, $h[2] eq "to") ;
+ok(36, $h[3] eq "the") ;
+ok(37, $h[4] eq "start") ;
+ok(38, $h[5] eq "of") ;
+ok(39, $h[6] eq "the") ;
+ok(40, $h[7] eq "array") ;
+ok(41, $h[8] eq $data[8]) ;
+
+# SPLICE
+
+# Now both arrays should be identical
+
+my $ok = 1 ;
+my $j = 0 ;
+foreach (@data)
+{
+   $ok = 0, last if $_ ne $h[$j ++] ; 
+}
+ok(42, $ok );
+
+# Neagtive subscripts
+
+# get the last element of the array
+ok(43, $h[-1] eq $data[-1] );
+ok(44, $h[-1] eq $h[ ($FA ? @h : $X->length) -1] );
+
+# get the first element using a negative subscript
+eval '$h[ - ( $FA ? @h : $X->length)] = "abcd"' ;
+ok(45, $@ eq "" );
+ok(46, $h[0] eq "abcd" );
+
+# now try to read before the start of the array
+eval '$h[ - (1 + ($FA ? @h : $X->length))] = 1234' ;
+ok(47, $@ =~ '^Modification of non-creatable array value attempted' );
+
+# IMPORTANT - $X must be undefined before the untie otherwise the
+#             underlying DB close routine will not get called.
+undef $X ;
+untie(@h);
+
+unlink $Dfile;
+
+
+{
+    # Check bval defaults to \n
+
+    my @h = () ;
+    my $dbh = new DB_File::RECNOINFO ;
+    ok(48, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[3] = "ghi" ;
+    untie @h ;
+    my $x = docat($Dfile) ;
+    unlink $Dfile;
+    ok(49, $x eq "abc\ndef\n\nghi\n") ;
+}
+
+{
+    # Change bval
+
+    my @h = () ;
+    my $dbh = new DB_File::RECNOINFO ;
+    $dbh->{bval} = "-" ;
+    ok(50, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[3] = "ghi" ;
+    untie @h ;
+    my $x = docat($Dfile) ;
+    unlink $Dfile;
+    my $ok = ($x eq "abc-def--ghi-") ;
+    bad_one() unless $ok ;
+    ok(51, $ok) ;
+}
+
+{
+    # Check R_FIXEDLEN with default bval (space)
+
+    my @h = () ;
+    my $dbh = new DB_File::RECNOINFO ;
+    $dbh->{flags} = R_FIXEDLEN ;
+    $dbh->{reclen} = 5 ;
+    ok(52, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[3] = "ghi" ;
+    untie @h ;
+    my $x = docat($Dfile) ;
+    unlink $Dfile;
+    my $ok = ($x eq "abc  def       ghi  ") ;
+    bad_one() unless $ok ;
+    ok(53, $ok) ;
+}
+
+{
+    # Check R_FIXEDLEN with user-defined bval
+
+    my @h = () ;
+    my $dbh = new DB_File::RECNOINFO ;
+    $dbh->{flags} = R_FIXEDLEN ;
+    $dbh->{bval} = "-" ;
+    $dbh->{reclen} = 5 ;
+    ok(54, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[3] = "ghi" ;
+    untie @h ;
+    my $x = docat($Dfile) ;
+    unlink $Dfile;
+    my $ok = ($x eq "abc--def-------ghi--") ;
+    bad_one() unless $ok ;
+    ok(55, $ok) ;
+}
+
+{
+    # check that attempting to tie an associative array to a DB_RECNO will fail
+
+    my $filename = "xyz" ;
+    my %x ;
+    eval { tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_RECNO ; } ;
+    ok(56, $@ =~ /^DB_File can only tie an array to a DB_RECNO database/) ;
+    unlink $filename ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use warnings ;
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use warnings ;
+   use strict ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use DB_File;
+   @ISA=qw(DB_File);
+   @EXPORT = @DB_File::EXPORT ;
+
+   sub STORE { 
+       my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+       my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub put { 
+       my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::put($key, $value * 3) ;
+   }
+
+   sub get { 
+       my $self = shift ;
+        $self->SUPER::get($_[0], $_[1]) ;
+       $_[1] -= 2 ;
+   }
+
+   sub A_new_method
+   {
+       my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+       return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; } 
+    eval 'use SubDB ; ';
+    main::ok(57, $@ eq "") ;
+    my @h ;
+    my $X ;
+    eval '
+       $X = tie(@h, "SubDB","recno.tmp", O_RDWR|O_CREAT, 0640, $DB_RECNO );
+       ' ;
+
+    main::ok(58, $@ eq "") ;
+
+    my $ret = eval '$h[3] = 3 ; return $h[3] ' ;
+    main::ok(59, $@ eq "") ;
+    main::ok(60, $ret == 5) ;
+
+    my $value = 0;
+    $ret = eval '$X->put(1, 4) ; $X->get(1, $value) ; return $value' ;
+    main::ok(61, $@ eq "") ;
+    main::ok(62, $ret == 10) ;
+
+    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
+    main::ok(63, $@ eq "" ) ;
+    main::ok(64, $ret == 1) ;
+
+    $ret = eval '$X->A_new_method(1) ' ;
+    main::ok(65, $@ eq "") ;
+    main::ok(66, $ret eq "[[11]]") ;
+
+    undef $X;
+    untie(@h);
+    unlink "SubDB.pm", "recno.tmp" ;
+
+}
+
+{
+
+    # test $#
+    my $self ;
+    unlink $Dfile;
+    ok(67, $self = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[2] = "ghi" ;
+    $h[3] = "jkl" ;
+    ok(68, $FA ? $#h == 3 : $self->length() == 4) ;
+    undef $self ;
+    untie @h ;
+    my $x = docat($Dfile) ;
+    ok(69, $x eq "abc\ndef\nghi\njkl\n") ;
+
+    # $# sets array to same length
+    ok(70, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
+    if ($FA)
+      { $#h = 3 }
+    else 
+      { $self->STORESIZE(4) }
+    ok(71, $FA ? $#h == 3 : $self->length() == 4) ;
+    undef $self ;
+    untie @h ;
+    $x = docat($Dfile) ;
+    ok(72, $x eq "abc\ndef\nghi\njkl\n") ;
+
+    # $# sets array to bigger
+    ok(73, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
+    if ($FA)
+      { $#h = 6 }
+    else 
+      { $self->STORESIZE(7) }
+    ok(74, $FA ? $#h == 6 : $self->length() == 7) ;
+    undef $self ;
+    untie @h ;
+    $x = docat($Dfile) ;
+    ok(75, $x eq "abc\ndef\nghi\njkl\n\n\n\n") ;
+
+    # $# sets array smaller
+    ok(76, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
+    if ($FA)
+      { $#h = 2 }
+    else 
+      { $self->STORESIZE(3) }
+    ok(77, $FA ? $#h == 2 : $self->length() == 3) ;
+    undef $self ;
+    untie @h ;
+    $x = docat($Dfile) ;
+    ok(78, $x eq "abc\ndef\nghi\n") ;
+
+    unlink $Dfile;
+
+
+}
+
+{
+   # DBM Filter tests
+   use warnings ;
+   use strict ;
+   my (@h, $db) ;
+   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   unlink $Dfile;
+
+   sub checkOutput
+   {
+       my($fk, $sk, $fv, $sv) = @_ ;
+       return
+           $fetch_key eq $fk && $store_key eq $sk && 
+          $fetch_value eq $fv && $store_value eq $sv &&
+          $_ eq 'original' ;
+   }
+   
+   ok(79, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) );
+
+   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
+   $db->filter_store_key   (sub { $store_key = $_ }) ;
+   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
+   $db->filter_store_value (sub { $store_value = $_ }) ;
+
+   $_ = "original" ;
+
+   $h[0] = "joe" ;
+   #                   fk   sk     fv   sv
+   ok(80, checkOutput( "", 0, "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(81, $h[0] eq "joe");
+   #                   fk  sk  fv    sv
+   ok(82, checkOutput( "", 0, "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(83, $db->FIRSTKEY() == 0) ;
+   #                    fk     sk  fv  sv
+   ok(84, checkOutput( 0, "", "", "")) ;
+
+   # replace the filters, but remember the previous set
+   my ($old_fk) = $db->filter_fetch_key   
+                       (sub { ++ $_ ; $fetch_key = $_ }) ;
+   my ($old_sk) = $db->filter_store_key   
+                       (sub { $_ *= 2 ; $store_key = $_ }) ;
+   my ($old_fv) = $db->filter_fetch_value 
+                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
+   my ($old_sv) = $db->filter_store_value 
+                       (sub { s/o/x/g; $store_value = $_ }) ;
+   
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h[1] = "Joe" ;
+   #                   fk   sk     fv    sv
+   ok(85, checkOutput( "", 2, "", "Jxe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(86, $h[1] eq "[Jxe]");
+   #                   fk   sk     fv    sv
+   ok(87, checkOutput( "", 2, "[Jxe]", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(88, $db->FIRSTKEY() == 1) ;
+   #                   fk   sk     fv    sv
+   ok(89, checkOutput( 1, "", "", "")) ;
+   
+   # put the original filters back
+   $db->filter_fetch_key   ($old_fk);
+   $db->filter_store_key   ($old_sk);
+   $db->filter_fetch_value ($old_fv);
+   $db->filter_store_value ($old_sv);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h[0] = "joe" ;
+   ok(90, checkOutput( "", 0, "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(91, $h[0] eq "joe");
+   ok(92, checkOutput( "", 0, "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(93, $db->FIRSTKEY() == 0) ;
+   ok(94, checkOutput( 0, "", "", "")) ;
+
+   # delete the filters
+   $db->filter_fetch_key   (undef);
+   $db->filter_store_key   (undef);
+   $db->filter_fetch_value (undef);
+   $db->filter_store_value (undef);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h[0] = "joe" ;
+   ok(95, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(96, $h[0] eq "joe");
+   ok(97, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(98, $db->FIRSTKEY() == 0) ;
+   ok(99, checkOutput( "", "", "", "")) ;
+
+   undef $db ;
+   untie @h;
+   unlink $Dfile;
+}
+
+{    
+    # DBM Filter with a closure
+
+    use warnings ;
+    use strict ;
+    my (@h, $db) ;
+
+    unlink $Dfile;
+    ok(100, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) );
+
+    my %result = () ;
+
+    sub Closure
+    {
+        my ($name) = @_ ;
+       my $count = 0 ;
+       my @kept = () ;
+
+       return sub { ++$count ; 
+                    push @kept, $_ ; 
+                    $result{$name} = "$name - $count: [@kept]" ;
+                  }
+    }
+
+    $db->filter_store_key(Closure("store key")) ;
+    $db->filter_store_value(Closure("store value")) ;
+    $db->filter_fetch_key(Closure("fetch key")) ;
+    $db->filter_fetch_value(Closure("fetch value")) ;
+
+    $_ = "original" ;
+
+    $h[0] = "joe" ;
+    ok(101, $result{"store key"} eq "store key - 1: [0]");
+    ok(102, $result{"store value"} eq "store value - 1: [joe]");
+    ok(103, ! defined $result{"fetch key"} );
+    ok(104, ! defined $result{"fetch value"} );
+    ok(105, $_ eq "original") ;
+
+    ok(106, $db->FIRSTKEY() == 0 ) ;
+    ok(107, $result{"store key"} eq "store key - 1: [0]");
+    ok(108, $result{"store value"} eq "store value - 1: [joe]");
+    ok(109, $result{"fetch key"} eq "fetch key - 1: [0]");
+    ok(110, ! defined $result{"fetch value"} );
+    ok(111, $_ eq "original") ;
+
+    $h[7]  = "john" ;
+    ok(112, $result{"store key"} eq "store key - 2: [0 7]");
+    ok(113, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(114, $result{"fetch key"} eq "fetch key - 1: [0]");
+    ok(115, ! defined $result{"fetch value"} );
+    ok(116, $_ eq "original") ;
+
+    ok(117, $h[0] eq "joe");
+    ok(118, $result{"store key"} eq "store key - 3: [0 7 0]");
+    ok(119, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(120, $result{"fetch key"} eq "fetch key - 1: [0]");
+    ok(121, $result{"fetch value"} eq "fetch value - 1: [joe]");
+    ok(122, $_ eq "original") ;
+
+    undef $db ;
+    untie @h;
+    unlink $Dfile;
+}              
+
+{
+   # DBM Filter recursion detection
+   use warnings ;
+   use strict ;
+   my (@h, $db) ;
+   unlink $Dfile;
+
+   ok(123, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) );
+
+   $db->filter_store_key (sub { $_ = $h[0] }) ;
+
+   eval '$h[1] = 1234' ;
+   ok(124, $@ =~ /^recursion detected in filter_store_key at/ );
+   
+   undef $db ;
+   untie @h;
+   unlink $Dfile;
+}
+
+
+{
+   # Examples from the POD
+
+  my $file = "xyzt" ;
+  {
+    my $redirect = new Redirect $file ;
+
+    use warnings FATAL => qw(all);
+    use strict ;
+    use DB_File ;
+
+    my $filename = "text" ;
+    unlink $filename ;
+
+    my @h ;
+    my $x = tie @h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_RECNO 
+        or die "Cannot open file 'text': $!\n" ;
+
+    # Add a few key/value pairs to the file
+    $h[0] = "orange" ;
+    $h[1] = "blue" ;
+    $h[2] = "yellow" ;
+
+    $FA ? push @h, "green", "black" 
+        : $x->push("green", "black") ;
+
+    my $elements = $FA ? scalar @h : $x->length ;
+    print "The array contains $elements entries\n" ;
+
+    my $last = $FA ? pop @h : $x->pop ;
+    print "popped $last\n" ;
+
+    $FA ? unshift @h, "white" 
+        : $x->unshift("white") ;
+    my $first = $FA ? shift @h : $x->shift ;
+    print "shifted $first\n" ;
+
+    # Check for existence of a key
+    print "Element 1 Exists with value $h[1]\n" if $h[1] ;
+
+    # use a negative index
+    print "The last element is $h[-1]\n" ;
+    print "The 2nd last element is $h[-2]\n" ;
+
+    undef $x ;
+    untie @h ;
+
+    unlink $filename ;
+  }  
+
+  ok(125, docat_del($file) eq <<'EOM') ;
+The array contains 5 entries
+popped black
+shifted white
+Element 1 Exists with value blue
+The last element is green
+The 2nd last element is yellow
+EOM
+
+  my $save_output = "xyzt" ;
+  {
+    my $redirect = new Redirect $save_output ;
+
+    use warnings FATAL => qw(all);
+    use strict ;
+    use vars qw(@h $H $file $i) ;
+    use DB_File ;
+    use Fcntl ;
+    
+    $file = "text" ;
+
+    unlink $file ;
+
+    $H = tie @h, "DB_File", $file, O_RDWR|O_CREAT, 0640, $DB_RECNO 
+        or die "Cannot open file $file: $!\n" ;
+    
+    # first create a text file to play with
+    $h[0] = "zero" ;
+    $h[1] = "one" ;
+    $h[2] = "two" ;
+    $h[3] = "three" ;
+    $h[4] = "four" ;
+
+    
+    # Print the records in order.
+    #
+    # The length method is needed here because evaluating a tied
+    # array in a scalar context does not return the number of
+    # elements in the array.  
+
+    print "\nORIGINAL\n" ;
+    foreach $i (0 .. $H->length - 1) {
+        print "$i: $h[$i]\n" ;
+    }
+
+    # use the push & pop methods
+    $a = $H->pop ;
+    $H->push("last") ;
+    print "\nThe last record was [$a]\n" ;
+
+    # and the shift & unshift methods
+    $a = $H->shift ;
+    $H->unshift("first") ;
+    print "The first record was [$a]\n" ;
+
+    # Use the API to add a new record after record 2.
+    $i = 2 ;
+    $H->put($i, "Newbie", R_IAFTER) ;
+
+    # and a new record before record 1.
+    $i = 1 ;
+    $H->put($i, "New One", R_IBEFORE) ;
+
+    # delete record 3
+    $H->del(3) ;
+
+    # now print the records in reverse order
+    print "\nREVERSE\n" ;
+    for ($i = $H->length - 1 ; $i >= 0 ; -- $i)
+      { print "$i: $h[$i]\n" }
+
+    # same again, but use the API functions instead
+    print "\nREVERSE again\n" ;
+    my ($s, $k, $v)  = (0, 0, 0) ;
+    for ($s = $H->seq($k, $v, R_LAST) ; 
+             $s == 0 ; 
+             $s = $H->seq($k, $v, R_PREV))
+      { print "$k: $v\n" }
+
+    undef $H ;
+    untie @h ;    
+
+    unlink $file ;
+  }  
+
+  ok(126, docat_del($save_output) eq <<'EOM') ;
+
+ORIGINAL
+0: zero
+1: one
+2: two
+3: three
+4: four
+
+The last record was [four]
+The first record was [zero]
+
+REVERSE
+5: last
+4: three
+3: Newbie
+2: one
+1: New One
+0: first
+
+REVERSE again
+5: last
+4: three
+3: Newbie
+2: one
+1: New One
+0: first
+EOM
+   
+}
+
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use DB_File ;
+
+    unlink $Dfile;
+    my @h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO 
+       or die "Can't open file: $!\n" ;
+    $h[0] = undef;
+    ok(127, $a eq "") ;
+    untie @h ;
+    unlink $Dfile;
+}
+
+{
+    # test that %hash = () doesn't produce the warning
+    #     Argument "" isn't numeric in entersub
+    use warnings ;
+    use strict ;
+    use DB_File ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+
+    unlink $Dfile;
+    my @h ;
+    
+    tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO 
+       or die "Can't open file: $!\n" ;
+    @h = (); ;
+    ok(128, $a eq "") ;
+    untie @h ;
+    unlink $Dfile;
+}
+
+exit ;

diff --git a/ext/Data/Dumper/t/dumper.t b/ext/Data/Dumper/t/dumper.t
new file mode 100755 (executable)
index 0000000..10add1c
--- /dev/null
+++ b/ext/Data/Dumper/t/dumper.t
@@ -0,0 +1,810 @@
+#!./perl -w
+#
+# testsuite for Data::Dumper
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
+      print "1..0 # Skip: Data::Dumper was not built\n";
+      exit 0;
+    }
+}
+
+use Data::Dumper;
+use Config;
+my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
+
+$Data::Dumper::Pad = "#";
+my $TMAX;
+my $XS;
+my $TNUM = 0;
+my $WANT = '';
+
+sub TEST {
+  my $string = shift;
+  my $t = eval $string;
+  ++$TNUM;
+  $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
+      if ($WANT =~ /deadbeef/);
+  if ($Is_ebcdic) {
+      # these data need massaging with non ascii character sets
+      # because of hashing order differences
+      $WANT = join("\n",sort(split(/\n/,$WANT)));
+      $WANT =~ s/\,$//mg;
+      $t    = join("\n",sort(split(/\n/,$t)));
+      $t    =~ s/\,$//mg;
+  }
+  print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
+       : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
+
+  ++$TNUM;
+  eval "$t";
+  print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n";
+
+  $t = eval $string;
+  ++$TNUM;
+  $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
+      if ($WANT =~ /deadbeef/);
+  if ($Is_ebcdic) {
+      # here too there are hashing order differences
+      $WANT = join("\n",sort(split(/\n/,$WANT)));
+      $WANT =~ s/\,$//mg;
+      $t    = join("\n",sort(split(/\n/,$t)));
+      $t    =~ s/\,$//mg;
+  }
+  print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
+       : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
+}
+
+if (defined &Data::Dumper::Dumpxs) {
+  print "### XS extension loaded, will run XS tests\n";
+  $TMAX = 186; $XS = 1;
+}
+else {
+  print "### XS extensions not loaded, will NOT run XS tests\n";
+  $TMAX = 93; $XS = 0;
+}
+
+print "1..$TMAX\n";
+
+#############
+#############
+
+@c = ('c');
+$c = \@c;
+$b = {};
+$a = [1, $b, $c];
+$b->{a} = $a;
+$b->{b} = $a->[1];
+$b->{c} = $a->[2];
+
+############# 1
+##
+$WANT = <<'EOT';
+#$a = [
+#       1,
+#       {
+#         'c' => [
+#                  'c'
+#                ],
+#         'a' => $a,
+#         'b' => $a->[1]
+#       },
+#       $a->[1]{'c'}
+#     ];
+#$b = $a->[1];
+#$c = $a->[1]{'c'};
+EOT
+
+TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]));
+TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b c)])) if $XS;
+
+
+############# 7
+##
+$WANT = <<'EOT';
+#@a = (
+#       1,
+#       {
+#         'c' => [
+#                  'c'
+#                ],
+#         'a' => [],
+#         'b' => {}
+#       },
+#       []
+#     );
+#$a[1]{'a'} = \@a;
+#$a[1]{'b'} = $a[1];
+#$a[2] = $a[1]{'c'};
+#$b = $a[1];
+EOT
+
+$Data::Dumper::Purity = 1;         # fill in the holes for eval
+TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
+TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
+
+############# 13
+##
+$WANT = <<'EOT';
+#%b = (
+#       'c' => [
+#                'c'
+#              ],
+#       'a' => [
+#                1,
+#                {},
+#                []
+#              ],
+#       'b' => {}
+#     );
+#$b{'a'}[1] = \%b;
+#$b{'a'}[2] = $b{'c'};
+#$b{'b'} = \%b;
+#$a = $b{'a'};
+EOT
+
+TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
+TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
+
+############# 19
+##
+$WANT = <<'EOT';
+#$a = [
+#  1,
+#  {
+#    'c' => [],
+#    'a' => [],
+#    'b' => {}
+#  },
+#  []
+#];
+#$a->[1]{'c'} = \@c;
+#$a->[1]{'a'} = $a;
+#$a->[1]{'b'} = $a->[1];
+#$a->[2] = \@c;
+#$b = $a->[1];
+EOT
+
+$Data::Dumper::Indent = 1;
+TEST q(
+       $d = Data::Dumper->new([$a,$b], [qw(a b)]);
+       $d->Seen({'*c' => $c});
+       $d->Dump;
+      );
+if ($XS) {
+  TEST q(
+        $d = Data::Dumper->new([$a,$b], [qw(a b)]);
+        $d->Seen({'*c' => $c});
+        $d->Dumpxs;
+       );
+}
+
+
+############# 25
+##
+$WANT = <<'EOT';
+#$a = [
+#       #0
+#       1,
+#       #1
+#       {
+#         c => [
+#                #0
+#                'c'
+#              ],
+#         a => $a,
+#         b => $a->[1]
+#       },
+#       #2
+#       $a->[1]{c}
+#     ];
+#$b = $a->[1];
+EOT
+
+$d->Indent(3);
+$d->Purity(0)->Quotekeys(0);
+TEST q( $d->Reset; $d->Dump );
+
+TEST q( $d->Reset; $d->Dumpxs ) if $XS;
+
+############# 31
+##
+$WANT = <<'EOT';
+#$VAR1 = [
+#  1,
+#  {
+#    'c' => [
+#      'c'
+#    ],
+#    'a' => [],
+#    'b' => {}
+#  },
+#  []
+#];
+#$VAR1->[1]{'a'} = $VAR1;
+#$VAR1->[1]{'b'} = $VAR1->[1];
+#$VAR1->[2] = $VAR1->[1]{'c'};
+EOT
+
+TEST q(Dumper($a));
+TEST q(Data::Dumper::DumperX($a)) if $XS;
+
+############# 37
+##
+$WANT = <<'EOT';
+#[
+#  1,
+#  {
+#    c => [
+#      'c'
+#    ],
+#    a => $VAR1,
+#    b => $VAR1->[1]
+#  },
+#  $VAR1->[1]{c}
+#]
+EOT
+
+{
+  local $Data::Dumper::Purity = 0;
+  local $Data::Dumper::Quotekeys = 0;
+  local $Data::Dumper::Terse = 1;
+  TEST q(Dumper($a));
+  TEST q(Data::Dumper::DumperX($a)) if $XS;
+}
+
+
+############# 43
+##
+$WANT = <<'EOT';
+#$VAR1 = {
+#  "reftest" => \\1,
+#  "abc\0'\efg" => "mno\0"
+#};
+EOT
+
+$foo = { "abc\000\'\efg" => "mno\000",
+         "reftest" => \\1,
+       };
+{
+  local $Data::Dumper::Useqq = 1;
+  TEST q(Dumper($foo));
+}
+
+  $WANT = <<"EOT";
+#\$VAR1 = {
+#  'reftest' => \\\\1,
+#  'abc\0\\'\efg' => 'mno\0'
+#};
+EOT
+
+  {
+    local $Data::Dumper::Useqq = 1;
+    TEST q(Data::Dumper::DumperX($foo)) if $XS;   # cheat
+  }
+
+
+
+#############
+#############
+
+{
+  package main;
+  use Data::Dumper;
+  $foo = 5;
+  @foo = (-10,\*foo);
+  %foo = (a=>1,b=>\$foo,c=>\@foo);
+  $foo{d} = \%foo;
+  $foo[2] = \%foo;
+
+############# 49
+##
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#*::foo = \5;
+#*::foo = [
+#           #0
+#           -10,
+#           #1
+#           do{my $o},
+#           #2
+#           {
+#             'c' => [],
+#             'a' => 1,
+#             'b' => do{my $o},
+#             'd' => {}
+#           }
+#         ];
+#*::foo{ARRAY}->[1] = $foo;
+#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
+#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
+#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
+#*::foo = *::foo{ARRAY}->[2];
+#@bar = @{*::foo{ARRAY}};
+#%baz = %{*::foo{ARRAY}->[2]};
+EOT
+
+  $Data::Dumper::Purity = 1;
+  $Data::Dumper::Indent = 3;
+  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
+  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
+
+############# 55
+##
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#*::foo = \5;
+#*::foo = [
+#  -10,
+#  do{my $o},
+#  {
+#    'c' => [],
+#    'a' => 1,
+#    'b' => do{my $o},
+#    'd' => {}
+#  }
+#];
+#*::foo{ARRAY}->[1] = $foo;
+#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
+#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
+#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
+#*::foo = *::foo{ARRAY}->[2];
+#$bar = *::foo{ARRAY};
+#$baz = *::foo{ARRAY}->[2];
+EOT
+
+  $Data::Dumper::Indent = 1;
+  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
+  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
+
+############# 61
+##
+  $WANT = <<'EOT';
+#@bar = (
+#  -10,
+#  \*::foo,
+#  {}
+#);
+#*::foo = \5;
+#*::foo = \@bar;
+#*::foo = {
+#  'c' => [],
+#  'a' => 1,
+#  'b' => do{my $o},
+#  'd' => {}
+#};
+#*::foo{HASH}->{'c'} = \@bar;
+#*::foo{HASH}->{'b'} = *::foo{SCALAR};
+#*::foo{HASH}->{'d'} = *::foo{HASH};
+#$bar[2] = *::foo{HASH};
+#%baz = %{*::foo{HASH}};
+#$foo = $bar[1];
+EOT
+
+  TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
+  TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
+
+############# 67
+##
+  $WANT = <<'EOT';
+#$bar = [
+#  -10,
+#  \*::foo,
+#  {}
+#];
+#*::foo = \5;
+#*::foo = $bar;
+#*::foo = {
+#  'c' => [],
+#  'a' => 1,
+#  'b' => do{my $o},
+#  'd' => {}
+#};
+#*::foo{HASH}->{'c'} = $bar;
+#*::foo{HASH}->{'b'} = *::foo{SCALAR};
+#*::foo{HASH}->{'d'} = *::foo{HASH};
+#$bar->[2] = *::foo{HASH};
+#$baz = *::foo{HASH};
+#$foo = $bar->[1];
+EOT
+
+  TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
+  TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
+
+############# 73
+##
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#@bar = (
+#  -10,
+#  $foo,
+#  {
+#    c => \@bar,
+#    a => 1,
+#    b => \5,
+#    d => $bar[2]
+#  }
+#);
+#%baz = %{$bar[2]};
+EOT
+
+  $Data::Dumper::Purity = 0;
+  $Data::Dumper::Quotekeys = 0;
+  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
+  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
+
+############# 79
+##
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#$bar = [
+#  -10,
+#  $foo,
+#  {
+#    c => $bar,
+#    a => 1,
+#    b => \5,
+#    d => $bar->[2]
+#  }
+#];
+#$baz = $bar->[2];
+EOT
+
+  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
+  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
+
+}
+
+#############
+#############
+{
+  package main;
+  @dogs = ( 'Fido', 'Wags' );
+  %kennel = (
+            First => \$dogs[0],
+            Second =>  \$dogs[1],
+           );
+  $dogs[2] = \%kennel;
+  $mutts = \%kennel;
+  $mutts = $mutts;         # avoid warning
+  
+############# 85
+##
+  $WANT = <<'EOT';
+#%kennels = (
+#  Second => \'Wags',
+#  First => \'Fido'
+#);
+#@dogs = (
+#  ${$kennels{First}},
+#  ${$kennels{Second}},
+#  \%kennels
+#);
+#%mutts = %kennels;
+EOT
+
+  TEST q(
+        $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
+                               [qw(*kennels *dogs *mutts)] );
+        $d->Dump;
+       );
+  if ($XS) {
+    TEST q(
+          $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
+                                 [qw(*kennels *dogs *mutts)] );
+          $d->Dumpxs;
+         );
+  }
+  
+############# 91
+##
+  $WANT = <<'EOT';
+#%kennels = %kennels;
+#@dogs = @dogs;
+#%mutts = %kennels;
+EOT
+
+  TEST q($d->Dump);
+  TEST q($d->Dumpxs) if $XS;
+  
+############# 97
+##
+  $WANT = <<'EOT';
+#%kennels = (
+#  Second => \'Wags',
+#  First => \'Fido'
+#);
+#@dogs = (
+#  ${$kennels{First}},
+#  ${$kennels{Second}},
+#  \%kennels
+#);
+#%mutts = %kennels;
+EOT
+
+  
+  TEST q($d->Reset; $d->Dump);
+  if ($XS) {
+    TEST q($d->Reset; $d->Dumpxs);
+  }
+
+############# 103
+##
+  $WANT = <<'EOT';
+#@dogs = (
+#  'Fido',
+#  'Wags',
+#  {
+#    Second => \$dogs[1],
+#    First => \$dogs[0]
+#  }
+#);
+#%kennels = %{$dogs[2]};
+#%mutts = %{$dogs[2]};
+EOT
+
+  TEST q(
+        $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
+                               [qw(*dogs *kennels *mutts)] );
+        $d->Dump;
+       );
+  if ($XS) {
+    TEST q(
+          $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
+                                 [qw(*dogs *kennels *mutts)] );
+          $d->Dumpxs;
+         );
+  }
+  
+############# 109
+##
+  TEST q($d->Reset->Dump);
+  if ($XS) {
+    TEST q($d->Reset->Dumpxs);
+  }
+
+############# 115
+##
+  $WANT = <<'EOT';
+#@dogs = (
+#  'Fido',
+#  'Wags',
+#  {
+#    Second => \'Wags',
+#    First => \'Fido'
+#  }
+#);
+#%kennels = (
+#  Second => \'Wags',
+#  First => \'Fido'
+#);
+EOT
+
+  TEST q(
+        $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
+        $d->Deepcopy(1)->Dump;
+       );
+  if ($XS) {
+    TEST q($d->Reset->Dumpxs);
+  }
+  
+}
+
+{
+
+sub z { print "foo\n" }
+$c = [ \&z ];
+
+############# 121
+##
+  $WANT = <<'EOT';
+#$a = $b;
+#$c = [
+#  $b
+#];
+EOT
+
+TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;);
+TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;)
+       if $XS;
+
+############# 127
+##
+  $WANT = <<'EOT';
+#$a = \&b;
+#$c = [
+#  \&b
+#];
+EOT
+
+TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;);
+TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;)
+       if $XS;
+
+############# 133
+##
+  $WANT = <<'EOT';
+#*a = \&b;
+#@c = (
+#  \&b
+#);
+EOT
+
+TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;);
+TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
+       if $XS;
+
+}
+
+{
+  $a = [];
+  $a->[1] = \$a->[0];
+
+############# 139
+##
+  $WANT = <<'EOT';
+#@a = (
+#  undef,
+#  do{my $o}
+#);
+#$a[1] = \$a[0];
+EOT
+
+TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;);
+TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;)
+       if $XS;
+}
+
+{
+  $a = \\\\\'foo';
+  $b = $$$a;
+
+############# 145
+##
+  $WANT = <<'EOT';
+#$a = \\\\\'foo';
+#$b = ${${$a}};
+EOT
+
+TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
+TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
+       if $XS;
+}
+
+{
+  $a = [{ a => \$b }, { b => undef }];
+  $b = [{ c => \$b }, { d => \$a }];
+
+############# 151
+##
+  $WANT = <<'EOT';
+#$a = [
+#  {
+#    a => \[
+#        {
+#          c => do{my $o}
+#        },
+#        {
+#          d => \[]
+#        }
+#      ]
+#  },
+#  {
+#    b => undef
+#  }
+#];
+#${$a->[0]{a}}->[0]->{c} = $a->[0]{a};
+#${${$a->[0]{a}}->[1]->{d}} = $a;
+#$b = ${$a->[0]{a}};
+EOT
+
+TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
+TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
+       if $XS;
+}
+
+{
+  $a = [[[[\\\\\'foo']]]];
+  $b = $a->[0][0];
+  $c = $${$b->[0][0]};
+
+############# 157
+##
+  $WANT = <<'EOT';
+#$a = [
+#  [
+#    [
+#      [
+#        \\\\\'foo'
+#      ]
+#    ]
+#  ]
+#];
+#$b = $a->[0][0];
+#$c = ${${$a->[0][0][0][0]}};
+EOT
+
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
+       if $XS;
+}
+
+{
+    $f = "pearl";
+    $e = [        $f ];
+    $d = { 'e' => $e };
+    $c = [        $d ];
+    $b = { 'c' => $c };
+    $a = { 'b' => $b };
+
+############# 163
+##
+  $WANT = <<'EOT';
+#$a = {
+#  b => {
+#    c => [
+#      {
+#        e => 'ARRAY(0xdeadbeef)'
+#      }
+#    ]
+#  }
+#};
+#$b = $a->{b};
+#$c = $a->{b}{c};
+EOT
+
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;);
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;)
+       if $XS;
+
+############# 169
+##
+  $WANT = <<'EOT';
+#$a = {
+#  b => 'HASH(0xdeadbeef)'
+#};
+#$b = $a->{b};
+#$c = [
+#  'HASH(0xdeadbeef)'
+#];
+EOT
+
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;);
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;)
+       if $XS;
+}
+
+{
+    $a = \$a;
+    $b = [$a];
+
+############# 175
+##
+  $WANT = <<'EOT';
+#$b = [
+#  \$b->[0]
+#];
+EOT
+
+TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;);
+TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;)
+       if $XS;
+
+############# 181
+##
+  $WANT = <<'EOT';
+#$b = [
+#  \do{my $o}
+#];
+#${$b->[0]} = $b->[0];
+EOT
+
+
+TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;);
+TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;)
+       if $XS;
+}

diff --git a/ext/Data/Dumper/t/overload.t b/ext/Data/Dumper/t/overload.t
new file mode 100755 (executable)
index 0000000..d4b3a92
--- /dev/null
+++ b/ext/Data/Dumper/t/overload.t
@@ -0,0 +1,35 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
+      print "1..0 # Skip: Data::Dumper was not built\n";
+      exit 0;
+    }
+}
+
+use Data::Dumper;
+
+print "1..1\n";
+
+package Foo;
+use overload '""' => 'as_string';
+
+sub new { bless { foo => "bar" }, shift }
+sub as_string { "%%%%" }
+
+package main;
+
+my $f = Foo->new;
+
+print "#\$f=$f\n";
+
+$_ = Dumper($f);
+s/^/#/mg;
+print $_;
+
+print "not " unless /bar/ && /Foo/;
+print "ok 1\n";
+

diff --git a/ext/Devel/Peek/Peek.t b/ext/Devel/Peek/Peek.t
new file mode 100644 (file)
index 0000000..c14dc9b
--- /dev/null
+++ b/ext/Devel/Peek/Peek.t
@@ -0,0 +1,308 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bPeek\b/) {
+        print "1..0 # Skip: Devel::Peek was not built\n";
+        exit 0;
+    }
+}
+
+use Devel::Peek;
+
+print "1..17\n";
+
+our $DEBUG = 0;
+open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
+
+sub do_test {
+    my $pattern = pop;
+    if (open(OUT,">peek$$")) {
+       open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
+       Dump($_[1]);
+       open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
+       close(OUT);
+       if (open(IN, "peek$$")) {
+           local $/;
+           $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
+           print $pattern, "\n" if $DEBUG;
+           my $dump = <IN>;
+           print $dump, "\n"    if $DEBUG;
+           print "[$dump] vs [$pattern]\nnot " unless $dump =~ /$pattern/ms;
+           print "ok $_[0]\n";
+           close(IN);
+       } else {
+           die "$0: failed to open peek$$: !\n";
+       }
+    } else {
+       die "$0: failed to create peek$$: $!\n";
+    }
+}
+
+our   $a;
+our   $b;
+my    $c;
+local $d = 0;
+
+do_test( 1,
+       $a = "foo",
+'SV = PV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(POK,pPOK\\)
+  PV = $ADDR "foo"\\\0
+  CUR = 3
+  LEN = 4'
+       );
+
+do_test( 2,
+        "bar",
+'SV = PV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(.*POK,READONLY,pPOK\\)
+  PV = $ADDR "bar"\\\0
+  CUR = 3
+  LEN = 4');
+
+do_test( 3,
+        $b = 123,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(IOK,pIOK\\)
+  IV = 123');
+
+do_test( 4,
+        456,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(.*IOK,READONLY,pIOK\\)
+  IV = 456');
+
+do_test( 5,
+        $c = 456,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(PADBUSY,PADMY,IOK,pIOK\\)
+  IV = 456');
+
+do_test( 6,
+        $c + $d,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(PADTMP,IOK,pIOK\\)
+  IV = 456');
+
+($d = "789") += 0.1;
+
+do_test( 7,
+       $d,
+'SV = PVNV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(NOK,pNOK\\)
+  IV = 0
+  NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
+  PV = $ADDR "789"\\\0
+  CUR = 3
+  LEN = 4');
+
+do_test( 8,
+        0xabcd,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(.*IOK,READONLY,pIOK\\)
+  IV = 43981');
+
+do_test( 9,
+        undef,
+'SV = NULL\\(0x0\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(\\)');
+
+do_test(10,
+        \$a,
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(POK,pPOK\\)
+    PV = $ADDR "foo"\\\0
+    CUR = 3
+    LEN = 4');
+
+do_test(11,
+       [$b,$c],
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVAV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(\\)
+    IV = 0
+    NV = 0
+    ARRAY = $ADDR
+    FILL = 1
+    MAX = 1
+    ARYLEN = 0x0
+    FLAGS = \\(REAL\\)
+    Elt No. 0
+    SV = IV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(IOK,pIOK\\)
+      IV = 123
+    Elt No. 1
+    SV = IV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(IOK,pIOK\\)
+      IV = 456');
+
+do_test(12,
+       {$b=>$c},
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(SHAREKEYS\\)
+    IV = 1
+    NV = 0
+    ARRAY = $ADDR  \\(0:7, 1:1\\)
+    hash quality = 100.0%
+    KEYS = 1
+    FILL = 1
+    MAX = 7
+    RITER = -1
+    EITER = 0x0
+    Elt "123" HASH = $ADDR
+    SV = IV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(IOK,pIOK\\)
+      IV = 456');
+
+do_test(13,
+        sub(){@_},
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVCV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON\\)
+    IV = 0
+    NV = 0
+    PROTOTYPE = ""
+    COMP_STASH = $ADDR\\t"main"
+    START = $ADDR ===> \\d+
+    ROOT = $ADDR
+    XSUB = 0x0
+    XSUBANY = 0
+    GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
+    FILE = ".*\\b(?i:peek\\.t)"
+    DEPTH = 0
+(?:    MUTEXP = $ADDR
+    OWNER = $ADDR
+)?    FLAGS = 0x4
+    PADLIST = $ADDR
+    OUTSIDE = $ADDR \\(MAIN\\)');
+
+do_test(14,
+        \&do_test,
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVCV\\($ADDR\\) at $ADDR
+    REFCNT = (3|4)
+    FLAGS = \\(\\)
+    IV = 0
+    NV = 0
+    COMP_STASH = $ADDR\\t"main"
+    START = $ADDR ===> \\d+
+    ROOT = $ADDR
+    XSUB = 0x0
+    XSUBANY = 0
+    GVGV::GV = $ADDR\\t"main" :: "do_test"
+    FILE = ".*\\b(?i:peek\\.t)"
+    DEPTH = 1
+(?:    MUTEXP = $ADDR
+    OWNER = $ADDR
+)?    FLAGS = 0x0
+    PADLIST = $ADDR
+      \\d+\\. $ADDR \\("\\$pattern" \\d+-\\d+\\)
+     \\d+\\. $ADDR \\(FAKE "\\$DEBUG" 0-\\d+\\)
+     \\d+\\. $ADDR \\("\\$dump" \\d+-\\d+\\)
+    OUTSIDE = $ADDR \\(MAIN\\)');
+
+do_test(15,
+        qr(tic),
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVMG\\($ADDR\\) at $ADDR
+    REFCNT = 1
+    FLAGS = \\(OBJECT,RMG\\)
+    IV = 0
+    NV = 0
+    PV = 0
+    MAGIC = $ADDR
+      MG_VIRTUAL = $ADDR
+      MG_TYPE = PERL_MAGIC_qr\(r\)
+      MG_OBJ = $ADDR
+    STASH = $ADDR\\t"Regexp"');
+
+do_test(16,
+        (bless {}, "Tac"),
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(OBJECT,SHAREKEYS\\)
+    IV = 0
+    NV = 0
+    STASH = $ADDR\\t"Tac"
+    ARRAY = 0x0
+    KEYS = 0
+    FILL = 0
+    MAX = 7
+    RITER = -1
+    EITER = 0x0');
+
+do_test(17,
+       *a,
+'SV = PVGV\\($ADDR\\) at $ADDR
+  REFCNT = 5
+  FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
+  IV = 0
+  NV = 0
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_glob
+    MG_TYPE = PERL_MAGIC_glob\(\*\)
+    MG_OBJ = $ADDR
+  NAME = "a"
+  NAMELEN = 1
+  GvSTASH = $ADDR\\t"main"
+  GP = $ADDR
+    SV = $ADDR
+    REFCNT = 1
+    IO = 0x0
+    FORM = 0x0  
+    AV = 0x0
+    HV = 0x0
+    CV = 0x0
+    CVGEN = 0x0
+    GPFLAGS = 0x0
+    LINE = \\d+
+    FILE = ".*\\b(?i:peek\\.t)"
+    FLAGS = $ADDR
+    EGV = $ADDR\\t"a"');
+
+END {
+  1 while unlink("peek$$");
+}

diff --git a/ext/Digest/MD5/t/aaa.t b/ext/Digest/MD5/t/aaa.t
new file mode 100644 (file)
index 0000000..f3f3202
--- /dev/null
+++ b/ext/Digest/MD5/t/aaa.t
@@ -0,0 +1,552 @@
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use strict;
+print "1..256\n";
+
+use Digest::MD5 qw(md5_hex);
+
+my $Is_EBCDIC = ord('A') == 193;
+
+my $testno = 0;
+while (<DATA>) {
+    if (!$Is_EBCDIC) {
+       next if /^EBCDIC/;
+    }
+    else {
+       next if !/^EBCDIC/;
+       s/^EBCDIC,\w+#//;
+   }
+   my($hexdigest, $message) = split;
+   $message =~ s/\"//g;
+
+   my $failed;
+   $failed++ unless md5_hex($message) eq $hexdigest;
+   $failed++ unless Digest::MD5->new->add(split(//, $message))->digest
+                                              eq pack("H*", $hexdigest);
+
+   print "not " if $failed;
+   print "ok ", ++$testno, "\n";
+}
+
+
+
+# This data was generated with:
+#
+# perl -e 'for (1..256) { system("md5sum --string=" . ("a" x $_)); }'
+#
+__END__
+0cc175b9c0f1b6a831c399e269772661  "a"
+4124bc0a9335c27f086f24ba207a4912  "aa"
+47bce5c74f589f4867dbd57e9ca9f808  "aaa"
+74b87337454200d4d33f80c4663dc5e5  "aaaa"
+594f803b380a41396ed63dca39503542  "aaaaa"
+0b4e7a0e5fe84ad35fb5f95b9ceeac79  "aaaaaa"
+5d793fc5b00a2348c3fb9ab59e5ca98a  "aaaaaaa"
+3dbe00a167653a1aaee01d93e77e730e  "aaaaaaaa"
+552e6a97297c53e592208cf97fbb3b60  "aaaaaaaaa"
+e09c80c42fda55f9d992e59ca6b3307d  "aaaaaaaaaa"
+d57f21e6a273781dbf8b7657940f3b03  "aaaaaaaaaaa"
+45e4812014d83dde5666ebdf5a8ed1ed  "aaaaaaaaaaaa"
+c162de19c4c3731ca3428769d0cd593d  "aaaaaaaaaaaaa"
+451599a5f9afa91a0f2097040a796f3d  "aaaaaaaaaaaaaa"
+12f9cf6998d52dbe773b06f848bb3608  "aaaaaaaaaaaaaaa"
+23ca472302f49b3ea5592b146a312da0  "aaaaaaaaaaaaaaaa"
+88e42e96cc71151b6e1938a1699b0a27  "aaaaaaaaaaaaaaaaa"
+2c60c24e7087e18e45055a33f9a5be91  "aaaaaaaaaaaaaaaaaa"
+639d76897485360b3147e66e0a8a3d6c  "aaaaaaaaaaaaaaaaaaa"
+22d42eb002cefa81e9ad604ea57bc01d  "aaaaaaaaaaaaaaaaaaaa"
+bd049f221af82804c5a2826809337c9b  "aaaaaaaaaaaaaaaaaaaaa"
+ff49cfac3968dbce26ebe7d4823e58bd  "aaaaaaaaaaaaaaaaaaaaaa"
+d95dbfee231e34cccb8c04444412ed7d  "aaaaaaaaaaaaaaaaaaaaaaa"
+40edae4bad0e5bf6d6c2dc5615a86afb  "aaaaaaaaaaaaaaaaaaaaaaaa"
+a5a8bfa3962f49330227955e24a2e67c  "aaaaaaaaaaaaaaaaaaaaaaaaa"
+ae791f19bdf77357ff10bb6b0e97e121  "aaaaaaaaaaaaaaaaaaaaaaaaaa"
+aaab9c59a88bf0bdfcb170546c5459d6  "aaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b0f0545856af1a340acdedce23c54b97  "aaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+f7ce3d7d44f3342107d884bfa90c966a  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+59e794d45697b360e18ba972bada0123  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+3b0845db57c200be6052466f87b2198a  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+5eca9bd3eb07c006cd43ae48dfde7fd3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b4f13cb081e412f44e99742cb128a1a5  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+4c660346451b8cf91ef50f4634458d41  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+11db24dc3f6c2145701db08625dd6d76  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+80dad3aad8584778352c68ab06250327  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+1227fe415e79db47285cb2689c93963f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+8e084f489f1bdf08c39f98ff6447ce6d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+08b2f2b0864bac1ba1585043362cbec9  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+4697843037d962f62a5a429e611e0f5f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+10c4da18575c092b486f8ab96c01c02f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+af205d729450b663f48b11d839a1c8df  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+0d3f91798fac6ee279ec2485b25f1124  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+4c3c7c067634daec9716a80ea886d123  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+d1e358e6e3b707282cdd06e919f7e08c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+8c6ded4f0af86e0a7e301f8a716c4363  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+4c2d8bcb02d982d7cb77f649c0a2dea8  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+bdb662f765cd310f2a547cab1cfecef6  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+08ff5f7301d30200ab89169f6afdb7af  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+6eb6a030bcce166534b95bc2ab45d9cf  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+1bb77918e5695c944be02c16ae29b25e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b6fe77c19f0f0f4946c761d62585bfea  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+e9e7e260dce84ffa6e0e7eb5fd9d37fc  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+eced9e0b81ef2bba605cbc5e2e76a1d0  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+ef1772b6dff9a122358552954ad0df65  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+3b0c8ac703f828b04c6c197006d17218  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+652b906d60af96844ebd21b674f35e93  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+dc2f2f2462a0d72358b2f99389458606  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+762fc2665994b217c52c3c2eb7d9f406  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+cc7ed669cf88f201c3297c6a91e1d18d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+cced11f7bbbffea2f718903216643648  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+24612f0ce2c9d2cf2b022ef1e027a54f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b06521f39153d618550606be297466d5  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+014842d480b571495a4a0363793f7367  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+c743a45e0d2e6a95cb859adae0248435  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+def5d97e01e1219fb2fc8da6c4d6ba2f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+92cb737f8687ccb93022fdb411a77cca  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+a0d1395c7fb36247bfe2d49376d9d133  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+ab75504250558b788f99d1ebd219abf2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+0f5c6c4e740bfcc08c3c26ccb2673d46  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+cddd19bec7f310d8c87149ef47a1828f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+96b39b8b95e016c79d104d83395b8133  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+f1fc0b14ff8fa674b02344577e23eeb1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+0e8d28a1cafa3ffcff22afd480cce7d8  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+448539ffc17e1e81005b65581855cef4  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+61e39aae7c53e6e77db2e4405d9fb157  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+618a426895ee6133a372bebd1129b63e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+046c90690c9e36578b9d4a7e1d249c75  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+aadab38075c43296ee7e12466ebb03e3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b15af9cdabbaea0516866a33d8fd0f98  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+986e6938ed767a8ae9530eef54bfe5f1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+7ae25a72b71a42ccbc5477fd989cd512  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+98d34e50d4aa7a893cc7919a91acb0e3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+3fc53fc22ea40f1a0afd78fc2cd9aa0f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+923e37c738b9d7b1526f70b65229cc3d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b3966b7a08e5d46fd0774b797ba78dc2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+f50c7286b540bb181db1d6e05a51a296  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+4efd6c8826e65a61f82af954d431b59b  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+ef1031e79e7a15a4470a5e98b23781b5  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+067876bfd0df0f4c5002780ec85e6f8c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+789851dfa4c03563e9cef5f7bc050a7e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+baf934720818ee49477e74fc644faa5e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+9a0ea77ca26d2c121ddcc179edb76308  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+20c825561572e33d026f99ddfd999538  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+464c461455c5a927079a13609c20b637  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+cf37d42f89b6adb0e1a9e99104501b82  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+d266af45e3d06b70d9f52e2df4344186  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+f8b59fa22eb0ba944e2b7aa24d67b681  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+0918d7c2f9062743450a86eae9dde1a3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+36a92cc94a9e0fa21f625f8bfb007adf  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+681d73898dad5685d48b5e8438bc3a66  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+337ccef058459c3c16411381778da0c4  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+6ccdfcc742862036ce07583633c5f77e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+ddfa1adc974649dc5b414be86def7457  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+650ebc28ad85f11aa4b63b6ee565b89d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+e4571793bcaba284017eeabd8df85697  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+4fc040d354ad9ba5e4f62862109d3e17  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+25814274e02aa7cc03d6314eb703e655  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+11378ecaee0089c840d26352704027e3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+86f950bfcd824d5546da01c40576db31  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+089f243d1e831c5879aa375ee364a06e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+9146ef3527c7cfcc66dc615c3986e391  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+d727cfdfc9ed0347e6917a68b982f7bc  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+da8f45e1fdc12deecfe56aeb5288796e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+29cfcf52d8250a253a535cf7989c7bd2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+0f6eb555b8e3c35411eebe9348594193  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+a922439f963e7e59040e4756992c6f1b  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+81f8453cf3f7e5ee5479c777e5a8d80c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+8a7bd0732ed6a28ce75f6dabc90e1613  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+5f61c0ccad4cac44c75ff505e1f1e537  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+f6acfca2d47c87f2b14ca038234d3614  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+269fc62c517f3d55c368152addca57e7  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+50587cb16413da779b35508018721647  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+5e4a3ecfdaa4636b84a39b6a7be7c047  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+c5339dc2af6bf595580281ffb07353f6  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+e51176a47347e167ed0ed766b6de1a0c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+020406e1d05cdc2aa287641f7ae2cc39  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+e510683b3f5ffe4093d021808bc6ff70  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b325dc1c6f5e7a2b7cf465b9feab7948  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+e016e4ccc7fdaea56fc377600b58c4cb  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+3870ec709d2fc64b255d65be3123ad69  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+a92bde1f862c3fe797ecd69510bbd266  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+04daa146f3a2256fdcbf015c0f67e168  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+3d13c8bf627421ccc937aa1c9ac87bf1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+247dc7ffc545e4dda64ae12def481c4e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+2dfd4def392ee9563241b7db7eb7c346  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+d11a18a4743a1a0a699d1704efb74a0d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+55b62fabd9c77d44d86e992eeeb093e6  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+9a72cf7d0bd5ae2907c79f91837e3ced  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+d3828cce1835534475029202ebd799e4  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b0bebbf0015658d4740679f263a3f01f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+02368ebf1f53bc4634211b1693021666  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+04960f7d18960e348372949e4baa9752  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+c6041e7a86d407e9402b175670519260  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+439fd4c056bec1d14acd393746f6ae59  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+81a855120e04494c5a6c874a2360fd57  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+ef57bd47a964dc3aadd959c4131e64ac  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+0b0ab27b16cbba267c141fe0f4ee9189  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+abccd84f340bfe4ba59095cc3d5ca6ad  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+bc620e8c15265f195c8818e2f3e3c58b  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+fdcd84c4143286f6fc70c69208acd18d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+50e05071e773b1e9f3009a4a559ce6b2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+9e69c7a6c1863fbba2532f09ba665bde  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+47a962111aa5187eeef3d17a278d95f2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+c13e57e33526bc713b5a1825f92651bc  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+72b392f15593e42404b38e5c889fa75e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+5327acd3278274265d44e22ccfc4042c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+930dcac6da160b2a4c51879da76d3417  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+41292c326f926f1534ead47fe302f0a0  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+2bdecb5cf6b69a00f7832299ef2fb5a5  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+8bf93e9e8a3e4396de3f211c788e177e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+eea9cb566e19d6a7f55fbae78d94ef2a  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+3b8452700a829dec78397aa5c0458dd3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+7950059f699eaea1e0a1759340d7c153  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+40840c5f1de00f17a8e70d5bd4d00af2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+80f86f6af38be9ca8e40c2dc44491a0a  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+7aab2c2e72c77163e7102412dc332125  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+bfd6869ae2ee2fe2675846d341eaa67d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+7e4d976f6d552d1d5bac7e2693dc8759  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+37d9884c32abfc6f372ee899434e64ad  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+e362cd83a4b49d81ac6788b7839a56fd  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+9203cbb93b25d80b9d1b75e3c6c4b0dc  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+77441eda11554ec5b915d942605f66ed  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+e0fe0c02b5c9c5afe10ab9d6a3769efe  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+cc7682cf11b214e928f3df899772e789  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+ade0901d347afb25ecf9df4955bb8061  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+987379587cbe8e94b7057269232ff826  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+fd44a60101b04b7ddbc2b4e9b509ca1f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+53107a7f1e6f13a2e63239b6f2bf0ef1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+0b82cdd562f26aaa2459610a7ba8cd76  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+79f12de7255e9c8c0ec9a9be45ee6210  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+92338d8de02ed7aa8b3adc9120b94e71  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+8fc48efda580fce85b8705d540e8382e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+63642b027ee89938c922722650f2eb9b  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+fe54daa473502e9cc2c26dd66d564eab  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b90f3d4b7dcd8cdd8d96cb14695f4793  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+3e73392e7a03bca45b67650d79a8fc63  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+7fe51f2642dffbabc33eea2fcc2039ba  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+bc33790e52f99718cf920329961ee753  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+54d1e41ebac5db7886f01ab0afb65b17  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+16e2824f7a3f00ef0028994182071953  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+234c07907df5019d5f40f03936939bce  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+8ea3af1d9476fa0b6c04ce4f3a336c03  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+e95b69eae07d498d484afc771d1c45fc  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+f22a673abbc4372544ba37b51a5f5a91  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+7e6161eb1be7b06928c536fada91b7f1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+4dfe3c301e88fff67822e1cfcfece43f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+edda210ac6645fbf5815eb4c58821f6d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+6a514de2bf1926129b08f9234cd0115e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+887f30b43b2867f4a9accceee7d16e6c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+15936442c22dab9b685de350bfe75971  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+281a39e10bab29f1f2dead149a1f3f87  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+04d5f8a53b0eeda82d3c0ccafd02c98e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+a91e6b80fe9d6db74fac76c7a67f065a  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+30334486fa9841044afb07f2573107a5  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+0183c0cf15a3c2ed97d326f421b6d62c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+4dc2a01b2161653753019b5228f765f8  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+71ef2dbdec7f78005354abebbfec8d8f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+a1d1cd1446c113726ba50cc86d8b6519  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+ed6da79cfd13ece051c4cb7c88e80c2e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+d2047852ce178d4ddb7978da3883f9c5  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+d75382e07dd096b618faeeac033eefff  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+3fb48e286d462dcc237c3335aa63ba14  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+55b959972677ea06c4d0e32f7fb2f10a  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+0a479c3623cfb9745e54d3376d0b9ae2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+7825ad1ba19db7eec57d88b16936f32f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+833ccf25509cb423a4aa98accb15512d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+cae9609b05a9782610a5a43d7cd4b8ff  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+6c303e1da7f8a3032d13fe995847a722  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+4c47143a568e30ecde86dafe3bcb0558  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+9c48f0592f504b86360cfb6de00203b3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+e1524f5686f170209366f9723880d9b0  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+a96164a43a192543d40e538b9e9e4ece  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b774a4f788458a60e131d998705e4a06  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+1e97f0a7dfd3fac6ae585acdcf51a549  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b6364c77b6dd495c2a7f6b0211ac6fce  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+5d22315e78df2bc4146aa66f6c405dbb  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+2a773d5b04e910612543a42deeaaaa62  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+0165449ac66b086accdec3051e0b691e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+54884ba571054eae72b2a5271828a1fc  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+520fb61f8625ea916d72a54a37937bc6  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+7717f05d6e424a2c7a20ab7977b21ec8  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b64e4f62e3e14317e3a90f9ff2cde576  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+a49128259cfe50ba3bed80bbd11add7f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b10cb153b79c2e4af6a8431c265aa82d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+2e50fee6f574241042bdfabfdd46a153  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+5d5656a09b98c24edd01c530d3aad5e2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+5ac1e1609d82274371c349d5b7875298  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+b7b40d64ffccebd78abcf522376b3aae  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+8619933469d908a2d4a2d890909bea43  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+591a0ee6dccd872b46ae184eb0f9450e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+8cd256a02c8c5c1676e9220e655d9ac4  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+e48c0e2ed3e4e299a6e62e5416eb6d83  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+f30f75dce71e757ee562218c1efa0645  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+06bd7e90c0410dacb155732cf956f520  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+531a0a821a9304c215f1829b880306f1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+93f4621c0b88499297ec3f8fbb3fb9c4  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+6af3d61e2e3ef8e189cffbea802c7e69  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+df84d21c884f99d6764d9bca4dec26e1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+1bdbdf1c9087c796394bcda5789f7206  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+21f5b107cda33036590a19419afd7fb6  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+0eae304c738191613302fb6721ea3605  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+abed9cdef66dcec954b87124ba18c1ab  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+dfde09457e2017e31d4ecfaea010db8f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+46bc249a5a8fc5d622cf12c42c463ae0  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+81109eec5aa1a284fb5327b10e9c16b9  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#cd25041f9f36811b04ab3015805fe816 "a"
+EBCDIC,1047#762b8b87733ee724b8cb751c3b956ea7 "aa"
+EBCDIC,1047#f39105ec557abe624399862897a127ed "aaa"
+EBCDIC,1047#b825cfc3203d45d01156b8e06ae74901 "aaaa"
+EBCDIC,1047#a497a05975af505878aa98b26bd329dd "aaaaa"
+EBCDIC,1047#90420f3fc7d64c6cdd7a3bf218b004b1 "aaaaaa"
+EBCDIC,1047#b3d7a168407b1613f08f186dc3744a72 "aaaaaaa"
+EBCDIC,1047#b7b4ab251d9cc8dc9fc562272a1c7f44 "aaaaaaaa"
+EBCDIC,1047#eb974f5cd9b8100dad8e9b82bbdb4a7a "aaaaaaaaa"
+EBCDIC,1047#cd675880a60d9c2095fe48981959ea5b "aaaaaaaaaa"
+EBCDIC,1047#8396c227248d77e1ebb478b4c44ee8e8 "aaaaaaaaaaa"
+EBCDIC,1047#ae59cf65c1c722b8ea6f6e770b20315f "aaaaaaaaaaaa"
+EBCDIC,1047#d1550adc6c6f2baeb5da9e2acd75eea1 "aaaaaaaaaaaaa"
+EBCDIC,1047#bddd60dbf174785c39827c71ecb29706 "aaaaaaaaaaaaaa"
+EBCDIC,1047#d0ef1bc67b2d761513ad8c1f92ca7a2b "aaaaaaaaaaaaaaa"
+EBCDIC,1047#dd613bdc90e1e71e57e40931cf3803c1 "aaaaaaaaaaaaaaaa"
+EBCDIC,1047#3810ed84a3fabf136b9f5c2de3c802ca "aaaaaaaaaaaaaaaaa"
+EBCDIC,1047#a41d584a36ba74526057338e4240b31d "aaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#e361a7b2e6adb9df91ed794f39c31a8f "aaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#dc089d8d25773e879ce759357394f63b "aaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#096bdd77ddd6393b5ff2878813ebc9c3 "aaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#e457d06769e51e7b34314c1fa885534b "aaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#ae3399b847ef9ce11d958a8926afa2a3 "aaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#be65d5ac6ebe81410cca55c2ad70e672 "aaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#108e4c3887db4178e5ea72782fb105d2 "aaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#d6ccc43d376b6ded51af488d1f56a872 "aaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#e208a35fdf88de1da8ec8411888b807e "aaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#bf09c576c720c32342308fae413347ae "aaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#aac629ca1ec1d5908fe85d6eeb352765 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#845a64111840e9db26e8f5032d59187d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#db38d8cf4f7037e6a150cc35e385972c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#2586f6fcb6ffb1578a94f8c9c2944b40 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#cb63decd219ee21068b330d321061434 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#d98cca1ccf230b2619ae6f452ab18325 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#f99e8a5e800a9c1b78b9c7181fa4113d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c60d314815b0d438fe8cf18a62d8680d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#1256f52d15ab93e69c75d6cc9986fa49 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#7e6b1236d08400ec5723b76f3b883b2a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#bae076b34373156e51196c8170fff549 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#b957a14baa9ab970516e5e3fe30560c5 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#8209c722c9d86984bde35f31e64de4c9 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#ad6abdadefb6809ef9db323939dad44e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#91ae6c863369dbfb13c688b9e5290929 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#770e940a6f11de3a3897031c7040573f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#2d07c71e6709d908992a19ee8fcd70c7 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#e748dc11e3b2984e0888782ecc9fa43f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#99573ce268b1f9e32e18319922380b2b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#68951bca944217c5a17d54d9fe296ee9 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#53addd1728c3fd60ba02e29ff7eac4d8 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#7c4abc37772402388c8d792351ae3163 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#a21011fb1a5c1f06dfc23c1b9b921506 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#5ce00db35364620dc75696426b9c7948 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#50a785cbcd6cb70322f32062bcfc8940 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#92e6ad1aa09ecde0becf66dc9f356549 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#bb769fed437ab5471f0453bdf0de6ca2 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#49d68b22125368b152dd80773b1053cd "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#8c7ce5f0c7ed40ec25df22b68d1725f3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#344d80c1906e9e728e0cc9703fc60803 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#630a45b11cc72d8e36aca0e180241cb4 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#1c9ba16c5be8d48b5d8fe1a8dd1b6999 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#74bb8337e8e9a3d114eb266437302949 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#134ddd06fa362804c9f8cf02111826bd "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#1ffd548f057ed474c0d3b53ee1f8ce1b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#487823e5089b40d8c66a6a7fc613c26c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#a40e0c6392e974bc6e258fb7530b9ec3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#dccf88078dcb7501156e17b6f5b90bd0 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#9012cdfe170301d3c8d11d9dab87bf96 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#046d4f6709367aa9be3452dc5dd03601 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#237b85d7be428836b0835e3f7411d0d0 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#32022ea076ffe7496da0b64b2482b963 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c68b3e8c7c88bf10003deaf652549f1c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#e648925002262503def112984215d21d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#192328de11913688d002f01326071abb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#42f7138b1f7ed2121098f3e418406e7b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#cb64c10607f961b2714a3b104e487838 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#0a8fb4023704d318e53a6047531477f3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#2c9a5487397c8245fe8a52684fa50554 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#26efb364f1da859fbc71744d2c62570e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#3359363d24960feaa2f05ea1b403ddcc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#be9304d0a6297a1a1c7b02cbf177fe0c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#badb0d02141d35349b3b2838cb6450cc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#75261d10ee76bfc016f98a868e535e49 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#d85006031896657b7215ed1f64f002b9 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#2db85d6ffa2287e42c0e55a72900dd4f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#f8ce69fabcf5d5013aaede9c90a7e4c0 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#5749ef4b7f6347c3cf9e8af2dc48093e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#afd1f87f6522f82f7d260909db38f84c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#690a229786930ec741404c83738f0e87 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#a1f02fbe5b1815f5d68ebfa5c5b8cdda "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4e75faba6d50d6f3341b3623f3457c83 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#af0eed7206c2aba4622b15a826b3cf48 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#984236c86e268a506dda56886d4589aa "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#256f33cc0cd5d0d700b959143f8b81fb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#a4f4a73bdf53bd03ec2bf406df8c5bf1 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#bac0c7bb84f581a8ca67e49ecb7eabdc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c1be2bc056a5abfff888f562f7420b8b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#6db1e154a0feeb290d6f9b6ca78b9faa "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#163fa1f68d79b511aa832e4d513c0d75 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#f00e90ba697aa55722c87b51652b515f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#ba925e3f1584bb930da28396334dfb06 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#6a43780f9f36e80e977d31e6ee055ccf "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#f07953ebdb37e911069ab4dc1d11b691 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#0f21a8a924546d121d479c2ae9b22788 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#6c857bf152348cc6a8d63ef4bb3a8b22 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#afc61c11e9730f9221e5b013cb75e36b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#7c762743838df21dbe61883325e4de3e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#a78d17621ef736358cf69909fe1841ae "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#687559a1f8bb2799d3f7e57ceb0f816e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#0a5eb0bcfc8888839b3b4f986e91db7c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#232c4a6355062f36d5b18a18453ba936 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#5ec9bdfb872d07265113dd94eaf7a9ea "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#f3c9f677ab5404ed16b029067a8d632f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#290997df4163f9f37994048b7f750ecb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#9d482b2d64d165eaf1796bddb15ffc43 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#f7e059c707e4156d59bef9c887731b75 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#dec244a8f0d45814f8968492cae063ae "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#a153d558a8bed15abe61d6de1345200c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c4c4155e9855435000915b9028af57ad "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#3bf4740880459875fc6625d3e8b9702b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#b73a90ab965e8254aeb1ed8995ccf551 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#143a255cfc206e135b23ed557c6b8c7d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#1600b994bf10eeb85772e0f5811ed661 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#7becfd6e439108f896d34012bc3c879f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#9fb1155e1c1529943d378bc79ce7248a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#210f27a4c085f4c50b119a9f530dbe64 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c03e534627aec7638f2ef7136a987afb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#056ff6dcf19eff62af1f7eaf68fdb868 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#78ebdbcbd1cf873ac5bc3317bc333d74 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#379ed8c06d6533b0ae397bd9bcc88727 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#68202ec0f97b3d04145ad8143b36bbec "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#f2e8c8f3ab9832adae73d6694b5aa6b5 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4dd0228d79bab138ae330137ceac9547 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#db509dc0a6d9a43323f200c3944fdd47 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#91e5620a3fbe4a7dbddc6328024f57e6 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#cebbeb507c5b8534898b394c3cb6dbab "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#eaa83adae76b4e5a38361a7943b2fc51 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#cf3fe145cdd9d906dff484591bebb099 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#5ee68f513d294e242dfd84066a489ad4 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#1452349d5b61efaf5f86f6c67ae1e67d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4a6d9c83bb7f0418977302f41861c674 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#1c82f764bc22e2b43aa64c86152576c5 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#94046ff34b09f2d5cd1ecc145f8b67f9 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#2f9b4413a963175dbf6c0e79fbafc13f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#fdcfd05667569a819bd43a32f3f0034c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#977ffabd477e827a170211d989121719 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#eb42e9022bad24209923768cd295da59 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#34daced153754389b0a3dd457aaa580f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4d4ac318fd2765150cdd3a1fd9046f76 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#5f3779e31d8b4ecc587ef2aa620990cb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#538a0f0a41a77491368d12d280b67ffc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#2b8bea1be2920657faea5d2f306df93e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#fdb162676ff37cafbb0b37f4a34e1f05 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#79b031eae2e5d593ad9e1765c1b32311 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#9a9d79d611f3f97dac3f1f16aeb95810 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#eca47f4f27f10c6e50bc02e96c1305e0 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c27a036a378a0c37e551623253de6c86 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#846248b2d8ba9a2845a5b5a6160ea043 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#37f6c0bb5c1c76a018bd92d6267d5f52 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c71638a87de7d0b7ff178235d368ca87 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c1769c2dafefeb4400d8aaaad7be13e2 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c2170ff8ba444a468ecc92c68e156876 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#87d372bb84572d2c33e910a8f39a46c3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#e198c2b2ad83adf6d2edb90918afb140 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#dc89c07be1a85973ce4a75fdd70b945f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#8213ffd54a231c594058b572f12ed2ce "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#64a275192c6bbaf330994498212ff235 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#e718b792be6311e0248a537ba6d5e84c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#b7ee2cd790ed748aa3ac632e2c30fe08 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#6a97471085d1e13858f7febbc8762a40 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#d82fa7cf3fe39751e88cc6a4c5ea0a80 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4d3ea68fdfb845be4aa12eef1868ac54 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#b24417be7632f1db1f37c00f2be59372 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#79f7f0088af39859c26e8dd422102e4a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#8e7c80a85e3a76bb83d81e12122d699c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#ffb596a208a1b81b17cf86e809ea9b15 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#a3e78c5e9bd595ea8457b25b7ae5ee7c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#200b9de7d5ebd0a74deb6d501fa9c273 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#75865e9d3111b6e17ba1e1b586c520e0 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#f13640a7b68db8d2bd853a95c371f4e7 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4525f0da220d5e730ad91070c819ca6a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#3f9c9eb19f1fd6aefeb3d736d5f37cbb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#e3344f64ba3436948b3de13081c98eb9 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#18b50889733a1e896e8fd2e460e98d7f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#918a86710bc529f44f022d5f891107a1 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4aaea2b4f2cfcfef3a5f6be8996b2a3e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#af899efcace3138fea64764015e265f6 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#d472112d115b9bfb34a65cc6683109fc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#f2a42d47b187fc7a250f771ebcda779b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#43442e458f65b5dc6b84181fb70f0e36 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#051771335f34ad905c1af28c429e23e2 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c2c23e86aac60a7d8cb2f2d9a011b525 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4276f514d2e9b5cf511a01b16d5bd7ad "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#43011a7d9ad322984e3617859eb37ee7 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#9b7e0d04de1c0121bd261a15cf9bb806 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#bc1e0269ae34e27ed0534a8ab5146324 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#85fa07daa4541779d7c8436a737802cf "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#5d1db871938d1dcc8a72509411dada31 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#e679a912e400a1c078e657be492a672c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#b17718a20096befcee63c2b55bbc5399 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4786015b6aa47e81752f4e2aa59061d5 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#7f3793d46edf449ce5800d568ef6e83f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#8f992f2bc222fdc9ecf86eb0c984948b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#aec900f38434e9fb7ded9d33f9a59b66 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#de3fe519c53310d2a8970a4ed2bcc937 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#02bf7d064c621689246886752ddc08bc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c306bdf0469814bf38b2cadc896489a3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#9f84e151ea29f14871b63454585cbc78 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#cc4fd08ed3768b08646bfa6c332a6156 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#d35126a1dc2ae4b93ac67a442961a752 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4c2ed17f95f823071289b94c7efe53f2 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#63e071ca26135f7e27d76fa57d015dbe "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4e506bd75c0d1391a0dd36adc18b3485 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#b8a9a5bf97ce5fc88a24c128bb75536e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#97e8bb790b164bc3bdb7189630748841 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#3c7a2d742d599f4fac9231c5264967ee "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#0483a8dc4b24d3d26f0d3bf0402486c5 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#86022bc208c5bbded89bbaeae88e6dbf "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c7a3f500cfe98f8c1959922b381b9438 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#bff3067df4cfff43007bea69f2380d6a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#e34a5c41f51ea6d1f1b187e90d940b59 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c8468cae7c8a2a999a0a164f68b759eb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4bccb2bff1862782004398afff2289b4 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#9710683ca0b5cbf10c3df249bfa85d7a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#5a705ab132807ce9605b98444622abf3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#dd53ab3422160f933f9723cd3cb53b5a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#bad7e8a4aeea40f8642a0ca1cdfcc61b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#4c0df2b1456694b51a5c809f34f959a8 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#f330498cabce39dd03eb02d6c983281f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#915ff5f5c93e0a7833be8cc529108216 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#b8facb5253a2b7e091c0a6c18d48e368 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#8ebdd257c3bc052f9c837f90fb1879cf "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#42d2cf830ee626939580323a824a4099 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#0d364adcb48ee9db07828ce127355a0b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#14d9170b8f9ead33ec4da94d66b6b74a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#0327eff7ae5d6b5966def78e593ff5f7 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#f08ac509f43f8e34008a65c3f47d29aa "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#7dc9cdc33fb9a0d70e1409357b086783 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#5f079c22e843c3426bcf03efbd0fc54d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#8422781e8a9390246920556090a9559d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#0cc485a5c828b2cdc895f38b5c3b386e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#2259886c34c2e8adf2b3552bd47a3d6e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c96af44682d38aa7e4b86954c883f8dc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#85bfdfeff05f7120bd5821ac6668694e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#b4083c69629ec95f6397cd5844edaf90 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#666550654d7c9e6b8a3118d9dc64bace "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#eef83a6cad3d9a8d963d468cb037ccce "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c2fd346804a8c9c80a08312d7b9d17f3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#6521b944a119cd1f787ff75c1452db74 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#805638adfdb3bf9591fd28dfadba697a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#e62d07301fd3c0bdb5f7ce0e49e4b5d3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#49b46e007e0c79c047f655b1b46167c2 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#8811ec9d3b878d168975ed835b3acaa8 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#9b4e8b089d75d1fe3567bcc97b4379d5 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c279605bdcfee9b4976eb57a9eb0d5fd "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#3e362e6f8c5eb3aa7530ef9722dda11c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+EBCDIC,1047#c54a2d44c8a73ab63d892b8b3d1c336f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"

diff --git a/ext/Digest/MD5/t/align.t b/ext/Digest/MD5/t/align.t
new file mode 100644 (file)
index 0000000..4176062
--- /dev/null
+++ b/ext/Digest/MD5/t/align.t
@@ -0,0 +1,20 @@
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+# Test that md5 works on unaligned memory blocks
+
+print "1..1\n";
+
+use strict;
+use Digest::MD5 qw(md5_hex);
+
+my $str = "\100" x 20;
+substr($str, 0, 1, "");  # chopping off first char makes the string unaligned
+
+#use Devel::Peek; Dump($str); 
+
+print "not " unless md5_hex($str) eq "c7ebb510e59ee96f404f288d14cc656a";
+print "ok 1\n";
+

diff --git a/ext/Digest/MD5/t/badfile.t b/ext/Digest/MD5/t/badfile.t
new file mode 100644 (file)
index 0000000..63effdf
--- /dev/null
+++ b/ext/Digest/MD5/t/badfile.t
@@ -0,0 +1,26 @@
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+# Digest::MD5 2.07 and older used to trigger a core dump when
+# passed an illegal file handle that failed to open.
+
+print "1..2\n";
+
+use Digest::MD5 ();
+
+$md5 = Digest::MD5->new;
+
+eval {
+   use vars qw(*FOO);
+   $md5->addfile(*FOO);
+};
+print "not " unless $@ =~ /^Bad filehandle: FOO/;
+print "ok 1\n";
+
+open(BAR, "none-existing-file.$$");
+$md5->addfile(*BAR);
+
+print "not " unless $md5->hexdigest eq "d41d8cd98f00b204e9800998ecf8427e";
+print "ok 2\n";

diff --git a/ext/Digest/MD5/t/files.t b/ext/Digest/MD5/t/files.t
new file mode 100644 (file)
index 0000000..c786a5f
--- /dev/null
+++ b/ext/Digest/MD5/t/files.t
@@ -0,0 +1,150 @@
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+print "1..2\n";
+
+use strict;
+use Digest::MD5 qw(md5 md5_hex md5_base64);
+
+#
+# This is the output of: 'md5sum MD5.pm MD5.xs'
+#
+my $EXPECT;
+
+if (ord('A') == 193) { # EBCDIC
+$EXPECT = <<EOT;
+95a81f17a8e6c2273aecac12d8c4cb90  ext/Digest/MD5/MD5.pm
+9cecc5dbb27bd64b98f61f558b4db378  ext/Digest/MD5/MD5.xs
+EOT
+} else { # ASCII
+$EXPECT = <<EOT;
+3d0146bf194e4fe68733d00fba02a49e  ext/Digest/MD5/MD5.pm
+5526659171a63f532d990dd73791b60e  ext/Digest/MD5/MD5.xs
+EOT
+}
+
+my $B64 = 1;
+eval { require MIME::Base64; };
+if ($@) {
+    print $@;
+    print "# Will not test base64 methods\n";
+    $B64 = 0;
+}
+
+my $testno = 0;
+
+use File::Spec;
+
+for (split /^/, $EXPECT) {
+     my($md5hex, $file) = split ' ';
+     my @path = split(m:/:, $file);
+     my $last = pop @path;
+     my $path = File::Spec->updir;
+     while (@path) {
+        $path = File::Spec->catdir($path, shift @path);
+     }
+     $file = File::Spec->catfile($path, $last);
+     my $md5bin = pack("H*", $md5hex);
+     my $md5b64;
+     if ($B64) {
+        $md5b64 = MIME::Base64::encode($md5bin, "");
+        chop($md5b64); chop($md5b64);   # remove padding
+     }
+     my $failed;
+
+     if (digest_file($file, 'digest') ne $md5bin) {
+        print "$file: Bad digest\n";
+        $failed++;
+     }
+
+     if (digest_file($file, 'hexdigest') ne $md5hex) {
+        print "$file: Bad hexdigest\n";
+        $failed++;
+     }
+
+     if ($B64 && digest_file($file, 'b64digest') ne $md5b64) {
+        print "$file: Bad b64digest\n";
+        $failed++;
+     }
+
+     my $data = cat_file($file);
+     if (md5($data) ne $md5bin) {
+        print "$file: md5() failed\n";
+        $failed++;
+     }
+     if (md5_hex($data) ne $md5hex) {
+        print "$file: md5_hex() failed\n";
+        $failed++;
+     }
+     if ($B64 && md5_base64($data) ne $md5b64) {
+        print "$file: md5_base64() failed\n";
+        $failed++;
+     }
+
+     if (Digest::MD5->new->add($data)->digest ne $md5bin) {
+        print "$file: MD5->new->add(...)->digest failed\n";
+        $failed++;
+     }
+     if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) {
+        print "$file: MD5->new->add(...)->hexdigest failed\n";
+        $failed++;
+     }
+     if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) {
+        print "$file: MD5->new->add(...)->b64digest failed\n";
+        $failed++;
+     }
+
+     my @data = split //, $data;
+     if (md5(@data) ne $md5bin) {
+        print "$file: md5(\@data) failed\n";
+        $failed++;
+     }
+     if (Digest::MD5->new->add(@data)->digest ne $md5bin) {
+        print "$file: MD5->new->add(\@data)->digest failed\n";
+        $failed++;
+     }
+     my $md5 = Digest::MD5->new;
+     for (@data) {
+        $md5->add($_);
+     }
+     if ($md5->digest ne $md5bin) {
+        print "$file: $md5->add()-loop failed\n";
+        $failed++;
+     }
+
+     print "not " if $failed;
+     print "ok ", ++$testno, "\n";
+}
+
+
+sub digest_file
+{
+    my($file, $method) = @_;
+    $method ||= "digest";
+    #print "$file $method\n";
+
+    open(FILE, $file) or die "Can't open $file: $!";
+# Digests avove are generated on UNIX without CRLF
+# so leave handles in text mode
+#    binmode(FILE);
+    my $digest = Digest::MD5->new->addfile(*FILE)->$method();
+    close(FILE);
+
+    $digest;
+}
+
+sub cat_file
+{
+    my($file) = @_;
+    local $/;  # slurp
+    open(FILE, $file) or die "Can't open $file: $!";
+# Digests avove are generated on UNIX without CRLF
+# so leave handles in text mode
+#    binmode(FILE);
+    my $tmp = <FILE>;
+    close(FILE);
+    $tmp;
+}
+

diff --git a/ext/Encode.t b/ext/Encode.t
new file mode 100644 (file)
index 0000000..ceeb422
--- /dev/null
+++ b/ext/Encode.t
@@ -0,0 +1,122 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\Encode\b/) {
+      print "1..0 # Skip: Encode was not built\n";
+      exit 0;
+    }
+}
+use Test;
+use Encode qw(from_to encode decode encode_utf8 decode_utf8 find_encoding);
+use charnames qw(greek);
+my @encodings = grep(/iso-?8859/,Encode::encodings());
+my $n = 2;
+my @character_set = ('0'..'9', 'A'..'Z', 'a'..'z');
+my @source = qw(ascii iso8859-1 cp1250);
+my @destiny = qw(cp1047 cp37 posix-bc);
+my @ebcdic_sets = qw(cp1047 cp37 posix-bc);
+plan test => 38+$n*@encodings + 2*@source*@destiny*@character_set + 2*@ebcdic_sets*256;
+my $str = join('',map(chr($_),0x20..0x7E));
+my $cpy = $str;
+ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong");
+ok($cpy,$str,"ASCII mangled by translating from iso8859-1 to Unicode");
+$cpy = $str;
+ok(from_to($cpy,'Unicode','iso8859-1'),length($str),"Length wrong");
+ok($cpy,$str,"ASCII mangled by translating from Unicode to iso8859-1");
+
+$str = join('',map(chr($_),0xa0..0xff));
+$cpy = $str;
+ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong");
+
+my $sym = Encode->getEncoding('symbol');
+my $uni = $sym->decode(encode(ascii => 'a'));
+ok("\N{alpha}",substr($uni,0,1),"alpha does not map to symbol 'a'");
+$str = $sym->encode("\N{Beta}");
+ok("B",decode(ascii => substr($str,0,1)),"Symbol 'B' does not map to Beta");
+
+foreach my $enc (qw(symbol dingbats ascii),@encodings)
+ {
+  my $tab = Encode->getEncoding($enc);
+  ok(1,defined($tab),"Could not load $enc");
+  $str = join('',map(chr($_),0x20..0x7E));
+  $uni = $tab->decode($str);
+  $cpy = $tab->encode($uni);
+  ok($cpy,$str,"$enc mangled translating to Unicode and back");
+ }
+
+# On ASCII based machines see if we can map several codepoints from
+# three distinct ASCII sets to three distinct EBCDIC coded character sets.
+# On EBCDIC machines see if we can map from three EBCDIC sets to three
+# distinct ASCII sets.
+
+my @expectation = (240..249, 193..201,209..217,226..233, 129..137,145..153,162..169);
+if (ord('A') != 65) {
+    my @temp = @destiny;
+    @destiny = @source;
+    @source = @temp;
+    undef(@temp);
+    @expectation = (48..57, 65..90, 97..122);
+}
+
+foreach my $to (@destiny)
+ {
+  foreach my $from (@source)
+   {
+    my @expected = @expectation;
+    foreach my $chr (@character_set)
+     {
+      my $native_chr = $chr;
+      my $cpy = $chr;
+      my $rc = from_to($cpy,$from,$to);
+      ok(1,$rc,"Could not translate from $from to $to");
+      ok(ord($cpy),shift(@expected),"mangled translating $native_chr from $from to $to");
+     }
+   }
+ }
+
+# On either ASCII or EBCDIC machines ensure we can take the full one
+# byte repetoire to EBCDIC sets and back.
+
+my $enc_as = 'iso8859-1';
+foreach my $enc_eb (@ebcdic_sets)
+ {
+  foreach my $ord (0..255)
+   {
+    $str = chr($ord);
+    my $rc = from_to($str,$enc_as,$enc_eb);
+    $rc += from_to($str,$enc_eb,$enc_as);
+    ok($rc,2,"return code for $ord $enc_eb -> $enc_as -> $enc_eb was not obtained");
+    ok($ord,ord($str),"$enc_as mangled translating $ord to $enc_eb and back");
+   }
+ }
+
+my $mime = find_encoding('iso-8859-2');
+ok(defined($mime),1,"Cannot find MIME-ish'iso-8859-2'");
+my $x11 = find_encoding('iso8859-2');
+ok(defined($x11),1,"Cannot find X11-ish 'iso8859-2'");
+ok($mime,$x11,"iso8598-2 and iso-8859-2 not same");
+my $spc = find_encoding('iso 8859-2');
+ok(defined($spc),1,"Cannot find 'iso 8859-2'");
+ok($spc,$mime,"iso 8859-2 and iso-8859-2 not same");
+
+for my $i (256,128,129,256)
+ {
+  my $c = chr($i);
+  my $s = "$c\n".sprintf("%02X",$i);
+  ok(utf8::valid($s),1,"concat of $i botched");
+  utf8::upgrade($s);
+  ok(utf8::valid($s),1,"concat of $i botched");
+ }
+
+# Spot check a few points in/out of utf8
+for my $i (0x41,128,256,0x20AC)
+ {
+  my $c = chr($i);
+  my $o = encode_utf8($c);
+  ok(decode_utf8($o),$c,"decode_utf8 not inverse of encode_utf8 for $i");
+  ok(encode('utf8',$c),$o,"utf8 encode by name broken for $i");
+  ok(decode('utf8',$o),$c,"utf8 decode by name broken for $i");
+ }
+
+

diff --git a/ext/Errno/Errno.t b/ext/Errno/Errno.t
new file mode 100755 (executable)
index 0000000..02f5ce2
--- /dev/null
+++ b/ext/Errno/Errno.t
@@ -0,0 +1,54 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+       chdir 't' if -d 't';
+       if ($^O eq 'MacOS') { 
+           @INC = qw(: ::lib ::macos:lib); 
+       } else { 
+           @INC = '../lib'; 
+       }
+    }
+}
+
+use Errno;
+
+print "1..5\n";
+
+print "not " unless @Errno::EXPORT_OK;
+print "ok 1\n";
+die unless @Errno::EXPORT_OK;
+
+$err = $Errno::EXPORT_OK[0];
+$num = &{"Errno::$err"};
+
+print "not " unless &{"Errno::$err"} == $num;
+print "ok 2\n";
+
+$! = $num;
+print "not " unless $!{$err};
+print "ok 3\n";
+
+$! = 0;
+print "not " if $!{$err};
+print "ok 4\n";
+
+$s1 = join(",",sort keys(%!));
+$s2 = join(",",sort @Errno::EXPORT_OK);
+
+if($s1 ne $s2) {
+    my @s1 = keys(%!);
+    my @s2 = @Errno::EXPORT_OK;
+    my(%s1,%s2);
+    @s1{@s1} = ();
+    @s2{@s2} = ();
+    delete @s2{@s1};
+    delete @s1{@s2};
+    print "# These are only in \%!\n";
+    print "# ",join(" ",map { "'$_'" } keys %s1),"\n";
+    print "# These are only in \@EXPORT_OK\n";
+    print "# ",join(" ",map { "'$_'" } keys %s2),"\n";
+    print "not ";
+}
+
+print "ok 5\n";

diff --git a/ext/Fcntl/Fcntl.t b/ext/Fcntl/Fcntl.t
new file mode 100644 (file)
index 0000000..24ade27
--- /dev/null
+++ b/ext/Fcntl/Fcntl.t
@@ -0,0 +1,46 @@
+#!./perl
+
+# A modest test: exercises only O_WRONLY, O_CREAT, and O_RDONLY.
+# Have to be modest to be portable: could possibly extend testing
+# also to O_RDWR and O_APPEND, but dunno about the portability of,
+# say, O_TRUNC and O_EXCL, not to mention O_NONBLOCK.
+
+use Fcntl;
+
+print "1..6\n";
+
+print "ok 1\n";
+
+if (sysopen(my $wo, "fcntl$$", O_WRONLY|O_CREAT)) {
+    print "ok 2\n";
+    if (syswrite($wo, "foo") == 3) {
+       print "ok 3\n";
+       close($wo);
+       if (sysopen(my $ro, "fcntl$$", O_RDONLY)) {
+           print "ok 4\n";
+           if (sysread($ro, my $read, 3)) {
+               print "ok 5\n";
+               if ($read eq "foo") {
+                   print "ok 6\n";
+               } else {
+                   print "not ok 6 # content '$read' not ok\n";
+               }
+           } else {
+               print "not ok 5 # sysread failed: $!\n";
+           }
+       } else {
+           print "not ok 4 # sysopen O_RDONLY failed: $!\n";
+       }
+       close($ro);
+    } else {
+       print "not ok 3 # syswrite failed: $!\n";
+    }
+    close($wo);
+} else {
+    print "not ok 2 # sysopen O_WRONLY failed: $!\n";
+}
+
+END {
+    1 while unlink "fcntl$$";
+}
+

diff --git a/ext/Fcntl/syslfs.t b/ext/Fcntl/syslfs.t
new file mode 100644 (file)
index 0000000..8d9769f
--- /dev/null
+++ b/ext/Fcntl/syslfs.t
@@ -0,0 +1,267 @@
+# NOTE: this file tests how large files (>2GB) work with raw system IO.
+# stdio: open(), tell(), seek(), print(), read() is tested in t/op/lfs.t.
+# If you modify/add tests here, remember to update also t/op/lfs.t.
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       # Don't bother if there are no quad offsets.
+       if ($Config{lseeksize} < 8) {
+               print "1..0 # Skip: no 64-bit file offsets\n";
+               exit(0);
+       }
+       require Fcntl; import Fcntl qw(/^O_/ /^SEEK_/);
+}
+
+use strict;
+
+$| = 1;
+
+our @s;
+our $fail;
+
+sub zap {
+    close(BIG);
+    unlink("big");
+    unlink("big1");
+    unlink("big2");
+}
+
+sub bye {
+    zap(); 
+    exit(0);
+}
+
+my $explained;
+
+sub explain {
+    unless ($explained++) {
+       print <<EOM;
+#
+# If the lfs (large file support: large meaning larger than two
+# gigabytes) tests are skipped or fail, it may mean either that your
+# process (or process group) is not allowed to write large files
+# (resource limits) or that the file system (the network filesystem?)
+# you are running the tests on doesn't let your user/group have large
+# files (quota) or the filesystem simply doesn't support large files.
+# You may even need to reconfigure your kernel.  (This is all very
+# operating system and site-dependent.)
+#
+# Perl may still be able to support large files, once you have
+# such a process, enough quota, and such a (file) system.
+# It is just that the test failed now.
+#
+EOM
+    }
+    print "1..0 # Skip: @_\n" if @_;
+}
+
+print "# checking whether we have sparse files...\n";
+
+# Known have-nots.
+if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
+    print "1..0 # Skip: no sparse files in $^O\n";
+    bye();
+}
+
+# Known haves that have problems running this test
+# (for example because they do not support sparse files, like UNICOS)
+if ($^O eq 'unicos') {
+    print "1..0 # Skip: no sparse files in $^0, unable to test large files\n";
+    bye();
+}
+
+# Then try heuristically to deduce whether we have sparse files.
+
+# We'll start off by creating a one megabyte file which has
+# only three "true" bytes.  If we have sparseness, we should
+# consume less blocks than one megabyte (assuming nobody has
+# one megabyte blocks...)
+
+sysopen(BIG, "big1", O_WRONLY|O_CREAT|O_TRUNC) or
+    do { warn "sysopen big1 failed: $!\n"; bye };
+sysseek(BIG, 1_000_000, SEEK_SET) or
+    do { warn "sysseek big1 failed: $!\n"; bye };
+syswrite(BIG, "big") or
+    do { warn "syswrite big1 failed; $!\n"; bye };
+close(BIG) or
+    do { warn "close big1 failed: $!\n"; bye };
+
+my @s1 = stat("big1");
+
+print "# s1 = @s1\n";
+
+sysopen(BIG, "big2", O_WRONLY|O_CREAT|O_TRUNC) or
+    do { warn "sysopen big2 failed: $!\n"; bye };
+sysseek(BIG, 2_000_000, SEEK_SET) or
+    do { warn "sysseek big2 failed: $!\n"; bye };
+syswrite(BIG, "big") or
+    do { warn "syswrite big2 failed; $!\n"; bye };
+close(BIG) or
+    do { warn "close big2 failed: $!\n"; bye };
+
+my @s2 = stat("big2");
+
+print "# s2 = @s2\n";
+
+zap();
+
+unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 &&
+       $s1[11] == $s2[11] && $s1[12] == $s2[12]) {
+       print "1..0 # Skip: no sparse files?\n";
+       bye;
+}
+
+print "# we seem to have sparse files...\n";
+
+# By now we better be sure that we do have sparse files:
+# if we are not, the following will hog 5 gigabytes of disk.  Ooops.
+# This may fail by producing some signal; run in a subprocess first for safety
+
+$ENV{LC_ALL} = "C";
+
+my $r = system '../perl', '-I../lib', '-e', <<'EOF';
+use Fcntl qw(/^O_/ /^SEEK_/);
+sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or die $!;
+my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
+my $syswrite = syswrite(BIG, "big");
+exit 0;
+EOF
+
+sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
+       do { warn "sysopen 'big' failed: $!\n"; bye };
+my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
+unless (! $r && defined $sysseek && $sysseek == 5_000_000_000) {
+    $sysseek = 'undef' unless defined $sysseek;
+    explain("seeking past 2GB failed: ",
+           $r ? 'signal '.($r & 0x7f) : "$! (sysseek returned $sysseek)");
+    bye();
+}
+
+# The syswrite will fail if there are are filesize limitations (process or fs).
+my $syswrite = syswrite(BIG, "big");
+print "# syswrite failed: $! (syswrite returned ",
+      defined $syswrite ? $syswrite : 'undef', ")\n"
+    unless defined $syswrite && $syswrite == 3;
+my $close     = close BIG;
+print "# close failed: $!\n" unless $close;
+unless($syswrite && $close) {
+    if ($! =~/too large/i) {
+       explain("writing past 2GB failed: process limits?");
+    } elsif ($! =~ /quota/i) {
+       explain("filesystem quota limits?");
+    } else {
+       explain("error: $!");
+    }
+    bye();
+}
+
+@s = stat("big");
+
+print "# @s\n";
+
+unless ($s[7] == 5_000_000_003) {
+    explain("kernel/fs not configured to use large files?");
+    bye();
+}
+
+sub fail () {
+    print "not ";
+    $fail++;
+}
+
+sub offset ($$) {
+    my ($offset_will_be, $offset_want) = @_;
+    my $offset_is = eval $offset_will_be;
+    unless ($offset_is == $offset_want) {
+        print "# bad offset $offset_is, want $offset_want\n";
+       my ($offset_func) = ($offset_will_be =~ /^(\w+)/);
+       if (unpack("L", pack("L", $offset_want)) == $offset_is) {
+           print "# 32-bit wraparound suspected in $offset_func() since\n";
+           print "# $offset_want cast into 32 bits equals $offset_is.\n";
+       } elsif ($offset_want - unpack("L", pack("L", $offset_want)) - 1
+                == $offset_is) {
+           print "# 32-bit wraparound suspected in $offset_func() since\n";
+           printf "# %s - unpack('L', pack('L', %s)) - 1 equals %s.\n",
+               $offset_want,
+               $offset_want,
+               $offset_is;
+        }
+        fail;
+    }
+}
+
+print "1..17\n";
+
+$fail = 0;
+
+fail unless $s[7] == 5_000_000_003;    # exercizes pp_stat
+print "ok 1\n";
+
+fail unless -s "big" == 5_000_000_003; # exercizes pp_ftsize
+print "ok 2\n";
+
+fail unless -e "big";
+print "ok 3\n";
+
+fail unless -f "big";
+print "ok 4\n";
+
+sysopen(BIG, "big", O_RDONLY) or do { warn "sysopen failed: $!\n"; bye };
+
+offset('sysseek(BIG, 4_500_000_000, SEEK_SET)', 4_500_000_000);
+print "ok 5\n";
+
+offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_000);
+print "ok 6\n";
+
+offset('sysseek(BIG, 1, SEEK_CUR)', 4_500_000_001);
+print "ok 7\n";
+
+offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_001);
+print "ok 8\n";
+
+offset('sysseek(BIG, -1, SEEK_CUR)', 4_500_000_000);
+print "ok 9\n";
+
+offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_000);
+print "ok 10\n";
+
+offset('sysseek(BIG, -3, SEEK_END)', 5_000_000_000);
+print "ok 11\n";
+
+offset('sysseek(BIG, 0, SEEK_CUR)', 5_000_000_000);
+print "ok 12\n";
+
+my $big;
+
+fail unless sysread(BIG, $big, 3) == 3;
+print "ok 13\n";
+
+fail unless $big eq "big";
+print "ok 14\n";
+
+# 705_032_704 = (I32)5_000_000_000
+# See that we don't have "big" in the 705_... spot:
+# that would mean that we have a wraparound.
+fail unless sysseek(BIG, 705_032_704, SEEK_SET);
+print "ok 15\n";
+
+my $zero;
+
+fail unless read(BIG, $zero, 3) == 3;
+print "ok 16\n";
+
+fail unless $zero eq "\0\0\0";
+print "ok 17\n";
+
+explain() if $fail;
+
+bye(); # does the necessary cleanup
+
+END {
+   unlink "big"; # be paranoid about leaving 5 gig files lying around
+}
+
+# eof

diff --git a/ext/Filter/t/call.t b/ext/Filter/t/call.t
new file mode 100644 (file)
index 0000000..dc667c9
--- /dev/null
+++ b/ext/Filter/t/call.t
@@ -0,0 +1,795 @@
+BEGIN {
+    chdir('t') if -d 't';    
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ m{\bFilter/Util/Call\b}) {
+        print "1..0 # Skip: Filter::Util::Call was not built\n";
+        exit 0;
+    }
+    require 'lib/filter-util.pl';
+}
+
+use strict;
+use warnings;
+
+use vars qw($Inc $Perl);
+
+print "1..28\n" ;
+
+$Perl = "$Perl -w" ;
+
+use Cwd ;
+my $here = getcwd ;
+
+
+my $filename = "call.tst" ;
+my $filenamebin = "call.bin" ;
+my $module   = "MyTest" ;
+my $module2  = "MyTest2" ;
+my $module3  = "MyTest3" ;
+my $module4  = "MyTest4" ;
+my $module5  = "MyTest5" ;
+my $nested   = "nested" ;
+my $block   = "block" ;
+
+# Test error cases
+##################
+
+# no filter function in module 
+###############################
+
+writeFile("${module}.pm", <<EOM) ;
+package ${module} ;
+
+use Filter::Util::Call ;
+ 
+sub import { filter_add(bless []) }
+
+1 ;
+EOM
+ 
+my $a = `$Perl "-I." $Inc -e "use ${module} ;"  2>&1` ;
+ok(1, (($? >>8) != 0 or (($^O eq 'MSWin32' || $^O eq 'NetWare') && $? != 0))) ;
+ok(2, $a =~ /^Can't locate object method "filter" via package "MyTest"/) ;
+ 
+# no reference parameter in filter_add
+######################################
+
+writeFile("${module}.pm", <<EOM) ;
+package ${module} ;
+ 
+use Filter::Util::Call ;
+ 
+sub import { filter_add() }
+ 
+1 ;
+EOM
+ 
+$a = `$Perl "-I." $Inc -e "use ${module} ;"  2>&1` ;
+ok(3, (($? >>8) != 0 or (($^O eq 'MSWin32' || $^O eq 'NetWare') && $? != 0))) ;
+#ok(4, $a =~ /^usage: filter_add\(ref\) at ${module}.pm/) ;
+ok(4, $a =~ /^Not enough arguments for Filter::Util::Call::filter_add/) ;
+ 
+
+
+
+# non-error cases
+#################
+
+
+# a simple filter, using a closure
+#################
+
+writeFile("${module}.pm", <<EOM, <<'EOM') ;
+package ${module} ;
+ 
+EOM
+use Filter::Util::Call ;
+sub import { 
+    filter_add(
+       sub {
+ 
+           my ($status) ;
+ 
+           if (($status = filter_read()) > 0) {
+               s/ABC/DEF/g 
+           }
+           $status ;
+       } ) ;
+}
+
+1 ;
+EOM
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+
+use $module ;
+EOM
+
+use Cwd ;
+$here = getcwd ;
+print "I am $here\n" ;
+print "some letters ABC\n" ;
+$y = "ABCDEF" ;
+print <<EOF ;
+Alphabetti Spagetti ($y)
+EOF
+
+EOM
+
+$a = `$Perl "-I." $Inc $filename  2>&1` ;
+ok(5, ($? >>8) == 0) ;
+ok(6, $a eq <<EOM) ;
+I am $here
+some letters DEF
+Alphabetti Spagetti (DEFDEF)
+EOM
+
+# a simple filter, not using a closure
+#################
+ 
+writeFile("${module}.pm", <<EOM, <<'EOM') ;
+package ${module} ;
+ 
+EOM
+use Filter::Util::Call ;
+sub import { filter_add(bless []) }
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    if (($status = filter_read()) > 0) {
+        s/ABC/DEF/g
+    }
+    $status ;
+}
+
+ 
+1 ;
+EOM
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+ 
+use $module ;
+EOM
+ 
+use Cwd ;
+$here = getcwd ;
+print "I am $here\n" ;
+print "some letters ABC\n" ;
+$y = "ABCDEF" ;
+print <<EOF ;
+Alphabetti Spagetti ($y)
+EOF
+ 
+EOM
+ 
+$a = `$Perl "-I." $Inc $filename  2>&1` ;
+ok(7, ($? >>8) == 0) ;
+ok(8, $a eq <<EOM) ;
+I am $here
+some letters DEF
+Alphabetti Spagetti (DEFDEF)
+EOM
+
+
+# nested filters
+################
+
+
+writeFile("${module2}.pm", <<EOM, <<'EOM') ;
+package ${module2} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import { filter_add(bless []) }
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    if (($status = filter_read()) > 0) {
+        s/XYZ/PQR/g
+    }
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+writeFile("${module3}.pm", <<EOM, <<'EOM') ;
+package ${module3} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import { filter_add(
+ 
+    sub 
+    {
+        my ($status) ;
+     
+        if (($status = filter_read()) > 0) {
+            s/Fred/Joe/g
+        }
+        $status ;
+    } ) ;
+}
+ 
+1 ;
+EOM
+ 
+writeFile("${module4}.pm", <<EOM) ;
+package ${module4} ;
+ 
+use $module5 ;
+
+print "I'm feeling used!\n" ;
+print "Fred Joe ABC DEF PQR XYZ\n" ;
+print "See you Today\n" ;
+1;
+EOM
+
+writeFile("${module5}.pm", <<EOM, <<'EOM') ;
+package ${module5} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import { filter_add(bless []) }
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    if (($status = filter_read()) > 0) {
+        s/Today/Tomorrow/g
+    }
+    $status ;
+}
+ 
+1 ;
+EOM
+
+writeFile($filename, <<EOM, <<'EOM') ;
+ 
+# two filters for this file
+use $module ;
+use $module2 ;
+require "$nested" ;
+use $module4 ;
+EOM
+ 
+print "some letters ABCXYZ\n" ;
+$y = "ABCDEFXYZ" ;
+print <<EOF ;
+Fred likes Alphabetti Spagetti ($y)
+EOF
+ 
+EOM
+ 
+writeFile($nested, <<EOM, <<'EOM') ;
+use $module3 ;
+EOM
+ 
+print "This is another file XYZ\n" ;
+print <<EOF ;
+Where is Fred?
+EOF
+ 
+EOM
+
+$a = `$Perl "-I." $Inc $filename  2>&1` ;
+ok(9, ($? >>8) == 0) ;
+ok(10, $a eq <<EOM) ;
+I'm feeling used!
+Fred Joe ABC DEF PQR XYZ
+See you Tomorrow
+This is another file XYZ
+Where is Joe?
+some letters DEFPQR
+Fred likes Alphabetti Spagetti (DEFDEFPQR)
+EOM
+
+# using the module context (with a closure)
+###########################################
+ 
+ 
+writeFile("${module2}.pm", <<EOM, <<'EOM') ;
+package ${module2} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import
+{
+    my ($type) = shift ;
+    my (@strings) = @_ ;
+ 
+ 
+    filter_add (
+ 
+       sub 
+       {
+           my ($status) ;
+           my ($pattern) ;
+            
+           if (($status = filter_read()) > 0) {
+                foreach $pattern (@strings)
+                   { s/$pattern/PQR/g }
+           }
+            
+           $status ;
+       }
+       )
+ 
+}
+1 ;
+EOM
+ 
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+ 
+use $module2 qw( XYZ KLM) ;
+use $module2 qw( ABC NMO) ;
+EOM
+ 
+print "some letters ABCXYZ KLM NMO\n" ;
+$y = "ABCDEFXYZKLMNMO" ;
+print <<EOF ;
+Alphabetti Spagetti ($y)
+EOF
+ 
+EOM
+ 
+$a = `$Perl "-I." $Inc $filename  2>&1` ;
+ok(11, ($? >>8) == 0) ;
+ok(12, $a eq <<EOM) ;
+some letters PQRPQR PQR PQR
+Alphabetti Spagetti (PQRDEFPQRPQRPQR)
+EOM
+ 
+
+
+# using the module context (without a closure)
+##############################################
+
+
+writeFile("${module2}.pm", <<EOM, <<'EOM') ;
+package ${module2} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import 
+{ 
+    my ($type) = shift ;
+    my (@strings) = @_ ;
+
+  
+    filter_add (bless [@strings]) 
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+    my ($pattern) ;
+ 
+    if (($status = filter_read()) > 0) {
+       foreach $pattern (@$self)
+          { s/$pattern/PQR/g }
+    }
+
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+ 
+use $module2 qw( XYZ KLM) ;
+use $module2 qw( ABC NMO) ;
+EOM
+ 
+print "some letters ABCXYZ KLM NMO\n" ;
+$y = "ABCDEFXYZKLMNMO" ;
+print <<EOF ;
+Alphabetti Spagetti ($y)
+EOF
+ 
+EOM
+ 
+$a = `$Perl "-I." $Inc $filename  2>&1` ;
+ok(13, ($? >>8) == 0) ;
+ok(14, $a eq <<EOM) ;
+some letters PQRPQR PQR PQR
+Alphabetti Spagetti (PQRDEFPQRPQRPQR)
+EOM
+
+# multi line test
+#################
+
+
+writeFile("${module2}.pm", <<EOM, <<'EOM') ;
+package ${module2} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import
+{ 
+    my ($type) = shift ;
+    my (@strings) = @_ ;
+
+  
+    filter_add(bless []) 
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    # read first line
+    if (($status = filter_read()) > 0) {
+       chop ;
+       s/\r$//;
+       # and now the second line (it will append)
+        $status = filter_read() ;
+    }
+
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+ 
+use $module2  ;
+EOM
+print "don't cut me 
+in half\n" ;
+print  
+<<EOF ;
+appen
+ded
+EO
+F
+ 
+EOM
+ 
+$a = `$Perl "-I." $Inc $filename  2>&1` ;
+ok(15, ($? >>8) == 0) ;
+ok(16, $a eq <<EOM) ;
+don't cut me in half
+appended
+EOM
+
+# Block test
+#############
+
+writeFile("${block}.pm", <<EOM, <<'EOM') ;
+package ${block} ;
+use Filter::Util::Call ;
+ 
+EOM
+sub import
+{ 
+    my ($type) = shift ;
+    my (@strings) = @_ ;
+
+  
+    filter_add (bless [@strings] )
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+    my ($pattern) ;
+ 
+    filter_read(20)  ;
+}
+ 
+1 ;
+EOM
+
+my $string = <<'EOM' ;
+print "hello mum\n" ;
+$x = 'me ' x 3 ;
+print "Who wants it?\n$x\n" ;
+EOM
+
+
+writeFile($filename, <<EOM, $string ) ;
+use $block ;
+EOM
+ 
+$a = `$Perl "-I." $Inc $filename  2>&1` ;
+ok(17, ($? >>8) == 0) ;
+ok(18, $a eq <<EOM) ;
+hello mum
+Who wants it?
+me me me 
+EOM
+
+# use in the filter
+####################
+
+writeFile("${block}.pm", <<EOM, <<'EOM') ;
+package ${block} ;
+use Filter::Util::Call ;
+ 
+EOM
+use Cwd ;
+
+sub import
+{ 
+    my ($type) = shift ;
+    my (@strings) = @_ ;
+
+  
+    filter_add(bless [@strings] )
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+    my ($here) = quotemeta getcwd ;
+ 
+    if (($status = filter_read()) > 0) {
+        s/DIR/$here/g
+    }
+    $status ;
+}
+ 
+1 ;
+EOM
+
+writeFile($filename, <<EOM, <<'EOM') ;
+use $block ;
+EOM
+print "We are in DIR\n" ;
+EOM
+ 
+$a = `$Perl "-I." $Inc $filename  2>&1` ;
+ok(19, ($? >>8) == 0) ;
+ok(20, $a eq <<EOM) ;
+We are in $here
+EOM
+
+
+# filter_del
+#############
+ 
+writeFile("${block}.pm", <<EOM, <<'EOM') ;
+package ${block} ;
+use Filter::Util::Call ;
+ 
+EOM
+ 
+sub import
+{
+    my ($type) = shift ;
+    my ($count) = @_ ;
+ 
+ 
+    filter_add(bless \$count )
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    s/HERE/THERE/g
+        if ($status = filter_read()) > 0 ;
+
+    -- $$self ;
+    filter_del() if $$self <= 0 ;
+
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+use $block (3) ;
+EOM
+print "
+HERE I am
+I am HERE
+HERE today gone tomorrow\n" ;
+EOM
+ 
+$a = `$Perl "-I." $Inc $filename  2>&1` ;
+ok(21, ($? >>8) == 0) ;
+ok(22, $a eq <<EOM) ;
+
+THERE I am
+I am THERE
+HERE today gone tomorrow
+EOM
+
+
+# filter_read_exact
+####################
+ 
+writeFile("${block}.pm", <<EOM, <<'EOM') ;
+package ${block} ;
+use Filter::Util::Call ;
+ 
+EOM
+ 
+sub import
+{
+    my ($type) = shift ;
+ 
+    filter_add(bless [] )
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    if (($status = filter_read_exact(9)) > 0) {
+        s/HERE/THERE/g
+    }
+ 
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+writeFile($filenamebin, <<EOM, <<'EOM') ;
+use $block ;
+EOM
+print "
+HERE I am
+I'm HERE
+HERE today gone tomorrow\n" ;
+EOM
+ 
+$a = `$Perl "-I." $Inc $filenamebin  2>&1` ;
+ok(23, ($? >>8) == 0) ;
+ok(24, $a eq <<EOM) ;
+
+HERE I am
+I'm THERE
+THERE today gone tomorrow
+EOM
+
+{
+
+# Check __DATA__
+####################
+ 
+writeFile("${block}.pm", <<EOM, <<'EOM') ;
+package ${block} ;
+use Filter::Util::Call ;
+ 
+EOM
+ 
+sub import
+{
+    my ($type) = shift ;
+ 
+    filter_add(bless [] )
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    if (($status = filter_read()) > 0) {
+        s/HERE/THERE/g
+    }
+ 
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+use $block ;
+EOM
+print "HERE HERE\n";
+@a = <DATA>;
+print @a;
+__DATA__
+HERE I am
+I'm HERE
+HERE today gone tomorrow
+EOM
+ 
+$a = `$Perl "-I." $Inc $filename  2>&1` ;
+ok(25, ($? >>8) == 0) ;
+ok(26, $a eq <<EOM) ;
+THERE THERE
+HERE I am
+I'm HERE
+HERE today gone tomorrow
+EOM
+
+}
+
+{
+
+# Check __END__
+####################
+ 
+writeFile("${block}.pm", <<EOM, <<'EOM') ;
+package ${block} ;
+use Filter::Util::Call ;
+ 
+EOM
+ 
+sub import
+{
+    my ($type) = shift ;
+ 
+    filter_add(bless [] )
+}
+ 
+sub filter
+{
+    my ($self) = @_ ;
+    my ($status) ;
+ 
+    if (($status = filter_read()) > 0) {
+        s/HERE/THERE/g
+    }
+ 
+    $status ;
+}
+ 
+1 ;
+EOM
+ 
+writeFile($filename, <<EOM, <<'EOM') ;
+use $block ;
+EOM
+print "HERE HERE\n";
+@a = <DATA>;
+print @a;
+__END__
+HERE I am
+I'm HERE
+HERE today gone tomorrow
+EOM
+ 
+$a = `$Perl "-I." $Inc $filename  2>&1` ;
+ok(27, ($? >>8) == 0) ;
+ok(28, $a eq <<EOM) ;
+THERE THERE
+HERE I am
+I'm HERE
+HERE today gone tomorrow
+EOM
+
+}
+
+END {
+    1 while unlink $filename ;
+    1 while unlink $filenamebin ;
+    1 while unlink "${module}.pm" ;
+    1 while unlink "${module2}.pm" ;
+    1 while unlink "${module3}.pm" ;
+    1 while unlink "${module4}.pm" ;
+    1 while unlink "${module5}.pm" ;
+    1 while unlink $nested ;
+    1 while unlink "${block}.pm" ;
+}
+
+

diff --git a/ext/GDBM_File/gdbm.t b/ext/GDBM_File/gdbm.t
new file mode 100755 (executable)
index 0000000..0f5cfa0
--- /dev/null
+++ b/ext/GDBM_File/gdbm.t
@@ -0,0 +1,427 @@
+#!./perl
+
+# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bGDBM_File\b/) {
+       print "1..0 # Skip: GDBM_File was not built\n";
+       exit 0;
+    }
+}
+
+use strict;
+use warnings;
+
+
+use GDBM_File;
+
+print "1..68\n";
+
+unlink <Op.dbmx*>;
+
+umask(0);
+my %h ;
+print (tie(%h,'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640) ? "ok 1\n" : "not ok 1\n");
+
+my $Dfile = "Op.dbmx.pag";
+if (! -e $Dfile) {
+       ($Dfile) = <Op.dbmx*>;
+}
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos') {
+    print "ok 2 # Skipped: different file permission semantics\n";
+}
+else {
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+     $blksize,$blocks) = stat($Dfile);
+    print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
+}
+my $i = 0;
+while (my ($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+untie(%h);
+print (tie(%h,'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+my @keys = keys(%h);
+my @values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (my ($key,$value) = each(%h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+       $key =~ y/a-z/A-Z/;
+       $i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(%h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+$h{'foo'} = '';
+$h{''} = 'bar';
+
+# check cache overflow and numeric keys and contents
+my $ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+@h{0..200} = 200..400;
+my @foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
+
+print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+untie %h;
+unlink 'Op.dbmx.dir', $Dfile;
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+   use warnings ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw(@ISA @EXPORT) ;
+
+   require Exporter ;
+   use GDBM_File;
+   @ISA=qw(GDBM_File);
+   @EXPORT = @GDBM_File::EXPORT ;
+
+   sub STORE { 
+       my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+       my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+       my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+       return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+    unlink <dbhash.tmp*> ;
+
+    eval 'use SubDB ; ';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+       $X = tie(%h, "SubDB","dbhash.tmp", &GDBM_WRCREAT, 0640 );
+       ' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval ' &GDBM_WRCREAT eq &main::GDBM_WRCREAT ' ;
+    main::ok(17, $@ eq "" ) ;
+    main::ok(18, $ret == 1) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(19, $@ eq "") ;
+    main::ok(20, $ret eq "[[5]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", <dbhash.tmp*> ;
+
+}
+
+{
+   # DBM Filter tests
+   use strict ;
+   use warnings ;
+   my (%h, $db) ;
+   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+
+   sub checkOutput
+   {
+       my($fk, $sk, $fv, $sv) = @_ ;
+       return
+           $fetch_key eq $fk && $store_key eq $sk && 
+          $fetch_value eq $fv && $store_value eq $sv &&
+          $_ eq 'original' ;
+   }
+   
+   unlink <Op.dbmx*>;
+   ok(21, $db = tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)) ;
+
+   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
+   $db->filter_store_key   (sub { $store_key = $_ }) ;
+   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
+   $db->filter_store_value (sub { $store_value = $_ }) ;
+
+   $_ = "original" ;
+
+   $h{"fred"} = "joe" ;
+   #                   fk   sk     fv   sv
+   ok(22, checkOutput( "", "fred", "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(23, $h{"fred"} eq "joe");
+   #                   fk    sk     fv    sv
+   ok(24, checkOutput( "", "fred", "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(25, $db->FIRSTKEY() eq "fred") ;
+   #                    fk     sk  fv  sv
+   ok(26, checkOutput( "fred", "", "", "")) ;
+
+   # replace the filters, but remember the previous set
+   my ($old_fk) = $db->filter_fetch_key   
+                       (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
+   my ($old_sk) = $db->filter_store_key   
+                       (sub { $_ = lc $_ ; $store_key = $_ }) ;
+   my ($old_fv) = $db->filter_fetch_value 
+                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
+   my ($old_sv) = $db->filter_store_value 
+                       (sub { s/o/x/g; $store_value = $_ }) ;
+   
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"Fred"} = "Joe" ;
+   #                   fk   sk     fv    sv
+   ok(27, checkOutput( "", "fred", "", "Jxe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(28, $h{"Fred"} eq "[Jxe]");
+   #                   fk   sk     fv    sv
+   ok(29, checkOutput( "", "fred", "[Jxe]", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(30, $db->FIRSTKEY() eq "FRED") ;
+   #                   fk   sk     fv    sv
+   ok(31, checkOutput( "FRED", "", "", "")) ;
+
+   # put the original filters back
+   $db->filter_fetch_key   ($old_fk);
+   $db->filter_store_key   ($old_sk);
+   $db->filter_fetch_value ($old_fv);
+   $db->filter_store_value ($old_sv);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"fred"} = "joe" ;
+   ok(32, checkOutput( "", "fred", "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(33, $h{"fred"} eq "joe");
+   ok(34, checkOutput( "", "fred", "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(35, $db->FIRSTKEY() eq "fred") ;
+   ok(36, checkOutput( "fred", "", "", "")) ;
+
+   # delete the filters
+   $db->filter_fetch_key   (undef);
+   $db->filter_store_key   (undef);
+   $db->filter_fetch_value (undef);
+   $db->filter_store_value (undef);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"fred"} = "joe" ;
+   ok(37, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(38, $h{"fred"} eq "joe");
+   ok(39, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(40, $db->FIRSTKEY() eq "fred") ;
+   ok(41, checkOutput( "", "", "", "")) ;
+
+   undef $db ;
+   untie %h;
+   unlink <Op.dbmx*>;
+}
+
+{    
+    # DBM Filter with a closure
+
+    use strict ;
+    use warnings ;
+    my (%h, $db) ;
+
+    unlink <Op.dbmx*>;
+    ok(42, $db = tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)) ;
+
+    my %result = () ;
+
+    sub Closure
+    {
+        my ($name) = @_ ;
+       my $count = 0 ;
+       my @kept = () ;
+
+       return sub { ++$count ; 
+                    push @kept, $_ ; 
+                    $result{$name} = "$name - $count: [@kept]" ;
+                  }
+    }
+
+    $db->filter_store_key(Closure("store key")) ;
+    $db->filter_store_value(Closure("store value")) ;
+    $db->filter_fetch_key(Closure("fetch key")) ;
+    $db->filter_fetch_value(Closure("fetch value")) ;
+
+    $_ = "original" ;
+
+    $h{"fred"} = "joe" ;
+    ok(43, $result{"store key"} eq "store key - 1: [fred]");
+    ok(44, $result{"store value"} eq "store value - 1: [joe]");
+    ok(45, !defined $result{"fetch key"} );
+    ok(46, !defined $result{"fetch value"} );
+    ok(47, $_ eq "original") ;
+
+    ok(48, $db->FIRSTKEY() eq "fred") ;
+    ok(49, $result{"store key"} eq "store key - 1: [fred]");
+    ok(50, $result{"store value"} eq "store value - 1: [joe]");
+    ok(51, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(52, ! defined $result{"fetch value"} );
+    ok(53, $_ eq "original") ;
+
+    $h{"jim"}  = "john" ;
+    ok(54, $result{"store key"} eq "store key - 2: [fred jim]");
+    ok(55, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(56, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(57, ! defined $result{"fetch value"} );
+    ok(58, $_ eq "original") ;
+
+    ok(59, $h{"fred"} eq "joe");
+    ok(60, $result{"store key"} eq "store key - 3: [fred jim fred]");
+    ok(61, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(62, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(63, $result{"fetch value"} eq "fetch value - 1: [joe]");
+    ok(64, $_ eq "original") ;
+
+    undef $db ;
+    untie %h;
+    unlink <Op.dbmx*>;
+}
+
+{
+   # DBM Filter recursion detection
+   use strict ;
+   use warnings ;
+   my (%h, $db) ;
+   unlink <Op.dbmx*>;
+
+   ok(65, $db = tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)) ;
+
+   $db->filter_store_key (sub { $_ = $h{$_} }) ;
+
+   eval '$h{1} = 1234' ;
+   ok(66, $@ =~ /^recursion detected in filter_store_key at/ );
+   
+   undef $db ;
+   untie %h;
+   unlink <Op.dbmx*>;
+}
+
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use GDBM_File ;
+
+    unlink <Op.dbmx*>;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    ok(67, tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640));
+    $h{ABC} = undef;
+    ok(68, $a eq "") ;
+    untie %h;
+    unlink <Op.dbmx*>;
+}

diff --git a/ext/IO/lib/IO/t/io_const.t b/ext/IO/lib/IO/t/io_const.t
new file mode 100755 (executable)
index 0000000..db1a322
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_const.t
@@ -0,0 +1,33 @@
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+           print "1..0\n";
+           exit 0;
+        }
+    }
+}
+
+use IO::Handle;
+
+print "1..6\n";
+my $i = 1;
+foreach (qw(SEEK_SET SEEK_CUR SEEK_END     _IOFBF    _IOLBF    _IONBF)) {
+    my $d1 = defined(&{"IO::Handle::" . $_}) ? 1 : 0;
+    my $v1 = $d1 ? &{"IO::Handle::" . $_}() : undef;
+    my $v2 = IO::Handle::constant($_);
+    my $d2 = defined($v2);
+
+    print "not "
+       if($d1 != $d2 || ($d1 && ($v1 != $v2)));
+    print "ok ",$i++,"\n";
+}

diff --git a/ext/IO/lib/IO/t/io_dir.t b/ext/IO/lib/IO/t/io_dir.t
new file mode 100755 (executable)
index 0000000..6ec4e9f
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_dir.t
@@ -0,0 +1,68 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+    }
+    require Config; import Config;
+    if ($] < 5.00326 || not $Config{'d_readdir'}) {
+       print "1..0\n";
+       exit 0;
+    }
+}
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+use IO::Dir qw(DIR_UNLINK);
+
+print "1..10\n";
+
+my $DIR = $^O eq 'MacOS' ? ":" : ".";
+
+$dot = new IO::Dir $DIR;
+print defined($dot) ? "ok" : "not ok", " 1\n";
+
+@a = sort <*>;
+do { $first = $dot->read } while defined($first) && $first =~ /^\./;
+print +(grep { $_ eq $first } @a) ? "ok" : "not ok", " 2\n";
+
+@b = sort($first, (grep {/^[^.]/} $dot->read));
+print +(join("\0", @a) eq join("\0", @b)) ? "ok" : "not ok", " 3\n";
+
+$dot->rewind;
+@c = sort grep {/^[^.]/} $dot->read;
+print +(join("\0", @b) eq join("\0", @c)) ? "ok" : "not ok", " 4\n";
+
+$dot->close;
+$dot->rewind;
+print defined($dot->read) ? "not ok" : "ok", " 5\n";
+
+open(FH,'>X') || die "Can't create x";
+print FH "X";
+close(FH);
+
+tie %dir, IO::Dir, $DIR;
+my @files = keys %dir;
+
+# I hope we do not have an empty dir :-)
+print @files ? "ok" : "not ok", " 6\n";
+
+my $stat = $dir{'X'};
+print defined($stat) && UNIVERSAL::isa($stat,'File::stat') && $stat->size == 1
+       ? "ok" : "not ok", " 7\n";
+
+delete $dir{'X'};
+
+print -f 'X' ? "ok" : "not ok", " 8\n";
+
+tie %dirx, IO::Dir, $DIR, DIR_UNLINK;
+
+my $statx = $dirx{'X'};
+print defined($statx) && UNIVERSAL::isa($statx,'File::stat') && $statx->size == 1
+       ? "ok" : "not ok", " 9\n";
+
+delete $dirx{'X'};
+
+print -f 'X' ? "not ok" : "ok", " 10\n";

diff --git a/ext/IO/lib/IO/t/io_dup.t b/ext/IO/lib/IO/t/io_dup.t
new file mode 100755 (executable)
index 0000000..8983a56
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_dup.t
@@ -0,0 +1,61 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+           print "1..0\n";
+           exit 0;
+        }
+    }
+}
+
+use IO::Handle;
+use IO::File;
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+print "1..6\n";
+
+print "ok 1\n";
+
+$dupout = IO::Handle->new->fdopen( \*STDOUT ,"w");
+$duperr = IO::Handle->new->fdopen( \*STDERR ,"w");
+
+$stdout = \*STDOUT; bless $stdout, "IO::File"; # "IO::Handle";
+$stderr = \*STDERR; bless $stderr, "IO::Handle";
+
+$stdout->open( "Io.dup","w") || die "Can't open stdout";
+$stderr->fdopen($stdout,"w");
+
+print $stdout "ok 2\n";
+print $stderr "ok 3\n";
+if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
+    print `echo ok 4`;
+    print `echo ok 5 1>&2`; # does this *really* work?
+}
+else {
+    system 'echo ok 4';
+    system 'echo ok 5 1>&2';
+}
+
+$stderr->close;
+$stdout->close;
+
+$stdout->fdopen($dupout,"w");
+$stderr->fdopen($duperr,"w");
+
+if ($^O eq 'MSWin32' || $^O eq 'NetWare') { print `type Io.dup` }
+else                  { system 'cat Io.dup' }
+unlink 'Io.dup';
+
+print STDOUT "ok 6\n";

diff --git a/ext/IO/lib/IO/t/io_linenum.t b/ext/IO/lib/IO/t/io_linenum.t
new file mode 100755 (executable)
index 0000000..cf55c98
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_linenum.t
@@ -0,0 +1,80 @@
+#!./perl
+
+# test added 29th April 1999 by Paul Johnson (pjcj@transeda.com)
+# updated    28th May   1999 by Paul Johnson
+
+my $File;
+
+BEGIN
+{
+  $File = __FILE__;
+  if (-d 't')
+  {
+    chdir 't';
+    $File =~ s/^t\W+//;                                 # Remove first directory
+  }
+  @INC = '../lib';
+  require strict; import strict;
+}
+
+use Test;
+
+BEGIN { plan tests => 12 }
+
+use IO::File;
+
+sub lineno
+{
+  my ($f) = @_;
+  my $l;
+  $l .= "$. ";
+  $l .= $f->input_line_number;
+  $l .= " $.";                     # check $. before and after input_line_number
+  $l;
+}
+
+my $t;
+
+open (F, $File) or die $!;
+my $io = IO::File->new($File) or die $!;
+
+<F> for (1 .. 10);
+ok(lineno($io), "10 0 10");
+
+$io->getline for (1 .. 5);
+ok(lineno($io), "5 5 5");
+
+<F>;
+ok(lineno($io), "11 5 11");
+
+$io->getline;
+ok(lineno($io), "6 6 6");
+
+$t = tell F;                                        # tell F; provokes a warning
+ok(lineno($io), "11 6 11");
+
+<F>;
+ok(lineno($io), "12 6 12");
+
+select F;
+ok(lineno($io), "12 6 12");
+
+<F> for (1 .. 10);
+ok(lineno($io), "22 6 22");
+
+$io->getline for (1 .. 5);
+ok(lineno($io), "11 11 11");
+
+$t = tell F;
+# We used to have problems here before local $. worked.
+# input_line_number() used to use select and tell.  When we did the
+# same, that mechanism broke.  It should work now.
+ok(lineno($io), "22 11 22");
+
+{
+  local $.;
+  $io->getline for (1 .. 5);
+  ok(lineno($io), "16 16 16");
+}
+
+ok(lineno($io), "22 16 22");

diff --git a/ext/IO/lib/IO/t/io_multihomed.t b/ext/IO/lib/IO/t/io_multihomed.t
new file mode 100644 (file)
index 0000000..62f25bc
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_multihomed.t
@@ -0,0 +1,128 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+       my $reason;
+       if (! $Config{'d_fork'}) {
+           $reason = 'no fork';
+       }
+       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
+           $reason = 'Socket extension unavailable';
+       }
+       elsif ($Config{'extensions'} !~ /\bIO\b/) {
+           $reason = 'IO extension unavailable';
+       }
+       if ($reason) {
+           print "1..0 # Skip: $reason\n";
+           exit 0;
+        }
+    }
+}
+
+$| = 1;
+
+print "1..8\n";
+
+eval {
+    $SIG{ALRM} = sub { die; };
+    alarm 60;
+};
+
+package Multi;
+require IO::Socket::INET;
+@ISA=qw(IO::Socket::INET);
+
+use Socket qw(inet_aton inet_ntoa unpack_sockaddr_in);
+
+sub _get_addr
+{
+    my($sock,$addr_str, $multi) = @_;
+    #print "_get_addr($sock, $addr_str, $multi)\n";
+
+    print "not " unless $multi;
+    print "ok 2\n";
+
+    (
+     # private IP-addresses which I hope does not work anywhere :-)
+     inet_aton("10.250.230.10"),
+     inet_aton("10.250.230.12"),
+     inet_aton("127.0.0.1")        # loopback
+    )
+}
+
+sub connect
+{
+    my $self = shift;
+    if (@_ == 1) {
+       my($port, $addr) = unpack_sockaddr_in($_[0]);
+       $addr = inet_ntoa($addr);
+       #print "connect($self, $port, $addr)\n";
+       if($addr eq "10.250.230.10") {
+           print "ok 3\n";
+           return 0;
+       }
+       if($addr eq "10.250.230.12") {
+           print "ok 4\n";
+           return 0;
+       }
+    }
+    $self->SUPER::connect(@_);
+}
+
+
+
+package main;
+
+use IO::Socket;
+
+$listen = IO::Socket::INET->new(Listen => 2,
+                               Proto => 'tcp',
+                               Timeout => 5,
+                              ) or die "$!";
+
+print "ok 1\n";
+
+$port = $listen->sockport;
+
+if($pid = fork()) {
+
+    $sock = $listen->accept() or die "$!";
+    print "ok 5\n";
+
+    print $sock->getline();
+    print $sock "ok 7\n";
+
+    waitpid($pid,0);
+
+    $sock->close;
+
+    print "ok 8\n";
+
+} elsif(defined $pid) {
+
+    $sock = Multi->new(PeerPort => $port,
+                      Proto => 'tcp',
+                      PeerAddr => 'localhost',
+                      MultiHomed => 1,
+                      Timeout => 1,
+                     ) or die "$!";
+
+    print $sock "ok 6\n";
+    sleep(1); # race condition
+    print $sock->getline();
+
+    $sock->close;
+
+    exit;
+} else {
+    die;
+}

diff --git a/ext/IO/lib/IO/t/io_pipe.t b/ext/IO/lib/IO/t/io_pipe.t
new file mode 100755 (executable)
index 0000000..ae18224
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_pipe.t
@@ -0,0 +1,123 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+       my $reason;
+       if (! $Config{'d_fork'}) {
+           $reason = 'no fork';
+       }
+       elsif ($Config{'extensions'} !~ /\bIO\b/) {
+           $reason = 'IO extension unavailable';
+       }
+       undef $reason if $^O eq 'VMS';
+       if ($reason) {
+           print "1..0 # Skip: $reason\n";
+           exit 0;
+        }
+    }
+}
+
+use IO::Pipe;
+
+my $perl = './perl';
+
+$| = 1;
+print "1..10\n";
+
+$pipe = new IO::Pipe->reader($perl, '-e', 'print "not ok 1\n"');
+while (<$pipe>) {
+  s/^not //;
+  print;
+}
+$pipe->close or print "# \$!=$!\nnot ";
+print "ok 2\n";
+
+$cmd = 'BEGIN{$SIG{ALRM} = sub {print "not ok 4\n"; exit}; alarm 10} s/not //';
+$pipe = new IO::Pipe->writer($perl, '-pe', $cmd);
+print $pipe "not ok 3\n" ;
+$pipe->close or print "# \$!=$!\nnot ";
+print "ok 4\n";
+
+# Check if can fork with dynamic extensions (bug in CRT):
+if ($^O eq 'os2' and
+    system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
+    print "ok $_ # skipped: broken fork\n" for 5..10;
+    exit 0;
+}
+
+$pipe = new IO::Pipe;
+
+$pid = fork();
+
+if($pid)
+ {
+  $pipe->writer;
+  print $pipe "Xk 5\n";
+  print $pipe "oY 6\n";
+  $pipe->close;
+  wait;
+ }
+elsif(defined $pid)
+ {
+  $pipe->reader;
+  $stdin = bless \*STDIN, "IO::Handle";
+  $stdin->fdopen($pipe,"r");
+  exec 'tr', 'YX', 'ko';
+ }
+else
+ {
+  die "# error = $!";
+ }
+
+$pipe = new IO::Pipe;
+$pid = fork();
+
+if($pid)
+ {
+  $pipe->reader;
+  while(<$pipe>) {
+      s/^not //;
+      print;
+  }
+  $pipe->close;
+  wait;
+ }
+elsif(defined $pid)
+ {
+  $pipe->writer;
+
+  $stdout = bless \*STDOUT, "IO::Handle";
+  $stdout->fdopen($pipe,"w");
+  print STDOUT "not ok 7\n";
+  exec 'echo', 'not ok 8';
+ }
+else
+ {
+  die;
+ }
+
+$pipe = new IO::Pipe;
+$pipe->writer;
+
+$SIG{'PIPE'} = 'broken_pipe';
+
+sub broken_pipe {
+    print "ok 9\n";
+}
+
+print $pipe "not ok 9\n";
+$pipe->close;
+
+sleep 1;
+
+print "ok 10\n";
+

diff --git a/ext/IO/lib/IO/t/io_poll.t b/ext/IO/lib/IO/t/io_poll.t
new file mode 100755 (executable)
index 0000000..d31ea47
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_poll.t
@@ -0,0 +1,82 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+    }
+}
+
+if ($^O eq 'mpeix') {
+    print "1..0 # Skip: broken on MPE/iX\n";
+    exit 0;
+}
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+print "1..9\n";
+
+use IO::Handle;
+use IO::Poll qw(/POLL/);
+
+my $poll = new IO::Poll;
+
+my $stdout = \*STDOUT;
+my $dupout = IO::Handle->new_from_fd(fileno($stdout),"w");
+
+$poll->mask($stdout => POLLOUT);
+
+print "not "
+       unless $poll->mask($stdout) == POLLOUT;
+print "ok 1\n";
+
+$poll->mask($dupout => POLLPRI);
+
+print "not "
+       unless $poll->mask($dupout) == POLLPRI;
+print "ok 2\n";
+
+$poll->poll(0.1);
+
+if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
+print "ok 3 # skipped, doesn't work on non-socket fds\n";
+print "ok 4 # skipped, doesn't work on non-socket fds\n";
+}
+else {
+print "not "
+       unless $poll->events($stdout) == POLLOUT;
+print "ok 3\n";
+
+print "not "
+       if $poll->events($dupout);
+print "ok 4\n";
+}
+
+my @h = $poll->handles;
+print "not "
+       unless @h == 2;
+print "ok 5\n";
+
+$poll->remove($stdout);
+
+@h = $poll->handles;
+
+print "not "
+       unless @h == 1;
+print "ok 6\n";
+
+print "not "
+       if $poll->mask($stdout);
+print "ok 7\n";
+
+$poll->poll(0.1);
+
+print "not "
+       if $poll->events($stdout);
+print "ok 8\n";
+
+$poll->remove($dupout);
+print "not "
+    if $poll->handles;
+print "ok 9\n";

diff --git a/ext/IO/lib/IO/t/io_sel.t b/ext/IO/lib/IO/t/io_sel.t
new file mode 100755 (executable)
index 0000000..84660db
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_sel.t
@@ -0,0 +1,132 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+    }
+}
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+print "1..23\n";
+
+use IO::Select 1.09;
+
+my $sel = new IO::Select(\*STDIN);
+$sel->add(4, 5) == 2 or print "not ";
+print "ok 1\n";
+
+$sel->add([\*STDOUT, 'foo']) == 1 or print "not ";
+print "ok 2\n";
+
+@handles = $sel->handles;
+print "not " unless $sel->count == 4 && @handles == 4;
+print "ok 3\n";
+#print $sel->as_string, "\n";
+
+$sel->remove(\*STDIN) == 1 or print "not ";
+print "ok 4\n",
+;
+$sel->remove(\*STDIN, 5, 6) == 1  # two of there are not present
+  or print "not ";
+print "ok 5\n";
+
+print "not " unless $sel->count == 2;
+print "ok 6\n";
+#print $sel->as_string, "\n";
+
+$sel->remove(1, 4);
+print "not " unless $sel->count == 0 && !defined($sel->bits);
+print "ok 7\n";
+
+$sel = new IO::Select;
+print "not " unless $sel->count == 0 && !defined($sel->bits);
+print "ok 8\n";
+
+$sel->remove([\*STDOUT, 5]);
+print "not " unless $sel->count == 0 && !defined($sel->bits);
+print "ok 9\n";
+
+if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos') {  # 4-arg select is only valid on sockets
+    print "# skipping tests 10..15\n";
+    for (10 .. 15) { print "ok $_\n" }
+    $sel->add(\*STDOUT);  # update
+    goto POST_SOCKET;
+}
+
+@a = $sel->can_read();  # should return imediately
+print "not " unless @a == 0;
+print "ok 10\n";
+
+# we assume that we can write to STDOUT :-)
+$sel->add([\*STDOUT, "ok 12\n"]);
+
+@a = $sel->can_write;
+print "not " unless @a == 1;
+print "ok 11\n";
+
+my($fd, $msg) = @{shift @a};
+print $fd $msg;
+
+$sel->add(\*STDOUT);  # update
+
+@a = IO::Select::select(undef, $sel, undef, 1);
+print "not " unless @a == 3;
+print "ok 13\n";
+
+($r, $w, $e) = @a;
+
+print "not " unless @$r == 0 && @$w == 1 && @$e == 0;
+print "ok 14\n";
+
+$fd = $w->[0];
+print $fd "ok 15\n";
+
+POST_SOCKET:
+# Test new exists() method
+$sel->exists(\*STDIN) and print "not ";
+print "ok 16\n";
+
+($sel->exists(0) || $sel->exists([\*STDERR])) and print "not ";
+print "ok 17\n";
+
+$fd = $sel->exists(\*STDOUT);
+if ($fd) {
+    print $fd "ok 18\n";
+} else {
+    print "not ok 18\n";
+}
+
+$fd = $sel->exists([1, 'foo']);
+if ($fd) {
+    print $fd "ok 19\n";
+} else {
+    print "not ok 19\n";
+}
+
+# Try self clearing
+$sel->add(5,6,7,8,9,10);
+print "not " unless $sel->count == 7;
+print "ok 20\n";
+
+$sel->remove($sel->handles);
+print "not " unless $sel->count == 0 && !defined($sel->bits);
+print "ok 21\n";
+
+# check warnings
+$SIG{__WARN__} = sub { 
+    ++ $w 
+      if $_[0] =~ /^Call to depreciated method 'has_error', use 'has_exception'/ 
+    } ;
+$w = 0 ;
+IO::Select::has_error();
+print "not " unless $w == 0 ;
+$w = 0 ;
+print "ok 22\n" ;
+use warnings 'IO::Select' ;
+IO::Select::has_error();
+print "not " unless $w == 1 ;
+$w = 0 ;
+print "ok 23\n" ;

diff --git a/ext/IO/lib/IO/t/io_sock.t b/ext/IO/lib/IO/t/io_sock.t
new file mode 100755 (executable)
index 0000000..b752fd8
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_sock.t
@@ -0,0 +1,338 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if (-d "lib" && -f "TEST") {
+       my $reason;
+       if (! $Config{'d_fork'}) {
+           $reason = 'no fork';
+       }
+       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
+           $reason = 'Socket extension unavailable';
+       }
+       elsif ($Config{'extensions'} !~ /\bIO\b/) {
+           $reason = 'IO extension unavailable';
+       }
+       undef $reason if $^O eq 'VMS' and $Config{d_socket};
+       if ($reason) {
+           print "1..0 # Skip: $reason\n";
+           exit 0;
+        }
+    }
+}
+
+$| = 1;
+print "1..20\n";
+
+eval {
+    $SIG{ALRM} = sub { die; };
+    alarm 120;
+};
+
+use IO::Socket;
+
+$listen = IO::Socket::INET->new(Listen => 2,
+                               Proto => 'tcp',
+                               # some systems seem to need as much as 10,
+                               # so be generous with the timeout
+                               Timeout => 15,
+                              ) or die "$!";
+
+print "ok 1\n";
+
+# Check if can fork with dynamic extensions (bug in CRT):
+if ($^O eq 'os2' and
+    system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
+    print "ok $_ # skipped: broken fork\n" for 2..5;
+    exit 0;
+}
+
+$port = $listen->sockport;
+
+if($pid = fork()) {
+
+    $sock = $listen->accept() or die "accept failed: $!";
+    print "ok 2\n";
+
+    $sock->autoflush(1);
+    print $sock->getline();
+
+    print $sock "ok 4\n";
+
+    $sock->close;
+
+    waitpid($pid,0);
+
+    print "ok 5\n";
+
+} elsif(defined $pid) {
+
+    $sock = IO::Socket::INET->new(PeerPort => $port,
+                                 Proto => 'tcp',
+                                 PeerAddr => 'localhost'
+                                )
+         || IO::Socket::INET->new(PeerPort => $port,
+                                 Proto => 'tcp',
+                                 PeerAddr => '127.0.0.1'
+                                )
+       or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
+
+    $sock->autoflush(1);
+
+    print $sock "ok 3\n";
+
+    print $sock->getline();
+
+    $sock->close;
+
+    exit;
+} else {
+ die;
+}
+
+# Test various other ways to create INET sockets that should
+# also work.
+$listen = IO::Socket::INET->new(Listen => '', Timeout => 15) or die "$!";
+$port = $listen->sockport;
+
+if($pid = fork()) {
+  SERVER_LOOP:
+    while (1) {
+       last SERVER_LOOP unless $sock = $listen->accept;
+       while (<$sock>) {
+           last SERVER_LOOP if /^quit/;
+           last if /^done/;
+           print;
+       }
+       $sock = undef;
+    }
+    $listen->close;
+} elsif (defined $pid) {
+    # child, try various ways to connect
+    $sock = IO::Socket::INET->new("localhost:$port")
+         || IO::Socket::INET->new("127.0.0.1:$port");
+    if ($sock) {
+       print "not " unless $sock->connected;
+       print "ok 6\n";
+       $sock->print("ok 7\n");
+       sleep(1);
+       print "ok 8\n";
+       $sock->print("ok 9\n");
+       $sock->print("done\n");
+       $sock->close;
+    }
+    else {
+       print "# $@\n";
+       print "not ok 6\n";
+       print "not ok 7\n";
+       print "not ok 8\n";
+       print "not ok 9\n";
+    }
+
+    # some machines seem to suffer from a race condition here
+    sleep(2);
+
+    $sock = IO::Socket::INET->new("127.0.0.1:$port");
+    if ($sock) {
+       $sock->print("ok 10\n");
+       $sock->print("done\n");
+       $sock->close;
+    }
+    else {
+       print "# $@\n";
+       print "not ok 10\n";
+    }
+
+    # some machines seem to suffer from a race condition here
+    sleep(1);
+
+    $sock = IO::Socket->new(Domain => AF_INET,
+                            PeerAddr => "localhost:$port")
+         || IO::Socket->new(Domain => AF_INET,
+                            PeerAddr => "127.0.0.1:$port");
+    if ($sock) {
+       $sock->print("ok 11\n");
+       $sock->print("quit\n");
+    } else {
+       print "not ok 11\n";
+    }
+    $sock = undef;
+    sleep(1);
+    exit;
+} else {
+    die;
+}
+
+# Then test UDP sockets
+$server = IO::Socket->new(Domain => AF_INET,
+                          Proto  => 'udp',
+                          LocalAddr => 'localhost')
+       || IO::Socket->new(Domain => AF_INET,
+                          Proto  => 'udp',
+                          LocalAddr => '127.0.0.1');
+$port = $server->sockport;
+
+if ($^O eq 'mpeix') {
+    print("ok 12 # skipped\n")
+} else {
+    if ($pid = fork()) {
+        my $buf;
+        $server->recv($buf, 100);
+        print $buf;
+    } elsif (defined($pid)) {
+        #child
+        $sock = IO::Socket::INET->new(Proto => 'udp',
+                                      PeerAddr => "localhost:$port")
+             || IO::Socket::INET->new(Proto => 'udp',
+                                      PeerAddr => "127.0.0.1:$port");
+        $sock->send("ok 12\n");
+        sleep(1);
+        $sock->send("ok 12\n");  # send another one to be sure
+        exit;
+    } else {
+        die;
+    }
+}
+
+print "not " unless $server->blocking;
+print "ok 13\n";
+
+$server->blocking(0);
+print "not " if $server->blocking;
+print "ok 14\n";
+
+### TEST 15
+### Set up some data to be transfered between the server and
+### the client. We'll use own source code ...
+#
+local @data;
+if( !open( SRC, "< $0")) {
+    print "not ok 15 - $!";
+} else {
+    @data = <SRC>;
+    close( SRC);
+}
+print "ok 15\n";
+
+### TEST 16
+### Start the server
+#
+my $listen = IO::Socket::INET->new( Listen => 2, Proto => 'tcp', Timeout => 15) ||
+    print "not ";
+print "ok 16\n";
+die if( !defined( $listen));
+my $serverport = $listen->sockport;
+
+my $server_pid = fork();
+if( $server_pid) {
+
+    ### TEST 17 Client/Server establishment
+    #
+    print "ok 17\n";
+
+    ### TEST 18
+    ### Get data from the server using a single stream
+    #
+    $sock = IO::Socket::INET->new("localhost:$serverport")
+         || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+    if ($sock) {
+       $sock->print("send\n");
+
+       my @array = ();
+       while( <$sock>) {
+           push( @array, $_);
+       }
+
+       $sock->print("done\n");
+       $sock->close;
+
+       print "not " if( @array != @data);
+    } else {
+       print "not ";
+    }
+    print "ok 18\n";
+
+    ### TEST 19
+    ### Get data from the server using a stream, which is
+    ### interrupted by eof calls.
+    ### On perl-5.7.0@7673 this failed in a SOCKS environment, because eof
+    ### did an getc followed by an ungetc in order to check for the streams
+    ### end. getc(3) got replaced by the SOCKS funktion, which ended up in
+    ### a recv(2) call on the socket, while ungetc(3) put back a character
+    ### to an IO buffer, which never again was read.
+    #
+    $sock = IO::Socket::INET->new("localhost:$serverport")
+         || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+    if ($sock) {
+       $sock->print("send\n");
+
+       my @array = ();
+       while( !eof( $sock ) ){
+           while( <$sock>) {
+               push( @array, $_);
+               last;
+           }
+       }
+
+       $sock->print("done\n");
+       $sock->close;
+
+       print "not " if( @array != @data);
+    } else {
+       print "not ";
+    }
+    print "ok 19\n";
+
+    ### TEST 20
+    ### Stop the server
+    #
+    $sock = IO::Socket::INET->new("localhost:$serverport")
+         || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+    if ($sock) {
+       $sock->print("done\n");
+       $sock->close;
+
+       print "not " if( 1 != kill 0, $server_pid);
+    } else {
+       print "not ";
+    }
+    print "ok 20\n";
+
+} elsif( defined( $server_pid)) {
+   
+    ### Child
+    #
+    SERVER_LOOP: while (1) {
+       last SERVER_LOOP unless $sock = $listen->accept;
+       while (<$sock>) {
+           last SERVER_LOOP if /^quit/;
+           last if /^done/;
+           if( /^send/) {
+               print $sock @data;
+               last;
+           }
+           print;
+       }
+       $sock = undef;
+    }
+    $listen->close;
+
+} else {
+
+    ### Fork failed
+    #
+    print "not ok 17\n";
+    die;
+}
+

diff --git a/ext/IO/lib/IO/t/io_taint.t b/ext/IO/lib/IO/t/io_taint.t
new file mode 100755 (executable)
index 0000000..c98d701
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_taint.t
@@ -0,0 +1,48 @@
+#!./perl -T
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+           print "1..0\n";
+           exit 0;
+        }
+    }
+}
+
+END { unlink "./__taint__$$" }
+
+print "1..3\n";
+use IO::File;
+$x = new IO::File "> ./__taint__$$" || die("Cannot open ./__taint__$$\n");
+print $x "$$\n";
+$x->close;
+
+$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
+chop($unsafe = <$x>);
+eval { kill 0 * $unsafe };
+print "not " if ((($^O ne 'MSWin32') && ($^O ne 'NetWare')) and ($@ !~ /^Insecure/o));
+print "ok 1\n";
+$x->close;
+
+# We could have just done a seek on $x, but technically we haven't tested
+# seek yet...
+$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
+$x->untaint;
+print "not " if ($?);
+print "ok 2\n"; # Calling the method worked
+chop($unsafe = <$x>);
+eval { kill 0 * $unsafe };
+print "not " if ($@ =~ /^Insecure/o);
+print "ok 3\n"; # No Insecure message from using the data
+$x->close;
+
+exit 0;

diff --git a/ext/IO/lib/IO/t/io_tell.t b/ext/IO/lib/IO/t/io_tell.t
new file mode 100755 (executable)
index 0000000..65c63bd
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_tell.t
@@ -0,0 +1,64 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       $tell_file = "TEST";
+    }
+    else {
+       $tell_file = "Makefile";
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+           print "1..0\n";
+           exit 0;
+        }
+    }
+}
+
+print "1..13\n";
+
+use IO::File;
+
+$tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file");
+binmode $tst; # its a nop unless it matters. Was only if ($^O eq 'MSWin32' or $^O eq 'dos');
+if ($tst->eof) { print "not ok 1\n"; } else { print "ok 1\n"; }
+
+$firstline = <$tst>;
+$secondpos = tell;
+
+$x = 0;
+while (<$tst>) {
+    if (eof) {$x++;}
+}
+if ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; }
+
+$lastpos = tell;
+
+unless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; }
+
+if ($tst->seek(0,0)) { print "ok 4\n"; } else { print "not ok 4\n"; }
+
+if (eof) { print "not ok 5\n"; } else { print "ok 5\n"; }
+
+if ($firstline eq <$tst>) { print "ok 6\n"; } else { print "not ok 6\n"; }
+
+if ($secondpos == tell) { print "ok 7\n"; } else { print "not ok 7\n"; }
+
+if ($tst->seek(0,1)) { print "ok 8\n"; } else { print "not ok 8\n"; }
+
+if ($tst->eof) { print "not ok 9\n"; } else { print "ok 9\n"; }
+
+if ($secondpos == tell) { print "ok 10\n"; } else { print "not ok 10\n"; }
+
+if ($tst->seek(0,2)) { print "ok 11\n"; } else { print "not ok 11\n"; }
+
+if ($lastpos == $tst->tell) { print "ok 12\n"; } else { print "not ok 12\n"; }
+
+unless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; }

diff --git a/ext/IO/lib/IO/t/io_udp.t b/ext/IO/lib/IO/t/io_udp.t
new file mode 100755 (executable)
index 0000000..d63a5dc
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_udp.t
@@ -0,0 +1,94 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+       my $reason;
+
+       if ($Config{'extensions'} !~ /\bSocket\b/) {
+         $reason = 'Socket was not built';
+       }
+       elsif ($Config{'extensions'} !~ /\bIO\b/) {
+         $reason = 'IO was not built';
+       }
+       elsif ($^O eq 'apollo') {
+         $reason = "unknown *FIXME*";
+       }
+       undef $reason if $^O eq 'VMS' and $Config{d_socket};
+       if ($reason) {
+           print "1..0 # Skip: $reason\n";
+           exit 0;
+       }
+    }
+}
+
+sub compare_addr {
+    no utf8;
+    my $a = shift;
+    my $b = shift;
+    if (length($a) != length $b) {
+       my $min = (length($a) < length $b) ? length($a) : length $b;
+       if ($min and substr($a, 0, $min) eq substr($b, 0, $min)) {
+           printf "# Apparently: %d bytes junk at the end of %s\n# %s\n",
+               abs(length($a) - length ($b)),
+               $_[length($a) < length ($b) ? 1 : 0],
+               "consider decreasing bufsize of recfrom.";
+           substr($a, $min) = "";
+           substr($b, $min) = "";
+       }
+       return 0;
+    }
+    my @a = unpack_sockaddr_in($a);
+    my @b = unpack_sockaddr_in($b);
+    "$a[0]$a[1]" eq "$b[0]$b[1]";
+}
+
+$| = 1;
+print "1..7\n";
+
+use Socket;
+use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
+
+$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+     || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
+    or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
+
+print "ok 1\n";
+
+$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+     || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
+    or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
+
+print "ok 2\n";
+
+$udpa->send("ok 4\n",0,$udpb->sockname);
+
+print "not "
+  unless compare_addr($udpa->peername,$udpb->sockname, 'peername', 'sockname');
+print "ok 3\n";
+
+my $where = $udpb->recv($buf="",5);
+print $buf;
+
+my @xtra = ();
+
+unless(compare_addr($where,$udpa->sockname, 'recv name', 'sockname')) {
+    print "not ";
+    @xtra = (0,$udpa->sockname);
+}
+print "ok 5\n";
+
+$udpb->send("ok 6\n",@xtra);
+$udpa->recv($buf="",5);
+print $buf;
+
+print "not " if $udpa->connected;
+print "ok 7\n";

diff --git a/ext/IO/lib/IO/t/io_unix.t b/ext/IO/lib/IO/t/io_unix.t
new file mode 100644 (file)
index 0000000..2f6def0
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_unix.t
@@ -0,0 +1,89 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+       my $reason;
+       if (! $Config{'d_fork'}) {
+           $reason = 'no fork';
+       }
+       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
+           $reason = 'Socket extension unavailable';
+       }
+       elsif ($Config{'extensions'} !~ /\bIO\b/) {
+           $reason = 'IO extension unavailable';
+       }
+       elsif ($^O eq 'os2') {
+           require IO::Socket;
+
+           eval {IO::Socket::pack_sockaddr_un('/tmp/foo') || 1}
+             or $@ !~ /not implemented/ or
+               $reason = 'compiled without TCP/IP stack v4';
+       } elsif ($^O eq 'qnx') {
+           $reason = 'Not implemented';
+       }
+       undef $reason if $^O eq 'VMS' and $Config{d_socket};
+       if ($reason) {
+           print "1..0 # Skip: $reason\n";
+           exit 0;
+        }
+    }
+}
+
+$PATH = "/tmp/sock-$$";
+
+# Test if we can create the file within the tmp directory
+if (-e $PATH or not open(TEST, ">$PATH") and $^O ne 'os2') {
+    print "1..0 # Skip: cannot open '$PATH' for write\n";
+    exit 0;
+}
+close(TEST);
+unlink($PATH) or $^O eq 'os2' or die "Can't unlink $PATH: $!";
+
+# Start testing
+$| = 1;
+print "1..5\n";
+
+use IO::Socket;
+
+$listen = IO::Socket::UNIX->new(Local=>$PATH, Listen=>0) || die "$!";
+print "ok 1\n";
+
+if($pid = fork()) {
+
+    $sock = $listen->accept();
+    print "ok 2\n";
+
+    print $sock->getline();
+
+    print $sock "ok 4\n";
+
+    $sock->close;
+
+    waitpid($pid,0);
+    unlink($PATH) || $^O eq 'os2' || warn "Can't unlink $PATH: $!";
+
+    print "ok 5\n";
+
+} elsif(defined $pid) {
+
+    $sock = IO::Socket::UNIX->new(Peer => $PATH) or die "$!";
+
+    print $sock "ok 3\n";
+
+    print $sock->getline();
+
+    $sock->close;
+
+    exit;
+} else {
+ die;
+}

diff --git a/ext/IO/lib/IO/t/io_xs.t b/ext/IO/lib/IO/t/io_xs.t
new file mode 100644 (file)
index 0000000..2449fc4
--- /dev/null
+++ b/ext/IO/lib/IO/t/io_xs.t
@@ -0,0 +1,43 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+           print "1..0\n";
+           exit 0;
+        }
+    }
+}
+
+use IO::File;
+use IO::Seekable;
+
+print "1..4\n";
+
+$x = new_tmpfile IO::File or print "not ";
+print "ok 1\n";
+print $x "ok 2\n";
+$x->seek(0,SEEK_SET);
+print <$x>;
+
+$x->seek(0,SEEK_SET);
+print $x "not ok 3\n";
+$p = $x->getpos;
+print $x "ok 3\n";
+$x->flush;
+$x->setpos($p);
+print scalar <$x>;
+
+$! = 0;
+$x->setpos(undef);
+print $! ? "ok 4 # $!\n" : "not ok 4\n";
+

diff --git a/ext/List/Util/t/blessed.t b/ext/List/Util/t/blessed.t
new file mode 100755 (executable)
index 0000000..89a740a
--- /dev/null
+++ b/ext/List/Util/t/blessed.t
@@ -0,0 +1,39 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+use Scalar::Util qw(blessed);
+use vars qw($t $y $x);
+
+print "1..7\n";
+
+print "not " if blessed(1);
+print "ok 1\n";
+
+print "not " if blessed('A');
+print "ok 2\n";
+
+print "not " if blessed({});
+print "ok 3\n";
+
+print "not " if blessed([]);
+print "ok 4\n";
+
+$y = \$t;
+
+print "not " if blessed($y);
+print "ok 5\n";
+
+$x = bless [], "ABC";
+
+print "not " unless blessed($x);
+print "ok 6\n";
+
+print "not " unless blessed($x) eq 'ABC';
+print "ok 7\n";

diff --git a/ext/List/Util/t/dualvar.t b/ext/List/Util/t/dualvar.t
new file mode 100755 (executable)
index 0000000..5bf4fe9
--- /dev/null
+++ b/ext/List/Util/t/dualvar.t
@@ -0,0 +1,46 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+BEGIN {
+  require Scalar::Util;
+
+  if (grep { /dualvar/ } @Scalar::Util::EXPORT_FAIL) {
+    print "1..0\n";
+    exit;
+  }
+}
+
+use Scalar::Util qw(dualvar);
+
+print "1..6\n";
+
+$var = dualvar 2.2,"string";
+
+print "not " unless $var == 2.2;
+print "ok 1\n";
+
+print "not " unless $var eq "string";
+print "ok 2\n";
+
+$var2 = $var;
+
+$var++;
+
+print "not " unless $var == 3.2;
+print "ok 3\n";
+
+print "not " unless $var ne "string";
+print "ok 4\n";
+
+print "not " unless $var2 == 2.2;
+print "ok 5\n";
+
+print "not " unless $var2 eq "string";
+print "ok 6\n";

diff --git a/ext/List/Util/t/first.t b/ext/List/Util/t/first.t
new file mode 100755 (executable)
index 0000000..6a35948
--- /dev/null
+++ b/ext/List/Util/t/first.t
@@ -0,0 +1,25 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+use List::Util qw(first);
+
+print "1..4\n";
+
+print "not " unless defined &first;
+print "ok 1\n";
+
+print "not " unless 9 == first { 8 == ($_ - 1) } 9,4,5,6;
+print "ok 2\n";
+
+print "not " if defined(first { 0 } 1,2,3,4);
+print "ok 3\n";
+
+print "not " if defined(first { 0 });
+print "ok 4\n";

diff --git a/ext/List/Util/t/max.t b/ext/List/Util/t/max.t
new file mode 100755 (executable)
index 0000000..911003b
--- /dev/null
+++ b/ext/List/Util/t/max.t
@@ -0,0 +1,30 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+use List::Util qw(max);
+
+print "1..5\n";
+
+print "not " unless defined &max;
+print "ok 1\n";
+
+print "not " unless max(1) == 1;
+print "ok 2\n";
+
+print "not " unless max(1,2) == 2;
+print "ok 3\n";
+
+print "not " unless max(2,1) == 2;
+print "ok 4\n";
+
+my @a = map { rand() } 1 .. 20;
+my @b = sort { $a <=> $b } @a;
+print "not " unless max(@a) == $b[-1];
+print "ok 5\n";

diff --git a/ext/List/Util/t/maxstr.t b/ext/List/Util/t/maxstr.t
new file mode 100755 (executable)
index 0000000..0ec35ca
--- /dev/null
+++ b/ext/List/Util/t/maxstr.t
@@ -0,0 +1,30 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+use List::Util qw(maxstr);
+
+print "1..5\n";
+
+print "not " unless defined &maxstr;
+print "ok 1\n";
+
+print "not " unless maxstr('a') eq 'a';
+print "ok 2\n";
+
+print "not " unless maxstr('a','b') eq 'b';
+print "ok 3\n";
+
+print "not " unless maxstr('B','A') eq 'B';
+print "ok 4\n";
+
+my @a = map { pack("u", pack("C*",map { int(rand(256))} (0..int(rand(10) + 2)))) } 0 .. 20;
+my @b = sort { $a cmp $b } @a;
+print "not " unless maxstr(@a) eq $b[-1];
+print "ok 5\n";

diff --git a/ext/List/Util/t/min.t b/ext/List/Util/t/min.t
new file mode 100755 (executable)
index 0000000..a51ced4
--- /dev/null
+++ b/ext/List/Util/t/min.t
@@ -0,0 +1,30 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+use List::Util qw(min);
+
+print "1..5\n";
+
+print "not " unless defined &min;
+print "ok 1\n";
+
+print "not " unless min(9) == 9;
+print "ok 2\n";
+
+print "not " unless min(1,2) == 1;
+print "ok 3\n";
+
+print "not " unless min(2,1) == 1;
+print "ok 4\n";
+
+my @a = map { rand() } 1 .. 20;
+my @b = sort { $a <=> $b } @a;
+print "not " unless min(@a) == $b[0];
+print "ok 5\n";

diff --git a/ext/List/Util/t/minstr.t b/ext/List/Util/t/minstr.t
new file mode 100755 (executable)
index 0000000..c000e78
--- /dev/null
+++ b/ext/List/Util/t/minstr.t
@@ -0,0 +1,30 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+use List::Util qw(minstr);
+
+print "1..5\n";
+
+print "not " unless defined &minstr;
+print "ok 1\n";
+
+print "not " unless minstr('a') eq 'a';
+print "ok 2\n";
+
+print "not " unless minstr('a','b') eq 'a';
+print "ok 3\n";
+
+print "not " unless minstr('B','A') eq 'A';
+print "ok 4\n";
+
+my @a = map { pack("u", pack("C*",map { int(rand(256))} (0..int(rand(10) + 2)))) } 0 .. 20;
+my @b = sort { $a cmp $b } @a;
+print "not " unless minstr(@a) eq $b[0];
+print "ok 5\n";

diff --git a/ext/List/Util/t/readonly.t b/ext/List/Util/t/readonly.t
new file mode 100644 (file)
index 0000000..864e1f1
--- /dev/null
+++ b/ext/List/Util/t/readonly.t
@@ -0,0 +1,46 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+use Scalar::Util qw(readonly);
+
+print "1..9\n";
+
+print "not " unless readonly(1);
+print "ok 1\n";
+
+my $var = 2;
+
+print "not " if readonly($var);
+print "ok 2\n";
+
+print "not " unless $var == 2;
+print "ok 3\n";
+
+print "not " unless readonly("fred");
+print "ok 4\n";
+
+$var = "fred";
+
+print "not " if readonly($var);
+print "ok 5\n";
+
+print "not " unless $var eq "fred";
+print "ok 6\n";
+
+$var = \2;
+
+print "not " if readonly($var);
+print "ok 7\n";
+
+print "not " unless readonly($$var);
+print "ok 8\n";
+
+print "not " if readonly(*STDOUT);
+print "ok 9\n";

diff --git a/ext/List/Util/t/reduce.t b/ext/List/Util/t/reduce.t
new file mode 100755 (executable)
index 0000000..063e0b7
--- /dev/null
+++ b/ext/List/Util/t/reduce.t
@@ -0,0 +1,30 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+use List::Util qw(reduce min);
+
+print "1..5\n";
+
+print "not " if defined reduce {};
+print "ok 1\n";
+
+print "not " unless 9 == reduce { $a / $b } 756,3,7,4;
+print "ok 2\n";
+
+print "not " unless 9 == reduce { $a / $b } 9;
+print "ok 3\n";
+
+@a = map { rand } 0 .. 20;
+print "not " unless min(@a) == reduce { $a < $b ? $a : $b } @a;
+print "ok 4\n";
+
+@a = map { pack("C", int(rand(256))) } 0 .. 20;
+print "not " unless join("",@a) eq reduce { $a . $b } @a;
+print "ok 5\n";

diff --git a/ext/List/Util/t/reftype.t b/ext/List/Util/t/reftype.t
new file mode 100755 (executable)
index 0000000..ea7ea7b
--- /dev/null
+++ b/ext/List/Util/t/reftype.t
@@ -0,0 +1,55 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+use Scalar::Util qw(reftype);
+use vars qw($t $y $x *F);
+use Symbol qw(gensym);
+
+# Ensure we do not trigger and tied methods
+tie *F, 'MyTie';
+
+@test = (
+ [ undef, 1],
+ [ undef, 'A'],
+ [ HASH => {} ],
+ [ ARRAY => [] ],
+ [ SCALAR => \$t ],
+ [ REF    => \(\$t) ],
+ [ GLOB   => \*F ],
+ [ GLOB   => gensym ],
+ [ CODE   => sub {} ],
+# [ IO => *STDIN{IO} ] the internal sv_reftype returns UNKNOWN
+);
+
+print "1..", @test*4, "\n";
+
+my $i = 1;
+foreach $test (@test) {
+  my($type,$what) = @$test;
+  my $pack;
+  foreach $pack (undef,"ABC","0",undef) {
+    print "# $what\n";
+    my $res = reftype($what);
+    printf "# %s - %s\n", map { defined($_) ? $_ : 'undef' } $type,$res;
+    print "not " if $type ? $res ne $type : defined($res);
+    bless $what, $pack if $type && defined $pack;
+    print "ok ",$i++,"\n";
+  }
+}
+
+package MyTie;
+
+sub TIEHANDLE { bless {} }
+sub DESTROY {}
+
+sub AUTOLOAD {
+  warn "$AUTOLOAD called";
+  exit 1; # May be in an eval
+}

diff --git a/ext/List/Util/t/sum.t b/ext/List/Util/t/sum.t
new file mode 100755 (executable)
index 0000000..34fb690
--- /dev/null
+++ b/ext/List/Util/t/sum.t
@@ -0,0 +1,23 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+use List::Util qw(sum);
+
+print "1..3\n";
+
+print "not " if defined sum;
+print "ok 1\n";
+
+print "not " unless sum(9) == 9;
+print "ok 2\n";
+
+print "not " unless sum(1,2,3,4) == 10;
+print "ok 3\n";
+

diff --git a/ext/List/Util/t/tainted.t b/ext/List/Util/t/tainted.t
new file mode 100644 (file)
index 0000000..5587bb7
--- /dev/null
+++ b/ext/List/Util/t/tainted.t
@@ -0,0 +1,38 @@
+#!./perl -T
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+use lib qw(blib/lib blib/arch);
+use Scalar::Util qw(tainted);
+use Config;
+
+print "1..5\n";
+
+print "not " if tainted(1);
+print "ok 1\n";
+
+my $var = 2;
+
+print "not " if tainted($var);
+print "ok 2\n";
+
+my $key = (keys %ENV)[0];
+
+$var = $ENV{$key};
+
+print "not " unless tainted($var);
+print "ok 3\n";
+
+print "not " unless tainted($ENV{$key});
+print "ok 4\n";
+
+print "not " if @ARGV and not tainted($ARGV[0]);
+print "ok 5\n";

diff --git a/ext/List/Util/t/weak.t b/ext/List/Util/t/weak.t
new file mode 100755 (executable)
index 0000000..6c7bea7
--- /dev/null
+++ b/ext/List/Util/t/weak.t
@@ -0,0 +1,206 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+}
+
+BEGIN {
+  $|=1;
+  require Scalar::Util;
+  if (grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) {
+    print("1..0\n");
+    exit;
+  }
+
+  $DEBUG = 0;
+
+  if ($DEBUG && eval { require Devel::Peek } ) {
+    Devel::Peek->import('Dump');
+  }
+  else {
+    *Dump = sub {};
+  }
+}
+
+use Scalar::Util qw(weaken isweak);
+print "1..17\n";
+
+######################### End of black magic.
+
+$cnt = 0;
+
+sub ok {
+       ++$cnt;
+       if($_[0]) { print "ok $cnt\n"; } else {print "not ok $cnt\n"; }
+}
+
+$| = 1;
+
+if(1) {
+
+my ($y,$z);
+
+#
+# Case 1: two references, one is weakened, the other is then undef'ed.
+#
+
+{
+       my $x = "foo";
+       $y = \$x;
+       $z = \$x;
+}
+print "# START:\n";
+Dump($y); Dump($z);
+
+ok( $y ne "" and $z ne "" );
+weaken($y);
+
+print "# WEAK:\n";
+Dump($y); Dump($z);
+
+ok( $y ne "" and $z ne "" );
+undef($z);
+
+print "# UNDZ:\n";
+Dump($y); Dump($z);
+
+ok( not (defined($y) and defined($z)) );
+undef($y);
+
+print "# UNDY:\n";
+Dump($y); Dump($z);
+
+ok( not (defined($y) and defined($z)) );
+
+print "# FIN:\n";
+Dump($y); Dump($z);
+
+# exit(0);
+
+# }
+# {
+
+# 
+# Case 2: one reference, which is weakened
+#
+
+# kill 5,$$;
+
+print "# CASE 2:\n";
+
+{
+       my $x = "foo";
+       $y = \$x;
+}
+
+ok( $y ne "" );
+print "# BW: \n";
+Dump($y);
+weaken($y);
+print "# AW: \n";
+Dump($y);
+ok( not defined $y  );
+
+print "# EXITBLOCK\n";
+}
+
+# exit(0);
+
+# 
+# Case 3: a circular structure
+#
+
+# kill 5, $$;
+
+$flag = 0;
+{
+       my $y = bless {}, Dest;
+       Dump($y);
+       print "# 1: $y\n";
+       $y->{Self} = $y;
+       Dump($y);
+       print "# 2: $y\n";
+       $y->{Flag} = \$flag;
+       print "# 3: $y\n";
+       weaken($y->{Self});
+       print "# WKED\n";
+       ok( $y ne "" );
+       print "# VALS: HASH ",$y,"   SELF ",\$y->{Self},"  Y ",\$y, 
+               "    FLAG: ",\$y->{Flag},"\n";
+       print "# VPRINT\n";
+}
+print "# OUT $flag\n";
+ok( $flag == 1 );
+
+print "# AFTER\n";
+
+undef $flag;
+
+print "# FLAGU\n";
+
+#
+# Case 4: a more complicated circular structure
+#
+
+$flag = 0;
+{
+       my $y = bless {}, Dest;
+       my $x = bless {}, Dest;
+       $x->{Ref} = $y;
+       $y->{Ref} = $x;
+       $x->{Flag} = \$flag;
+       $y->{Flag} = \$flag;
+       weaken($x->{Ref});
+}
+ok( $flag == 2 );
+
+#
+# Case 5: deleting a weakref before the other one
+#
+
+{
+       my $x = "foo";
+       $y = \$x;
+       $z = \$x;
+}
+
+print "# CASE5\n";
+Dump($y);
+
+weaken($y);
+Dump($y);
+undef($y);
+
+ok( not defined $y);
+ok($z ne "");
+
+
+#
+# Case 6: test isweakref
+#
+
+$a = 5;
+ok(!isweak($a));
+$b = \$a;
+ok(!isweak($b));
+weaken($b);
+ok(isweak($b));
+$b = \$a;
+ok(!isweak($b));
+
+$x = {};
+weaken($x->{Y} = \$a);
+ok(isweak($x->{Y}));
+ok(!isweak($x->{Z}));
+
+
+package Dest;
+
+sub DESTROY {
+       print "# INCFLAG\n";
+       ${$_[0]{Flag}} ++;
+}

diff --git a/ext/MIME/Base64/t/base64.t b/ext/MIME/Base64/t/base64.t
new file mode 100644 (file)
index 0000000..7a61fe9
--- /dev/null
+++ b/ext/MIME/Base64/t/base64.t
@@ -0,0 +1,383 @@
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use MIME::Base64;
+
+print "1..283\n";
+
+print "# Testing MIME::Base64-", $MIME::Base64::VERSION, "\n";
+
+BEGIN {
+ if (ord('A') == 41) {
+  *ASCII = sub { return $_[0] };
+ }
+ else {
+  require Encode;
+  *ASCII = sub { Encode::encode('ascii',$_[0]) };
+ }
+}
+
+$testno = 1;
+
+encodeTest();
+decodeTest();
+
+# This used to generate a warning
+print "not " unless decode_base64(encode_base64("foo")) eq "foo";
+print "ok ", $testno++, "\n";
+
+sub encodeTest
+{
+    print "# encode test\n";
+
+    my @encode_tests = (
+       # All values
+       ["\000" => "AA=="],
+       ["\001" => "AQ=="],
+       ["\002" => "Ag=="],
+       ["\003" => "Aw=="],
+       ["\004" => "BA=="],
+       ["\005" => "BQ=="],
+       ["\006" => "Bg=="],
+       ["\007" => "Bw=="],
+       ["\010" => "CA=="],
+       ["\011" => "CQ=="],
+       ["\012" => "Cg=="],
+       ["\013" => "Cw=="],
+       ["\014" => "DA=="],
+       ["\015" => "DQ=="],
+       ["\016" => "Dg=="],
+       ["\017" => "Dw=="],
+       ["\020" => "EA=="],
+       ["\021" => "EQ=="],
+       ["\022" => "Eg=="],
+       ["\023" => "Ew=="],
+       ["\024" => "FA=="],
+       ["\025" => "FQ=="],
+       ["\026" => "Fg=="],
+       ["\027" => "Fw=="],
+       ["\030" => "GA=="],
+       ["\031" => "GQ=="],
+       ["\032" => "Gg=="],
+       ["\033" => "Gw=="],
+       ["\034" => "HA=="],
+       ["\035" => "HQ=="],
+       ["\036" => "Hg=="],
+       ["\037" => "Hw=="],
+       ["\040" => "IA=="],
+       ["\041" => "IQ=="],
+       ["\042" => "Ig=="],
+       ["\043" => "Iw=="],
+       ["\044" => "JA=="],
+       ["\045" => "JQ=="],
+       ["\046" => "Jg=="],
+       ["\047" => "Jw=="],
+       ["\050" => "KA=="],
+       ["\051" => "KQ=="],
+       ["\052" => "Kg=="],
+       ["\053" => "Kw=="],
+       ["\054" => "LA=="],
+       ["\055" => "LQ=="],
+       ["\056" => "Lg=="],
+       ["\057" => "Lw=="],
+       ["\060" => "MA=="],
+       ["\061" => "MQ=="],
+       ["\062" => "Mg=="],
+       ["\063" => "Mw=="],
+       ["\064" => "NA=="],
+       ["\065" => "NQ=="],
+       ["\066" => "Ng=="],
+       ["\067" => "Nw=="],
+       ["\070" => "OA=="],
+       ["\071" => "OQ=="],
+       ["\072" => "Og=="],
+       ["\073" => "Ow=="],
+       ["\074" => "PA=="],
+       ["\075" => "PQ=="],
+       ["\076" => "Pg=="],
+       ["\077" => "Pw=="],
+       ["\100" => "QA=="],
+       ["\101" => "QQ=="],
+       ["\102" => "Qg=="],
+       ["\103" => "Qw=="],
+       ["\104" => "RA=="],
+       ["\105" => "RQ=="],
+       ["\106" => "Rg=="],
+       ["\107" => "Rw=="],
+       ["\110" => "SA=="],
+       ["\111" => "SQ=="],
+       ["\112" => "Sg=="],
+       ["\113" => "Sw=="],
+       ["\114" => "TA=="],
+       ["\115" => "TQ=="],
+       ["\116" => "Tg=="],
+       ["\117" => "Tw=="],
+       ["\120" => "UA=="],
+       ["\121" => "UQ=="],
+       ["\122" => "Ug=="],
+       ["\123" => "Uw=="],
+       ["\124" => "VA=="],
+       ["\125" => "VQ=="],
+       ["\126" => "Vg=="],
+       ["\127" => "Vw=="],
+       ["\130" => "WA=="],
+       ["\131" => "WQ=="],
+       ["\132" => "Wg=="],
+       ["\133" => "Ww=="],
+       ["\134" => "XA=="],
+       ["\135" => "XQ=="],
+       ["\136" => "Xg=="],
+       ["\137" => "Xw=="],
+       ["\140" => "YA=="],
+       ["\141" => "YQ=="],
+       ["\142" => "Yg=="],
+       ["\143" => "Yw=="],
+       ["\144" => "ZA=="],
+       ["\145" => "ZQ=="],
+       ["\146" => "Zg=="],
+       ["\147" => "Zw=="],
+       ["\150" => "aA=="],
+       ["\151" => "aQ=="],
+       ["\152" => "ag=="],
+       ["\153" => "aw=="],
+       ["\154" => "bA=="],
+       ["\155" => "bQ=="],
+       ["\156" => "bg=="],
+       ["\157" => "bw=="],
+       ["\160" => "cA=="],
+       ["\161" => "cQ=="],
+       ["\162" => "cg=="],
+       ["\163" => "cw=="],
+       ["\164" => "dA=="],
+       ["\165" => "dQ=="],
+       ["\166" => "dg=="],
+       ["\167" => "dw=="],
+       ["\170" => "eA=="],
+       ["\171" => "eQ=="],
+       ["\172" => "eg=="],
+       ["\173" => "ew=="],
+       ["\174" => "fA=="],
+       ["\175" => "fQ=="],
+       ["\176" => "fg=="],
+       ["\177" => "fw=="],
+       ["\200" => "gA=="],
+       ["\201" => "gQ=="],
+       ["\202" => "gg=="],
+       ["\203" => "gw=="],
+       ["\204" => "hA=="],
+       ["\205" => "hQ=="],
+       ["\206" => "hg=="],
+       ["\207" => "hw=="],
+       ["\210" => "iA=="],
+       ["\211" => "iQ=="],
+       ["\212" => "ig=="],
+       ["\213" => "iw=="],
+       ["\214" => "jA=="],
+       ["\215" => "jQ=="],
+       ["\216" => "jg=="],
+       ["\217" => "jw=="],
+       ["\220" => "kA=="],
+       ["\221" => "kQ=="],
+       ["\222" => "kg=="],
+       ["\223" => "kw=="],
+       ["\224" => "lA=="],
+       ["\225" => "lQ=="],
+       ["\226" => "lg=="],
+       ["\227" => "lw=="],
+       ["\230" => "mA=="],
+       ["\231" => "mQ=="],
+       ["\232" => "mg=="],
+       ["\233" => "mw=="],
+       ["\234" => "nA=="],
+       ["\235" => "nQ=="],
+       ["\236" => "ng=="],
+       ["\237" => "nw=="],
+       ["\240" => "oA=="],
+       ["\241" => "oQ=="],
+       ["\242" => "og=="],
+       ["\243" => "ow=="],
+       ["\244" => "pA=="],
+       ["\245" => "pQ=="],
+       ["\246" => "pg=="],
+       ["\247" => "pw=="],
+       ["\250" => "qA=="],
+       ["\251" => "qQ=="],
+       ["\252" => "qg=="],
+       ["\253" => "qw=="],
+       ["\254" => "rA=="],
+       ["\255" => "rQ=="],
+       ["\256" => "rg=="],
+       ["\257" => "rw=="],
+       ["\260" => "sA=="],
+       ["\261" => "sQ=="],
+       ["\262" => "sg=="],
+       ["\263" => "sw=="],
+       ["\264" => "tA=="],
+       ["\265" => "tQ=="],
+       ["\266" => "tg=="],
+       ["\267" => "tw=="],
+       ["\270" => "uA=="],
+       ["\271" => "uQ=="],
+       ["\272" => "ug=="],
+       ["\273" => "uw=="],
+       ["\274" => "vA=="],
+       ["\275" => "vQ=="],
+       ["\276" => "vg=="],
+       ["\277" => "vw=="],
+       ["\300" => "wA=="],
+       ["\301" => "wQ=="],
+       ["\302" => "wg=="],
+       ["\303" => "ww=="],
+       ["\304" => "xA=="],
+       ["\305" => "xQ=="],
+       ["\306" => "xg=="],
+       ["\307" => "xw=="],
+       ["\310" => "yA=="],
+       ["\311" => "yQ=="],
+       ["\312" => "yg=="],
+       ["\313" => "yw=="],
+       ["\314" => "zA=="],
+       ["\315" => "zQ=="],
+       ["\316" => "zg=="],
+       ["\317" => "zw=="],
+       ["\320" => "0A=="],
+       ["\321" => "0Q=="],
+       ["\322" => "0g=="],
+       ["\323" => "0w=="],
+       ["\324" => "1A=="],
+       ["\325" => "1Q=="],
+       ["\326" => "1g=="],
+       ["\327" => "1w=="],
+       ["\330" => "2A=="],
+       ["\331" => "2Q=="],
+       ["\332" => "2g=="],
+       ["\333" => "2w=="],
+       ["\334" => "3A=="],
+       ["\335" => "3Q=="],
+       ["\336" => "3g=="],
+       ["\337" => "3w=="],
+       ["\340" => "4A=="],
+       ["\341" => "4Q=="],
+       ["\342" => "4g=="],
+       ["\343" => "4w=="],
+       ["\344" => "5A=="],
+       ["\345" => "5Q=="],
+       ["\346" => "5g=="],
+       ["\347" => "5w=="],
+       ["\350" => "6A=="],
+       ["\351" => "6Q=="],
+       ["\352" => "6g=="],
+       ["\353" => "6w=="],
+       ["\354" => "7A=="],
+       ["\355" => "7Q=="],
+       ["\356" => "7g=="],
+       ["\357" => "7w=="],
+       ["\360" => "8A=="],
+       ["\361" => "8Q=="],
+       ["\362" => "8g=="],
+       ["\363" => "8w=="],
+       ["\364" => "9A=="],
+       ["\365" => "9Q=="],
+       ["\366" => "9g=="],
+       ["\367" => "9w=="],
+       ["\370" => "+A=="],
+       ["\371" => "+Q=="],
+       ["\372" => "+g=="],
+       ["\373" => "+w=="],
+       ["\374" => "/A=="],
+       ["\375" => "/Q=="],
+       ["\376" => "/g=="],
+       ["\377" => "/w=="],
+
+       ["\000\377" => "AP8="],
+       ["\377\000" => "/wA="],
+       ["\000\000\000" => "AAAA"],
+
+        [''    => ''],
+       [ASCII('a')   => 'YQ=='],
+       [ASCII('aa')  => 'YWE='],
+       [ASCII('aaa') => 'YWFh'],
+
+       [ASCII('aaa') => 'YWFh'],
+       [ASCII('aaa') => 'YWFh'],
+       [ASCII('aaa') => 'YWFh'],
+
+
+       # from HTTP spec
+       [ASCII('Aladdin:open sesame') => 'QWxhZGRpbjpvcGVuIHNlc2FtZQ=='],
+
+       [ASCII('a') x 100 => 'YWFh' x 33 . 'YQ=='],
+
+       [ASCII('Multipurpose Internet Mail Extensions: The Base64 Content-Transfer-Encoding is designed to represent sequences of octets in a form that is not humanly readable. ')
+       => "TXVsdGlwdXJwb3NlIEludGVybmV0IE1haWwgRXh0ZW5zaW9uczogVGhlIEJhc2U2NCBDb250ZW50LVRyYW5zZmVyLUVuY29kaW5nIGlzIGRlc2lnbmVkIHRvIHJlcHJlc2VudCBzZXF1ZW5jZXMgb2Ygb2N0ZXRzIGluIGEgZm9ybSB0aGF0IGlzIG5vdCBodW1hbmx5IHJlYWRhYmxlLiA="],
+
+    );
+
+    for $test (@encode_tests) {
+       my($plain, $expected) = ($$test[0], $$test[1]);
+
+       my $encoded = encode_base64($plain, '');
+       if ($encoded ne $expected) {
+           print "test $testno ($plain): expected $expected, got $encoded\n";
+            print "not ";
+       }
+       my $decoded = decode_base64($encoded);
+       if ($decoded ne $plain) {
+           print "test $testno ($encoded): expected $plain, got $decoded\n";
+            print "not ";
+       }
+
+       if (ord('A') != 193) { # perl versions broken on EBCDIC
+       # Try the old Perl versions too
+       if ($encoded ne MIME::Base64::old_encode_base64($plain, '')) {
+           print "old_encode_base64 give different result.\n";
+           print "not ";
+        }
+       if ($plain ne MIME::Base64::old_decode_base64($encoded)) {
+           print "old_decode_base64 give different result.\n";
+           print "not ";
+        }
+       }
+               
+       print "ok $testno\n";
+       $testno++;
+    }
+}
+
+sub decodeTest
+{
+    print "# decode test\n";
+
+    local $SIG{__WARN__} = sub { print $_[0] };  # avoid warnings on stderr
+
+    my @decode_tests = (
+       ['YWE='   => ASCII('aa')],
+       [' YWE='  =>  ASCII('aa')],
+       ['Y WE='  =>  ASCII('aa')],
+       ['YWE= '  =>  ASCII('aa')],
+       ["Y\nW\r\nE=" =>  ASCII('aa')],
+
+       # These will generate some warnings
+        ['YWE=====' =>  ASCII('aa')],    # extra padding
+       ['YWE'      =>  ASCII('aa')],    # missing padding
+        ['YWFh====' =>  ASCII('aaa')],
+        ['YQ'       =>  ASCII('a')],
+        ['Y'        => ''],
+        ['x=='      => ''],
+        [''         => ''],
+        [undef()    => ''],
+    );
+
+    for $test (@decode_tests) {
+       my($encoded, $expected) = ($$test[0], $$test[1]);
+
+       my $decoded = decode_base64($encoded);
+       if ($decoded ne $expected) {
+           die "test $testno ($encoded): expected $expected, got $decoded\n";
+       }
+       print "ok $testno\n";
+       $testno++;
+    }
+}

diff --git a/ext/MIME/Base64/t/qp.t b/ext/MIME/Base64/t/qp.t
new file mode 100644 (file)
index 0000000..1a7f9e4
--- /dev/null
+++ b/ext/MIME/Base64/t/qp.t
@@ -0,0 +1,113 @@
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use MIME::QuotedPrint;
+
+$x70 = "x" x 70;
+
+@tests =
+  (
+   # plain ascii should not be encoded
+   ["quoted printable"  =>
+    "quoted printable"],
+
+   # 8-bit chars should be encoded
+   ["v\xe5re kj\xe6re norske tegn b\xf8r \xe6res" =>
+    "v=E5re kj=E6re norske tegn b=F8r =E6res"],
+
+   # trailing space should be encoded
+   ["  " => "=20=20"],
+   ["\tt\t" => "\tt=09"],
+   ["test  \ntest\n\t \t \n" => "test=20=20\ntest\n=09=20=09=20\n"],
+
+   # "=" is special an should be decoded
+   ["=\n" => "=3D\n"],
+   ["\0\xff" => "=00=FF"],
+
+   # Very long lines should be broken (not more than 76 chars
+   ["The Quoted-Printable encoding is intended to represent data that largly consists of octets that correspond to printable characters in the ASCII character set." =>
+    "The Quoted-Printable encoding is intended to represent data that largly con=
+sists of octets that correspond to printable characters in the ASCII charac=
+ter set."
+    ],
+
+   # Long lines after short lines were broken through 2.01.
+   ["short line
+In America, any boy may become president and I suppose that's just one of the risks he takes. -- Adlai Stevenson" =>
+    "short line
+In America, any boy may become president and I suppose that's just one of t=
+he risks he takes. -- Adlai Stevenson"],
+
+   # My (roderick@argon.org) first crack at fixing that bug failed for
+   # multiple long lines.
+   ["College football is a game which would be much more interesting if the faculty played instead of the students, and even more interesting if the
+trustees played.  There would be a great increase in broken arms, legs, and necks, and simultaneously an appreciable diminution in the loss to humanity. -- H. L. Mencken" =>
+    "College football is a game which would be much more interesting if the facu=
+lty played instead of the students, and even more interesting if the
+trustees played.  There would be a great increase in broken arms, legs, and=
+ necks, and simultaneously an appreciable diminution in the loss to humanit=
+y. -- H. L. Mencken"],
+
+   # Don't break a line that's near but not over 76 chars.
+   ["$x70!23"          => "$x70!23"],
+   ["$x70!234"         => "$x70!234"],
+   ["$x70!2345"                => "$x70!2345"],
+   ["$x70!23456"       => "$x70!23456"],
+   ["$x70!23\n"                => "$x70!23\n"],
+   ["$x70!234\n"       => "$x70!234\n"],
+   ["$x70!2345\n"      => "$x70!2345\n"],
+   ["$x70!23456\n"     => "$x70!23456\n"],
+
+   # Not allowed to break =XX escapes using soft line break
+   ["$x70===xxxx" => "$x70=3D=\n=3D=3Dxxxx"],
+   ["$x70!===xxx" => "$x70!=3D=\n=3D=3Dxxx"],
+   ["$x70!!===xx" => "$x70!!=3D=\n=3D=3Dxx"],
+   ["$x70!!!===x" => "$x70!!!=\n=3D=3D=3Dx"],
+   #                            ^
+   #                    70123456|
+   #                           max
+   #                        line width
+);
+
+$notests = @tests + 2;
+print "1..$notests\n";
+
+$testno = 0;
+for (@tests) {
+    $testno++;
+    ($plain, $encoded) = @$_;
+    if (ord('A') == 193) {  # EBCDIC 8 bit chars are different
+        if ($testno == 2) { $plain =~ s/\xe5/\x47/; $plain =~ s/\xe6/\x9c/g; $plain =~ s/\xf8/\x70/; }
+        if ($testno == 7) { $plain =~ s/\xff/\xdf/; }
+    }
+    $x = encode_qp($plain);
+    if ($x ne $encoded) {
+       print "Encode test failed\n";
+       print "Got:      '$x'\n";
+       print "Expected: '$encoded'\n";
+       print "not ok $testno\n";
+       next;
+    }
+    $x = decode_qp($encoded);
+    if ($x ne $plain) {
+       print "Decode test failed\n";
+       print "Got:      '$x'\n";
+       print "Expected: '$plain'\n";
+       print "not ok $testno\n";
+       next;
+    }
+    print "ok $testno\n";
+}
+
+# Some extra testing for a case that was wrong until libwww-perl-5.09
+print "not " unless decode_qp("foo  \n\nfoo =\n\nfoo=20\n\n") eq
+                                "foo\n\nfoo \nfoo \n\n";
+$testno++; print "ok $testno\n";
+
+# Same test but with "\r\n" terminated lines
+print "not " unless decode_qp("foo  \r\n\r\nfoo =\r\n\r\nfoo=20\r\n\r\n") eq
+                                "foo\r\n\r\nfoo \r\nfoo \r\n\r\n";
+$testno++; print "ok $testno\n";
+

diff --git a/ext/MIME/Base64/t/unicode.t b/ext/MIME/Base64/t/unicode.t
new file mode 100644 (file)
index 0000000..0b8df1a
--- /dev/null
+++ b/ext/MIME/Base64/t/unicode.t
@@ -0,0 +1,16 @@
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+print "1..1\n";
+
+require MIME::Base64;
+
+eval {
+    MIME::Base64::encode(v300);
+};
+
+print "not " unless $@;
+print "ok 1\n";
+

diff --git a/ext/NDBM_File/ndbm.t b/ext/NDBM_File/ndbm.t
new file mode 100755 (executable)
index 0000000..cb975e0
--- /dev/null
+++ b/ext/NDBM_File/ndbm.t
@@ -0,0 +1,420 @@
+#!./perl
+
+# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bNDBM_File\b/) {
+       print "1..0 # Skip: NDBM_File was not built\n";
+       exit 0;
+    }
+}
+
+use strict;
+use warnings;
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+require NDBM_File;
+#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
+use Fcntl;
+
+print "1..65\n";
+
+unlink <Op.dbmx*>;
+
+umask(0);
+my %h;
+ok(1, tie(%h,'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640));
+
+my $Dfile = "Op.dbmx.pag";
+if (! -e $Dfile) {
+       ($Dfile) = <Op.dbmx*>;
+}
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare') {
+    print "ok 2 # Skipped: different file permission semantics\n";
+}
+else {
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+     $blksize,$blocks) = stat($Dfile);
+    print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
+}
+my $i = 0;
+while (my ($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+untie(%h);
+print (tie(%h,'NDBM_File','Op.dbmx', &O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+my @keys = keys(%h);
+my @values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (my ($key,$value) = each(%h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+       $key =~ y/a-z/A-Z/;
+       $i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(%h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+$h{'foo'} = '';
+$h{''} = 'bar';
+
+# check cache overflow and numeric keys and contents
+my $ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+@h{0..200} = 200..400;
+my @foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
+
+print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+untie %h;
+unlink 'Op.dbmx.dir', $Dfile;
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+   use warnings ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use warnings ;
+   use vars qw(@ISA @EXPORT) ;
+
+   require Exporter ;
+   use NDBM_File;
+   @ISA=qw(NDBM_File);
+   @EXPORT = @NDBM_File::EXPORT if defined @NDBM_File::EXPORT ;
+
+   sub STORE { 
+       my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+       my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+       my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+       return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+
+    eval 'use SubDB ; use Fcntl ; ';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+       $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 );
+       ' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(17, $@ eq "") ;
+    main::ok(18, $ret eq "[[5]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", <dbhash.tmp*> ;
+
+}
+
+{
+   # DBM Filter tests
+   use strict ;
+   use warnings ;
+   my (%h, $db) ;
+   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+
+   sub checkOutput
+   {
+       my($fk, $sk, $fv, $sv) = @_ ;
+       return
+           $fetch_key eq $fk && $store_key eq $sk && 
+          $fetch_value eq $fv && $store_value eq $sv &&
+          $_ eq 'original' ;
+   }
+   
+   unlink <Op.dbmx*>;
+   ok(19, $db = tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
+
+   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
+   $db->filter_store_key   (sub { $store_key = $_ }) ;
+   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
+   $db->filter_store_value (sub { $store_value = $_ }) ;
+
+   $_ = "original" ;
+
+   $h{"fred"} = "joe" ;
+   #                   fk   sk     fv   sv
+   ok(20, checkOutput( "", "fred", "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(21, $h{"fred"} eq "joe");
+   #                   fk    sk     fv    sv
+   ok(22, checkOutput( "", "fred", "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(23, $db->FIRSTKEY() eq "fred") ;
+   #                    fk     sk  fv  sv
+   ok(24, checkOutput( "fred", "", "", "")) ;
+
+   # replace the filters, but remember the previous set
+   my ($old_fk) = $db->filter_fetch_key   
+                       (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
+   my ($old_sk) = $db->filter_store_key   
+                       (sub { $_ = lc $_ ; $store_key = $_ }) ;
+   my ($old_fv) = $db->filter_fetch_value 
+                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
+   my ($old_sv) = $db->filter_store_value 
+                       (sub { s/o/x/g; $store_value = $_ }) ;
+   
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"Fred"} = "Joe" ;
+   #                   fk   sk     fv    sv
+   ok(25, checkOutput( "", "fred", "", "Jxe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(26, $h{"Fred"} eq "[Jxe]");
+   #                   fk   sk     fv    sv
+   ok(27, checkOutput( "", "fred", "[Jxe]", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(28, $db->FIRSTKEY() eq "FRED") ;
+   #                   fk   sk     fv    sv
+   ok(29, checkOutput( "FRED", "", "", "")) ;
+
+   # put the original filters back
+   $db->filter_fetch_key   ($old_fk);
+   $db->filter_store_key   ($old_sk);
+   $db->filter_fetch_value ($old_fv);
+   $db->filter_store_value ($old_sv);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"fred"} = "joe" ;
+   ok(30, checkOutput( "", "fred", "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(31, $h{"fred"} eq "joe");
+   ok(32, checkOutput( "", "fred", "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(33, $db->FIRSTKEY() eq "fred") ;
+   ok(34, checkOutput( "fred", "", "", "")) ;
+
+   # delete the filters
+   $db->filter_fetch_key   (undef);
+   $db->filter_store_key   (undef);
+   $db->filter_fetch_value (undef);
+   $db->filter_store_value (undef);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"fred"} = "joe" ;
+   ok(35, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(36, $h{"fred"} eq "joe");
+   ok(37, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(38, $db->FIRSTKEY() eq "fred") ;
+   ok(39, checkOutput( "", "", "", "")) ;
+
+   undef $db ;
+   untie %h;
+   unlink <Op.dbmx*>;
+}
+
+{    
+    # DBM Filter with a closure
+
+    use strict ;
+    use warnings ;
+    my (%h, $db) ;
+
+    unlink <Op.dbmx*>;
+    ok(40, $db = tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
+
+    my %result = () ;
+
+    sub Closure
+    {
+        my ($name) = @_ ;
+       my $count = 0 ;
+       my @kept = () ;
+
+       return sub { ++$count ; 
+                    push @kept, $_ ; 
+                    $result{$name} = "$name - $count: [@kept]" ;
+                  }
+    }
+
+    $db->filter_store_key(Closure("store key")) ;
+    $db->filter_store_value(Closure("store value")) ;
+    $db->filter_fetch_key(Closure("fetch key")) ;
+    $db->filter_fetch_value(Closure("fetch value")) ;
+
+    $_ = "original" ;
+
+    $h{"fred"} = "joe" ;
+    ok(41, $result{"store key"} eq "store key - 1: [fred]");
+    ok(42, $result{"store value"} eq "store value - 1: [joe]");
+    ok(43, !defined $result{"fetch key"} );
+    ok(44, !defined $result{"fetch value"} );
+    ok(45, $_ eq "original") ;
+
+    ok(46, $db->FIRSTKEY() eq "fred") ;
+    ok(47, $result{"store key"} eq "store key - 1: [fred]");
+    ok(48, $result{"store value"} eq "store value - 1: [joe]");
+    ok(49, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(50, ! defined $result{"fetch value"} );
+    ok(51, $_ eq "original") ;
+
+    $h{"jim"}  = "john" ;
+    ok(52, $result{"store key"} eq "store key - 2: [fred jim]");
+    ok(53, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(54, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(55, ! defined $result{"fetch value"} );
+    ok(56, $_ eq "original") ;
+
+    ok(57, $h{"fred"} eq "joe");
+    ok(58, $result{"store key"} eq "store key - 3: [fred jim fred]");
+    ok(59, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(60, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(61, $result{"fetch value"} eq "fetch value - 1: [joe]");
+    ok(62, $_ eq "original") ;
+
+    undef $db ;
+    untie %h;
+    unlink <Op.dbmx*>;
+}              
+
+{
+   # DBM Filter recursion detection
+   use strict ;
+   use warnings ;
+   my (%h, $db) ;
+   unlink <Op.dbmx*>;
+
+   ok(63, $db = tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
+
+   $db->filter_store_key (sub { $_ = $h{$_} }) ;
+
+   eval '$h{1} = 1234' ;
+   ok(64, $@ =~ /^recursion detected in filter_store_key at/ );
+   
+   undef $db ;
+   untie %h;
+   unlink <Op.dbmx*>;
+}
+
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use NDBM_File ;
+
+    unlink <Op.dbmx*>;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    ok(65, tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
+}

diff --git a/ext/ODBM_File/odbm.t b/ext/ODBM_File/odbm.t
new file mode 100755 (executable)
index 0000000..a43e70b
--- /dev/null
+++ b/ext/ODBM_File/odbm.t
@@ -0,0 +1,437 @@
+#!./perl
+
+# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bODBM_File\b/) {
+       print "1..0 # Skip: ODBM_File was not built\n";
+       exit 0;
+    }
+}
+
+use strict;
+use warnings;
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+require ODBM_File;
+#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
+use Fcntl;
+
+print "1..66\n";
+
+unlink <Op.dbmx*>;
+
+umask(0);
+my %h;
+ok(1, tie(%h,'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640));
+
+my $Dfile = "Op.dbmx.pag";
+if (! -e $Dfile) {
+       ($Dfile) = <Op.dbmx*>;
+}
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare') {
+    print "ok 2 # Skipped: different file permission semantics\n";
+}
+else {
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+     $blksize,$blocks) = stat($Dfile);
+    print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
+}
+my $i = 0;
+while (my ($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+untie(%h);
+print (tie(%h,'ODBM_File','Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+my @keys = keys(%h);
+my @values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (my ($key,$value) = each(%h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+       $key =~ y/a-z/A-Z/;
+       $i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(%h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+$h{'foo'} = '';
+$h{''} = 'bar';
+
+# check cache overflow and numeric keys and contents
+my $ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+@h{0..200} = 200..400;
+my @foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
+
+print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+untie %h;
+unlink 'Op.dbmx.dir', $Dfile;
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+   use warnings ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use warnings ;
+   use vars qw(@ISA @EXPORT) ;
+
+   require Exporter ;
+   use ODBM_File;
+   @ISA=qw(ODBM_File);
+   @EXPORT = @ODBM_File::EXPORT ;
+
+   sub STORE { 
+       my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+       my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+       my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+       return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+
+    eval 'use SubDB ; use Fcntl ;';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+       $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 );
+       ' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(17, $@ eq "") ;
+    main::ok(18, $ret eq "[[5]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", <dbhash.tmp*> ;
+
+}
+
+{
+   # DBM Filter tests
+   use strict ;
+   use warnings ;
+   my (%h, $db) ;
+   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+
+   sub checkOutput
+   {
+       my($fk, $sk, $fv, $sv) = @_ ;
+       print "# ", join('|', $fetch_key, $fk, $store_key, $sk,
+                       $fetch_value, $fv, $store_value, $sv, $_), "\n";
+       return
+           $fetch_key eq $fk && $store_key eq $sk && 
+          $fetch_value eq $fv && $store_value eq $sv &&
+          $_ eq 'original' ;
+   }
+   
+   unlink <Op.dbmx*>;
+   ok(19, $db = tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
+
+   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
+   $db->filter_store_key   (sub { $store_key = $_ }) ;
+   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
+   $db->filter_store_value (sub { $store_value = $_ }) ;
+
+   $_ = "original" ;
+
+   $h{"fred"} = "joe" ;
+   #                   fk   sk     fv   sv
+   ok(20, checkOutput( "", "fred", "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(21, $h{"fred"} eq "joe");
+   #                   fk    sk     fv    sv
+   ok(22, checkOutput( "", "fred", "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(23, $db->FIRSTKEY() eq "fred") ;
+   #                    fk     sk  fv  sv
+   ok(24, checkOutput( "fred", "", "", "")) ;
+
+   # replace the filters, but remember the previous set
+   my ($old_fk) = $db->filter_fetch_key   
+                       (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
+   my ($old_sk) = $db->filter_store_key   
+                       (sub { $_ = lc $_ ; $store_key = $_ }) ;
+   my ($old_fv) = $db->filter_fetch_value 
+                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
+   my ($old_sv) = $db->filter_store_value 
+                       (sub { s/o/x/g; $store_value = $_ }) ;
+   
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"Fred"} = "Joe" ;
+   #                   fk   sk     fv    sv
+   ok(25, checkOutput( "", "fred", "", "Jxe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(26, $h{"Fred"} eq "[Jxe]");
+   #                   fk   sk     fv    sv
+   ok(27, checkOutput( "", "fred", "[Jxe]", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(28, $db->FIRSTKEY() eq "FRED") ;
+   #                   fk   sk     fv    sv
+   ok(29, checkOutput( "FRED", "", "", "")) ;
+
+   # put the original filters back
+   $db->filter_fetch_key   ($old_fk);
+   $db->filter_store_key   ($old_sk);
+   $db->filter_fetch_value ($old_fv);
+   $db->filter_store_value ($old_sv);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"fred"} = "joe" ;
+   ok(30, checkOutput( "", "fred", "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(31, $h{"fred"} eq "joe");
+   ok(32, checkOutput( "", "fred", "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(33, $db->FIRSTKEY() eq "fred") ;
+   ok(34, checkOutput( "fred", "", "", "")) ;
+
+   # delete the filters
+   $db->filter_fetch_key   (undef);
+   $db->filter_store_key   (undef);
+   $db->filter_fetch_value (undef);
+   $db->filter_store_value (undef);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"fred"} = "joe" ;
+   ok(35, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(36, $h{"fred"} eq "joe");
+   ok(37, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(38, $db->FIRSTKEY() eq "fred") ;
+   ok(39, checkOutput( "", "", "", "")) ;
+
+   undef $db ;
+   untie %h;
+   unlink <Op.dbmx*>;
+}
+
+{    
+    # DBM Filter with a closure
+
+    use strict ;
+    use warnings ;
+    my (%h, $db) ;
+
+    unlink <Op.dbmx*>;
+    ok(40, $db = tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
+
+    my %result = () ;
+
+    sub Closure
+    {
+        my ($name) = @_ ;
+       my $count = 0 ;
+       my @kept = () ;
+
+       return sub { ++$count ; 
+                    push @kept, $_ ; 
+                    $result{$name} = "$name - $count: [@kept]" ;
+                  }
+    }
+
+    $db->filter_store_key(Closure("store key")) ;
+    $db->filter_store_value(Closure("store value")) ;
+    $db->filter_fetch_key(Closure("fetch key")) ;
+    $db->filter_fetch_value(Closure("fetch value")) ;
+
+    $_ = "original" ;
+
+    $h{"fred"} = "joe" ;
+    ok(41, $result{"store key"} eq "store key - 1: [fred]");
+    ok(42, $result{"store value"} eq "store value - 1: [joe]");
+    ok(43, !defined $result{"fetch key"} );
+    ok(44, !defined $result{"fetch value"} );
+    ok(45, $_ eq "original") ;
+
+    ok(46, $db->FIRSTKEY() eq "fred") ;
+    ok(47, $result{"store key"} eq "store key - 1: [fred]");
+    ok(48, $result{"store value"} eq "store value - 1: [joe]");
+    ok(49, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(50, ! defined $result{"fetch value"} );
+    ok(51, $_ eq "original") ;
+
+    $h{"jim"}  = "john" ;
+    ok(52, $result{"store key"} eq "store key - 2: [fred jim]");
+    ok(53, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(54, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(55, ! defined $result{"fetch value"} );
+    ok(56, $_ eq "original") ;
+
+    ok(57, $h{"fred"} eq "joe");
+    ok(58, $result{"store key"} eq "store key - 3: [fred jim fred]");
+    ok(59, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(60, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(61, $result{"fetch value"} eq "fetch value - 1: [joe]");
+    ok(62, $_ eq "original") ;
+
+    undef $db ;
+    untie %h;
+    unlink <Op.dbmx*>;
+}              
+
+{
+   # DBM Filter recursion detection
+   use strict ;
+   use warnings ;
+   my (%h, $db) ;
+   unlink <Op.dbmx*>;
+
+   ok(63, $db = tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
+
+   $db->filter_store_key (sub { $_ = $h{$_} }) ;
+
+   eval '$h{1} = 1234' ;
+   ok(64, $@ =~ /^recursion detected in filter_store_key at/ );
+   
+   undef $db ;
+   untie %h;
+   unlink <Op.dbmx*>;
+}
+
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use ODBM_File ;
+
+    unlink <Op.dbmx*>;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    ok(65, tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
+    $h{ABC} = undef;
+    ok(66, $a eq "") ;
+    untie %h;
+    unlink <Op.dbmx*>;
+}
+
+if ($^O eq 'hpux') {
+    print <<EOM;
+#
+# If you experience failures with the odbm test in HP-UX,
+# this is a well-known bug that's unfortunately very hard to fix.
+# The suggested course of action is to avoid using the ODBM_File,
+# but to use instead the NDBM_File extension.
+#
+EOM
+}

diff --git a/ext/ODBM_File/sdbm.t b/ext/ODBM_File/sdbm.t
new file mode 100755 (executable)
index 0000000..57928e0
--- /dev/null
+++ b/ext/ODBM_File/sdbm.t
@@ -0,0 +1,429 @@
+#!./perl
+
+# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (($Config{'extensions'} !~ /\bSDBM_File\b/) && ($^O ne 'VMS')){
+       print "1..0\n";
+       exit 0;
+    }
+}
+
+use strict;
+use warnings;
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+require SDBM_File;
+#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
+use Fcntl;
+
+print "1..68\n";
+
+unlink <Op_dbmx.*>;
+
+umask(0);
+my %h ;
+ok(1, tie %h,'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640);
+
+my $Dfile = "Op_dbmx.pag";
+if (! -e $Dfile) {
+       ($Dfile) = <Op_dbmx.*>;
+}
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos') {
+    print "ok 2 # Skipped: different file permission semantics\n";
+}
+else {
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+     $blksize,$blocks) = stat($Dfile);
+    print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
+}
+my $i = 0;
+while (my ($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+untie(%h);
+print (tie(%h,'SDBM_File','Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+my @keys = keys(%h);
+my @values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (my ($key,$value) = each(%h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+       $key =~ y/a-z/A-Z/;
+       $i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(%h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+$h{'foo'} = '';
+$h{''} = 'bar';
+
+# check cache overflow and numeric keys and contents
+my $ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+@h{0..200} = 200..400;
+my @foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
+
+print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+   use warnings ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use warnings ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use SDBM_File;
+   @ISA=qw(SDBM_File);
+   @EXPORT = @SDBM_File::EXPORT if defined @SDBM_File::EXPORT ;
+
+   sub STORE { 
+       my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+       my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+       my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+       return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+
+    eval 'use SubDB ; use Fcntl ;';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+       $X = tie(%h, "SubDB","dbhash_tmp", O_RDWR|O_CREAT, 0640 );
+       ' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(17, $@ eq "") ;
+    main::ok(18, $ret eq "[[5]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", <dbhash_tmp.*> ;
+
+}
+
+ok(19, !exists $h{'goner1'});
+ok(20, exists $h{'foo'});
+
+untie %h;
+unlink <Op_dbmx*>, $Dfile;
+
+{
+   # DBM Filter tests
+   use strict ;
+   use warnings ;
+   my (%h, $db) ;
+   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+
+   sub checkOutput
+   {
+       my($fk, $sk, $fv, $sv) = @_ ;
+       return
+           $fetch_key eq $fk && $store_key eq $sk && 
+          $fetch_value eq $fv && $store_value eq $sv &&
+          $_ eq 'original' ;
+   }
+   
+   unlink <Op_dbmx*>;
+   ok(21, $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ;
+
+   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
+   $db->filter_store_key   (sub { $store_key = $_ }) ;
+   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
+   $db->filter_store_value (sub { $store_value = $_ }) ;
+
+   $_ = "original" ;
+
+   $h{"fred"} = "joe" ;
+   #                   fk   sk     fv   sv
+   ok(22, checkOutput( "", "fred", "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(23, $h{"fred"} eq "joe");
+   #                   fk    sk     fv    sv
+   ok(24, checkOutput( "", "fred", "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(25, $db->FIRSTKEY() eq "fred") ;
+   #                    fk     sk  fv  sv
+   ok(26, checkOutput( "fred", "", "", "")) ;
+
+   # replace the filters, but remember the previous set
+   my ($old_fk) = $db->filter_fetch_key   
+                       (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
+   my ($old_sk) = $db->filter_store_key   
+                       (sub { $_ = lc $_ ; $store_key = $_ }) ;
+   my ($old_fv) = $db->filter_fetch_value 
+                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
+   my ($old_sv) = $db->filter_store_value 
+                       (sub { s/o/x/g; $store_value = $_ }) ;
+   
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"Fred"} = "Joe" ;
+   #                   fk   sk     fv    sv
+   ok(27, checkOutput( "", "fred", "", "Jxe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(28, $h{"Fred"} eq "[Jxe]");
+   #                   fk   sk     fv    sv
+   ok(29, checkOutput( "", "fred", "[Jxe]", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(30, $db->FIRSTKEY() eq "FRED") ;
+   #                   fk   sk     fv    sv
+   ok(31, checkOutput( "FRED", "", "", "")) ;
+
+   # put the original filters back
+   $db->filter_fetch_key   ($old_fk);
+   $db->filter_store_key   ($old_sk);
+   $db->filter_fetch_value ($old_fv);
+   $db->filter_store_value ($old_sv);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"fred"} = "joe" ;
+   ok(32, checkOutput( "", "fred", "", "joe")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(33, $h{"fred"} eq "joe");
+   ok(34, checkOutput( "", "fred", "joe", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(35, $db->FIRSTKEY() eq "fred") ;
+   ok(36, checkOutput( "fred", "", "", "")) ;
+
+   # delete the filters
+   $db->filter_fetch_key   (undef);
+   $db->filter_store_key   (undef);
+   $db->filter_fetch_value (undef);
+   $db->filter_store_value (undef);
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   $h{"fred"} = "joe" ;
+   ok(37, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(38, $h{"fred"} eq "joe");
+   ok(39, checkOutput( "", "", "", "")) ;
+
+   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
+   ok(40, $db->FIRSTKEY() eq "fred") ;
+   ok(41, checkOutput( "", "", "", "")) ;
+
+   undef $db ;
+   untie %h;
+   unlink <Op_dbmx*>;
+}
+
+{    
+    # DBM Filter with a closure
+
+    use strict ;
+     use warnings ;
+    my (%h, $db) ;
+
+    unlink <Op_dbmx*>;
+    ok(42, $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ;
+
+    my %result = () ;
+
+    sub Closure
+    {
+        my ($name) = @_ ;
+       my $count = 0 ;
+       my @kept = () ;
+
+       return sub { ++$count ; 
+                    push @kept, $_ ; 
+                    $result{$name} = "$name - $count: [@kept]" ;
+                  }
+    }
+
+    $db->filter_store_key(Closure("store key")) ;
+    $db->filter_store_value(Closure("store value")) ;
+    $db->filter_fetch_key(Closure("fetch key")) ;
+    $db->filter_fetch_value(Closure("fetch value")) ;
+
+    $_ = "original" ;
+
+    $h{"fred"} = "joe" ;
+    ok(43, $result{"store key"} eq "store key - 1: [fred]");
+    ok(44, $result{"store value"} eq "store value - 1: [joe]");
+    ok(45, !defined $result{"fetch key"} );
+    ok(46, !defined $result{"fetch value"} );
+    ok(47, $_ eq "original") ;
+
+    ok(48, $db->FIRSTKEY() eq "fred") ;
+    ok(49, $result{"store key"} eq "store key - 1: [fred]");
+    ok(50, $result{"store value"} eq "store value - 1: [joe]");
+    ok(51, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(52, ! defined $result{"fetch value"} );
+    ok(53, $_ eq "original") ;
+
+    $h{"jim"}  = "john" ;
+    ok(54, $result{"store key"} eq "store key - 2: [fred jim]");
+    ok(55, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(56, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(57, ! defined $result{"fetch value"} );
+    ok(58, $_ eq "original") ;
+
+    ok(59, $h{"fred"} eq "joe");
+    ok(60, $result{"store key"} eq "store key - 3: [fred jim fred]");
+    ok(61, $result{"store value"} eq "store value - 2: [joe john]");
+    ok(62, $result{"fetch key"} eq "fetch key - 1: [fred]");
+    ok(63, $result{"fetch value"} eq "fetch value - 1: [joe]");
+    ok(64, $_ eq "original") ;
+
+    undef $db ;
+    untie %h;
+    unlink <Op_dbmx*>;
+}              
+
+{
+   # DBM Filter recursion detection
+   use strict ;
+   use warnings ;
+   my (%h, $db) ;
+   unlink <Op_dbmx*>;
+
+   ok(65, $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ;
+
+   $db->filter_store_key (sub { $_ = $h{$_} }) ;
+
+   eval '$h{1} = 1234' ;
+   ok(66, $@ =~ /^recursion detected in filter_store_key at/ );
+   
+   undef $db ;
+   untie %h;
+   unlink <Op_dbmx*>;
+}
+
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use SDBM_File ;
+
+    unlink <Op_dbmx*>;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    ok(67, tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ;
+    $h{ABC} = undef;
+    ok(68, $a eq "") ;
+
+    untie %h;
+    unlink <Op_dbmx*>;
+}

diff --git a/ext/Opcode/Opcode.t b/ext/Opcode/Opcode.t
new file mode 100755 (executable)
index 0000000..a785fce
--- /dev/null
+++ b/ext/Opcode/Opcode.t
@@ -0,0 +1,115 @@
+#!./perl -w
+
+$|=1;
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+        print "1..0\n";
+        exit 0;
+    }
+}
+
+use Opcode qw(
+       opcodes opdesc opmask verify_opset
+       opset opset_to_ops opset_to_hex invert_opset
+       opmask_add full_opset empty_opset define_optag
+);
+
+use strict;
+
+my $t = 1;
+my $last_test; # initalised at end
+print "1..$last_test\n";
+
+my($s1, $s2, $s3);
+my(@o1, @o2, @o3);
+
+# --- opset_to_ops and opset
+
+my @empty_l = opset_to_ops(empty_opset);
+print @empty_l == 0 ?   "ok $t\n" : "not ok $t\n"; $t++;
+
+my @full_l1  = opset_to_ops(full_opset);
+print @full_l1 == opcodes() ? "ok $t\n" : "not ok $t\n"; $t++;
+my @full_l2 = @full_l1;        # = opcodes();  # XXX to be fixed
+print "@full_l1" eq "@full_l2" ? "ok $t\n" : "not ok $t\n"; $t++;
+
+@empty_l = opset_to_ops(opset(':none'));
+print @empty_l == 0 ?   "ok $t\n" : "not ok $t\n"; $t++;
+
+my @full_l3 = opset_to_ops(opset(':all'));
+print  @full_l1  ==  @full_l3  ? "ok $t\n" : "not ok $t\n"; $t++;
+print "@full_l1" eq "@full_l3" ? "ok $t\n" : "not ok $t\n"; $t++;
+
+die $t unless $t == 7;
+$s1 = opset(      'padsv');
+$s2 = opset($s1,  'padav');
+$s3 = opset($s2, '!padav');
+print $s1 eq $s2 ? "not ok $t\n" : "ok $t\n"; ++$t;
+print $s1 eq $s3 ? "ok $t\n" : "not ok $t\n"; ++$t;
+
+# --- define_optag
+
+print eval { opset(':_tst_') } ? "not ok $t\n" : "ok $t\n"; ++$t;
+define_optag(":_tst_", opset(qw(padsv padav padhv)));
+print eval { opset(':_tst_') } ? "ok $t\n" : "not ok $t\n"; ++$t;
+
+# --- opdesc and opcodes
+
+die $t unless $t == 11;
+print opdesc("gv") eq "glob value" ? "ok $t\n" : "not ok $t\n"; $t++;
+my @desc = opdesc(':_tst_','stub');
+print "@desc" eq "private variable private array private hash stub"
+                                   ? "ok $t\n" : "not ok $t\n#@desc\n"; $t++;
+print opcodes() ? "ok $t\n" : "not ok $t\n"; $t++;
+print "ok $t\n"; ++$t;
+
+# --- invert_opset
+
+$s1 = opset(qw(fileno padsv padav));
+@o2 = opset_to_ops(invert_opset($s1));
+print @o2 == opcodes-3 ? "ok $t\n" : "not ok $t\n"; $t++;
+
+# --- opmask
+
+die $t unless $t == 16;
+print opmask() eq empty_opset() ? "ok $t\n" : "not ok $t\n"; $t++;     # work
+print length opmask() == int((opcodes()+7)/8) ? "ok $t\n" : "not ok $t\n"; $t++;
+
+# --- verify_opset
+
+print verify_opset($s1) && !verify_opset(42) ? "ok $t\n":"not ok $t\n"; $t++;
+
+# --- opmask_add
+
+opmask_add(opset(qw(fileno))); # add to global op_mask
+print eval 'fileno STDOUT' ? "not ok $t\n" : "ok $t\n";        $t++; # fail
+print $@ =~ /fileno trapped/ ? "ok $t\n" : "not ok $t\n# $@\n"; $t++;
+
+# --- check use of bit vector ops on opsets
+
+$s1 = opset('padsv');
+$s2 = opset('padav');
+$s3 = opset('padsv', 'padav', 'padhv');
+
+# Non-negated
+print (($s1 | $s2) eq opset($s1,$s2) ? "ok $t\n":"not ok $t\n"); $t++;
+print (($s2 & $s3) eq opset($s2)     ? "ok $t\n":"not ok $t\n"); $t++;
+print (($s2 ^ $s3) eq opset('padsv','padhv') ? "ok $t\n":"not ok $t\n"); $t++;
+
+# Negated, e.g., with possible extra bits in last byte beyond last op bit.
+# The extra bits mean we can't just say ~mask eq invert_opset(mask).
+
+@o1 = opset_to_ops(           ~ $s3);
+@o2 = opset_to_ops(invert_opset $s3);
+print "@o1" eq "@o2" ? "ok $t\n":"not ok $t\n"; $t++;
+
+# --- finally, check some opname assertions
+
+foreach(@full_l1) { die "bad opname: $_" if /\W/ or /^\d/ }
+
+print "ok $last_test\n";
+BEGIN { $last_test = 25 }

diff --git a/ext/Opcode/ops.t b/ext/Opcode/ops.t
new file mode 100755 (executable)
index 0000000..56b1bac
--- /dev/null
+++ b/ext/Opcode/ops.t
@@ -0,0 +1,29 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+        print "1..0\n";
+        exit 0;
+    }
+}
+
+print "1..2\n";
+
+eval <<'EOP';
+       no ops 'fileno';        # equiv to "perl -M-ops=fileno"
+       $a = fileno STDIN;
+EOP
+
+print $@ =~ /trapped/ ? "ok 1\n" : "not ok 1\n# $@\n";
+
+eval <<'EOP';
+       use ops ':default';     # equiv to "perl -M(as above) -Mops=:default"
+       eval 1;
+EOP
+
+print $@ =~ /trapped/ ? "ok 2\n" : "not ok 2\n# $@\n";
+
+1;

diff --git a/ext/POSIX/POSIX.t b/ext/POSIX/POSIX.t
new file mode 100755 (executable)
index 0000000..09bd88c
--- /dev/null
+++ b/ext/POSIX/POSIX.t
@@ -0,0 +1,139 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) {
+       print "1..0\n";
+       exit 0;
+    }
+}
+
+use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write);
+use strict subs;
+
+$| = 1;
+print "1..27\n";
+
+$Is_W32 = $^O eq 'MSWin32';
+$Is_NetWare = $^O eq 'NetWare';
+$Is_Dos = $^O eq 'dos';
+
+$testfd = open("TEST", O_RDONLY, 0) and print "ok 1\n";
+read($testfd, $buffer, 9) if $testfd > 2;
+print $buffer eq "#!./perl\n" ? "ok 2\n" : "not ok 2\n";
+
+write(1,"ok 3\nnot ok 3\n", 5);
+
+if ($Is_Dos) {
+    for (4..5) {
+        print "ok $_ # skipped, no pipe() support on dos\n";
+    }
+} else {
+@fds = POSIX::pipe();
+print $fds[0] > $testfd ? "ok 4\n" : "not ok 4\n";
+CORE::open($reader = \*READER, "<&=".$fds[0]);
+CORE::open($writer = \*WRITER, ">&=".$fds[1]);
+print $writer "ok 5\n";
+close $writer;
+print <$reader>;
+close $reader;
+}
+
+if ($Is_W32 || $Is_Dos) {
+    for (6..11) {
+       print "ok $_ # skipped, no sigaction support on win32/dos\n";
+    }
+}
+else {
+$sigset = new POSIX::SigSet 1,3;
+delset $sigset 1;
+if (!ismember $sigset 1) { print "ok 6\n" }
+if (ismember $sigset 3) { print "ok 7\n" }
+$mask = new POSIX::SigSet &SIGINT;
+$action = new POSIX::SigAction 'main::SigHUP', $mask, 0;
+sigaction(&SIGHUP, $action);
+$SIG{'INT'} = 'SigINT';
+kill 'HUP', $$;
+sleep 1;
+print "ok 11\n";
+
+sub SigHUP {
+    print "ok 8\n";
+    kill 'INT', $$;
+    sleep 2;
+    print "ok 9\n";
+}
+
+sub SigINT {
+    print "ok 10\n";
+}
+}
+
+print &_POSIX_OPEN_MAX > $fds[1] ? "ok 12\n" : "not ok 12\n";
+
+print getcwd() =~ m#/t$# ? "ok 13\n" : "not ok 13\n";
+
+# Check string conversion functions.
+
+if ($Config{d_strtod}) {
+    $lc = &POSIX::setlocale(&POSIX::LC_NUMERIC, 'C') if $Config{d_setlocale};
+    ($n, $x) = &POSIX::strtod('3.14159_OR_SO');
+# Using long double NVs may introduce greater accuracy than wanted.
+    $n =~ s/^3.1415(8999|9000)\d*$/3.14159/
+        if $Config{uselongdouble} eq 'define';
+    print (($n == 3.14159) && ($x == 6) ?
+          "ok 14\n" : "not ok 14\n");
+    &POSIX::setlocale(&POSIX::LC_NUMERIC, $lc) if $Config{d_setlocale};
+} else { print "# strtod not present\n", "ok 14\n"; }
+
+if ($Config{d_strtol}) {
+    ($n, $x) = &POSIX::strtol('21_PENGUINS');
+    print (($n == 21) && ($x == 9) ? "ok 15\n" : "not ok 15\n");
+} else { print "# strtol not present\n", "ok 15\n"; }
+
+if ($Config{d_strtoul}) {
+    ($n, $x) = &POSIX::strtoul('88_TEARS');
+    print (($n == 88) && ($x == 6) ? "ok 16\n" : "not ok 16\n");
+} else { print "# strtoul not present\n", "ok 16\n"; }
+
+# Pick up whether we're really able to dynamically load everything.
+print &POSIX::acos(1.0) == 0.0 ? "ok 17\n" : "not ok 17\n";
+
+# This can coredump if struct tm has a timezone field and we
+# didn't detect it.  If this fails, try adding
+# -DSTRUCT_TM_HASZONE to your cflags when compiling ext/POSIX/POSIX.c.
+# See ext/POSIX/hints/sunos_4.pl and ext/POSIX/hints/linux.pl 
+print POSIX::strftime("ok 18 # %H:%M, on %D\n", localtime());
+
+# If that worked, validate the mini_mktime() routine's normalisation of
+# input fields to strftime().
+sub try_strftime {
+    my $num = shift;
+    my $expect = shift;
+    my $got = POSIX::strftime("%a %b %d %H:%M:%S %Y %j", @_);
+    if ($got eq $expect) {
+       print "ok $num\n";
+    }
+    else {
+       print "# expected: $expect\n# got: $got\nnot ok $num\n";
+    }
+}
+
+$lc = &POSIX::setlocale(&POSIX::LC_TIME, 'C') if $Config{d_setlocale};
+try_strftime(19, "Wed Feb 28 00:00:00 1996 059", 0,0,0, 28,1,96);
+try_strftime(20, "Thu Feb 29 00:00:60 1996 060", 60,0,-24, 30,1,96);
+try_strftime(21, "Fri Mar 01 00:00:00 1996 061", 0,0,-24, 31,1,96);
+try_strftime(22, "Sun Feb 28 00:00:00 1999 059", 0,0,0, 28,1,99);
+try_strftime(23, "Mon Mar 01 00:00:00 1999 060", 0,0,24, 28,1,99);
+try_strftime(24, "Mon Feb 28 00:00:00 2000 059", 0,0,0, 28,1,100);
+try_strftime(25, "Tue Feb 29 00:00:00 2000 060", 0,0,0, 0,2,100);
+try_strftime(26, "Wed Mar 01 00:00:00 2000 061", 0,0,0, 1,2,100);
+try_strftime(27, "Fri Mar 31 00:00:00 2000 091", 0,0,0, 31,2,100);
+&POSIX::setlocale(&POSIX::LC_TIME, $lc) if $Config{d_setlocale};
+
+$| = 0;
+# The following line assumes buffered output, which may be not true with EMX:
+print '@#!*$@(!@#$' unless ($^O eq 'os2' || $^O eq 'uwin' || $^O eq 'os390');
+_exit(0);

diff --git a/ext/POSIX/sigaction.t b/ext/POSIX/sigaction.t
new file mode 100644 (file)
index 0000000..c38b122
--- /dev/null
+++ b/ext/POSIX/sigaction.t
@@ -0,0 +1,127 @@
+#!./perl
+
+BEGIN {
+       chdir 't' if -d 't';
+       unshift @INC, '../lib';
+}
+
+BEGIN{
+       # Don't do anything if POSIX is missing, or sigaction missing.
+       eval { use POSIX; };
+       if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare') {
+               print "1..0\n";
+               exit 0;
+       }
+}
+
+use strict;
+use vars qw/$bad7 $ok10 $bad18 $ok/;
+
+$^W=1;
+
+print "1..18\n";
+
+sub IGNORE {
+       $bad7=1;
+}
+
+sub DEFAULT {
+       $bad18=1;
+}
+
+sub foo {
+       $ok=1;
+}
+
+my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
+my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0);
+
+{
+       my $bad;
+       local($SIG{__WARN__})=sub { $bad=1; };
+       sigaction(SIGHUP, $newaction, $oldaction);
+       if($bad) { print "not ok 1\n" } else { print "ok 1\n"}
+}
+
+if($oldaction->{HANDLER} eq 'DEFAULT' ||
+   $oldaction->{HANDLER} eq 'IGNORE')
+  { print "ok 2\n" } else { print "not ok 2 # ", $oldaction->{HANDLER}, "\n"}
+print $SIG{HUP} eq '::foo' ? "ok 3\n" : "not ok 3\n";
+
+sigaction(SIGHUP, $newaction, $oldaction);
+if($oldaction->{HANDLER} eq '::foo')
+  { print "ok 4\n" } else { print "not ok 4\n"}
+if($oldaction->{MASK}->ismember(SIGUSR1))
+  { print "ok 5\n" } else { print "not ok 5\n"}
+if($oldaction->{FLAGS}) {
+    if ($^O eq 'linux') {
+       print "ok 6 # Skip: sigaction() broken in $^O\n";
+    } else {
+       print "not ok 6\n";
+    }
+} else {
+    print "ok 6\n";
+}
+
+$newaction=POSIX::SigAction->new('IGNORE');
+sigaction(SIGHUP, $newaction);
+kill 'HUP', $$;
+print $bad7 ? "not ok 7\n" : "ok 7\n";
+
+print $SIG{HUP} eq 'IGNORE' ? "ok 8\n" : "not ok 8\n";
+sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
+print $SIG{HUP} eq 'DEFAULT' ? "ok 9\n" : "not ok 9\n";
+
+$newaction=POSIX::SigAction->new(sub { $ok10=1; });
+sigaction(SIGHUP, $newaction);
+{
+       local($^W)=0;
+       kill 'HUP', $$;
+}
+print $ok10 ? "ok 10\n" : "not ok 10\n";
+
+print ref($SIG{HUP}) eq 'CODE' ? "ok 11\n" : "not ok 11\n";
+
+sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
+# Make sure the signal mask gets restored after sigaction croak()s.
+eval {
+       my $act=POSIX::SigAction->new('::foo');
+       delete $act->{HANDLER};
+       sigaction(SIGINT, $act);
+};
+kill 'HUP', $$;
+print $ok ? "ok 12\n" : "not ok 12\n";
+
+undef $ok;
+# Make sure the signal mask gets restored after sigaction returns early.
+my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
+kill 'HUP', $$;
+print !$x && $ok ? "ok 13\n" : "not ok 13\n";
+
+$SIG{HUP}=sub {};
+sigaction(SIGHUP, $newaction, $oldaction);
+print ref($oldaction->{HANDLER}) eq 'CODE' ? "ok 14\n" : "not ok 14\n";
+
+eval {
+       sigaction(SIGHUP, undef, $oldaction);
+};
+print $@ ? "not ok 15\n" : "ok 15\n";
+
+eval {
+       sigaction(SIGHUP, 0, $oldaction);
+};
+print $@ ? "not ok 16\n" : "ok 16\n";
+
+eval {
+       sigaction(SIGHUP, bless({},'Class'), $oldaction);
+};
+print $@ ? "ok 17\n" : "not ok 17\n";
+
+$newaction=POSIX::SigAction->new(sub { $ok10=1; });
+sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
+{
+       local($^W)=0;
+       kill 'CONT', $$;
+}
+print $bad18 ? "not ok 18\n" : "ok 18\n";
+

diff --git a/ext/PerlIO/PerlIO.t b/ext/PerlIO/PerlIO.t
new file mode 100644 (file)
index 0000000..d71ab8e
--- /dev/null
+++ b/ext/PerlIO/PerlIO.t
@@ -0,0 +1,90 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       if ($Config{'extensions'} !~ /\bPerlIO\b/) {
+           print "1..0 # Skip: PerlIO was not built\n";
+           exit 0;
+       }
+}
+
+use PerlIO;
+
+print "1..19\n";
+
+print "ok 1\n";
+
+my $txt = "txt$$";
+my $bin = "bin$$";
+my $utf = "utf$$";
+
+my $txtfh;
+my $binfh;
+my $utffh;
+
+print "not " unless open($txtfh, ">:crlf", $txt);
+print "ok 2\n";
+
+print "not " unless open($binfh, ">:raw",  $bin);
+print "ok 3\n";
+
+print "not " unless open($utffh, ">:utf8", $utf);
+print "ok 4\n";
+
+print $txtfh "foo\n";
+print $txtfh "bar\n";
+print "not " unless close($txtfh);
+print "ok 5\n";
+
+print $binfh "foo\n";
+print $binfh "bar\n";
+print "not " unless close($binfh);
+print "ok 6\n";
+
+print $utffh "foo\x{ff}\n";
+print $utffh "bar\x{abcd}\n";
+print "not " unless close($utffh);
+print "ok 7\n";
+
+print "not " unless open($txtfh, "<:crlf", $txt);
+print "ok 8\n";
+
+print "not " unless open($binfh, "<:raw",  $bin);
+print "ok 9\n";
+
+print "not " unless open($utffh, "<:utf8", $utf);
+print "ok 10\n";
+
+print "not " unless <$txtfh> eq "foo\n" && <$txtfh> eq "bar\n";
+print "ok 11\n";
+
+print "not " unless <$binfh> eq "foo\n" && <$binfh> eq "bar\n";
+print "ok 12\n";
+
+print "not " unless <$utffh> eq "foo\x{ff}\n" && <$utffh> eq "bar\x{abcd}\n";
+print "ok 13\n";
+
+print "not " unless eof($txtfh);
+print "ok 14\n";
+
+print "not " unless eof($binfh);
+print "ok 15\n";
+
+print "not " unless eof($utffh);
+print "ok 16\n";
+
+print "not " unless close($txtfh);
+print "ok 17\n";
+
+print "not " unless close($binfh);
+print "ok 18\n";
+
+print "not " unless close($utffh);
+print "ok 19\n";
+
+END {
+    1 while unlink $txt;
+    1 while unlink $bin;
+    1 while unlink $utf;
+}
+

diff --git a/ext/PerlIO/t/scalar.t b/ext/PerlIO/t/scalar.t
new file mode 100644 (file)
index 0000000..8368e66
--- /dev/null
+++ b/ext/PerlIO/t/scalar.t
@@ -0,0 +1,101 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    unless (find PerlIO::Layer 'perlio') {
+       print "1..0 # Skip: not perlio\n";
+       exit 0;
+    }
+}
+
+$| = 1;
+print "1..20\n";
+
+my $fh;
+my $var = "ok 2\n";
+open($fh,"+<",\$var) or print "not ";
+print "ok 1\n";
+print <$fh>;
+print "not " unless eof($fh);
+print "ok 3\n";
+seek($fh,0,0) or print "not ";
+print "not " if eof($fh);
+print "ok 4\n";
+print "ok 5\n";
+print $fh "ok 7\n" or print "not ";
+print "ok 6\n";
+print $var;
+$var = "foo\nbar\n";
+seek($fh,0,0) or print "not ";
+print "not " if eof($fh);
+print "ok 8\n";
+print "not " unless <$fh> eq "foo\n";
+print "ok 9\n";
+my $rv = close $fh;
+if (!$rv) {
+    print "# Close on scalar failed: $!\n";
+    print "not ";
+}
+print "ok 10\n";
+
+# Test that semantics are similar to normal file-based I/O
+# Check that ">" clobbers the scalar
+$var = "Something";
+open $fh, ">", \$var;
+print "# Got [$var], expect []\n";
+print "not " unless $var eq "";
+print "ok 11\n";
+#  Check that file offset set to beginning of scalar
+my $off = tell($fh);
+print "# Got $off, expect 0\n";
+print "not " unless $off == 0;
+print "ok 12\n";
+# Check that writes go where they should and update the offset
+$var = "Something";
+print $fh "Brea";
+$off = tell($fh);
+print "# Got $off, expect 4\n";
+print "not " unless $off == 4;
+print "ok 13\n";
+print "# Got [$var], expect [Breathing]\n";
+print "not " unless $var eq "Breathing";
+print "ok 14\n";
+close $fh;
+
+# Check that ">>" appends to the scalar
+$var = "Something ";
+open $fh, ">>", \$var;
+$off = tell($fh);
+print "# Got $off, expect 10\n";
+print "not " unless $off == 10;
+print "ok 15\n";
+print "# Got [$var], expect [Something ]\n";
+print "not " unless $var eq "Something ";
+print "ok 16\n";
+#  Check that further writes go to the very end of the scalar
+$var .= "else ";
+print "# Got [$var], expect [Something else ]\n";
+print "not " unless $var eq "Something else ";
+print "ok 17\n";
+$off = tell($fh);
+print "# Got $off, expect 10\n";
+print "not " unless $off == 10;
+print "ok 18\n";
+print $fh "is here";
+print "# Got [$var], expect [Something else is here]\n";
+print "not " unless $var eq "Something else is here";
+print "ok 19\n";
+close $fh;
+
+# Check that updates to the scalar from elsewhere do not
+# cause problems
+$var = "line one\nline two\line three\n";
+open $fh, "<", \$var;
+while (<$fh>) {
+    $var = "foo";
+}
+close $fh;
+print "# Got [$var], expect [foo]\n";
+print "not " unless $var eq "foo";
+print "ok 20\n";

diff --git a/ext/Safe/safe1.t b/ext/Safe/safe1.t
new file mode 100755 (executable)
index 0000000..27993d9
--- /dev/null
+++ b/ext/Safe/safe1.t
@@ -0,0 +1,68 @@
+#!./perl -w
+$|=1;
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+        print "1..0\n";
+        exit 0;
+    }
+}
+
+# Tests Todo:
+#      'main' as root
+
+package test;  # test from somewhere other than main
+
+use vars qw($bar);
+
+use Opcode 1.00, qw(opdesc opset opset_to_ops opset_to_hex
+       opmask_add full_opset empty_opset opcodes opmask define_optag);
+
+use Safe 1.00;
+
+my $last_test; # initalised at end
+print "1..$last_test\n";
+
+my $t = 1;
+my $cpt;
+# create and destroy some automatic Safe compartments first
+$cpt = new Safe or die;
+$cpt = new Safe or die;
+$cpt = new Safe or die;
+
+$cpt = new Safe "Root" or die;
+
+foreach(1..3) {
+       $foo = 42;
+
+       $cpt->share(qw($foo));
+
+       print ${$cpt->varglob('foo')}       == 42 ? "ok $t\n" : "not ok $t\n"; $t++;
+
+       ${$cpt->varglob('foo')} = 9;
+
+       print $foo == 9 ? "ok $t\n" : "not ok $t\n"; $t++;
+
+       print $cpt->reval('$foo')       == 9    ? "ok $t\n" : "not ok $t\n"; $t++;
+       # check 'main' has been changed:
+       print $cpt->reval('$::foo')     == 9    ? "ok $t\n" : "not ok $t\n"; $t++;
+       print $cpt->reval('$main::foo') == 9    ? "ok $t\n" : "not ok $t\n"; $t++;
+       # check we can't see our test package:
+       print $cpt->reval('$test::foo')         ? "not ok $t\n" : "ok $t\n"; $t++;
+       print $cpt->reval('${"test::foo"}')             ? "not ok $t\n" : "ok $t\n"; $t++;
+
+       $cpt->erase;    # erase the compartment, e.g., delete all variables
+
+       print $cpt->reval('$foo') ? "not ok $t\n" : "ok $t\n"; $t++;
+
+       # Note that we *must* use $cpt->varglob here because if we used
+       # $Root::foo etc we would still see the original values!
+       # This seems to be because the compiler has created an extra ref.
+
+       print ${$cpt->varglob('foo')} ? "not ok $t\n" : "ok $t\n"; $t++;
+}
+
+print "ok $last_test\n";
+BEGIN { $last_test = 28 }

diff --git a/ext/Safe/safe2.t b/ext/Safe/safe2.t
new file mode 100755 (executable)
index 0000000..4d6c84a
--- /dev/null
+++ b/ext/Safe/safe2.t
@@ -0,0 +1,145 @@
+#!./perl -w
+$|=1;
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+        print "1..0\n";
+        exit 0;
+    }
+    # test 30 rather naughtily expects English error messages
+    $ENV{'LC_ALL'} = 'C';
+    $ENV{LANGUAGE} = 'C'; # GNU locale extension
+}
+
+# Tests Todo:
+#      'main' as root
+
+use vars qw($bar);
+
+use Opcode 1.00, qw(opdesc opset opset_to_ops opset_to_hex
+       opmask_add full_opset empty_opset opcodes opmask define_optag);
+
+use Safe 1.00;
+
+my $last_test; # initalised at end
+print "1..$last_test\n";
+
+# Set up a package namespace of things to be visible to the unsafe code
+$Root::foo = "visible";
+$bar = "invisible";
+
+# Stop perl from moaning about identifies which are apparently only used once
+$Root::foo .= "";
+
+my $cpt;
+# create and destroy a couple of automatic Safe compartments first
+$cpt = new Safe or die;
+$cpt = new Safe or die;
+
+$cpt = new Safe "Root";
+
+$cpt->reval(q{ system("echo not ok 1"); });
+if ($@ =~ /^system trapped by operation mask/) {
+    print "ok 1\n";
+} else {
+    print "#$@" if $@;
+    print "not ok 1\n";
+}
+
+$cpt->reval(q{
+    print $foo eq 'visible'            ? "ok 2\n" : "not ok 2\n";
+    print $main::foo  eq 'visible'     ? "ok 3\n" : "not ok 3\n";
+    print defined($bar)                        ? "not ok 4\n" : "ok 4\n";
+    print defined($::bar)              ? "not ok 5\n" : "ok 5\n";
+    print defined($main::bar)          ? "not ok 6\n" : "ok 6\n";
+});
+print $@ ? "not ok 7\n#$@" : "ok 7\n";
+
+$foo = "ok 8\n";
+%bar = (key => "ok 9\n");
+@baz = (); push(@baz, "o", "10"); $" = 'k ';
+$glob = "ok 11\n";
+@glob = qw(not ok 16);
+
+sub sayok { print "ok @_\n" }
+
+$cpt->share(qw($foo %bar @baz *glob sayok));
+$cpt->share('$"') unless $Config{use5005threads};
+
+$cpt->reval(q{
+    package other;
+    sub other_sayok { print "ok @_\n" }
+    package main;
+    print $foo ? $foo : "not ok 8\n";
+    print $bar{key} ? $bar{key} : "not ok 9\n";
+    (@baz) ? print "@baz\n" : print "not ok 10\n";
+    print $glob;
+    other::other_sayok(12);
+    $foo =~ s/8/14/;
+    $bar{new} = "ok 15\n";
+    @glob = qw(ok 16);
+});
+print $@ ? "not ok 13\n#$@" : "ok 13\n";
+$" = ' ';
+print $foo, $bar{new}, "@glob\n";
+
+$Root::foo = "not ok 17";
+@{$cpt->varglob('bar')} = qw(not ok 18);
+${$cpt->varglob('foo')} = "ok 17";
+@Root::bar = "ok";
+push(@Root::bar, "18"); # Two steps to prevent "Identifier used only once..."
+
+print "$Root::foo\n";
+print "@{$cpt->varglob('bar')}\n";
+
+use strict;
+
+print 1 ? "ok 19\n" : "not ok 19\n";
+print 1 ? "ok 20\n" : "not ok 20\n";
+
+my $m1 = $cpt->mask;
+$cpt->trap("negate");
+my $m2 = $cpt->mask;
+my @masked = opset_to_ops($m1);
+print $m2 eq opset("negate", @masked) ? "ok 21\n" : "not ok 21\n";
+
+print eval { $cpt->mask("a bad mask") } ? "not ok 22\n" : "ok 22\n";
+
+print $cpt->reval("2 + 2") == 4 ? "ok 23\n" : "not ok 23\n";
+
+$cpt->mask(empty_opset);
+my $t_scalar = $cpt->reval('print wantarray ? "not ok 24\n" : "ok 24\n"');
+print $cpt->reval('@ary=(6,7,8);@ary') == 3 ? "ok 25\n" : "not ok 25\n";
+my @t_array  = $cpt->reval('print wantarray ? "ok 26\n" : "not ok 26\n"; (2,3,4)');
+print $t_array[2] == 4 ? "ok 27\n" : "not ok 27\n";
+
+my $t_scalar2 = $cpt->reval('die "foo bar"; 1');
+print defined $t_scalar2 ? "not ok 28\n" : "ok 28\n";
+print $@ =~ /foo bar/ ? "ok 29\n" : "not ok 29\n";
+
+# --- rdo
+  
+my $t = 30;
+$cpt->rdo('/non/existant/file.name');
+# The regexp is getting rather baroque.
+print $! =~ /cannot find|No such file|file specification syntax error|A file or directory in the path name does not exist|Invalid argument|Device not configured|file not found|File or directory doesn't exist/i ? "ok $t\n" : "not ok $t # $!\n"; $t++;
+# test #31 is gone.
+print 1 ? "ok $t\n" : "not ok $t\n#$@/$!\n"; $t++;
+  
+#my $rdo_file = "tmp_rdo.tpl";
+#if (open X,">$rdo_file") {
+#    print X "999\n";
+#    close X;
+#    $cpt->permit_only('const', 'leaveeval');
+#    print  $cpt->rdo($rdo_file) == 999 ? "ok $t\n" : "not ok $t\n"; $t++;
+#    unlink $rdo_file;
+#}
+#else {
+#    print "# test $t skipped, can't open file: $!\nok $t\n"; $t++;
+#}
+
+
+print "ok $last_test\n";
+BEGIN { $last_test = 32 }

diff --git a/ext/Socket/Socket.t b/ext/Socket/Socket.t
new file mode 100755 (executable)
index 0000000..481fd8f
--- /dev/null
+++ b/ext/Socket/Socket.t
@@ -0,0 +1,87 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bSocket\b/ && 
+        !(($^O eq 'VMS') && $Config{d_socket})) {
+       print "1..0\n";
+       exit 0;
+    }
+}
+       
+use Socket;
+
+print "1..8\n";
+
+if (socket(T,PF_INET,SOCK_STREAM,6)) {
+  print "ok 1\n";
+
+  if (connect(T,pack_sockaddr_in(7,inet_aton("localhost")))){
+       print "ok 2\n";
+
+       print "# Connected to " .
+               inet_ntoa((unpack_sockaddr_in(getpeername(T)))[1])."\n";
+
+       syswrite(T,"hello",5);
+       $read = sysread(T,$buff,10);    # Connection may be granted, then closed!
+       while ($read > 0 && length($buff) < 5) {
+           # adjust for fact that TCP doesn't guarantee size of reads/writes
+           $read = sysread(T,$buff,10,length($buff));
+       }
+       print(($read == 0 || $buff eq "hello") ? "ok 3\n" : "not ok 3\n");
+  }
+  else {
+       print "# You're allowed to fail tests 2 and 3 if.\n";
+       print "# The echo service has been disabled.\n";
+       print "# $!\n";
+       print "ok 2\n";
+       print "ok 3\n";
+  }
+}
+else {
+       print "# $!\n";
+       print "not ok 1\n";
+}
+
+if( socket(S,PF_INET,SOCK_STREAM,6) ){
+  print "ok 4\n";
+
+  if (connect(S,pack_sockaddr_in(7,INADDR_LOOPBACK))){
+       print "ok 5\n";
+
+       print "# Connected to " .
+               inet_ntoa((unpack_sockaddr_in(getpeername(S)))[1])."\n";
+
+       syswrite(S,"olleh",5);
+       $read = sysread(S,$buff,10);    # Connection may be granted, then closed!
+       while ($read > 0 && length($buff) < 5) {
+           # adjust for fact that TCP doesn't guarantee size of reads/writes
+           $read = sysread(S,$buff,10,length($buff));
+       }
+       print(($read == 0 || $buff eq "olleh") ? "ok 6\n" : "not ok 6\n");
+  }
+  else {
+       print "# You're allowed to fail tests 5 and 6 if.\n";
+       print "# The echo service has been disabled.\n";
+       print "# $!\n";
+       print "ok 5\n";
+       print "ok 6\n";
+  }
+}
+else {
+       print "# $!\n";
+       print "not ok 4\n";
+}
+
+# warnings
+$SIG{__WARN__} = sub {
+    ++ $w if $_[0] =~ /^6-ARG sockaddr_in call is deprecated/ ;
+} ;
+$w = 0 ;
+sockaddr_in(1,2,3,4,5,6) ;
+print ($w == 1 ? "not ok 7\n" : "ok 7\n") ;
+use warnings 'Socket' ;
+sockaddr_in(1,2,3,4,5,6) ;
+print ($w == 1 ? "ok 8\n" : "not ok 8\n") ;

diff --git a/ext/Storable/t/blessed.t b/ext/Storable/t/blessed.t
new file mode 100644 (file)
index 0000000..b1a18e6
--- /dev/null
+++ b/ext/Storable/t/blessed.t
@@ -0,0 +1,104 @@
+#!./perl
+
+# $Id: blessed.t,v 1.0 2000/09/01 19:40:41 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#
+# $Log: blessed.t,v $
+# Revision 1.0  2000/09/01 19:40:41  ram
+# Baseline for first official release.
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+    require 'lib/st-dump.pl';
+}
+
+sub ok;
+
+use Storable qw(freeze thaw);
+
+print "1..10\n";
+
+package SHORT_NAME;
+
+sub make { bless [], shift }
+
+package SHORT_NAME_WITH_HOOK;
+
+sub make { bless [], shift }
+
+sub STORABLE_freeze {
+       my $self = shift;
+       return ("", $self);
+}
+
+sub STORABLE_thaw {
+       my $self = shift;
+       my $cloning = shift;
+       my ($x, $obj) = @_;
+       die "STORABLE_thaw" unless $obj eq $self;
+}
+
+package main;
+
+# Still less than 256 bytes, so long classname logic not fully exercised
+# Wait until Perl removes the restriction on identifier lengths.
+my $name = "LONG_NAME_" . 'xxxxxxxxxxxxx::' x 14 . "final";
+
+eval <<EOC;
+package $name;
+
+\@ISA = ("SHORT_NAME");
+EOC
+die $@ if $@;
+ok 1, $@ eq '';
+
+eval <<EOC;
+package ${name}_WITH_HOOK;
+
+\@ISA = ("SHORT_NAME_WITH_HOOK");
+EOC
+ok 2, $@ eq '';
+
+# Construct a pool of objects
+my @pool;
+
+for (my $i = 0; $i < 10; $i++) {
+       push(@pool, SHORT_NAME->make);
+       push(@pool, SHORT_NAME_WITH_HOOK->make);
+       push(@pool, $name->make);
+       push(@pool, "${name}_WITH_HOOK"->make);
+}
+
+my $x = freeze \@pool;
+ok 3, 1;
+
+my $y = thaw $x;
+ok 4, ref $y eq 'ARRAY';
+ok 5, @{$y} == @pool;
+
+ok 6, ref $y->[0] eq 'SHORT_NAME';
+ok 7, ref $y->[1] eq 'SHORT_NAME_WITH_HOOK';
+ok 8, ref $y->[2] eq $name;
+ok 9, ref $y->[3] eq "${name}_WITH_HOOK";
+
+my $good = 1;
+for (my $i = 0; $i < 10; $i++) {
+       do { $good = 0; last } unless ref $y->[4*$i]   eq 'SHORT_NAME';
+       do { $good = 0; last } unless ref $y->[4*$i+1] eq 'SHORT_NAME_WITH_HOOK';
+       do { $good = 0; last } unless ref $y->[4*$i+2] eq $name;
+       do { $good = 0; last } unless ref $y->[4*$i+3] eq "${name}_WITH_HOOK";
+}
+ok 10, $good;
+

diff --git a/ext/Storable/t/canonical.t b/ext/Storable/t/canonical.t
new file mode 100644 (file)
index 0000000..b55669b
--- /dev/null
+++ b/ext/Storable/t/canonical.t
@@ -0,0 +1,153 @@
+#!./perl
+
+# $Id: canonical.t,v 1.0 2000/09/01 19:40:41 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#  
+# $Log: canonical.t,v $
+# Revision 1.0  2000/09/01 19:40:41  ram
+# Baseline for first official release.
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+}
+
+
+use Storable qw(freeze thaw dclone);
+use vars qw($debugging $verbose);
+
+print "1..8\n";
+
+sub ok {
+    my($testno, $ok) = @_;
+    print "not " unless $ok;
+    print "ok $testno\n";
+}
+
+
+# Uncomment the folowing line to get a dump of the constructed data structure
+# (you may want to reduce the size of the hashes too)
+# $debugging = 1;
+
+$hashsize = 100;
+$maxhash2size = 100;
+$maxarraysize = 100;
+
+# Use MD5 if its available to make random string keys
+
+eval { require "MD5.pm" };
+$gotmd5 = !$@;
+
+# Use Data::Dumper if debugging and it is available to create an ASCII dump
+
+if ($debugging) {
+    eval { require "Data/Dumper.pm" };
+    $gotdd  = !$@;
+}
+
+@fixed_strings = ("January", "February", "March", "April", "May", "June",
+                 "July", "August", "September", "October", "November", "December" );
+
+# Build some arbitrarily complex data structure starting with a top level hash
+# (deeper levels contain scalars, references to hashes or references to arrays);
+
+for (my $i = 0; $i < $hashsize; $i++) {
+       my($k) = int(rand(1_000_000));
+       $k = MD5->hexhash($k) if $gotmd5 and int(rand(2));
+       $a1{$k} = { key => "$k", value => $i };
+
+       # A third of the elements are references to further hashes
+
+       if (int(rand(1.5))) {
+               my($hash2) = {};
+               my($hash2size) = int(rand($maxhash2size));
+               while ($hash2size--) {
+                       my($k2) = $k . $i . int(rand(100));
+                       $hash2->{$k2} = $fixed_strings[rand(int(@fixed_strings))];
+               }
+               $a1{$k}->{value} = $hash2;
+       }
+
+       # A further third are references to arrays
+
+       elsif (int(rand(2))) {
+               my($arr_ref) = [];
+               my($arraysize) = int(rand($maxarraysize));
+               while ($arraysize--) {
+                       push(@$arr_ref, $fixed_strings[rand(int(@fixed_strings))]);
+               }
+               $a1{$k}->{value} = $arr_ref;
+       }       
+}
+
+
+print STDERR Data::Dumper::Dumper(\%a1) if ($verbose and $gotdd);
+
+
+# Copy the hash, element by element in order of the keys
+
+foreach $k (sort keys %a1) {
+    $a2{$k} = { key => "$k", value => $a1{$k}->{value} };
+}
+
+# Deep clone the hash
+
+$a3 = dclone(\%a1);
+
+# In canonical mode the frozen representation of each of the hashes
+# should be identical
+
+$Storable::canonical = 1;
+
+$x1 = freeze(\%a1);
+$x2 = freeze(\%a2);
+$x3 = freeze($a3);
+
+ok 1, (length($x1) > $hashsize);       # sanity check
+ok 2, length($x1) == length($x2);      # idem
+ok 3, $x1 eq $x2;
+ok 4, $x1 eq $x3;
+
+# In normal mode it is exceedingly unlikely that the frozen
+# representaions of all the hashes will be the same (normally the hash
+# elements are frozen in the order they are stored internally,
+# i.e. pseudo-randomly).
+
+$Storable::canonical = 0;
+
+$x1 = freeze(\%a1);
+$x2 = freeze(\%a2);
+$x3 = freeze($a3);
+
+
+# Two out of three the same may be a coincidence, all three the same
+# is much, much more unlikely.  Still it could happen, so this test
+# may report a false negative.
+
+ok 5, ($x1 ne $x2) || ($x1 ne $x3);    
+
+
+# Ensure refs to "undef" values are properly shared
+# Same test as in t/dclone.t to ensure the "canonical" code is also correct
+
+my $hash;
+push @{$$hash{''}}, \$$hash{a};
+ok 6, $$hash{''}[0] == \$$hash{a};
+
+my $cloned = dclone(dclone($hash));
+ok 7, $$cloned{''}[0] == \$$cloned{a};
+
+$$cloned{a} = "blah";
+ok 8, $$cloned{''}[0] == \$$cloned{a};
+

diff --git a/ext/Storable/t/compat06.t b/ext/Storable/t/compat06.t
new file mode 100644 (file)
index 0000000..1586b18
--- /dev/null
+++ b/ext/Storable/t/compat06.t
@@ -0,0 +1,157 @@
+#!./perl
+
+# $Id: compat-0.6.t,v 1.0.1.1 2001/02/17 12:26:21 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#
+# $Log: compat-0.6.t,v $
+# Revision 1.0.1.1  2001/02/17 12:26:21  ram
+# patch8: added EBCDIC version of the test, from Peter Prymmer
+#
+# Revision 1.0  2000/09/01 19:40:41  ram
+# Baseline for first official release.
+#
+
+BEGIN {
+    chdir('t') if -d 't';    
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+    require 'lib/st-dump.pl';
+}
+
+sub ok;
+
+print "1..8\n";
+
+use Storable qw(freeze nfreeze thaw);
+
+package TIED_HASH;
+
+sub TIEHASH {
+       my $self = bless {}, shift;
+       return $self;
+}
+
+sub FETCH {
+       my $self = shift;
+       my ($key) = @_;
+       $main::hash_fetch++;
+       return $self->{$key};
+}
+
+sub STORE {
+       my $self = shift;
+       my ($key, $val) = @_;
+       $self->{$key} = $val;
+}
+
+package SIMPLE;
+
+sub make {
+       my $self = bless [], shift;
+       my ($x) = @_;
+       $self->[0] = $x;
+       return $self;
+}
+
+package ROOT;
+
+sub make {
+       my $self = bless {}, shift;
+       my $h = tie %hash, TIED_HASH;
+       $self->{h} = $h;
+       $self->{ref} = \%hash;
+       my @pool;
+       for (my $i = 0; $i < 5; $i++) {
+               push(@pool, SIMPLE->make($i));
+       }
+       $self->{obj} = \@pool;
+       my @a = ('string', $h, $self);
+       $self->{a} = \@a;
+       $self->{num} = [1, 0, -3, -3.14159, 456, 4.5];
+       $h->{key1} = 'val1';
+       $h->{key2} = 'val2';
+       return $self;
+};
+
+sub num { $_[0]->{num} }
+sub h   { $_[0]->{h} }
+sub ref { $_[0]->{ref} }
+sub obj { $_[0]->{obj} }
+
+package main;
+
+my $is_EBCDIC = (ord('A') == 193) ? 1 : 0;
+ 
+my $r = ROOT->make;
+
+my $data = '';
+if (!$is_EBCDIC) {                     # ASCII machine
+       while (<DATA>) {
+               next if /^#/;
+           $data .= unpack("u", $_);
+       }
+} else {
+       while (<DATA>) {
+               next if /^#$/;          # skip comments
+               next if /^#\s+/;        # skip comments
+               next if /^[^#]/;        # skip uuencoding for ASCII machines
+               s/^#//;                         # prepare uuencoded data for EBCDIC machines
+               $data .= unpack("u", $_);
+       }
+}
+
+my $expected_length = $is_EBCDIC ? 217 : 278;
+ok 1, length $data == $expected_length;
+  
+my $y = thaw($data);
+ok 2, 1;
+ok 3, ref $y eq 'ROOT';
+
+$Storable::canonical = 1;              # Prevent "used once" warning
+$Storable::canonical = 1;
+# Allow for long double string conversions.
+$y->{num}->[3] += 0;
+$r->{num}->[3] += 0;
+ok 4, nfreeze($y) eq nfreeze($r);
+
+ok 5, $y->ref->{key1} eq 'val1';
+ok 6, $y->ref->{key2} eq 'val2';
+ok 7, $hash_fetch == 2;
+
+my $num = $r->num;
+my $ok = 1;
+for (my $i = 0; $i < @$num; $i++) {
+       do { $ok = 0; last } unless $num->[$i] == $y->num->[$i];
+}
+ok 8, $ok;
+
+__END__
+#
+# using Storable-0.6@11, output of: print pack("u", nfreeze(ROOT->make));
+# original size: 278 bytes
+#
+M`P,````%!`(````&"(%8"(!8"'U8"@@M,RXQ-#$U.5@)```!R%@*`S0N-5A8
+M6`````-N=6T$`P````(*!'9A;#%8````!&ME>3$*!'9A;#)8````!&ME>3)B
+M"51)141?2$%32%A8`````6@$`@````,*!G-T<FEN9U@$``````I8!```````
+M6%A8`````6$$`@````4$`@````$(@%AB!E-)35!,15A8!`(````!"(%88@93
+M24U03$586`0"`````0B"6&(&4TE-4$Q%6%@$`@````$(@UAB!E-)35!,15A8
+M!`(````!"(188@9324U03$586%A8`````V]B:@0,!``````*6%A8`````W)E
+(9F($4D]/5%@`
+#
+# using Storable-0.6@11, output of: print '#' . pack("u", nfreeze(ROOT->make));
+# on OS/390 (cp 1047) original size: 217 bytes
+#
+#M!0,1!-G6UN,#````!00,!!$)X\G%Q&W(P>+(`P````(*!*6!D_$````$DH6H
+#M\0H$I8&3\@````22A:CR`````YF%A@0"````!@B!"(`(?0H(8/-+\?3Q]?D)
+#M```!R`H#]$OU`````Y6DE`0"````!001!N+)U-?3Q0(````!"(`$$@("````
+#M`0B!!!("`@````$(@@02`@(````!"(,$$@("`````0B$`````Y:"D00`````
+#E!`````&(!`(````#"@:BHYF)E8<$``````0$```````````!@0``

diff --git a/ext/Storable/t/dclone.t b/ext/Storable/t/dclone.t
new file mode 100644 (file)
index 0000000..38c82eb
--- /dev/null
+++ b/ext/Storable/t/dclone.t
@@ -0,0 +1,82 @@
+#!./perl
+
+# $Id: dclone.t,v 1.0 2000/09/01 19:40:41 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#
+# $Log: dclone.t,v $
+# Revision 1.0  2000/09/01 19:40:41  ram
+# Baseline for first official release.
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+    require 'lib/st-dump.pl';
+}
+
+
+use Storable qw(dclone);
+
+print "1..9\n";
+
+$a = 'toto';
+$b = \$a;
+$c = bless {}, CLASS;
+$c->{attribute} = 'attrval';
+%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
+@a = ('first', undef, 3, -4, -3.14159, 456, 4.5,
+       $b, \$a, $a, $c, \$c, \%a);
+
+print "not " unless defined ($aref = dclone(\@a));
+print "ok 1\n";
+
+$dumped = &dump(\@a);
+print "ok 2\n";
+
+$got = &dump($aref);
+print "ok 3\n";
+
+print "not " unless $got eq $dumped; 
+print "ok 4\n";
+
+package FOO; @ISA = qw(Storable);
+
+sub make {
+       my $self = bless {};
+       $self->{key} = \%main::a;
+       return $self;
+};
+
+package main;
+
+$foo = FOO->make;
+print "not " unless defined($r = $foo->dclone);
+print "ok 5\n";
+
+print "not " unless &dump($foo) eq &dump($r);
+print "ok 6\n";
+
+# Ensure refs to "undef" values are properly shared during cloning
+my $hash;
+push @{$$hash{''}}, \$$hash{a};
+print "not " unless $$hash{''}[0] == \$$hash{a};
+print "ok 7\n";
+
+my $cloned = dclone(dclone($hash));
+print "not " unless $$cloned{''}[0] == \$$cloned{a};
+print "ok 8\n";
+
+$$cloned{a} = "blah";
+print "not " unless $$cloned{''}[0] == \$$cloned{a};
+print "ok 9\n";
+

diff --git a/ext/Storable/t/forgive.t b/ext/Storable/t/forgive.t
new file mode 100644 (file)
index 0000000..5881098
--- /dev/null
+++ b/ext/Storable/t/forgive.t
@@ -0,0 +1,67 @@
+#!./perl
+
+# $Id: forgive.t,v 1.0.1.1 2000/09/01 19:40:42 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#
+# Original Author: Ulrich Pfeifer
+# (C) Copyright 1997, Universitat Dortmund, all rights reserved.
+#
+# $Log: forgive.t,v $
+# Revision 1.0.1.1  2000/09/01 19:40:42  ram
+# Baseline for first official release.
+#
+# Revision 1.0  2000/09/01 19:40:41  ram
+# Baseline for first official release.
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+}
+
+use Storable qw(store retrieve);
+use File::Spec;
+
+print "1..8\n";
+
+my $test = 1;
+my $bad = ['foo', sub { 1 },  'bar'];
+my $result;
+
+eval {$result = store ($bad , 'store')};
+print ((!defined $result)?"ok $test\n":"not ok $test\n"); $test++;
+print (($@ ne '')?"ok $test\n":"not ok $test\n"); $test++;
+
+$Storable::forgive_me=1;
+
+my $devnull = File::Spec->devnull;
+
+open(SAVEERR, ">&STDERR");
+open(STDERR, ">$devnull") or 
+  ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
+
+eval {$result = store ($bad , 'store')};
+
+open(STDERR, ">&SAVEERR");
+
+print ((defined $result)?"ok $test\n":"not ok $test\n"); $test++;
+print (($@ eq '')?"ok $test\n":"not ok $test\n"); $test++;
+
+my $ret = retrieve('store');
+print ((defined $ret)?"ok $test\n":"not ok $test\n"); $test++;
+print (($ret->[0] eq 'foo')?"ok $test\n":"not ok $test\n"); $test++;
+print (($ret->[2] eq 'bar')?"ok $test\n":"not ok $test\n"); $test++;
+print ((ref $ret->[1] eq 'SCALAR')?"ok $test\n":"not ok $test\n"); $test++;
+
+
+END { 1 while unlink 'store' }

diff --git a/ext/Storable/t/freeze.t b/ext/Storable/t/freeze.t
new file mode 100644 (file)
index 0000000..37631ed
--- /dev/null
+++ b/ext/Storable/t/freeze.t
@@ -0,0 +1,119 @@
+#!./perl
+
+# $Id: freeze.t,v 1.0 2000/09/01 19:40:41 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#
+# $Log: freeze.t,v $
+# Revision 1.0  2000/09/01 19:40:41  ram
+# Baseline for first official release.
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+    require 'lib/st-dump.pl';
+}
+
+
+use Storable qw(freeze nfreeze thaw);
+
+print "1..15\n";
+
+$a = 'toto';
+$b = \$a;
+$c = bless {}, CLASS;
+$c->{attribute} = $b;
+$d = {};
+$e = [];
+$d->{'a'} = $e;
+$e->[0] = $d;
+%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
+@a = ('first', undef, 3, -4, -3.14159, 456, 4.5, $d, \$d, \$e, $e,
+       $b, \$a, $a, $c, \$c, \%a);
+
+print "not " unless defined ($f1 = freeze(\@a));
+print "ok 1\n";
+
+$dumped = &dump(\@a);
+print "ok 2\n";
+
+$root = thaw($f1);
+print "not " unless defined $root;
+print "ok 3\n";
+
+$got = &dump($root);
+print "ok 4\n";
+
+print "not " unless $got eq $dumped; 
+print "ok 5\n";
+
+package FOO; @ISA = qw(Storable);
+
+sub make {
+       my $self = bless {};
+       $self->{key} = \%main::a;
+       return $self;
+};
+
+package main;
+
+$foo = FOO->make;
+print "not " unless $f2 = $foo->freeze;
+print "ok 6\n";
+
+print "not " unless $f3 = $foo->nfreeze;
+print "ok 7\n";
+
+$root3 = thaw($f3);
+print "not " unless defined $root3;
+print "ok 8\n";
+
+print "not " unless &dump($foo) eq &dump($root3);
+print "ok 9\n";
+
+$root = thaw($f2);
+print "not " unless &dump($foo) eq &dump($root);
+print "ok 10\n";
+
+print "not " unless &dump($root3) eq &dump($root);
+print "ok 11\n";
+
+$other = freeze($root);
+print "not " unless length($other) == length($f2);
+print "ok 12\n";
+
+$root2 = thaw($other);
+print "not " unless &dump($root2) eq &dump($root);
+print "ok 13\n";
+
+$VAR1 = [
+       'method',
+       1,
+       'prepare',
+       'SELECT table_name, table_owner, num_rows FROM iitables
+                  where table_owner != \'$ingres\' and table_owner != \'DBA\''
+];
+
+$x = nfreeze($VAR1);
+$VAR2 = thaw($x);
+print "not " unless $VAR2->[3] eq $VAR1->[3];
+print "ok 14\n";
+
+# Test the workaround for LVALUE bug in perl 5.004_04 -- from Gisle Aas
+sub foo { $_[0] = 1 }
+$foo = [];
+foo($foo->[1]);
+eval { freeze($foo) };
+print "not " if $@;
+print "ok 15\n";
+

diff --git a/ext/Storable/t/lock.t b/ext/Storable/t/lock.t
new file mode 100644 (file)
index 0000000..77d73bb
--- /dev/null
+++ b/ext/Storable/t/lock.t
@@ -0,0 +1,61 @@
+#!./perl
+
+# $Id: lock.t,v 1.0.1.4 2001/01/03 09:41:00 ram Exp $
+#
+#  @COPYRIGHT@
+#
+# $Log: lock.t,v $
+# Revision 1.0.1.4  2001/01/03 09:41:00  ram
+# patch7: use new CAN_FLOCK routine to determine whether to run tests
+#
+# Revision 1.0.1.3  2000/10/26 17:11:27  ram
+# patch5: just check $^O, there's no need for the whole Config
+#
+# Revision 1.0.1.2  2000/10/23 18:03:07  ram
+# patch4: protected calls to flock() for dos platform
+#
+# Revision 1.0.1.1  2000/09/28 21:44:06  ram
+# patch2: created.
+#
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+
+    require 'lib/st-dump.pl';
+}
+
+sub ok;
+
+use Storable qw(lock_store lock_retrieve);
+
+unless (&Storable::CAN_FLOCK) {
+    print "1..0 # Skip: fcntl/flock emulation broken on this platform\n";
+       exit 0;
+}
+
+print "1..5\n";
+
+@a = ('first', undef, 3, -4, -3.14159, 456, 4.5);
+
+#
+# We're just ensuring things work, we're not validating locking.
+#
+
+ok 1, defined lock_store(\@a, 'store');
+ok 2, $dumped = &dump(\@a);
+
+$root = lock_retrieve('store');
+ok 3, ref $root eq 'ARRAY';
+ok 4, @a == @$root;
+ok 5, &dump($root) eq $dumped; 
+
+unlink 't/store';
+

diff --git a/ext/Storable/t/overload.t b/ext/Storable/t/overload.t
new file mode 100644 (file)
index 0000000..6d1e581
--- /dev/null
+++ b/ext/Storable/t/overload.t
@@ -0,0 +1,97 @@
+#!./perl
+
+# $Id: overload.t,v 1.0.1.1 2001/02/17 12:27:22 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#  
+# $Log: overload.t,v $
+# Revision 1.0.1.1  2001/02/17 12:27:22  ram
+# patch8: added test for structures with indirect ref to overloaded
+#
+# Revision 1.0  2000/09/01 19:40:42  ram
+# Baseline for first official release.
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+    require 'lib/st-dump.pl';
+}
+
+sub ok;
+
+use Storable qw(freeze thaw);
+
+print "1..12\n";
+
+package OVERLOADED;
+
+use overload
+       '""' => sub { $_[0][0] };
+
+package main;
+
+$a = bless [77], OVERLOADED;
+
+$b = thaw freeze $a;
+ok 1, ref $b eq 'OVERLOADED';
+ok 2, "$b" eq "77";
+
+$c = thaw freeze \$a;
+ok 3, ref $c eq 'REF';
+ok 4, ref $$c eq 'OVERLOADED';
+ok 5, "$$c" eq "77";
+
+$d = thaw freeze [$a, $a];
+ok 6, "$d->[0]" eq "77";
+$d->[0][0]++;
+ok 7, "$d->[1]" eq "78";
+
+package REF_TO_OVER;
+
+sub make {
+       my $self = bless {}, shift;
+       my ($over) = @_;
+       $self->{over} = $over;
+       return $self;
+}
+
+package OVER;
+
+use overload
+       '+'             => \&plus,
+       '""'    => sub { ref $_[0] };
+
+sub plus {
+       return 314;
+}
+
+sub make {
+       my $self = bless {}, shift;
+       my $ref = REF_TO_OVER->make($self);
+       $self->{ref} = $ref;
+       return $self;
+}
+
+package main;
+
+$a = OVER->make();
+$b = thaw freeze $a;
+
+ok 8, ref $b eq 'OVER';
+ok 9, $a + $a == 314;
+ok 10, ref $b->{ref} eq 'REF_TO_OVER';
+ok 11, "$b->{ref}->{over}" eq "$b";
+ok 12, $b + $b == 314;
+
+1;
+

diff --git a/ext/Storable/t/recurse.t b/ext/Storable/t/recurse.t
new file mode 100644 (file)
index 0000000..e3afc9c
--- /dev/null
+++ b/ext/Storable/t/recurse.t
@@ -0,0 +1,300 @@
+#!./perl
+
+# $Id: recurse.t,v 1.0.1.3 2001/02/17 12:28:33 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#  
+# $Log: recurse.t,v $
+# Revision 1.0.1.3  2001/02/17 12:28:33  ram
+# patch8: ensure blessing occurs ASAP, specially designed for hooks
+#
+# Revision 1.0.1.2  2000/11/05 17:22:05  ram
+# patch6: stress hook a little more with refs to lexicals
+#
+# $Log: recurse.t,v $
+# Revision 1.0.1.1  2000/09/17 16:48:05  ram
+# patch1: added test case for store hook bug
+#
+# $Log: recurse.t,v $
+# Revision 1.0  2000/09/01 19:40:42  ram
+# Baseline for first official release.
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+    require 'lib/st-dump.pl';
+}
+
+sub ok;
+
+use Storable qw(freeze thaw dclone);
+
+print "1..32\n";
+
+package OBJ_REAL;
+
+use Storable qw(freeze thaw);
+
+@x = ('a', 1);
+
+sub make { bless [], shift }
+
+sub STORABLE_freeze {
+       my $self = shift;
+       my $cloning = shift;
+       die "STORABLE_freeze" unless Storable::is_storing;
+       return (freeze(\@x), $self);
+}
+
+sub STORABLE_thaw {
+       my $self = shift;
+       my $cloning = shift;
+       my ($x, $obj) = @_;
+       die "STORABLE_thaw #1" unless $obj eq $self;
+       my $len = length $x;
+       my $a = thaw $x;
+       die "STORABLE_thaw #2" unless ref $a eq 'ARRAY';
+       die "STORABLE_thaw #3" unless @$a == 2 && $a->[0] eq 'a' && $a->[1] == 1;
+       @$self = @$a;
+       die "STORABLE_thaw #4" unless Storable::is_retrieving;
+}
+
+package OBJ_SYNC;
+
+@x = ('a', 1);
+
+sub make { bless {}, shift }
+
+sub STORABLE_freeze {
+       my $self = shift;
+       my ($cloning) = @_;
+       return if $cloning;
+       return ("", \@x, $self);
+}
+
+sub STORABLE_thaw {
+       my $self = shift;
+       my ($cloning, $undef, $a, $obj) = @_;
+       die "STORABLE_thaw #1" unless $obj eq $self;
+       die "STORABLE_thaw #2" unless ref $a eq 'ARRAY' || @$a != 2;
+       $self->{ok} = $self;
+}
+
+package OBJ_SYNC2;
+
+use Storable qw(dclone);
+
+sub make {
+       my $self = bless {}, shift;
+       my ($ext) = @_;
+       $self->{sync} = OBJ_SYNC->make;
+       $self->{ext} = $ext;
+       return $self;
+}
+
+sub STORABLE_freeze {
+       my $self = shift;
+       my %copy = %$self;
+       my $r = \%copy;
+       my $t = dclone($r->{sync});
+       return ("", [$t, $self->{ext}], $r, $self, $r->{ext});
+}
+
+sub STORABLE_thaw {
+       my $self = shift;
+       my ($cloning, $undef, $a, $r, $obj, $ext) = @_;
+       die "STORABLE_thaw #1" unless $obj eq $self;
+       die "STORABLE_thaw #2" unless ref $a eq 'ARRAY';
+       die "STORABLE_thaw #3" unless ref $r eq 'HASH';
+       die "STORABLE_thaw #4" unless $a->[1] == $r->{ext};
+       $self->{ok} = $self;
+       ($self->{sync}, $self->{ext}) = @$a;
+}
+
+package OBJ_REAL2;
+
+use Storable qw(freeze thaw);
+
+$MAX = 20;
+$recursed = 0;
+$hook_called = 0;
+
+sub make { bless [], shift }
+
+sub STORABLE_freeze {
+       my $self = shift;
+       $hook_called++;
+       return (freeze($self), $self) if ++$recursed < $MAX;
+       return ("no", $self);
+}
+
+sub STORABLE_thaw {
+       my $self = shift;
+       my $cloning = shift;
+       my ($x, $obj) = @_;
+       die "STORABLE_thaw #1" unless $obj eq $self;
+       $self->[0] = thaw($x) if $x ne "no";
+       $recursed--;
+}
+
+package main;
+
+my $real = OBJ_REAL->make;
+my $x = freeze $real;
+ok 1, 1;
+
+my $y = thaw $x;
+ok 2, 1;
+ok 3, $y->[0] eq 'a';
+ok 4, $y->[1] == 1;
+
+my $sync = OBJ_SYNC->make;
+$x = freeze $sync;
+ok 5, 1;
+
+$y = thaw $x;
+ok 6, 1;
+ok 7, $y->{ok} == $y;
+
+my $ext = [1, 2];
+$sync = OBJ_SYNC2->make($ext);
+$x = freeze [$sync, $ext];
+ok 8, 1;
+
+my $z = thaw $x;
+$y = $z->[0];
+ok 9, 1;
+ok 10, $y->{ok} == $y;
+ok 11, ref $y->{sync} eq 'OBJ_SYNC';
+ok 12, $y->{ext} == $z->[1];
+
+$real = OBJ_REAL2->make;
+$x = freeze $real;
+ok 13, 1;
+ok 14, $OBJ_REAL2::recursed == $OBJ_REAL2::MAX;
+ok 15, $OBJ_REAL2::hook_called == $OBJ_REAL2::MAX;
+
+$y = thaw $x;
+ok 16, 1;
+ok 17, $OBJ_REAL2::recursed == 0;
+
+$x = dclone $real;
+ok 18, 1;
+ok 19, ref $x eq 'OBJ_REAL2';
+ok 20, $OBJ_REAL2::recursed == 0;
+ok 21, $OBJ_REAL2::hook_called == 2 * $OBJ_REAL2::MAX;
+
+ok 22, !Storable::is_storing;
+ok 23, !Storable::is_retrieving;
+
+#
+# The following was a test-case that Salvador Ortiz Garcia <sog@msg.com.mx>
+# sent me, along with a proposed fix.
+#
+
+package Foo;
+
+sub new {
+       my $class = shift;
+       my $dat = shift;
+       return bless {dat => $dat}, $class;
+}
+
+package Bar;
+sub new {
+       my $class = shift;
+       return bless {
+               a => 'dummy',
+               b => [ 
+                       Foo->new(1),
+                       Foo->new(2), # Second instance of a Foo 
+               ]
+       }, $class;
+}
+
+sub STORABLE_freeze {
+       my($self,$clonning) = @_;
+       return "$self->{a}", $self->{b};
+}
+
+sub STORABLE_thaw {
+       my($self,$clonning,$dummy,$o) = @_;
+       $self->{a} = $dummy;
+       $self->{b} = $o;
+}
+
+package main;
+
+my $bar = new Bar;
+my $bar2 = thaw freeze $bar;
+
+ok 24, ref($bar2) eq 'Bar';
+ok 25, ref($bar->{b}[0]) eq 'Foo';
+ok 26, ref($bar->{b}[1]) eq 'Foo';
+ok 27, ref($bar2->{b}[0]) eq 'Foo';
+ok 28, ref($bar2->{b}[1]) eq 'Foo';
+
+#
+# The following attempts to make sure blessed objects are blessed ASAP
+# at retrieve time.
+#
+
+package CLASS_1;
+
+sub make {
+       my $self = bless {}, shift;
+       return $self;
+}
+
+package CLASS_2;
+
+sub make {
+       my $self = bless {}, shift;
+       my ($o) = @_;
+       $self->{c1} = CLASS_1->make();
+       $self->{o} = $o;
+       $self->{c3} = bless CLASS_1->make(), "CLASS_3";
+       $o->set_c2($self);
+       return $self;
+}
+
+sub STORABLE_freeze {
+       my($self, $clonning) = @_;
+       return "", $self->{c1}, $self->{c3}, $self->{o};
+}
+
+sub STORABLE_thaw {
+       my($self, $clonning, $frozen, $c1, $c3, $o) = @_;
+       main::ok 29, ref $self eq "CLASS_2";
+       main::ok 30, ref $c1 eq "CLASS_1";
+       main::ok 31, ref $c3 eq "CLASS_3";
+       main::ok 32, ref $o eq "CLASS_OTHER";
+       $self->{c1} = $c1;
+       $self->{c3} = $c3;
+}
+
+package CLASS_OTHER;
+
+sub make {
+       my $self = bless {}, shift;
+       return $self;
+}
+
+sub set_c2 { $_[0]->{c2} = $_[1] }
+
+package main;
+
+my $o = CLASS_OTHER->make();
+my $c2 = CLASS_2->make($o);
+my $so = thaw freeze $o;
+

diff --git a/ext/Storable/t/retrieve.t b/ext/Storable/t/retrieve.t
new file mode 100644 (file)
index 0000000..c968485
--- /dev/null
+++ b/ext/Storable/t/retrieve.t
@@ -0,0 +1,78 @@
+#!./perl
+
+# $Id: retrieve.t,v 1.0 2000/09/01 19:40:42 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#
+# $Log: retrieve.t,v $
+# Revision 1.0  2000/09/01 19:40:42  ram
+# Baseline for first official release.
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+    require 'lib/st-dump.pl';
+}
+
+
+use Storable qw(store retrieve nstore);
+
+print "1..14\n";
+
+$a = 'toto';
+$b = \$a;
+$c = bless {}, CLASS;
+$c->{attribute} = 'attrval';
+%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
+@a = ('first', '', undef, 3, -4, -3.14159, 456, 4.5,
+       $b, \$a, $a, $c, \$c, \%a);
+
+print "not " unless defined store(\@a, 'store');
+print "ok 1\n";
+print "not " if Storable::last_op_in_netorder();
+print "ok 2\n";
+print "not " unless defined nstore(\@a, 'nstore');
+print "ok 3\n";
+print "not " unless Storable::last_op_in_netorder();
+print "ok 4\n";
+print "not " unless Storable::last_op_in_netorder();
+print "ok 5\n";
+
+$root = retrieve('store');
+print "not " unless defined $root;
+print "ok 6\n";
+print "not " if Storable::last_op_in_netorder();
+print "ok 7\n";
+
+$nroot = retrieve('nstore');
+print "not " unless defined $nroot;
+print "ok 8\n";
+print "not " unless Storable::last_op_in_netorder();
+print "ok 9\n";
+
+$d1 = &dump($root);
+print "ok 10\n";
+$d2 = &dump($nroot);
+print "ok 11\n";
+
+print "not " unless $d1 eq $d2; 
+print "ok 12\n";
+
+# Make sure empty string is defined at retrieval time
+print "not " unless defined $root->[1];
+print "ok 13\n";
+print "not " if length $root->[1];
+print "ok 14\n";
+
+END { 1 while unlink('store', 'nstore') }
+

diff --git a/ext/Storable/t/store.t b/ext/Storable/t/store.t
new file mode 100644 (file)
index 0000000..d26755f
--- /dev/null
+++ b/ext/Storable/t/store.t
@@ -0,0 +1,119 @@
+#!./perl
+
+# $Id: store.t,v 1.0 2000/09/01 19:40:42 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#
+# $Log: store.t,v $
+# Revision 1.0  2000/09/01 19:40:42  ram
+# Baseline for first official release.
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+    require 'lib/st-dump.pl';
+}
+
+use Storable qw(store retrieve store_fd nstore_fd fd_retrieve);
+
+print "1..20\n";
+
+$a = 'toto';
+$b = \$a;
+$c = bless {}, CLASS;
+$c->{attribute} = 'attrval';
+%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
+@a = ('first', undef, 3, -4, -3.14159, 456, 4.5,
+       $b, \$a, $a, $c, \$c, \%a);
+
+print "not " unless defined store(\@a, 'store');
+print "ok 1\n";
+
+$dumped = &dump(\@a);
+print "ok 2\n";
+
+$root = retrieve('store');
+print "not " unless defined $root;
+print "ok 3\n";
+
+$got = &dump($root);
+print "ok 4\n";
+
+print "not " unless $got eq $dumped; 
+print "ok 5\n";
+
+1 while unlink 'store';
+
+package FOO; @ISA = qw(Storable);
+
+sub make {
+       my $self = bless {};
+       $self->{key} = \%main::a;
+       return $self;
+};
+
+package main;
+
+$foo = FOO->make;
+print "not " unless $foo->store('store');
+print "ok 6\n";
+
+print "not " unless open(OUT, '>>store');
+print "ok 7\n";
+binmode OUT;
+
+print "not " unless defined store_fd(\@a, ::OUT);
+print "ok 8\n";
+print "not " unless defined nstore_fd($foo, ::OUT);
+print "ok 9\n";
+print "not " unless defined nstore_fd(\%a, ::OUT);
+print "ok 10\n";
+
+print "not " unless close(OUT);
+print "ok 11\n";
+
+print "not " unless open(OUT, 'store');
+binmode OUT;
+
+$r = fd_retrieve(::OUT);
+print "not " unless defined $r;
+print "ok 12\n";
+print "not " unless &dump($foo) eq &dump($r);
+print "ok 13\n";
+
+$r = fd_retrieve(::OUT);
+print "not " unless defined $r;
+print "ok 14\n";
+print "not " unless &dump(\@a) eq &dump($r);
+print "ok 15\n";
+
+$r = fd_retrieve(main::OUT);
+print "not " unless defined $r;
+print "ok 16\n";
+print "not " unless &dump($foo) eq &dump($r);
+print "ok 17\n";
+
+$r = fd_retrieve(::OUT);
+print "not " unless defined $r;
+print "ok 18\n";
+print "not " unless &dump(\%a) eq &dump($r);
+print "ok 19\n";
+
+eval { $r = fd_retrieve(::OUT); };
+print "not " unless $@;
+print "ok 20\n";
+
+close OUT;
+END { 1 while unlink 'store' }
+
+

diff --git a/ext/Storable/t/tied.t b/ext/Storable/t/tied.t
new file mode 100644 (file)
index 0000000..88131fe
--- /dev/null
+++ b/ext/Storable/t/tied.t
@@ -0,0 +1,213 @@
+#!./perl
+
+# $Id: tied.t,v 1.0 2000/09/01 19:40:42 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#
+# $Log: tied.t,v $
+# Revision 1.0  2000/09/01 19:40:42  ram
+# Baseline for first official release.
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+    require 'lib/st-dump.pl';
+}
+
+sub ok;
+
+use Storable qw(freeze thaw);
+
+print "1..22\n";
+
+($scalar_fetch, $array_fetch, $hash_fetch) = (0, 0, 0);
+
+package TIED_HASH;
+
+sub TIEHASH {
+       my $self = bless {}, shift;
+       return $self;
+}
+
+sub FETCH {
+       my $self = shift;
+       my ($key) = @_;
+       $main::hash_fetch++;
+       return $self->{$key};
+}
+
+sub STORE {
+       my $self = shift;
+       my ($key, $value) = @_;
+       $self->{$key} = $value;
+}
+
+sub FIRSTKEY {
+       my $self = shift;
+       scalar keys %{$self};
+       return each %{$self};
+}
+
+sub NEXTKEY {
+       my $self = shift;
+       return each %{$self};
+}
+
+package TIED_ARRAY;
+
+sub TIEARRAY {
+       my $self = bless [], shift;
+       return $self;
+}
+
+sub FETCH {
+       my $self = shift;
+       my ($idx) = @_;
+       $main::array_fetch++;
+       return $self->[$idx];
+}
+
+sub STORE {
+       my $self = shift;
+       my ($idx, $value) = @_;
+       $self->[$idx] = $value;
+}
+
+sub FETCHSIZE {
+       my $self = shift;
+       return @{$self};
+}
+
+package TIED_SCALAR;
+
+sub TIESCALAR {
+       my $scalar;
+       my $self = bless \$scalar, shift;
+       return $self;
+}
+
+sub FETCH {
+       my $self = shift;
+       $main::scalar_fetch++;
+       return $$self;
+}
+
+sub STORE {
+       my $self = shift;
+       my ($value) = @_;
+       $$self = $value;
+}
+
+package FAULT;
+
+$fault = 0;
+
+sub TIESCALAR {
+       my $pkg = shift;
+       return bless [@_], $pkg;
+}
+
+sub FETCH {
+       my $self = shift;
+       my ($href, $key) = @$self;
+       $fault++;
+       untie $href->{$key};
+       return $href->{$key} = 1;
+}
+
+package main;
+
+$a = 'toto';
+$b = \$a;
+
+$c = tie %hash, TIED_HASH;
+$d = tie @array, TIED_ARRAY;
+tie $scalar, TIED_SCALAR;
+
+#$scalar = 'foo';
+#$hash{'attribute'} = \$d;
+#$array[0] = $c;
+#$array[1] = \$scalar;
+
+### If I say
+###   $hash{'attribute'} = $d;
+### below, then dump() incorectly dumps the hash value as a string the second
+### time it is reached. I have not investigated enough to tell whether it's
+### a bug in my dump() routine or in the Perl tieing mechanism.
+$scalar = 'foo';
+$hash{'attribute'} = 'plain value';
+$array[0] = \$scalar;
+$array[1] = $c;
+$array[2] = \@array;
+
+@tied = (\$scalar, \@array, \%hash);
+%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$a, 'scalarref', \$scalar);
+@a = ('first', 3, -4, -3.14159, 456, 4.5, $d, \$d,
+       $b, \$a, $a, $c, \$c, \%a, \@array, \%hash, \@tied);
+
+ok 1, defined($f = freeze(\@a));
+
+$dumped = &dump(\@a);
+ok 2, 1;
+
+$root = thaw($f);
+ok 3, defined $root;
+
+$got = &dump($root);
+ok 4, 1;
+
+### Used to see the manifestation of the bug documented above.
+### print "original: $dumped";
+### print "--------\n";
+### print "got: $got";
+### print "--------\n";
+
+ok 5, $got eq $dumped; 
+
+$g = freeze($root);
+ok 6, length($f) == length($g);
+
+# Ensure the tied items in the retrieved image work
+@old = ($scalar_fetch, $array_fetch, $hash_fetch);
+@tied = ($tscalar, $tarray, $thash) = @{$root->[$#{$root}]};
+@type = qw(SCALAR  ARRAY  HASH);
+
+ok 7, tied $$tscalar;
+ok 8, tied @{$tarray};
+ok 9, tied %{$thash};
+
+@new = ($$tscalar, $tarray->[0], $thash->{'attribute'});
+@new = ($scalar_fetch, $array_fetch, $hash_fetch);
+
+# Tests 10..15
+for ($i = 0; $i < @new; $i++) {
+       print "not " unless $new[$i] == $old[$i] + 1;
+       printf "ok %d\n", 10 + 2*$i;    # Tests 10,12,14
+       print "not " unless ref $tied[$i] eq $type[$i];
+       printf "ok %d\n", 11 + 2*$i;    # Tests 11,13,15
+}
+
+# Check undef ties
+my $h = {};
+tie $h->{'x'}, 'FAULT', $h, 'x';
+my $hf = freeze($h);
+ok 16, defined $hf;
+ok 17, $FAULT::fault == 0;
+ok 18, $h->{'x'} == 1;
+ok 19, $FAULT::fault == 1;
+
+my $ht = thaw($hf);
+ok 20, defined $ht;
+ok 21, $ht->{'x'} == 1;
+ok 22, $FAULT::fault == 2;
+

diff --git a/ext/Storable/t/tied_hook.t b/ext/Storable/t/tied_hook.t
new file mode 100644 (file)
index 0000000..46805cf
--- /dev/null
+++ b/ext/Storable/t/tied_hook.t
@@ -0,0 +1,254 @@
+#!./perl
+
+# $Id: tied_hook.t,v 1.0.1.1 2001/02/17 12:29:01 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#
+# $Log: tied_hook.t,v $
+# Revision 1.0.1.1  2001/02/17 12:29:01  ram
+# patch8: added test for blessed ref to tied hash
+#
+# Revision 1.0  2000/09/01 19:40:42  ram
+# Baseline for first official release.
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+    require 'lib/st-dump.pl';
+}
+
+sub ok;
+
+use Storable qw(freeze thaw);
+
+print "1..25\n";
+
+($scalar_fetch, $array_fetch, $hash_fetch) = (0, 0, 0);
+
+package TIED_HASH;
+
+sub TIEHASH {
+       my $self = bless {}, shift;
+       return $self;
+}
+
+sub FETCH {
+       my $self = shift;
+       my ($key) = @_;
+       $main::hash_fetch++;
+       return $self->{$key};
+}
+
+sub STORE {
+       my $self = shift;
+       my ($key, $value) = @_;
+       $self->{$key} = $value;
+}
+
+sub FIRSTKEY {
+       my $self = shift;
+       scalar keys %{$self};
+       return each %{$self};
+}
+
+sub NEXTKEY {
+       my $self = shift;
+       return each %{$self};
+}
+
+sub STORABLE_freeze {
+       my $self = shift;
+       $main::hash_hook1++;
+       return join(":", keys %$self) . ";" . join(":", values %$self);
+}
+
+sub STORABLE_thaw {
+       my ($self, $cloning, $frozen) = @_;
+       my ($keys, $values) = split(/;/, $frozen);
+       my @keys = split(/:/, $keys);
+       my @values = split(/:/, $values);
+       for (my $i = 0; $i < @keys; $i++) {
+               $self->{$keys[$i]} = $values[$i];
+       }
+       $main::hash_hook2++;
+}
+
+package TIED_ARRAY;
+
+sub TIEARRAY {
+       my $self = bless [], shift;
+       return $self;
+}
+
+sub FETCH {
+       my $self = shift;
+       my ($idx) = @_;
+       $main::array_fetch++;
+       return $self->[$idx];
+}
+
+sub STORE {
+       my $self = shift;
+       my ($idx, $value) = @_;
+       $self->[$idx] = $value;
+}
+
+sub FETCHSIZE {
+       my $self = shift;
+       return @{$self};
+}
+
+sub STORABLE_freeze {
+       my $self = shift;
+       $main::array_hook1++;
+       return join(":", @$self);
+}
+
+sub STORABLE_thaw {
+       my ($self, $cloning, $frozen) = @_;
+       @$self = split(/:/, $frozen);
+       $main::array_hook2++;
+}
+
+package TIED_SCALAR;
+
+sub TIESCALAR {
+       my $scalar;
+       my $self = bless \$scalar, shift;
+       return $self;
+}
+
+sub FETCH {
+       my $self = shift;
+       $main::scalar_fetch++;
+       return $$self;
+}
+
+sub STORE {
+       my $self = shift;
+       my ($value) = @_;
+       $$self = $value;
+}
+
+sub STORABLE_freeze {
+       my $self = shift;
+       $main::scalar_hook1++;
+       return $$self;
+}
+
+sub STORABLE_thaw {
+       my ($self, $cloning, $frozen) = @_;
+       $$self = $frozen;
+       $main::scalar_hook2++;
+}
+
+package main;
+
+$a = 'toto';
+$b = \$a;
+
+$c = tie %hash, TIED_HASH;
+$d = tie @array, TIED_ARRAY;
+tie $scalar, TIED_SCALAR;
+
+$scalar = 'foo';
+$hash{'attribute'} = 'plain value';
+$array[0] = \$scalar;
+$array[1] = $c;
+$array[2] = \@array;
+$array[3] = "plaine scalaire";
+
+@tied = (\$scalar, \@array, \%hash);
+%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$a, 'scalarref', \$scalar);
+@a = ('first', 3, -4, -3.14159, 456, 4.5, $d, \$d,
+       $b, \$a, $a, $c, \$c, \%a, \@array, \%hash, \@tied);
+
+ok 1, defined($f = freeze(\@a));
+
+$dumped = &dump(\@a);
+ok 2, 1;
+
+$root = thaw($f);
+ok 3, defined $root;
+
+$got = &dump($root);
+ok 4, 1;
+
+ok 5, $got ne $dumped;         # our hooks did not handle refs in array
+
+$g = freeze($root);
+ok 6, length($f) == length($g);
+
+# Ensure the tied items in the retrieved image work
+@old = ($scalar_fetch, $array_fetch, $hash_fetch);
+@tied = ($tscalar, $tarray, $thash) = @{$root->[$#{$root}]};
+@type = qw(SCALAR  ARRAY  HASH);
+
+ok 7, tied $$tscalar;
+ok 8, tied @{$tarray};
+ok 9, tied %{$thash};
+
+@new = ($$tscalar, $tarray->[0], $thash->{'attribute'});
+@new = ($scalar_fetch, $array_fetch, $hash_fetch);
+
+# Tests 10..15
+for ($i = 0; $i < @new; $i++) {
+       ok 10 + 2*$i, $new[$i] == $old[$i] + 1;         # Tests 10,12,14
+       ok 11 + 2*$i, ref $tied[$i] eq $type[$i];       # Tests 11,13,15
+}
+
+ok 16, $$tscalar eq 'foo';
+ok 17, $tarray->[3] eq 'plaine scalaire';
+ok 18, $thash->{'attribute'} eq 'plain value';
+
+# Ensure hooks were called
+ok 19, ($scalar_hook1 && $scalar_hook2);
+ok 20, ($array_hook1 && $array_hook2);
+ok 21, ($hash_hook1 && $hash_hook2);
+
+#
+# And now for the "blessed ref to tied hash" with "store hook" test...
+#
+
+my $bc = bless \%hash, 'FOO';          # FOO does not exist -> no hook
+my $bx = thaw freeze $bc;
+
+ok 22, ref $bx eq 'FOO';
+my $old_hash_fetch = $hash_fetch;
+my $v = $bx->{attribute};
+ok 23, $hash_fetch == $old_hash_fetch + 1;     # Still tied
+
+package TIED_HASH_REF;
+
+
+sub STORABLE_freeze {
+        my ($self, $cloning) = @_;
+        return if $cloning;
+        return('ref lost');
+}
+
+sub STORABLE_thaw {
+        my ($self, $cloning, $data) = @_;
+        return if $cloning;
+}
+
+package main;
+
+$bc = bless \%hash, 'TIED_HASH_REF';
+$bx = thaw freeze $bc;
+
+ok 24, ref $bx eq 'TIED_HASH_REF';
+$old_hash_fetch = $hash_fetch;
+$v = $bx->{attribute};
+ok 25, $hash_fetch == $old_hash_fetch + 1;     # Still tied
+

diff --git a/ext/Storable/t/tied_items.t b/ext/Storable/t/tied_items.t
new file mode 100644 (file)
index 0000000..3d0abf7
--- /dev/null
+++ b/ext/Storable/t/tied_items.t
@@ -0,0 +1,68 @@
+#!./perl
+
+# $Id: tied_items.t,v 1.0 2000/09/01 19:40:42 ram Exp $
+#
+#  Copyright (c) 1995-2000, Raphael Manfredi
+#  
+#  You may redistribute only under the same terms as Perl 5, as specified
+#  in the README file that comes with the distribution.
+#
+# $Log: tied_items.t,v $
+# Revision 1.0  2000/09/01 19:40:42  ram
+# Baseline for first official release.
+#
+
+#
+# Tests ref to items in tied hash/array structures.
+#
+
+sub BEGIN {
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+    require 'lib/st-dump.pl';
+}
+
+sub ok;
+$^W = 0;
+
+print "1..8\n";
+
+use Storable qw(dclone);
+
+$h_fetches = 0;
+
+sub H::TIEHASH { bless \(my $x), "H" }
+sub H::FETCH { $h_fetches++; $_[1] - 70 }
+
+tie %h, "H";
+
+$ref = \$h{77};
+$ref2 = dclone $ref;
+
+ok 1, $h_fetches == 0;
+ok 2, $$ref2 eq $$ref;
+ok 3, $$ref2 == 7;
+ok 4, $h_fetches == 2;
+
+$a_fetches = 0;
+
+sub A::TIEARRAY { bless \(my $x), "A" }
+sub A::FETCH { $a_fetches++; $_[1] - 70 }
+
+tie @a, "A";
+
+$ref = \$a[78];
+$ref2 = dclone $ref;
+
+ok 5, $a_fetches == 0;
+ok 6, $$ref2 eq $$ref;
+ok 7, $$ref2 == 8;
+# I don't understand why it's 3 and not 2
+ok 8, $a_fetches == 3;
+

diff --git a/ext/Storable/t/utf8.t b/ext/Storable/t/utf8.t
new file mode 100644 (file)
index 0000000..2160308
--- /dev/null
+++ b/ext/Storable/t/utf8.t
@@ -0,0 +1,40 @@
+#!./perl
+
+# $Id: utf8.t,v 1.0.1.2 2000/09/28 21:44:17 ram Exp $
+#
+#  @COPYRIGHT@
+#
+# $Log: utf8.t,v $
+# Revision 1.0.1.2  2000/09/28 21:44:17  ram
+# patch2: fixed stupid typo
+#
+# Revision 1.0.1.1  2000/09/17 16:48:12  ram
+# patch1: created.
+#
+#
+
+sub BEGIN {
+    if ($] < 5.006) {
+       print "1..0 # Skip: no utf8 support\n";
+       exit 0;
+    }
+    chdir('t') if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+    require 'lib/st-dump.pl';
+}
+
+sub ok;
+
+use Storable qw(thaw freeze);
+
+print "1..1\n";
+
+$x = chr(1234);
+ok 1, $x eq ${thaw freeze \$x};
+

diff --git a/ext/Sys/Hostname/Hostname.t b/ext/Sys/Hostname/Hostname.t
new file mode 100755 (executable)
index 0000000..85a04cd
--- /dev/null
+++ b/ext/Sys/Hostname/Hostname.t
@@ -0,0 +1,25 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bSys\/Hostname\b/) {
+      print "1..0 # Skip: Sys::Hostname was not built\n";
+      exit 0;
+    }
+}
+
+use Sys::Hostname;
+
+eval {
+    $host = hostname;
+};
+
+if ($@) {
+    print "1..0\n" if $@ =~ /Cannot get host name/;
+} else {
+    print "1..1\n";
+    print "# \$host = `$host'\n";
+    print "ok 1\n";
+}

diff --git a/ext/Sys/Syslog/syslog.t b/ext/Sys/Syslog/syslog.t
new file mode 100755 (executable)
index 0000000..801e882
--- /dev/null
+++ b/ext/Sys/Syslog/syslog.t
@@ -0,0 +1,72 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bSyslog\b/) {
+       print "1..0 # Skip: Sys::Syslog was not built\n";
+       exit 0;
+    }
+
+    require Socket;
+
+    # This code inspired by Sys::Syslog::connect():
+    require Sys::Hostname;
+    my ($host_uniq) = Sys::Hostname::hostname();
+    my ($host)      = $host_uniq =~ /([A-Za-z0-9_.-]+)/;
+
+    if (! defined Socket::inet_aton($host)) {
+        print "1..0 # Skip: Can't lookup $host\n";
+        exit 0;
+    }
+}
+
+BEGIN {
+  eval {require Sys::Syslog} or do {
+    if ($@ =~ /Your vendor has not/) {
+      print "1..0 # Skipped: missing macros\n";
+      exit 0;
+    }
+  }
+}
+
+use Sys::Syslog qw(:DEFAULT setlogsock);
+
+# Test this to 1 if your syslog accepts udp connections.
+# Most don't (or at least shouldn't)
+my $Test_Syslog_INET = 0;
+
+print "1..6\n";
+
+if (Sys::Syslog::_PATH_LOG()) {
+    if (-e Sys::Syslog::_PATH_LOG()) {
+        print defined(eval { setlogsock('unix') }) ? "ok 1\n" : "not ok 1\n";
+        print defined(eval { openlog('perl', 'ndelay', 'local0') }) ? "ok 2\n" : "not ok 2\n";
+        print defined(eval { syslog('info', 'test') }) ? "ok 3\n" : "not ok 3\n";
+    }
+    else {
+        for (1..3) {
+            print
+                "ok $_ # skipping, file ",
+                Sys::Syslog::_PATH_LOG(),
+                " does not exist\n";
+        }
+    }
+}
+else {
+    for (1..3) { print "ok $_ # skipping, _PATH_LOG unavailable\n" }
+}
+
+if( $Test_Syslog_INET ) {
+    print defined(eval { setlogsock('inet') }) ? "ok 4\n" 
+                                               : "not ok 4\n";
+    print defined(eval { openlog('perl', 'ndelay', 'local0') }) ? "ok 5\n" 
+                                                                : "not ok 5\n";
+    print defined(eval { syslog('info', 'test') }) ? "ok 6\n" 
+                                                   : "not ok 6\n";
+}
+else {
+    print "ok $_ # skipped(assuming syslog doesn't accept inet connections)\n" 
+      foreach (4..6);
+}

diff --git a/ext/Thread/thr5005.t b/ext/Thread/thr5005.t
new file mode 100755 (executable)
index 0000000..6650683
--- /dev/null
+++ b/ext/Thread/thr5005.t
@@ -0,0 +1,207 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (! $Config{'use5005threads'}) {
+       print "1..0 # Skip: no use5005threads\n";
+       exit 0;
+    }
+
+    # XXX known trouble with global destruction
+    $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+}
+$| = 1;
+print "1..74\n";
+use Thread 'yield';
+print "ok 1\n";
+
+sub content
+{
+ print shift;
+ return shift;
+}
+
+# create a thread passing args and immedaietly wait for it.
+my $t = new Thread \&content,("ok 2\n","ok 3\n", 1..1000);
+print $t->join;
+
+# check that lock works ...
+{lock $foo;
+ $t = new Thread sub { lock $foo; print "ok 5\n" };
+ print "ok 4\n";
+}
+$t->join;
+
+sub dorecurse
+{
+ my $val = shift;
+ my $ret;
+ print $val;
+ if (@_)
+  {
+   $ret = Thread->new(\&dorecurse, @_);
+   $ret->join;
+  }
+}
+
+$t = new Thread \&dorecurse, map { "ok $_\n" } 6..10;
+$t->join;
+
+# test that sleep lets other thread run
+$t = new Thread \&dorecurse,"ok 11\n";
+sleep 6;
+print "ok 12\n";
+$t->join;
+
+sub islocked : locked {
+ my $val = shift;
+ my $ret;
+ print $val;
+ if (@_)
+  {
+   $ret = Thread->new(\&islocked, shift);
+  }
+ $ret;
+}
+
+$t = Thread->new(\&islocked, "ok 13\n", "ok 14\n");
+$t->join->join;
+
+{
+    package Loch::Ness;
+    sub new { bless [], shift }
+    sub monster : locked : method {
+       my($s, $m) = @_;
+       print "ok $m\n";
+    }
+    sub gollum { &monster }
+}
+Loch::Ness->monster(15);
+Loch::Ness->new->monster(16);
+Loch::Ness->gollum(17);
+Loch::Ness->new->gollum(18);
+
+my $short = "This is a long string that goes on and on.";
+my $shorte = " a long string that goes on and on.";
+my $long  = "This is short.";
+my $longe  = " short.";
+my $thr1 = new Thread \&threaded, $short, $shorte, "19";
+my $thr2 = new Thread \&threaded, $long, $longe, "20";
+my $thr3 = new Thread \&testsprintf, "21";
+
+sub testsprintf {
+  my $testno = shift;
+  # this may coredump if thread vars are not properly initialised
+  my $same = sprintf "%.0f", $testno;
+  if ($testno eq $same) {
+    print "ok $testno\n";
+  } else {
+    print "not ok $testno\t# '$testno' ne '$same'\n";
+  }
+}
+
+sub threaded {
+  my ($string, $string_end, $testno) = @_;
+
+  # Do the match, saving the output in appropriate variables
+  $string =~ /(.*)(is)(.*)/;
+  # Yield control, allowing the other thread to fill in the match variables
+  yield();
+  # Examine the match variable contents; on broken perls this fails
+  if ($3 eq $string_end) {
+    print "ok $testno\n";
+  }
+  else {
+    warn <<EOT;
+
+#
+# This is a KNOWN FAILURE, and one of the reasons why threading
+# is still an experimental feature.  It is here to stop people
+# from deploying threads in production. ;-)
+#
+EOT
+    print "not ok $testno # other thread filled in match variables\n";
+  }
+}
+$thr1->join;
+$thr2->join;
+$thr3->join;
+print "ok 22\n";
+
+{
+    my $THRf_STATE_MASK = 7;
+    my $THRf_R_JOINABLE = 0;
+    my $THRf_R_JOINED = 1;
+    my $THRf_R_DETACHED = 2;
+    my $THRf_ZOMBIE = 3;
+    my $THRf_DEAD = 4;
+    my $THRf_DID_DIE = 8;
+    sub _test {
+       my($test, $t, $state, $die) = @_;
+       my $flags = $t->flags;
+       if (($flags & $THRf_STATE_MASK) == $state
+               && !($flags & $THRf_DID_DIE) == !$die) {
+           print "ok $test\n";
+       } else {
+           print <<BAD;
+not ok $test\t# got flags $flags not @{[ $state + ($die ? $THRf_DID_DIE : 0) ]}
+BAD
+       }
+    }
+
+    my @t;
+    push @t, (
+       Thread->new(sub { sleep 4; die "thread die\n" }),
+       Thread->new(sub { die "thread die\n" }),
+       Thread->new(sub { sleep 4; 1 }),
+       Thread->new(sub { 1 }),
+    ) for 1, 2;
+    $_->detach for @t[grep $_ & 4, 0..$#t];
+
+    sleep 1;
+    my $test = 23;
+    for (0..7) {
+       my $t = $t[$_];
+       my $flags = ($_ & 1)
+           ? ($_ & 4) ? $THRf_DEAD : $THRf_ZOMBIE
+           : ($_ & 4) ? $THRf_R_DETACHED : $THRf_R_JOINABLE;
+       _test($test++, $t, $flags, (($_ & 3) != 1) ? 0 : $THRf_DID_DIE);
+       printf "%sok %s\n", !$t->done == !($_ & 1) ? "" : "not ", $test++;
+    }
+#   $test = 39;
+    for (grep $_ & 1, 0..$#t) {
+       next if $_ & 4;         # can't join detached threads
+       $t[$_]->eval;
+       my $die = ($_ & 2) ? "" : "thread die\n";
+       printf "%sok %s\n", $@ eq $die ? "" : "not ", $test++;
+    }
+#   $test = 41;
+    for (0..7) {
+       my $t = $t[$_];
+       my $flags = ($_ & 1)
+           ? ($_ & 4) ? $THRf_DEAD : $THRf_DEAD
+           : ($_ & 4) ? $THRf_R_DETACHED : $THRf_R_JOINABLE;
+       _test($test++, $t, $flags, (($_ & 3) != 1) ? 0 : $THRf_DID_DIE);
+       printf "%sok %s\n", !$t->done == !($_ & 1) ? "" : "not ", $test++;
+    }
+#   $test = 57;
+    for (grep !($_ & 1), 0..$#t) {
+       next if $_ & 4;         # can't join detached threads
+       $t[$_]->eval;
+       my $die = ($_ & 2) ? "" : "thread die\n";
+       printf "%sok %s\n", $@ eq $die ? "" : "not ", $test++;
+    }
+    sleep 1;   # make sure even the detached threads are done sleeping
+#   $test = 59;
+    for (0..7) {
+       my $t = $t[$_];
+       my $flags = ($_ & 1)
+           ? ($_ & 4) ? $THRf_DEAD : $THRf_DEAD
+           : ($_ & 4) ? $THRf_DEAD : $THRf_DEAD;
+       _test($test++, $t, $flags, ($_ & 2) ? 0 : $THRf_DID_DIE);
+       printf "%sok %s\n", $t->done ? "" : "not ", $test++;
+    }
+#   $test = 75;
+}

diff --git a/ext/Time/HiRes/HiRes.t b/ext/Time/HiRes/HiRes.t
new file mode 100644 (file)
index 0000000..db35b95
--- /dev/null
+++ b/ext/Time/HiRes/HiRes.t
@@ -0,0 +1,216 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN { $| = 1; print "1..19\n"; }
+
+END {print "not ok 1\n" unless $loaded;}
+
+use Time::HiRes qw(tv_interval);
+
+$loaded = 1;
+
+print "ok 1\n";
+
+use strict;
+
+my $have_gettimeofday  = defined &Time::HiRes::gettimeofday;
+my $have_usleep                = defined &Time::HiRes::usleep;
+my $have_ualarm                = defined &Time::HiRes::ualarm;
+
+import Time::HiRes 'gettimeofday'      if $have_gettimeofday;
+import Time::HiRes 'usleep'            if $have_usleep;
+import Time::HiRes 'ualarm'            if $have_ualarm;
+
+use Config;
+
+sub skip {
+    map { print "ok $_ (skipped)\n" } @_;
+}
+
+sub ok {
+    my ($n, $result, @info) = @_;
+    if ($result) {
+       print "ok $n\n";
+    }
+    else {
+       print "not ok $n\n";
+       print "# @info\n" if @info;
+    }
+}
+
+if (!$have_gettimeofday) {
+    skip 2..6;
+}
+else {
+    my @one = gettimeofday();
+    ok 2, @one == 2, 'gettimeofday returned ', 0+@one, ' args';
+    ok 3, $one[0] > 850_000_000, "@one too small";
+
+    sleep 1;
+
+    my @two = gettimeofday();
+    ok 4, ($two[0] > $one[0] || ($two[0] == $one[0] && $two[1] > $one[1])),
+           "@two is not greater than @one";
+
+    my $f = Time::HiRes::time;
+    ok 5, $f > 850_000_000, "$f too small";
+    ok 6, $f - $two[0] < 2, "$f - @two >= 2";
+}
+
+if (!$have_usleep) {
+    skip 7..8;
+}
+else {
+    my $one = time;
+    usleep(10_000);
+    my $two = time;
+    usleep(10_000);
+    my $three = time;
+    ok 7, $one == $two || $two == $three, "slept too long, $one $two $three";
+
+    if (!$have_gettimeofday) {
+       skip 8;
+    }
+    else {
+       my $f = Time::HiRes::time;
+       usleep(500_000);
+        my $f2 = Time::HiRes::time;
+       my $d = $f2 - $f;
+       ok 8, $d > 0.4 && $d < 0.8, "slept $d secs $f to $f2";
+    }
+}
+
+# Two-arg tv_interval() is always available.
+{
+    my $f = tv_interval [5, 100_000], [10, 500_000];
+    ok 9, $f == 5.4, $f;
+}
+
+if (!$have_gettimeofday) {
+    skip 10;
+}
+else {
+    my $r = [gettimeofday()];
+    my $f = tv_interval $r;
+    ok 10, $f < 2, $f;
+}
+
+if (!$have_usleep) {
+    skip 11;
+}
+else {
+    my $r = [gettimeofday()];
+    #jTime::HiRes::sleep 0.5;
+    Time::HiRes::sleep( 0.5 );
+    my $f = tv_interval $r;
+    ok 11, $f > 0.4 && $f < 0.8, "slept $f secs";
+}
+
+if (!$have_ualarm) {
+    skip 12..13;
+}
+else {
+    my $tick = 0;
+    local $SIG{ALRM} = sub { $tick++ };
+
+    my $one = time; $tick = 0; ualarm(10_000); sleep until $tick;
+    my $two = time; $tick = 0; ualarm(10_000); sleep until $tick;
+    my $three = time;
+    ok 12, $one == $two || $two == $three, "slept too long, $one $two $three";
+
+    $tick = 0;
+    ualarm(10_000, 10_000);
+    sleep until $tick >= 3;
+    ok 13, 1;
+    ualarm(0);
+}
+
+# new test: did we even get close?
+
+{
+ my $t = time();
+ my $tf = Time::HiRes::time();
+ ok 14, (abs($tf - $t) <= 1),
+  "time $t differs from Time::HiRes::time $tf";
+}
+
+unless (defined &Time::HiRes::gettimeofday
+       && defined &Time::HiRes::ualarm
+       && defined &Time::HiRes::usleep) {
+    for (15..17) {
+       print "ok $_ # skipped\n";
+    }
+} else {
+    use Time::HiRes qw (time alarm sleep);
+
+    my ($f, $r, $i);
+
+    print "# time...";
+    $f = time; 
+    print "$f\nok 15\n";
+
+    print "# sleep...";
+    $r = [Time::HiRes::gettimeofday];
+    sleep (0.5);
+    print Time::HiRes::tv_interval($r), "\nok 16\n";
+
+    $r = [Time::HiRes::gettimeofday];
+    $i = 5;
+    $SIG{ALRM} = "tick";
+    while ($i)
+    {
+       alarm(0.3);
+       select (undef, undef, undef, 10);
+       print "# Select returned! $i ", Time::HiRes::tv_interval ($r), "\n";
+    }
+
+    sub tick
+    {
+       $i--;
+       print "# Tick! $i ", Time::HiRes::tv_interval ($r), "\n";
+    }
+    $SIG{ALRM} = 'DEFAULT';
+
+    print "ok 17\n";
+}
+
+unless (defined &Time::HiRes::setitimer
+       && defined &Time::HiRes::getitimer
+       && exists &Time::HiRes::ITIMER_VIRTUAL
+       && $Config{d_select}) {
+    for (18..19) {
+       print "ok $_ # Skip: no virtual interval timers\n";
+    }
+} else {
+    use Time::HiRes qw (setitimer getitimer ITIMER_VIRTUAL);
+
+    my $i = 3;
+    my $r = [Time::HiRes::gettimeofday];
+
+    $SIG{VTALRM} = sub {
+       $i ? $i-- : setitimer(ITIMER_VIRTUAL, 0);
+       print "# Tick! $i ", Time::HiRes::tv_interval($r), "\n";
+    }; 
+
+    print "# setitimer: ", join(" ", setitimer(ITIMER_VIRTUAL, 0.5, 0.4)), "\n";
+
+    # Assume interval timer granularity of 0.05 seconds.  Too bold?
+    print "not " unless abs(getitimer(ITIMER_VIRTUAL) / 0.5) - 1 < 0.1;
+    print "ok 18\n";
+
+    print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
+
+    while (getitimer(ITIMER_VIRTUAL)) {
+       my $j; $j++ for 1..1000; # Can't be unbreakable, must test getitimer().
+    }
+
+    print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
+
+    print "not " unless getitimer(ITIMER_VIRTUAL) == 0;
+    print "ok 19\n";
+
+    $SIG{VTALRM} = 'DEFAULT';
+}
+

diff --git a/ext/Time/Piece/Piece.t b/ext/Time/Piece/Piece.t
new file mode 100644 (file)
index 0000000..c62e36d
--- /dev/null
+++ b/ext/Time/Piece/Piece.t
@@ -0,0 +1,323 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    require Config; import Config;
+
+    if ($Config{extensions} !~ m!\bTime/Piece\b!) {
+       print "1..0 # Time::Piece not built\n";
+       exit 0;
+    }
+}
+
+print "1..86\n";
+
+use Time::Piece;
+
+print "ok 1\n";
+
+my $t = gmtime(951827696); # 2001-02-29T12:34:56
+
+print "not " unless $t->sec == 56;
+print "ok 2\n";
+
+print "not " unless $t->second == 56;
+print "ok 3\n";
+
+print "not " unless $t->min == 34;
+print "ok 4\n";
+
+print "not " unless $t->minute == 34;
+print "ok 5\n";
+
+print "not " unless $t->hour == 12;
+print "ok 6\n";
+
+print "not " unless $t->mday == 29;
+print "ok 7\n";
+
+print "not " unless $t->day_of_month == 29;
+print "ok 8\n";
+
+print "not " unless $t->mon == 2;
+print "ok 9\n";
+
+print "not " unless $t->_mon == 1;
+print "ok 10\n";
+
+print "not " unless $t->monname eq 'Feb';
+print "ok 11\n";
+
+print "not " unless $t->month eq 'February';
+print "ok 12\n";
+
+print "not " unless $t->year == 2000;
+print "ok 13\n";
+
+print "not " unless $t->_year == 100;
+print "ok 14\n";
+
+print "not " unless $t->wday == 3;
+print "ok 15\n";
+
+print "not " unless $t->_wday == 2;
+print "ok 16\n";
+
+print "not " unless $t->day_of_week == 2;
+print "ok 17\n";
+
+print "not " unless $t->wdayname eq 'Tue';
+print "ok 18\n";
+
+print "not " unless $t->weekday eq 'Tuesday';
+print "ok 19\n";
+
+print "not " unless $t->yday == 59;
+print "ok 20\n";
+
+print "not " unless $t->day_of_year == 59;
+print "ok 21\n";
+
+# In GMT there should be no daylight savings ever.
+
+print "not " unless $t->isdst == 0;
+print "ok 22\n";
+
+print "not " unless $t->daylight_savings == 0;
+print "ok 23\n";
+
+print "not " unless $t->hms eq '12:34:56';
+print "ok 24\n";
+
+print "not " unless $t->time eq '12:34:56';
+print "ok 25\n";
+
+print "not " unless $t->ymd eq '2000-02-29';
+print "ok 26\n";
+
+print "not " unless $t->date eq '2000-02-29';
+print "ok 27\n";
+
+print "not " unless $t->mdy eq '02-29-2000';
+print "ok 28\n";
+
+print "not " unless $t->dmy eq '29-02-2000';
+print "ok 29\n";
+
+print "not " unless $t->cdate eq 'Tue Feb 29 12:34:56 2000';
+print "ok 30\n";
+
+print "not " unless "$t" eq 'Tue Feb 29 12:34:56 2000';
+print "ok 31\n";
+
+print "not " unless $t->datetime eq '2000-02-29T12:34:56';
+print "ok 32\n";
+
+print "not " unless $t->epoch == 951827696;
+print "ok 33\n";
+
+# ->tzoffset?
+
+print "not " unless ($t->julian_day / 2451604.0075) - 1 < 0.001;
+print "ok 34\n";
+
+print "not " unless ($t->mjd        /   51603.5075) - 1 < 0.001;
+print "ok 35\n";
+
+print "not " unless $t->week == 9;
+print "ok 36\n";
+
+if ($Config{d_strftime}) {
+
+    print "not " unless $t->strftime('%a') eq 'Tue';
+    print "ok 37\n";
+
+    print "not " unless $t->strftime('%A') eq 'Tuesday';
+    print "ok 38\n";
+
+    print "not " unless $t->strftime('%b') eq 'Feb';
+    print "ok 39\n";
+
+    print "not " unless $t->strftime('%B') eq 'February';
+    print "ok 40\n";
+
+    print "not " unless $t->strftime('%c') eq 'Tue Feb 29 12:34:56 2000';
+    print "ok 41\n";
+
+    print "not " unless $t->strftime('%C') == 20;
+    print "ok 42\n";
+
+    print "not " unless $t->strftime('%d') == 29;
+    print "ok 43\n";
+
+    print "not " unless $t->strftime('%D') eq '02/29/00'; # Yech!
+    print "ok 44\n";
+
+    print "not " unless $t->strftime('%e') eq '29'; # should test with < 10
+    print "ok 45\n";
+
+    print "not " unless $t->strftime('%H') eq '12'; # should test with < 10
+    print "ok 46\n";
+
+    print "not " unless $t->strftime('%b') eq 'Feb';
+    print "ok 47\n";
+
+    print "not " unless $t->strftime('%I') eq '12'; # should test with < 10
+    print "ok 48\n";
+
+    print "not " unless $t->strftime('%j') eq '059';
+    print "ok 49\n";
+
+    print "not " unless $t->strftime('%M') eq '34'; # should test with < 10
+    print "ok 50\n";
+
+    print "not " unless $t->strftime('%p') eq 'am';
+    print "ok 51\n";
+
+    print "not " unless $t->strftime('%r') eq '12:34:56 am';
+    print "ok 52\n";
+
+    print "not " unless $t->strftime('%R') eq '12:34'; # should test with > 12
+    print "ok 53\n";
+
+    print "not " unless $t->strftime('%S') eq '56'; # should test with < 10
+    print "ok 54\n";
+
+    print "not " unless $t->strftime('%T') eq '12:34:56'; # < 12 and > 12
+    print "ok 55\n";
+
+    print "not " unless $t->strftime('%u') == 2;
+    print "ok 56\n";
+
+    print "not " unless $t->strftime('%U') eq '09'; # Sun cmp Mon
+    print "ok 57\n";
+
+    print "not " unless $t->strftime('%V') eq '09'; # Sun cmp Mon
+    print "ok 58\n";
+
+    print "not " unless $t->strftime('%w') == 2;
+    print "ok 59\n";
+
+    print "not " unless $t->strftime('%W') eq '09'; # Sun cmp Mon
+    print "ok 60\n";
+
+    print "not " unless $t->strftime('%x') eq '02/29/00'; # Yech!
+    print "ok 61\n";
+
+    print "not " unless $t->strftime('%y') == 0; # should test with 1999
+    print "ok 62\n";
+
+    print "not " unless $t->strftime('%Y') eq '2000';
+    print "ok 63\n";
+
+    # %Z can't be tested, too unportable
+
+} else {
+    for (38...63) {
+       print "ok $_ # Skip: no strftime\n";
+    }
+}
+
+print "not " unless $t->ymd("") eq '20000229';
+print "ok 64\n";
+
+print "not " unless $t->mdy("/") eq '02/29/2000';
+print "ok 65\n";
+
+print "not " unless $t->dmy(".") eq '29.02.2000';
+print "ok 66\n";
+
+print "not " unless $t->date_separator() eq '-';
+print "ok 67\n";
+
+$t->date_separator("/");
+
+print "not " unless $t->ymd eq '2000/02/29';
+print "ok 68\n";
+
+print "not " unless $t->date_separator() eq '/';
+print "ok 69\n";
+
+$t->date_separator("-");
+
+print "not " unless $t->hms(".") eq '12.34.56';
+print "ok 70\n";
+
+print "not " unless $t->time_separator() eq ':';
+print "ok 71\n";
+
+$t->time_separator(".");
+
+print "not " unless $t->hms eq '12.34.56';
+print "ok 72\n";
+
+print "not " unless $t->time_separator() eq '.';
+print "ok 73\n";
+
+$t->time_separator(":");
+
+my @fidays = qw( sunnuntai maanantai tiistai keskiviikko torstai
+                perjantai lauantai );
+my @frdays = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi );
+
+print "not " unless $t->weekday(@fidays) eq "tiistai";
+print "ok 74\n";
+
+my @days = $t->weekday_names();
+
+Time::Piece::weekday_names(@frdays);
+
+print "not " unless $t->weekday eq "Merdi";
+print "ok 75\n";
+
+Time::Piece::weekday_names(@days);
+
+print "not " unless $t->weekday eq "Tuesday";
+print "ok 76\n";
+
+my @months = $t->mon_names();
+
+my @dumonths = qw(januari februari maart april mei juni
+                 juli augustus september oktober november december);
+
+print "not " unless $t->month(@dumonths) eq "februari";
+print "ok 77\n";
+
+Time::Piece::month_names(@dumonths);
+
+print "not " unless $t->month eq "februari";
+print "ok 78\n";
+
+Time::Piece::mon_names(@months);
+
+print "not " unless $t->monname eq "Feb";
+print "ok 79\n";
+
+print "not " unless
+    $t->datetime(date => '/', T => ' ', time => '-') eq "2000/02/29 12-34-56";
+print "ok 80\n";
+
+print "not " unless $t->is_leap_year;
+print "ok 81\n";
+
+print "not " unless $t->month_last_day == 29; # test more
+print "ok 82\n";
+
+print "not " if Time::Piece::_is_leap_year(1900);
+print "ok 83\n";
+
+print "not " if Time::Piece::_is_leap_year(1901);
+print "ok 84\n";
+
+print "not " unless Time::Piece::_is_leap_year(1904);
+print "ok 85\n";
+
+use Time::Piece 'strptime';
+
+my %T = strptime("%T", "12:34:56");
+
+print "not " unless keys %T == 3 && $T{H} == 12 && $T{M} == 34 && $T{S} == 56;
+print "ok 86\n";
+

diff --git a/ext/XS/Typemap/Typemap.t b/ext/XS/Typemap/Typemap.t
new file mode 100644 (file)
index 0000000..0cf1ab3
--- /dev/null
+++ b/ext/XS/Typemap/Typemap.t
@@ -0,0 +1,339 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bXS\/Typemap\b/) {
+        print "1..0 # Skip: XS::Typemap was not built\n";
+        exit 0;
+    }
+}
+
+use Test;
+BEGIN { plan tests => 84 }
+
+use strict;
+use warnings;
+use XS::Typemap;
+
+ok(1);
+
+# Some inheritance trees to check ISA relationships
+BEGIN {
+  package intObjPtr::SubClass;
+  use base qw/ intObjPtr /;
+  sub xxx { 1; }
+}
+
+BEGIN {
+  package intRefIvPtr::SubClass;
+  use base qw/ intRefIvPtr /;
+  sub xxx { 1 }
+}
+
+# T_SV - standard perl scalar value
+print "# T_SV\n";
+
+my $sv = "Testing T_SV";
+ok( T_SV($sv), $sv);
+
+# T_SVREF - reference to Scalar
+print "# T_SVREF\n";
+
+$sv .= "REF";
+my $svref = \$sv;
+ok( T_SVREF($svref), $svref );
+
+# Now test that a non reference is rejected
+# the typemaps croak
+eval { T_SVREF( "fail - not ref" ) };
+ok( $@ );
+
+# T_AVREF - reference to a perl Array
+print "# T_AVREF\n";
+
+my @array;
+ok( T_AVREF(\@array), \@array);
+
+# Now test that a non array ref is rejected
+eval { T_AVREF( \$sv ) };
+ok( $@ );
+
+# T_HVREF - reference to a perl Hash
+print "# T_HVREF\n";
+
+my %hash;
+ok( T_HVREF(\%hash), \%hash);
+
+# Now test that a non hash ref is rejected
+eval { T_HVREF( \@array ) };
+ok( $@ );
+
+
+# T_CVREF - reference to perl subroutine
+print "# T_CVREF\n";
+my $sub = sub { 1 };
+ok( T_CVREF($sub), $sub );
+
+# Now test that a non code ref is rejected
+eval { T_CVREF( \@array ) };
+ok( $@ );
+
+# T_SYSRET - system return values
+print "# T_SYSRET\n";
+
+# first check success
+ok( T_SYSRET_pass );
+
+# ... now failure
+ok( T_SYSRET_fail, undef);
+
+# T_UV - unsigned integer
+print "# T_UV\n";
+
+ok( T_UV(5), 5 );    # pass
+ok( T_UV(-4) != -4); # fail
+
+# T_IV - signed integer
+print "# T_IV\n";
+
+ok( T_IV(5), 5);
+ok( T_IV(-4), -4);
+ok( T_IV(4.1), int(4.1));
+ok( T_IV("52"), "52");
+ok( T_IV(4.5) != 4.5); # failure
+
+
+# Skip T_INT
+
+# T_ENUM - enum list
+print "# T_ENUM\n";
+
+ok( T_ENUM() ); # just hope for a true value
+
+# T_BOOL - boolean
+print "# T_BOOL\n";
+
+ok( T_BOOL(52) );
+ok( ! T_BOOL(0) );
+ok( ! T_BOOL('') );
+ok( ! T_BOOL(undef) );
+
+# Skip T_U_INT
+
+# Skip T_SHORT
+
+# T_U_SHORT aka U16
+
+print "# T_U_SHORT\n";
+
+ok( T_U_SHORT(32000), 32000);
+if ($Config{shortsize} == 2) {
+  ok( T_U_SHORT(65536) != 65536); # probably dont want to test edge cases
+} else {
+  ok(1); # e.g. Crays have shortsize 4 (T3X) or 8 (CXX and SVX)
+}
+
+# T_U_LONG aka U32
+
+print "# T_U_LONG\n";
+
+ok( T_U_LONG(65536), 65536);
+ok( T_U_LONG(-1) != -1);
+
+# T_CHAR
+
+print "# T_CHAR\n";
+
+ok( T_CHAR("a"), "a");
+ok( T_CHAR("-"), "-");
+ok( T_CHAR(chr(128)),chr(128));
+ok( T_CHAR(chr(256)) ne chr(256));
+
+# T_U_CHAR
+
+print "# T_U_CHAR\n";
+
+ok( T_U_CHAR(127), 127);
+ok( T_U_CHAR(128), 128);
+ok( T_U_CHAR(-1) != -1);
+ok( T_U_CHAR(300) != 300);
+
+# T_FLOAT
+print "# T_FLOAT\n";
+
+# limited precision
+ok( sprintf("%6.3f",T_FLOAT(52.345)), sprintf("%6.3f",52.345));
+
+# T_NV
+print "# T_NV\n";
+
+ok( T_NV(52.345), 52.345);
+
+# T_DOUBLE
+print "# T_DOUBLE\n";
+
+ok( sprintf("%6.3f",T_DOUBLE(52.345)), sprintf("%6.3f",52.345));
+
+# T_PV
+print "# T_PV\n";
+
+ok( T_PV("a string"), "a string");
+ok( T_PV(52), 52);
+
+# T_PTR
+print "# T_PTR\n";
+
+my $t = 5;
+my $ptr = T_PTR_OUT($t);
+ok( T_PTR_IN( $ptr ), $t );
+
+# T_PTRREF
+print "# T_PTRREF\n";
+
+$t = -52;
+$ptr = T_PTRREF_OUT( $t );
+ok( ref($ptr), "SCALAR");
+ok( T_PTRREF_IN( $ptr ), $t );
+
+# test that a non-scalar ref is rejected
+eval { T_PTRREF_IN( $t ); };
+ok( $@ );
+
+# T_PTROBJ
+print "# T_PTROBJ\n";
+
+$t = 256;
+$ptr = T_PTROBJ_OUT( $t );
+ok( ref($ptr), "intObjPtr");
+ok( $ptr->T_PTROBJ_IN, $t );
+
+# check that normal scalar refs fail
+eval {intObjPtr::T_PTROBJ_IN( \$t );};
+ok( $@ );
+
+# check that inheritance works
+bless $ptr, "intObjPtr::SubClass";
+ok( ref($ptr), "intObjPtr::SubClass");
+ok( $ptr->T_PTROBJ_IN, $t );
+
+# Skip T_REF_IV_REF
+
+# T_REF_IV_PTR
+print "# T_REF_IV_PTR\n";
+
+$t = -365;
+$ptr = T_REF_IV_PTR_OUT( $t );
+ok( ref($ptr), "intRefIvPtr");
+ok( $ptr->T_REF_IV_PTR_IN(), $t);
+
+# inheritance should not work
+bless $ptr, "intRefIvPtr::SubClass";
+eval { $ptr->T_REF_IV_PTR_IN };
+ok( $@ );
+
+# Skip T_PTRDESC
+
+# Skip T_REFREF
+
+# Skip T_REFOBJ
+
+# T_OPAQUEPTR
+print "# T_OPAQUEPTR\n";
+
+$t = 22;
+my $p = T_OPAQUEPTR_IN( $t );
+ok( T_OPAQUEPTR_OUT($p), $t);
+
+# T_OPAQUEPTR with a struct
+print "# T_OPAQUEPTR with a struct\n";
+
+my @test = (5,6,7);
+$p = T_OPAQUEPTR_IN_struct(@test);
+my @result = T_OPAQUEPTR_OUT_struct($p);
+ok(scalar(@result),scalar(@test));
+for (0..$#test) {
+  ok($result[$_], $test[$_]);
+}
+
+# T_OPAQUE
+print "# T_OPAQUE\n";
+
+$t = 48;
+$p = T_OPAQUE_IN( $t );
+ok(T_OPAQUEPTR_OUT_short( $p ), $t); # Test using T_OPAQUEPTR
+ok(T_OPAQUE_OUT( $p ), $t );         # Test using T_OPQAQUE
+
+# T_OPAQUE_array
+print "# A packed  array\n";
+
+my @opq = (2,4,8);
+my $packed = T_OPAQUE_array(@opq);
+my @uopq = unpack("i*",$packed);
+ok(scalar(@uopq), scalar(@opq));
+for (0..$#opq) {
+  ok( $uopq[$_], $opq[$_]);
+}
+
+# Skip T_PACKED
+
+# Skip T_PACKEDARRAY
+
+# Skip T_DATAUNIT
+
+# Skip T_CALLBACK
+
+# T_ARRAY
+print "# T_ARRAY\n";
+my @inarr = (1,2,3,4,5,6,7,8,9,10);
+my @outarr = T_ARRAY( 5, @inarr );
+ok(scalar(@outarr), scalar(@inarr));
+
+for (0..$#inarr) {
+  ok($outarr[$_], $inarr[$_]);
+}
+
+
+
+# T_STDIO
+print "# T_STDIO\n";
+
+# open a file in XS for write
+my $testfile= "stdio.tmp";
+my $fh = T_STDIO_open( $testfile );
+ok( $fh );
+
+# write to it using perl
+if (defined $fh) {
+
+  my @lines = ("NormalSTDIO\n", "PerlIO\n");
+
+  # print to it using FILE* through XS
+  ok( T_STDIO_print($fh, $lines[0]), length($lines[0]));
+
+  # print to it using normal perl
+  ok(print $fh "$lines[1]");
+
+  # close it using XS
+  # This works fine but causes a segmentation fault during global
+  # destruction when the glob associated with this filehandle is
+  # tidied up.
+#  ok( T_STDIO_close( $fh ) );
+  ok(close($fh)); # using perlio to close the glob works fine
+
+  # open from perl, and check contents
+  open($fh, "< $testfile");
+  ok($fh);
+  my $line = <$fh>;
+  ok($line,$lines[0]);
+  $line = <$fh>;
+  ok($line,$lines[1]);
+
+  ok(close($fh));
+  ok(unlink($testfile));
+
+} else {
+  for (1..8) {
+    skip("Skip Test not relevant since file was not opened correctly",0);
+  }
+}
+

diff --git a/ext/attrs.t b/ext/attrs.t
new file mode 100644 (file)
index 0000000..18a02ab
--- /dev/null
+++ b/ext/attrs.t
@@ -0,0 +1,141 @@
+#!./perl
+
+# Regression tests for attrs.pm and the C<sub x : attrs> syntax.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    eval 'require attrs; 1' or do {
+       print "1..0\n";
+       exit 0;
+    }
+}
+
+use warnings;
+no warnings qw(deprecated);     # else attrs cries.
+
+sub NTESTS () ;
+
+my ($test, $ntests);
+BEGIN {$ntests=0}
+$test=0;
+my $failed = 0;
+
+print "1..".NTESTS."\n";
+
+eval 'sub t1 ($) { use attrs "locked"; $_[0]++ }';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub t2 { use attrs "locked"; $_[0]++ }';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub t3 ($) : locked ;';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub t4 : locked ;';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+my $anon1;
+eval '$anon1 = sub ($) { use attrs qw(locked method); $_[0]++ }';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+my $anon2;
+eval '$anon2 = sub { use attrs qw(locked method); $_[0]++ }';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+my $anon3;
+eval '$anon3 = sub { use attrs "method"; $_[0]->[1] }';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+my @attrs = attrs::get($anon3 ? $anon3 : \&ns);
+(print "not "), $failed=1 unless "@attrs" eq "method";
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+@attrs = sort +attrs::get($anon2 ? $anon2 : \&ns);
+(print "not "), $failed=1 unless "@attrs" eq "locked method";
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+@attrs = sort +attrs::get($anon1 ? $anon1 : \&ns);
+(print "not "), $failed=1 unless "@attrs" eq "locked method";
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub e1 ($) : plugh ;';
+unless ($@ && $@ =~ m/^Invalid CODE attribute: ["']?plugh["']? at/) {
+    my $x = $@;
+    $x =~ s/\n.*\z//s;
+    print "# $x\n";
+    print "not ";
+    $failed = 1;
+}
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub e2 ($) : plugh(0,0) xyzzy ;';
+unless ($@ && $@ =~ m/^Invalid CODE attributes: ["']?plugh\(0,0\)["']? /) {
+    my $x = $@;
+    $x =~ s/\n.*\z//s;
+    print "# $x\n";
+    print "not ";
+    $failed = 1;
+}
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub e3 ($) : plugh(0,0 xyzzy ;';
+unless ($@ && $@ =~ m/Unterminated attribute parameter in attribute list at/) {
+    my $x = $@;
+    $x =~ s/\n.*\z//s;
+    print "# $x\n";
+    print "not ";
+    $failed = 1;
+}
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub e4 ($) : plugh + xyzzy ;';
+unless ($@ && $@ =~ m/Invalid separator character '[+]' in attribute list at/) {
+    my $x = $@;
+    $x =~ s/\n.*\z//s;
+    print "# $x\n";
+    print "not ";
+    $failed = 1;
+}
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+{
+    my $w = "" ;
+    local $SIG{__WARN__} = sub {$w = shift} ;
+    eval 'sub w1 ($) { use warnings "deprecated"; use attrs "locked"; $_[0]++ }';
+    (print "not "), $failed=1 if $@;
+    print "ok ",++$test,"\n";
+    BEGIN {++$ntests}
+    (print "not "), $failed=1 
+       if $w !~ /^pragma "attrs" is deprecated, use "sub NAME : ATTRS" instead at/;
+    print "ok ",++$test,"\n";
+    BEGIN {++$ntests}
+}
+
+
+# Other tests should be added above this line
+
+sub NTESTS () { $ntests }
+
+exit $failed;

diff --git a/installperl b/installperl
index a58f8e5a5363b82de7e2f37b3b0b01d34a8b4284..e681eaee921dd5f7c15afa71a16d4cf153cd589e 100755 (executable)
--- a/installperl
+++ b/installperl
@@ -694,8 +694,11 @@ sub installlib {
     }
     
     # ignore patch backups, RCS files, emacs backup & temp files and the
-    # .exists files, and .PL files.
-    return if $name =~ m{\.orig$|~$|^#.+#$|,v$|^\.exists|\.PL$};
+    # .exists files, .PL files, and .t files.
+    return if $name =~ m{\.orig$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.t$};
+
+    # ignore locale, strict, and warnings test data files
+    return if $name =~ m{^lib/(locale|strict|warnings)/\w+$};
 
     $name = "$dir/$name" if $dir ne '';
 

diff --git a/lib/AnyDBM_File.t b/lib/AnyDBM_File.t
new file mode 100755 (executable)
index 0000000..30b3c7a
--- /dev/null
+++ b/lib/AnyDBM_File.t
@@ -0,0 +1,155 @@
+#!./perl
+
+# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (($Config{'extensions'} !~ /\b(DB|[A-Z]DBM)_File\b/) ){
+      print "1..0 # Skipping (no DB_File or [A-Z]DBM_File)\n";
+      exit 0;
+    }
+}
+require AnyDBM_File;
+use Fcntl;
+
+print "1..12\n";
+
+$Is_Dosish = ($^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare' or $^O eq 'dos' or
+             $^O eq 'os2' or $^O eq 'mint');
+
+unlink <Op_dbmx*>;
+
+umask(0);
+print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640)
+       ? "ok 1\n" : "not ok 1\n");
+
+$Dfile = "Op_dbmx.pag";
+if (! -e $Dfile) {
+       ($Dfile) = <Op_dbmx*>;
+}
+if ($Is_Dosish || $^O eq 'MacOS') {
+    print "ok 2 # Skipped: different file permission semantics\n";
+}
+else {
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+     $blksize,$blocks) = stat($Dfile);
+    print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
+}
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3 # i=$i\n\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+untie(%h);
+print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (($key,$value) = each(%h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+       $key =~ y/a-z/A-Z/;
+       $i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(%h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+$h{'foo'} = '';
+$h{''} = 'bar';
+
+# check cache overflow and numeric keys and contents
+$ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
+
+print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
+if ($h{''} eq 'bar') {
+   print "ok 12\n" ;
+}
+else {
+   if ($AnyDBM_File::ISA[0] eq 'DB_File' && $DB_File::db_ver >= 2.004010) {
+     ($major, $minor, $patch) = ($DB_File::db_ver =~ /^(\d+)\.(\d\d\d)(\d\d\d)/) ;
+     $major =~ s/^0+// ;
+     $minor =~ s/^0+// ;
+     $patch =~ s/^0+// ;
+     $compact = "$major.$minor.$patch" ;
+     #
+     # anydbm.t test 12 will fail when AnyDBM_File uses the combination of
+     # DB_File and Berkeley DB 2.4.10 (or greater). 
+     # You are using DB_File $DB_File::VERSION and Berkeley DB $compact
+     #
+     # Berkeley DB 2 from version 2.4.10 onwards does not allow null keys.
+     # This feature will be reenabled in a future version of Berkeley DB.
+     #
+     print "ok 12 # skipped: db v$compact, no null key support\n" ;
+   }
+   else {
+     print "not ok 12\n" ;
+   }
+}
+
+untie %h;
+if ($^O eq 'VMS') {
+  unlink 'Op_dbmx.sdbm_dir', $Dfile;
+} else {
+  unlink 'Op_dbmx.dir', $Dfile;  
+}

diff --git a/lib/Attribute/Handlers.t b/lib/Attribute/Handlers.t
new file mode 100644 (file)
index 0000000..5056fa8
--- /dev/null
+++ b/lib/Attribute/Handlers.t
@@ -0,0 +1,130 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+END {print "not ok 1\n" unless $loaded;}
+use v5.6.0;
+use Attribute::Handlers;
+$loaded = 1;
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+sub ok { $::count++; push @::results, [$_[1], $_[0]?"":"not "]; }
+
+END { print "1..$::count\n";
+      print map "$_->[1]ok $_->[0]\n", sort {$a->[0]<=>$b->[0]} @::results }
+
+package Test;
+use warnings;
+no warnings 'redefine';
+
+sub UNIVERSAL::Okay :ATTR { ::ok @{$_[4]} }
+
+sub Dokay :ATTR(SCALAR) { ::ok @{$_[4]} }
+sub Dokay :ATTR(HASH)   { ::ok @{$_[4]} }
+sub Dokay :ATTR(ARRAY)  { ::ok @{$_[4]} }
+sub Dokay :ATTR(CODE)   { ::ok @{$_[4]} }
+
+sub Vokay :ATTR(VAR)    { ::ok @{$_[4]} }
+
+sub Aokay :ATTR(ANY)    { ::ok @{$_[4]} }
+
+package main;
+use warnings;
+
+my $x1 :Okay(1,1);
+my @x1 :Okay(1=>2);
+my %x1 :Okay(1,3);
+sub x1 :Okay(1,4) {}
+
+my Test $x2 :Dokay(1,5);
+
+package Test;
+my $x3 :Dokay(1,6);
+my Test $x4 :Dokay(1,7);
+sub x3 :Dokay(1,8) {}
+
+my $y1 :Okay(1,9);
+my @y1 :Okay(1,10);
+my %y1 :Okay(1,11);
+sub y1 :Okay(1,12) {}
+
+my $y2 :Vokay(1,13);
+my @y2 :Vokay(1,14);
+my %y2 :Vokay(1,15);
+# BEGIN {eval 'sub y2 :Vokay(0,16) {}; 1' or
+::ok(1,16);
+# }
+
+my $z :Aokay(1,17);
+my @z :Aokay(1,18);
+my %z :Aokay(1,19);
+sub z :Aokay(1,20) {};
+
+package DerTest;
+use base 'Test';
+use warnings;
+
+my $x5 :Dokay(1,21);
+my Test $x6 :Dokay(1,22);
+sub x5 :Dokay(1,23);
+
+my $y3 :Okay(1,24);
+my @y3 :Okay(1,25);
+my %y3 :Okay(1,26);
+sub y3 :Okay(1,27) {}
+
+package Unrelated;
+
+BEGIN { eval 'my $x7 :Dokay(0,28)' or ::ok(1,28); }
+my Test $x8 :Dokay(1,29);
+eval 'sub x7 :Dokay(0,30) {}' or ::ok(1,30);
+
+
+package Tie::Loud;
+
+sub TIESCALAR { ::ok(1,31); bless {}, $_[0] }
+sub FETCH { ::ok(1,32); return 1 }
+sub STORE { ::ok(1,33); return 1 }
+
+package Tie::Noisy;
+
+sub TIEARRAY { ::ok(1,$_[1]); bless {}, $_[0] }
+sub FETCH { ::ok(1,35); return 1 }
+sub STORE { ::ok(1,36); return 1 }
+sub FETCHSIZE { 100 }
+
+package Tie::Rowdy;
+
+sub TIEHASH { ::ok(1,$_[1]); bless {}, $_[0] }
+sub FETCH { ::ok(1,38); return 1 }
+sub STORE { ::ok(1,39); return 1 }
+
+package main;
+
+use Attribute::Handlers autotie => {      Other::Loud => Tie::Loud,
+                                               Noisy => Tie::Noisy,
+                                    UNIVERSAL::Rowdy => Tie::Rowdy,
+                                   };
+
+my Other $loud : Loud;
+$loud++;
+
+my @noisy : Noisy(34);
+$noisy[0]++;
+
+my %rowdy : Rowdy(37);
+$rowdy{key}++;

diff --git a/lib/AutoLoader.t b/lib/AutoLoader.t
new file mode 100755 (executable)
index 0000000..f2fae7f
--- /dev/null
+++ b/lib/AutoLoader.t
@@ -0,0 +1,128 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') {
+       $dir = ":auto-$$";
+       $sep = ":";
+    } else {
+       $dir = "auto-$$";
+       $sep = "/";
+    }
+    @INC = $dir;
+    push @INC, '../lib';
+}
+
+print "1..11\n";
+
+# First we must set up some autoloader files
+mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
+mkdir "$dir${sep}auto", 0755     or die "Can't mkdir: $!";
+mkdir "$dir${sep}auto${sep}Foo", 0755 or die "Can't mkdir: $!";
+
+open(FOO, ">$dir${sep}auto${sep}Foo${sep}foo.al") or die;
+print FOO <<'EOT';
+package Foo;
+sub foo { shift; shift || "foo" }
+1;
+EOT
+close(FOO);
+
+open(BAR, ">$dir${sep}auto${sep}Foo${sep}bar.al") or die;
+print BAR <<'EOT';
+package Foo;
+sub bar { shift; shift || "bar" }
+1;
+EOT
+close(BAR);
+
+open(BAZ, ">$dir${sep}auto${sep}Foo${sep}bazmarkhian.al") or die;
+print BAZ <<'EOT';
+package Foo;
+sub bazmarkhianish { shift; shift || "baz" }
+1;
+EOT
+close(BAZ);
+
+# Let's define the package
+package Foo;
+require AutoLoader;
+@ISA=qw(AutoLoader);
+
+sub new { bless {}, shift };
+
+package main;
+
+$foo = new Foo;
+
+print "not " unless $foo->foo eq 'foo';  # autoloaded first time
+print "ok 1\n";
+
+print "not " unless $foo->foo eq 'foo';  # regular call
+print "ok 2\n";
+
+# Try an undefined method
+eval {
+    $foo->will_fail;
+};
+print "not " unless $@ =~ /^Can't locate/;
+print "ok 3\n";
+
+# Used to be trouble with this
+eval {
+    my $foo = new Foo;
+    die "oops";
+};
+print "not " unless $@ =~ /oops/;
+print "ok 4\n";
+
+# Pass regular expression variable to autoloaded function.  This used
+# to go wrong because AutoLoader used regular expressions to generate
+# autoloaded filename.
+"foo" =~ /(\w+)/;
+print "not " unless $1 eq 'foo';
+print "ok 5\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 6\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 7\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 8\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 9\n";
+
+# test recursive autoloads
+open(F, ">$dir${sep}auto${sep}Foo${sep}a.al") or die;
+print F <<'EOT';
+package Foo;
+BEGIN { b() }
+sub a { print "ok 11\n"; }
+1;
+EOT
+close(F);
+
+open(F, ">$dir${sep}auto${sep}Foo${sep}b.al") or die;
+print F <<'EOT';
+package Foo;
+sub b { print "ok 10\n"; }
+1;
+EOT
+close(F);
+Foo::a();
+
+# cleanup
+END {
+return unless $dir && -d $dir;
+unlink "$dir${sep}auto${sep}Foo${sep}foo.al";
+unlink "$dir${sep}auto${sep}Foo${sep}bar.al";
+unlink "$dir${sep}auto${sep}Foo${sep}bazmarkhian.al";
+unlink "$dir${sep}auto${sep}Foo${sep}a.al";
+unlink "$dir${sep}auto${sep}Foo${sep}b.al";
+rmdir "$dir${sep}auto${sep}Foo";
+rmdir "$dir${sep}auto";
+rmdir "$dir";
+}

diff --git a/lib/Benchmark.t b/lib/Benchmark.t
new file mode 100755 (executable)
index 0000000..be711f1
--- /dev/null
+++ b/lib/Benchmark.t
@@ -0,0 +1,88 @@
+#!perl
+
+BEGIN {
+    chdir( 't' ) if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDevel\/DProf\b/){
+      print "1..0 # Skip: Devel::DProf was not built\n";
+      exit 0;
+    }
+}
+
+END {
+    while(-e 'tmon.out' && unlink 'tmon.out') {}
+    while(-e 'err' && unlink 'err') {}
+}
+
+use Benchmark qw( timediff timestr );
+use Getopt::Std 'getopts';
+getopts('vI:p:');
+
+# -v   Verbose
+# -I   Add to @INC
+# -p   Name of perl binary
+
+@tests = @ARGV ? @ARGV : sort (<lib/dprof/*_t>, <lib/dprof/*_v>);  # glob-sort, for OS/2
+
+$path_sep = $Config{path_sep} || ':';
+$perl5lib = $opt_I || join( $path_sep, @INC );
+$perl = $opt_p || $^X;
+
+if( $opt_v ){
+       print "tests: @tests\n";
+       print "perl: $perl\n";
+       print "perl5lib: $perl5lib\n";
+}
+if( $perl =~ m|^\./| ){
+       # turn ./perl into ../perl, because of chdir(t) above.
+       $perl = ".$perl";
+}
+if( ! -f $perl ){ die "Where's Perl?" }
+
+sub profile {
+       my $test = shift;
+       my @results;
+       local $ENV{PERL5LIB} = $perl5lib;
+       my $opt_d = '-d:DProf';
+
+       my $t_start = new Benchmark;
+        open( R, "$perl \"$opt_d\" $test |" ) || warn "$0: Can't run. $!\n";
+       @results = <R>;
+       close R;
+       my $t_total = timediff( new Benchmark, $t_start );
+
+       if( $opt_v ){
+               print "\n";
+               print @results
+       }
+
+        print '# ',timestr( $t_total, 'nop' ), "\n";
+}
+
+
+sub verify {
+       my $test = shift;
+
+       my $command = $perl.' "-I../lib" "-I./lib/dprof" '.$test;
+       $command .= ' -v' if $opt_v;
+       $command .= ' -p '. $perl;
+       system $command;
+}
+
+
+$| = 1;
+print "1..18\n";
+while( @tests ){
+       $test = shift @tests;
+        $test =~ s/\.$// if $^O eq 'VMS';
+       if( $test =~ /_t$/i ){
+               print "# $test" . '.' x (20 - length $test);
+               profile $test;
+       }
+       else{
+               verify $test;
+       }
+}
+
+unlink("tmon.out");

diff --git a/lib/CGI/t/form.t b/lib/CGI/t/form.t
new file mode 100755 (executable)
index 0000000..2922903
--- /dev/null
+++ b/lib/CGI/t/form.t
@@ -0,0 +1,90 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..17\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI (':standard','-no_debug');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+my $CRLF = "\015\012";
+if ($^O eq 'VMS') { 
+    $CRLF = "\n";  # via web server carriage is inserted automatically
+}
+if (ord("\t") != 9) { # EBCDIC?
+    $CRLF = "\r\n";
+}
+
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD}='GET';
+$ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO}     ='/somewhere/else';
+$ENV{PATH_TRANSLATED} ='/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME}   ='/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+
+test(2,start_form(-action=>'foobar',-method=>'get') eq 
+     qq(<form method="get" action="foobar" enctype="application/x-www-form-urlencoded">\n),
+     "start_form()");
+
+test(3,submit() eq qq(<input type="submit" name=".submit" />),"submit()");
+test(4,submit(-name=>'foo',-value=>'bar') eq qq(<input type="submit" name="foo" value="bar" />),"submit(-name,-value)");
+test(5,submit({-name=>'foo',-value=>'bar'}) eq qq(<input type="submit" name="foo" value="bar" />),"submit({-name,-value})");
+test(6,textfield(-name=>'weather') eq qq(<input type="text" name="weather" value="dull" />),"textfield({-name})");
+test(7,textfield(-name=>'weather',-value=>'nice') eq qq(<input type="text" name="weather" value="dull" />),"textfield({-name,-value})");
+test(8,textfield(-name=>'weather',-value=>'nice',-override=>1) eq qq(<input type="text" name="weather" value="nice" />),
+     "textfield({-name,-value,-override})");
+test(9,checkbox(-name=>'weather',-value=>'nice') eq qq(<input type="checkbox" name="weather" value="nice" />weather),
+     "checkbox()");
+test(10,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast') eq 
+     qq(<input type="checkbox" name="weather" value="nice" />forecast),
+     "checkbox()");
+test(11,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast',-checked=>1,-override=>1) eq 
+     qq(<input type="checkbox" name="weather" value="nice" checked />forecast),
+     "checkbox()");
+test(12,checkbox(-name=>'weather',-value=>'dull',-label=>'forecast') eq 
+     qq(<input type="checkbox" name="weather" value="dull" checked />forecast),
+     "checkbox()");
+
+test(13,radio_group(-name=>'game') eq 
+     qq(<input type="radio" name="game" value="chess" checked />chess <input type="radio" name="game" value="checkers" />checkers),
+     'radio_group()');
+test(14,radio_group(-name=>'game',-labels=>{'chess'=>'ping pong'}) eq 
+     qq(<input type="radio" name="game" value="chess" checked />ping pong <input type="radio" name="game" value="checkers" />checkers),
+     'radio_group()');
+
+test(15, checkbox_group(-name=>'game',-Values=>[qw/checkers chess cribbage/]) eq 
+     qq(<input type="checkbox" name="game" value="checkers" checked />checkers <input type="checkbox" name="game" value="chess" checked />chess <input type="checkbox" name="game" value="cribbage" />cribbage),
+     'checkbox_group()');
+
+test(16, checkbox_group(-name=>'game',-values=>[qw/checkers chess cribbage/],-defaults=>['cribbage'],-override=>1) eq 
+     qq(<input type="checkbox" name="game" value="checkers" />checkers <input type="checkbox" name="game" value="chess" />chess <input type="checkbox" name="game" value="cribbage" checked />cribbage),
+     'checkbox_group()');
+test(17, popup_menu(-name=>'game',-values=>[qw/checkers chess cribbage/],-default=>'cribbage',-override=>1) eq <<END,'checkbox_group()');
+<select name="game">
+<option  value="checkers">checkers</option>
+<option  value="chess">chess</option>
+<option selected value="cribbage">cribbage</option>
+</select>
+END
+

diff --git a/lib/CGI/t/function.t b/lib/CGI/t/function.t
new file mode 100755 (executable)
index 0000000..b670e33
--- /dev/null
+++ b/lib/CGI/t/function.t
@@ -0,0 +1,111 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..27\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Config;
+use CGI (':standard','keywords');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+my $CRLF = "\015\012";
+
+# A peculiarity of sending "\n" through MBX|Socket|web-server on VMS 
+# is that a CR character gets inserted automatically in the web server 
+# case but not internal to perl's double quoted strings "\n".  This
+# test would need to be modified to use the "\015\012" on VMS if it
+# were actually run through a web server.
+# Thanks to Peter Prymmer for this
+
+if ($^O eq 'VMS') { $CRLF = "\n"; }
+
+# Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII
+# translation hence CRLF is used as \r\n within CGI.pm on such machines.
+
+if (ord("\t") != 9) { $CRLF = "\r\n"; }
+
+# Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII
+# translation hence CRLF is used as \r\n within CGI.pm on such machines.
+
+if (ord("\t") != 9) { $CRLF = "\r\n"; }
+ 
+# Set up a CGI environment
+$ENV{REQUEST_METHOD}='GET';
+$ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO}     ='/somewhere/else';
+$ENV{PATH_TRANSLATED} ='/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME}   ='/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+$ENV{HTTP_LOVE} = 'true';
+
+test(2,request_method() eq 'GET',"CGI::request_method()");
+test(3,query_string() eq 'game=chess;game=checkers;weather=dull',"CGI::query_string()");
+test(4,param() == 2,"CGI::param()");
+test(5,join(' ',sort {$a cmp $b} param()) eq 'game weather',"CGI::param()");
+test(6,param('game') eq 'chess',"CGI::param()");
+test(7,param('weather') eq 'dull',"CGI::param()");
+test(8,join(' ',param('game')) eq 'chess checkers',"CGI::param()");
+test(9,param(-name=>'foo',-value=>'bar'),'CGI::param() put');
+test(10,param(-name=>'foo') eq 'bar','CGI::param() get');
+test(11,query_string() eq 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux");
+test(12,http('love') eq 'true',"CGI::http()");
+test(13,script_name() eq '/cgi-bin/foo.cgi',"CGI::script_name()");
+test(14,url() eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
+test(15,self_url() eq 
+     'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+     "CGI::url()");
+test(16,url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
+test(17,url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
+test(18,url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
+test(19,url(-relative=>1,-path=>1,-query=>1) eq 
+     'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+     'CGI::url(-relative=>1,-path=>1,-query=>1)');
+Delete('foo');
+test(20,!param('foo'),'CGI::delete()');
+
+CGI::_reset_globals();
+$ENV{QUERY_STRING}='mary+had+a+little+lamb';
+test(21,join(' ',keywords()) eq 'mary had a little lamb','CGI::keywords');
+test(22,join(' ',param('keywords')) eq 'mary had a little lamb','CGI::keywords');
+
+CGI::_reset_globals;
+if ($Config{d_fork}) {
+  $test_string = 'game=soccer&game=baseball&weather=nice';
+  $ENV{REQUEST_METHOD}='POST';
+  $ENV{CONTENT_LENGTH}=length($test_string);
+  $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
+  if (open(CHILD,"|-")) {  # cparent
+    print CHILD $test_string;
+    close CHILD;
+    exit 0;
+  }
+  # at this point, we're in a new (child) process
+  test(23,param('weather') eq 'nice',"CGI::param() from POST");
+  test(24,(url_param('big_balls') eq 'basketball'),"CGI::url_param()");
+} else {
+  print "ok 23 # Skip\n";
+  print "ok 24 # Skip\n";
+}
+test(25,redirect('http://somewhere.else') eq "Status: 302 Moved${CRLF}location: http://somewhere.else${CRLF}${CRLF}","CGI::redirect() 1");
+my $h = redirect(-Location=>'http://somewhere.else',-Type=>'text/html');
+test(26,$h eq "Status: 302 Moved${CRLF}location: http://somewhere.else${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
+test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html') eq "Status: 302 Moved${CRLF}location: http://somewhere.else/bin/foo&bar${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");

diff --git a/lib/CGI/t/html.t b/lib/CGI/t/html.t
new file mode 100755 (executable)
index 0000000..93e5dac
--- /dev/null
+++ b/lib/CGI/t/html.t
@@ -0,0 +1,95 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..24\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI (':standard','-no_debug','*h3','start_table');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+my $CRLF = "\015\012";
+if ($^O eq 'VMS') { 
+  $CRLF = "\n";  # via web server carriage is inserted automatically
+}
+if (ord("\t") != 9) { # EBCDIC?
+  $CRLF = "\r\n";
+}
+
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# all the automatic tags
+test(2,h1() eq '<h1 />',"single tag");
+test(3,h1('fred') eq '<h1>fred</h1>',"open/close tag");
+test(4,h1('fred','agnes','maura') eq '<h1>fred agnes maura</h1>',"open/close tag multiple");
+test(5,h1({-align=>'CENTER'},'fred') eq '<h1 align="CENTER">fred</h1>',"open/close tag with attribute");
+test(6,h1({-align=>undef},'fred') eq '<h1 align>fred</h1>',"open/close tag with orphan attribute");
+test(7,h1({-align=>'CENTER'},['fred','agnes']) eq 
+     '<h1 align="CENTER">fred</h1> <h1 align="CENTER">agnes</h1>',
+     "distributive tag with attribute");
+{
+    local($") = '-'; 
+    test(8,h1('fred','agnes','maura') eq '<h1>fred-agnes-maura</h1>',"open/close tag \$\" interpolation");
+}
+test(9,header() eq "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","header()");
+test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${CRLF}${CRLF}","header()");
+test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${CRLF}Content-Type: image/gif${CRLF}${CRLF}","header()");
+test(12,header(-nph=>1) =~ m!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,"header()");
+test(13,start_html() ."\n" eq <<END,"start_html()");
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE html
+       PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN"
+       "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
+</head><body>
+END
+    ;
+test(14,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR") ."\n" eq <<END,"start_html()");
+<!DOCTYPE html
+       PUBLIC "-//IETF//DTD HTML 3.2//FR">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
+</head><body>
+END
+    ;
+test(15,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE html
+       PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN"
+       "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>The world of foo</title>
+</head><body>
+END
+    ;
+test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 'fred=chocolate&chip; path=/',"cookie()");
+my $h = header(-Cookie=>$cookie);
+test(17,$h =~ m!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Date:.*${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s, 
+  "header(-cookie)");
+test(18,start_h3 eq '<h3>');
+test(19,end_h3 eq '</h3>');
+test(20,start_table({-border=>undef}) eq '<table border>');
+test(21,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; &#139;right&#155;</h1>');
+charset('utf-8');
+if (ord("\t") == 9) {
+test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; \8bright\9b</h1>');
+}
+else {
+test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; »rightº</h1>');
+}
+test(23,i(p('hello there')) eq '<i><p>hello there</p></i>');
+my $q = new CGI;
+test(24,$q->h1('hi') eq '<h1>hi</h1>');

diff --git a/lib/CGI/t/pretty.t b/lib/CGI/t/pretty.t
new file mode 100755 (executable)
index 0000000..14f6447
--- /dev/null
+++ b/lib/CGI/t/pretty.t
@@ -0,0 +1,41 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..5\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI::Pretty (':standard','-no_debug','*h3','start_table');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# all the automatic tags
+test(2,h1() eq '<h1>',"single tag");
+test(3,ol(li('fred'),li('ethel')) eq "<ol>\n\t<li>\n\t\tfred\n\t</li>\n\t <li>\n\t\tethel\n\t</li>\n</ol>\n","basic indentation");
+test(4,p('hi',pre('there'),'frog') eq 
+'<p>
+       hi <pre>there</pre>
+        frog
+</p>
+',"<pre> tags");
+test(5,p('hi',a({-href=>'frog'},'there'),'frog') eq 
+'<p>
+       hi <a href="frog">there</a>
+        frog
+</p>
+',"as-is");

diff --git a/lib/CGI/t/request.t b/lib/CGI/t/request.t
new file mode 100755 (executable)
index 0000000..fde3fd0
--- /dev/null
+++ b/lib/CGI/t/request.t
@@ -0,0 +1,103 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..33\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI ();
+use Config;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD}  = 'GET';
+$ENV{QUERY_STRING}    = 'game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO}       = '/somewhere/else';
+$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME}     = '/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT}     = 8080;
+$ENV{SERVER_NAME}     = 'the.good.ship.lollypop.com';
+$ENV{REQUEST_URI}     = "$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?$ENV{QUERY_STRING}";
+$ENV{HTTP_LOVE}       = 'true';
+
+$q = new CGI;
+test(2,$q,"CGI::new()");
+test(3,$q->request_method eq 'GET',"CGI::request_method()");
+test(4,$q->query_string eq 'game=chess;game=checkers;weather=dull',"CGI::query_string()");
+test(5,$q->param() == 2,"CGI::param()");
+test(6,join(' ',sort $q->param()) eq 'game weather',"CGI::param()");
+test(7,$q->param('game') eq 'chess',"CGI::param()");
+test(8,$q->param('weather') eq 'dull',"CGI::param()");
+test(9,join(' ',$q->param('game')) eq 'chess checkers',"CGI::param()");
+test(10,$q->param(-name=>'foo',-value=>'bar'),'CGI::param() put');
+test(11,$q->param(-name=>'foo') eq 'bar','CGI::param() get');
+test(12,$q->query_string eq 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux");
+test(13,$q->http('love') eq 'true',"CGI::http()");
+test(14,$q->script_name eq '/cgi-bin/foo.cgi',"CGI::script_name()");
+test(15,$q->url eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
+test(16,$q->self_url eq 
+     'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+     "CGI::url()");
+test(17,$q->url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
+test(18,$q->url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
+test(19,$q->url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
+test(20,$q->url(-relative=>1,-path=>1,-query=>1) eq 
+     'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+     'CGI::url(-relative=>1,-path=>1,-query=>1)');
+$q->delete('foo');
+test(21,!$q->param('foo'),'CGI::delete()');
+
+$q->_reset_globals;
+$ENV{QUERY_STRING}='mary+had+a+little+lamb';
+test(22,$q=new CGI,"CGI::new() redux");
+test(23,join(' ',$q->keywords) eq 'mary had a little lamb','CGI::keywords');
+test(24,join(' ',$q->param('keywords')) eq 'mary had a little lamb','CGI::keywords');
+test(25,$q=new CGI('foo=bar&foo=baz'),"CGI::new() redux");
+test(26,$q->param('foo') eq 'bar','CGI::param() redux');
+test(27,$q=new CGI({'foo'=>'bar','bar'=>'froz'}),"CGI::new() redux 2");
+test(28,$q->param('bar') eq 'froz',"CGI::param() redux 2");
+
+# test tied interface
+my $p = $q->Vars;
+test(29,$p->{bar} eq 'froz',"tied interface fetch");
+$p->{bar} = join("\0",qw(foo bar baz));
+test(30,join(' ',$q->param('bar')) eq 'foo bar baz','tied interface store');
+
+# test posting
+$q->_reset_globals;
+if ($Config{d_fork}) {
+  $test_string = 'game=soccer&game=baseball&weather=nice';
+  $ENV{REQUEST_METHOD}='POST';
+  $ENV{CONTENT_LENGTH}=length($test_string);
+  $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
+  if (open(CHILD,"|-")) {  # cparent
+    print CHILD $test_string;
+    close CHILD;
+    exit 0;
+  }
+  # at this point, we're in a new (child) process
+  test(31,$q=new CGI,"CGI::new() from POST");
+  test(32,$q->param('weather') eq 'nice',"CGI::param() from POST");
+  test(33,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
+} else {
+  print "ok 31 # Skip\n";
+  print "ok 32 # Skip\n";
+  print "ok 33 # Skip\n";
+}

diff --git a/lib/CGI/t/util.t b/lib/CGI/t/util.t
new file mode 100644 (file)
index 0000000..f0471cf
--- /dev/null
+++ b/lib/CGI/t/util.t
@@ -0,0 +1,56 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to escape() and unescape() punctuation characters
+# except for qw(- . _).
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..59\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Config;
+use CGI::Util qw(escape unescape);
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# ASCII order, ASCII codepoints, ASCII repertoire
+
+my %punct = (
+    ' ' => '20',  '!' => '21',  '"' => '22',  '#' =>  '23', 
+    '$' => '24',  '%' => '25',  '&' => '26',  '\'' => '27', 
+    '(' => '28',  ')' => '29',  '*' => '2A',  '+' =>  '2B', 
+    ',' => '2C',                              '/' =>  '2F',  # '-' => '2D',  '.' => '2E' 
+    ':' => '3A',  ';' => '3B',  '<' => '3C',  '=' =>  '3D', 
+    '>' => '3E',  '?' => '3F',  '[' => '5B',  '\\' => '5C', 
+    ']' => '5D',  '^' => '5E',                '`' =>  '60',  # '_' => '5F',
+    '{' => '7B',  '|' => '7C',  '}' => '7D',  '~' =>  '7E', 
+         );
+
+# The sort order may not be ASCII on EBCDIC machines:
+
+my $i = 1;
+
+foreach(sort(keys(%punct))) { 
+    $i++;
+    my $escape = "AbC\%$punct{$_}dEF";
+    my $cgi_escape = escape("AbC$_" . "dEF");
+    test($i, $escape eq $cgi_escape , "# $escape ne $cgi_escape");
+    $i++;
+    my $unescape = "AbC$_" . "dEF";
+    my $cgi_unescape = unescape("AbC\%$punct{$_}dEF");
+    test($i, $unescape eq $cgi_unescape , "# $unescape ne $cgi_unescape");
+}
+

diff --git a/lib/CPAN/t/loadme.t b/lib/CPAN/t/loadme.t
new file mode 100644 (file)
index 0000000..dce7e10
--- /dev/null
+++ b/lib/CPAN/t/loadme.t
@@ -0,0 +1,16 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+}
+
+BEGIN {
+    print "1..1\n";
+}
+use strict;
+use CPAN;
+use CPAN::FirstTime;
+
+print "ok 1\n";
+

diff --git a/lib/CPAN/t/vcmp.t b/lib/CPAN/t/vcmp.t
new file mode 100644 (file)
index 0000000..290fc3d
--- /dev/null
+++ b/lib/CPAN/t/vcmp.t
@@ -0,0 +1,62 @@
+# -*- Mode: cperl; coding: utf-8; -*-
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+}
+
+use strict;
+use CPAN;
+use vars qw($D $N);
+
+while (<DATA>) {
+  next if /^v/ && $]<5.006; # v-string tests are not for pre-5.6.0
+  chomp;
+  s/\s*#.*//;
+  push @$D, [ split ];
+}
+
+$N = scalar @$D;
+print "1..$N\n";
+
+while (@$D) {
+  my($l,$r,$exp) = @{shift @$D};
+  my $res = CPAN::Version->vcmp($l,$r);
+  if ($res != $exp){
+    print "# l[$l]r[$r]exp[$exp]res[$res]\n";
+    print "not ";
+  }
+  print "ok ", $N-@$D, "\n";
+}
+
+__END__
+0 0 0
+1 0 1
+0 1 -1
+1 1 0
+1.1 0.0a 1
+1.1a 0.0 1
+1.2.3 1.1.1 1
+v1.2.3 v1.1.1 1
+v1.2.3 v1.2.1 1
+v1.2.3 v1.2.11 -1
+1.2.3 1.2.11 1 # not what they wanted
+1.9 1.10 1
+VERSION VERSION 0
+0.02 undef 1
+1.57_00 1.57 1
+1.5700 1.57 1
+1.57_01 1.57 1
+0.2.10 0.2 1
+20000000.00 19990108 1
+1.00 0.96 1
+0.7.02 0.7 1
+1.3a5 1.3 1
+undef 1.00 -1
+v1.0 undef 1
+v0.2.4 0.24 -1
+v1.0.22 122 -1
+5.00556 v5.5.560 0
+5.005056 v5.5.56 0
+5.00557 v5.5.560 1
+5.00056 v5.0.561 -1

diff --git a/lib/Carp.t b/lib/Carp.t
new file mode 100644 (file)
index 0000000..a318c19
--- /dev/null
+++ b/lib/Carp.t
@@ -0,0 +1,53 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+}
+
+use Carp qw(carp cluck croak confess);
+
+print "1..7\n";
+
+print "ok 1\n";
+
+$SIG{__WARN__} = sub {
+    print "ok $1\n"
+       if $_[0] =~ m!ok (\d+)$! };
+
+carp  "ok 2\n";
+       
+$SIG{__WARN__} = sub {
+    print "ok $1\n"
+       if $_[0] =~ m!(\d+) at .+\b(?i:carp\.t) line \d+$! };
+
+carp 3;
+
+sub sub_4 {
+
+$SIG{__WARN__} = sub {
+    print "ok $1\n"
+       if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at .+\b(?i:carp\.t) line \d+$! };
+
+cluck 4;
+
+}
+
+sub_4;
+
+$SIG{__DIE__} = sub {
+    print "ok $1\n"
+       if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at .+\b(?i:carp\.t) line \d+$! };
+
+eval { croak 5 };
+
+sub sub_6 {
+    $SIG{__DIE__} = sub {
+       print "ok $1\n"
+           if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at .+\b(?i:carp\.t) line \d+\n\tmain::sub_6\(\) called at .+\b(?i:carp\.t) line \d+$! };
+
+    eval { confess 6 };
+}
+
+sub_6;
+
+print "ok 7\n";
+

diff --git a/lib/Class/ISA/test.pl b/lib/Class/ISA/test.pl
new file mode 100644 (file)
index 0000000..b09e2a9
--- /dev/null
+++ b/lib/Class/ISA/test.pl
@@ -0,0 +1,40 @@
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+}
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..2\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Class::ISA;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+  @Food::Fishstick::ISA = qw(Food::Fish  Life::Fungus  Chemicals);
+  @Food::Fish::ISA = qw(Food);
+  @Food::ISA = qw(Matter);
+  @Life::Fungus::ISA = qw(Life);
+  @Chemicals::ISA = qw(Matter);
+  @Life::ISA = qw(Matter);
+  @Matter::ISA = qw();
+
+  use Class::ISA;
+  my @path = Class::ISA::super_path('Food::Fishstick');
+  my $flat_path = join ' ', @path;
+  print "# Food::Fishstick path is:\n# $flat_path\n";
+  print "not " unless
+   "Food::Fish Food Matter Life::Fungus Life Chemicals" eq $flat_path;
+  print "ok 2\n";

diff --git a/lib/Class/Struct.t b/lib/Class/Struct.t
new file mode 100644 (file)
index 0000000..2dfaf85
--- /dev/null
+++ b/lib/Class/Struct.t
@@ -0,0 +1,76 @@
+#!./perl -w
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+}
+
+print "1..10\n";
+
+package aClass;
+
+sub new { bless {}, shift }
+
+sub meth { 42 }
+
+package MyObj;
+
+use Class::Struct;
+use Class::Struct 'struct'; # test out both forms
+
+use Class::Struct SomeClass => { SomeElem => '$' };
+
+struct( s => '$', a => '@', h => '%', c => 'aClass' );
+
+my $obj = MyObj->new;
+
+$obj->s('foo');
+
+print "not " unless $obj->s() eq 'foo';
+print "ok 1\n";
+
+my $arf = $obj->a;
+
+print "not " unless ref $arf eq 'ARRAY';
+print "ok 2\n";
+
+$obj->a(2, 'secundus');
+
+print "not " unless $obj->a(2) eq 'secundus';
+print "ok 3\n";
+
+my $hrf = $obj->h;
+
+print "not " unless ref $hrf eq 'HASH';
+print "ok 4\n";
+
+$obj->h('x', 10);
+
+print "not " unless $obj->h('x') == 10;
+print "ok 5\n";
+
+my $orf = $obj->c;
+
+print "not " unless ref $orf eq 'aClass';
+print "ok 6\n";
+
+print "not " unless $obj->c->meth() == 42;
+print "ok 7\n";
+
+my $obk = SomeClass->new();
+
+$obk->SomeElem(123);
+
+print "not " unless $obk->SomeElem() == 123;
+print "ok 8\n";
+
+$obj->a([4,5,6]);
+
+print "not " unless $obj->a(1) == 5;
+print "ok 9\n";
+
+$obj->h({h=>7,r=>8,f=>9});
+
+print "not " unless $obj->h('r') == 8;
+print "ok 10\n";
+

diff --git a/lib/Devel/SelfStubber.t b/lib/Devel/SelfStubber.t
new file mode 100644 (file)
index 0000000..2e74a02
--- /dev/null
+++ b/lib/Devel/SelfStubber.t
@@ -0,0 +1,285 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+use Devel::SelfStubber;
+
+my $runperl = "$^X \"-I../lib\"";
+
+# ensure correct output ordering for system() calls
+
+select STDERR; $| = 1; select STDOUT; $| = 1;
+
+print "1..12\n";
+
+my @cleanup;
+
+END {
+  foreach my $file (reverse @cleanup) {
+    unlink $file or warn "unlink $file failed: $!" while -f $file;
+    rmdir $file or warn "rmdir $file failed: $!" if -d $file;
+  }
+}
+
+my $inlib = "SSI-$$";
+mkdir $inlib, 0777 or die $!;
+push @cleanup, $inlib;
+
+while (<DATA>) {
+  if (/^\#{16,}\s+(.*)/) {
+    my $file = "$inlib/$1";
+    push @cleanup, $file;
+    open FH, ">$file" or die $!;
+  } else {
+    print FH;
+  }
+}
+close FH;
+
+{
+  my $file = "A-$$";
+  push @cleanup, $file;
+  open FH, ">$file" or die $!;
+  select FH;
+  Devel::SelfStubber->stub('Child', $inlib);
+  select STDOUT;
+  print "ok 1\n";
+  close FH or die $!;
+
+  open FH, $file or die $!;
+  my @A = <FH>;
+
+  if (@A == 1 && $A[0] =~ /^\s*sub\s+Child::foo\s*;\s*$/) {
+    print "ok 2\n";
+  } else {
+    print "not ok 2\n";
+    print "# $_" foreach (@A);
+  }
+}
+
+{
+  my $file = "B-$$";
+  push @cleanup, $file;
+  open FH, ">$file" or die $!;
+  select FH;
+  Devel::SelfStubber->stub('Proto', $inlib);
+  select STDOUT;
+  print "ok 3\n"; # Checking that we did not die horribly.
+  close FH or die $!;
+
+  open FH, $file or die $!;
+  my @B = <FH>;
+
+  if (@B == 1 && $B[0] =~ /^\s*sub\s+Proto::bar\s*\(\$\$\);\s*$/) {
+    print "ok 4\n";
+  } else {
+    print "not ok 4\n";
+    print "# $_" foreach (@B);
+  }
+
+  close FH or die $!;
+}
+
+{
+  my $file = "C-$$";
+  push @cleanup, $file;
+  open FH, ">$file" or die $!;
+  select FH;
+  Devel::SelfStubber->stub('Attribs', $inlib);
+  select STDOUT;
+  print "ok 5\n"; # Checking that we did not die horribly.
+  close FH or die $!;
+
+  open FH, $file or die $!;
+  my @C = <FH>;
+
+  if (@C == 2 && $C[0] =~ /^\s*sub\s+Attribs::baz\s+:\s*locked\s*;\s*$/
+      && $C[1] =~ /^\s*sub\s+Attribs::lv\s+:\s*lvalue\s*:\s*method\s*;\s*$/) {
+    print "ok 6\n";
+  } else {
+    print "not ok 6\n";
+    print "# $_" foreach (@C);
+  }
+
+  close FH or die $!;
+}
+
+# "wrong" and "right" may change if SelfLoader is changed.
+my %wrong = ( Parent => 'Parent', Child => 'Parent' );
+my %right = ( Parent => 'Parent', Child => 'Child' );
+if ($^O eq 'VMS') {
+    # extra line feeds for MBX IPC
+    %wrong = ( Parent => "Parent\n", Child => "Parent\n" );
+    %right = ( Parent => "Parent\n", Child => "Child\n" );
+}
+my @module = qw(Parent Child)
+;
+sub fail {
+  my ($left, $right) = @_;
+  while (my ($key, $val) = each %$left) {
+    # warn "$key $val $$right{$key}";
+    return 1
+      unless $val eq $$right{$key};
+  }
+  return;
+}
+
+sub faildump {
+  my ($expect, $got) = @_;
+  foreach (sort keys %$expect) {
+    print "# $_ expect '$$expect{$_}' got '$$got{$_}'\n";
+  }
+}
+
+# Now test that the module tree behaves "wrongly" as expected
+
+foreach my $module (@module) {
+  my $file = "$module--$$";
+  push @cleanup, $file;
+  open FH, ">$file" or die $!;
+  print FH "use $module;
+print ${module}->foo;
+";
+  close FH or die $!;
+}
+
+{
+  my %output;
+  foreach my $module (@module) {
+    print "# $runperl \"-I$inlib\" $module--$$\n";
+    ($output{$module} = `$runperl "-I$inlib" $module--$$`)
+      =~ s/\'s foo//;
+  }
+
+  if (&fail (\%wrong, \%output)) {
+    print "not ok 7\n", &faildump (\%wrong, \%output);
+  } else {
+    print "ok 7\n";
+  }
+}
+
+my $lib="SSO-$$";
+mkdir $lib, 0777 or die $!;
+push @cleanup, $lib;
+$Devel::SelfStubber::JUST_STUBS=0;
+
+undef $/;
+foreach my $module (@module, 'Data', 'End') {
+  my $file = "$lib/$module.pm";
+  open FH, "$inlib/$module.pm" or die $!;
+  my $contents = <FH>;
+  close FH or die $!;
+  push @cleanup, $file;
+  open FH, ">$file" or die $!;
+  select FH;
+  if ($contents =~ /__DATA__/) {
+    # This will die for any module with no  __DATA__
+    Devel::SelfStubber->stub($module, $inlib);
+  } else {
+    print $contents;
+  }
+  select STDOUT;
+  close FH or die $!;
+}
+print "ok 8\n";
+
+{
+  my %output;
+  foreach my $module (@module) {
+    print "# $runperl \"-I$lib\" $module--$$\n";
+    ($output{$module} = `$runperl "-I$lib" $module--$$`)
+      =~ s/\'s foo//;
+  }
+
+  if (&fail (\%right, \%output)) {
+    print "not ok 9\n", &faildump (\%right, \%output);
+  } else {
+    print "ok 9\n";
+  }
+}
+
+# Check that the DATA handle stays open
+system "$runperl -w \"-I$lib\" \"-MData\" -e \"Data::ok\"";
+
+# Possibly a pointless test as this doesn't really verify that it's been
+# stubbed.
+system "$runperl -w \"-I$lib\" \"-MEnd\" -e \"End::lime\"";
+
+# But check that the documentation after the __END__ survived.
+open FH, "$lib/End.pm" or die $!;
+$_ = <FH>;
+close FH or die $!;
+
+if (/Did the documentation here survive\?/) {
+  print "ok 12\n";
+} else {
+  print "not ok 12 # information after an __END__ token seems to be lost\n";
+}
+
+__DATA__
+################ Parent.pm
+package Parent;
+
+sub foo {
+  return __PACKAGE__;
+}
+1;
+__END__
+################ Child.pm
+package Child;
+require Parent;
+@ISA = 'Parent';
+use SelfLoader;
+
+1;
+__DATA__
+sub foo {
+  return __PACKAGE__;
+}
+__END__
+################ Proto.pm
+package Proto;
+use SelfLoader;
+
+1;
+__DATA__
+sub bar ($$) {
+}
+################ Attribs.pm
+package Attribs;
+use SelfLoader;
+
+1;
+__DATA__
+sub baz : locked {
+}
+sub lv : lvalue : method {
+  my $a;
+  \$a;
+}
+################ Data.pm
+package Data;
+use SelfLoader;
+
+1;
+__DATA__
+sub ok {
+  print <DATA>;
+}
+__END__ DATA
+ok 10
+################ End.pm
+package End;
+use SelfLoader;
+
+1;
+__DATA__
+sub lime {
+  print "ok 11\n";
+}
+__END__
+Did the documentation here survive?

diff --git a/lib/Digest.t b/lib/Digest.t
new file mode 100644 (file)
index 0000000..5741b77
--- /dev/null
+++ b/lib/Digest.t
@@ -0,0 +1,26 @@
+print "1..3\n";
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Digest;
+
+my $hexdigest = "900150983cd24fb0d6963f7d28e17f72";
+if (ord('A') == 193) { # EBCDIC
+    $hexdigest = "fe4ea0d98f9cd8d1d27f102a93cb0bb0"; # IBM-1047
+}
+
+print "not " unless Digest->MD5->add("abc")->hexdigest eq $hexdigest;
+print "ok 1\n";
+
+print "not " unless Digest->MD5->add("abc")->hexdigest eq $hexdigest;
+print "ok 2\n";
+
+eval {
+    print "not " unless Digest->new("HMAC-MD5" => "Jefe")->add("what do ya want for nothing?")->hexdigest eq "750c783e6ab0b503eaa86e310a5db738";
+    print "ok 3\n";
+};
+print "ok 3\n" if $@ && $@ =~ /^Can't locate/;
+

diff --git a/lib/DirHandle.t b/lib/DirHandle.t
new file mode 100755 (executable)
index 0000000..e83ea13
--- /dev/null
+++ b/lib/DirHandle.t
@@ -0,0 +1,34 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (not $Config{'d_readdir'}) {
+       print "1..0\n";
+       exit 0;
+    }
+}
+
+use DirHandle;
+
+print "1..5\n";
+
+$dot = new DirHandle ($^O eq 'MacOS' ? ':' : '.');
+
+print defined($dot) ? "ok" : "not ok", " 1\n";
+
+@a = sort <*>;
+do { $first = $dot->read } while defined($first) && $first =~ /^\./;
+print +(grep { $_ eq $first } @a) ? "ok" : "not ok", " 2\n";
+
+@b = sort($first, (grep {/^[^.]/} $dot->read));
+print +(join("\0", @a) eq join("\0", @b)) ? "ok" : "not ok", " 3\n";
+
+$dot->rewind;
+@c = sort grep {/^[^.]/} $dot->read;
+print +(join("\0", @b) eq join("\0", @c)) ? "ok" : "not ok", " 4\n";
+
+$dot->close;
+$dot->rewind;
+print defined($dot->read) ? "not ok" : "ok", " 5\n";

diff --git a/lib/English.t b/lib/English.t
new file mode 100755 (executable)
index 0000000..459dc3b
--- /dev/null
+++ b/lib/English.t
@@ -0,0 +1,65 @@
+#!./perl
+
+print "1..22\n";
+
+BEGIN { @INC = '../lib' }
+use English qw( -no_match_vars ) ;
+use Config;
+my $threads = $Config{'use5005threads'} || 0;
+
+print $PID == $$ ? "ok 1\n" : "not ok 1\n";
+
+$_ = 1;
+print $ARG == $_  || $threads ? "ok 2\n" : "not ok 2\n";
+
+sub foo {
+    print $ARG[0] == $_[0] || $threads ? "ok 3\n" : "not ok 3\n";
+}
+&foo(1);
+
+"abc" =~ /b/;
+
+print ! $PREMATCH  ? "" : "not ", "ok 4\n" ;
+print ! $MATCH     ? "" : "not ", "ok 5\n" ;
+print ! $POSTMATCH ? "" : "not ", "ok 6\n" ;
+
+$OFS = " ";
+$ORS = "\n";
+print 'ok',7;
+undef $OUTPUT_FIELD_SEPARATOR;
+
+if ($threads) { $" = "\n" } else { $LIST_SEPARATOR = "\n" };
+@foo = ("ok 8", "ok 9");
+print "@foo";
+undef $OUTPUT_RECORD_SEPARATOR;
+
+eval 'NO SUCH FUNCTION';
+print "ok 10\n" if $EVAL_ERROR =~ /method/ || $threads;
+
+print $UID == $< ? "ok 11\n" : "not ok 11\n";
+print $GID == $( ? "ok 12\n" : "not ok 12\n";
+print $EUID == $> ? "ok 13\n" : "not ok 13\n";
+print $EGID == $) ? "ok 14\n" : "not ok 14\n";
+
+print $PROGRAM_NAME eq $0 ? "ok 15\n" : "not ok 15\n";
+print $BASETIME == $^T ? "ok 16\n" : "not ok 16\n";
+
+package B ;
+
+use English ;
+
+"abc" =~ /b/;
+
+print $PREMATCH  ? "" : "not ", "ok 17\n" ;
+print $MATCH     ? "" : "not ", "ok 18\n" ;
+print $POSTMATCH ? "" : "not ", "ok 19\n" ;
+
+package C ;
+
+use English qw( -no_match_vars ) ;
+
+"abc" =~ /b/;
+
+print ! $PREMATCH  ? "" : "not ", "ok 20\n" ;
+print ! $MATCH     ? "" : "not ", "ok 21\n" ;
+print ! $POSTMATCH ? "" : "not ", "ok 22\n" ;

diff --git a/lib/Env/array.t b/lib/Env/array.t
new file mode 100755 (executable)
index 0000000..ff6af2e
--- /dev/null
+++ b/lib/Env/array.t
@@ -0,0 +1,25 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+       $ENV{FOO} = "foo";
+       $ENV{BAR} = "bar";
+}
+
+use Env qw(FOO $BAR);
+
+$FOO .= "/bar";
+$BAR .= "/baz";
+
+print "1..2\n";
+
+print "not " if $FOO ne 'foo/bar';
+print "ok 1\n";
+
+print "not " if $BAR ne 'bar/baz';
+print "ok 2\n";
+

diff --git a/lib/Env/env.t b/lib/Env/env.t
new file mode 100755 (executable)
index 0000000..c5068fd
--- /dev/null
+++ b/lib/Env/env.t
@@ -0,0 +1,100 @@
+#!./perl
+
+$| = 1;
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+if ($^O eq 'VMS') {
+    print "1..11\n";
+    foreach (1..11) { print "ok $_ # skipped for VMS\n"; }
+    exit 0;
+}
+
+use Env  qw(@FOO);
+use vars qw(@BAR);
+
+sub array_equal
+{
+    my ($a, $b) = @_;
+    return 0 unless scalar(@$a) == scalar(@$b);
+    for my $i (0..scalar(@$a) - 1) {
+       return 0 unless $a->[$i] eq $b->[$i];
+    }
+    return 1;
+}
+
+sub test
+{
+    my ($desc, $code) = @_;
+
+    &$code;
+
+    print "# $desc...\n";
+    print "#    FOO = (", join(", ", @FOO), ")\n";
+    print "#    BAR = (", join(", ", @BAR), ")\n";
+
+    if (defined $check) { print "not " unless &$check; }
+    else { print "not " unless array_equal(\@FOO, \@BAR); }
+
+    print "ok ", ++$i, "\n";
+}
+
+print "1..11\n";
+
+test "Assignment", sub {
+    @FOO = qw(a B c);
+    @BAR = qw(a B c);
+};
+
+test "Storing", sub {
+    $FOO[1] = 'b';
+    $BAR[1] = 'b';
+};
+
+test "Truncation", sub {
+    $#FOO = 0;
+    $#BAR = 0;
+};
+
+test "Push", sub {
+    push @FOO, 'b', 'c';
+    push @BAR, 'b', 'c';
+};
+
+test "Pop", sub {
+    pop @FOO;
+    pop @BAR;
+};
+
+test "Shift", sub {
+    shift @FOO;
+    shift @BAR;
+};
+
+test "Push", sub {
+    push @FOO, 'c';
+    push @BAR, 'c';
+};
+
+test "Unshift", sub {
+    unshift @FOO, 'a';
+    unshift @BAR, 'a';
+};
+
+test "Reverse", sub {
+    @FOO = reverse @FOO;
+    @BAR = reverse @BAR;
+};
+
+test "Sort", sub {
+    @FOO = sort @FOO;
+    @BAR = sort @BAR;
+};
+
+test "Splice", sub {
+    splice @FOO, 1, 1, 'B';
+    splice @BAR, 1, 1, 'B';
+};

diff --git a/lib/Exporter.t b/lib/Exporter.t
new file mode 100644 (file)
index 0000000..a0028fe
--- /dev/null
+++ b/lib/Exporter.t
@@ -0,0 +1,145 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Utility testing functions.
+my $test_num = 1;
+sub ok ($;$) {
+    my($test, $name) = @_;
+    print "not " unless $test;
+    print "ok $test_num";
+    print " - $name" if (defined $name && ! $^O eq 'VMS');
+    print "\n";
+    $test_num++;
+}
+
+
+my $loaded;
+BEGIN { $| = 1; $^W = 1; }
+END {print "not ok $test_num\n" unless $loaded;}
+print "1..$Total_tests\n";
+use Exporter;
+$loaded = 1;
+ok(1, 'compile');
+
+
+BEGIN {
+    # Methods which Exporter says it implements.
+    @Exporter_Methods = qw(import
+                           export_to_level
+                           require_version
+                           export_fail
+                          );
+}
+
+BEGIN { $Total_tests = 14 + @Exporter_Methods }
+
+package Testing;
+require Exporter;
+@ISA = qw(Exporter);
+
+# Make sure Testing can do everything its supposed to.
+foreach my $meth (@::Exporter_Methods) {
+    ::ok( Testing->can($meth), "subclass can $meth()" );
+}
+
+%EXPORT_TAGS = (
+                This => [qw(stuff %left)],
+                That => [qw(Above the @wailing)],
+                tray => [qw(Fasten $seatbelt)],
+               );
+@EXPORT    = qw(lifejacket);
+@EXPORT_OK = qw(under &your $seat);
+$VERSION = '1.05';
+
+::ok( Testing->require_version(1.05),   'require_version()' );
+eval { Testing->require_version(1.11); 1 };
+::ok( $@,                               'require_version() fail' );
+::ok( Testing->require_version(0),      'require_version(0)' );
+
+sub lifejacket  { 'lifejacket'  }
+sub stuff       { 'stuff'       }
+sub Above       { 'Above'       }
+sub the         { 'the'         }
+sub Fasten      { 'Fasten'      }
+sub your        { 'your'        }
+sub under       { 'under'       }
+use vars qw($seatbelt $seat @wailing %left);
+$seatbelt = 'seatbelt';
+$seat     = 'seat';
+@wailing = qw(AHHHHHH);
+%left = ( left => "right" );
+
+
+Exporter::export_ok_tags;
+
+my %tags     = map { $_ => 1 } map { @$_ } values %EXPORT_TAGS;
+my %exportok = map { $_ => 1 } @EXPORT_OK;
+my $ok = 1;
+foreach my $tag (keys %tags) {
+    $ok = exists $exportok{$tag};
+}
+::ok( $ok, 'export_ok_tags()' );
+
+
+package Foo;
+Testing->import;
+
+::ok( defined &lifejacket,      'simple import' );
+
+
+package Bar;
+my @imports = qw($seatbelt &Above stuff @wailing %left);
+Testing->import(@imports);
+
+::ok( (!grep { eval "!defined $_" } map({ /^\w/ ? "&$_" : $_ } @imports)),
+      'import by symbols' );
+
+
+package Yar;
+my @tags = qw(:This :tray);
+Testing->import(@tags);
+
+::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
+             map { @$_ } @{$Testing::EXPORT_TAGS{@tags}}),
+      'import by tags' );
+
+
+package Arrr;
+Testing->import(qw(!lifejacket));
+
+::ok( !defined &lifejacket,     'deny import by !' );
+
+
+package Mars;
+Testing->import('/e/');
+
+::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
+            grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
+      'import by regex');
+
+
+package Venus;
+Testing->import('!/e/');
+
+::ok( (!grep { eval "defined $_" } map { /^\w/ ? "&$_" : $_ }
+            grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
+      'deny import by regex');
+::ok( !defined &lifejacket, 'further denial' );
+
+
+package More::Testing;
+@ISA = qw(Exporter);
+$VERSION = 0;
+eval { More::Testing->require_version(0); 1 };
+::ok(!$@,       'require_version(0) and $VERSION = 0');
+
+
+package Yet::More::Testing;
+@ISA = qw(Exporter);
+$VERSION = 0;
+eval { Yet::More::Testing->require_version(10); 1 };
+::ok($@ !~ /\(undef\)/,       'require_version(10) and $VERSION = 0');

diff --git a/lib/ExtUtils.t b/lib/ExtUtils.t
new file mode 100644 (file)
index 0000000..50a9fe4
--- /dev/null
+++ b/lib/ExtUtils.t
@@ -0,0 +1,483 @@
+#!./perl -w
+
+print "1..27\n";
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use warnings;
+use strict;
+use ExtUtils::MakeMaker;
+use ExtUtils::Constant qw (constant_types C_constant XS_constant autoload);
+use Config;
+use File::Spec::Functions;
+use File::Spec;
+# Because were are going to be changing directory before running Makefile.PL
+my $perl = File::Spec->rel2abs( $^X );
+# ExtUtils::Constant::C_constant uses $^X inside a comment, and we want to
+# compare output to ensure that it is the same. We were probably run as ./perl
+# whereas we will run the child with the full path in $perl. So make $^X for
+# us the same as our child will see.
+$^X = $perl;
+
+print "# perl=$perl\n";
+my $runperl = "$perl -x \"-I../../lib\"";
+
+$| = 1;
+
+my $dir = "ext-$$";
+my @files;
+
+print "# $dir being created...\n";
+mkdir $dir, 0777 or die "mkdir: $!\n";
+
+
+END {
+    use File::Path;
+    print "# $dir being removed...\n";
+    rmtree($dir);
+}
+
+my $package = "ExtTest";
+
+# Test the code that generates 1 and 2 letter name comparisons.
+my %compass = (
+N => 0, NE => 45, E => 90, SE => 135, S => 180, SW => 225, W => 270, NW => 315
+);
+
+my $parent_rfc1149 =
+  'A Standard for the Transmission of IP Datagrams on Avian Carriers';
+
+my @names = ("FIVE", {name=>"OK6", type=>"PV",},
+             {name=>"OK7", type=>"PVN",
+              value=>['"not ok 7\\n\\0ok 7\\n"', 15]},
+             {name => "FARTHING", type=>"NV"},
+             {name => "NOT_ZERO", type=>"UV", value=>"~(UV)0"},
+             {name => "OPEN", type=>"PV", value=>'"/*"', macro=>1},
+             {name => "CLOSE", type=>"PV", value=>'"*/"',
+              macro=>["#if 1\n", "#endif\n"]},
+             {name => "ANSWER", default=>["UV", 42]}, "NOTDEF",
+             {name => "Yes", type=>"YES"},
+             {name => "No", type=>"NO"},
+             {name => "Undef", type=>"UNDEF"},
+# OK. It wasn't really designed to allow the creation of dual valued constants.
+# It was more for INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
+             {name=>"RFC1149", type=>"SV", value=>"sv_2mortal(temp_sv)",
+              pre=>"SV *temp_sv = newSVpv(RFC1149, 0); "
+                  . "(void) SvUPGRADE(temp_sv,SVt_PVIV); SvIOK_on(temp_sv); "
+                   . "SvIVX(temp_sv) = 1149;"},
+);
+
+push @names, $_ foreach keys %compass;
+
+my @names_only = map {(ref $_) ? $_->{name} : $_} @names;
+
+my $types = {};
+my $constant_types = constant_types(); # macro defs
+my $C_constant = join "\n",
+  C_constant ($package, undef, "IV", $types, undef, undef, @names);
+my $XS_constant = XS_constant ($package, $types); # XS for ExtTest::constant
+
+################ Header
+my $header = catfile($dir, "test.h");
+push @files, "test.h";
+open FH, ">$header" or die "open >$header: $!\n";
+print FH <<"EOT";
+#define FIVE 5
+#define OK6 "ok 6\\n"
+#define OK7 1
+#define FARTHING 0.25
+#define NOT_ZERO 1
+#define Yes 0
+#define No 1
+#define Undef 1
+#define RFC1149 "$parent_rfc1149"
+#undef NOTDEF
+
+EOT
+
+while (my ($point, $bearing) = each %compass) {
+  print FH "#define $point $bearing\n"
+}
+close FH or die "close $header: $!\n";
+
+################ XS
+my $xs = catfile($dir, "$package.xs");
+push @files, "$package.xs";
+open FH, ">$xs" or die "open >$xs: $!\n";
+
+print FH <<'EOT';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+EOT
+
+print FH "#include \"test.h\"\n\n";
+print FH $constant_types;
+print FH $C_constant, "\n";
+print FH "MODULE = $package            PACKAGE = $package\n";
+print FH "PROTOTYPES: ENABLE\n";
+print FH $XS_constant;
+close FH or die "close $xs: $!\n";
+
+################ PM
+my $pm = catfile($dir, "$package.pm");
+push @files, "$package.pm";
+open FH, ">$pm" or die "open >$pm: $!\n";
+print FH "package $package;\n";
+print FH "use $];\n";
+
+print FH <<'EOT';
+
+use strict;
+use warnings;
+use Carp;
+
+require Exporter;
+require DynaLoader;
+use vars qw ($VERSION @ISA @EXPORT_OK);
+
+$VERSION = '0.01';
+@ISA = qw(Exporter DynaLoader);
+@EXPORT_OK = qw(
+EOT
+
+print FH "\t$_\n" foreach (@names_only);
+print FH ");\n";
+print FH autoload ($package, $]);
+print FH "bootstrap $package \$VERSION;\n1;\n__END__\n";
+close FH or die "close $pm: $!\n";
+
+################ test.pl
+my $testpl = catfile($dir, "test.pl");
+push @files, "test.pl";
+open FH, ">$testpl" or die "open >$testpl: $!\n";
+
+print FH "use strict;\n";
+print FH "use $package qw(@names_only);\n";
+print FH <<'EOT';
+
+# IV
+my $five = FIVE;
+if ($five == 5) {
+  print "ok 5\n";
+} else {
+  print "not ok 5 # $five\n";
+}
+
+# PV
+print OK6;
+
+# PVN containing embedded \0s
+$_ = OK7;
+s/.*\0//s;
+print;
+
+# NV
+my $farthing = FARTHING;
+if ($farthing == 0.25) {
+  print "ok 8\n";
+} else {
+  print "not ok 8 # $farthing\n";
+}
+
+# UV
+my $not_zero = NOT_ZERO;
+if ($not_zero > 0 && $not_zero == ~0) {
+  print "ok 9\n";
+} else {
+  print "not ok 9 # \$not_zero=$not_zero ~0=" . (~0) . "\n";
+}
+
+# Value includes a "*/" in an attempt to bust out of a C comment.
+# Also tests custom cpp #if clauses
+my $close = CLOSE;
+if ($close eq '*/') {
+  print "ok 10\n";
+} else {
+  print "not ok 10 # \$close='$close'\n";
+}
+
+# Default values if macro not defined.
+my $answer = ANSWER;
+if ($answer == 42) {
+  print "ok 11\n";
+} else {
+  print "not ok 11 # What do you get if you multiply six by nine? '$answer'\n";
+}
+
+# not defined macro
+my $notdef = eval { NOTDEF; };
+if (defined $notdef) {
+  print "not ok 12 # \$notdef='$notdef'\n";
+} elsif ($@ !~ /Your vendor has not defined ExtTest macro NOTDEF/) {
+  print "not ok 12 # \$@='$@'\n";
+} else {
+  print "ok 12\n";
+}
+
+# not a macro
+my $notthere = eval { &ExtTest::NOTTHERE; };
+if (defined $notthere) {
+  print "not ok 13 # \$notthere='$notthere'\n";
+} elsif ($@ !~ /NOTTHERE is not a valid ExtTest macro/) {
+  chomp $@;
+  print "not ok 13 # \$@='$@'\n";
+} else {
+  print "ok 13\n";
+}
+
+# Truth
+my $yes = Yes;
+if ($yes) {
+  print "ok 14\n";
+} else {
+  print "not ok 14 # $yes='\$yes'\n";
+}
+
+# Falsehood
+my $no = No;
+if (defined $no and !$no) {
+  print "ok 15\n";
+} else {
+  print "not ok 15 # \$no=" . defined ($no) ? "'$no'\n" : "undef\n";
+}
+
+# Undef
+my $undef = Undef;
+unless (defined $undef) {
+  print "ok 16\n";
+} else {
+  print "not ok 16 # \$undef='$undef'\n";
+}
+
+
+# invalid macro (chosen to look like a mix up between No and SW)
+$notdef = eval { &ExtTest::So };
+if (defined $notdef) {
+  print "not ok 17 # \$notdef='$notdef'\n";
+} elsif ($@ !~ /^So is not a valid ExtTest macro/) {
+  print "not ok 17 # \$@='$@'\n";
+} else {
+  print "ok 17\n";
+}
+
+# invalid defined macro
+$notdef = eval { &ExtTest::EW };
+if (defined $notdef) {
+  print "not ok 18 # \$notdef='$notdef'\n";
+} elsif ($@ !~ /^EW is not a valid ExtTest macro/) {
+  print "not ok 18 # \$@='$@'\n";
+} else {
+  print "ok 18\n";
+}
+
+my %compass = (
+EOT
+
+while (my ($point, $bearing) = each %compass) {
+  print FH "$point => $bearing, "
+}
+
+print FH <<'EOT';
+
+);
+
+my $fail;
+while (my ($point, $bearing) = each %compass) {
+  my $val = eval $point;
+  if ($@) {
+    print "# $point: \$@='$@'\n";
+    $fail = 1;
+  } elsif (!defined $bearing) {
+    print "# $point: \$val=undef\n";
+    $fail = 1;
+  } elsif ($val != $bearing) {
+    print "# $point: \$val=$val, not $bearing\n";
+    $fail = 1;
+  }
+}
+if ($fail) {
+  print "not ok 19\n";
+} else {
+  print "ok 19\n";
+}
+
+EOT
+
+print FH <<"EOT";
+my \$rfc1149 = RFC1149;
+if (\$rfc1149 ne "$parent_rfc1149") {
+  print "not ok 20 # '\$rfc1149' ne '$parent_rfc1149'\n";
+} else {
+  print "ok 20\n";
+}
+
+if (\$rfc1149 != 1149) {
+  printf "not ok 21 # %d != 1149\n", \$rfc1149;
+} else {
+  print "ok 21\n";
+}
+
+EOT
+
+print FH <<'EOT';
+# test macro=>1
+my $open = OPEN;
+if ($open eq '/*') {
+  print "ok 22\n";
+} else {
+  print "not ok 22 # \$open='$open'\n";
+}
+EOT
+close FH or die "close $testpl: $!\n";
+
+################ Makefile.PL
+# We really need a Makefile.PL because make test for a no dynamic linking perl
+# will run Makefile.PL again as part of the "make perl" target.
+my $makefilePL = catfile($dir, "Makefile.PL");
+push @files, "Makefile.PL";
+open FH, ">$makefilePL" or die "open >$makefilePL: $!\n";
+print FH <<"EOT";
+#!$perl -w
+use ExtUtils::MakeMaker;
+WriteMakefile(
+              'NAME'           => "$package",
+              'VERSION_FROM'   => "$package.pm", # finds \$VERSION
+              (\$] >= 5.005 ?
+               (#ABSTRACT_FROM => "$package.pm", # XXX add this
+                AUTHOR     => "$0") : ())
+             );
+EOT
+
+close FH or die "close $makefilePL: $!\n";
+
+chdir $dir or die $!; push @INC,  '../../lib';
+END {chdir ".." or warn $!};
+
+my @perlout = `$runperl Makefile.PL`;
+if ($?) {
+  print "not ok 1 # $runperl Makefile.PL failed: $?\n";
+  print "# $_" foreach @perlout;
+  exit($?);
+} else {
+  print "ok 1\n";
+}
+
+
+my $makefile = ($^O eq 'VMS' ? 'descrip' : 'Makefile');
+my $makefile_ext = ($^O eq 'VMS' ? '.mms' : '');
+if (-f "$makefile$makefile_ext") {
+  print "ok 2\n";
+} else {
+  print "not ok 2\n";
+}
+my $makefile_rename = ($^O eq 'VMS' ? '.mms' : '.old');
+push @files, "$makefile$makefile_rename"; # Renamed by make clean
+
+my $make = $Config{make};
+
+$make = $ENV{MAKE} if exists $ENV{MAKE};
+
+my $makeout;
+
+print "# make = '$make'\n";
+$makeout = `$make`;
+if ($?) {
+  print "not ok 3 # $make failed: $?\n";
+  exit($?);
+} else {
+  print "ok 3\n";
+}
+
+if ($Config{usedl}) {
+  print "ok 4\n";
+} else {
+  push @files, "perl$Config{exe_ext}";
+  my $makeperl = "$make perl";
+  print "# make = '$makeperl'\n";
+  $makeout = `$makeperl`;
+  if ($?) {
+    print "not ok 4 # $makeperl failed: $?\n";
+    exit($?);
+  } else {
+    print "ok 4\n";
+  }
+}
+
+my $test = 23;
+my $maketest = "$make test";
+print "# make = '$maketest'\n";
+$makeout = `$maketest`;
+
+# echo of running the test script
+$makeout =~ s/^\s*PERL_DL_NONLAZY=.+?\n//m;
+$makeout =~ s/^MCR.+test.pl\n//mig if $^O eq 'VMS';
+
+# GNU make babblings
+$makeout =~ s/^\w*?make.+?(?:entering|leaving) directory.+?\n//mig;
+
+# Hopefully gets most make's babblings
+# make -f Makefile.aperl perl
+$makeout =~ s/^\w*?make.+\sperl[^A-Za-z0-9]*\n//mig;
+# make[1]: `perl' is up to date.
+$makeout =~ s/^\w*?make.+perl.+?is up to date.*?\n//mig;
+
+print $makeout;
+
+if ($?) {
+  print "not ok $test # $maketest failed: $?\n";
+} else {
+  print "ok $test\n";
+}
+$test++;
+
+my $regen = `$runperl $package.xs`;
+if ($?) {
+  print "not ok $test # $runperl $package.xs failed: $?\n";
+} else {
+  print "ok $test\n";
+}
+$test++;
+
+my $expect = $constant_types . $C_constant .
+  "\n#### XS Section:\n" . $XS_constant;
+
+if ($expect eq $regen) {
+  print "ok $test\n";
+} else {
+  print "not ok $test\n";
+  # open FOO, ">expect"; print FOO $expect;
+  # open FOO, ">regen"; print FOO $regen; close FOO;
+}
+$test++;
+
+my $makeclean = "$make clean";
+print "# make = '$makeclean'\n";
+$makeout = `$makeclean`;
+if ($?) {
+  print "not ok $test # $make failed: $?\n";
+} else {
+  print "ok $test\n";
+}
+$test++;
+
+foreach (@files) {
+  unlink $_ or warn "unlink $_: $!";
+}
+
+my $fail;
+opendir DIR, "." or die "opendir '.': $!";
+while (defined (my $entry = readdir DIR)) {
+  next if $entry =~ /^\.\.?$/;
+  print "# Extra file '$entry'\n";
+  $fail = 1;
+}
+closedir DIR or warn "closedir '.': $!";
+if ($fail) {
+  print "not ok $test\n";
+} else {
+  print "ok $test\n";
+}

diff --git a/lib/Fatal.t b/lib/Fatal.t
new file mode 100755 (executable)
index 0000000..f00b876
--- /dev/null
+++ b/lib/Fatal.t
@@ -0,0 +1,36 @@
+#!./perl -w
+
+BEGIN {
+   chdir 't' if -d 't';
+   @INC = '../lib';
+   print "1..15\n";
+}
+
+use strict;
+use Fatal qw(open close :void opendir);
+
+my $i = 1;
+eval { open FOO, '<lkjqweriuapofukndajsdlfjnvcvn' };
+print "not " unless $@ =~ /^Can't open/;
+print "ok $i\n"; ++$i;
+
+my $foo = 'FOO';
+for ('$foo', "'$foo'", "*$foo", "\\*$foo") {
+    eval qq{ open $_, '<$0' };
+    print "not " if $@;
+    print "ok $i\n"; ++$i;
+
+    print "not " if $@ or scalar(<$foo>) !~ m|^#!./perl|;
+    print "ok $i\n"; ++$i;
+    eval qq{ close FOO };
+    print "not " if $@;
+    print "ok $i\n"; ++$i;
+}
+
+eval { opendir FOO, 'lkjqweriuapofukndajsdlfjnvcvn' };
+print "not " unless $@ =~ /^Can't open/;
+print "ok $i\n"; ++$i;
+
+eval { my $a = opendir FOO, 'lkjqweriuapofukndajsdlfjnvcvn' };
+print "not " if $@ =~ /^Can't open/;
+print "ok $i\n"; ++$i;

diff --git a/lib/File/Basename.t b/lib/File/Basename.t
new file mode 100755 (executable)
index 0000000..9bee1bf
--- /dev/null
+++ b/lib/File/Basename.t
@@ -0,0 +1,144 @@
+#!./perl -T
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use File::Basename qw(fileparse basename dirname);
+
+print "1..41\n";
+
+# import correctly?
+print +(defined(&basename) && !defined(&fileparse_set_fstype) ?
+        '' : 'not '),"ok 1\n";
+
+# set fstype -- should replace non-null default
+print +(length(File::Basename::fileparse_set_fstype('unix')) ?
+        '' : 'not '),"ok 2\n";
+
+# Unix syntax tests
+($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7','\.book\d+');
+if ($base eq 'draft' and $path eq '/virgil/aeneid/' and $type eq '.book7') {
+  print "ok 3\n";
+}
+else {
+  print "not ok 3      |$base|$path|$type|\n";
+}
+print +(basename('/arma/virumque.cano') eq 'virumque.cano' ?
+        '' : 'not '),"ok 4\n";
+print +(dirname('/arma/virumque.cano') eq '/arma' ? '' : 'not '),"ok 5\n";
+print +(dirname('arma/') eq '.' ? '' : 'not '),"ok 6\n";
+print +(dirname('/') eq '/' ? '' : 'not '),"ok 7\n";
+
+
+# set fstype -- should replace non-null default
+print +(File::Basename::fileparse_set_fstype('VMS') eq 'unix' ?
+        '' : 'not '),"ok 8\n";
+
+# VMS syntax tests
+($base,$path,$type) = fileparse('virgil:[aeneid]draft.book7','\.book\d+');
+if ($base eq 'draft' and $path eq 'virgil:[aeneid]' and $type eq '.book7') {
+  print "ok 9\n";
+}
+else {
+  print "not ok 9      |$base|$path|$type|\n";
+}
+print +(basename('arma:[virumque]cano.trojae') eq 'cano.trojae' ?
+        '' : 'not '),"ok 10\n";
+print +(dirname('arma:[virumque]cano.trojae') eq 'arma:[virumque]' ?
+        '' : 'not '),"ok 11\n";
+print +(dirname('arma:<virumque>cano.trojae') eq 'arma:<virumque>' ?
+        '' : 'not '),"ok 12\n";
+print +(dirname('arma:virumque.cano') eq 'arma:' ? '' : 'not '),"ok 13\n";
+$ENV{DEFAULT} = '' unless exists $ENV{DEFAULT};
+print +(dirname('virumque.cano') eq $ENV{DEFAULT} ? '' : 'not '),"ok 14\n";
+print +(dirname('arma/') eq '.' ? '' : 'not '),"ok 15\n";
+
+# set fstype -- should replace non-null default
+print +(File::Basename::fileparse_set_fstype('MSDOS') eq 'VMS' ?
+        '' : 'not '),"ok 16\n";
+
+# MSDOS syntax tests
+($base,$path,$type) = fileparse('C:\\virgil\\aeneid\\draft.book7','\.book\d+');
+if ($base eq 'draft' and $path eq 'C:\\virgil\\aeneid\\' and $type eq '.book7') {
+  print "ok 17\n";
+}
+else {
+  print "not ok 17     |$base|$path|$type|\n";
+}
+print +(basename('A:virumque\\cano.trojae') eq 'cano.trojae' ?
+        '' : 'not '),"ok 18\n";
+print +(dirname('A:\\virumque\\cano.trojae') eq 'A:\\virumque' ?
+        '' : 'not '),"ok 19\n";
+print +(dirname('A:\\') eq 'A:\\' ? '' : 'not '),"ok 20\n";
+print +(dirname('arma\\') eq '.' ? '' : 'not '),"ok 21\n";
+
+# Yes "/" is a legal path separator under MSDOS
+basename("lib/File/Basename.pm") eq "Basename.pm" or print "not ";
+print "ok 22\n";
+
+
+
+# set fstype -- should replace non-null default
+print +(File::Basename::fileparse_set_fstype('MacOS') eq 'MSDOS' ?
+        '' : 'not '),"ok 23\n";
+
+# MacOS syntax tests
+($base,$path,$type) = fileparse('virgil:aeneid:draft.book7','\.book\d+');
+if ($base eq 'draft' and $path eq 'virgil:aeneid:' and $type eq '.book7') {
+  print "ok 24\n";
+}
+else {
+  print "not ok 24     |$base|$path|$type|\n";
+}
+print +(basename(':arma:virumque:cano.trojae') eq 'cano.trojae' ?
+        '' : 'not '),"ok 25\n";
+print +(dirname(':arma:virumque:cano.trojae') eq ':arma:virumque:' ?
+        '' : 'not '),"ok 26\n";
+print +(dirname(':arma:virumque:') eq ':arma:' ? '' : 'not '),"ok 27\n";
+print +(dirname(':arma:virumque') eq ':arma:' ? '' : 'not '),"ok 28\n";
+print +(dirname(':arma:') eq ':' ? '' : 'not '),"ok 29\n";
+print +(dirname(':arma') eq ':' ? '' : 'not '),"ok 30\n";
+print +(dirname('arma:') eq 'arma:' ? '' : 'not '),"ok 31\n";
+print +(dirname('arma') eq ':' ? '' : 'not '),"ok 32\n";
+print +(dirname(':') eq ':' ? '' : 'not '),"ok 33\n";
+
+
+# Check quoting of metacharacters in suffix arg by basename()
+print +(basename(':arma:virumque:cano.trojae','.trojae') eq 'cano' ?
+        '' : 'not '),"ok 34\n";
+print +(basename(':arma:virumque:cano_trojae','.trojae') eq 'cano_trojae' ?
+        '' : 'not '),"ok 35\n";
+
+# extra tests for a few specific bugs
+
+File::Basename::fileparse_set_fstype 'MSDOS';
+# perl5.003_18 gives C:/perl/.\
+print +((fileparse 'C:/perl/lib')[1] eq 'C:/perl/' ? '' : 'not '), "ok 36\n";
+# perl5.003_18 gives C:\perl\
+print +(dirname('C:\\perl\\lib\\') eq 'C:\\perl' ? '' : 'not '), "ok 37\n";
+
+File::Basename::fileparse_set_fstype 'UNIX';
+# perl5.003_18 gives '.'
+print +(dirname('/perl/') eq '/' ? '' : 'not '), "ok 38\n";
+# perl5.003_18 gives '/perl/lib'
+print +(dirname('/perl/lib//') eq '/perl' ? '' : 'not '), "ok 39\n";
+
+#   The empty tainted value, for tainting strings
+my $TAINT = substr($^X, 0, 0);
+# How to identify taint when you see it
+sub any_tainted (@) {
+    not eval { join("",@_), kill 0; 1 };
+}
+sub tainted ($) {
+    any_tainted @_;
+}
+sub all_tainted (@) {
+    for (@_) { return 0 unless tainted $_ }
+    1;
+}
+
+print +(tainted(dirname($TAINT.'/perl/lib//')) ? '' : 'not '), "ok 40\n";
+print +(all_tainted(fileparse($TAINT.'/dir/draft.book7','\.book\d+'))
+               ? '' : 'not '), "ok 41\n";

diff --git a/lib/File/CheckTree.t b/lib/File/CheckTree.t
new file mode 100755 (executable)
index 0000000..b445af4
--- /dev/null
+++ b/lib/File/CheckTree.t
@@ -0,0 +1,19 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use File::CheckTree;
+
+# We assume that we run from the perl "t" directory.
+
+validate q{
+    lib  -d || die
+    TEST -f || die
+};
+
+print "ok 1\n";

diff --git a/lib/File/Compare.t b/lib/File/Compare.t
new file mode 100644 (file)
index 0000000..aedc323
--- /dev/null
+++ b/lib/File/Compare.t
@@ -0,0 +1,114 @@
+#!./perl
+
+BEGIN {
+  chdir 't' if -d 't';
+  @INC = '../lib';
+}
+
+BEGIN {
+  our @TEST = stat "TEST";
+  our @README = stat "README";
+  unless (@TEST && @README) {
+    print "1..0 # Skip: no file TEST or README\n";
+    exit 0;
+  }
+}
+
+print "1..12\n";
+
+use File::Compare qw(compare compare_text);
+
+print "ok 1\n";
+
+# named files, same, existing but different, cause an error
+print "not " unless compare("README","README") == 0;
+print "ok 2\n";
+
+print "not " unless compare("TEST","README") == 1;
+print "ok 3\n";
+
+print "not " unless compare("README","HLAGHLAG") == -1;
+                               # a file which doesn't exist
+print "ok 4\n";
+
+# compare_text, the same file, different but existing files
+# cause error, test sub form.
+print "not " unless compare_text("README","README") == 0;
+print "ok 5\n";
+
+print "not " unless compare_text("TEST","README") == 1;
+print "ok 6\n";
+
+print "not " unless compare_text("TEST","HLAGHLAG") == -1;
+print "ok 7\n";
+
+print "not " unless
+  compare_text("README","README",sub {$_[0] ne $_[1]}) == 0;
+print "ok 8\n";
+
+# filehandle and same file
+{
+  my $fh;
+  open ($fh, "<README") or print "not ";
+  binmode($fh);
+  print "not " unless compare($fh,"README") == 0;
+  print "ok 9\n";
+  close $fh;
+}
+
+# filehandle and different (but existing) file.
+{
+  my $fh;
+  open ($fh, "<README") or print "not ";
+  binmode($fh);
+  print "not " unless compare_text($fh,"TEST") == 1;
+  print "ok 10\n";
+  close $fh;
+}
+
+# Different file with contents of known file,
+# will use File::Temp to do this, skip rest of
+# tests if this doesn't seem to work
+
+my @donetests;
+eval {
+  require File::Spec; import File::Spec;
+  require File::Path; import File::Path;
+  require File::Temp; import File::Temp qw/ :mktemp unlink0 /;
+
+  my $template = File::Spec->catfile(File::Spec->tmpdir, 'fcmpXXXX');
+  my($tfh,$filename) = mkstemp($template);
+  {
+    local $/; #slurp
+    my $fh;
+    open($fh,'README');
+    binmode($fh);
+    my $data = <$fh>;
+    print $tfh $data;
+    close($fh);
+  }
+  seek($tfh,0,0);
+  $donetests[0] = compare($tfh, 'README');
+  $donetests[1] = compare($filename, 'README');
+  unlink0($tfh,$filename);
+};
+print "# problems when testing with a tempory file\n" if $@;
+
+if (@donetests == 2) {
+  print "not " unless $donetests[0] == 0;
+  print "ok 11\n";
+  if ($^O eq 'VMS') {
+    # The open attempt on FROM in File::Compare::compare should fail
+    # on this OS since files are not shared by default.
+    print "not " unless $donetests[1] == -1;
+    print "ok 12\n";
+  }
+  else {
+    print "not " unless $donetests[1] == 0;
+    print "ok 12\n";
+  }
+}
+else {
+  print "ok 11# Skip\nok 12 # Skip Likely due to File::Temp\n";
+}
+

diff --git a/lib/File/Copy.t b/lib/File/Copy.t
new file mode 100755 (executable)
index 0000000..44b5827
--- /dev/null
+++ b/lib/File/Copy.t
@@ -0,0 +1,147 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    push @INC, "::lib:$MacPerl::Architecture" if $^O eq 'MacOS';
+}
+
+$| = 1;
+
+my @pass = (0,1);
+my $tests = $^O eq 'MacOS' ? 14 : 11;
+printf "1..%d\n", $tests * scalar(@pass);
+
+use File::Copy;
+
+for my $pass (@pass) {
+
+  my $loopconst = $pass*$tests;
+
+  # First we create a file
+  open(F, ">file-$$") or die;
+  binmode F; # for DOSISH platforms, because test 3 copies to stdout
+  printf F "ok %d\n", 3 + $loopconst;
+  close F;
+
+  copy "file-$$", "copy-$$";
+
+  open(F, "copy-$$") or die;
+  $foo = <F>;
+  close(F);
+
+  print "not " if -s "file-$$" != -s "copy-$$";
+  printf "ok %d\n", 1 + $loopconst;
+
+  print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+  printf "ok %d\n", 2+$loopconst;
+
+  binmode STDOUT unless $^O eq 'VMS'; # Copy::copy works in binary mode
+  copy "copy-$$", \*STDOUT;
+  unlink "copy-$$" or die "unlink: $!";
+
+  open(F,"file-$$");
+  copy(*F, "copy-$$");
+  open(R, "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R);
+  print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+  printf "ok %d\n", 4+$loopconst;
+  unlink "copy-$$" or die "unlink: $!";
+  open(F,"file-$$");
+  copy(\*F, "copy-$$");
+  close(F) or die "close: $!";
+  open(R, "copy-$$") or die; $foo = <R>; close(R) or die "close: $!";
+  print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+  printf "ok %d\n", 5+$loopconst;
+  unlink "copy-$$" or die "unlink: $!";
+
+  require IO::File;
+  $fh = IO::File->new(">copy-$$") or die "Cannot open copy-$$:$!";
+  binmode $fh or die;
+  copy("file-$$",$fh);
+  $fh->close or die "close: $!";
+  open(R, "copy-$$") or die; $foo = <R>; close(R);
+  print "# foo=`$foo'\nnot " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+  printf "ok %d\n", 6+$loopconst;
+  unlink "copy-$$" or die "unlink: $!";
+  require FileHandle;
+  my $fh = FileHandle->new(">copy-$$") or die "Cannot open copy-$$:$!";
+  binmode $fh or die;
+  copy("file-$$",$fh);
+  $fh->close;
+  open(R, "copy-$$") or die; $foo = <R>; close(R);
+  print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+  printf "ok %d\n", 7+$loopconst;
+  unlink "file-$$" or die "unlink: $!";
+
+  print "# moved missing file.\nnot " if move("file-$$", "copy-$$");
+  print "# target disappeared.\nnot " if not -e "copy-$$";
+  printf "ok %d\n", 8+$loopconst;
+
+  move "copy-$$", "file-$$" or print "# move did not succeed.\n";
+  print "# not moved: $!\nnot " unless -e "file-$$" and not -e "copy-$$";
+  open(R, "file-$$") or die; $foo = <R>; close(R);
+  print "# foo=`$foo'\nnot " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+  printf "ok %d\n", 9+$loopconst;
+
+  if ($^O eq 'MacOS') {
+       
+    copy "file-$$", "lib";     
+    open(R, ":lib:file-$$") or die; $foo = <R>; close(R);
+    print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+    printf "ok %d\n", 10+$loopconst;
+    unlink ":lib:file-$$" or die "unlink: $!";
+       
+    copy "file-$$", ":lib";    
+    open(R, ":lib:file-$$") or die; $foo = <R>; close(R);
+    print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+    printf "ok %d\n", 11+$loopconst;
+    unlink ":lib:file-$$" or die "unlink: $!";
+       
+    copy "file-$$", ":lib:";   
+    open(R, ":lib:file-$$") or die; $foo = <R>; close(R);
+    print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+    printf "ok %d\n", 12+$loopconst;
+    unlink ":lib:file-$$" or die "unlink: $!";
+       
+    unless (-e 'lib:') { # make sure there's no volume called 'lib'
+       undef $@;
+       eval { (copy "file-$$", "lib:") || die "'lib:' is not a volume name"; };
+       print "# Died: $@";
+       print "not " unless ( $@ =~ m|'lib:' is not a volume name| );
+    }
+    printf "ok %d\n", 13+$loopconst;
+
+    move "file-$$", ":lib:";
+    open(R, ":lib:file-$$") or die "open :lib:file-$$: $!"; $foo = <R>; close(R);
+    print "not " unless $foo eq sprintf("ok %d\n", 3+$loopconst)
+        and not -e "file-$$";;
+    printf "ok %d\n", 14+$loopconst;
+    unlink ":lib:file-$$" or die "unlink: $!";
+  
+  } else {
+    
+    copy "file-$$", "lib";
+    open(R, "lib/file-$$") or die; $foo = <R>; close(R);
+    print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+    printf "ok %d\n", 10+$loopconst;
+    unlink "lib/file-$$" or die "unlink: $!";
+
+    move "file-$$", "lib";
+    open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = <R>; close(R);
+    print "not " unless $foo eq sprintf("ok %d\n", 3+$loopconst)
+        and not -e "file-$$";;
+    printf "ok %d\n", 11+$loopconst;
+    unlink "lib/file-$$" or die "unlink: $!";
+  
+  }
+}
+
+
+END {
+    1 while unlink "file-$$";
+    if ($^O eq 'MacOS') {
+        1 while unlink ":lib:file-$$";
+    } else {
+        1 while unlink "lib/file-$$";
+    }
+}

diff --git a/lib/File/DosGlob.t b/lib/File/DosGlob.t
new file mode 100755 (executable)
index 0000000..31e36e2
--- /dev/null
+++ b/lib/File/DosGlob.t
@@ -0,0 +1,111 @@
+#!./perl
+
+#
+# test glob() in File::DosGlob
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..10\n";
+
+# override it in main::
+use File::DosGlob 'glob';
+
+# test if $_ takes as the default
+$_ = "op/a*.t";
+my @r = glob;
+print "not " if $_ ne 'op/a*.t';
+print "ok 1\n";
+print "# |@r|\nnot " if @r < 9;
+print "ok 2\n";
+
+# check if <*/*> works
+@r = <*/a*.t>;
+# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
+print "not " if @r < 9;
+print "ok 3\n";
+my $r = scalar @r;
+
+# check if scalar context works
+@r = ();
+while (defined($_ = <*/a*.t>)) {
+    print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 4\n";
+
+# check if list context works
+@r = ();
+for (<*/a*.t>) {
+    print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 5\n";
+
+# test if implicit assign to $_ in while() works
+@r = ();
+while (<*/a*.t>) {
+    print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 6\n";
+
+# test if explicit glob() gets assign magic too
+my @s = ();
+while (glob '*/a*.t') {
+    print "# $_\n";
+    push @s, $_;
+}
+print "not " if "@r" ne "@s";
+print "ok 7\n";
+
+# how about in a different package, like?
+package Foo;
+use File::DosGlob 'glob';
+@s = ();
+while (glob '*/a*.t') {
+    print "# $_\n";
+    push @s, $_;
+}
+print "not " if "@r" ne "@s";
+print "ok 8\n";
+
+# test if different glob ops maintain independent contexts
+@s = ();
+while (<*/a*.t>) {
+    my $i = 0;
+    print "# $_ <";
+    push @s, $_;
+    while (<*/b*.t>) {
+        print " $_";
+       $i++;
+    }
+    print " >\n";
+}
+print "not " if "@r" ne "@s";
+print "ok 9\n";
+
+# how about a global override, hm?
+eval <<'EOT';
+use File::DosGlob 'GLOBAL_glob';
+package Bar;
+@s = ();
+while (<*/a*.t>) {
+    my $i = 0;
+    print "# $_ <";
+    push @s, $_;
+    while (glob '*/b*.t') {
+        print " $_";
+       $i++;
+    }
+    print " >\n";
+}
+print "not " if "@r" ne "@s";
+print "ok 10\n";
+EOT

diff --git a/lib/File/Find/find.t b/lib/File/Find/find.t
new file mode 100755 (executable)
index 0000000..cf1b1f8
--- /dev/null
+++ b/lib/File/Find/find.t
@@ -0,0 +1,734 @@
+#!./perl
+
+
+my %Expect_File = (); # what we expect for $_ 
+my %Expect_Name = (); # what we expect for $File::Find::name/fullname
+my %Expect_Dir  = (); # what we expect for $File::Find::dir
+my $symlink_exists = eval { symlink("",""); 1 };
+my $warn_msg;
+
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC => '../lib';
+
+    $SIG{'__WARN__'} = sub { $warn_msg = $_[0]; warn "# $_[0]"; }
+}
+
+if ( $symlink_exists ) { print "1..188\n"; }
+else                   { print "1..78\n";  }
+
+use File::Find;
+use File::Spec;
+
+cleanup();
+
+find({wanted => sub { print "ok 1\n" if $_ eq 'commonsense.t'; } },
+   File::Spec->curdir);
+
+finddepth({wanted => sub { print "ok 2\n" if $_ eq 'commonsense.t'; } },
+       File::Spec->curdir);
+
+my $case = 2;
+my $FastFileTests_OK = 0;
+
+sub cleanup {
+    if (-d dir_path('for_find')) {
+        chdir(dir_path('for_find'));
+    }
+    if (-d dir_path('fa')) {
+        unlink file_path('fa', 'fa_ord'),
+               file_path('fa', 'fsl'),
+               file_path('fa', 'faa', 'faa_ord'),
+               file_path('fa', 'fab', 'fab_ord'),
+               file_path('fa', 'fab', 'faba', 'faba_ord'),
+               file_path('fb', 'fb_ord'),
+               file_path('fb', 'fba', 'fba_ord');
+        rmdir dir_path('fa', 'faa');
+        rmdir dir_path('fa', 'fab', 'faba');
+        rmdir dir_path('fa', 'fab');
+        rmdir dir_path('fa');
+        rmdir dir_path('fb', 'fba');
+        rmdir dir_path('fb');
+        chdir File::Spec->updir;
+        rmdir dir_path('for_find');
+    }
+}
+
+END {
+    cleanup();
+}
+
+sub Check($) {
+    $case++;
+    if ($_[0]) { print "ok $case\n"; }
+    else       { print "not ok $case\n"; }
+}
+
+sub CheckDie($) {
+    $case++;
+    if ($_[0]) { print "ok $case\n"; }
+    else { print "not ok $case\n $!\n"; exit 0; }
+}
+
+sub touch {
+    CheckDie( open(my $T,'>',$_[0]) );
+}
+
+sub MkDir($$) {
+    CheckDie( mkdir($_[0],$_[1]) );
+}
+
+sub wanted_File_Dir {
+    print "# \$File::Find::dir => '$File::Find::dir'\n";
+    print "# \$_ => '$_'\n";
+    s#\.$## if ($^O eq 'VMS' && $_ ne '.');
+    Check( $Expect_File{$_} );
+    if ( $FastFileTests_OK ) {
+        delete $Expect_File{ $_} 
+          unless ( $Expect_Dir{$_} && ! -d _ );
+    } else {
+        delete $Expect_File{$_} 
+          unless ( $Expect_Dir{$_} && ! -d $_ );
+    }
+}
+
+sub wanted_File_Dir_prune {
+    &wanted_File_Dir;
+    $File::Find::prune=1 if  $_ eq 'faba';
+}
+
+sub wanted_Name {
+    my $n = $File::Find::name;
+    $n =~ s#\.$## if ($^O eq 'VMS' && $n ne '.');
+    print "# \$File::Find::name => '$n'\n";
+    my $i = rindex($n,'/');
+    my $OK = exists($Expect_Name{$n});
+    unless ($^O eq 'MacOS') {
+        if ( $OK ) {
+            $OK= exists($Expect_Name{substr($n,0,$i)})  if $i >= 0;    
+        }
+    }
+    Check($OK);
+    delete $Expect_Name{$n};
+}
+
+sub wanted_File {
+    print "# \$_ => '$_'\n";
+    s#\.$## if ($^O eq 'VMS' && $_ ne '.');
+    my $i = rindex($_,'/');
+    my $OK = exists($Expect_File{ $_});
+    unless ($^O eq 'MacOS') {
+        if ( $OK ) {
+            $OK= exists($Expect_File{ substr($_,0,$i)})  if $i >= 0;
+        }
+    }
+    Check($OK);
+    delete $Expect_File{ $_};
+}
+
+sub simple_wanted {
+    print "# \$File::Find::dir => '$File::Find::dir'\n";
+    print "# \$_ => '$_'\n";
+}
+
+sub noop_wanted {}
+
+sub my_preprocess {
+    @files = @_;
+    print "# --preprocess--\n";
+    print "#   \$File::Find::dir => '$File::Find::dir' \n";
+    foreach $file (@files) {
+        print "#   $file \n";
+        delete $Expect_Dir{ $File::Find::dir }->{$file};
+    }
+    print "# --end preprocess--\n";
+    Check(scalar(keys %{$Expect_Dir{ $File::Find::dir }}) == 0);
+    if (scalar(keys %{$Expect_Dir{ $File::Find::dir }}) == 0) {
+        delete $Expect_Dir{ $File::Find::dir }
+    }
+    return @files;
+}
+
+sub my_postprocess {
+    print "# postprocess: \$File::Find::dir => '$File::Find::dir' \n";
+    delete $Expect_Dir{ $File::Find::dir};
+}
+
+
+# Use dir_path() to specify a directory path that's expected for
+# $File::Find::dir (%Expect_Dir). Also use it in file operations like
+# chdir, rmdir etc.
+#
+# dir_path() concatenates directory names to form a _relative_
+# directory path, independant from the platform it's run on, although
+# there are limitations.  Don't try to create an absolute path,
+# because that may fail on operating systems that have the concept of
+# volume names (e.g. Mac OS). Be careful when you want to create an
+# updir path like ../fa (Unix) or ::fa: (Mac OS). Plain directory
+# names will work best. As a special case, you can pass it a "." as
+# first argument, to create a directory path like "./fa/dir" on
+# operating systems other than Mac OS (actually, Mac OS will ignore
+# the ".", if it's the first argument). If there's no second argument,
+# this function will return the empty string on Mac OS and the string
+# "./" otherwise.
+
+sub dir_path {
+    my $first_item = shift @_;
+
+    if ($first_item eq '.') {
+        if ($^O eq 'MacOS') {
+            return '' unless @_;
+            # ignore first argument; return a relative path
+            # with leading ":" and with trailing ":"
+            return File::Spec->catdir("", @_); 
+        } else { # other OS
+            return './' unless @_;
+            my $path = File::Spec->catdir(@_);
+            # add leading "./"
+            $path = "./$path";
+            return $path;
+        }
+
+    } else { # $first_item ne '.'
+        return $first_item unless @_; # return plain filename
+        if ($^O eq 'MacOS') {
+            # relative path with leading ":" and with trailing ":"
+            return File::Spec->catdir("", $first_item, @_);
+        } else { # other OS
+            return File::Spec->catdir($first_item, @_);
+        }
+    }
+}
+
+
+# Use topdir() to specify a directory path that you want to pass to
+#find/finddepth Basically, topdir() does the same as dir_path() (see
+#above), except that there's no trailing ":" on Mac OS.
+
+sub topdir {
+    my $path = dir_path(@_);
+    $path =~ s/:$// if ($^O eq 'MacOS');
+    return $path;
+}
+
+
+# Use file_path() to specify a file path that's expected for $_
+# (%Expect_File).  Also suitable for file operations like unlink etc.
+#
+# file_path() concatenates directory names (if any) and a filename to
+# form a _relative_ file path (the last argument is assumed to be a
+# file). It's independant from the platform it's run on, although
+# there are limitations (see the warnings for dir_path() above). As a
+# special case, you can pass it a "." as first argument, to create a
+# file path like "./fa/file" on operating systems other than Mac OS
+# (actually, Mac OS will ignore the ".", if it's the first
+# argument). If there's no second argument, this function will return
+# the empty string on Mac OS and the string "./" otherwise.
+
+sub file_path {
+    my $first_item = shift @_;
+
+    if ($first_item eq '.') {
+        if ($^O eq 'MacOS') {
+            return '' unless @_;
+            # ignore first argument; return a relative path  
+            # with leading ":", but without trailing ":"
+            return File::Spec->catfile("", @_); 
+        } else { # other OS
+            return './' unless @_;
+            my $path = File::Spec->catfile(@_);
+            # add leading "./" 
+            $path = "./$path"; 
+            return $path;
+        }
+
+    } else { # $first_item ne '.'
+        return $first_item unless @_; # return plain filename
+        if ($^O eq 'MacOS') {
+            # relative path with leading ":", but without trailing ":"
+            return File::Spec->catfile("", $first_item, @_);
+        } else { # other OS
+            return File::Spec->catfile($first_item, @_);
+        }
+    }
+}
+
+
+# Use file_path_name() to specify a file path that's expected for
+# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1
+# option is in effect, $_ is the same as $File::Find::Name. In that
+# case, also use this function to specify a file path that's expected
+# for $_.
+#
+# Basically, file_path_name() does the same as file_path() (see
+# above), except that there's always a leading ":" on Mac OS, even for
+# plain file/directory names.
+
+sub file_path_name {
+    my $path = file_path(@_);
+    $path = ":$path" if (($^O eq 'MacOS') && ($path !~ /:/));
+    return $path;
+}
+
+
+
+MkDir( dir_path('for_find'), 0770 );
+CheckDie(chdir( dir_path('for_find')));
+MkDir( dir_path('fa'), 0770 );
+MkDir( dir_path('fb'), 0770  );
+touch( file_path('fb', 'fb_ord') );
+MkDir( dir_path('fb', 'fba'), 0770  );
+touch( file_path('fb', 'fba', 'fba_ord') );
+if ($^O eq 'MacOS') {
+      CheckDie( symlink(':fb',':fa:fsl') ) if $symlink_exists;
+} else {
+      CheckDie( symlink('../fb','fa/fsl') ) if $symlink_exists;
+}
+touch( file_path('fa', 'fa_ord') );
+
+MkDir( dir_path('fa', 'faa'), 0770  );
+touch( file_path('fa', 'faa', 'faa_ord') );
+MkDir( dir_path('fa', 'fab'), 0770  );
+touch( file_path('fa', 'fab', 'fab_ord') );
+MkDir( dir_path('fa', 'fab', 'faba'), 0770  );
+touch( file_path('fa', 'fab', 'faba', 'faba_ord') );
+
+
+%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1,
+                file_path('fa_ord') => 1, file_path('fab') => 1,
+                file_path('fab_ord') => 1, file_path('faba') => 1,
+                file_path('faa') => 1, file_path('faa_ord') => 1);
+
+delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
+%Expect_Name = ();
+
+%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
+                dir_path('fab') => 1, dir_path('faba') => 1,
+                dir_path('fb') => 1, dir_path('fba') => 1);
+
+delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
+File::Find::find( {wanted => \&wanted_File_Dir_prune}, topdir('fa') ); 
+Check( scalar(keys %Expect_File) == 0 );
+
+
+print "# check re-entrancy\n";
+
+%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1,
+                file_path('fa_ord') => 1, file_path('fab') => 1,
+                file_path('fab_ord') => 1, file_path('faba') => 1,
+                file_path('faa') => 1, file_path('faa_ord') => 1);
+
+delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
+%Expect_Name = ();
+
+%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
+                dir_path('fab') => 1, dir_path('faba') => 1,
+                dir_path('fb') => 1, dir_path('fba') => 1);
+
+delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
+
+File::Find::find( {wanted => sub { wanted_File_Dir_prune();
+                                    File::Find::find( {wanted => sub
+                                    {} }, File::Spec->curdir ); } },
+                                    topdir('fa') );
+
+Check( scalar(keys %Expect_File) == 0 ); 
+
+
+# no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File
+
+%Expect_File = (file_path_name('fa') => 1,
+               file_path_name('fa', 'fsl') => 1,
+                file_path_name('fa', 'fa_ord') => 1,
+                file_path_name('fa', 'fab') => 1,
+               file_path_name('fa', 'fab', 'fab_ord') => 1,
+               file_path_name('fa', 'fab', 'faba') => 1,
+               file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+               file_path_name('fa', 'faa') => 1,
+                file_path_name('fa', 'faa', 'faa_ord') => 1,);
+
+delete $Expect_File{ file_path_name('fa', 'fsl') } unless $symlink_exists;
+%Expect_Name = ();
+
+%Expect_Dir = (dir_path('fa') => 1,
+              dir_path('fa', 'faa') => 1,
+               dir_path('fa', 'fab') => 1,
+              dir_path('fa', 'fab', 'faba') => 1,
+              dir_path('fb') => 1,
+              dir_path('fb', 'fba') => 1);
+
+delete @Expect_Dir{ dir_path('fb'), dir_path('fb', 'fba') }
+    unless $symlink_exists;
+
+File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1},
+                 topdir('fa') ); Check( scalar(keys %Expect_File) == 0 );
+
+
+%Expect_File = ();
+
+%Expect_Name = (File::Spec->curdir => 1,
+               file_path_name('.', 'fa') => 1,
+                file_path_name('.', 'fa', 'fsl') => 1,
+                file_path_name('.', 'fa', 'fa_ord') => 1,
+                file_path_name('.', 'fa', 'fab') => 1,
+                file_path_name('.', 'fa', 'fab', 'fab_ord') => 1,
+                file_path_name('.', 'fa', 'fab', 'faba') => 1,
+                file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1,
+                file_path_name('.', 'fa', 'faa') => 1,
+                file_path_name('.', 'fa', 'faa', 'faa_ord') => 1,
+                file_path_name('.', 'fb') => 1,
+               file_path_name('.', 'fb', 'fba') => 1,
+               file_path_name('.', 'fb', 'fba', 'fba_ord') => 1,
+               file_path_name('.', 'fb', 'fb_ord') => 1);
+
+delete $Expect_Name{ file_path('.', 'fa', 'fsl') } unless $symlink_exists;
+%Expect_Dir = (); 
+File::Find::finddepth( {wanted => \&wanted_Name}, File::Spec->curdir );
+Check( scalar(keys %Expect_Name) == 0 );
+
+
+# no_chdir is in effect, hence we use file_path_name to specify the
+# expected paths for %Expect_File
+
+%Expect_File = (File::Spec->curdir => 1,
+               file_path_name('.', 'fa') => 1,
+                file_path_name('.', 'fa', 'fsl') => 1,
+                file_path_name('.', 'fa', 'fa_ord') => 1,
+                file_path_name('.', 'fa', 'fab') => 1,
+                file_path_name('.', 'fa', 'fab', 'fab_ord') => 1,
+                file_path_name('.', 'fa', 'fab', 'faba') => 1,
+                file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1,
+                file_path_name('.', 'fa', 'faa') => 1,
+                file_path_name('.', 'fa', 'faa', 'faa_ord') => 1,
+                file_path_name('.', 'fb') => 1,
+               file_path_name('.', 'fb', 'fba') => 1,
+               file_path_name('.', 'fb', 'fba', 'fba_ord') => 1,
+               file_path_name('.', 'fb', 'fb_ord') => 1);
+
+delete $Expect_File{ file_path_name('.', 'fa', 'fsl') } unless $symlink_exists;
+%Expect_Name = ();
+%Expect_Dir = (); 
+
+File::Find::finddepth( {wanted => \&wanted_File, no_chdir => 1},
+                    File::Spec->curdir );
+
+Check( scalar(keys %Expect_File) == 0 );
+
+
+print "# check preprocess\n";
+%Expect_File = ();
+%Expect_Name = ();
+%Expect_Dir = (
+          File::Spec->curdir                 => {fa => 1, fb => 1}, 
+          dir_path('.', 'fa')                => {faa => 1, fab => 1, fa_ord => 1},
+          dir_path('.', 'fa', 'faa')         => {faa_ord => 1},
+          dir_path('.', 'fa', 'fab')         => {faba => 1, fab_ord => 1},
+          dir_path('.', 'fa', 'fab', 'faba') => {faba_ord => 1},
+          dir_path('.', 'fb')                => {fba => 1, fb_ord => 1},
+          dir_path('.', 'fb', 'fba')         => {fba_ord => 1}
+          );
+
+File::Find::find( {wanted => \&noop_wanted,
+                  preprocess => \&my_preprocess}, File::Spec->curdir );
+
+Check( scalar(keys %Expect_Dir) == 0 );
+
+
+print "# check postprocess\n";
+%Expect_File = ();
+%Expect_Name = ();
+%Expect_Dir = (
+          File::Spec->curdir                 => 1,
+          dir_path('.', 'fa')                => 1,
+          dir_path('.', 'fa', 'faa')         => 1,
+          dir_path('.', 'fa', 'fab')         => 1,
+          dir_path('.', 'fa', 'fab', 'faba') => 1,
+          dir_path('.', 'fb')                => 1,
+          dir_path('.', 'fb', 'fba')         => 1
+          );
+
+File::Find::find( {wanted => \&noop_wanted,
+                  postprocess => \&my_postprocess}, File::Spec->curdir );
+
+Check( scalar(keys %Expect_Dir) == 0 );
+
+
+if ( $symlink_exists ) {
+    print "# --- symbolic link tests --- \n";
+    $FastFileTests_OK= 1;
+
+
+    # Verify that File::Find::find will call wanted even if the topdir of
+    # is a symlink to a directory, and it shouldn't follow the link
+    # unless follow is set, which it isn't in this case
+    %Expect_File = ( file_path('fsl') => 1 );
+    %Expect_Name = ();
+    %Expect_Dir = ();
+    File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa', 'fsl') );
+    Check( scalar(keys %Expect_File) == 0 );
+
+ 
+    %Expect_File = (File::Spec->curdir => 1, file_path('fa_ord') => 1,
+                    file_path('fsl') => 1, file_path('fb_ord') => 1,
+                    file_path('fba') => 1, file_path('fba_ord') => 1,
+                    file_path('fab') => 1, file_path('fab_ord') => 1,
+                    file_path('faba') => 1, file_path('faa') => 1,
+                    file_path('faa_ord') => 1);
+
+    %Expect_Name = ();
+
+    %Expect_Dir = (File::Spec->curdir => 1, dir_path('fa') => 1,
+                   dir_path('faa') => 1, dir_path('fab') => 1,
+                   dir_path('faba') => 1, dir_path('fb') => 1,
+                   dir_path('fba') => 1);
+
+    File::Find::find( {wanted => \&wanted_File_Dir_prune,
+                      follow_fast => 1}, topdir('fa') );
+
+    Check( scalar(keys %Expect_File) == 0 );  
+
+
+    # no_chdir is in effect, hence we use file_path_name to specify
+    # the expected paths for %Expect_File
+
+    %Expect_File = (file_path_name('fa') => 1,
+                   file_path_name('fa', 'fa_ord') => 1,
+                   file_path_name('fa', 'fsl') => 1,
+                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
+                    file_path_name('fa', 'fsl', 'fba') => 1,
+                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
+                    file_path_name('fa', 'fab') => 1,
+                    file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    file_path_name('fa', 'fab', 'faba') => 1,
+                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    file_path_name('fa', 'faa') => 1,
+                    file_path_name('fa', 'faa', 'faa_ord') => 1);
+
+    %Expect_Name = ();
+
+    %Expect_Dir = (dir_path('fa') => 1,
+                  dir_path('fa', 'faa') => 1,
+                   dir_path('fa', 'fab') => 1,
+                  dir_path('fa', 'fab', 'faba') => 1,
+                  dir_path('fb') => 1,
+                  dir_path('fb', 'fba') => 1);
+
+    File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1,
+                      no_chdir => 1}, topdir('fa') );
+
+    Check( scalar(keys %Expect_File) == 0 );
+
+    %Expect_File = ();
+
+    %Expect_Name = (file_path_name('fa') => 1,
+                   file_path_name('fa', 'fa_ord') => 1,
+                   file_path_name('fa', 'fsl') => 1,
+                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
+                    file_path_name('fa', 'fsl', 'fba') => 1,
+                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
+                    file_path_name('fa', 'fab') => 1,
+                    file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    file_path_name('fa', 'fab', 'faba') => 1,
+                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    file_path_name('fa', 'faa') => 1,
+                    file_path_name('fa', 'faa', 'faa_ord') => 1);
+
+    %Expect_Dir = ();
+
+    File::Find::finddepth( {wanted => \&wanted_Name,
+                           follow_fast => 1}, topdir('fa') );
+
+    Check( scalar(keys %Expect_Name) == 0 );
+
+    # no_chdir is in effect, hence we use file_path_name to specify
+    # the expected paths for %Expect_File
+
+    %Expect_File = (file_path_name('fa') => 1,
+                   file_path_name('fa', 'fa_ord') => 1,
+                   file_path_name('fa', 'fsl') => 1,
+                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
+                    file_path_name('fa', 'fsl', 'fba') => 1,
+                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
+                    file_path_name('fa', 'fab') => 1,
+                    file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    file_path_name('fa', 'fab', 'faba') => 1,
+                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    file_path_name('fa', 'faa') => 1,
+                    file_path_name('fa', 'faa', 'faa_ord') => 1);
+
+    %Expect_Name = ();
+    %Expect_Dir = ();
+
+    File::Find::finddepth( {wanted => \&wanted_File, follow_fast => 1,
+                           no_chdir => 1}, topdir('fa') );
+
+    Check( scalar(keys %Expect_File) == 0 );     
+
+ 
+    print "# check dangling symbolic links\n";
+    MkDir( dir_path('dangling_dir'), 0770 );
+    CheckDie( symlink( dir_path('dangling_dir'),
+                      file_path('dangling_dir_sl') ) );
+    rmdir dir_path('dangling_dir');
+    touch(file_path('dangling_file'));  
+    if ($^O eq 'MacOS') {
+        CheckDie( symlink('dangling_file', ':fa:dangling_file_sl') );
+    } else {
+        CheckDie( symlink('../dangling_file','fa/dangling_file_sl') );
+    }      
+    unlink file_path('dangling_file');
+
+    { 
+        # these tests should also emit a warning
+       use warnings;
+
+        %Expect_File = (File::Spec->curdir => 1,
+                       file_path('fa_ord') => 1,
+                        file_path('fsl') => 1,
+                        file_path('fb_ord') => 1,
+                       file_path('fba') => 1,
+                        file_path('fba_ord') => 1,
+                       file_path('fab') => 1,
+                        file_path('fab_ord') => 1,
+                        file_path('faba') => 1,
+                       file_path('faba_ord') => 1,
+                        file_path('faa') => 1,
+                        file_path('faa_ord') => 1);
+
+        %Expect_Name = ();
+        %Expect_Dir = ();
+        undef $warn_msg;
+
+        File::Find::find( {wanted => \&wanted_File, follow => 1,
+                          dangling_symlinks =>
+                              sub { $warn_msg = "$_[0] is a dangling symbolic link" }
+                           },
+                           topdir('dangling_dir_sl'), topdir('fa') );
+
+        Check( scalar(keys %Expect_File) == 0 );
+        Check( $warn_msg =~ m|dangling_dir_sl is a dangling symbolic link| );  
+        unlink file_path('fa', 'dangling_file_sl'),
+                         file_path('dangling_dir_sl');
+
+    }
+
+
+    print "# check recursion\n";
+    if ($^O eq 'MacOS') {
+        CheckDie( symlink(':fa:faa',':fa:faa:faa_sl') );
+    } else {
+        CheckDie( symlink('../faa','fa/faa/faa_sl') );
+    }
+    undef $@;
+    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
+                             no_chdir => 1}, topdir('fa') ); };
+    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]faa_sl is a recursive symbolic link| );  
+    unlink file_path('fa', 'faa', 'faa_sl'); 
+
+
+    print "# check follow_skip (file)\n";
+    if ($^O eq 'MacOS') {
+        CheckDie( symlink(':fa:fa_ord',':fa:fa_ord_sl') ); # symlink to a file
+    } else {
+        CheckDie( symlink('./fa_ord','fa/fa_ord_sl') ); # symlink to a file
+    }
+    undef $@;
+
+    eval {File::Find::finddepth( {wanted => \&simple_wanted,
+                                  follow => 1,
+                                  follow_skip => 0, no_chdir => 1},
+                                  topdir('fa') );};
+
+    Check( $@ =~ m|for_find[:/]fa[:/]fa_ord encountered a second time| );
+
+
+    # no_chdir is in effect, hence we use file_path_name to specify
+    # the expected paths for %Expect_File
+
+    %Expect_File = (file_path_name('fa') => 1,
+                   file_path_name('fa', 'fa_ord') => 1,
+                   file_path_name('fa', 'fsl') => 1,
+                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
+                    file_path_name('fa', 'fsl', 'fba') => 1,
+                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
+                    file_path_name('fa', 'fab') => 1,
+                    file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    file_path_name('fa', 'fab', 'faba') => 1,
+                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    file_path_name('fa', 'faa') => 1,
+                    file_path_name('fa', 'faa', 'faa_ord') => 1);
+
+    %Expect_Name = ();
+
+    %Expect_Dir = (dir_path('fa') => 1,
+                  dir_path('fa', 'faa') => 1,
+                   dir_path('fa', 'fab') => 1,
+                  dir_path('fa', 'fab', 'faba') => 1,
+                  dir_path('fb') => 1,
+                  dir_path('fb','fba') => 1);
+
+    File::Find::finddepth( {wanted => \&wanted_File_Dir, follow => 1,
+                           follow_skip => 1, no_chdir => 1},
+                           topdir('fa') );
+
+    Check( scalar(keys %Expect_File) == 0 );
+    unlink file_path('fa', 'fa_ord_sl');
+
+
+    print "# check follow_skip (directory)\n";
+    if ($^O eq 'MacOS') {
+        CheckDie( symlink(':fa:faa',':fa:faa_sl') ); # symlink to a directory
+    } else {
+        CheckDie( symlink('./faa','fa/faa_sl') ); # symlink to a directory
+    }
+    undef $@;
+
+    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
+                            follow_skip => 0, no_chdir => 1},
+                            topdir('fa') );};
+
+    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time| );
+
+  
+    undef $@;
+
+    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
+                            follow_skip => 1, no_chdir => 1},
+                            topdir('fa') );};
+
+    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time| );  
+
+    # no_chdir is in effect, hence we use file_path_name to specify
+    # the expected paths for %Expect_File
+
+    %Expect_File = (file_path_name('fa') => 1,
+                   file_path_name('fa', 'fa_ord') => 1,
+                   file_path_name('fa', 'fsl') => 1,
+                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
+                    file_path_name('fa', 'fsl', 'fba') => 1,
+                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
+                    file_path_name('fa', 'fab') => 1,
+                    file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    file_path_name('fa', 'fab', 'faba') => 1,
+                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    file_path_name('fa', 'faa') => 1,
+                    file_path_name('fa', 'faa', 'faa_ord') => 1);
+
+    %Expect_Name = ();
+
+    %Expect_Dir = (dir_path('fa') => 1,
+                  dir_path('fa', 'faa') => 1,
+                   dir_path('fa', 'fab') => 1,
+                  dir_path('fa', 'fab', 'faba') => 1,
+                  dir_path('fb') => 1,
+                  dir_path('fb', 'fba') => 1);
+
+    File::Find::find( {wanted => \&wanted_File_Dir, follow => 1,
+                      follow_skip => 2, no_chdir => 1}, topdir('fa') );
+
+    Check( scalar(keys %Expect_File) == 0 );
+    unlink file_path('fa', 'faa_sl');
+
+} 
+

diff --git a/lib/File/Find/taint.t b/lib/File/Find/taint.t
new file mode 100644 (file)
index 0000000..5ee1c3d
--- /dev/null
+++ b/lib/File/Find/taint.t
@@ -0,0 +1,388 @@
+#!./perl -T
+
+
+my %Expect_File = (); # what we expect for $_ 
+my %Expect_Name = (); # what we expect for $File::Find::name/fullname
+my %Expect_Dir  = (); # what we expect for $File::Find::dir
+my $symlink_exists = eval { symlink("",""); 1 };
+my $cwd;
+my $cwd_untainted;
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC => '../lib';
+
+    for (keys %ENV) { # untaint ENV
+    ($ENV{$_}) = $ENV{$_} =~ /(.*)/;
+    }
+}
+
+if ( $symlink_exists ) { print "1..45\n"; }
+else                   { print "1..27\n";  }
+
+use File::Find;
+use File::Spec;
+use Cwd;
+
+# Remove insecure directories from PATH
+my @path;
+my $sep = ($^O eq 'MSWin32') ? ';' : ':';
+foreach my $dir (split(/$sep/,$ENV{'PATH'}))
+ {
+  push(@path,$dir) unless -w $dir;
+ }
+$ENV{'PATH'} = join($sep,@path);
+
+cleanup();
+
+find({wanted => sub { print "ok 1\n" if $_ eq 'commonsense.t'; },
+      untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir);
+
+finddepth({wanted => sub { print "ok 2\n" if $_ eq 'commonsense.t'; },
+           untaint => 1, untaint_pattern => qr|^(.+)$|},
+           File::Spec->curdir);
+
+my $case = 2;
+my $FastFileTests_OK = 0;
+
+sub cleanup {
+    if (-d dir_path('for_find')) {
+        chdir(dir_path('for_find'));
+    }
+    if (-d dir_path('fa')) {
+        unlink file_path('fa', 'fa_ord'),
+               file_path('fa', 'fsl'),
+               file_path('fa', 'faa', 'faa_ord'),
+               file_path('fa', 'fab', 'fab_ord'),
+               file_path('fa', 'fab', 'faba', 'faba_ord'),
+               file_path('fb', 'fb_ord'),
+               file_path('fb', 'fba', 'fba_ord');
+        rmdir dir_path('fa', 'faa');
+        rmdir dir_path('fa', 'fab', 'faba');
+        rmdir dir_path('fa', 'fab');
+        rmdir dir_path('fa');
+        rmdir dir_path('fb', 'fba');
+        rmdir dir_path('fb');
+        chdir File::Spec->updir;
+        rmdir dir_path('for_find');
+    }
+}
+
+END {
+    cleanup();
+}
+
+sub Check($) {
+    $case++;
+    if ($_[0]) { print "ok $case\n"; }
+    else       { print "not ok $case\n"; }
+}
+
+sub CheckDie($) {
+    $case++;
+    if ($_[0]) { print "ok $case\n"; }
+    else { print "not ok $case\n $!\n"; exit 0; }
+}
+
+sub touch {
+    CheckDie( open(my $T,'>',$_[0]) );
+}
+
+sub MkDir($$) {
+    CheckDie( mkdir($_[0],$_[1]) );
+}
+
+sub wanted_File_Dir {
+    print "# \$File::Find::dir => '$File::Find::dir'\n";
+    print "# \$_ => '$_'\n";
+    s#\.$## if ($^O eq 'VMS' && $_ ne '.');
+    Check( $Expect_File{$_} );
+    if ( $FastFileTests_OK ) {
+        delete $Expect_File{ $_} 
+          unless ( $Expect_Dir{$_} && ! -d _ );
+    } else {
+        delete $Expect_File{$_} 
+          unless ( $Expect_Dir{$_} && ! -d $_ );
+    }
+}
+
+sub wanted_File_Dir_prune {
+    &wanted_File_Dir;
+    $File::Find::prune=1 if  $_ eq 'faba';
+}
+
+
+sub simple_wanted {
+    print "# \$File::Find::dir => '$File::Find::dir'\n";
+    print "# \$_ => '$_'\n";
+}
+
+
+# Use dir_path() to specify a directory path that's expected for
+# $File::Find::dir (%Expect_Dir). Also use it in file operations like
+# chdir, rmdir etc.
+#
+# dir_path() concatenates directory names to form a _relative_
+# directory path, independant from the platform it's run on, although
+# there are limitations.  Don't try to create an absolute path,
+# because that may fail on operating systems that have the concept of
+# volume names (e.g. Mac OS). Be careful when you want to create an
+# updir path like ../fa (Unix) or ::fa: (Mac OS). Plain directory
+# names will work best. As a special case, you can pass it a "." as
+# first argument, to create a directory path like "./fa/dir" on
+# operating systems other than Mac OS (actually, Mac OS will ignore
+# the ".", if it's the first argument). If there's no second argument,
+# this function will return the empty string on Mac OS and the string
+# "./" otherwise.
+
+sub dir_path {
+    my $first_item = shift @_;
+
+    if ($first_item eq '.') {
+        if ($^O eq 'MacOS') {
+            return '' unless @_;
+            # ignore first argument; return a relative path
+            # with leading ":" and with trailing ":"
+            return File::Spec->catdir("", @_); 
+        } else { # other OS
+            return './' unless @_;
+            my $path = File::Spec->catdir(@_);
+            # add leading "./"
+            $path = "./$path";
+            return $path;
+        }
+
+    } else { # $first_item ne '.'
+        return $first_item unless @_; # return plain filename
+        if ($^O eq 'MacOS') {
+            # relative path with leading ":" and with trailing ":"
+            return File::Spec->catdir("", $first_item, @_);
+        } else { # other OS
+            return File::Spec->catdir($first_item, @_);
+        }
+    }
+}
+
+
+# Use topdir() to specify a directory path that you want to pass to
+#find/finddepth Basically, topdir() does the same as dir_path() (see
+#above), except that there's no trailing ":" on Mac OS.
+
+sub topdir {
+    my $path = dir_path(@_);
+    $path =~ s/:$// if ($^O eq 'MacOS');
+    return $path;
+}
+
+
+# Use file_path() to specify a file path that's expected for $_ (%Expect_File).
+# Also suitable for file operations like unlink etc.
+
+# file_path() concatenates directory names (if any) and a filename to
+# form a _relative_ file path (the last argument is assumed to be a
+# file). It's independant from the platform it's run on, although
+# there are limitations (see the warnings for dir_path() above). As a
+# special case, you can pass it a "." as first argument, to create a
+# file path like "./fa/file" on operating systems other than Mac OS
+# (actually, Mac OS will ignore the ".", if it's the first
+# argument). If there's no second argument, this function will return
+# the empty string on Mac OS and the string "./" otherwise.
+
+sub file_path {
+    my $first_item = shift @_;
+
+    if ($first_item eq '.') {
+        if ($^O eq 'MacOS') {
+            return '' unless @_;
+            # ignore first argument; return a relative path  
+            # with leading ":", but without trailing ":"
+            return File::Spec->catfile("", @_); 
+        } else { # other OS
+            return './' unless @_;
+            my $path = File::Spec->catfile(@_);
+            # add leading "./" 
+            $path = "./$path"; 
+            return $path;
+        }
+
+    } else { # $first_item ne '.'
+        return $first_item unless @_; # return plain filename
+        if ($^O eq 'MacOS') {
+            # relative path with leading ":", but without trailing ":"
+            return File::Spec->catfile("", $first_item, @_);
+        } else { # other OS
+            return File::Spec->catfile($first_item, @_);
+        }
+    }
+}
+
+
+# Use file_path_name() to specify a file path that's expected for
+# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1
+# option is in effect, $_ is the same as $File::Find::Name. In that
+# case, also use this function to specify a file path that's expected
+# for $_.
+#
+# Basically, file_path_name() does the same as file_path() (see
+# above), except that there's always a leading ":" on Mac OS, even for
+# plain file/directory names.
+
+sub file_path_name {
+    my $path = file_path(@_);
+    $path = ":$path" if (($^O eq 'MacOS') && ($path !~ /:/));
+    return $path;
+}
+
+
+
+MkDir( dir_path('for_find'), 0770 );
+CheckDie(chdir( dir_path('for_find')));
+
+$cwd = cwd(); # save cwd
+( $cwd_untainted ) = $cwd =~ m|^(.+)$|; # untaint it
+
+MkDir( dir_path('fa'), 0770 );
+MkDir( dir_path('fb'), 0770  );
+touch( file_path('fb', 'fb_ord') );
+MkDir( dir_path('fb', 'fba'), 0770  );
+touch( file_path('fb', 'fba', 'fba_ord') );
+if ($^O eq 'MacOS') {
+      CheckDie( symlink(':fb',':fa:fsl') ) if $symlink_exists;
+} else {
+      CheckDie( symlink('../fb','fa/fsl') ) if $symlink_exists;
+}
+touch( file_path('fa', 'fa_ord') );
+
+MkDir( dir_path('fa', 'faa'), 0770  );
+touch( file_path('fa', 'faa', 'faa_ord') );
+MkDir( dir_path('fa', 'fab'), 0770  );
+touch( file_path('fa', 'fab', 'fab_ord') );
+MkDir( dir_path('fa', 'fab', 'faba'), 0770  );
+touch( file_path('fa', 'fab', 'faba', 'faba_ord') );
+
+print "# check untainting (no follow)\n";
+
+# untainting here should work correctly
+
+%Expect_File = (File::Spec->curdir => 1, file_path('fsl') =>
+                1,file_path('fa_ord') => 1, file_path('fab') => 1,
+                file_path('fab_ord') => 1, file_path('faba') => 1,
+                file_path('faa') => 1, file_path('faa_ord') => 1);
+delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
+%Expect_Name = ();
+
+%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
+                dir_path('fab') => 1, dir_path('faba') => 1,
+                dir_path('fb') => 1, dir_path('fba') => 1);
+
+delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
+
+File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1,
+                  untaint_pattern => qr|^(.+)$|}, topdir('fa') );
+
+Check( scalar(keys %Expect_File) == 0 );
+
+
+# don't untaint at all, should die
+%Expect_File = ();
+%Expect_Name = ();
+%Expect_Dir  = ();
+undef $@;
+eval {File::Find::find( {wanted => \&simple_wanted}, topdir('fa') );};
+Check( $@ =~ m|Insecure dependency| );
+chdir($cwd_untainted);
+
+
+# untaint pattern doesn't match, should die 
+undef $@;
+
+eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
+                         untaint_pattern => qr|^(NO_MATCH)$|},
+                         topdir('fa') );};
+
+Check( $@ =~ m|is still tainted| );
+chdir($cwd_untainted);
+
+
+# untaint pattern doesn't match, should die when we chdir to cwd   
+print "# check untaint_skip (no follow)\n";
+undef $@;
+
+eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
+                         untaint_skip => 1, untaint_pattern =>
+                         qr|^(NO_MATCH)$|}, topdir('fa') );};
+
+Check( $@ =~ m|insecure cwd| );
+chdir($cwd_untainted);
+
+
+if ( $symlink_exists ) {
+    print "# --- symbolic link tests --- \n";
+    $FastFileTests_OK= 1;
+
+    print "# check untainting (follow)\n";
+
+    # untainting here should work correctly
+    # no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File
+
+    %Expect_File = (file_path_name('fa') => 1,
+                   file_path_name('fa','fa_ord') => 1,
+                   file_path_name('fa', 'fsl') => 1,
+                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
+                    file_path_name('fa', 'fsl', 'fba') => 1,
+                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
+                    file_path_name('fa', 'fab') => 1,
+                    file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    file_path_name('fa', 'fab', 'faba') => 1,
+                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    file_path_name('fa', 'faa') => 1,
+                    file_path_name('fa', 'faa', 'faa_ord') => 1);
+
+    %Expect_Name = ();
+
+    %Expect_Dir = (dir_path('fa') => 1,
+                  dir_path('fa', 'faa') => 1,
+                   dir_path('fa', 'fab') => 1,
+                  dir_path('fa', 'fab', 'faba') => 1,
+                  dir_path('fb') => 1,
+                  dir_path('fb', 'fba') => 1);
+
+    File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1,
+                       no_chdir => 1, untaint => 1, untaint_pattern =>
+                       qr|^(.+)$| }, topdir('fa') );
+
+    Check( scalar(keys %Expect_File) == 0 );
+ 
+    
+    # don't untaint at all, should die
+    undef $@;
+
+    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1},
+                           topdir('fa') );};
+
+    Check( $@ =~ m|Insecure dependency| );
+    chdir($cwd_untainted);
+
+    # untaint pattern doesn't match, should die
+    undef $@;
+
+    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
+                             untaint => 1, untaint_pattern =>
+                             qr|^(NO_MATCH)$|}, topdir('fa') );};
+
+    Check( $@ =~ m|is still tainted| );
+    chdir($cwd_untainted);
+
+    # untaint pattern doesn't match, should die when we chdir to cwd
+    print "# check untaint_skip (follow)\n";
+    undef $@;
+
+    eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
+                             untaint_skip => 1, untaint_pattern =>
+                             qr|^(NO_MATCH)$|}, topdir('fa') );};
+
+    Check( $@ =~ m|insecure cwd| );
+    chdir($cwd_untainted);
+
+} 
+

diff --git a/lib/File/Glob/basic.t b/lib/File/Glob/basic.t
new file mode 100755 (executable)
index 0000000..ef9dd96
--- /dev/null
+++ b/lib/File/Glob/basic.t
@@ -0,0 +1,175 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') { 
+       @INC = qw(: ::lib ::macos:lib); 
+    } else { 
+       @INC = '.'; 
+       push @INC, '../lib'; 
+    }
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+    print "1..11\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+use File::Glob ':glob';
+use Cwd ();
+$loaded = 1;
+print "ok 1\n";
+
+sub array {
+    return '(', join(", ", map {defined $_ ? "\"$_\"" : "undef"} @a), ")\n";
+}
+
+# look for the contents of the current directory
+$ENV{PATH} = "/bin";
+delete @ENV{BASH_ENV, CDPATH, ENV, IFS};
+@correct = ();
+if (opendir(D, $^O eq "MacOS" ? ":" : ".")) {
+   @correct = grep { !/^\./ } sort readdir(D);
+   closedir D;
+}
+@a = File::Glob::glob("*", 0);
+@a = sort @a;
+if ("@a" ne "@correct" || GLOB_ERROR) {
+    print "# |@a| ne |@correct|\nnot ";
+}
+print "ok 2\n";
+
+# look up the user's home directory
+# should return a list with one item, and not set ERROR
+if ($^O ne 'MSWin32' && $^O ne 'NetWare' && $^O ne 'VMS') {
+  eval {
+    ($name, $home) = (getpwuid($>))[0,7];
+    1;
+  } and do {
+    @a = bsd_glob("~$name", GLOB_TILDE);
+    if (scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR) {
+       print "not ";
+    }
+  };
+}
+print "ok 3\n";
+
+# check backslashing
+# should return a list with one item, and not set ERROR
+@a = bsd_glob('TEST', GLOB_QUOTE);
+if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) {
+    local $/ = "][";
+    print "# [@a]\n";
+    print "not ";
+}
+print "ok 4\n";
+
+# check nonexistent checks
+# should return an empty list
+# XXX since errfunc is NULL on win32, this test is not valid there
+@a = bsd_glob("asdfasdf", 0);
+if (($^O ne 'MSWin32' && $^O ne 'NetWare') and scalar @a != 0) {
+    print "# |@a|\nnot ";
+}
+print "ok 5\n";
+
+# check bad protections
+# should return an empty list, and set ERROR
+if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'os2' or $^O eq 'VMS'
+    or $^O eq 'cygwin' or Cwd::cwd() =~ m#^$Config{'afsroot'}#s or not $>)
+{
+    print "ok 6 # skipped\n";
+}
+else {
+    $dir = "pteerslt";
+    mkdir $dir, 0;
+    @a = bsd_glob("$dir/*", GLOB_ERR);
+    #print "\@a = ", array(@a);
+    rmdir $dir;
+    if (scalar(@a) != 0 || GLOB_ERROR == 0) {
+       print "not ";
+    }
+    print "ok 6\n";
+}
+
+# check for csh style globbing
+@a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
+unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') {
+    print "not ";
+}
+print "ok 7\n";
+
+@a = bsd_glob(
+    '{TES*,doesntexist*,a,b}',
+    GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0)
+);
+
+# Working on t/TEST often causes this test to fail because it sees Emacs temp
+# and RCS files.  Filter them out, and .pm files too, and patch temp files.
+@a = grep !/(,v$|~$|\.(pm|ori?g|rej)$)/, @a;
+
+print "# @a\n";
+
+unless (@a == 3
+        and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
+        and $a[1] eq 'a'
+        and $a[2] eq 'b')
+{
+    print "not ok 8 # @a";
+} else {
+    print "ok 8\n";
+}
+
+# "~" should expand to $ENV{HOME}
+$ENV{HOME} = "sweet home";
+@a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
+unless ($^O eq "MacOS" || (@a == 1 and $a[0] eq $ENV{HOME})) {
+    print "not ";
+}
+print "ok 9\n";
+
+# GLOB_ALPHASORT (default) should sort alphabetically regardless of case
+mkdir "pteerslt", 0777;
+chdir "pteerslt";
+
+@f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl);
+@f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl);
+if ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER
+    @f_names = sort(@f_names);
+}
+if ($^O eq 'VMS') { # VMS is happily caseignorant
+    @f_alpha = qw(ax.pl ay.pl bx.pl by.pl cx.pl cy.pl);
+    @f_names = @f_alpha;
+}
+
+for (@f_names) {
+    open T, "> $_";
+    close T;
+}
+
+$pat = "*.pl";
+
+$ok = 1;
+@g_names = bsd_glob($pat, 0);
+print "# f_names = @f_names\n";
+print "# g_names = @g_names\n";
+for (@f_names) {
+    $ok = 0 unless $_ eq shift @g_names;
+}
+print $ok ? "ok 10\n" : "not ok 10\n";
+
+$ok = 1;
+@g_alpha = bsd_glob($pat);
+print "# f_alpha = @f_alpha\n";
+print "# g_alpha = @g_alpha\n";
+for (@f_alpha) {
+    $ok = 0 unless $_ eq shift @g_alpha;
+}
+print $ok ? "ok 11\n" : "not ok 11\n";
+
+unlink @f_names;
+chdir "..";
+rmdir "pteerslt";

diff --git a/lib/File/Glob/case.t b/lib/File/Glob/case.t
new file mode 100755 (executable)
index 0000000..87f3b9f
--- /dev/null
+++ b/lib/File/Glob/case.t
@@ -0,0 +1,60 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') { 
+       @INC = qw(: ::lib ::macos:lib); 
+    } else { 
+       @INC = '.'; 
+       push @INC, '../lib'; 
+    }
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+    print "1..7\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+use File::Glob qw(:glob csh_glob);
+$loaded = 1;
+print "ok 1\n";
+
+my $pat = $^O eq "MacOS" ? ":op:G*.t" : "op/G*.t";
+
+# Test the actual use of the case sensitivity tags, via csh_glob()
+import File::Glob ':nocase';
+@a = csh_glob($pat);
+print "not " unless @a >= 8;
+print "ok 2\n";
+
+# This may fail on systems which are not case-PRESERVING
+import File::Glob ':case';
+@a = csh_glob($pat); # None should be uppercase
+print "not " unless @a == 0;
+print "ok 3\n";
+
+# Test the explicit use of the GLOB_NOCASE flag
+@a = bsd_glob($pat, GLOB_NOCASE);
+print "not " unless @a >= 3;
+print "ok 4\n";
+
+# Test Win32 backslash nastiness...
+if ($^O ne 'MSWin32' && $^O ne 'NetWare') {
+    print "ok 5\nok 6\nok 7\n";
+}
+else {
+    @a = File::Glob::glob("op\\g*.t");
+    print "not " unless @a >= 8;
+    print "ok 5\n";
+    mkdir "[]", 0;
+    @a = File::Glob::glob("\\[\\]", GLOB_QUOTE);
+    rmdir "[]";
+    print "# returned @a\nnot " unless @a == 1;
+    print "ok 6\n";
+    @a = bsd_glob("op\\*", GLOB_QUOTE);
+    print "not " if @a == 0;
+    print "ok 7\n";
+}

diff --git a/lib/File/Glob/global.t b/lib/File/Glob/global.t
new file mode 100755 (executable)
index 0000000..c0abbc5
--- /dev/null
+++ b/lib/File/Glob/global.t
@@ -0,0 +1,151 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') { 
+       @INC = qw(: ::lib ::macos:lib); 
+    } else { 
+       @INC = '.'; 
+       push @INC, '../lib'; 
+    }
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+    print "1..10\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+
+BEGIN {
+    *CORE::GLOBAL::glob = sub { "Just another Perl hacker," };
+}
+
+BEGIN {
+    if ("Just another Perl hacker," ne (<*>)[0]) {
+        die <<EOMessage;
+Your version of perl ($]) doesn't seem to allow extensions to override
+the core glob operator.
+EOMessage
+    }
+}
+
+use File::Glob ':globally';
+$loaded = 1;
+print "ok 1\n";
+
+$_ = $^O eq "MacOS" ? ":op:*.t" : "op/*.t";
+my @r = glob;
+print "not " if $_ ne ($^O eq "MacOS" ? ":op:*.t" : "op/*.t");
+print "ok 2\n";
+
+print "# |@r|\nnot " if @r < 3;
+print "ok 3\n";
+
+# check if <*/*> works
+if ($^O eq "MacOS") {
+    @r = <:*:*.t>;
+} else {
+    @r = <*/*.t>;
+}
+# at least t/global.t t/basic.t, t/taint.t
+print "not " if @r < 3;
+print "ok 4\n";
+my $r = scalar @r;
+
+# check if scalar context works
+@r = ();
+if ($^O eq "MacOS") {
+    while (defined($_ = <:*:*.t>)) {
+       #print "# $_\n";
+       push @r, $_;
+    }
+} else {
+    while (defined($_ = <*/*.t>)) {
+       #print "# $_\n";
+       push @r, $_;
+    }
+}
+print "not " if @r != $r;
+print "ok 5\n";
+
+# check if list context works
+@r = ();
+if ($^O eq "MacOS") {
+    for (<:*:*.t>) {
+       #print "# $_\n";
+       push @r, $_;
+    }
+} else {
+    for (<*/*.t>) {
+       #print "# $_\n";
+       push @r, $_;
+    }
+}
+print "not " if @r != $r;
+print "ok 6\n";
+
+# test if implicit assign to $_ in while() works
+@r = ();
+if ($^O eq "MacOS") {
+    while (<:*:*.t>) {
+       #print "# $_\n";
+       push @r, $_;
+    }
+} else {
+    while (<*/*.t>) {
+       #print "# $_\n";
+       push @r, $_;
+    }
+}
+print "not " if @r != $r;
+print "ok 7\n";
+
+# test if explicit glob() gets assign magic too
+my @s = ();
+while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
+    #print "# $_\n";
+    push @s, $_;
+}
+print "not " if "@r" ne "@s";
+print "ok 8\n";
+
+# how about in a different package, like?
+package Foo;
+use File::Glob ':globally';
+@s = ();
+while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
+    #print "# $_\n";
+    push @s, $_;
+}
+print "not " if "@r" ne "@s";
+print "ok 9\n";
+
+# test if different glob ops maintain independent contexts
+@s = ();
+my $i = 0;
+if ($^O eq "MacOS") {
+    while (<:*:*.t>) {
+       #print "# $_ <";
+       push @s, $_;
+       while (<:bas*:*.t>) {
+           #print " $_";
+           $i++;
+       }
+       #print " >\n";
+    }
+} else {
+    while (<*/*.t>) {
+       #print "# $_ <";
+       push @s, $_;
+       while (<bas*/*.t>) {
+           #print " $_";
+           $i++;
+       }
+       #print " >\n";
+    }
+}
+print "not " if "@r" ne "@s" or not $i;
+print "ok 10\n";

diff --git a/lib/File/Glob/taint.t b/lib/File/Glob/taint.t
new file mode 100755 (executable)
index 0000000..4c09903
--- /dev/null
+++ b/lib/File/Glob/taint.t
@@ -0,0 +1,31 @@
+#!./perl -T
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') { 
+       @INC = qw(: ::lib ::macos:lib); 
+    } else { 
+       @INC = '.'; 
+       push @INC, '../lib'; 
+    }
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+    print "1..2\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+use File::Glob;
+$loaded = 1;
+print "ok 1\n";
+
+# all filenames should be tainted
+@a = File::Glob::bsd_glob("*");
+eval { $a = join("",@a), kill 0; 1 };
+unless ($@ =~ /Insecure dependency/) {
+    print "not ";
+}
+print "ok 2\n";

diff --git a/lib/File/Path.t b/lib/File/Path.t
new file mode 100755 (executable)
index 0000000..42e0ae9
--- /dev/null
+++ b/lib/File/Path.t
@@ -0,0 +1,28 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use File::Path;
+use strict;
+
+my $count = 0;
+use warnings;
+
+print "1..4\n";
+
+# first check for stupid permissions second for full, so we clean up
+# behind ourselves
+for my $perm (0111,0777) {
+    mkpath("foo/bar");
+    chmod $perm, "foo", "foo/bar";
+
+    print "not " unless -d "foo" && -d "foo/bar";
+    print "ok ", ++$count, "\n";
+
+    rmtree("foo");
+    print "not " if -e "foo";
+    print "ok ", ++$count, "\n";
+}

diff --git a/lib/File/Spec.t b/lib/File/Spec.t
new file mode 100755 (executable)
index 0000000..c6d155f
--- /dev/null
+++ b/lib/File/Spec.t
@@ -0,0 +1,379 @@
+#!./perl
+
+BEGIN {
+    $^O = '';
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Each element in this array is a single test. Storing them this way makes
+# maintenance easy, and should be OK since perl should be pretty functional
+# before these tests are run.
+
+@tests = (
+# Function                      Expected
+[ "Unix->catfile('a','b','c')", 'a/b/c'  ],
+
+[ "Unix->splitpath('file')",            ',,file'            ],
+[ "Unix->splitpath('/d1/d2/d3/')",      ',/d1/d2/d3/,'      ],
+[ "Unix->splitpath('d1/d2/d3/')",       ',d1/d2/d3/,'       ],
+[ "Unix->splitpath('/d1/d2/d3/.')",     ',/d1/d2/d3/.,'     ],
+[ "Unix->splitpath('/d1/d2/d3/..')",    ',/d1/d2/d3/..,'    ],
+[ "Unix->splitpath('/d1/d2/d3/.file')", ',/d1/d2/d3/,.file' ],
+[ "Unix->splitpath('d1/d2/d3/file')",   ',d1/d2/d3/,file'   ],
+[ "Unix->splitpath('/../../d1/')",      ',/../../d1/,'      ],
+[ "Unix->splitpath('/././d1/')",        ',/././d1/,'        ],
+
+[ "Unix->catpath('','','file')",            'file'            ],
+[ "Unix->catpath('','/d1/d2/d3/','')",      '/d1/d2/d3/'      ],
+[ "Unix->catpath('','d1/d2/d3/','')",       'd1/d2/d3/'       ],
+[ "Unix->catpath('','/d1/d2/d3/.','')",     '/d1/d2/d3/.'     ],
+[ "Unix->catpath('','/d1/d2/d3/..','')",    '/d1/d2/d3/..'    ],
+[ "Unix->catpath('','/d1/d2/d3/','.file')", '/d1/d2/d3/.file' ],
+[ "Unix->catpath('','d1/d2/d3/','file')",   'd1/d2/d3/file'   ],
+[ "Unix->catpath('','/../../d1/','')",      '/../../d1/'      ],
+[ "Unix->catpath('','/././d1/','')",        '/././d1/'        ],
+[ "Unix->catpath('d1','d2/d3/','')",        'd2/d3/'          ],
+[ "Unix->catpath('d1','d2','d3/')",         'd2/d3/'          ],
+
+[ "Unix->splitdir('')",           ''           ],
+[ "Unix->splitdir('/d1/d2/d3/')", ',d1,d2,d3,' ],
+[ "Unix->splitdir('d1/d2/d3/')",  'd1,d2,d3,'  ],
+[ "Unix->splitdir('/d1/d2/d3')",  ',d1,d2,d3'  ],
+[ "Unix->splitdir('d1/d2/d3')",   'd1,d2,d3'   ],
+
+[ "Unix->catdir()",                     ''          ],
+[ "Unix->catdir('/')",                  '/'         ],
+[ "Unix->catdir('','d1','d2','d3','')", '/d1/d2/d3' ],
+[ "Unix->catdir('d1','d2','d3','')",    'd1/d2/d3'  ],
+[ "Unix->catdir('','d1','d2','d3')",    '/d1/d2/d3' ],
+[ "Unix->catdir('d1','d2','d3')",       'd1/d2/d3'  ],
+
+[ "Unix->catfile('a','b','c')", 'a/b/c' ],
+
+[ "Unix->canonpath('')",                                      ''          ],
+[ "Unix->canonpath('///../../..//./././a//b/.././c/././')",   '/a/b/../c' ],
+[ "Unix->canonpath('/.')",                                    '/.'        ],
+
+[  "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')",          ''                   ],
+[  "Unix->abs2rel('/t1/t2/t4','/t1/t2/t3')",          '../t4'              ],
+[  "Unix->abs2rel('/t1/t2','/t1/t2/t3')",             '..'                 ],
+[  "Unix->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')",       't4'                 ],
+[  "Unix->abs2rel('/t4/t5/t6','/t1/t2/t3')",          '../../../t4/t5/t6'  ],
+#[ "Unix->abs2rel('../t4','/t1/t2/t3')",              '../t4'              ],
+[  "Unix->abs2rel('/','/t1/t2/t3')",                  '../../..'           ],
+[  "Unix->abs2rel('///','/t1/t2/t3')",                '../../..'           ],
+[  "Unix->abs2rel('/.','/t1/t2/t3')",                 '../../../.'         ],
+[  "Unix->abs2rel('/./','/t1/t2/t3')",                '../../..'           ],
+#[ "Unix->abs2rel('../t4','/t1/t2/t3')",              '../t4'              ],
+
+[ "Unix->rel2abs('t4','/t1/t2/t3')",             '/t1/t2/t3/t4'    ],
+[ "Unix->rel2abs('t4/t5','/t1/t2/t3')",          '/t1/t2/t3/t4/t5' ],
+[ "Unix->rel2abs('.','/t1/t2/t3')",              '/t1/t2/t3'       ],
+[ "Unix->rel2abs('..','/t1/t2/t3')",             '/t1/t2/t3/..'    ],
+[ "Unix->rel2abs('../t4','/t1/t2/t3')",          '/t1/t2/t3/../t4' ],
+[ "Unix->rel2abs('/t1','/t1/t2/t3')",            '/t1'             ],
+
+[ "Win32->splitpath('file')",                            ',,file'                            ],
+[ "Win32->splitpath('\\d1/d2\\d3/')",                    ',\\d1/d2\\d3/,'                    ],
+[ "Win32->splitpath('d1/d2\\d3/')",                      ',d1/d2\\d3/,'                      ],
+[ "Win32->splitpath('\\d1/d2\\d3/.')",                   ',\\d1/d2\\d3/.,'                   ],
+[ "Win32->splitpath('\\d1/d2\\d3/..')",                  ',\\d1/d2\\d3/..,'                  ],
+[ "Win32->splitpath('\\d1/d2\\d3/.file')",               ',\\d1/d2\\d3/,.file'               ],
+[ "Win32->splitpath('\\d1/d2\\d3/file')",                ',\\d1/d2\\d3/,file'                ],
+[ "Win32->splitpath('d1/d2\\d3/file')",                  ',d1/d2\\d3/,file'                  ],
+[ "Win32->splitpath('C:\\d1/d2\\d3/')",                  'C:,\\d1/d2\\d3/,'                  ],
+[ "Win32->splitpath('C:d1/d2\\d3/')",                    'C:,d1/d2\\d3/,'                    ],
+[ "Win32->splitpath('C:\\d1/d2\\d3/file')",              'C:,\\d1/d2\\d3/,file'              ],
+[ "Win32->splitpath('C:d1/d2\\d3/file')",                'C:,d1/d2\\d3/,file'                ],
+[ "Win32->splitpath('C:\\../d2\\d3/file')",              'C:,\\../d2\\d3/,file'              ],
+[ "Win32->splitpath('C:../d2\\d3/file')",                'C:,../d2\\d3/,file'                ],
+[ "Win32->splitpath('\\../..\\d1/')",                    ',\\../..\\d1/,'                    ],
+[ "Win32->splitpath('\\./.\\d1/')",                      ',\\./.\\d1/,'                      ],
+[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/')",     '\\\\node\\share,\\d1/d2\\d3/,'     ],
+[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/file')", '\\\\node\\share,\\d1/d2\\d3/,file' ],
+[ "Win32->splitpath('\\\\node\\share\\d1/d2\\file')",    '\\\\node\\share,\\d1/d2\\,file'    ],
+[ "Win32->splitpath('file',1)",                          ',file,'                            ],
+[ "Win32->splitpath('\\d1/d2\\d3/',1)",                  ',\\d1/d2\\d3/,'                    ],
+[ "Win32->splitpath('d1/d2\\d3/',1)",                    ',d1/d2\\d3/,'                      ],
+[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/',1)",   '\\\\node\\share,\\d1/d2\\d3/,'     ],
+
+[ "Win32->catpath('','','file')",                            'file'                            ],
+[ "Win32->catpath('','\\d1/d2\\d3/','')",                    '\\d1/d2\\d3/'                    ],
+[ "Win32->catpath('','d1/d2\\d3/','')",                      'd1/d2\\d3/'                      ],
+[ "Win32->catpath('','\\d1/d2\\d3/.','')",                   '\\d1/d2\\d3/.'                   ],
+[ "Win32->catpath('','\\d1/d2\\d3/..','')",                  '\\d1/d2\\d3/..'                  ],
+[ "Win32->catpath('','\\d1/d2\\d3/','.file')",               '\\d1/d2\\d3/.file'               ],
+[ "Win32->catpath('','\\d1/d2\\d3/','file')",                '\\d1/d2\\d3/file'                ],
+[ "Win32->catpath('','d1/d2\\d3/','file')",                  'd1/d2\\d3/file'                  ],
+[ "Win32->catpath('C:','\\d1/d2\\d3/','')",                  'C:\\d1/d2\\d3/'                  ],
+[ "Win32->catpath('C:','d1/d2\\d3/','')",                    'C:d1/d2\\d3/'                    ],
+[ "Win32->catpath('C:','\\d1/d2\\d3/','file')",              'C:\\d1/d2\\d3/file'              ],
+[ "Win32->catpath('C:','d1/d2\\d3/','file')",                'C:d1/d2\\d3/file'                ],
+[ "Win32->catpath('C:','\\../d2\\d3/','file')",              'C:\\../d2\\d3/file'              ],
+[ "Win32->catpath('C:','../d2\\d3/','file')",                'C:../d2\\d3/file'                ],
+[ "Win32->catpath('','\\../..\\d1/','')",                    '\\../..\\d1/'                    ],
+[ "Win32->catpath('','\\./.\\d1/','')",                      '\\./.\\d1/'                      ],
+[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','')",     '\\\\node\\share\\d1/d2\\d3/'     ],
+[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','file')", '\\\\node\\share\\d1/d2\\d3/file' ],
+[ "Win32->catpath('\\\\node\\share','\\d1/d2\\','file')",    '\\\\node\\share\\d1/d2\\file'    ],
+
+[ "Win32->splitdir('')",             ''           ],
+[ "Win32->splitdir('\\d1/d2\\d3/')", ',d1,d2,d3,' ],
+[ "Win32->splitdir('d1/d2\\d3/')",   'd1,d2,d3,'  ],
+[ "Win32->splitdir('\\d1/d2\\d3')",  ',d1,d2,d3'  ],
+[ "Win32->splitdir('d1/d2\\d3')",    'd1,d2,d3'   ],
+
+[ "Win32->catdir()",                        ''                   ],
+[ "Win32->catdir('')",                      '\\'                 ],
+[ "Win32->catdir('/')",                     '\\'                 ],
+[ "Win32->catdir('//d1','d2')",             '\\\\d1\\d2'         ],
+[ "Win32->catdir('','/d1','d2')",           '\\\\d1\\d2'         ],
+[ "Win32->catdir('','','/d1','d2')",        '\\\\\\d1\\d2'       ],
+[ "Win32->catdir('','//d1','d2')",          '\\\\\\d1\\d2'       ],
+[ "Win32->catdir('','','//d1','d2')",       '\\\\\\\\d1\\d2'     ],
+[ "Win32->catdir('','d1','','d2','')",      '\\d1\\d2'           ],
+[ "Win32->catdir('','d1','d2','d3','')",    '\\d1\\d2\\d3'       ],
+[ "Win32->catdir('d1','d2','d3','')",       'd1\\d2\\d3'         ],
+[ "Win32->catdir('','d1','d2','d3')",       '\\d1\\d2\\d3'       ],
+[ "Win32->catdir('d1','d2','d3')",          'd1\\d2\\d3'         ],
+[ "Win32->catdir('A:/d1','d2','d3')",       'A:\\d1\\d2\\d3'     ],
+[ "Win32->catdir('A:/d1','d2','d3','')",    'A:\\d1\\d2\\d3'     ],
+#[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\d2\\d3'     ],
+[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\B:\\d2\\d3' ],
+[ "Win32->catdir('A:/')",                   'A:\\'               ],
+
+[ "Win32->catfile('a','b','c')", 'a\\b\\c' ],
+
+[ "Win32->canonpath('')",               ''                    ],
+[ "Win32->canonpath('a:')",             'A:'                  ],
+[ "Win32->canonpath('A:f')",            'A:f'                 ],
+[ "Win32->canonpath('//a\\b//c')",      '\\\\a\\b\\c'         ],
+[ "Win32->canonpath('/a/..../c')",      '\\a\\....\\c'        ],
+[ "Win32->canonpath('//a/b\\c')",       '\\\\a\\b\\c'         ],
+[ "Win32->canonpath('////')",           '\\\\\\'              ],
+[ "Win32->canonpath('//')",             '\\'                  ],
+[ "Win32->canonpath('/.')",             '\\.'                 ],
+[ "Win32->canonpath('//a/b/../../c')",  '\\\\a\\b\\..\\..\\c' ],
+[ "Win32->canonpath('//a/../../c')",    '\\\\a\\..\\..\\c'    ],
+
+[  "Win32->abs2rel('/t1/t2/t3','/t1/t2/t3')",    ''                       ],
+[  "Win32->abs2rel('/t1/t2/t4','/t1/t2/t3')",    '..\\t4'                 ],
+[  "Win32->abs2rel('/t1/t2','/t1/t2/t3')",       '..'                     ],
+[  "Win32->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4'                     ],
+[  "Win32->abs2rel('/t4/t5/t6','/t1/t2/t3')",    '..\\..\\..\\t4\\t5\\t6' ],
+#[ "Win32->abs2rel('../t4','/t1/t2/t3')",        '\\t1\\t2\\t3\\..\\t4'   ],
+[  "Win32->abs2rel('/','/t1/t2/t3')",            '..\\..\\..'             ],
+[  "Win32->abs2rel('///','/t1/t2/t3')",          '..\\..\\..'             ],
+[  "Win32->abs2rel('/.','/t1/t2/t3')",           '..\\..\\..\\.'          ],
+[  "Win32->abs2rel('/./','/t1/t2/t3')",          '..\\..\\..'             ],
+[  "Win32->abs2rel('\\\\a/t1/t2/t4','/t2/t3')",  '..\\t4'                 ],
+[  "Win32->abs2rel('//a/t1/t2/t4','/t2/t3')",    '..\\t4'                 ],
+
+[ "Win32->rel2abs('temp','C:/')",                       'C:\\temp'                        ],
+[ "Win32->rel2abs('temp','C:/a')",                      'C:\\a\\temp'                     ],
+[ "Win32->rel2abs('temp','C:/a/')",                     'C:\\a\\temp'                     ],
+[ "Win32->rel2abs('../','C:/')",                        'C:\\..'                          ],
+[ "Win32->rel2abs('../','C:/a')",                       'C:\\a\\..'                       ],
+[ "Win32->rel2abs('temp','//prague_main/work/')",       '\\\\prague_main\\work\\temp'     ],
+[ "Win32->rel2abs('../temp','//prague_main/work/')",    '\\\\prague_main\\work\\..\\temp' ],
+[ "Win32->rel2abs('temp','//prague_main/work')",        '\\\\prague_main\\work\\temp'     ],
+[ "Win32->rel2abs('../','//prague_main/work')",         '\\\\prague_main\\work\\..'       ],
+
+[ "VMS->splitpath('file')",                                       ',,file'                                   ],
+[ "VMS->splitpath('[d1.d2.d3]')",                                 ',[d1.d2.d3],'                               ],
+[ "VMS->splitpath('[.d1.d2.d3]')",                                ',[.d1.d2.d3],'                              ],
+[ "VMS->splitpath('[d1.d2.d3]file')",                             ',[d1.d2.d3],file'                           ],
+[ "VMS->splitpath('d1/d2/d3/file')",                              ',[.d1.d2.d3],file'                          ],
+[ "VMS->splitpath('/d1/d2/d3/file')",                             'd1:,[d2.d3],file'                         ],
+[ "VMS->splitpath('[.d1.d2.d3]file')",                            ',[.d1.d2.d3],file'                          ],
+[ "VMS->splitpath('node::volume:[d1.d2.d3]')",                    'node::volume:,[d1.d2.d3],'                  ],
+[ "VMS->splitpath('node::volume:[d1.d2.d3]file')",                'node::volume:,[d1.d2.d3],file'              ],
+[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]')",     'node"access_spec"::volume:,[d1.d2.d3],'     ],
+[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]file')", 'node"access_spec"::volume:,[d1.d2.d3],file' ],
+
+[ "VMS->catpath('','','file')",                                       'file'                                     ],
+[ "VMS->catpath('','[d1.d2.d3]','')",                                 '[d1.d2.d3]'                               ],
+[ "VMS->catpath('','[.d1.d2.d3]','')",                                '[.d1.d2.d3]'                              ],
+[ "VMS->catpath('','[d1.d2.d3]','file')",                             '[d1.d2.d3]file'                           ],
+[ "VMS->catpath('','[.d1.d2.d3]','file')",                            '[.d1.d2.d3]file'                          ],
+[ "VMS->catpath('','d1/d2/d3','file')",                               '[.d1.d2.d3]file'                            ],
+[ "VMS->catpath('v','d1/d2/d3','file')",                              'v:[.d1.d2.d3]file'                            ],
+[ "VMS->catpath('node::volume:','[d1.d2.d3]','')",                    'node::volume:[d1.d2.d3]'                  ],
+[ "VMS->catpath('node::volume:','[d1.d2.d3]','file')",                'node::volume:[d1.d2.d3]file'              ],
+[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','')",     'node"access_spec"::volume:[d1.d2.d3]'     ],
+[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','file')", 'node"access_spec"::volume:[d1.d2.d3]file' ],
+
+[ "VMS->canonpath('')",                                    ''                        ],
+[ "VMS->canonpath('volume:[d1]file')",                     'volume:[d1]file'         ],
+[ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')",              'volume:[d2.d3]'          ],
+[ "VMS->canonpath('volume:[000000.d1]d2.dir;1')",                 'volume:[d1]d2.dir;1'   ],
+
+[ "VMS->splitdir('')",            ''          ],
+[ "VMS->splitdir('[]')",          ''          ],
+[ "VMS->splitdir('d1.d2.d3')",    'd1,d2,d3'  ],
+[ "VMS->splitdir('[d1.d2.d3]')",  'd1,d2,d3'  ],
+[ "VMS->splitdir('.d1.d2.d3')",   ',d1,d2,d3' ],
+[ "VMS->splitdir('[.d1.d2.d3]')", ',d1,d2,d3' ],
+[ "VMS->splitdir('.-.d2.d3')",    ',-,d2,d3'  ],
+[ "VMS->splitdir('[.-.d2.d3]')",  ',-,d2,d3'  ],
+
+[ "VMS->catdir('')",                                                      ''                 ],
+[ "VMS->catdir('d1','d2','d3')",                                          '[.d1.d2.d3]'         ],
+[ "VMS->catdir('d1','d2/','d3')",                                         '[.d1.d2.d3]'         ],
+[ "VMS->catdir('','d1','d2','d3')",                                       '[.d1.d2.d3]'        ],
+[ "VMS->catdir('','-','d2','d3')",                                        '[-.d2.d3]'         ],
+[ "VMS->catdir('','-','','d3')",                                          '[-.d3]'            ],
+[ "VMS->catdir('dir.dir','d2.dir','d3.dir')",                             '[.dir.d2.d3]'        ],
+[ "VMS->catdir('[.name]')",                                               '[.name]'            ],
+[ "VMS->catdir('[.name]','[.name]')",                                     '[.name.name]'],    
+
+[  "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", ''                 ],
+[  "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]'           ],
+[  "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')",              ''                 ],
+[  "VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')",          'file'             ],
+[  "VMS->abs2rel('[t1.t2.t4]','[t1.t2.t3]')",              '[-.t4]'           ],
+[  "VMS->abs2rel('[t1.t2]file','[t1.t2.t3]')",             '[-]file'          ],
+[  "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')",           '[t4]'             ],
+[  "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')",              '[---.t4.t5.t6]'   ],
+[ "VMS->abs2rel('[000000]','[t1.t2.t3]')",                 '[---.000000]'     ],
+[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')",             '[-.t4]'           ],
+[ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')",              '[---.b]'          ],
+
+[ "VMS->rel2abs('[.t4]','[t1.t2.t3]')",          '[t1.t2.t3.t4]'    ],
+[ "VMS->rel2abs('[.t4.t5]','[t1.t2.t3]')",       '[t1.t2.t3.t4.t5]' ],
+[ "VMS->rel2abs('[]','[t1.t2.t3]')",             '[t1.t2.t3]'       ],
+[ "VMS->rel2abs('[-]','[t1.t2.t3]')",            '[t1.t2]'          ],
+[ "VMS->rel2abs('[-.t4]','[t1.t2.t3]')",         '[t1.t2.t4]'       ],
+[ "VMS->rel2abs('[t1]','[t1.t2.t3]')",           '[t1]'             ],
+
+[ "OS2->catdir('A:/d1','B:/d2','d3','')", 'A:/d1/B:/d2/d3' ],
+[ "OS2->catfile('a','b','c')",            'a/b/c'          ],
+
+[ "Mac->splitpath('file')",          ',,file'          ],
+[ "Mac->splitpath(':file')",         ',:,file'         ],
+[ "Mac->splitpath(':d1',1)",         ',:d1:,'          ],
+[ "Mac->splitpath('d1',1)",          'd1:,,'           ],
+[ "Mac->splitpath('d1:d2:d3:')",     'd1:,d2:d3:,'     ],
+[ "Mac->splitpath('d1:d2:d3',1)",    'd1:,d2:d3:,'     ],
+[ "Mac->splitpath(':d1:d2:d3:')",    ',:d1:d2:d3:,'    ],
+[ "Mac->splitpath(':d1:d2:d3:',1)",  ',:d1:d2:d3:,'    ],
+[ "Mac->splitpath('d1:d2:d3:file')", 'd1:,d2:d3:,file' ],
+[ "Mac->splitpath('d1:d2:d3',1)",    'd1:,d2:d3:,'     ],
+
+[ "Mac->catdir('')",                ':'           ],
+[ "Mac->catdir('d1','d2','d3')",    'd1:d2:d3:'   ],
+[ "Mac->catdir('d1','d2/','d3')",   'd1:d2/:d3:'  ],
+[ "Mac->catdir('','d1','d2','d3')", ':d1:d2:d3:'  ],
+[ "Mac->catdir('','','d2','d3')",   '::d2:d3:'    ],
+[ "Mac->catdir('','','','d3')",     ':::d3:'      ],
+[ "Mac->catdir(':name')",           ':name:'      ],
+[ "Mac->catdir(':name',':name')",   ':name:name:' ],
+
+[ "Mac->catfile('a','b','c')", 'a:b:c' ],
+
+[ "Mac->canonpath('')",                   ''     ],
+[ "Mac->canonpath(':')",                  ':'    ],
+[ "Mac->canonpath('::')",                 '::'   ],
+[ "Mac->canonpath('a::')",                'a::'  ],
+[ "Mac->canonpath(':a::')",               ':a::' ],
+
+[ "Mac->abs2rel('t1:t2:t3','t1:t2:t3')",    ':'            ],
+[ "Mac->abs2rel('t1:t2','t1:t2:t3')",       '::'           ],
+[ "Mac->abs2rel('t1:t4','t1:t2:t3')",       ':::t4'        ],
+[ "Mac->abs2rel('t1:t2:t4','t1:t2:t3')",    '::t4'         ],
+[ "Mac->abs2rel('t1:t2:t3:t4','t1:t2:t3')", ':t4'          ],
+[ "Mac->abs2rel('t4:t5:t6','t1:t2:t3')",    '::::t4:t5:t6' ],
+[ "Mac->abs2rel('t1','t1:t2:t3')",          ':::'          ],
+
+[ "Mac->rel2abs(':t4','t1:t2:t3')",          't1:t2:t3:t4'    ],
+[ "Mac->rel2abs(':t4:t5','t1:t2:t3')",       't1:t2:t3:t4:t5' ],
+[ "Mac->rel2abs('','t1:t2:t3')",             ''               ],
+[ "Mac->rel2abs('::','t1:t2:t3')",           't1:t2:t3::'     ],
+[ "Mac->rel2abs('::t4','t1:t2:t3')",         't1:t2:t3::t4'   ],
+[ "Mac->rel2abs('t1','t1:t2:t3')",           't1'             ],
+) ;
+
+# Grab all of the plain routines from File::Spec
+use File::Spec @File::Spec::EXPORT_OK ;
+
+require File::Spec::Unix ;
+require File::Spec::Win32 ;
+
+eval {
+   require VMS::Filespec ;
+} ;
+
+my $skip_exception = "Install VMS::Filespec (from vms/ext)" ;
+
+if ( $@ ) {
+   # Not pretty, but it allows testing of things not implemented soley
+   # on VMS.  It might be better to change File::Spec::VMS to do this,
+   # making it more usable when running on (say) Unix but working with
+   # VMS paths.
+   eval qq-
+      sub File::Spec::VMS::vmsify  { die "$skip_exception" }
+      sub File::Spec::VMS::unixify { die "$skip_exception" }
+      sub File::Spec::VMS::vmspath { die "$skip_exception" }
+   - ;
+   $INC{"VMS/Filespec.pm"} = 1 ;
+}
+require File::Spec::VMS ;
+
+require File::Spec::OS2 ;
+require File::Spec::Mac ;
+
+print "1..", scalar( @tests ), "\n" ;
+
+my $current_test= 1 ;
+
+# Test out the class methods
+for ( @tests ) {
+   tryfunc( @$_ ) ;
+}
+
+
+
+#
+# Tries a named function with the given args and compares the result against
+# an expected result. Works with functions that return scalars or arrays.
+#
+sub tryfunc {
+    my $function = shift ;
+    my $expected = shift ;
+    my $platform = shift ;
+
+    if ($platform && $^O ne $platform) {
+       print "ok $current_test # skipped: $function\n" ;
+       ++$current_test ;
+       return;
+    }
+
+    $function =~ s#\\#\\\\#g ;
+
+    my $got ;
+    if ( $function =~ /^[^\$].*->/ ) {
+       $got = eval( "join( ',', File::Spec::$function )" ) ;
+    }
+    else {
+       $got = eval( "join( ',', $function )" ) ;
+    }
+
+    if ( $@ ) {
+        if ( substr( $@, 0, length $skip_exception ) eq $skip_exception ) {
+           chomp $@ ;
+           print "ok $current_test # skip $function: $@\n" ;
+       }
+       else {
+           chomp $@ ;
+           print "not ok $current_test # $function: $@\n" ;
+       }
+    }
+    elsif ( !defined( $got ) || $got ne $expected ) {
+       print "not ok $current_test # $function: got '$got', expected '$expected'\n" ;
+    }
+    else {
+       print "ok $current_test # $function\n" ;
+    }
+    ++$current_test ;
+}

diff --git a/lib/File/Spec/Functions.t b/lib/File/Spec/Functions.t
new file mode 100755 (executable)
index 0000000..9268122
--- /dev/null
+++ b/lib/File/Spec/Functions.t
@@ -0,0 +1,17 @@
+#!./perl
+
+BEGIN {
+    $^O = '';
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use File::Spec::Functions;
+
+if (catfile('a','b','c') eq 'a/b/c') {
+    print "ok 1\n";
+} else {
+    print "not ok 1\n";
+}

diff --git a/lib/File/Temp/mktemp.t b/lib/File/Temp/mktemp.t
new file mode 100755 (executable)
index 0000000..4e31d01
--- /dev/null
+++ b/lib/File/Temp/mktemp.t
@@ -0,0 +1,115 @@
+#!/usr/bin/perl -w
+
+# Test for mktemp family of commands in File::Temp
+# Use STANDARD safe level for these tests
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Test; import Test;
+       plan(tests => 9);
+}
+
+use strict;
+
+use File::Spec;
+use File::Path;
+use File::Temp qw/ :mktemp unlink0 /;
+use FileHandle;
+
+ok(1);
+
+# MKSTEMP - test
+
+# Create file in temp directory
+my $template = File::Spec->catfile(File::Spec->tmpdir, 'wowserXXXX');
+
+(my $fh, $template) = mkstemp($template);
+
+print "# MKSTEMP: FH is $fh File is $template fileno=".fileno($fh)."\n";
+# Check if the file exists
+ok( (-e $template) );
+
+# Autoflush
+$fh->autoflush(1) if $] >= 5.006;
+
+# Try printing something to the file
+my $string = "woohoo\n";
+print $fh $string;
+
+# rewind the file
+ok(seek( $fh, 0, 0));
+
+# Read from the file
+my $line = <$fh>;
+
+# compare with previous string
+ok($string, $line);
+
+# Tidy up
+# This test fails on Windows NT since it seems that the size returned by 
+# stat(filehandle) does not always equal the size of the stat(filename)
+# This must be due to caching. In particular this test writes 7 bytes
+# to the file which are not recognised by stat(filename)
+# Simply waiting 3 seconds seems to be enough for the system to update
+
+if ($^O eq 'MSWin32') {
+  sleep 3;
+}
+my $status = unlink0($fh, $template);
+if ($status) {
+  ok( $status );
+} else {
+  skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
+}
+
+# MKSTEMPS
+# File with suffix. This is created in the current directory so
+# may be problematic on NFS
+
+$template = "suffixXXXXXX";
+my $suffix = ".dat";
+
+($fh, my $fname) = mkstemps($template, $suffix);
+
+print "# MKSTEMPS: File is $template -> $fname fileno=".fileno($fh)."\n";
+# Check if the file exists
+ok( (-e $fname) );
+
+# This fails if you are running on NFS
+# If this test fails simply skip it rather than doing a hard failure
+$status = unlink0($fh, $fname);
+
+if ($status) {
+  ok($status);
+} else {
+  skip("Skip test failed probably due to cwd being on NFS",1)
+}
+
+# MKDTEMP
+# Temp directory
+
+$template = File::Spec->catdir(File::Spec->tmpdir, 'tmpdirXXXXXX');
+
+my $tmpdir = mkdtemp($template);
+
+print "# MKDTEMP: Name is $tmpdir from template $template\n";
+
+ok( (-d $tmpdir ) );
+
+# Need to tidy up after myself
+rmtree($tmpdir);
+
+# MKTEMP
+# Just a filename, not opened
+
+$template = File::Spec->catfile(File::Spec->tmpdir, 'mytestXXXXXX');
+
+my $tmpfile = mktemp($template);
+
+print "# MKTEMP: Tempfile is $template -> $tmpfile\n";
+
+# Okay if template no longer has XXXXX in
+
+
+ok( ($tmpfile !~ /XXXXX$/) );

diff --git a/lib/File/Temp/posix.t b/lib/File/Temp/posix.t
new file mode 100755 (executable)
index 0000000..0a5e860
--- /dev/null
+++ b/lib/File/Temp/posix.t
@@ -0,0 +1,83 @@
+#!/usr/bin/perl -w
+# Test for File::Temp - POSIX functions
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Test; import Test;
+       plan(tests => 7);
+}
+
+use strict;
+
+use File::Temp qw/ :POSIX unlink0 /;
+use FileHandle;
+
+ok(1);
+
+# TMPNAM - scalar
+
+print "# TMPNAM: in a scalar context: \n";
+my $tmpnam = tmpnam();
+
+# simply check that the file does not exist
+# Not a 100% water tight test though if another program 
+# has managed to create one in the meantime.
+ok( !(-e $tmpnam ));
+
+print "# TMPNAM file name: $tmpnam\n";
+
+# TMPNAM list context
+# Not strict posix behaviour
+(my $fh, $tmpnam) = tmpnam();
+
+print "# TMPNAM: in list context: $fh $tmpnam\n";
+
+# File is opened - make sure it exists
+ok( (-e $tmpnam ));
+
+# Unlink it - a possible NFS issue again if TMPDIR is not a local disk
+my $status = unlink0($fh, $tmpnam);
+if ($status) {
+  ok( $status );
+} else {
+  skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
+}
+
+# TMPFILE
+
+$fh = tmpfile();
+
+if (defined $fh) {
+  ok( $fh );
+  print "# TMPFILE: tmpfile got FH $fh\n";
+
+  $fh->autoflush(1) if $] >= 5.006;
+
+  # print something to it
+  my $original = "Hello a test\n";
+  print "# TMPFILE: Wrote line: $original";
+  print $fh $original
+    or die "Error printing to tempfile\n";
+
+  # rewind it
+  ok( seek($fh,0,0) );
+
+  # Read from it
+  my $line = <$fh>;
+
+  print "# TMPFILE: Read line: $line";
+  ok( $original, $line);
+
+  close($fh);
+
+} else {
+  # Skip all the remaining tests
+  foreach (1..3) {
+    skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
+  }
+}
+
+
+
+

diff --git a/lib/File/Temp/security.t b/lib/File/Temp/security.t
new file mode 100755 (executable)
index 0000000..f9be237
--- /dev/null
+++ b/lib/File/Temp/security.t
@@ -0,0 +1,140 @@
+#!/usr/bin/perl -w
+# Test for File::Temp - Security levels
+
+# Some of the security checking will not work on all platforms
+# Test a simple open in the cwd and tmpdir foreach of the
+# security levels
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Test; import Test;
+       plan(tests => 13);
+}
+
+use strict;
+use File::Spec;
+
+# Set up END block - this needs to happen before we load
+# File::Temp since this END block must be evaluated after the
+# END block configured by File::Temp
+my @files; # list of files to remove
+END { foreach (@files) { ok( !(-e $_) )} }
+
+use File::Temp qw/ tempfile unlink0 /;
+ok(1);
+
+# The high security tests must currently be skipped on some platforms
+my $skipplat = ( (
+                 # No sticky bits.
+                 $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'os2' || $^O eq 'dos'
+                 ) ? 1 : 0 );
+
+# Can not run high security tests in perls before 5.6.0
+my $skipperl  = ($] < 5.006 ? 1 : 0 );
+
+# Determine whether we need to skip things and why
+my $skip = 0;
+if ($skipplat) {
+  $skip = "Skip Not supported on this platform";
+} elsif ($skipperl) {
+  $skip = "Skip Perl version must be v5.6.0 for these tests";
+
+}
+
+print "# We will be skipping some tests : $skip\n" if $skip;
+
+# start off with basic checking
+
+File::Temp->safe_level( File::Temp::STANDARD );
+
+print "# Testing with STANDARD security...\n";
+
+&test_security(0);
+
+# Try medium
+
+File::Temp->safe_level( File::Temp::MEDIUM )
+  unless $skip;
+
+print "# Testing with MEDIUM security...\n";
+
+# Now we need to start skipping tests
+&test_security($skip);
+
+# Try HIGH
+
+File::Temp->safe_level( File::Temp::HIGH )
+  unless $skip;
+
+print "# Testing with HIGH security...\n";
+
+&test_security($skip);
+
+exit;
+
+# Subroutine to open two temporary files.
+# one is opened in the current dir and the other in the temp dir
+
+sub test_security {
+
+  # Read in the skip flag
+  my $skip = shift;
+
+  # If we are skipping we need to simply fake the correct number
+  # of tests -- we dont use skip since the tempfile() commands will
+  # fail with MEDIUM/HIGH security before the skip() command would be run
+  if ($skip) {
+
+    skip($skip,1);
+    skip($skip,1);
+
+    # plus we need an end block so the tests come out in the right order
+    eval q{ END { skip($skip,1); skip($skip,1)  } 1; } || die;
+
+    return;
+  }
+
+  # Create the tempfile
+  my $template = "tmpXXXXX";
+  my ($fh1, $fname1) = eval { tempfile ( $template, 
+                                 DIR => File::Spec->tmpdir,
+                                 UNLINK => 1,
+                               );
+                           };
+
+  if (defined $fname1) {
+      print "# fname1 = $fname1\n";
+      ok( (-e $fname1) );
+      push(@files, $fname1); # store for end block
+  } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
+      my $skip2 = "Skip system possibly insecure, see INSTALL, section 'make test'";
+      skip($skip2, 1);
+      # plus we need an end block so the tests come out in the right order
+      eval q{ END { skip($skip2,1); } 1; } || die;
+  } else {
+      ok(0);
+  }
+
+  # Explicitly 
+  if ( $< < File::Temp->top_system_uid() ){
+      skip("Skip Test inappropriate for root", 1);
+      eval q{ END { skip($skip,1); } 1; } || die;
+      return;
+  }
+  my ($fh2, $fname2) = eval { tempfile ($template,  UNLINK => 1 ); };
+  if (defined $fname2) {
+      print "# fname2 = $fname2\n";
+      ok( (-e $fname2) );
+      push(@files, $fname2); # store for end block
+      close($fh2);
+  } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
+      my $skip2 = "Skip system possibly insecure, see INSTALL, section 'make test'";
+      skip($skip2, 1);
+      # plus we need an end block so the tests come out in the right order
+      eval q{ END { skip($skip2,1); } 1; } || die;
+  } else {
+      ok(0);
+  }
+
+}

diff --git a/lib/File/Temp/tempfile.t b/lib/File/Temp/tempfile.t
new file mode 100755 (executable)
index 0000000..ed59765
--- /dev/null
+++ b/lib/File/Temp/tempfile.t
@@ -0,0 +1,145 @@
+#!/usr/local/bin/perl -w
+# Test for File::Temp - tempfile function
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Test; import Test;
+       plan(tests => 20);
+}
+
+use strict;
+use File::Spec;
+
+# Will need to check that all files were unlinked correctly
+# Set up an END block here to do it
+
+# Arrays containing list of dirs/files to test
+my (@files, @dirs, @still_there);
+
+# And a test for files that should still be around
+# These are tidied up
+END {
+  foreach (@still_there) {
+    ok( -f $_ );
+    ok( unlink( $_ ) );
+    ok( !(-f $_) );
+  }
+}
+
+# Loop over an array hoping that the files dont exist
+END { foreach (@files) { ok( !(-e $_) )} }
+
+# And a test for directories
+END { foreach (@dirs)  { ok( !(-d $_) )} }
+
+# Need to make sure that the END blocks are setup before
+# the ones that File::Temp configures since END blocks are evaluated
+# in revers order and we need to check the files *after* File::Temp
+# removes them
+use File::Temp qw/ tempfile tempdir/;
+
+# Now we start the tests properly
+ok(1);
+
+
+# Tempfile
+# Open tempfile in some directory, unlink at end
+my ($fh, $tempfile) = tempfile(
+                              UNLINK => 1,
+                              SUFFIX => '.txt',
+                             );
+
+ok( (-f $tempfile) );
+# Should still be around after closing
+ok( close( $fh ) ); 
+ok( (-f $tempfile) );
+# Check again at exit
+push(@files, $tempfile);
+
+# TEMPDIR test
+# Create temp directory in current dir
+my $template = 'tmpdirXXXXXX';
+print "# Template: $template\n";
+my $tempdir = tempdir( $template ,
+                      DIR => File::Spec->curdir,
+                      CLEANUP => 1,
+                    );
+
+print "# TEMPDIR: $tempdir\n";
+
+ok( (-d $tempdir) );
+push(@dirs, $tempdir);
+
+# Create file in the temp dir
+($fh, $tempfile) = tempfile(
+                           DIR => $tempdir,
+                           UNLINK => 1,
+                           SUFFIX => '.dat',
+                          );
+
+print "# TEMPFILE: Created $tempfile\n";
+
+ok( (-f $tempfile));
+push(@files, $tempfile);
+
+# Test tempfile
+# ..and again
+($fh, $tempfile) = tempfile(
+                           DIR => $tempdir,
+                          );
+
+
+ok( (-f $tempfile ));
+push(@files, $tempfile);
+
+print "# TEMPFILE: Created $tempfile\n";
+
+# and another (with template)
+
+($fh, $tempfile) = tempfile( 'helloXXXXXXX',
+                           DIR => $tempdir,
+                           UNLINK => 1,
+                           SUFFIX => '.dat',
+                          );
+
+print "# TEMPFILE: Created $tempfile\n";
+
+ok( (-f $tempfile) );
+push(@files, $tempfile);
+
+
+# Create a temporary file that should stay around after
+# it has been closed
+($fh, $tempfile) = tempfile( 'permXXXXXXX', UNLINK => 0 );
+print "# TEMPFILE: Created $tempfile\n";
+ok( -f $tempfile );
+ok( close( $fh ) );
+push( @still_there, $tempfile); # check at END
+
+# Would like to create a temp file and just retrieve the handle
+# but the test is problematic since:
+#  - We dont know the filename so we cant check that it is tidied
+#    correctly
+#  - The unlink0 required on unix for tempfile creation will fail
+#    on NFS
+# Try to do what we can.
+# Tempfile croaks on error so we need an eval
+$fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Spec->tmpdir ) };
+
+if ($fh) {
+
+  # print something to it to make sure something is there
+  ok( print $fh "Test\n" );
+
+  # Close it - can not check it is gone since we dont know the name
+  ok( close($fh) );
+
+} else {
+  skip "Skip Failed probably due to NFS", 1;
+  skip "Skip Failed probably due to NFS", 1;
+}
+
+# Now END block will execute to test the removal of directories
+print "# End of tests. Execute END blocks\n";
+

diff --git a/lib/File/stat.t b/lib/File/stat.t
new file mode 100644 (file)
index 0000000..ac6d95f
--- /dev/null
+++ b/lib/File/stat.t
@@ -0,0 +1,70 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $hasst;
+    eval { my @n = stat "TEST" };
+    $hasst = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($hasst) { print "1..0 # Skip: no stat\n"; exit 0 }
+    use Config;
+    $hasst = 0 unless $Config{'i_sysstat'} eq 'define';
+    unless ($hasst) { print "1..0 # Skip: no sys/stat.h\n"; exit 0 }
+}
+
+BEGIN {
+    our @stat = stat "TEST"; # This is the function stat.
+    unless (@stat) { print "1..0 # Skip: no file TEST\n"; exit 0 }
+}
+
+print "1..14\n";
+
+use File::stat;
+
+print "ok 1\n";
+
+my $stat = stat "TEST"; # This is the OO stat.
+
+print "not " unless $stat->dev     == $stat[ 0];
+print "ok 2\n";
+
+print "not " unless $stat->ino     == $stat[ 1];
+print "ok 3\n";
+
+print "not " unless $stat->mode    == $stat[ 2];
+print "ok 4\n";
+
+print "not " unless $stat->nlink   == $stat[ 3];
+print "ok 5\n";
+
+print "not " unless $stat->uid     == $stat[ 4];
+print "ok 6\n";
+
+print "not " unless $stat->gid     == $stat[ 5];
+print "ok 7\n";
+
+print "not " unless $stat->rdev    == $stat[ 6];
+print "ok 8\n";
+
+print "not " unless $stat->size    == $stat[ 7];
+print "ok 9\n";
+
+print "not " unless $stat->atime   == $stat[ 8];
+print "ok 10\n";
+
+print "not " unless $stat->mtime   == $stat[ 9];
+print "ok 11\n";
+
+print "not " unless $stat->ctime   == $stat[10];
+print "ok 12\n";
+
+print "not " unless $stat->blksize == $stat[11];
+print "ok 13\n";
+
+print "not " unless $stat->blocks  == $stat[12];
+print "ok 14\n";
+
+# Testing pretty much anything else is unportable.

diff --git a/lib/FileCache.t b/lib/FileCache.t
new file mode 100755 (executable)
index 0000000..a97fdd5
--- /dev/null
+++ b/lib/FileCache.t
@@ -0,0 +1,25 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use FileCache;
+
+# This is really not a complete test as I don't bother to open enough
+# files to make real swapping of open filedescriptor happen.
+
+$path = "foo";
+cacheout $path;
+
+print $path "\n";
+
+close $path;
+
+print "not " unless -f $path;
+print "ok 1\n";
+
+unlink $path;

diff --git a/lib/FileHandle.t b/lib/FileHandle.t
new file mode 100755 (executable)
index 0000000..eaddf49
--- /dev/null
+++ b/lib/FileHandle.t
@@ -0,0 +1,91 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+       print "1..0\n";
+       exit 0;
+    }
+}
+
+use FileHandle;
+use strict subs;
+
+autoflush STDOUT 1;
+
+$mystdout = new_from_fd FileHandle 1,"w";
+$| = 1;
+autoflush $mystdout;
+print "1..11\n";
+
+print $mystdout "ok ".fileno($mystdout)."\n";
+
+$fh = (new FileHandle "./TEST", O_RDONLY
+       or new FileHandle "TEST", O_RDONLY)
+  and print "ok 2\n";
+
+
+$buffer = <$fh>;
+print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n";
+
+
+ungetc $fh ord 'A';
+CORE::read($fh, $buf,1);
+print $buf eq 'A' ? "ok 4\n" : "not ok 4\n";
+
+close $fh;
+
+$fh = new FileHandle;
+
+print "not " unless ($fh->open("< TEST") && <$fh> eq $buffer);
+print "ok 5\n";
+
+$fh->seek(0,0);
+print "#possible mixed CRLF/LF in t/TEST\nnot " unless (<$fh> eq $buffer);
+print "ok 6\n";
+
+$fh->seek(0,2);
+$line = <$fh>;
+print "not " if (defined($line) || !$fh->eof);
+print "ok 7\n";
+
+print "not " unless ($fh->open("TEST","r") && !$fh->tell && $fh->close);
+print "ok 8\n";
+
+autoflush STDOUT 0;
+
+print "not " if ($|);
+print "ok 9\n";
+
+autoflush STDOUT 1;
+
+print "not " unless ($|);
+print "ok 10\n";
+
+if ($^O eq 'dos')
+{
+    printf("ok %d\n",11);
+    exit(0);
+}
+
+($rd,$wr) = FileHandle::pipe;
+
+if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare' ||
+    $Config{d_fork} ne 'define') {
+  $wr->autoflush;
+  $wr->printf("ok %d\n",11);
+  print $rd->getline;
+}
+else {
+  if (fork) {
+   $wr->close;
+   print $rd->getline;
+  }
+  else {
+   $rd->close;
+   $wr->printf("ok %d\n",11);
+   exit(0);
+  }
+}

diff --git a/lib/Filter/Simple/test.pl b/lib/Filter/Simple/test.pl
new file mode 100644 (file)
index 0000000..3fb3270
--- /dev/null
+++ b/lib/Filter/Simple/test.pl
@@ -0,0 +1,27 @@
+#!./perl
+
+BEGIN {
+    chdir('t') if -d 't';    
+    @INC = 'lib';
+}
+
+print "1..6\n";
+
+use MyFilter qr/not ok/ => "ok", fail => "ok";
+
+sub fail { print "fail ", $_[0], "\n" }
+
+print "not ok 1\n";
+print "fail 2\n";
+
+fail(3);
+&fail(4);
+
+print "not " unless "whatnot okapi" eq "whatokapi";
+print "ok 5\n";
+
+no MyFilter;
+
+print "not " unless "not ok" =~ /^not /;
+print "ok 6\n";
+

diff --git a/lib/FindBin.t b/lib/FindBin.t
new file mode 100755 (executable)
index 0000000..d07ce75
--- /dev/null
+++ b/lib/FindBin.t
@@ -0,0 +1,15 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use FindBin qw($Bin);
+
+print "# $Bin\n";
+
+print "not " unless $Bin =~ m,[/.]lib\]?$,;
+print "ok 1\n";

diff --git a/lib/Getopt/Long/basic.t b/lib/Getopt/Long/basic.t
new file mode 100755 (executable)
index 0000000..c5d857d
--- /dev/null
+++ b/lib/Getopt/Long/basic.t
@@ -0,0 +1,26 @@
+#!./perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+use Getopt::Long qw(:config no_ignore_case);
+die("Getopt::Long version 2.24 required--this is only version ".
+    $Getopt::Long::VERSION)
+  unless $Getopt::Long::VERSION >= 2.24;
+
+print "1..9\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+undef $opt_baR;
+undef $opt_bar;
+print "ok 1\n" if GetOptions ("foo", "Foo=s");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");

diff --git a/lib/Getopt/Long/compat.t b/lib/Getopt/Long/compat.t
new file mode 100755 (executable)
index 0000000..0bbe386
--- /dev/null
+++ b/lib/Getopt/Long/compat.t
@@ -0,0 +1,25 @@
+#!./perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+require "newgetopt.pl";
+
+print "1..9\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+$newgetopt::ignorecase = 0;
+$newgetopt::ignorecase = 0;
+undef $opt_baR;
+undef $opt_bar;
+print "ok 1\n" if NGetOpt ("foo", "Foo=s");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");

diff --git a/lib/Getopt/Long/linkage.t b/lib/Getopt/Long/linkage.t
new file mode 100755 (executable)
index 0000000..3bd81a3
--- /dev/null
+++ b/lib/Getopt/Long/linkage.t
@@ -0,0 +1,37 @@
+#!./perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+use Getopt::Long;
+
+print "1..18\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+Getopt::Long::Configure ("no_ignore_case");
+%lnk = ();
+print "ok 1\n" if GetOptions (\%lnk, "foo", "Foo=s");
+print ((defined $lnk{foo})   ? "" : "not ", "ok 2\n");
+print (($lnk{foo} == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $lnk{Foo})   ? "" : "not ", "ok 4\n");
+print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)          ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 7\n");
+print (!(exists $lnk{baR})   ? "" : "not ", "ok 8\n");
+
+@ARGV = qw(-Foo -baR --foo bar);
+Getopt::Long::Configure ("default","no_ignore_case");
+%lnk = ();
+my $foo;
+print "ok 9\n" if GetOptions (\%lnk, "foo" => \$foo, "Foo=s");
+print ((defined $foo)        ? "" : "not ", "ok 10\n");
+print (($foo == 1)           ? "" : "not ", "ok 11\n");
+print ((defined $lnk{Foo})   ? "" : "not ", "ok 12\n");
+print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 13\n");
+print ((@ARGV == 1)          ? "" : "not ", "ok 14\n");
+print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 15\n");
+print (!(exists $lnk{foo})   ? "" : "not ", "ok 16\n");
+print (!(exists $lnk{baR})   ? "" : "not ", "ok 17\n");
+print (!(exists $lnk{bar})   ? "" : "not ", "ok 18\n");

diff --git a/lib/Getopt/Long/oo.t b/lib/Getopt/Long/oo.t
new file mode 100644 (file)
index 0000000..98f3eaa
--- /dev/null
+++ b/lib/Getopt/Long/oo.t
@@ -0,0 +1,26 @@
+#!./perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+use Getopt::Long;
+die("Getopt::Long version 2.24 required--this is only version ".
+    $Getopt::Long::VERSION)
+  unless $Getopt::Long::VERSION >= 2.24;
+print "1..9\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+my $p = new Getopt::Long::Parser (config => ["no_ignore_case"]);
+undef $opt_baR;
+undef $opt_bar;
+print "ok 1\n" if $p->getoptions ("foo", "Foo=s");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");

diff --git a/lib/Getopt/Std.t b/lib/Getopt/Std.t
new file mode 100755 (executable)
index 0000000..fb70f10
--- /dev/null
+++ b/lib/Getopt/Std.t
@@ -0,0 +1,73 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..11\n";
+
+use Getopt::Std;
+
+# First we test the getopt function
+@ARGV = qw(-xo -f foo -y file);
+getopt('f');
+
+print "not " if "@ARGV" ne 'file';
+print "ok 1\n";
+
+print "not " unless $opt_x && $opt_o && opt_y;
+print "ok 2\n";
+
+print "not " unless $opt_f eq 'foo';
+print "ok 3\n";
+
+
+# Then we try the getopts
+$opt_o = $opt_i = $opt_f = undef;
+@ARGV = qw(-foi -i file);
+getopts('oif:') or print "not ";
+print "ok 4\n";
+
+print "not " unless "@ARGV" eq 'file';
+print "ok 5\n";
+
+print "not " unless $opt_i and $opt_f eq 'oi';
+print "ok 6\n";
+
+print "not " if $opt_o;
+print "ok 7\n";
+
+# Try illegal options, but avoid printing of the error message
+
+open(STDERR, ">stderr") || die;
+
+@ARGV = qw(-h help);
+
+!getopts("xf:y") or print "not ";
+print "ok 8\n";
+
+
+# Then try the Getopt::Long module
+
+use Getopt::Long;
+
+@ARGV = qw(--help --file foo --foo --nobar --num=5 -- file);
+
+GetOptions(
+   'help'   => \$HELP,
+   'file:s' => \$FILE,
+   'foo!'   => \$FOO,
+   'bar!'   => \$BAR,
+   'num:i'  => \$NO,
+) || print "not ";
+print "ok 9\n";
+
+print "not " unless $HELP && $FOO && !$BAR && $FILE eq 'foo' && $NO == 5;
+print "ok 10\n";
+
+print "not " unless "@ARGV" eq "file";
+print "ok 11\n";
+
+close STDERR;
+unlink "stderr";

diff --git a/lib/I18N/Collate.t b/lib/I18N/Collate.t
new file mode 100644 (file)
index 0000000..bf3ba20
--- /dev/null
+++ b/lib/I18N/Collate.t
@@ -0,0 +1,44 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (!$Config{d_setlocale} || $Config{ccflags} =~ /\bD?NO_LOCALE\b/) {
+       print "1..0\n";
+       exit;
+    }
+}
+
+print "1..7\n";
+
+use I18N::Collate;
+
+print "ok 1\n";
+
+$a = I18N::Collate->new("foo");
+
+print "ok 2\n";
+
+{
+    use warnings;
+    local $SIG{__WARN__} = sub { $@ = $_[0] };
+    $b = I18N::Collate->new("foo");
+    print "not " unless $@ =~ /\bHAS BEEN DEPRECATED\b/;
+    print "ok 3\n";
+    $@ = '';
+}
+
+print "not " unless $a eq $b;
+print "ok 4\n";
+
+$b = I18N::Collate->new("bar");
+print "not " if $@ =~ /\bHAS BEEN DEPRECATED\b/;
+print "ok 5\n";
+
+print "not " if $a eq $b;
+print "ok 6\n";
+
+print "not " if $a lt $b == $a gt $b;
+print "ok 7\n";
+

diff --git a/lib/I18N/LangTags/test.pl b/lib/I18N/LangTags/test.pl
new file mode 100644 (file)
index 0000000..06c178e
--- /dev/null
+++ b/lib/I18N/LangTags/test.pl
@@ -0,0 +1,45 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+######################### We start with some black magic to print on failure.
+require 5;
+
+use strict;
+use Test;
+BEGIN { plan tests => 23 };
+BEGIN { ok 1 }
+use I18N::LangTags qw(is_language_tag same_language_tag
+                     extract_language_tags super_languages
+                     similarity_language_tag is_dialect_of
+                     locale2language_tag alternate_language_tags
+                     encode_language_tag
+                    );
+
+ok !is_language_tag('');
+ok  is_language_tag('fr');
+ok  is_language_tag('fr-ca');
+ok  is_language_tag('fr-CA');
+ok !is_language_tag('fr-CA-');
+ok !is_language_tag('fr_CA');
+ok  is_language_tag('fr-ca-joual');
+ok !is_language_tag('frca');
+ok  is_language_tag('nav');
+ok  is_language_tag('nav-shiprock');
+ok !is_language_tag('nav-ceremonial'); # subtag too long
+ok !is_language_tag('x');
+ok !is_language_tag('i');
+ok  is_language_tag('i-borg'); # NB: fictitious tag
+ok  is_language_tag('x-borg');
+ok  is_language_tag('x-borg-prot5123');
+ok  same_language_tag('x-borg-prot5123', 'i-BORG-Prot5123' );
+ok !same_language_tag('en', 'en-us' );
+
+ok 0 == similarity_language_tag('en-ca', 'fr-ca');
+ok 1 == similarity_language_tag('en-ca', 'en-us');
+ok 2 == similarity_language_tag('en-us-southern', 'en-us-western');
+ok 2 == similarity_language_tag('en-us-southern', 'en-us');
+
+# print "So there!\n";
+

diff --git a/lib/IPC/Open2.t b/lib/IPC/Open2.t
new file mode 100644 (file)
index 0000000..fe49189
--- /dev/null
+++ b/lib/IPC/Open2.t
@@ -0,0 +1,59 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (!$Config{'d_fork'}
+       # open2/3 supported on win32 (but not Borland due to CRT bugs)
+       && (($^O ne 'MSWin32' && $^O ne 'NetWare') || $Config{'cc'} =~ /^bcc/i))
+    {
+       print "1..0\n";
+       exit 0;
+    }
+    # make warnings fatal
+    $SIG{__WARN__} = sub { die @_ };
+}
+
+use strict;
+use IO::Handle;
+use IPC::Open2;
+#require 'open2.pl'; use subs 'open2';
+
+my $perl = './perl';
+
+sub ok {
+    my ($n, $result, $info) = @_;
+    if ($result) {
+       print "ok $n\n";
+    }
+    else {
+       print "not ok $n\n";
+       print "# $info\n" if $info;
+    }
+}
+
+sub cmd_line {
+       if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
+               return qq/"$_[0]"/;
+       }
+       else {
+               return $_[0];
+       }
+}
+
+my ($pid, $reaped_pid);
+STDOUT->autoflush;
+STDERR->autoflush;
+
+print "1..7\n";
+
+ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e',
+       cmd_line('print scalar <STDIN>');
+ok 2, print WRITE "hi kid\n";
+ok 3, <READ> =~ /^hi kid\r?\n$/;
+ok 4, close(WRITE), $!;
+ok 5, close(READ), $!;
+$reaped_pid = waitpid $pid, 0;
+ok 6, $reaped_pid == $pid, $reaped_pid;
+ok 7, $? == 0, $?;

diff --git a/lib/IPC/Open3.t b/lib/IPC/Open3.t
new file mode 100644 (file)
index 0000000..7d2d411
--- /dev/null
+++ b/lib/IPC/Open3.t
@@ -0,0 +1,150 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (!$Config{'d_fork'}
+       # open2/3 supported on win32 (but not Borland due to CRT bugs)
+       && (($^O ne 'MSWin32' && $^O ne 'NetWare') || $Config{'cc'} =~ /^bcc/i))
+    {
+       print "1..0\n";
+       exit 0;
+    }
+    # make warnings fatal
+    $SIG{__WARN__} = sub { die @_ };
+}
+
+use strict;
+use IO::Handle;
+use IPC::Open3;
+#require 'open3.pl'; use subs 'open3';
+
+my $perl = $^X;
+
+sub ok {
+    my ($n, $result, $info) = @_;
+    if ($result) {
+       print "ok $n\n";
+    }
+    else {
+       print "not ok $n\n";
+       print "# $info\n" if $info;
+    }
+}
+
+sub cmd_line {
+       if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
+               my $cmd = shift;
+               $cmd =~ tr/\r\n//d;
+               $cmd =~ s/"/\\"/g;
+               return qq/"$cmd"/;
+       }
+       else {
+               return $_[0];
+       }
+}
+
+my ($pid, $reaped_pid);
+STDOUT->autoflush;
+STDERR->autoflush;
+
+print "1..22\n";
+
+# basic
+ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF');
+    $| = 1;
+    print scalar <STDIN>;
+    print STDERR "hi error\n";
+EOF
+ok 2, print WRITE "hi kid\n";
+ok 3, <READ> =~ /^hi kid\r?\n$/;
+ok 4, <ERROR> =~ /^hi error\r?\n$/;
+ok 5, close(WRITE), $!;
+ok 6, close(READ), $!;
+ok 7, close(ERROR), $!;
+$reaped_pid = waitpid $pid, 0;
+ok 8, $reaped_pid == $pid, $reaped_pid;
+ok 9, $? == 0, $?;
+
+# read and error together, both named
+$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', cmd_line(<<'EOF');
+    $| = 1;
+    print scalar <STDIN>;
+    print STDERR scalar <STDIN>;
+EOF
+print WRITE "ok 10\n";
+print scalar <READ>;
+print WRITE "ok 11\n";
+print scalar <READ>;
+waitpid $pid, 0;
+
+# read and error together, error empty
+$pid = open3 'WRITE', 'READ', '', $perl, '-e', cmd_line(<<'EOF');
+    $| = 1;
+    print scalar <STDIN>;
+    print STDERR scalar <STDIN>;
+EOF
+print WRITE "ok 12\n";
+print scalar <READ>;
+print WRITE "ok 13\n";
+print scalar <READ>;
+waitpid $pid, 0;
+
+# dup writer
+ok 14, pipe PIPE_READ, PIPE_WRITE;
+$pid = open3 '<&PIPE_READ', 'READ', '',
+                   $perl, '-e', cmd_line('print scalar <STDIN>');
+close PIPE_READ;
+print PIPE_WRITE "ok 15\n";
+close PIPE_WRITE;
+print scalar <READ>;
+waitpid $pid, 0;
+
+# dup reader
+$pid = open3 'WRITE', '>&STDOUT', 'ERROR',
+                   $perl, '-e', cmd_line('print scalar <STDIN>');
+print WRITE "ok 16\n";
+waitpid $pid, 0;
+
+# dup error:  This particular case, duping stderr onto the existing
+# stdout but putting stdout somewhere else, is a good case because it
+# used not to work.
+$pid = open3 'WRITE', 'READ', '>&STDOUT',
+                   $perl, '-e', cmd_line('print STDERR scalar <STDIN>');
+print WRITE "ok 17\n";
+waitpid $pid, 0;
+
+# dup reader and error together, both named
+$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', cmd_line(<<'EOF');
+    $| = 1;
+    print STDOUT scalar <STDIN>;
+    print STDERR scalar <STDIN>;
+EOF
+print WRITE "ok 18\n";
+print WRITE "ok 19\n";
+waitpid $pid, 0;
+
+# dup reader and error together, error empty
+$pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', cmd_line(<<'EOF');
+    $| = 1;
+    print STDOUT scalar <STDIN>;
+    print STDERR scalar <STDIN>;
+EOF
+print WRITE "ok 20\n";
+print WRITE "ok 21\n";
+waitpid $pid, 0;
+
+# command line in single parameter variant of open3
+# for understanding of Config{'sh'} test see exec description in camel book
+my $cmd = 'print(scalar(<STDIN>))';
+$cmd = $Config{'sh'} =~ /sh/ ? "'$cmd'" : cmd_line($cmd);
+eval{$pid = open3 'WRITE', '>&STDOUT', 'ERROR', "$perl -e " . $cmd; };
+if ($@) {
+       print "error $@\n";
+       print "not ok 22\n";
+}
+else {
+       print WRITE "ok 22\n";
+       waitpid $pid, 0;
+}        

diff --git a/lib/IPC/SysV.t b/lib/IPC/SysV.t
new file mode 100755 (executable)
index 0000000..795ad5d
--- /dev/null
+++ b/lib/IPC/SysV.t
@@ -0,0 +1,218 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+
+    @INC = '../lib';
+
+    require Config; import Config;
+
+    my $reason;
+
+    if ($Config{'extensions'} !~ /\bIPC\/SysV\b/) {
+      $reason = 'IPC::SysV was not built';
+    } elsif ($Config{'d_sem'} ne 'define') {
+      $reason = '$Config{d_sem} undefined';
+    } elsif ($Config{'d_msg'} ne 'define') {
+      $reason = '$Config{d_msg} undefined';
+    }
+    if ($reason) {
+       print "1..0 # Skip: $reason\n";
+       exit 0;
+    }
+}
+
+# These constants are common to all tests.
+# Later the sem* tests will import more for themselves.
+
+use IPC::SysV qw(IPC_PRIVATE IPC_NOWAIT IPC_STAT IPC_RMID S_IRWXU);
+use strict;
+
+print "1..16\n";
+
+my $msg;
+my $sem;
+
+$SIG{__DIE__} = 'cleanup'; # will cleanup $msg and $sem if needed
+
+# FreeBSD is known to throw this if there's no SysV IPC in the kernel.
+$SIG{SYS} = sub {
+    print STDERR <<EOM;
+SIGSYS caught.
+It may be that your kernel does not have SysV IPC configured.
+
+EOM
+    if ($^O eq 'freebsd') {
+       print STDERR <<EOM;
+You must have following options in your kernel:
+
+options         SYSVSHM
+options         SYSVSEM
+options         SYSVMSG
+
+See config(8).
+EOM
+    }
+    exit(1);
+};
+
+my $perm = S_IRWXU;
+
+if ($Config{'d_msgget'} eq 'define' &&
+    $Config{'d_msgctl'} eq 'define' &&
+    $Config{'d_msgsnd'} eq 'define' &&
+    $Config{'d_msgrcv'} eq 'define') {
+
+    $msg = msgget(IPC_PRIVATE, $perm);
+    # Very first time called after machine is booted value may be 0 
+    die "msgget failed: $!\n" unless defined($msg) && $msg >= 0;
+
+    print "ok 1\n";
+
+    #Putting a message on the queue
+    my $msgtype = 1;
+    my $msgtext = "hello";
+
+    my $test2bad;
+    my $test5bad;
+    my $test6bad;
+
+    unless (msgsnd($msg,pack("L! a*",$msgtype,$msgtext),IPC_NOWAIT)) {
+       print "not ";
+       $test2bad = 1;
+    }
+    print "ok 2\n";
+    if ($test2bad) {
+       print <<EOM;
+#
+# The failure of the subtest #2 may indicate that the message queue
+# resource limits either of the system or of the testing account
+# have been reached.  Error message "Operating would block" is
+# usually indicative of this situation.  The error message was now:
+# "$!"
+#
+# You can check the message queues with the 'ipcs' command and
+# you can remove unneeded queues with the 'ipcrm -q id' command.
+# You may also consider configuring your system or account
+# to have more message queue resources.
+#
+# Because of the subtest #2 failing also the substests #5 and #6 will
+# very probably also fail.
+#
+EOM
+    }
+
+    my $data;
+    msgctl($msg,IPC_STAT,$data) or print "not ";
+    print "ok 3\n";
+
+    print "not " unless length($data);
+    print "ok 4\n";
+
+    my $msgbuf;
+    unless (msgrcv($msg,$msgbuf,256,0,IPC_NOWAIT)) {
+       print "not ";
+       $test5bad = 1;
+    }
+    print "ok 5\n";
+    if ($test5bad && $test2bad) {
+       print <<EOM;
+#
+# This failure was to be expected because the subtest #2 failed.
+#
+EOM
+    }
+
+    my($rmsgtype,$rmsgtext);
+    ($rmsgtype,$rmsgtext) = unpack("L! a*",$msgbuf);
+    unless ($rmsgtype == $msgtype && $rmsgtext eq $msgtext) {
+       print "not ";
+       $test6bad = 1;
+    }
+    print "ok 6\n";
+    if ($test6bad && $test2bad) {
+       print <<EOM;
+#
+# This failure was to be expected because the subtest #2 failed.
+#
+EOM
+     }
+} else {
+    for (1..6) {
+       print "ok $_\n"; # fake it
+    }
+}
+
+if($Config{'d_semget'} eq 'define' &&
+   $Config{'d_semctl'} eq 'define') {
+
+    if ($Config{'d_semctl_semid_ds'} eq 'define' ||
+       $Config{'d_semctl_semun'}    eq 'define') {
+
+       use IPC::SysV qw(IPC_CREAT GETALL SETALL);
+
+       $sem = semget(IPC_PRIVATE, 10, $perm | IPC_CREAT);
+       # Very first time called after machine is booted value may be 0 
+       die "semget: $!\n" unless defined($sem) && $sem >= 0;
+
+       print "ok 7\n";
+
+       my $data;
+       semctl($sem,0,IPC_STAT,$data) or print "not ";
+       print "ok 8\n";
+       
+       print "not " unless length($data);
+       print "ok 9\n";
+
+       my $nsem = 10;
+
+       semctl($sem,0,SETALL,pack("s!*",(0) x $nsem)) or print "not ";
+       print "ok 10\n";
+
+       $data = "";
+       semctl($sem,0,GETALL,$data) or print "not ";
+       print "ok 11\n";
+
+       print "not " unless length($data) == length(pack("s!*",(0) x $nsem));
+       print "ok 12\n";
+
+       my @data = unpack("s!*",$data);
+
+       my $adata = "0" x $nsem;
+
+       print "not " unless @data == $nsem and join("",@data) eq $adata;
+       print "ok 13\n";
+
+       my $poke = 2;
+
+       $data[$poke] = 1;
+       semctl($sem,0,SETALL,pack("s!*",@data)) or print "not ";
+       print "ok 14\n";
+    
+       $data = "";
+       semctl($sem,0,GETALL,$data) or print "not ";
+       print "ok 15\n";
+
+       @data = unpack("s!*",$data);
+
+       my $bdata = "0" x $poke . "1" . "0" x ($nsem-$poke-1);
+
+       print "not " unless join("",@data) eq $bdata;
+       print "ok 16\n";
+    } else {
+       for (7..16) {
+           print "ok $_ # skipped, no semctl possible\n";
+       }
+    }
+} else {
+    for (7..16) {
+       print "ok $_\n"; # fake it
+    }
+}
+
+sub cleanup {
+    msgctl($msg,IPC_RMID,0)       if defined $msg;
+    semctl($sem,0,IPC_RMID,undef) if defined $sem;
+}
+
+cleanup;

diff --git a/lib/Locale/Codes/t/all.t b/lib/Locale/Codes/t/all.t
new file mode 100644 (file)
index 0000000..ed93c5a
--- /dev/null
+++ b/lib/Locale/Codes/t/all.t
@@ -0,0 +1,366 @@
+#!./perl
+#
+# all.t - tests for all_* routines in
+#      Locale::Country
+#      Locale::Language
+#      Locale::Currency
+#
+# There are four tests. We get a list of all codes, convert to
+# language/country/currency, # convert back to code,
+# and check that they're the same. Then we do the same,
+# starting with list of languages/countries/currencies.
+#
+
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use Locale::Country;
+use Locale::Language;
+use Locale::Currency;
+
+print "1..12\n";
+
+my $code;
+my $language;
+my $country;
+my $ok;
+my $reverse;
+my $currency;
+
+
+#-----------------------------------------------------------------------
+# Old API - without codeset specified, default to ALPHA_2
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $code (all_country_codes())
+{
+    $country = code2country($code);
+    if (!defined $country)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = country2code($country);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $code)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 1\n" : "not ok 1\n");
+
+#-----------------------------------------------------------------------
+# code to country, back to code, for ALPHA2
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $code (all_country_codes(LOCALE_CODE_ALPHA_2))
+{
+    $country = code2country($code, LOCALE_CODE_ALPHA_2);
+    if (!defined $country)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = country2code($country, LOCALE_CODE_ALPHA_2);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $code)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 2\n" : "not ok 2\n");
+
+#-----------------------------------------------------------------------
+# code to country, back to code, for ALPHA3
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $code (all_country_codes(LOCALE_CODE_ALPHA_3))
+{
+    $country = code2country($code, LOCALE_CODE_ALPHA_3);
+    if (!defined $country)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = country2code($country, LOCALE_CODE_ALPHA_3);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $code)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 3\n" : "not ok 3\n");
+
+#-----------------------------------------------------------------------
+# code to country, back to code, for NUMERIC
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $code (all_country_codes(LOCALE_CODE_NUMERIC))
+{
+    $country = code2country($code, LOCALE_CODE_NUMERIC);
+    if (!defined $country)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = country2code($country, LOCALE_CODE_NUMERIC);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $code)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 4\n" : "not ok 4\n");
+
+
+#-----------------------------------------------------------------------
+# Old API - country to code, back to country, using default of ALPHA_2
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $country (all_country_names())
+{
+    $code = country2code($country);
+    if (!defined $code)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = code2country($code);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $country)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 5\n" : "not ok 5\n");
+
+#-----------------------------------------------------------------------
+# country to code, back to country, using LOCALE_CODE_ALPHA_2
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $country (all_country_names())
+{
+    $code = country2code($country, LOCALE_CODE_ALPHA_2);
+    if (!defined $code)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = code2country($code, LOCALE_CODE_ALPHA_2);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $country)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 6\n" : "not ok 6\n");
+
+#-----------------------------------------------------------------------
+# country to code, back to country, using LOCALE_CODE_ALPHA_3
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $country (all_country_names())
+{
+    $code = country2code($country, LOCALE_CODE_ALPHA_3);
+    if (!defined $code)
+    {
+       next if ($country eq 'Antarctica'
+                || $country eq 'Bouvet Island'
+                || $country eq 'Cocos (Keeling) Islands'
+                || $country eq 'Christmas Island'
+                || $country eq 'France, Metropolitan'
+                || $country eq 'South Georgia and the South Sandwich Islands'
+                || $country eq 'Heard Island and McDonald Islands'
+                || $country eq 'British Indian Ocean Territory'
+                || $country eq 'French Southern Territories'
+                || $country eq 'United States Minor Outlying Islands'
+                || $country eq 'Mayotte'
+                || $country eq 'Zaire');
+        $ok = 0;
+        last;
+    }
+    $reverse = code2country($code, LOCALE_CODE_ALPHA_3);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $country)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 7\n" : "not ok 7\n");
+
+#-----------------------------------------------------------------------
+# country to code, back to country, using LOCALE_CODE_NUMERIC
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $country (all_country_names())
+{
+    $code = country2code($country, LOCALE_CODE_NUMERIC);
+    if (!defined $code)
+    {
+       next if ($country eq 'Antarctica'
+                || $country eq 'Bouvet Island'
+                || $country eq 'Cocos (Keeling) Islands'
+                || $country eq 'Christmas Island'
+                || $country eq 'France, Metropolitan'
+                || $country eq 'South Georgia and the South Sandwich Islands'
+                || $country eq 'Heard Island and McDonald Islands'
+                || $country eq 'British Indian Ocean Territory'
+                || $country eq 'French Southern Territories'
+                || $country eq 'United States Minor Outlying Islands'
+                || $country eq 'Mayotte'
+                || $country eq 'Zaire');
+        $ok = 0;
+        last;
+    }
+    $reverse = code2country($code, LOCALE_CODE_NUMERIC);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $country)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+
+$ok = 1;
+foreach $code (all_language_codes())
+{
+    $language = code2language($code);
+    if (!defined $language)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = language2code($language);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $code)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 9\n" : "not ok 9\n");
+
+
+$ok = 1;
+foreach $language (all_language_names())
+{
+    $code = language2code($language);
+    if (!defined $code)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = code2language($code);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $language)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 10\n" : "not ok 10\n");
+
+$ok = 1;
+foreach $code (all_currency_codes())
+{
+    $currency = code2currency($code);
+    if (!defined $currency)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = currency2code($currency);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    #
+    # three special cases:
+    #  The Kwacha has two codes - used in Zambia and Malawi
+    #  The Russian Ruble has two codes - rub and rur
+    #  The Belarussian Ruble has two codes - byb and byr
+    if ($reverse ne $code
+       && $code ne 'mwk' && $code ne 'zmk'
+       && $code ne 'byr' && $code ne 'byb'
+       && $code ne 'rub' && $code ne 'rur')
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 11\n" : "not ok 11\n");
+
+$ok = 1;
+foreach $currency (all_currency_names())
+{
+    $code = currency2code($currency);
+    if (!defined $code)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = code2currency($code);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $currency)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 12\n" : "not ok 12\n");

diff --git a/lib/Locale/Codes/t/constants.t b/lib/Locale/Codes/t/constants.t
new file mode 100644 (file)
index 0000000..359cdfc
--- /dev/null
+++ b/lib/Locale/Codes/t/constants.t
@@ -0,0 +1,49 @@
+#!./perl
+#
+# constants.t - tests for Locale::Constants
+#
+
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use Locale::Constants;
+
+print "1..3\n";
+
+if (defined LOCALE_CODE_ALPHA_2
+    && defined LOCALE_CODE_ALPHA_3
+    && defined LOCALE_CODE_NUMERIC)
+{
+    print "ok 1\n";
+}
+else
+{
+    print "not ok 1\n";
+}
+
+if (LOCALE_CODE_ALPHA_2 != LOCALE_CODE_ALPHA_3
+    && LOCALE_CODE_ALPHA_2 != LOCALE_CODE_NUMERIC
+    && LOCALE_CODE_ALPHA_3 != LOCALE_CODE_NUMERIC)
+{
+    print "ok 2\n";
+}
+else
+{
+    print "not ok 2\n";
+}
+
+if (defined LOCALE_CODE_DEFAULT
+    && (LOCALE_CODE_DEFAULT == LOCALE_CODE_ALPHA_2
+       || LOCALE_CODE_DEFAULT == LOCALE_CODE_ALPHA_3
+       || LOCALE_CODE_DEFAULT == LOCALE_CODE_NUMERIC))
+{
+    print "ok 3\n";
+}
+else
+{
+    print "not ok 3\n";
+}
+
+exit 0;

diff --git a/lib/Locale/Codes/t/country.t b/lib/Locale/Codes/t/country.t
new file mode 100644 (file)
index 0000000..4234d1e
--- /dev/null
+++ b/lib/Locale/Codes/t/country.t
@@ -0,0 +1,114 @@
+#!./perl
+#
+# country.t - tests for Locale::Country
+#
+
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use Locale::Country;
+
+#-----------------------------------------------------------------------
+# This is an array of tests specs. Each spec is [TEST, OK_TO_DIE]
+# Each TEST is eval'd as an expression.
+# If it evaluates to FALSE, then "not ok N" is printed for the test,
+# otherwise "ok N". If the eval dies, then the OK_TO_DIE flag is checked.
+# If it is true (1), the test is treated as passing, otherwise it failed.
+#-----------------------------------------------------------------------
+@TESTS =
+(
+       #================================================
+       # TESTS FOR code2country
+       #================================================
+
+ #---- selection of examples which should all result in undef -----------
+ ['!defined code2country()', 0],                  # no argument
+ ['!defined code2country(undef)', 0],             # undef argument
+ ['!defined code2country("zz")', 0],              # illegal code
+ ['!defined code2country("zz", LOCALE_CODE_ALPHA_2)', 0],        # illegal code
+ ['!defined code2country("zz", LOCALE_CODE_ALPHA_3)', 0],        # illegal code
+ ['!defined code2country("zz", LOCALE_CODE_NUMERIC)', 0],        # illegal code
+ ['!defined code2country("ja")', 0],              # should be jp for country
+ ['!defined code2country("uk")', 0],              # should be jp for country
+
+ #---- some successful examples -----------------------------------------
+ ['code2country("BO") eq "Bolivia"', 0],
+ ['code2country("BO", LOCALE_CODE_ALPHA_2) eq "Bolivia"', 0],
+ ['code2country("bol", LOCALE_CODE_ALPHA_3) eq "Bolivia"', 0],
+ ['code2country("pk") eq "Pakistan"', 0],
+ ['code2country("sn") eq "Senegal"', 0],
+ ['code2country("us") eq "United States"', 0],
+ ['code2country("ad") eq "Andorra"', 0],          # first in DATA segment
+ ['code2country("ad", LOCALE_CODE_ALPHA_2) eq "Andorra"', 0],
+ ['code2country("and", LOCALE_CODE_ALPHA_3) eq "Andorra"', 0],
+ ['code2country("020", LOCALE_CODE_NUMERIC) eq "Andorra"', 0],
+ ['code2country(48, LOCALE_CODE_NUMERIC) eq "Bahrain"', 0],
+ ['code2country("zw") eq "Zimbabwe"', 0],         # last in DATA segment
+ ['code2country("gb") eq "United Kingdom"', 0],   # United Kingdom is "gb", not "uk"
+
+       #================================================
+       # TESTS FOR country2code
+       #================================================
+
+ #---- selection of examples which should all result in undef -----------
+ ['!defined code2country("BO", LOCALE_CODE_ALPHA_3)', 0],
+ ['!defined code2country("BO", LOCALE_CODE_NUMERIC)', 0],
+ ['!defined country2code()', 0],                  # no argument
+ ['!defined country2code(undef)', 0],             # undef argument
+ ['!defined country2code("Banana")', 0],          # illegal country name
+
+ #---- some successful examples -----------------------------------------
+ ['country2code("japan")          eq "jp"', 0],
+ ['country2code("japan")          ne "ja"', 0],
+ ['country2code("Japan")          eq "jp"', 0],
+ ['country2code("United States")  eq "us"', 0],
+ ['country2code("United Kingdom") eq "gb"', 0],
+ ['country2code("Andorra")        eq "ad"', 0],    # first in DATA segment
+ ['country2code("Zimbabwe")       eq "zw"', 0],    # last in DATA segment
+
+       #================================================
+       # TESTS FOR country_code2code
+       #================================================
+
+ #---- selection of examples which should all result in undef -----------
+ ['!defined country_code2code("bo", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_3)', 0],
+ ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3)', 0],
+ ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_3)', 0],
+ ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_2)', 1],
+ ['!defined country_code2code("bo", LOCALE_CODE_ALPHA_2)', 1],
+ ['!defined country_code2code()', 1],                  # no argument
+ ['!defined country_code2code(undef)', 1],             # undef argument
+
+ #---- some successful examples -----------------------------------------
+ ['country_code2code("BO", LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3) eq "bol"', 0],
+ ['country_code2code("bol", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2) eq "bo"', 0],
+ ['country_code2code("zwe", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2) eq "zw"', 0],
+ ['country_code2code("858", LOCALE_CODE_NUMERIC, LOCALE_CODE_ALPHA_3) eq "ury"', 0],
+ ['country_code2code(858, LOCALE_CODE_NUMERIC, LOCALE_CODE_ALPHA_3) eq "ury"', 0],
+ ['country_code2code("tr", LOCALE_CODE_ALPHA_2, LOCALE_CODE_NUMERIC) eq "792"', 0],
+
+);
+
+print "1..", int(@TESTS), "\n";
+
+$testid = 1;
+foreach $test (@TESTS)
+{
+    eval "print (($test->[0]) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
+    if ($@)
+    {
+       if (!$test->[1])
+       {
+           print "not ok $testid\n";
+       }
+       else
+       {
+           print "ok $testid\n";
+       }
+    }
+    ++$testid;
+}
+
+exit 0;

diff --git a/lib/Locale/Codes/t/currency.t b/lib/Locale/Codes/t/currency.t
new file mode 100644 (file)
index 0000000..55a04db
--- /dev/null
+++ b/lib/Locale/Codes/t/currency.t
@@ -0,0 +1,85 @@
+#!./perl
+#
+# currency.t - tests for Locale::Currency
+#
+
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use Locale::Currency;
+
+#-----------------------------------------------------------------------
+# This is an array of tests. Each test is eval'd as an expression.
+# If it evaluates to FALSE, then "not ok N" is printed for the test,
+# otherwise "ok N".
+#-----------------------------------------------------------------------
+@TESTS =
+(
+       #================================================
+       # TESTS FOR code2currency
+       #================================================
+
+ #---- selection of examples which should all result in undef -----------
+ '!defined code2currency()',                 # no argument => undef returned
+ '!defined code2currency(undef)',            # undef arg   => undef returned
+ '!defined code2currency("zz")',             # illegal code => undef
+ '!defined code2currency("zzzz")',           # illegal code => undef
+ '!defined code2currency("zzz")',            # illegal code => undef
+ '!defined code2currency("ukp")',            # gbp for sterling, not ukp
+
+ #---- misc tests -------------------------------------------------------
+ 'code2currency("all") eq "Lek"',
+ 'code2currency("ats") eq "Schilling"',
+ 'code2currency("bob") eq "Boliviano"',
+ 'code2currency("bnd") eq "Brunei Dollar"',
+ 'code2currency("cop") eq "Colombian Peso"',
+ 'code2currency("dkk") eq "Danish Krone"',
+ 'code2currency("fjd") eq "Fiji Dollar"',
+ 'code2currency("idr") eq "Rupiah"',
+ 'code2currency("chf") eq "Swiss Franc"',
+ 'code2currency("mvr") eq "Rufiyaa"',
+ 'code2currency("mmk") eq "Kyat"',
+ 'code2currency("mwk") eq "Kwacha"',   # two different codes for Kwacha
+ 'code2currency("zmk") eq "Kwacha"',    # used in Zambia and Malawi
+ 'code2currency("byr") eq "Belarussian Ruble"',        # 2 codes for belarussian ruble
+ 'code2currency("byb") eq "Belarussian Ruble"', #
+ 'code2currency("rub") eq "Russian Ruble"',    # 2 codes for russian ruble
+ 'code2currency("rur") eq "Russian Ruble"',     #
+
+ #---- some successful examples -----------------------------------------
+ 'code2currency("BOB") eq "Boliviano"',
+ 'code2currency("adp") eq "Andorran Peseta"',  # first in DATA segment
+ 'code2currency("zwd") eq "Zimbabwe Dollar"',  # last in DATA segment
+
+       #================================================
+       # TESTS FOR currency2code
+       #================================================
+
+ #---- selection of examples which should all result in undef -----------
+ '!defined currency2code()',                 # no argument => undef returned
+ '!defined currency2code(undef)',            # undef arg   => undef returned
+ '!defined currency2code("")',               # empty string => undef returned
+ '!defined currency2code("Banana")',         # illegal curr name => undef
+
+ #---- some successful examples -----------------------------------------
+ 'currency2code("Kroon")           eq "eek"',
+ 'currency2code("Markka")         eq "fim"',
+ 'currency2code("Riel")            eq "khr"',
+ 'currency2code("PULA")            eq "bwp"',
+ 'currency2code("Andorran Peseta") eq "adp"',       # first in DATA segment
+ 'currency2code("Zimbabwe Dollar") eq "zwd"',       # last in DATA segment
+);
+
+print "1..", int(@TESTS), "\n";
+
+$testid = 1;
+foreach $test (@TESTS)
+{
+    eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
+    print "not ok $testid\n" if $@;
+    ++$testid;
+}
+
+exit 0;

diff --git a/lib/Locale/Codes/t/languages.t b/lib/Locale/Codes/t/languages.t
new file mode 100644 (file)
index 0000000..9facd35
--- /dev/null
+++ b/lib/Locale/Codes/t/languages.t
@@ -0,0 +1,110 @@
+#!./perl
+#
+# language.t - tests for Locale::Language
+#
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+}
+
+use Locale::Language;
+
+no utf8; # so that the naked 8-bit characters won't gripe under use utf8
+
+#-----------------------------------------------------------------------
+# This is an array of tests. Each test is eval'd as an expression.
+# If it evaluates to FALSE, then "not ok N" is printed for the test,
+# otherwise "ok N".
+#-----------------------------------------------------------------------
+@TESTS =
+(
+       #================================================
+       # TESTS FOR code2language
+       #================================================
+
+ #---- selection of examples which should all result in undef -----------
+ '!defined code2language()',                 # no argument => undef returned
+ '!defined code2language(undef)',            # undef arg   => undef returned
+ '!defined code2language("zz")',             # illegal code => undef
+ '!defined code2language("jp")',             # ja for lang, jp for country
+
+ #---- test recent changes ----------------------------------------------
+ 'code2language("ae") eq "Avestan"',
+ 'code2language("bs") eq "Bosnian"',
+ 'code2language("ch") eq "Chamorro"',
+ 'code2language("ce") eq "Chechen"',
+ 'code2language("cu") eq "Church Slavic"',
+ 'code2language("cv") eq "Chuvash"',
+ 'code2language("hz") eq "Herero"',
+ 'code2language("ho") eq "Hiri Motu"',
+ 'code2language("ki") eq "Kikuyu"',
+ 'code2language("kj") eq "Kuanyama"',
+ 'code2language("kv") eq "Komi"',
+ 'code2language("mh") eq "Marshall"',
+ 'code2language("nv") eq "Navajo"',
+ 'code2language("nr") eq "Ndebele, South"',
+ 'code2language("nd") eq "Ndebele, North"',
+ 'code2language("ng") eq "Ndonga"',
+ 'code2language("nn") eq "Norwegian Nynorsk"',
+ 'code2language("nb") eq "Norwegian Bokmål"',
+ 'code2language("ny") eq "Chichewa; Nyanja"',
+ 'code2language("oc") eq "Occitan (post 1500)"',
+ 'code2language("os") eq "Ossetian; Ossetic"',
+ 'code2language("pi") eq "Pali"',
+ '!defined code2language("sh")',             # Serbo-Croatian withdrawn
+ 'code2language("se") eq "Sami"',
+ 'code2language("sc") eq "Sardinian"',
+ 'code2language("kw") eq "Cornish"',
+ 'code2language("gv") eq "Manx"',
+ 'code2language("lb") eq "Letzeburgesch"',
+ 'code2language("he") eq "Hebrew"',
+ '!defined code2language("iw")',             # Hebrew withdrawn
+ 'code2language("id") eq "Indonesian"',
+ '!defined code2language("in")',             # Indonesian withdrawn
+ 'code2language("iu") eq "Inuktitut"',
+ 'code2language("ug") eq "Uighur"',
+ '!defined code2language("ji")',             # Yiddish withdrawn
+ 'code2language("yi") eq "Yiddish"',
+ 'code2language("za") eq "Zhuang"',
+
+ #---- some successful examples -----------------------------------------
+ 'code2language("DA") eq "Danish"',
+ 'code2language("eo") eq "Esperanto"',
+ 'code2language("fi") eq "Finnish"',
+ 'code2language("en") eq "English"',
+ 'code2language("aa") eq "Afar"',            # first in DATA segment
+ 'code2language("zu") eq "Zulu"',            # last in DATA segment
+
+       #================================================
+       # TESTS FOR language2code
+       #================================================
+
+ #---- selection of examples which should all result in undef -----------
+ '!defined language2code()',                 # no argument => undef returned
+ '!defined language2code(undef)',            # undef arg   => undef returned
+ '!defined language2code("Banana")',         # illegal lang name => undef
+
+ #---- some successful examples -----------------------------------------
+ 'language2code("Japanese")  eq "ja"',
+ 'language2code("japanese")  eq "ja"',
+ 'language2code("japanese")  ne "jp"',
+ 'language2code("French")    eq "fr"',
+ 'language2code("Greek")     eq "el"',
+ 'language2code("english")   eq "en"',
+ 'language2code("ESTONIAN")  eq "et"',
+ 'language2code("Afar")      eq "aa"',       # first in DATA segment
+ 'language2code("Zulu")      eq "zu"',       # last in DATA segment
+);
+
+print "1..", int(@TESTS), "\n";
+
+$testid = 1;
+foreach $test (@TESTS)
+{
+    eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
+    print "not ok $testid\n" if $@;
+    ++$testid;
+}
+
+exit 0;

diff --git a/lib/Locale/Codes/t/uk.t b/lib/Locale/Codes/t/uk.t
new file mode 100644 (file)
index 0000000..948e2d1
--- /dev/null
+++ b/lib/Locale/Codes/t/uk.t
@@ -0,0 +1,70 @@
+#!./perl
+#
+# uk.t - tests for Locale::Country with "uk" aliases to "gb"
+#
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+}
+
+use Locale::Country;
+
+Locale::Country::_alias_code('uk' => 'gb');
+
+#-----------------------------------------------------------------------
+# This is an array of tests. Each test is eval'd as an expression.
+# If it evaluates to FALSE, then "not ok N" is printed for the test,
+# otherwise "ok N".
+#-----------------------------------------------------------------------
+@TESTS =
+(
+       #================================================
+       # TESTS FOR code2country
+       #================================================
+
+ #---- selection of examples which should all result in undef -----------
+ '!defined code2country()',                  # no argument
+ '!defined code2country(undef)',             # undef argument
+ '!defined code2country("zz")',              # illegal code
+ '!defined code2country("ja")',              # should be jp for country
+
+ #---- some successful examples -----------------------------------------
+ 'code2country("BO") eq "Bolivia"',
+ 'code2country("pk") eq "Pakistan"',
+ 'code2country("sn") eq "Senegal"',
+ 'code2country("us") eq "United States"',
+ 'code2country("ad") eq "Andorra"',          # first in DATA segment
+ 'code2country("zw") eq "Zimbabwe"',         # last in DATA segment
+ 'code2country("uk") eq "United Kingdom"',   # normally "gb"
+
+       #================================================
+       # TESTS FOR country2code
+       #================================================
+
+ #---- selection of examples which should all result in undef -----------
+ '!defined country2code()',                  # no argument
+ '!defined country2code(undef)',             # undef argument
+ '!defined country2code("Banana")',          # illegal country name
+
+ #---- some successful examples -----------------------------------------
+ 'country2code("japan")          eq "jp"',
+ 'country2code("japan")          ne "ja"',
+ 'country2code("Japan")          eq "jp"',
+ 'country2code("United States")  eq "us"',
+ 'country2code("United Kingdom") eq "uk"',
+ 'country2code("Andorra")        eq "ad"',    # first in DATA segment
+ 'country2code("Zimbabwe")       eq "zw"',    # last in DATA segment
+);
+
+print "1..", int(@TESTS), "\n";
+
+$testid = 1;
+foreach $test (@TESTS)
+{
+    eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
+    print "not ok $testid\n" if $@;
+    ++$testid;
+}
+
+exit 0;

diff --git a/lib/Locale/Maketext.t b/lib/Locale/Maketext.t
new file mode 100644 (file)
index 0000000..743d8ee
--- /dev/null
+++ b/lib/Locale/Maketext.t
@@ -0,0 +1,37 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN { $| = 1; print "1..3\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Locale::Maketext 1.01;
+print "# Perl v$], Locale::Maketext v$Locale::Maketext::VERSION\n";
+$loaded = 1;
+print "ok 1\n";
+{
+  package Woozle;
+  @ISA = ('Locale::Maketext');
+  sub dubbil { return $_[1] * 2 }
+}
+{
+  package Woozle::elx;
+  @ISA = ('Woozle');
+  %Lexicon = (
+   'd2' => 'hum [dubbil,_1]',
+  );
+}
+
+$lh = Woozle->get_handle('elx');
+if($lh) {
+  print "ok 2\n";
+  my $x = $lh->maketext('d2', 7);
+  if($x eq "hum 14") {
+    print "ok 3\n";
+  } else {
+    print "not ok 3\n  (got \"$x\")\n";
+  }
+} else {
+  print "not ok 2\n";
+}
+#Shazam!

diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t
new file mode 100755 (executable)
index 0000000..e8de58d
--- /dev/null
+++ b/lib/Math/BigInt/t/bigfltpm.t
@@ -0,0 +1,708 @@
+#!/usr/bin/perl -w
+
+use Test;
+use strict;
+
+BEGIN
+  {
+  $| = 1;
+  unshift @INC, '../lib'; # for running manually
+  # chdir 't' if -d 't';
+  plan tests => 514;
+  }
+
+use Math::BigFloat;
+use Math::BigInt;
+
+my ($x,$y,$f,@args,$ans,$try,$ans1,$ans1_str,$setup);
+while (<DATA>)
+  {
+  chop;
+  $_ =~ s/#.*$//;      # remove comments
+  $_ =~ s/\s+$//;      # trailing spaces
+  next if /^$/;                # skip empty lines & comments
+  if (s/^&//)
+    {
+    $f = $_;
+    }
+  elsif (/^\$/)
+    {
+    $setup = $_; $setup =~ s/^\$/\$Math::BigFloat::/;  # rnd_mode, div_scale 
+    # print "$setup\n";
+    }
+  else
+    {
+    if (m|^(.*?):(/.+)$|)
+      {
+      $ans = $2;
+      @args = split(/:/,$1,99);
+      }
+    else
+      {
+      @args = split(/:/,$_,99); $ans = pop(@args);
+      }
+    $try = "\$x = new Math::BigFloat \"$args[0]\";";
+    if ($f eq "fnorm")
+      {
+        $try .= "\$x;";
+      } elsif ($f eq "binf") {
+        $try .= "\$x->binf('$args[1]');";
+      } elsif ($f eq "bsstr") {
+        $try .= "\$x->bsstr();";
+      } elsif ($f eq "_set") {
+        $try .= "\$x->_set('$args[1]'); \$x;";
+      } elsif ($f eq "fneg") {
+        $try .= "-\$x;";
+      } elsif ($f eq "bfloor") {
+        $try .= "\$x->bfloor();";
+      } elsif ($f eq "bceil") {
+        $try .= "\$x->bceil();";
+      } elsif ($f eq "is_zero") {
+        $try .= "\$x->is_zero()+0;";
+      } elsif ($f eq "is_one") {
+        $try .= "\$x->is_one()+0;";
+      } elsif ($f eq "is_odd") {
+        $try .= "\$x->is_odd()+0;";
+      } elsif ($f eq "is_even") {
+        $try .= "\$x->is_even()+0;";
+      } elsif ($f eq "as_number") {
+        $try .= "\$x->as_number();";
+      } elsif ($f eq "fpow") {
+        $try .= "\$x ** $args[1];";
+      } elsif ($f eq "fabs") {
+        $try .= "abs \$x;";
+      }elsif ($f eq "fround") {
+        $try .= "$setup; \$x->fround($args[1]);";
+      } elsif ($f eq "ffround") {
+        $try .= "$setup; \$x->ffround($args[1]);";
+      } elsif ($f eq "fsqrt") {
+        $try .= "$setup; \$x->fsqrt();";
+      }
+    else
+      {
+      $try .= "\$y = new Math::BigFloat \"$args[1]\";";
+      if ($f eq "fcmp") {
+        $try .= "\$x <=> \$y;";
+      } elsif ($f eq "fadd") {
+        $try .= "\$x + \$y;";
+      } elsif ($f eq "fsub") {
+        $try .= "\$x - \$y;";
+      } elsif ($f eq "fmul") {
+        $try .= "\$x * \$y;";
+      } elsif ($f eq "fdiv") {
+        $try .= "$setup; \$x / \$y;";
+      } elsif ($f eq "fmod") {
+        $try .= "\$x % \$y;";
+      } else { warn "Unknown op '$f'"; }
+    }
+    $ans1 = eval $try;
+    if ($ans =~ m|^/(.*)$|)
+      {
+      my $pat = $1;
+      if ($ans1 =~ /$pat/)
+        {
+        ok (1,1);
+        }
+      else
+        {
+        print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0);
+        }
+      }
+    else
+      {
+      if ($ans eq "")
+        {
+        ok_undef ($ans1);
+        }
+      else
+        {
+        print "# Tried: '$try'\n" if !ok ($ans1, $ans);
+        } 
+      } # end pattern or string
+    }
+  } # end while
+
+# all done
+
+###############################################################################
+# Perl 5.005 does not like ok ($x,undef)
+
+sub ok_undef
+  {
+  my $x = shift;
+
+  ok (1,1) and return if !defined $x;
+  ok ($x,'undef');
+  }
+   
+__END__
+&as_number
+0:0
+1:1
+1.2:1
+2.345:2
+-2:-2
+-123.456:-123
+-200:-200
+&binf
+1:+:+inf
+2:-:-inf
+3:abc:+inf
+&bsstr
++inf:+inf
+-inf:-inf
+abc:NaN
+&fnorm
++inf:+inf
+-inf:-inf
++infinity:NaN
++-inf:NaN
+abc:NaN
+   1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:0
++0:0
++00:0
++0_0_0:0
+000000_0000000_00000:0
+-0:0
+-0000:0
++1:1
++01:1
++001:1
++00000100000:100000
+123456789:123456789
+-1:-1
+-01:-1
+-001:-1
+-123456789:-123456789
+-00000100000:-100000
+123.456a:NaN
+123.456:123.456
+0.01:0.01
+.002:0.002
++.2:0.2
+-0.0003:-0.0003
+-.0000000004:-0.0000000004
+123456E2:12345600
+123456E-2:1234.56
+-123456E2:-12345600
+-123456E-2:-1234.56
+1e1:10
+2e-11:0.00000000002
+-3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+-4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004
+&fpow
+2:2:4
+1:2:1
+1:3:1
+-1:2:1
+-1:3:-1
+123.456:2:15241.383936
+2:-2:0.25
+2:-3:0.125
+128:-2:0.00006103515625
+&fneg
+abc:NaN
++0:0
++1:-1
+-1:1
++123456789:-123456789
+-123456789:123456789
++123.456789:-123.456789
+-123456.789:123456.789
+&fabs
+abc:NaN
++0:0
++1:1
+-1:1
++123456789:123456789
+-123456789:123456789
++123.456789:123.456789
+-123456.789:123456.789
+&fround
+$rnd_mode = "trunc"
++10123456789:5:10123000000
+-10123456789:5:-10123000000
++10123456789.123:5:10123000000
+-10123456789.123:5:-10123000000
++10123456789:9:10123456700
+-10123456789:9:-10123456700
++101234500:6:101234000
+-101234500:6:-101234000
+$rnd_mode = "zero"
++20123456789:5:20123000000
+-20123456789:5:-20123000000
++20123456789.123:5:20123000000
+-20123456789.123:5:-20123000000
++20123456789:9:20123456800
+-20123456789:9:-20123456800
++201234500:6:201234000
+-201234500:6:-201234000
+$rnd_mode = "+inf"
++30123456789:5:30123000000
+-30123456789:5:-30123000000
++30123456789.123:5:30123000000
+-30123456789.123:5:-30123000000
++30123456789:9:30123456800
+-30123456789:9:-30123456800
++301234500:6:301235000
+-301234500:6:-301234000
+$rnd_mode = "-inf"
++40123456789:5:40123000000
+-40123456789:5:-40123000000
++40123456789.123:5:40123000000
+-40123456789.123:5:-40123000000
++40123456789:9:40123456800
+-40123456789:9:-40123456800
++401234500:6:401234000
+-401234500:6:-401235000
+$rnd_mode = "odd"
++50123456789:5:50123000000
+-50123456789:5:-50123000000
++50123456789.123:5:50123000000
+-50123456789.123:5:-50123000000
++50123456789:9:50123456800
+-50123456789:9:-50123456800
++501234500:6:501235000
+-501234500:6:-501235000
+$rnd_mode = "even"
++60123456789:5:60123000000
+-60123456789:5:-60123000000
++60123456789:9:60123456800
+-60123456789:9:-60123456800
++601234500:6:601234000
+-601234500:6:-601234000
++60123456789.0123:5:60123000000
+-60123456789.0123:5:-60123000000
+&ffround
+$rnd_mode = "trunc"
++1.23:-1:1.2
++1.234:-1:1.2
++1.2345:-1:1.2
++1.23:-2:1.23
++1.234:-2:1.23
++1.2345:-2:1.23
++1.23:-3:1.23
++1.234:-3:1.234
++1.2345:-3:1.234
+-1.23:-1:-1.2
++1.27:-1:1.2
+-1.27:-1:-1.2
++1.25:-1:1.2
+-1.25:-1:-1.2
++1.35:-1:1.3
+-1.35:-1:-1.3
+-0.0061234567890:-1:0
+-0.0061:-1:0
+-0.00612:-1:0
+-0.00612:-2:0
+-0.006:-1:0
+-0.006:-2:0
+-0.0006:-2:0
+-0.0006:-3:0
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:0
+0.51:0:0
+0.41:0:0
+$rnd_mode = "zero"
++2.23:-1:/2.2(?:0{5}\d+)?
+-2.23:-1:/-2.2(?:0{5}\d+)?
++2.27:-1:/2.(?:3|29{5}\d+)
+-2.27:-1:/-2.(?:3|29{5}\d+)
++2.25:-1:/2.2(?:0{5}\d+)?
+-2.25:-1:/-2.2(?:0{5}\d+)?
++2.35:-1:/2.(?:3|29{5}\d+)
+-2.35:-1:/-2.(?:3|29{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:0
+0.51:0:1
+0.41:0:0
+$rnd_mode = "+inf"
++3.23:-1:/3.2(?:0{5}\d+)?
+-3.23:-1:/-3.2(?:0{5}\d+)?
++3.27:-1:/3.(?:3|29{5}\d+)
+-3.27:-1:/-3.(?:3|29{5}\d+)
++3.25:-1:/3.(?:3|29{5}\d+)
+-3.25:-1:/-3.2(?:0{5}\d+)?
++3.35:-1:/3.(?:4|39{5}\d+)
+-3.35:-1:/-3.(?:3|29{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:1
+0.51:0:1
+0.41:0:0
+$rnd_mode = "-inf"
++4.23:-1:/4.2(?:0{5}\d+)?
+-4.23:-1:/-4.2(?:0{5}\d+)?
++4.27:-1:/4.(?:3|29{5}\d+)
+-4.27:-1:/-4.(?:3|29{5}\d+)
++4.25:-1:/4.2(?:0{5}\d+)?
+-4.25:-1:/-4.(?:3|29{5}\d+)
++4.35:-1:/4.(?:3|29{5}\d+)
+-4.35:-1:/-4.(?:4|39{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:0
+0.51:0:1
+0.41:0:0
+$rnd_mode = "odd"
++5.23:-1:/5.2(?:0{5}\d+)?
+-5.23:-1:/-5.2(?:0{5}\d+)?
++5.27:-1:/5.(?:3|29{5}\d+)
+-5.27:-1:/-5.(?:3|29{5}\d+)
++5.25:-1:/5.(?:3|29{5}\d+)
+-5.25:-1:/-5.(?:3|29{5}\d+)
++5.35:-1:/5.(?:3|29{5}\d+)
+-5.35:-1:/-5.(?:3|29{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:1
+0.51:0:1
+0.41:0:0
+$rnd_mode = "even"
++6.23:-1:/6.2(?:0{5}\d+)?
+-6.23:-1:/-6.2(?:0{5}\d+)?
++6.27:-1:/6.(?:3|29{5}\d+)
+-6.27:-1:/-6.(?:3|29{5}\d+)
++6.25:-1:/6.(?:2(?:0{5}\d+)?|29{5}\d+)
+-6.25:-1:/-6.(?:2(?:0{5}\d+)?|29{5}\d+)
++6.35:-1:/6.(?:4|39{5}\d+|29{8}\d+)
+-6.35:-1:/-6.(?:4|39{5}\d+|29{8}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-7e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:0
+0.51:0:1
+0.41:0:0
+0.01234567:-3:0.012
+0.01234567:-4:0.0123
+0.01234567:-5:0.01235
+0.01234567:-6:0.012346
+0.01234567:-7:0.0123457
+0.01234567:-8:0.01234567
+0.01234567:-9:0.01234567
+0.01234567:-12:0.01234567
+&fcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
+-1.1:0:-1
++0:-1.1:1
++1.1:+0:1
++0:+1.1:-1
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
+0:0.01:-1
+0:0.0001:-1
+0:-0.0001:1
+0:-0.1:1
+0.1:0:1
+0.00001:0:1
+-0.0001:0:-1
+-0.1:0:-1
+0:0.0001234:-1
+0:-0.0001234:1
+0.0001234:0:1
+-0.0001234:0:-1
+0.0001:0.0005:-1
+0.0005:0.0001:1
+0.005:0.0001:1
+0.001:0.0005:1
+0.000001:0.0005:-2     # <0, but can't test this
+0.00000123:0.0005:-2   # <0, but can't test this
+0.00512:0.0001:1
+0.005:0.000112:1
+0.00123:0.0005:1
+&fadd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:0
++1:+0:1
++0:+1:1
++1:+1:2
+-1:+0:-1
++0:-1:-1
+-1:-1:-2
+-1:+1:0
++1:-1:0
++9:+1:10
++99:+1:100
++999:+1:1000
++9999:+1:10000
++99999:+1:100000
++999999:+1:1000000
++9999999:+1:10000000
++99999999:+1:100000000
++999999999:+1:1000000000
++9999999999:+1:10000000000
++99999999999:+1:100000000000
++10:-1:9
++100:-1:99
++1000:-1:999
++10000:-1:9999
++100000:-1:99999
++1000000:-1:999999
++10000000:-1:9999999
++100000000:-1:99999999
++1000000000:-1:999999999
++10000000000:-1:9999999999
++123456789:+987654321:1111111110
+-123456789:+987654321:864197532
+-123456789:-987654321:-1111111110
++123456789:-987654321:-864197532
+&fsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:0
++1:+0:1
++0:+1:-1
++1:+1:0
+-1:+0:-1
++0:-1:1
+-1:-1:0
+-1:+1:-2
++1:-1:2
++9:+1:8
++99:+1:98
++999:+1:998
++9999:+1:9998
++99999:+1:99998
++999999:+1:999998
++9999999:+1:9999998
++99999999:+1:99999998
++999999999:+1:999999998
++9999999999:+1:9999999998
++99999999999:+1:99999999998
++10:-1:11
++100:-1:101
++1000:-1:1001
++10000:-1:10001
++100000:-1:100001
++1000000:-1:1000001
++10000000:-1:10000001
++100000000:-1:100000001
++1000000000:-1:1000000001
++10000000000:-1:10000000001
++123456789:+987654321:-864197532
+-123456789:+987654321:-1111111110
+-123456789:-987654321:864197532
++123456789:-987654321:1111111110
+&fmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:0
++0:+1:0
++1:+0:0
++0:-1:0
+-1:+0:0
++123456789123456789:+0:0
++0:+123456789123456789:0
+-1:-1:1
+-1:+1:-1
++1:-1:-1
++1:+1:1
++2:+3:6
+-2:+3:-6
++2:-3:-6
+-2:-3:6
++111:+111:12321
++10101:+10101:102030201
++1001001:+1001001:1002003002001
++100010001:+100010001:10002000300020001
++10000100001:+10000100001:100002000030000200001
++11111111111:+9:99999999999
++22222222222:+9:199999999998
++33333333333:+9:299999999997
++44444444444:+9:399999999996
++55555555555:+9:499999999995
++66666666666:+9:599999999994
++77777777777:+9:699999999993
++88888888888:+9:799999999992
++99999999999:+9:899999999991
+&fdiv
+$div_scale = 40; $Math::BigFloat::rnd_mode = 'even'
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:0
++1:+0:NaN
++0:-1:0
+-1:+0:NaN
++1:+1:1
+-1:-1:1
++1:-1:-1
+-1:+1:-1
++1:+2:0.5
++2:+1:2
++10:+5:2
++100:+4:25
++1000:+8:125
++10000:+16:625
++10000:-16:-625
++999999999999:+9:111111111111
++999999999999:+99:10101010101
++999999999999:+999:1001001001
++999999999999:+9999:100010001
++999999999999999:+99999:10000100001
++1000000000:+9:111111111.1111111111111111111111111111111
++2000000000:+9:222222222.2222222222222222222222222222222
++3000000000:+9:333333333.3333333333333333333333333333333
++4000000000:+9:444444444.4444444444444444444444444444444
++5000000000:+9:555555555.5555555555555555555555555555556
++6000000000:+9:666666666.6666666666666666666666666666667
++7000000000:+9:777777777.7777777777777777777777777777778
++8000000000:+9:888888888.8888888888888888888888888888889
++9000000000:+9:1000000000
++35500000:+113:314159.2920353982300884955752212389380531
++71000000:+226:314159.2920353982300884955752212389380531
++106500000:+339:314159.2920353982300884955752212389380531
++1000000000:+3:333333333.3333333333333333333333333333333
+$div_scale = 20
++1000000000:+9:111111111.11111111111
++2000000000:+9:222222222.22222222222
++3000000000:+9:333333333.33333333333
++4000000000:+9:444444444.44444444444
++5000000000:+9:555555555.55555555556
++6000000000:+9:666666666.66666666667
++7000000000:+9:777777777.77777777778
++8000000000:+9:888888888.88888888889
++9000000000:+9:1000000000
+# following two cases are the "old" behaviour, but are now (>v0.01) different
+#+35500000:+113:314159.292035398230088
+#+71000000:+226:314159.292035398230088
++35500000:+113:314159.29203539823009
++71000000:+226:314159.29203539823009
++106500000:+339:314159.29203539823009
++1000000000:+3:333333333.33333333333
+$div_scale = 1
+# div_scale will be 3 since $x has 3 digits
++124:+3:41.3
+# reset scale for further tests
+$div_scale = 40
+&fmod
++0:0:NaN
++0:1:0
++3:1:0
+#+5:2:1
+#+9:4:1
+#+9:5:4
+#+9000:56:40
+#+56:9000:56
+&fsqrt
++0:0
+-1:NaN
+-2:NaN
+-16:NaN
+-123.45:NaN
++1:1
+#+1.44:1.2
+#+2:1.41421356237309504880168872420969807857
+#+4:2
+#+16:4
+#+100:10
+#+123.456:11.11107555549866648462149404118219234119
+#+15241.38393:123.456
+&is_odd
+abc:0
+0:0
+-1:1
+-3:1
+1:1
+3:1
+1000001:1
+1000002:0
+2:0
+&is_even
+abc:0
+0:1
+-1:0
+-3:0
+1:0
+3:0
+1000001:0
+1000002:1
+2:1
+&is_zero
+NaNzero:0
+0:1
+-1:0
+1:0
+&is_one
+0:0
+2:0
+1:1
+-1:0
+-2:0
+&_set
+NaN:2:2
+2:abc:NaN
+1:-1:-1
+2:1:1
+-2:0:0
+128:-2:-2
+&bfloor
+0:0
+abc:NaN
++inf:+inf
+-inf:-inf
+1:1
+-51:-51
+-51.2:-52
+12.2:12
+&bceil
+0:0
+abc:NaN
++inf:+inf
+-inf:-inf
+1:1
+-51:-51
+-51.2:-51
+12.2:13

diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t
new file mode 100755 (executable)
index 0000000..f819104
--- /dev/null
+++ b/lib/Math/BigInt/t/bigintpm.t
@@ -0,0 +1,1238 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test;
+
+BEGIN 
+  {
+  $| = 1;
+  # chdir 't' if -d 't';
+  unshift @INC, '../lib'; # for running manually
+  plan tests => 1190;
+  }
+
+##############################################################################
+# for testing inheritance of _swap
+
+package Math::Foo;
+
+use Math::BigInt;
+use vars qw/@ISA/;
+@ISA = (qw/Math::BigInt/);
+
+use overload
+# customized overload for sub, since original does not use swap there
+'-'     =>      sub { my @a = ref($_[0])->_swap(@_);
+                   $a[0]->bsub($a[1])};
+
+sub _swap
+  {
+  # a fake _swap, which reverses the params
+  my $self = shift;                     # for override in subclass
+  if ($_[2])
+    {
+    my $c = ref ($_[0] ) || 'Math::Foo';
+    return ( $_[0]->copy(), $_[1] );
+    }
+  else
+    {
+    return ( Math::Foo->new($_[1]), $_[0] );
+    }
+  }
+
+##############################################################################
+package main;
+
+use Math::BigInt;
+
+my (@args,$f,$try,$x,$y,$z,$a,$exp,$ans,$ans1,@a,$m,$e,$round_mode);
+
+while (<DATA>) 
+  {
+  chop;
+  next if /^#/;        # skip comments
+  if (s/^&//) 
+    {
+    $f = $_;
+    }
+  elsif (/^\$/) 
+    {
+    $round_mode = $_;
+    $round_mode =~ s/^\$/Math::BigInt->/;
+    # print "$round_mode\n";
+    }
+  else 
+    {
+    @args = split(/:/,$_,99);
+    $ans = pop(@args);
+    $try = "\$x = Math::BigInt->new(\"$args[0]\");";
+    if ($f eq "bnorm"){
+      # $try .= '$x+0;';
+    } elsif ($f eq "_set") {
+      $try .= '$x->_set($args[1]); "$x";';
+    } elsif ($f eq "is_zero") {
+      $try .= '$x->is_zero()+0;';
+    } elsif ($f eq "is_one") {
+      $try .= '$x->is_one()+0;';
+    } elsif ($f eq "is_odd") {
+      $try .= '$x->is_odd()+0;';
+    } elsif ($f eq "is_even") {
+      $try .= '$x->is_even()+0;';
+    } elsif ($f eq "binf") {
+      $try .= "\$x->binf('$args[1]');";
+    } elsif ($f eq "bfloor") {
+      $try .= '$x->bfloor();';
+    } elsif ($f eq "bceil") {
+      $try .= '$x->bceil();';
+    } elsif ($f eq "is_inf") {
+      $try .= "\$x->is_inf('$args[1]')+0;";
+    } elsif ($f eq "bsstr") {
+      $try .= '$x->bsstr();';
+    } elsif ($f eq "bneg") {
+      $try .= '-$x;';
+    } elsif ($f eq "babs") {
+      $try .= 'abs $x;';
+    } elsif ($f eq "binc") {
+      $try .= '++$x;'; 
+    } elsif ($f eq "bdec") {
+      $try .= '--$x;'; 
+    }elsif ($f eq "bnot") {
+      $try .= '~$x;';
+    }elsif ($f eq "bsqrt") {
+      $try .= '$x->bsqrt();';
+    }elsif ($f eq "length") {
+      $try .= "\$x->length();";
+    }elsif ($f eq "bround") {
+      $try .= "$round_mode; \$x->bround($args[1]);";
+    }elsif ($f eq "exponent"){
+      $try .= '$x = $x->exponent()->bstr();';
+    }elsif ($f eq "mantissa"){
+      $try .= '$x = $x->mantissa()->bstr();';
+    }elsif ($f eq "parts"){
+      $try .= "(\$m,\$e) = \$x->parts();"; 
+      $try .= '$m = $m->bstr(); $m = "NaN" if !defined $m;';
+      $try .= '$e = $e->bstr(); $e = "NaN" if !defined $e;';
+      $try .= '"$m,$e";';
+    } else {
+      $try .= "\$y = new Math::BigInt \"$args[1]\";";
+      if ($f eq "bcmp"){
+        $try .= '$x <=> $y;';
+      }elsif ($f eq "bacmp"){
+        $try .= '$x->bacmp($y);';
+      }elsif ($f eq "badd"){
+        $try .= "\$x + \$y;";
+      }elsif ($f eq "bsub"){
+        $try .= "\$x - \$y;";
+      }elsif ($f eq "bmul"){
+        $try .= "\$x * \$y;";
+      }elsif ($f eq "bdiv"){
+        $try .= "\$x / \$y;";
+      }elsif ($f eq "bmod"){
+        $try .= "\$x % \$y;";
+      }elsif ($f eq "bgcd")
+        {
+        if (defined $args[2])
+          {
+          $try .= " \$z = new Math::BigInt \"$args[2]\"; ";
+          }
+        $try .= "Math::BigInt::bgcd(\$x, \$y";
+        $try .= ", \$z" if (defined $args[2]);
+        $try .= " );";
+        }
+      elsif ($f eq "blcm")
+        {
+        if (defined $args[2])
+          {
+          $try .= " \$z = new Math::BigInt \"$args[2]\"; ";
+          }
+        $try .= "Math::BigInt::blcm(\$x, \$y";
+        $try .= ", \$z" if (defined $args[2]);
+        $try .= " );";
+      }elsif ($f eq "blsft"){
+        if (defined $args[2])
+          {
+          $try .= "\$x->blsft(\$y,$args[2]);";
+          }
+        else
+          {
+          $try .= "\$x << \$y;";
+          }
+      }elsif ($f eq "brsft"){
+        if (defined $args[2])
+          {
+          $try .= "\$x->brsft(\$y,$args[2]);";
+          }
+        else
+          {
+          $try .= "\$x >> \$y;";
+          }
+      }elsif ($f eq "band"){
+        $try .= "\$x & \$y;";
+      }elsif ($f eq "bior"){
+        $try .= "\$x | \$y;";
+      }elsif ($f eq "bxor"){
+        $try .= "\$x ^ \$y;";
+      }elsif ($f eq "bpow"){
+        $try .= "\$x ** \$y;";
+      }elsif ($f eq "digit"){
+        $try = "\$x = Math::BigInt->new(\"$args[0]\"); \$x->digit($args[1]);";
+      } else { warn "Unknown op '$f'"; }
+    }
+    # print "trying $try\n";
+    $ans1 = eval $try;
+    $ans =~ s/^[+]([0-9])/$1/;                 # remove leading '+' 
+    if ($ans eq "")
+      {
+      ok_undef ($ans1); 
+      }
+    else
+      {
+      #print "try: $try ans: $ans1 $ans\n";
+      print "# Tried: '$try'\n" if !ok ($ans1, $ans);
+      }
+    # check internal state of number objects
+    is_valid($ans1) if ref $ans1; 
+    }
+  } # endwhile data tests
+close DATA;
+
+# test whether constant works or not
+$try = "use Math::BigInt (1.31,'babs',':constant');";
+$try .= ' $x = 2**150; babs($x); $x = "$x";';
+$ans1 = eval $try;
+
+ok ( $ans1, "1427247692705959881058285969449495136382746624");
+
+# test some more
+@a = ();
+for (my $i = 1; $i < 10; $i++) 
+  {
+  push @a, $i;
+  }
+ok "@a", "1 2 3 4 5 6 7 8 9";
+
+# test whether selfmultiplication works correctly (result is 2**64)
+$try = '$x = new Math::BigInt "+4294967296";';
+$try .= '$a = $x->bmul($x);';
+$ans1 = eval $try;
+print "# Tried: '$try'\n" if !ok ($ans1, Math::BigInt->new(2) ** 64);
+
+# test whether op detroys args or not (should better not)
+
+$x = new Math::BigInt (3);
+$y = new Math::BigInt (4);
+$z = $x & $y;
+ok ($x,3);
+ok ($y,4);
+ok ($z,0);
+$z = $x | $y;
+ok ($x,3);
+ok ($y,4);
+ok ($z,7);
+$x = new Math::BigInt (1);
+$y = new Math::BigInt (2);
+$z = $x | $y;
+ok ($x,1);
+ok ($y,2);
+ok ($z,3);
+
+$x = new Math::BigInt (5);
+$y = new Math::BigInt (4);
+$z = $x ^ $y;
+ok ($x,5);
+ok ($y,4);
+ok ($z,1);
+
+$x = new Math::BigInt (-5); $y = -$x;
+ok ($x, -5);
+
+$x = new Math::BigInt (-5); $y = abs($x);
+ok ($x, -5);
+
+# check whether overloading cmp works
+$try = "\$x = Math::BigInt->new(0);";
+$try .= "\$y = 10;";
+$try .= "'false' if \$x ne \$y;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "false" ); 
+
+# we cant test for working cmpt with other objects here, we would need a dummy
+# object with stringify overload for this. see Math::String tests
+
+###############################################################################
+# check shortcuts
+$try = "\$x = Math::BigInt->new(1); \$x += 9;";
+$try .= "'ok' if \$x == 10;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(1); \$x -= 9;";
+$try .= "'ok' if \$x == -8;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(1); \$x *= 9;";
+$try .= "'ok' if \$x == 9;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(10); \$x /= 2;";
+$try .= "'ok' if \$x == 5;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+###############################################################################
+# check reversed order of arguments
+$try = "\$x = Math::BigInt->new(10); \$x = 2 ** \$x;";
+$try .= "'ok' if \$x == 1024;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(10); \$x = 2 * \$x;";
+$try .= "'ok' if \$x == 20;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(10); \$x = 2 + \$x;";
+$try .= "'ok' if \$x == 12;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(10); \$x = 2 - \$x;";
+$try .= "'ok' if \$x == -8;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(10); \$x = 20 / \$x;";
+$try .= "'ok' if \$x == 2;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+###############################################################################
+# check badd(4,5) form
+
+$try = "\$x = Math::BigInt::badd(4,5);";
+$try .= "'ok' if \$x == 9;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->badd(4,5);";
+$try .= "'ok' if \$x == 9;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+###############################################################################
+# check proper length of internal arrays
+
+$x = Math::BigInt->new(99999); 
+ok ($x,99999);
+ok (scalar @{$x->{value}}, 1);
+$x += 1;
+ok ($x,100000);
+ok (scalar @{$x->{value}}, 2);
+$x -= 1;
+ok ($x,99999);
+ok (scalar @{$x->{value}}, 1);
+
+###############################################################################
+# check numify
+
+my $BASE = int(1e5);
+$x = Math::BigInt->new($BASE-1);     ok ($x->numify(),$BASE-1); 
+$x = Math::BigInt->new(-($BASE-1));  ok ($x->numify(),-($BASE-1)); 
+$x = Math::BigInt->new($BASE);       ok ($x->numify(),$BASE); 
+$x = Math::BigInt->new(-$BASE);      ok ($x->numify(),-$BASE);
+$x = Math::BigInt->new( -($BASE*$BASE*1+$BASE*1+1) ); 
+ok($x->numify(),-($BASE*$BASE*1+$BASE*1+1)); 
+
+###############################################################################
+# test bug in _digits with length($c[-1]) where $c[-1] was "00001" instead of 1
+
+$x = Math::BigInt->new(99998); $x++; $x++; $x++; $x++;
+if ($x > 100000) { ok (1,1) } else { ok ("$x < 100000","$x > 100000"); }
+
+$x = Math::BigInt->new(100003); $x++;
+$y = Math::BigInt->new(1000000);
+if ($x < 1000000) { ok (1,1) } else { ok ("$x > 1000000","$x < 1000000"); }
+
+###############################################################################
+# bug in sub where number with at least 6 trailing zeros after any op failed
+
+$x = Math::BigInt->new(123456); $z = Math::BigInt->new(10000); $z *= 10;
+$x -= $z;
+ok ($z, 100000);
+ok ($x, 23456);
+
+###############################################################################
+# bug with rest "-0" in div, causing further div()s to fail
+
+$x = Math::BigInt->new(-322056000); ($x,$y) = $x->bdiv('-12882240');
+
+ok ($y,'0');   # not '-0'
+is_valid($y);
+
+###############################################################################
+# check undefs: NOT DONE YET
+
+###############################################################################
+# bool
+
+$x = Math::BigInt->new(1); if ($x) { ok (1,1); } else { ok($x,'to be true') }
+$x = Math::BigInt->new(0); if (!$x) { ok (1,1); } else { ok($x,'to be false') }
+
+###############################################################################
+# objectify()
+
+@args = Math::BigInt::objectify(2,4,5);
+ok (scalar @args,3);           # 'Math::BigInt', 4, 5
+ok ($args[0],'Math::BigInt');
+ok ($args[1],4);
+ok ($args[2],5);
+
+@args = Math::BigInt::objectify(0,4,5);
+ok (scalar @args,3);           # 'Math::BigInt', 4, 5
+ok ($args[0],'Math::BigInt');
+ok ($args[1],4);
+ok ($args[2],5);
+
+@args = Math::BigInt::objectify(2,4,5);
+ok (scalar @args,3);           # 'Math::BigInt', 4, 5
+ok ($args[0],'Math::BigInt');
+ok ($args[1],4);
+ok ($args[2],5);
+
+@args = Math::BigInt::objectify(2,4,5,6,7);
+ok (scalar @args,5);           # 'Math::BigInt', 4, 5, 6, 7
+ok ($args[0],'Math::BigInt');
+ok ($args[1],4); ok (ref($args[1]),$args[0]);
+ok ($args[2],5); ok (ref($args[2]),$args[0]);
+ok ($args[3],6); ok (ref($args[3]),'');
+ok ($args[4],7); ok (ref($args[4]),'');
+
+@args = Math::BigInt::objectify(2,'Math::BigInt',4,5,6,7);
+ok (scalar @args,5);           # 'Math::BigInt', 4, 5, 6, 7
+ok ($args[0],'Math::BigInt');
+ok ($args[1],4); ok (ref($args[1]),$args[0]);
+ok ($args[2],5); ok (ref($args[2]),$args[0]);
+ok ($args[3],6); ok (ref($args[3]),'');
+ok ($args[4],7); ok (ref($args[4]),'');
+
+###############################################################################
+# test for flaoting-point input (other tests in bnorm() below)
+
+$z = 1050000000000000;          # may be int on systems with 64bit?
+$x = Math::BigInt->new($z); ok ($x->bsstr(),'105e+13');        # not 1.03e+15?
+$z = 1e+129;                   # definitely a float
+$x = Math::BigInt->new($z); ok ($x->bsstr(),$z);
+
+###############################################################################
+# prime number tests, also test for **= and length()
+# found on: http://www.utm.edu/research/primes/notes/by_year.html
+
+# ((2^148)-1)/17
+$x = Math::BigInt->new(2); $x **= 148; $x++; $x = $x / 17;
+ok ($x,"20988936657440586486151264256610222593863921");
+ok ($x->length(),length "20988936657440586486151264256610222593863921");
+
+# MM7 = 2^127-1
+$x = Math::BigInt->new(2); $x **= 127; $x--;
+ok ($x,"170141183460469231731687303715884105727");
+
+# I am afraid the following is not yet possible due to slowness
+# Also, testing for 2 meg output is a bit hard ;)
+#$x = new Math::BigInt(2); $x **= 6972593; $x--;
+
+# 593573509*2^332162+1 has exactly 100.000 digits
+# takes over 16 mins and still not complete, so can not be done yet ;)
+#$x = Math::BigInt->new(2); $x **= 332162; $x *= "593573509"; $x++;
+#ok ($x->digits(),100000);
+
+###############################################################################
+# inheritance and overriding of _swap
+
+$x = Math::Foo->new(5);
+$x = $x - 8;           # 8 - 5 instead of 5-8
+ok ($x,3);
+ok (ref($x),'Math::Foo');
+
+$x = Math::Foo->new(5);
+$x = 8 - $x;           # 5 - 8 instead of 8 - 5
+ok ($x,-3);
+ok (ref($x),'Math::Foo');
+
+###############################################################################
+# all tests done
+
+# devel test, see whether valid catches errors
+#$x = Math::BigInt->new(0);
+#$x->{sign} = '-';
+#is_valid($x); # nok
+#
+#$x->{sign} = 'e';
+#is_valid($x); # nok
+#
+#$x->{value}->[0] = undef;
+#is_valid($x); # nok
+#
+#$x->{value}->[0] = 1e6;
+#is_valid($x); # nok
+#
+#$x->{value}->[0] = -2;
+#is_valid($x); # nok
+#
+#$x->{sign} = '+';
+#is_valid($x); # ok
+
+###############################################################################
+# Perl 5.005 does not like ok ($x,undef)
+
+sub ok_undef
+  {
+  my $x = shift;
+
+  ok (1,1) and return if !defined $x;
+  ok ($x,'undef');
+  }
+
+###############################################################################
+# sub to check validity of a BigInt internally, to ensure that no op leaves a
+# number object in an invalid state (f.i. "-0")
+
+sub is_valid
+  {
+  my $x = shift;
+
+  my $error = ["",];
+
+  # ok as reference? 
+  is_okay('ref($x)','Math::BigInt',ref($x),$error);
+
+  # has ok sign?
+  is_okay('$x->{sign}',"'+', '-', '-inf', '+inf' or 'NaN'",$x->{sign},$error)
+   if $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
+
+  # is not -0?
+  if (($x->{sign} eq '-') && (@{$x->{value}} == 1) && ($x->{value}->[0] == 0))
+     {
+     is_okay("\$x ne '-0'","0",$x,$error);
+     }
+  # all parts are valid?
+  my $i = 0; my $j = scalar @{$x->{value}}; my $e; my $try;
+  while ($i < $j)
+    {
+    $e = $x->{value}->[$i]; $e = 'undef' unless defined $e;
+    $try = '=~ /^[\+]?[0-9]+\$/; '."($f, $x, $e)";
+    last if $e !~ /^[+]?[0-9]+$/;
+    $try = ' < 0 || >= 1e5; '."($f, $x, $e)";
+    last if $e <0 || $e >= 1e5;
+    # this test is disabled, since new/bnorm and certain ops (like early out
+    # in add/sub) are allowed/expected to leave '00000' in some elements
+    #$try = '=~ /^00+/; '."($f, $x, $e)";
+    #last if $e =~ /^00+/;
+    $i++;
+    }
+  is_okay("\$x->{value}->[$i] $try","not $e",$e,$error)
+   if $i < $j; # trough all?
+  
+  # see whether errors crop up
+  $error->[1] = 'undef' unless defined $error->[1];
+  if ($error->[0] ne "")
+    {
+    ok ($error->[1],$error->[2]);
+    print "# Tried: $error->[0]\n";
+    }
+  else
+    {
+    ok (1,1);
+    }
+  }
+
+sub is_okay
+  {
+  my ($tried,$expected,$try,$error) = @_;
+
+  return if $error->[0] ne ""; # error, no further testing
+
+  @$error = ( $tried, $try, $expected ) if $try ne $expected;
+  }
+
+__END__
+&bnorm
+# binary input
+0babc:NaN
+0b123:NaN
+0b0:0
+-0b0:0
+-0b1:-1
+0b0001:1
+0b001:1
+0b011:3
+0b101:5
+0b1000000000000000000000000000000:1073741824
+# hex input
+-0x0:0
+0xabcdefgh:NaN
+0x1234:4660
+0xabcdef:11259375
+-0xABCDEF:-11259375
+-0x1234:-4660
+0x12345678:305419896
+# inf input
++inf:+inf
+-inf:-inf
+0inf:NaN
+# normal input
+:NaN
+abc:NaN
+   1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:0
++0:0
++00:0
++000:0
+000000000000000000:0
+-0:0
+-0000:0
++1:1
++01:1
++001:1
++00000100000:100000
+123456789:123456789
+-1:-1
+-01:-1
+-001:-1
+-123456789:-123456789
+-00000100000:-100000
+1_2_3:123
+_123:NaN
+_123_:NaN
+_123_:NaN
+1__23:NaN
+10000000000E-1_0:1
+1E2:100
+1E1:10
+1E0:1
+E1:NaN
+E23:NaN
+1.23E2:123
+1.23E1:NaN
+1.23E-1:NaN
+100E-1:10
+# floating point input
+1.01E2:101
+1010E-1:101
+-1010E0:-1010
+-1010E1:-10100
+-1010E-2:NaN
+-1.01E+1:NaN
+-1.01E-1:NaN
+&binf
+1:+:+inf
+2:-:-inf
+3:abc:+inf
+&is_inf
++inf::1
+-inf::1
+abc::0
+1::0
+NaN::0
+-1::0
++inf:-:0
++inf:+:1
+-inf:-:1
+-inf:+:0
+&blsft
+abc:abc:NaN
++2:+2:+8
++1:+32:+4294967296
++1:+48:+281474976710656
++8:-2:NaN
+# excercise base 10
++12345:4:10:123450000
+-1234:0:10:-1234
++1234:0:10:+1234
++2:2:10:200
++12:2:10:1200
++1234:-3:10:NaN
+1234567890123:12:10:1234567890123000000000000
+&brsft
+abc:abc:NaN
++8:+2:+2
++4294967296:+32:+1
++281474976710656:+48:+1
++2:-2:NaN
+# excercise base 10
+-1234:0:10:-1234
++1234:0:10:+1234
++200:2:10:2
++1234:3:10:1
++1234:2:10:12
++1234:-3:10:NaN
+310000:4:10:31
+12300000:5:10:123
+1230000000000:10:10:123
+09876123456789067890:12:10:9876123
+1234561234567890123:13:10:123456
+&bsstr
+1e+34:1e+34
+123.456E3:123456e+0
+100:1e+2
+abc:NaN
+&bneg
+abd:NaN
++0:+0
++1:-1
+-1:+1
++123456789:-123456789
+-123456789:+123456789
+&babs
+abc:NaN
++0:+0
++1:+1
+-1:+1
++123456789:+123456789
+-123456789:+123456789
+&bcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
++100:+5:1
+-123456789:+987654321:-1
++123456789:-987654321:1
+-987654321:+123456789:-1
+&bacmp
++0:-0:0
++0:+1:-1
+-1:+1:0
++1:-1:0
+-1:+2:-1
++2:-1:1
+-123456789:+987654321:-1
++123456789:-987654321:-1
+-987654321:+123456789:1
+&binc
+abc:NaN
++0:+1
++1:+2
+-1:+0
+&bdec
+abc:NaN
++0:-1
++1:+0
+-1:-2
+&badd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:+1
++1:+1:+2
+-1:+0:-1
++0:-1:-1
+-1:-1:-2
+-1:+1:+0
++1:-1:+0
++9:+1:+10
++99:+1:+100
++999:+1:+1000
++9999:+1:+10000
++99999:+1:+100000
++999999:+1:+1000000
++9999999:+1:+10000000
++99999999:+1:+100000000
++999999999:+1:+1000000000
++9999999999:+1:+10000000000
++99999999999:+1:+100000000000
++10:-1:+9
++100:-1:+99
++1000:-1:+999
++10000:-1:+9999
++100000:-1:+99999
++1000000:-1:+999999
++10000000:-1:+9999999
++100000000:-1:+99999999
++1000000000:-1:+999999999
++10000000000:-1:+9999999999
++123456789:+987654321:+1111111110
+-123456789:+987654321:+864197532
+-123456789:-987654321:-1111111110
++123456789:-987654321:-864197532
+&bsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:-1
++1:+1:+0
+-1:+0:-1
++0:-1:+1
+-1:-1:+0
+-1:+1:-2
++1:-1:+2
++9:+1:+8
++99:+1:+98
++999:+1:+998
++9999:+1:+9998
++99999:+1:+99998
++999999:+1:+999998
++9999999:+1:+9999998
++99999999:+1:+99999998
++999999999:+1:+999999998
++9999999999:+1:+9999999998
++99999999999:+1:+99999999998
++10:-1:+11
++100:-1:+101
++1000:-1:+1001
++10000:-1:+10001
++100000:-1:+100001
++1000000:-1:+1000001
++10000000:-1:+10000001
++100000000:-1:+100000001
++1000000000:-1:+1000000001
++10000000000:-1:+10000000001
++123456789:+987654321:-864197532
+-123456789:+987654321:-1111111110
+-123456789:-987654321:+864197532
++123456789:-987654321:+1111111110
+&bmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+0
++1:+0:+0
++0:-1:+0
+-1:+0:+0
++123456789123456789:+0:+0
++0:+123456789123456789:+0
+-1:-1:+1
+-1:+1:-1
++1:-1:-1
++1:+1:+1
++2:+3:+6
+-2:+3:-6
++2:-3:-6
+-2:-3:+6
++111:+111:+12321
++10101:+10101:+102030201
++1001001:+1001001:+1002003002001
++100010001:+100010001:+10002000300020001
++10000100001:+10000100001:+100002000030000200001
++11111111111:+9:+99999999999
++22222222222:+9:+199999999998
++33333333333:+9:+299999999997
++44444444444:+9:+399999999996
++55555555555:+9:+499999999995
++66666666666:+9:+599999999994
++77777777777:+9:+699999999993
++88888888888:+9:+799999999992
++99999999999:+9:+899999999991
++25:+25:+625
++12345:+12345:+152399025
++99999:+11111:+1111088889
+&bdiv
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+1
+-1:-1:+1
++1:-1:-1
+-1:+1:-1
++1:+2:+0
++2:+1:+2
++1:+26:+0
++1000000000:+9:+111111111
++2000000000:+9:+222222222
++3000000000:+9:+333333333
++4000000000:+9:+444444444
++5000000000:+9:+555555555
++6000000000:+9:+666666666
++7000000000:+9:+777777777
++8000000000:+9:+888888888
++9000000000:+9:+1000000000
++35500000:+113:+314159
++71000000:+226:+314159
++106500000:+339:+314159
++1000000000:+3:+333333333
++10:+5:+2
++100:+4:+25
++1000:+8:+125
++10000:+16:+625
++999999999999:+9:+111111111111
++999999999999:+99:+10101010101
++999999999999:+999:+1001001001
++999999999999:+9999:+100010001
++999999999999999:+99999:+10000100001
++1111088889:+99999:+11111
+-5:-3:1
+4:3:1
+1:3:0
+-2:-3:0
+-2:3:-1
+1:-3:-1
+-5:3:-2
+4:-3:-2
+&bmod
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+0
+-1:-1:+0
++1:-1:+0
+-1:+1:+0
++1:+2:+1
++2:+1:+0
++1000000000:+9:+1
++2000000000:+9:+2
++3000000000:+9:+3
++4000000000:+9:+4
++5000000000:+9:+5
++6000000000:+9:+6
++7000000000:+9:+7
++8000000000:+9:+8
++9000000000:+9:+0
++35500000:+113:+33
++71000000:+226:+66
++106500000:+339:+99
++1000000000:+3:+1
++10:+5:+0
++100:+4:+0
++1000:+8:+0
++10000:+16:+0
++999999999999:+9:+0
++999999999999:+99:+0
++999999999999:+999:+0
++999999999999:+9999:+0
++999999999999999:+99999:+0
+-9:+5:+1
++9:-5:-1
+-9:-5:-4
+-5:3:1
+-2:3:1
+4:3:1
+1:3:1
+-5:-3:-2
+-2:-3:-2
+4:-3:-2
+1:-3:-2
+&bgcd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+1
++1:+0:+1
++1:+1:+1
++2:+3:+1
++3:+2:+1
+-3:+2:+1
++100:+625:+25
++4096:+81:+1
++1034:+804:+2
++27:+90:+56:+1
++27:+90:+54:+9
+&blcm
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:NaN
++1:+0:+0
++0:+1:+0
++27:+90:+270
++1034:+804:+415668
+&band
+abc:abc:NaN
+abc:0:NaN
+0:abc:NaN
++8:+2:+0
++281474976710656:+0:+0
++281474976710656:+1:+0
++281474976710656:+281474976710656:+281474976710656
+&bior
+abc:abc:NaN
+abc:0:NaN
+0:abc:NaN
++8:+2:+10
++281474976710656:+0:+281474976710656
++281474976710656:+1:+281474976710657
++281474976710656:+281474976710656:+281474976710656
+&bxor
+abc:abc:NaN
+abc:0:NaN
+0:abc:NaN
++8:+2:+10
++281474976710656:+0:+281474976710656
++281474976710656:+1:+281474976710657
++281474976710656:+281474976710656:+0
+&bnot
+abc:NaN
++0:-1
++8:-9
++281474976710656:-281474976710657
+&digit
+0:0:0
+12:0:2
+12:1:1
+123:0:3
+123:1:2
+123:2:1
+123:-1:1
+123:-2:2
+123:-3:3
+123456:0:6
+123456:1:5
+123456:2:4
+123456:3:3
+123456:4:2
+123456:5:1
+123456:-1:1
+123456:-2:2
+123456:-3:3
+100000:-3:0
+100000:0:0
+100000:1:0
+&mantissa
+abc:NaN
+1e4:1
+2e0:2
+123:123
+-1:-1
+-2:-2
+&exponent
+abc:NaN
+1e4:4
+2e0:0
+123:0
+-1:0
+-2:0
+0:1
+&parts
+abc:NaN,NaN
+1e4:1,4
+2e0:2,0
+123:123,0
+-1:-1,0
+-2:-2,0
+0:0,1
+&bpow
+0:0:1
+0:1:0
+0:2:0
+0:-1:NaN
+0:-2:NaN
+1:0:1
+1:1:1
+1:2:1
+1:3:1
+1:-1:1
+1:-2:1
+1:-3:1
+2:0:1
+2:1:2
+2:2:4
+2:3:8
+3:3:27
+2:-1:NaN
+-2:-1:NaN
+2:-2:NaN
+-2:-2:NaN
+# 1 ** -x => 1 / (1 ** x)
+-1:0:1
+-2:0:1
+-1:1:-1
+-1:2:1
+-1:3:-1
+-1:4:1
+-1:5:-1
+-1:-1:-1
+-1:-2:1
+-1:-3:-1
+-1:-4:1
+10:2:100
+10:3:1000
+10:4:10000
+10:5:100000
+10:6:1000000
+10:7:10000000
+10:8:100000000
+10:9:1000000000
+10:20:100000000000000000000
+123456:2:15241383936
+&length
+100:3
+10:2
+1:1
+0:1
+12345:5
+10000000000000000:17
+-123:3
+&bsqrt
+144:12
+16:4
+4:2
+2:1
+12:3
+256:16
+100000000:10000
+4000000000000:2000000
+1:1
+0:0
+-2:NaN
+Nan:NaN
+&bround
+$round_mode('trunc')
+1234:0:1234
+1234:2:1200
+123456:4:123400
+123456:5:123450
+123456:6:123456
++10123456789:5:+10123000000
+-10123456789:5:-10123000000
++10123456789:9:+10123456700
+-10123456789:9:-10123456700
++101234500:6:+101234000
+-101234500:6:-101234000
+#+101234500:-4:+101234000
+#-101234500:-4:-101234000
+$round_mode('zero')
++20123456789:5:+20123000000
+-20123456789:5:-20123000000
++20123456789:9:+20123456800
+-20123456789:9:-20123456800
++201234500:6:+201234000
+-201234500:6:-201234000
+#+201234500:-4:+201234000
+#-201234500:-4:-201234000
++12345000:4:12340000
+-12345000:4:-12340000
+$round_mode('+inf')
++30123456789:5:+30123000000
+-30123456789:5:-30123000000
++30123456789:9:+30123456800
+-30123456789:9:-30123456800
++301234500:6:+301235000
+-301234500:6:-301234000
+#+301234500:-4:+301235000
+#-301234500:-4:-301234000
++12345000:4:12350000
+-12345000:4:-12340000
+$round_mode('-inf')
++40123456789:5:+40123000000
+-40123456789:5:-40123000000
++40123456789:9:+40123456800
+-40123456789:9:-40123456800
++401234500:6:+401234000
++401234500:6:+401234000
+#-401234500:-4:-401235000
+#-401234500:-4:-401235000
++12345000:4:12340000
+-12345000:4:-12350000
+$round_mode('odd')
++50123456789:5:+50123000000
+-50123456789:5:-50123000000
++50123456789:9:+50123456800
+-50123456789:9:-50123456800
++501234500:6:+501235000
+-501234500:6:-501235000
+#+501234500:-4:+501235000
+#-501234500:-4:-501235000
++12345000:4:12350000
+-12345000:4:-12350000
+$round_mode('even')
++60123456789:5:+60123000000
+-60123456789:5:-60123000000
++60123456789:9:+60123456800
+-60123456789:9:-60123456800
++601234500:6:+601234000
+-601234500:6:-601234000
+#+601234500:-4:+601234000
+#-601234500:-4:-601234000
+#-601234500:-9:0
+#-501234500:-9:0
+#-601234500:-8:0
+#-501234500:-8:0
++1234567:7:1234567
++1234567:6:1234570
++12345000:4:12340000
+-12345000:4:-12340000
+&is_odd
+abc:0
+0:0
+1:1
+3:1
+-1:1
+-3:1
+10000001:1
+10000002:0
+2:0
+&is_even
+abc:0
+0:1
+1:0
+3:0
+-1:0
+-3:0
+10000001:0
+10000002:1
+2:1
+&is_zero
+0:1
+NaNzero:0
+123:0
+-1:0
+1:0
+&_set
+2:-1:-1
+-2:1:1
+NaN:2:2
+2:abc:NaN
+&is_one
+0:0
+1:1
+2:0
+-1:0
+-2:0
+# floor and ceil tests are pretty pointless in integer space...but play safe
+&bfloor
+0:0
+-1:-1
+-2:-2
+2:2
+3:3
+abc:NaN
+&bceil
+0:0
+-1:-1
+-2:-2
+2:2
+3:3
+abc:NaN

diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t
new file mode 100644 (file)
index 0000000..3948102
--- /dev/null
+++ b/lib/Math/BigInt/t/mbimbf.t
@@ -0,0 +1,214 @@
+#!/usr/bin/perl -w
+
+# test accuracy, precicion and fallback, round_mode
+
+use strict;
+use Test;
+
+BEGIN 
+  {
+  $| = 1;
+  # chdir 't' if -d 't';
+  unshift @INC, '../lib'; # for running manually
+  plan tests => 103;
+  }
+
+use Math::BigInt;
+use Math::BigFloat;
+
+my ($x,$y,$z,$u);
+
+###############################################################################
+# test defaults and set/get
+
+ok_undef ($Math::BigInt::accuracy);
+ok_undef ($Math::BigInt::precision);
+ok ($Math::BigInt::div_scale,40);
+ok (Math::BigInt::round_mode(),'even');
+ok ($Math::BigInt::rnd_mode,'even');
+
+ok_undef ($Math::BigFloat::accuracy);
+ok_undef ($Math::BigFloat::precision);
+ok ($Math::BigFloat::div_scale,40);
+ok ($Math::BigFloat::rnd_mode,'even');
+
+# accuracy
+foreach (qw/5 42 -1 0/)
+  {
+  ok ($Math::BigFloat::accuracy = $_,$_);
+  ok ($Math::BigInt::accuracy = $_,$_);
+  }
+ok_undef ($Math::BigFloat::accuracy = undef);
+ok_undef ($Math::BigInt::accuracy = undef);
+
+# precision
+foreach (qw/5 42 -1 0/)
+  {
+  ok ($Math::BigFloat::precision = $_,$_);
+  ok ($Math::BigInt::precision = $_,$_);
+  }
+ok_undef ($Math::BigFloat::precision = undef);
+ok_undef ($Math::BigInt::precision = undef);
+
+# fallback
+foreach (qw/5 42 1/)
+  {
+  ok ($Math::BigFloat::div_scale = $_,$_);
+  ok ($Math::BigInt::div_scale = $_,$_);
+  }
+# illegal values are possible for fallback due to no accessor
+
+# round_mode
+foreach (qw/odd even zero trunc +inf -inf/)
+  {
+  ok ($Math::BigFloat::rnd_mode = $_,$_);
+  ok ($Math::BigInt::rnd_mode = $_,$_);
+  }
+$Math::BigFloat::rnd_mode = 4;
+ok ($Math::BigFloat::rnd_mode,4);
+ok ($Math::BigInt::rnd_mode,'-inf');   # from above
+
+$Math::BigInt::accuracy = undef;
+$Math::BigInt::precision = undef;
+# local copies
+$x = Math::BigFloat->new(123.456);
+ok_undef ($x->accuracy());
+ok ($x->accuracy(5),5);
+ok_undef ($x->accuracy(undef),undef);
+ok_undef ($x->precision());
+ok ($x->precision(5),5);
+ok_undef ($x->precision(undef),undef);
+
+# see if MBF changes MBIs values
+ok ($Math::BigInt::accuracy = 42,42);
+ok ($Math::BigFloat::accuracy = 64,64);
+ok ($Math::BigInt::accuracy,42);               # should be still 42
+ok ($Math::BigFloat::accuracy,64);             # should be still 64
+
+###############################################################################
+# see if creating a number under set A or P will round it
+
+$Math::BigInt::accuracy = 4;
+$Math::BigInt::precision = 3;
+
+ok (Math::BigInt->new(123456),123500); # with A
+$Math::BigInt::accuracy = undef;
+ok (Math::BigInt->new(123456),123000); # with P
+
+$Math::BigFloat::accuracy = 4;
+$Math::BigFloat::precision = -1;
+$Math::BigInt::precision = undef;
+
+ok (Math::BigFloat->new(123.456),123.5);       # with A
+$Math::BigFloat::accuracy = undef;
+ok (Math::BigFloat->new(123.456),123.5);       # with P from MBF, not MBI!
+
+$Math::BigFloat::precision = undef;
+
+###############################################################################
+# see if setting accuracy/precision actually rounds the number
+
+$x = Math::BigFloat->new(123.456); $x->accuracy(4);   ok ($x,123.5);
+$x = Math::BigFloat->new(123.456); $x->precision(-2); ok ($x,123.46);
+
+$x = Math::BigInt->new(123456);    $x->accuracy(4);   ok ($x,123500);
+$x = Math::BigInt->new(123456);    $x->precision(2);  ok ($x,123500);
+
+###############################################################################
+# test actual rounding via round()
+
+$x = Math::BigFloat->new(123.456);
+ok ($x->copy()->round(5,2),123.46);
+ok ($x->copy()->round(4,2),123.5);
+ok ($x->copy()->round(undef,-2),123.46);
+ok ($x->copy()->round(undef,2),100);
+
+$x = Math::BigFloat->new(123.45000);
+ok ($x->copy()->round(undef,-1,'odd'),123.5);
+
+# see if rounding is 'sticky'
+$x = Math::BigFloat->new(123.4567);
+$y = $x->copy()->bround();             # no-op since nowhere A or P defined
+
+ok ($y,123.4567);                      
+$y = $x->copy()->round(5,2);
+ok ($y->accuracy(),5);
+ok_undef ($y->precision());            # A has precedence, so P still unset
+$y = $x->copy()->round(undef,2);
+ok ($y->precision(),2);
+ok_undef ($y->accuracy());             # P has precedence, so A still unset
+
+# does copy work?
+$x = Math::BigFloat->new(123.456); $x->accuracy(4); $x->precision(2);
+$z = $x->copy(); ok ($z->accuracy(),4); ok ($z->precision(),2);
+
+###############################################################################
+# test wether operations round properly afterwards
+# These tests are not complete, since they do not excercise every "return"
+# statement in the op's. But heh, it's better than nothing...
+
+$x = Math::BigFloat->new(123.456);
+$y = Math::BigFloat->new(654.321);
+$x->{_a} = 5;          # $x->accuracy(5) would round $x straightaway
+$y->{_a} = 4;          # $y->accuracy(4) would round $x straightaway
+
+$z = $x + $y;          ok ($z,777.8);
+$z = $y - $x;          ok ($z,530.9);
+$z = $y * $x;          ok ($z,80780);
+$z = $x ** 2;          ok ($z,15241);
+$z = $x * $x;          ok ($z,15241);
+# not yet: $z = -$x;           ok ($z,-123.46); ok ($x,123.456);
+$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62);
+$x = Math::BigFloat->new(123456); $x->{_a} = 4;
+$z = $x->copy; $z++;   ok ($z,123500);
+
+$x = Math::BigInt->new(123456);
+$y = Math::BigInt->new(654321);
+$x->{_a} = 5;          # $x->accuracy(5) would round $x straightaway
+$y->{_a} = 4;          # $y->accuracy(4) would round $x straightaway
+
+$z = $x + $y;          ok ($z,777800);
+$z = $y - $x;          ok ($z,530900);
+$z = $y * $x;          ok ($z,80780000000);
+$z = $x ** 2;          ok ($z,15241000000);
+# not yet: $z = -$x;           ok ($z,-123460); ok ($x,123456);
+$z = $x->copy; $z++;   ok ($z,123460);
+$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62000);
+
+###############################################################################
+# test mixed arguments
+
+$x = Math::BigFloat->new(10);
+$u = Math::BigFloat->new(2.5);
+$y = Math::BigInt->new(2);
+
+$z = $x + $y; ok ($z,12); ok (ref($z),'Math::BigFloat');
+$z = $x / $y; ok ($z,5); ok (ref($z),'Math::BigFloat');
+$z = $u * $y; ok ($z,5); ok (ref($z),'Math::BigFloat');
+
+$y = Math::BigInt->new(12345);
+$z = $u->copy()->bmul($y,2,0,'odd'); ok ($z,31000);
+$z = $u->copy()->bmul($y,3,0,'odd'); ok ($z,30900);
+$z = $u->copy()->bmul($y,undef,0,'odd'); ok ($z,30863);
+$z = $u->copy()->bmul($y,undef,1,'odd'); ok ($z,30860);
+$z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
+
+# breakage:
+# $z = $y->copy()->bmul($u,2,0,'odd'); ok ($z,31000);
+# $z = $y * $u; ok ($z,5); ok (ref($z),'Math::BigInt');
+# $z = $y + $x; ok ($z,12); ok (ref($z),'Math::BigInt');
+# $z = $y / $x; ok ($z,0); ok (ref($z),'Math::BigInt');
+
+# all done
+
+###############################################################################
+# Perl 5.005 does not like ok ($x,undef)
+
+sub ok_undef
+  {
+  my $x = shift;
+
+  ok (1,1) and return if !defined $x;
+  ok ($x,'undef');
+  }
+

diff --git a/lib/Math/Complex.t b/lib/Math/Complex.t
new file mode 100755 (executable)
index 0000000..334374d
--- /dev/null
+++ b/lib/Math/Complex.t
@@ -0,0 +1,979 @@
+#!./perl
+
+# $RCSfile: complex.t,v $
+#
+# Regression tests for the Math::Complex pacakge
+# -- Raphael Manfredi  since Sep 1996
+# -- Jarkko Hietaniemi since Mar 1997
+# -- Daniel S. Lewart  since Sep 1997
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Math::Complex;
+
+use vars qw($VERSION);
+
+$VERSION = 1.91;
+
+my ($args, $op, $target, $test, $test_set, $try, $val, $zvalue, @set, @val);
+
+$test = 0;
+$| = 1;
+my @script = (
+    'my ($res, $s0,$s1,$s2,$s3,$s4,$s5,$s6,$s7,$s8,$s9,$s10, $z0,$z1,$z2);' .
+       "\n\n"
+);
+my $eps = 1e-13;
+
+if ($^O eq 'unicos') {         # For some reason root() produces very inaccurate
+    $eps = 1e-10;      # results in Cray UNICOS, and occasionally also
+}                      # cos(), sin(), cosh(), sinh().  The division
+                       # of doubles is the current suspect.
+
+while (<DATA>) {
+       s/^\s+//;
+       next if $_ eq '' || /^\#/;
+       chomp;
+       $test_set = 0;          # Assume not a test over a set of values
+       if (/^&(.+)/) {
+               $op = $1;
+               next;
+       }
+       elsif (/^\{(.+)\}/) {
+               set($1, \@set, \@val);
+               next;
+       }
+       elsif (s/^\|//) {
+               $test_set = 1;  # Requests we loop over the set...
+       }
+       my @args = split(/:/);
+       if ($test_set == 1) {
+               my $i;
+               for ($i = 0; $i < @set; $i++) {
+                       # complex number
+                       $target = $set[$i];
+                       # textual value as found in set definition
+                       $zvalue = $val[$i];
+                       test($zvalue, $target, @args);
+               }
+       } else {
+               test($op, undef, @args);
+       }
+}
+
+#
+
+sub test_mutators {
+    my $op;
+
+    $test++;
+push(@script, <<'EOT');
+{
+    my $z = cplx(  1,  1);
+    $z->Re(2);
+    $z->Im(3);
+    print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
+    print 'not ' unless Re($z) == 2 and Im($z) == 3;
+EOT
+    push(@script, qq(print "ok $test\\n"}\n));
+
+    $test++;
+push(@script, <<'EOT');
+{
+    my $z = cplx(  1,  1);
+    $z->abs(3 * sqrt(2));
+    print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
+    print 'not ' unless (abs($z) - 3 * sqrt(2)) < $eps and
+                        (arg($z) - pi / 4     ) < $eps and
+                        (Re($z) - 3           ) < $eps and
+                        (Im($z) - 3           ) < $eps;
+EOT
+    push(@script, qq(print "ok $test\\n"}\n));
+
+    $test++;
+push(@script, <<'EOT');
+{
+    my $z = cplx(  1,  1);
+    $z->arg(-3 / 4 * pi);
+    print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
+    print 'not ' unless (arg($z) + 3 / 4 * pi) < $eps and
+                        (abs($z) - sqrt(2)   ) < $eps and
+                        (Re($z) + 1          ) < $eps and
+                        (Im($z) + 1          ) < $eps;
+EOT
+    push(@script, qq(print "ok $test\\n"}\n));
+}
+
+test_mutators();
+
+my $constants = '
+my $i    = cplx(0,  1);
+my $pi   = cplx(pi, 0);
+my $pii  = cplx(0, pi);
+my $pip2 = cplx(pi/2, 0);
+my $zero = cplx(0, 0);
+';
+
+push(@script, $constants);
+
+
+# test the divbyzeros
+
+sub test_dbz {
+    for my $op (@_) {
+       $test++;
+       push(@script, <<EOT);
+       eval '$op';
+       (\$bad) = (\$@ =~ /(.+)/);
+       print "# $test op = $op divbyzero? \$bad...\n";
+       print 'not ' unless (\$@ =~ /Division by zero/);
+EOT
+        push(@script, qq(print "ok $test\\n";\n));
+    }
+}
+
+# test the logofzeros
+
+sub test_loz {
+    for my $op (@_) {
+       $test++;
+       push(@script, <<EOT);
+       eval '$op';
+       (\$bad) = (\$@ =~ /(.+)/);
+       print "# $test op = $op logofzero? \$bad...\n";
+       print 'not ' unless (\$@ =~ /Logarithm of zero/);
+EOT
+        push(@script, qq(print "ok $test\\n";\n));
+    }
+}
+
+test_dbz(
+        'i/0',
+        'acot(0)',
+        'acot(+$i)',
+#       'acoth(-1)',   # Log of zero.
+        'acoth(0)',
+        'acoth(+1)',
+        'acsc(0)',
+        'acsch(0)',
+        'asec(0)',
+        'asech(0)',
+        'atan($i)',
+#       'atanh(-1)',   # Log of zero.
+        'atanh(+1)',
+        'cot(0)',
+        'coth(0)',
+        'csc(0)',
+        'csch(0)',
+       );
+
+test_loz(
+        'log($zero)',
+        'atan(-$i)',
+        'acot(-$i)',
+        'atanh(-1)',
+        'acoth(-1)',
+       );
+
+# test the bad roots
+
+sub test_broot {
+    for my $op (@_) {
+       $test++;
+       push(@script, <<EOT);
+       eval 'root(2, $op)';
+       (\$bad) = (\$@ =~ /(.+)/);
+       print "# $test op = $op badroot? \$bad...\n";
+       print 'not ' unless (\$@ =~ /root rank must be/);
+EOT
+        push(@script, qq(print "ok $test\\n";\n));
+    }
+}
+
+test_broot(qw(-3 -2.1 0 0.99));
+
+sub test_display_format {
+    $test++;
+    push @script, <<EOS;
+    print "# package display_format cartesian?\n";
+    print "not " unless Math::Complex->display_format eq 'cartesian';
+    print "ok $test\n";
+EOS
+
+    push @script, <<EOS;
+    my \$j = (root(1,3))[1];
+
+    \$j->display_format('polar');
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j display_format polar?\n";
+    print "not " unless \$j->display_format eq 'polar';
+    print "ok $test\n";
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" eq "[1,2pi/3]";
+    print "ok $test\n";
+
+    my %display_format;
+
+    %display_format = \$j->display_format;
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# display_format{style} polar?\n";
+    print "not " unless \$display_format{style} eq 'polar';
+    print "ok $test\n";
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# keys %display_format == 2?\n";
+    print "not " unless keys %display_format == 2;
+    print "ok $test\n";
+
+    \$j->display_format('style' => 'cartesian', 'format' => '%.5f');
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" eq "-0.50000+0.86603i";
+    print "ok $test\n";
+
+    %display_format = \$j->display_format;
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# display_format{format} %.5f?\n";
+    print "not " unless \$display_format{format} eq '%.5f';
+    print "ok $test\n";
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# keys %display_format == 3?\n";
+    print "not " unless keys %display_format == 3;
+    print "ok $test\n";
+
+    \$j->display_format('format' => undef);
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" =~ /^-0(?:\\.5(?:0000\\d+)?|\\.49999\\d+)\\+0.86602540\\d+i\$/;
+    print "ok $test\n";
+
+    \$j->display_format('style' => 'polar', 'polar_pretty_print' => 0);
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" =~ /^\\[1,2\\.09439510\\d+\\]\$/;
+    print "ok $test\n";
+
+    \$j->display_format('style' => 'cartesian', 'format' => '(%.5g)');
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" eq "(-0.5)+(0.86603)i";
+    print "ok $test\n";
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j display_format cartesian?\n";
+    print "not " unless \$j->display_format eq 'cartesian';
+    print "ok $test\n";
+EOS
+}
+
+test_display_format();
+
+print "1..$test\n";
+eval join '', @script;
+die $@ if $@;
+
+sub abop {
+       my ($op) = @_;
+
+       push(@script, qq(print "# $op=\n";));
+}
+
+sub test {
+       my ($op, $z, @args) = @_;
+       my ($baop) = 0;
+       $test++;
+       my $i;
+       $baop = 1 if ($op =~ s/;=$//);
+       for ($i = 0; $i < @args; $i++) {
+               $val = value($args[$i]);
+               push @script, "\$z$i = $val;\n";
+       }
+       if (defined $z) {
+               $args = "'$op'";                # Really the value
+               $try = "abs(\$z0 - \$z1) <= $eps ? \$z1 : \$z0";
+               push @script, "\$res = $try; ";
+               push @script, "check($test, $args[0], \$res, \$z$#args, $args);\n";
+       } else {
+               my ($try, $args);
+               if (@args == 2) {
+                       $try = "$op \$z0";
+                       $args = "'$args[0]'";
+               } else {
+                       $try = ($op =~ /^\w/) ? "$op(\$z0, \$z1)" : "\$z0 $op \$z1";
+                       $args = "'$args[0]', '$args[1]'";
+               }
+               push @script, "\$res = $try; ";
+               push @script, "check($test, '$try', \$res, \$z$#args, $args);\n";
+               if (@args > 2 and $baop) { # binary assignment ops
+                       $test++;
+                       # check the op= works
+                       push @script, <<EOB;
+{
+       my \$za = cplx(ref \$z0 ? \@{\$z0->cartesian} : (\$z0, 0));
+
+       my (\$z1r, \$z1i) = ref \$z1 ? \@{\$z1->cartesian} : (\$z1, 0);
+
+       my \$zb = cplx(\$z1r, \$z1i);
+
+       \$za $op= \$zb;
+       my (\$zbr, \$zbi) = \@{\$zb->cartesian};
+
+       check($test, '\$z0 $op= \$z1', \$za, \$z$#args, $args);
+EOB
+                       $test++;
+                       # check that the rhs has not changed
+                       push @script, qq(print "not " unless (\$zbr == \$z1r and \$zbi == \$z1i););
+                       push @script, qq(print "ok $test\\n";\n);
+                       push @script, "}\n";
+               }
+       }
+}
+
+sub set {
+       my ($set, $setref, $valref) = @_;
+       @{$setref} = ();
+       @{$valref} = ();
+       my @set = split(/;\s*/, $set);
+       my @res;
+       my $i;
+       for ($i = 0; $i < @set; $i++) {
+               push(@{$valref}, $set[$i]);
+               my $val = value($set[$i]);
+               push @script, "\$s$i = $val;\n";
+               push @{$setref}, "\$s$i";
+       }
+}
+
+sub value {
+       local ($_) = @_;
+       if (/^\s*\((.*),(.*)\)/) {
+               return "cplx($1,$2)";
+       }
+       elsif (/^\s*([\-\+]?(?:\d+(\.\d+)?|\.\d+)(?:[e[\-\+]\d+])?)/) {
+               return "cplx($1,0)";
+       }
+       elsif (/^\s*\[(.*),(.*)\]/) {
+               return "cplxe($1,$2)";
+       }
+       elsif (/^\s*'(.*)'/) {
+               my $ex = $1;
+               $ex =~ s/\bz\b/$target/g;
+               $ex =~ s/\br\b/abs($target)/g;
+               $ex =~ s/\bt\b/arg($target)/g;
+               $ex =~ s/\ba\b/Re($target)/g;
+               $ex =~ s/\bb\b/Im($target)/g;
+               return $ex;
+       }
+       elsif (/^\s*"(.*)"/) {
+               return "\"$1\"";
+       }
+       return $_;
+}
+
+sub check {
+       my ($test, $try, $got, $expected, @z) = @_;
+
+       print "# @_\n";
+
+       if ("$got" eq "$expected"
+           ||
+           ($expected =~ /^-?\d/ && $got == $expected)
+           ||
+           (abs($got - $expected) < $eps)
+           ) {
+               print "ok $test\n";
+       } else {
+               print "not ok $test\n";
+               my $args = (@z == 1) ? "z = $z[0]" : "z0 = $z[0], z1 = $z[1]";
+               print "# '$try' expected: '$expected' got: '$got' for $args\n";
+       }
+}
+
+sub addsq {
+    my ($z1, $z2) = @_;
+    return ($z1 + i*$z2) * ($z1 - i*$z2);
+}
+
+sub subsq {
+    my ($z1, $z2) = @_;
+    return ($z1 + $z2) * ($z1 - $z2);
+}
+
+__END__
+&+;=
+(3,4):(3,4):(6,8)
+(-3,4):(3,-4):(0,0)
+(3,4):-3:(0,4)
+1:(4,2):(5,2)
+[2,0]:[2,pi]:(0,0)
+
+&++
+(2,1):(3,1)
+
+&-;=
+(2,3):(-2,-3)
+[2,pi/2]:[2,-(pi)/2]
+2:[2,0]:(0,0)
+[3,0]:2:(1,0)
+3:(4,5):(-1,-5)
+(4,5):3:(1,5)
+(2,1):(3,5):(-1,-4)
+
+&--
+(1,2):(0,2)
+[2,pi]:[3,pi]
+
+&*;=
+(0,1):(0,1):(-1,0)
+(4,5):(1,0):(4,5)
+[2,2*pi/3]:(1,0):[2,2*pi/3]
+2:(0,1):(0,2)
+(0,1):3:(0,3)
+(0,1):(4,1):(-1,4)
+(2,1):(4,-1):(9,2)
+
+&/;=
+(3,4):(3,4):(1,0)
+(4,-5):1:(4,-5)
+1:(0,1):(0,-1)
+(0,6):(0,2):(3,0)
+(9,2):(4,-1):(2,1)
+[4,pi]:[2,pi/2]:[2,pi/2]
+[2,pi/2]:[4,pi]:[0.5,-(pi)/2]
+
+&**;=
+(2,0):(3,0):(8,0)
+(3,0):(2,0):(9,0)
+(2,3):(4,0):(-119,-120)
+(0,0):(1,0):(0,0)
+(0,0):(2,3):(0,0)
+(1,0):(0,0):(1,0)
+(1,0):(1,0):(1,0)
+(1,0):(2,3):(1,0)
+(2,3):(0,0):(1,0)
+(2,3):(1,0):(2,3)
+(0,0):(0,0):(1,0)
+
+&Re
+(3,4):3
+(-3,4):-3
+[1,pi/2]:0
+
+&Im
+(3,4):4
+(3,-4):-4
+[1,pi/2]:1
+
+&abs
+(3,4):5
+(-3,4):5
+
+&arg
+[2,0]:0
+[-2,0]:pi
+
+&~
+(4,5):(4,-5)
+(-3,4):(-3,-4)
+[2,pi/2]:[2,-(pi)/2]
+
+&<
+(3,4):(1,2):0
+(3,4):(3,2):0
+(3,4):(3,8):1
+(4,4):(5,129):1
+
+&==
+(3,4):(4,5):0
+(3,4):(3,5):0
+(3,4):(2,4):0
+(3,4):(3,4):1
+
+&sqrt
+-9:(0,3)
+(-100,0):(0,10)
+(16,-30):(5,-3)
+
+&stringify_cartesian
+(-100,0):"-100"
+(0,1):"i"
+(4,-3):"4-3i"
+(4,0):"4"
+(-4,0):"-4"
+(-2,4):"-2+4i"
+(-2,-1):"-2-i"
+
+&stringify_polar
+[-1, 0]:"[1,pi]"
+[1, pi/3]:"[1,pi/3]"
+[6, -2*pi/3]:"[6,-2pi/3]"
+[0.5, -9*pi/11]:"[0.5,-9pi/11]"
+
+{ (4,3); [3,2]; (-3,4); (0,2); [2,1] }
+
+|'z + ~z':'2*Re(z)'
+|'z - ~z':'2*i*Im(z)'
+|'z * ~z':'abs(z) * abs(z)'
+
+{ (0.5, 0); (-0.5, 0); (2,3); [3,2]; (-3,2); (0,2); 3; 1.2; (-3, 0); (-2, -1); [2,1] }
+
+|'(root(z, 4))[1] ** 4':'z'
+|'(root(z, 5))[3] ** 5':'z'
+|'(root(z, 8))[7] ** 8':'z'
+|'abs(z)':'r'
+|'acot(z)':'acotan(z)'
+|'acsc(z)':'acosec(z)'
+|'acsc(z)':'asin(1 / z)'
+|'asec(z)':'acos(1 / z)'
+|'cbrt(z)':'cbrt(r) * exp(i * t/3)'
+|'cos(acos(z))':'z'
+|'addsq(cos(z), sin(z))':1
+|'cos(z)':'cosh(i*z)'
+|'subsq(cosh(z), sinh(z))':1
+|'cot(acot(z))':'z'
+|'cot(z)':'1 / tan(z)'
+|'cot(z)':'cotan(z)'
+|'csc(acsc(z))':'z'
+|'csc(z)':'1 / sin(z)'
+|'csc(z)':'cosec(z)'
+|'exp(log(z))':'z'
+|'exp(z)':'exp(a) * exp(i * b)'
+|'ln(z)':'log(z)'
+|'log(exp(z))':'z'
+|'log(z)':'log(r) + i*t'
+|'log10(z)':'log(z) / log(10)'
+|'logn(z, 2)':'log(z) / log(2)'
+|'logn(z, 3)':'log(z) / log(3)'
+|'sec(asec(z))':'z'
+|'sec(z)':'1 / cos(z)'
+|'sin(asin(z))':'z'
+|'sin(i * z)':'i * sinh(z)'
+|'sqrt(z) * sqrt(z)':'z'
+|'sqrt(z)':'sqrt(r) * exp(i * t/2)'
+|'tan(atan(z))':'z'
+|'z**z':'exp(z * log(z))'
+
+{ (1,1); [1,0.5]; (-2, -1); 2; -3; (-1,0.5); (0,0.5); 0.5; (2, 0); (-1, -2) }
+
+|'cosh(acosh(z))':'z'
+|'coth(acoth(z))':'z'
+|'coth(z)':'1 / tanh(z)'
+|'coth(z)':'cotanh(z)'
+|'csch(acsch(z))':'z'
+|'csch(z)':'1 / sinh(z)'
+|'csch(z)':'cosech(z)'
+|'sech(asech(z))':'z'
+|'sech(z)':'1 / cosh(z)'
+|'sinh(asinh(z))':'z'
+|'tanh(atanh(z))':'z'
+
+{ (0.2,-0.4); [1,0.5]; -1.2; (-1,0.5); 0.5; (1.1, 0) }
+
+|'acos(cos(z)) ** 2':'z * z'
+|'acosh(cosh(z)) ** 2':'z * z'
+|'acoth(z)':'acotanh(z)'
+|'acoth(z)':'atanh(1 / z)'
+|'acsch(z)':'acosech(z)'
+|'acsch(z)':'asinh(1 / z)'
+|'asech(z)':'acosh(1 / z)'
+|'asin(sin(z))':'z'
+|'asinh(sinh(z))':'z'
+|'atan(tan(z))':'z'
+|'atanh(tanh(z))':'z'
+
+&log
+(-2.0,0):(   0.69314718055995,  3.14159265358979)
+(-1.0,0):(   0               ,  3.14159265358979)
+(-0.5,0):(  -0.69314718055995,  3.14159265358979)
+( 0.5,0):(  -0.69314718055995,  0               )
+( 1.0,0):(   0               ,  0               )
+( 2.0,0):(   0.69314718055995,  0               )
+
+&log
+( 2, 3):(    1.28247467873077,  0.98279372324733)
+(-2, 3):(    1.28247467873077,  2.15879893034246)
+(-2,-3):(    1.28247467873077, -2.15879893034246)
+( 2,-3):(    1.28247467873077, -0.98279372324733)
+
+&sin
+(-2.0,0):(  -0.90929742682568,  0               )
+(-1.0,0):(  -0.84147098480790,  0               )
+(-0.5,0):(  -0.47942553860420,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.47942553860420,  0               )
+( 1.0,0):(   0.84147098480790,  0               )
+( 2.0,0):(   0.90929742682568,  0               )
+
+&sin
+( 2, 3):(  9.15449914691143, -4.16890695996656)
+(-2, 3):( -9.15449914691143, -4.16890695996656)
+(-2,-3):( -9.15449914691143,  4.16890695996656)
+( 2,-3):(  9.15449914691143,  4.16890695996656)
+
+&cos
+(-2.0,0):(  -0.41614683654714,  0               )
+(-1.0,0):(   0.54030230586814,  0               )
+(-0.5,0):(   0.87758256189037,  0               )
+( 0.0,0):(   1               ,  0               )
+( 0.5,0):(   0.87758256189037,  0               )
+( 1.0,0):(   0.54030230586814,  0               )
+( 2.0,0):(  -0.41614683654714,  0               )
+
+&cos
+( 2, 3):( -4.18962569096881, -9.10922789375534)
+(-2, 3):( -4.18962569096881,  9.10922789375534)
+(-2,-3):( -4.18962569096881, -9.10922789375534)
+( 2,-3):( -4.18962569096881,  9.10922789375534)
+
+&tan
+(-2.0,0):(   2.18503986326152,  0               )
+(-1.0,0):(  -1.55740772465490,  0               )
+(-0.5,0):(  -0.54630248984379,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.54630248984379,  0               )
+( 1.0,0):(   1.55740772465490,  0               )
+( 2.0,0):(  -2.18503986326152,  0               )
+
+&tan
+( 2, 3):( -0.00376402564150,  1.00323862735361)
+(-2, 3):(  0.00376402564150,  1.00323862735361)
+(-2,-3):(  0.00376402564150, -1.00323862735361)
+( 2,-3):( -0.00376402564150, -1.00323862735361)
+
+&sec
+(-2.0,0):(  -2.40299796172238,  0               )
+(-1.0,0):(   1.85081571768093,  0               )
+(-0.5,0):(   1.13949392732455,  0               )
+( 0.0,0):(   1               ,  0               )
+( 0.5,0):(   1.13949392732455,  0               )
+( 1.0,0):(   1.85081571768093,  0               )
+( 2.0,0):(  -2.40299796172238,  0               )
+
+&sec
+( 2, 3):( -0.04167496441114,  0.09061113719624)
+(-2, 3):( -0.04167496441114, -0.09061113719624)
+(-2,-3):( -0.04167496441114,  0.09061113719624)
+( 2,-3):( -0.04167496441114, -0.09061113719624)
+
+&csc
+(-2.0,0):(  -1.09975017029462,  0               )
+(-1.0,0):(  -1.18839510577812,  0               )
+(-0.5,0):(  -2.08582964293349,  0               )
+( 0.5,0):(   2.08582964293349,  0               )
+( 1.0,0):(   1.18839510577812,  0               )
+( 2.0,0):(   1.09975017029462,  0               )
+
+&csc
+( 2, 3):(  0.09047320975321,  0.04120098628857)
+(-2, 3):( -0.09047320975321,  0.04120098628857)
+(-2,-3):( -0.09047320975321, -0.04120098628857)
+( 2,-3):(  0.09047320975321, -0.04120098628857)
+
+&cot
+(-2.0,0):(   0.45765755436029,  0               )
+(-1.0,0):(  -0.64209261593433,  0               )
+(-0.5,0):(  -1.83048772171245,  0               )
+( 0.5,0):(   1.83048772171245,  0               )
+( 1.0,0):(   0.64209261593433,  0               )
+( 2.0,0):(  -0.45765755436029,  0               )
+
+&cot
+( 2, 3):( -0.00373971037634, -0.99675779656936)
+(-2, 3):(  0.00373971037634, -0.99675779656936)
+(-2,-3):(  0.00373971037634,  0.99675779656936)
+( 2,-3):( -0.00373971037634,  0.99675779656936)
+
+&asin
+(-2.0,0):(  -1.57079632679490,  1.31695789692482)
+(-1.0,0):(  -1.57079632679490,  0               )
+(-0.5,0):(  -0.52359877559830,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.52359877559830,  0               )
+( 1.0,0):(   1.57079632679490,  0               )
+( 2.0,0):(   1.57079632679490, -1.31695789692482)
+
+&asin
+( 2, 3):(  0.57065278432110,  1.98338702991654)
+(-2, 3):( -0.57065278432110,  1.98338702991654)
+(-2,-3):( -0.57065278432110, -1.98338702991654)
+( 2,-3):(  0.57065278432110, -1.98338702991654)
+
+&acos
+(-2.0,0):(   3.14159265358979, -1.31695789692482)
+(-1.0,0):(   3.14159265358979,  0               )
+(-0.5,0):(   2.09439510239320,  0               )
+( 0.0,0):(   1.57079632679490,  0               )
+( 0.5,0):(   1.04719755119660,  0               )
+( 1.0,0):(   0               ,  0               )
+( 2.0,0):(   0               ,  1.31695789692482)
+
+&acos
+( 2, 3):(  1.00014354247380, -1.98338702991654)
+(-2, 3):(  2.14144911111600, -1.98338702991654)
+(-2,-3):(  2.14144911111600,  1.98338702991654)
+( 2,-3):(  1.00014354247380,  1.98338702991654)
+
+&atan
+(-2.0,0):(  -1.10714871779409,  0               )
+(-1.0,0):(  -0.78539816339745,  0               )
+(-0.5,0):(  -0.46364760900081,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.46364760900081,  0               )
+( 1.0,0):(   0.78539816339745,  0               )
+( 2.0,0):(   1.10714871779409,  0               )
+
+&atan
+( 2, 3):(  1.40992104959658,  0.22907268296854)
+(-2, 3):( -1.40992104959658,  0.22907268296854)
+(-2,-3):( -1.40992104959658, -0.22907268296854)
+( 2,-3):(  1.40992104959658, -0.22907268296854)
+
+&asec
+(-2.0,0):(   2.09439510239320,  0               )
+(-1.0,0):(   3.14159265358979,  0               )
+(-0.5,0):(   3.14159265358979, -1.31695789692482)
+( 0.5,0):(   0               ,  1.31695789692482)
+( 1.0,0):(   0               ,  0               )
+( 2.0,0):(   1.04719755119660,  0               )
+
+&asec
+( 2, 3):(  1.42041072246703,  0.23133469857397)
+(-2, 3):(  1.72118193112276,  0.23133469857397)
+(-2,-3):(  1.72118193112276, -0.23133469857397)
+( 2,-3):(  1.42041072246703, -0.23133469857397)
+
+&acsc
+(-2.0,0):(  -0.52359877559830,  0               )
+(-1.0,0):(  -1.57079632679490,  0               )
+(-0.5,0):(  -1.57079632679490,  1.31695789692482)
+( 0.5,0):(   1.57079632679490, -1.31695789692482)
+( 1.0,0):(   1.57079632679490,  0               )
+( 2.0,0):(   0.52359877559830,  0               )
+
+&acsc
+( 2, 3):(  0.15038560432786, -0.23133469857397)
+(-2, 3):( -0.15038560432786, -0.23133469857397)
+(-2,-3):( -0.15038560432786,  0.23133469857397)
+( 2,-3):(  0.15038560432786,  0.23133469857397)
+
+&acot
+(-2.0,0):(  -0.46364760900081,  0               )
+(-1.0,0):(  -0.78539816339745,  0               )
+(-0.5,0):(  -1.10714871779409,  0               )
+( 0.5,0):(   1.10714871779409,  0               )
+( 1.0,0):(   0.78539816339745,  0               )
+( 2.0,0):(   0.46364760900081,  0               )
+
+&acot
+( 2, 3):(  0.16087527719832, -0.22907268296854)
+(-2, 3):( -0.16087527719832, -0.22907268296854)
+(-2,-3):( -0.16087527719832,  0.22907268296854)
+( 2,-3):(  0.16087527719832,  0.22907268296854)
+
+&sinh
+(-2.0,0):(  -3.62686040784702,  0               )
+(-1.0,0):(  -1.17520119364380,  0               )
+(-0.5,0):(  -0.52109530549375,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.52109530549375,  0               )
+( 1.0,0):(   1.17520119364380,  0               )
+( 2.0,0):(   3.62686040784702,  0               )
+
+&sinh
+( 2, 3):( -3.59056458998578,  0.53092108624852)
+(-2, 3):(  3.59056458998578,  0.53092108624852)
+(-2,-3):(  3.59056458998578, -0.53092108624852)
+( 2,-3):( -3.59056458998578, -0.53092108624852)
+
+&cosh
+(-2.0,0):(   3.76219569108363,  0               )
+(-1.0,0):(   1.54308063481524,  0               )
+(-0.5,0):(   1.12762596520638,  0               )
+( 0.0,0):(   1               ,  0               )
+( 0.5,0):(   1.12762596520638,  0               )
+( 1.0,0):(   1.54308063481524,  0               )
+( 2.0,0):(   3.76219569108363,  0               )
+
+&cosh
+( 2, 3):( -3.72454550491532,  0.51182256998738)
+(-2, 3):( -3.72454550491532, -0.51182256998738)
+(-2,-3):( -3.72454550491532,  0.51182256998738)
+( 2,-3):( -3.72454550491532, -0.51182256998738)
+
+&tanh
+(-2.0,0):(  -0.96402758007582,  0               )
+(-1.0,0):(  -0.76159415595576,  0               )
+(-0.5,0):(  -0.46211715726001,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.46211715726001,  0               )
+( 1.0,0):(   0.76159415595576,  0               )
+( 2.0,0):(   0.96402758007582,  0               )
+
+&tanh
+( 2, 3):(  0.96538587902213, -0.00988437503832)
+(-2, 3):( -0.96538587902213, -0.00988437503832)
+(-2,-3):( -0.96538587902213,  0.00988437503832)
+( 2,-3):(  0.96538587902213,  0.00988437503832)
+
+&sech
+(-2.0,0):(   0.26580222883408,  0               )
+(-1.0,0):(   0.64805427366389,  0               )
+(-0.5,0):(   0.88681888397007,  0               )
+( 0.0,0):(   1               ,  0               )
+( 0.5,0):(   0.88681888397007,  0               )
+( 1.0,0):(   0.64805427366389,  0               )
+( 2.0,0):(   0.26580222883408,  0               )
+
+&sech
+( 2, 3):( -0.26351297515839, -0.03621163655877)
+(-2, 3):( -0.26351297515839,  0.03621163655877)
+(-2,-3):( -0.26351297515839, -0.03621163655877)
+( 2,-3):( -0.26351297515839,  0.03621163655877)
+
+&csch
+(-2.0,0):(  -0.27572056477178,  0               )
+(-1.0,0):(  -0.85091812823932,  0               )
+(-0.5,0):(  -1.91903475133494,  0               )
+( 0.5,0):(   1.91903475133494,  0               )
+( 1.0,0):(   0.85091812823932,  0               )
+( 2.0,0):(   0.27572056477178,  0               )
+
+&csch
+( 2, 3):( -0.27254866146294, -0.04030057885689)
+(-2, 3):(  0.27254866146294, -0.04030057885689)
+(-2,-3):(  0.27254866146294,  0.04030057885689)
+( 2,-3):( -0.27254866146294,  0.04030057885689)
+
+&coth
+(-2.0,0):(  -1.03731472072755,  0               )
+(-1.0,0):(  -1.31303528549933,  0               )
+(-0.5,0):(  -2.16395341373865,  0               )
+( 0.5,0):(   2.16395341373865,  0               )
+( 1.0,0):(   1.31303528549933,  0               )
+( 2.0,0):(   1.03731472072755,  0               )
+
+&coth
+( 2, 3):(  1.03574663776500,  0.01060478347034)
+(-2, 3):( -1.03574663776500,  0.01060478347034)
+(-2,-3):( -1.03574663776500, -0.01060478347034)
+( 2,-3):(  1.03574663776500, -0.01060478347034)
+
+&asinh
+(-2.0,0):(  -1.44363547517881,  0               )
+(-1.0,0):(  -0.88137358701954,  0               )
+(-0.5,0):(  -0.48121182505960,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.48121182505960,  0               )
+( 1.0,0):(   0.88137358701954,  0               )
+( 2.0,0):(   1.44363547517881,  0               )
+
+&asinh
+( 2, 3):(  1.96863792579310,  0.96465850440760)
+(-2, 3):( -1.96863792579310,  0.96465850440761)
+(-2,-3):( -1.96863792579310, -0.96465850440761)
+( 2,-3):(  1.96863792579310, -0.96465850440760)
+
+&acosh
+(-2.0,0):(   1.31695789692482,  3.14159265358979)
+(-1.0,0):(   0,                 3.14159265358979)
+(-0.5,0):(   0,                 2.09439510239320)
+( 0.0,0):(   0,                 1.57079632679490)
+( 0.5,0):(   0,                 1.04719755119660)
+( 1.0,0):(   0               ,  0               )
+( 2.0,0):(   1.31695789692482,  0               )
+
+&acosh
+( 2, 3):(  1.98338702991654,  1.00014354247380)
+(-2, 3):(  1.98338702991653,  2.14144911111600)
+(-2,-3):(  1.98338702991653, -2.14144911111600)
+( 2,-3):(  1.98338702991654, -1.00014354247380)
+
+&atanh
+(-2.0,0):(  -0.54930614433405,  1.57079632679490)
+(-0.5,0):(  -0.54930614433405,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.54930614433405,  0               )
+( 2.0,0):(   0.54930614433405,  1.57079632679490)
+
+&atanh
+( 2, 3):(  0.14694666622553,  1.33897252229449)
+(-2, 3):( -0.14694666622553,  1.33897252229449)
+(-2,-3):( -0.14694666622553, -1.33897252229449)
+( 2,-3):(  0.14694666622553, -1.33897252229449)
+
+&asech
+(-2.0,0):(   0               , 2.09439510239320)
+(-1.0,0):(   0               , 3.14159265358979)
+(-0.5,0):(   1.31695789692482, 3.14159265358979)
+( 0.5,0):(   1.31695789692482, 0               )
+( 1.0,0):(   0               , 0               )
+( 2.0,0):(   0               , 1.04719755119660)
+
+&asech
+( 2, 3):(  0.23133469857397, -1.42041072246703)
+(-2, 3):(  0.23133469857397, -1.72118193112276)
+(-2,-3):(  0.23133469857397,  1.72118193112276)
+( 2,-3):(  0.23133469857397,  1.42041072246703)
+
+&acsch
+(-2.0,0):(  -0.48121182505960, 0               )
+(-1.0,0):(  -0.88137358701954, 0               )
+(-0.5,0):(  -1.44363547517881, 0               )
+( 0.5,0):(   1.44363547517881, 0               )
+( 1.0,0):(   0.88137358701954, 0               )
+( 2.0,0):(   0.48121182505960, 0               )
+
+&acsch
+( 2, 3):(  0.15735549884499, -0.22996290237721)
+(-2, 3):( -0.15735549884499, -0.22996290237721)
+(-2,-3):( -0.15735549884499,  0.22996290237721)
+( 2,-3):(  0.15735549884499,  0.22996290237721)
+
+&acoth
+(-2.0,0):(  -0.54930614433405, 0               )
+(-0.5,0):(  -0.54930614433405, 1.57079632679490)
+( 0.5,0):(   0.54930614433405, 1.57079632679490)
+( 2.0,0):(   0.54930614433405, 0               )
+
+&acoth
+( 2, 3):(  0.14694666622553, -0.23182380450040)
+(-2, 3):( -0.14694666622553, -0.23182380450040)
+(-2,-3):( -0.14694666622553,  0.23182380450040)
+( 2,-3):(  0.14694666622553,  0.23182380450040)
+
+# eof

diff --git a/lib/Math/Trig.t b/lib/Math/Trig.t
new file mode 100755 (executable)
index 0000000..4246a47
--- /dev/null
+++ b/lib/Math/Trig.t
@@ -0,0 +1,200 @@
+#!./perl 
+
+#
+# Regression tests for the Math::Trig package
+#
+# The tests are quite modest as the Math::Complex tests exercise
+# these quite vigorously.
+# 
+# -- Jarkko Hietaniemi, April 1997
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Math::Trig;
+
+use strict;
+
+use vars qw($x $y $z);
+
+my $eps = 1e-11;
+
+if ($^O eq 'unicos') { # See lib/Math/Complex.pm and t/lib/complex.t.
+    $eps = 1e-10;
+}
+
+sub near ($$;$) {
+    my $e = defined $_[2] ? $_[2] : $eps;
+    $_[1] ? (abs($_[0]/$_[1] - 1) < $e) : abs($_[0]) < $e;
+}
+
+print "1..26\n";
+
+$x = 0.9;
+print 'not ' unless (near(tan($x), sin($x) / cos($x)));
+print "ok 1\n";
+
+print 'not ' unless (near(sinh(2), 3.62686040784702));
+print "ok 2\n";
+
+print 'not ' unless (near(acsch(0.1), 2.99822295029797));
+print "ok 3\n";
+
+$x = asin(2);
+print 'not ' unless (ref $x eq 'Math::Complex');
+print "ok 4\n";
+
+# avoid using Math::Complex here
+$x =~ /^([^-]+)(-[^i]+)i$/;
+($y, $z) = ($1, $2);
+print 'not ' unless (near($y,  1.5707963267949) and
+                    near($z, -1.31695789692482));
+print "ok 5\n";
+
+print 'not ' unless (near(deg2rad(90), pi/2));
+print "ok 6\n";
+
+print 'not ' unless (near(rad2deg(pi), 180));
+print "ok 7\n";
+
+use Math::Trig ':radial';
+
+{
+    my ($r,$t,$z) = cartesian_to_cylindrical(1,1,1);
+
+    print 'not ' unless (near($r, sqrt(2)))     and
+                       (near($t, deg2rad(45))) and
+                       (near($z, 1));
+    print "ok 8\n";
+
+    ($x,$y,$z) = cylindrical_to_cartesian($r, $t, $z);
+
+    print 'not ' unless (near($x, 1)) and
+                       (near($y, 1)) and
+                       (near($z, 1));
+    print "ok 9\n";
+
+    ($r,$t,$z) = cartesian_to_cylindrical(1,1,0);
+
+    print 'not ' unless (near($r, sqrt(2)))     and
+                       (near($t, deg2rad(45))) and
+                       (near($z, 0));
+    print "ok 10\n";
+
+    ($x,$y,$z) = cylindrical_to_cartesian($r, $t, $z);
+
+    print 'not ' unless (near($x, 1)) and
+                       (near($y, 1)) and
+                       (near($z, 0));
+    print "ok 11\n";
+}
+
+{
+    my ($r,$t,$f) = cartesian_to_spherical(1,1,1);
+
+    print 'not ' unless (near($r, sqrt(3)))     and
+                       (near($t, deg2rad(45))) and
+                       (near($f, atan2(sqrt(2), 1)));
+    print "ok 12\n";
+
+    ($x,$y,$z) = spherical_to_cartesian($r, $t, $f);
+
+    print 'not ' unless (near($x, 1)) and
+                       (near($y, 1)) and
+                       (near($z, 1));
+    print "ok 13\n";
+
+    ($r,$t,$f) = cartesian_to_spherical(1,1,0);
+
+    print 'not ' unless (near($r, sqrt(2)))     and
+                       (near($t, deg2rad(45))) and
+                       (near($f, deg2rad(90)));
+    print "ok 14\n";
+
+    ($x,$y,$z) = spherical_to_cartesian($r, $t, $f);
+
+    print 'not ' unless (near($x, 1)) and
+                       (near($y, 1)) and
+                       (near($z, 0));
+    print "ok 15\n";
+}
+
+{
+    my ($r,$t,$z) = cylindrical_to_spherical(spherical_to_cylindrical(1,1,1));
+
+    print 'not ' unless (near($r, 1)) and
+                       (near($t, 1)) and
+                       (near($z, 1));
+    print "ok 16\n";
+
+    ($r,$t,$z) = spherical_to_cylindrical(cylindrical_to_spherical(1,1,1));
+
+    print 'not ' unless (near($r, 1)) and
+                       (near($t, 1)) and
+                       (near($z, 1));
+    print "ok 17\n";
+}
+
+{
+    use Math::Trig 'great_circle_distance';
+
+    print 'not '
+       unless (near(great_circle_distance(0, 0, 0, pi/2), pi/2));
+    print "ok 18\n";
+
+    print 'not '
+       unless (near(great_circle_distance(0, 0, pi, pi), pi));
+    print "ok 19\n";
+
+    # London to Tokyo.
+    my @L = (deg2rad(-0.5), deg2rad(90 - 51.3));
+    my @T = (deg2rad(139.8),deg2rad(90 - 35.7));
+
+    my $km = great_circle_distance(@L, @T, 6378);
+
+    print 'not ' unless (near($km, 9605.26637021388));
+    print "ok 20\n";
+}
+
+{
+    my $R2D = 57.295779513082320876798154814169;
+
+    sub frac { $_[0] - int($_[0]) }
+
+    my $lotta_radians = deg2rad(1E+20, 1);
+    print "not " unless near($lotta_radians,  1E+20/$R2D);
+    print "ok 21\n";
+
+    my $negat_degrees = rad2deg(-1E20, 1);
+    print "not " unless near($negat_degrees, -1E+20*$R2D);
+    print "ok 22\n";
+
+    my $posit_degrees = rad2deg(-10000, 1);
+    print "not " unless near($posit_degrees, -10000*$R2D);
+    print "ok 23\n";
+}
+
+{
+    use Math::Trig 'great_circle_direction';
+
+    print 'not '
+       unless (near(great_circle_direction(0, 0, 0, pi/2), pi));
+    print "ok 24\n";
+
+    print 'not '
+       unless (near(great_circle_direction(0, 0, pi, pi), -pi()/2));
+    print "ok 25\n";
+
+    # London to Tokyo.
+    my @L = (deg2rad(-0.5), deg2rad(90 - 51.3));
+    my @T = (deg2rad(139.8),deg2rad(90 - 35.7));
+
+    my $rad = great_circle_direction(@L, @T);
+
+    print 'not ' unless (near($rad, -0.546644569997376));
+    print "ok 26\n";
+}
+
+# eof

diff --git a/lib/NEXT/test.pl b/lib/NEXT/test.pl
new file mode 100644 (file)
index 0000000..6328fd1
--- /dev/null
+++ b/lib/NEXT/test.pl
@@ -0,0 +1,99 @@
+#! /usr/local/bin/perl -w
+
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN { print "1..20\n"; }
+
+use NEXT;
+
+print "ok 1\n";
+
+package A;
+sub A::method   { return ( 3, $_[0]->NEXT::method() ) }
+sub A::DESTROY  { $_[0]->NEXT::DESTROY() }
+
+package B;
+use base qw( A );
+sub B::AUTOLOAD { return ( 9, $_[0]->NEXT::AUTOLOAD() ) }
+sub B::DESTROY  { $_[0]->NEXT::DESTROY() }
+
+package C;
+sub C::DESTROY  { print "ok 18\n"; $_[0]->NEXT::DESTROY() }
+
+package D;
+@D::ISA = qw( B C E );
+sub D::method   { return ( 2, $_[0]->NEXT::method() ) }
+sub D::AUTOLOAD { return ( 8, $_[0]->NEXT::AUTOLOAD() ) }
+sub D::DESTROY  { print "ok 17\n"; $_[0]->NEXT::DESTROY() }
+sub D::oops     { $_[0]->NEXT::method() }
+
+package E;
+@E::ISA = qw( F G );
+sub E::method   { return ( 4,  $_[0]->NEXT::method(), $_[0]->NEXT::method() ) }
+sub E::AUTOLOAD { return ( 10, $_[0]->NEXT::AUTOLOAD() ) }
+sub E::DESTROY  { print "ok 19\n"; $_[0]->NEXT::DESTROY() }
+
+package F;
+sub F::method   { return ( 5  ) }
+sub F::AUTOLOAD { return ( 11 ) }
+sub F::DESTROY  { print "ok 20\n" }
+
+package G;
+sub G::method   { return ( 6 ) }
+sub G::AUTOLOAD { print "not "; return }
+sub G::DESTROY  { print "not ok 21"; return }
+
+package main;
+
+my $obj = bless {}, "D";
+
+my @vals;
+
+# TEST NORMAL REDISPATCH (ok 2..6)
+@vals = $obj->method();
+print map "ok $_\n", @vals;
+
+# RETEST NORMAL REDISPATCH SHOULD BE THE SAME (ok 7)
+@vals = $obj->method();
+print "not " unless join("", @vals) == "23456";
+print "ok 7\n";
+
+# TEST AUTOLOAD REDISPATCH (ok 8..11)
+@vals = $obj->missing_method();
+print map "ok $_\n", @vals;
+
+# NAMED METHOD CAN'T REDISPATCH TO NAMED METHOD OF DIFFERENT NAME (ok 12)
+eval { $obj->oops() } && print "not ";
+print "ok 12\n";
+
+# AUTOLOAD'ED METHOD CAN'T REDISPATCH TO NAMED METHOD (ok 13)
+eval q{
+       package C;
+       sub AUTOLOAD { $_[0]->NEXT::method() };
+};
+eval { $obj->missing_method(); } && print "not ";
+print "ok 13\n";
+
+# NAMED METHOD CAN'T REDISPATCH TO AUTOLOAD'ED METHOD (ok 14)
+eval q{ 
+       package C;
+       sub method { $_[0]->NEXT::AUTOLOAD() };
+};
+eval { $obj->method(); } && print "not ";
+print "ok 14\n";
+
+# BASE CLASS METHODS ONLY REDISPATCHED WITHIN HIERARCHY (ok 15..16)
+my $ob2 = bless {}, "B";
+@val = $ob2->method();         
+print "not " unless @val==1 && $val[0]==3;
+print "ok 15\n";
+
+@val = $ob2->missing_method(); 
+print "not " unless @val==1 && $val[0]==9;
+print "ok 16\n";
+
+# CAN REDISPATCH DESTRUCTORS (ok 17..20)

diff --git a/lib/Net/hostent.t b/lib/Net/hostent.t
new file mode 100644 (file)
index 0000000..c3a1219
--- /dev/null
+++ b/lib/Net/hostent.t
@@ -0,0 +1,72 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bSocket\b/ && 
+        !(($^O eq 'VMS') && $Config{d_socket})) {
+       print "1..0 # Test uses Socket, Socket not built\n";
+       exit 0;
+    }
+}
+
+BEGIN { $| = 1; print "1..7\n"; }
+
+END {print "not ok 1\n" unless $loaded;}
+
+use Net::hostent;
+
+$loaded = 1;
+print "ok 1\n";
+
+# test basic resolution of localhost <-> 127.0.0.1
+use Socket;
+
+my $h = gethost('localhost');
+print +(defined $h ? '' : 'not ') . "ok 2\n";
+my $i = gethostbyaddr(inet_aton("127.0.0.1"));
+print +(!defined $i ? 'not ' : '') . "ok 3\n";
+
+print "not " if inet_ntoa($h->addr) ne "127.0.0.1";
+print "ok 4\n";
+
+print "not " if inet_ntoa($i->addr) ne "127.0.0.1";
+print "ok 5\n";
+
+# need to skip the name comparisons on Win32 because windows will
+# return the name of the machine instead of "localhost" when resolving
+# 127.0.0.1 or even "localhost"
+
+# VMS returns "LOCALHOST" under tcp/ip services V4.1 ECO 2, possibly others
+# OS/390 returns localhost.YADDA.YADDA
+
+if ($^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'cygwin') {
+  print "ok $_ # skipped on win32\n" for (6,7);
+} else {
+  my $in_alias;
+  unless ($h->name =~ /^localhost(?:\..+)?$/i) {
+    foreach (@{$h->aliases}) {
+      if (/^localhost(?:\..+)?$/i) {
+       $in_alias = 1;
+       last;
+      }
+    }
+    print "not " unless $in_alias;
+  } # Else we found it as the hostname
+  print "ok 6 # ",$h->name, " ", join (",", @{$h->aliases}), "\n";
+
+  if ($in_alias) {
+    # If we found it in the aliases before, expect to find it there again.
+    foreach (@{$h->aliases}) {
+      if (/^localhost(?:\..+)?$/i) {
+       undef $in_alias; # This time, clear the flag if we see "localhost"
+       last;
+      }
+    }
+    print "not " if $in_alias;
+  } else {
+    print "not " unless $i->name =~ /^localhost(?:\..+)?$/i;
+  }
+  print "ok 7 # ",$h->name, " ", join (",", @{$h->aliases}), "\n";
+}

diff --git a/lib/Net/netent.t b/lib/Net/netent.t
new file mode 100644 (file)
index 0000000..e73122c
--- /dev/null
+++ b/lib/Net/netent.t
@@ -0,0 +1,36 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $hasne;
+    eval { my @n = getnetbyname "loopback" };
+    $hasne = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($hasne) { print "1..0 # Skip: no getnetbyname\n"; exit 0 }
+    use Config;
+    $hasne = 0 unless $Config{'i_netdb'} eq 'define';
+    unless ($hasne) { print "1..0 # Skip: no netdb.h\n"; exit 0 }
+}
+
+BEGIN {
+    our @netent = getnetbyname "loopback"; # This is the function getnetbyname.
+    unless (@netent) { print "1..0 # Skip: no loopback net\n"; exit 0 }
+}
+
+print "1..2\n";
+
+use Net::netent;
+
+print "ok 1\n";
+
+my $netent = getnetbyname "loopback"; # This is the OO getnetbyname.
+
+print "not " unless $netent->name   eq $netent[0];
+print "ok 2\n";
+
+# Testing pretty much anything else is unportable;
+# e.g. the canonical name of the "loopback" net may be "loop".
+

diff --git a/lib/Net/protoent.t b/lib/Net/protoent.t
new file mode 100644 (file)
index 0000000..6c5a154
--- /dev/null
+++ b/lib/Net/protoent.t
@@ -0,0 +1,38 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $haspe;
+    eval { my @n = getprotobyname "tcp" };
+    $haspe = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($haspe) { print "1..0 # Skip: no getprotobyname\n"; exit 0 }
+    use Config;
+    $haspe = 0 unless $Config{'i_netdb'} eq 'define';
+    unless ($haspe) { print "1..0 # Skip: no netdb.h\n"; exit 0 }
+}
+
+BEGIN {
+    our @protoent = getprotobyname "tcp"; # This is the function getprotobyname.
+    unless (@protoent) { print "1..0 # Skip: no tcp protocol\n"; exit 0 }
+}
+
+print "1..3\n";
+
+use Net::protoent;
+
+print "ok 1\n";
+
+my $protoent = getprotobyname "tcp"; # This is the OO getprotobyname.
+
+print "not " unless $protoent->name   eq $protoent[0];
+print "ok 2\n";
+
+print "not " unless $protoent->proto  == $protoent[2];
+print "ok 3\n";
+
+# Testing pretty much anything else is unportable.
+

diff --git a/lib/Net/servent.t b/lib/Net/servent.t
new file mode 100644 (file)
index 0000000..ef4a04d
--- /dev/null
+++ b/lib/Net/servent.t
@@ -0,0 +1,38 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $hasse;
+    eval { my @n = getservbyname "echo", "tcp" };
+    $hasse = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($hasse) { print "1..0 # Skip: no getservbyname\n"; exit 0 }
+    use Config;
+    $hasse = 0 unless $Config{'i_netdb'} eq 'define';
+    unless ($hasse) { print "1..0 # Skip: no netdb.h\n"; exit 0 }
+}
+
+BEGIN {
+    our @servent = getservbyname "echo", "tcp"; # This is the function getservbyname.
+    unless (@servent) { print "1..0 # Skip: no echo service\n"; exit 0 }
+}
+
+print "1..3\n";
+
+use Net::servent;
+
+print "ok 1\n";
+
+my $servent = getservbyname "echo", "tcp"; # This is the OO getservbyname.
+
+print "not " unless $servent->name   eq $servent[0];
+print "ok 2\n";
+
+print "not " unless $servent->port  == $servent[2];
+print "ok 3\n";
+
+# Testing pretty much anything else is unportable.
+

diff --git a/lib/Search/Dict.t b/lib/Search/Dict.t
new file mode 100755 (executable)
index 0000000..c36fdb8
--- /dev/null
+++ b/lib/Search/Dict.t
@@ -0,0 +1,87 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..4\n";
+
+$DICT = <<EOT;
+Aarhus
+Aaron
+Ababa
+aback
+abaft
+abandon
+abandoned
+abandoning
+abandonment
+abandons
+abase
+abased
+abasement
+abasements
+abases
+abash
+abashed
+abashes
+abashing
+abasing
+abate
+abated
+abatement
+abatements
+abater
+abates
+abating
+Abba
+EOT
+
+use Search::Dict;
+
+open(DICT, "+>dict-$$") or die "Can't create dict-$$: $!";
+binmode DICT;                  # To make length expected one.
+print DICT $DICT;
+
+my $pos = look *DICT, "Ababa";
+chomp($word = <DICT>);
+print "not " if $pos < 0 || $word ne "Ababa";
+print "ok 1\n";
+
+if (ord('a') > ord('A') ) {  # ASCII
+
+    $pos = look *DICT, "foo";
+    chomp($word = <DICT>);
+
+    print "not " if $pos != length($DICT);  # will search to end of file
+    print "ok 2\n";
+
+    my $pos = look *DICT, "abash";
+    chomp($word = <DICT>);
+    print "not " if $pos < 0 || $word ne "abash";
+    print "ok 3\n";
+
+}
+else { # EBCDIC systems e.g. os390
+
+    $pos = look *DICT, "FOO";
+    chomp($word = <DICT>);
+
+    print "not " if $pos != length($DICT);  # will search to end of file
+    print "ok 2\n";
+
+    my $pos = look *DICT, "Abba";
+    chomp($word = <DICT>);
+    print "not " if $pos < 0 || $word ne "Abba";
+    print "ok 3\n";
+}
+
+$pos = look *DICT, "aarhus", 1, 1;
+chomp($word = <DICT>);
+
+print "not " if $pos < 0 || $word ne "Aarhus";
+print "ok 4\n";
+
+close DICT or die "cannot close";
+unlink "dict-$$";

diff --git a/lib/SelectSaver.t b/lib/SelectSaver.t
new file mode 100755 (executable)
index 0000000..3b58d70
--- /dev/null
+++ b/lib/SelectSaver.t
@@ -0,0 +1,28 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..3\n";
+
+use SelectSaver;
+
+open(FOO, ">foo-$$") || die;
+
+print "ok 1\n";
+{
+    my $saver = new SelectSaver(FOO);
+    print "foo\n";
+}
+
+# Get data written to file
+open(FOO, "foo-$$") || die;
+chomp($foo = <FOO>);
+close FOO;
+unlink "foo-$$";
+
+print "ok 2\n" if $foo eq "foo";
+
+print "ok 3\n";

diff --git a/lib/SelfLoader.t b/lib/SelfLoader.t
new file mode 100755 (executable)
index 0000000..6987f65
--- /dev/null
+++ b/lib/SelfLoader.t
@@ -0,0 +1,208 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    $dir = "self-$$";
+    $sep = "/";
+
+    if ($^O eq 'MacOS') {
+       $dir = ":" . $dir;
+       $sep = ":";
+    }
+
+    @INC = $dir;
+    push @INC, '../lib';
+
+    print "1..19\n";
+
+    # First we must set up some selfloader files
+    mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
+
+    open(FOO, ">$dir${sep}Foo.pm") or die;
+    print FOO <<'EOT';
+package Foo;
+use SelfLoader;
+
+sub new { bless {}, shift }
+sub foo;
+sub bar;
+sub bazmarkhianish;
+sub a;
+sub never;    # declared but definition should never be read
+1;
+__DATA__
+
+sub foo { shift; shift || "foo" };
+
+sub bar { shift; shift || "bar" }
+
+sub bazmarkhianish { shift; shift || "baz" }
+
+package sheep;
+sub bleat { shift; shift || "baa" }
+
+__END__
+sub never { die "D'oh" }
+EOT
+
+    close(FOO);
+
+    open(BAR, ">$dir${sep}Bar.pm") or die;
+    print BAR <<'EOT';
+package Bar;
+use SelfLoader;
+
+@ISA = 'Baz';
+
+sub new { bless {}, shift }
+sub a;
+
+1;
+__DATA__
+
+sub a { 'a Bar'; }
+sub b { 'b Bar' }
+
+__END__ DATA
+sub never { die "D'oh" }
+EOT
+
+    close(BAR);
+};
+
+
+package Baz;
+
+sub a { 'a Baz' }
+sub b { 'b Baz' }
+sub c { 'c Baz' }
+
+
+package main;
+use Foo;
+use Bar;
+
+$foo = new Foo;
+
+print "not " unless $foo->foo eq 'foo';  # selfloaded first time
+print "ok 1\n";
+
+print "not " unless $foo->foo eq 'foo';  # regular call
+print "ok 2\n";
+
+# Try an undefined method
+eval {
+    $foo->will_fail;
+};
+if ($@ =~ /^Undefined subroutine/) {
+    print "ok 3\n";
+} else {
+    print "not ok 3 $@\n";
+}
+
+# Used to be trouble with this
+eval {
+    my $foo = new Foo;
+    die "oops";
+};
+if ($@ =~ /oops/) {
+    print "ok 4\n";
+} else {
+    print "not ok 4 $@\n";
+}
+
+# Pass regular expression variable to autoloaded function.  This used
+# to go wrong in AutoLoader because it used regular expressions to generate
+# autoloaded filename.
+"foo" =~ /(\w+)/;
+print "not " unless $1 eq 'foo';
+print "ok 5\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 6\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 7\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 8\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 9\n";
+
+# Check nested packages inside __DATA__
+print "not " unless sheep::bleat()  eq 'baa';
+print "ok 10\n";
+
+# Now check inheritance:
+
+$bar = new Bar;
+
+# Before anything is SelfLoaded there is no declaration of Foo::b so we should
+# get Baz::b
+print "not " unless $bar->b() eq 'b Baz';
+print "ok 11\n";
+
+# There is no Bar::c so we should get Baz::c
+print "not " unless $bar->c() eq 'c Baz';
+print "ok 12\n";
+
+# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side
+# effect
+print "not " unless $bar->a() eq 'a Bar';
+print "ok 13\n";
+
+print "not " unless $bar->b() eq 'b Bar';
+print "ok 14\n";
+
+print "not " unless $bar->c() eq 'c Baz';
+print "ok 15\n";
+
+
+
+# Check that __END__ is honoured
+# Try an subroutine that should never be noticed by selfloader
+eval {
+    $foo->never;
+};
+if ($@ =~ /^Undefined subroutine/) {
+    print "ok 16\n";
+} else {
+    print "not ok 16 $@\n";
+}
+
+# Try to read from the data file handle
+my $foodata = <Foo::DATA>;
+close Foo::DATA;
+if (defined $foodata) {
+    print "not ok 17 # $foodata\n";
+} else {
+    print "ok 17\n";
+}
+
+# Check that __END__ DATA is honoured
+# Try an subroutine that should never be noticed by selfloader
+eval {
+    $bar->never;
+};
+if ($@ =~ /^Undefined subroutine/) {
+    print "ok 18\n";
+} else {
+    print "not ok 18 $@\n";
+}
+
+# Try to read from the data file handle
+my $bardata = <Bar::DATA>;
+close Bar::DATA;
+if ($bardata ne "sub never { die \"D'oh\" }\n") {
+    print "not ok 19 # $bardata\n";
+} else {
+    print "ok 19\n";
+}
+
+# cleanup
+END {
+return unless $dir && -d $dir;
+unlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm";
+rmdir "$dir";
+}

diff --git a/lib/Switch/test.pl b/lib/Switch/test.pl
new file mode 100644 (file)
index 0000000..d1a8af1
--- /dev/null
+++ b/lib/Switch/test.pl
@@ -0,0 +1,277 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Carp;
+use Switch qw(__ fallthrough);
+
+my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
+END{print"1..$C\n$M"}
+
+# NON-case THINGS;
+
+$case->{case} = { case => "case" };
+
+*case = \&case;
+
+# PREMATURE case
+
+eval { case 1 { ok(0) }; ok(0) } || ok(1);
+
+# H.O. FUNCS
+
+switch (__ > 2) {
+
+       case 1  { ok(0) } else { ok(1) }
+       case 2  { ok(0) } else { ok(1) }
+       case 3  { ok(1) } else { ok(0) }
+}
+
+switch (3) {
+
+       eval { case __ <= 1 || __ > 2   { ok(0) } } || ok(1);
+       case __ <= 2            { ok(0) };
+       case __ <= 3            { ok(1) };
+}
+
+# POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
+
+# 1. NUMERIC SWITCH
+
+for (1..3)
+{
+       switch ($_) {
+               # SELF
+               case ($_) { ok(1) } else { ok(0) }
+
+               # NUMERIC
+               case (1) { ok ($_==1) } else { ok($_!=1) }
+               case  1  { ok ($_==1) } else { ok($_!=1) }
+               case (3) { ok ($_==3) } else { ok($_!=3) }
+               case (4) { ok (0) } else { ok(1) }
+               case (2) { ok ($_==2) } else { ok($_!=2) }
+
+               # STRING
+               case ('a') { ok (0) } else { ok(1) }
+               case  'a'  { ok (0) } else { ok(1) }
+               case ('3') { ok ($_ == 3) } else { ok($_ != 3) }
+               case ('3.0') { ok (0) } else { ok(1) }
+
+               # ARRAY
+               case ([10,5,1]) { ok ($_==1) } else { ok($_!=1) }
+               case  [10,5,1]  { ok ($_==1) } else { ok($_!=1) }
+               case (['a','b']) { ok (0) } else { ok(1) }
+               case (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) }
+               case (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) }
+               case ([]) { ok (0) } else { ok(1) }
+
+               # HASH
+               case ({}) { ok (0) } else { ok (1) }
+               case {} { ok (0) } else { ok (1) }
+               case {1,1} { ok ($_==1) } else { ok($_!=1) }
+               case ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) }
+
+               # SUB/BLOCK
+               case (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) }
+               case {$_[0]==2} { ok ($_==2) } else { ok($_!=2) }
+               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
+               case {1} { ok (1) } else { ok (0) }     # ; -> SUB, NOT HASH
+       }
+}
+
+
+# 2. STRING SWITCH
+
+for ('a'..'c','1')
+{
+       switch ($_) {
+               # SELF
+               case ($_) { ok(1) } else { ok(0) }
+
+               # NUMERIC
+               case (1)  { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
+               case (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
+
+               # STRING
+               case ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') }
+               case ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') }
+               case ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') }
+               case ('1') { ok ($_ eq '1') } else { ok($_ ne '1') }
+               case ('d') { ok (0) } else { ok (1) }
+
+               # ARRAY
+               case (['a','1']) { ok ($_ eq 'a' || $_ eq '1') }
+                       else { ok ($_ ne 'a' && $_ ne '1') }
+               case (['z','2']) { ok (0) } else { ok(1) }
+               case ([]) { ok (0) } else { ok(1) }
+
+               # HASH
+               case ({}) { ok (0) } else { ok (1) }
+               case ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') }
+                       else { ok ($_ ne 'a' && $_ ne '1') }
+
+               # SUB/BLOCK
+               case (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') }
+                       else { ok($_ ne 'a') }
+               case {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') }
+               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
+               case {1} { ok (1) } else { ok (0) }     # ; -> SUB, NOT HASH
+       }
+}
+
+
+# 3. ARRAY SWITCH
+
+my $iteration = 0;
+for ([],[1,'a'],[2,'b'])
+{
+       switch ($_) {
+       $iteration++;
+               # SELF
+               case ($_) { ok(1) }
+
+               # NUMERIC
+               case (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
+               case (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
+
+               # STRING
+               case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
+               case ('b') { ok ($iteration==3) } else { ok ($iteration!=3) }
+               case ('1') { ok ($iteration==2) } else { ok ($iteration!=2) }
+
+               # ARRAY
+               case (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) }
+               case ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) }
+               case ([]) { ok (0) } else { ok(1) }
+               case ([7..100]) { ok (0) } else { ok(1) }
+
+               # HASH
+               case ({}) { ok (0) } else { ok (1) }
+               case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
+                       else { ok ($iteration!=2) }
+
+               # SUB/BLOCK
+               case {scalar grep /a/, @_} { ok ($iteration==2) }
+                       else { ok ($iteration!=2) }
+               case (sub {scalar grep /a/, @_ }) { ok ($iteration==2) }
+                       else { ok ($iteration!=2) }
+               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
+               case {1} { ok (1) } else { ok (0) }     # ; -> SUB, NOT HASH
+       }
+}
+
+
+# 4. HASH SWITCH
+
+$iteration = 0;
+for ({},{a=>1,b=>0})
+{
+       switch ($_) {
+       $iteration++;
+
+               # SELF
+               case ($_) { ok(1) } else { ok(0) }
+
+               # NUMERIC
+               case (1) { ok (0) } else { ok (1) }
+               case (1.0) { ok (0) } else { ok (1) }
+
+               # STRING
+               case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
+               case ('b') { ok (0) } else { ok (1) }
+               case ('c') { ok (0) } else { ok (1) }
+
+               # ARRAY
+               case (['a',2]) { ok ($iteration==2) }
+                       else { ok ($iteration!=2) }
+               case (['b','a']) { ok ($iteration==2) }
+                       else { ok ($iteration!=2) }
+               case (['b','c']) { ok (0) } else { ok (1) }
+               case ([]) { ok (0) } else { ok(1) }
+               case ([7..100]) { ok (0) } else { ok(1) }
+
+               # HASH
+               case ({}) { ok (0) } else { ok (1) }
+               case ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
+
+               # SUB/BLOCK
+               case {$_[0]{a}} { ok ($iteration==2) }
+                       else { ok ($iteration!=2) }
+               case (sub {$_[0]{a}}) { ok ($iteration==2) }
+                       else { ok ($iteration!=2) }
+               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
+               case {1} { ok (1) } else { ok (0) }     # ; -> SUB, NOT HASH
+       }
+}
+
+
+# 5. CODE SWITCH
+
+$iteration = 0;
+for ( sub {1},
+      sub { return 0 unless @_;
+           my ($data) = @_;
+           my $type = ref $data;
+           return $type eq 'HASH'   && $data->{a}
+               || $type eq 'Regexp' && 'a' =~ /$data/
+               || $type eq ""       && $data eq '1';
+         },
+      sub {0} )
+{
+       switch ($_) {
+       $iteration++;
+               # SELF
+               case ($_) { ok(1) } else { ok(0) }
+
+               # NUMERIC
+               case (1) { ok ($iteration<=2) } else { ok ($iteration>2) }
+               case (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) }
+               case (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) }
+
+               # STRING
+               case ('a') { ok ($iteration==1) } else { ok ($iteration!=1) }
+               case ('b') { ok ($iteration==1) } else { ok ($iteration!=1) }
+               case ('c') { ok ($iteration==1) } else { ok ($iteration!=1) }
+               case ('1') { ok ($iteration<=2) } else { ok ($iteration>2) }
+
+               # ARRAY
+               case ([1, 'a']) { ok ($iteration<=2) }
+                       else { ok ($iteration>2) }
+               case (['b','a']) { ok ($iteration==1) }
+                       else { ok ($iteration!=1) }
+               case (['b','c']) { ok ($iteration==1) }
+                       else { ok ($iteration!=1) }
+               case ([]) { ok ($iteration==1) } else { ok($iteration!=1) }
+               case ([7..100]) { ok ($iteration==1) }
+                       else { ok($iteration!=1) }
+
+               # HASH
+               case ({}) { ok ($iteration==1) } else { ok ($iteration!=1) }
+               case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) }
+                       else { ok ($iteration>2) }
+
+               # SUB/BLOCK
+               case {$_[0]->{a}} { ok (0) } else { ok (1) }
+               case (sub {$_[0]{a}}) { ok (0) } else { ok (1) }
+               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
+               case {1} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
+       }
+}
+
+
+# NESTED SWITCHES
+
+for my $count (1..3)
+{
+       switch ([9,"a",11]) {
+               case (qr/\d/) {
+                               switch ($count) {
+                                       case (1)     { ok($count==1) }
+                                               else { ok($count!=1) }
+                                       case ([5,6]) { ok(0) } else { ok(1) }
+                               }
+                           }
+               ok(1) case (11);
+       }
+}

diff --git a/lib/Symbol.t b/lib/Symbol.t
new file mode 100755 (executable)
index 0000000..03449a3
--- /dev/null
+++ b/lib/Symbol.t
@@ -0,0 +1,52 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..8\n";
+
+BEGIN { $_ = 'foo'; }  # because Symbol used to clobber $_
+
+use Symbol;
+
+# First check $_ clobbering
+print "not " if $_ ne 'foo';
+print "ok 1\n";
+
+
+# First test gensym()
+$sym1 = gensym;
+print "not " if ref($sym1) ne 'GLOB';
+print "ok 2\n";
+
+$sym2 = gensym;
+
+print "not " if $sym1 eq $sym2;
+print "ok 3\n";
+
+ungensym $sym1;
+
+$sym1 = $sym2 = undef;
+
+
+# Test qualify()
+package foo;
+
+use Symbol qw(qualify);  # must import into this package too
+
+qualify("x") eq "foo::x"          or print "not ";
+print "ok 4\n";
+
+qualify("x", "FOO") eq "FOO::x"   or print "not ";
+print "ok 5\n";
+
+qualify("BAR::x") eq "BAR::x"     or print "not ";
+print "ok 6\n";
+
+qualify("STDOUT") eq "main::STDOUT" or print "not ";
+print "ok 7\n";
+
+qualify("ARGV", "FOO") eq "main::ARGV" or print "not ";
+print "ok 8\n";

diff --git a/lib/Term/ANSIColor/test.pl b/lib/Term/ANSIColor/test.pl
new file mode 100755 (executable)
index 0000000..f38e905
--- /dev/null
+++ b/lib/Term/ANSIColor/test.pl
@@ -0,0 +1,81 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Test suite for the Term::ANSIColor Perl module.  Before `make install' is
+# performed this script should be runnable with `make test'.  After `make
+# install' it should work as `perl test.pl'.
+
+############################################################################
+# Ensure module can be loaded
+############################################################################
+
+BEGIN { $| = 1; print "1..8\n" }
+END   { print "not ok 1\n" unless $loaded }
+use Term::ANSIColor qw(:constants color colored);
+$loaded = 1;
+print "ok 1\n";
+
+
+############################################################################
+# Test suite
+############################################################################
+
+# Test simple color attributes.
+if (color ('blue on_green', 'bold') eq "\e[34;42;1m") {
+    print "ok 2\n";
+} else {
+    print "not ok 2\n";
+}
+
+# Test colored.
+if (colored ("testing", 'blue', 'bold') eq "\e[34;1mtesting\e[0m") {
+    print "ok 3\n";
+} else {
+    print "not ok 3\n";
+}
+
+# Test the constants.
+if (BLUE BOLD "testing" eq "\e[34m\e[1mtesting") {
+    print "ok 4\n";
+} else {
+    print "not ok 4\n";
+}
+
+# Test AUTORESET.
+$Term::ANSIColor::AUTORESET = 1;
+if (BLUE BOLD "testing" eq "\e[34m\e[1mtesting\e[0m\e[0m") {
+    print "ok 5\n";
+} else {
+    print "not ok 5\n";
+}
+
+# Test EACHLINE.
+$Term::ANSIColor::EACHLINE = "\n";
+if (colored ("test\n\ntest", 'bold')
+    eq "\e[1mtest\e[0m\n\n\e[1mtest\e[0m") {
+    print "ok 6\n";
+} else {
+    print colored ("test\n\ntest", 'bold'), "\n";
+    print "not ok 6\n";
+}
+
+# Test EACHLINE with multiple trailing delimiters.
+$Term::ANSIColor::EACHLINE = "\r\n";
+if (colored ("test\ntest\r\r\n\r\n", 'bold')
+    eq "\e[1mtest\ntest\r\e[0m\r\n\r\n") {
+    print "ok 7\n";
+} else {
+    print "not ok 7\n";
+}
+
+# Test the array ref form.
+$Term::ANSIColor::EACHLINE = "\n";
+if (colored (['bold', 'on_green'], "test\n", "\n", "test")
+    eq "\e[1;42mtest\e[0m\n\n\e[1;42mtest\e[0m") {
+    print "ok 8\n";
+} else {
+    print colored (['bold', 'on_green'], "test\n", "\n", "test");
+    print "not ok 8\n";
+}

diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 18ee902439275c63cc945b361bac4988e85466e2..e0c4dbe3f745cd392047145418bb59fc70d0e051 100644 (file)
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -554,7 +554,7 @@ on TTY.  The width is the width of the "yada/blah..." string.
 sub _mk_leader {
     my ($te, $width) = @_;
 
-    chop($te);      # XXX chomp?
+    $te =~ s/\.\w+$/./;
 
     if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; }
     my $blank = (' ' x 77);

diff --git a/lib/Test/Harness.t b/lib/Test/Harness.t
new file mode 100644 (file)
index 0000000..a4c423d
--- /dev/null
+++ b/lib/Test/Harness.t
@@ -0,0 +1,205 @@
+#!perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+
+# For shutting up Test::Harness.
+package My::Dev::Null;
+use Tie::Handle;
+@My::Dev::Null::ISA = qw(Tie::StdHandle);
+
+sub WRITE { }
+
+
+package main;
+
+# Utility testing functions.
+my $test_num = 1;
+sub ok ($;$) {
+    my($test, $name) = @_;
+    my $okstring = '';
+    $okstring = "not " unless $test;
+    $okstring .= "ok $test_num";
+    $okstring .= " - $name" if defined $name;
+    print "$okstring\n";
+    $test_num++;
+}
+
+sub eqhash {
+    my($a1, $a2) = @_;
+    return 0 unless keys %$a1 == keys %$a2;
+
+    my $ok = 1;
+    foreach my $k (keys %$a1) {
+        $ok = $a1->{$k} eq $a2->{$k};
+        last unless $ok;
+    }
+
+    return $ok;
+}
+
+use vars qw($Total_tests %samples);
+
+my $loaded;
+BEGIN { $| = 1; $^W = 1; }
+END {print "not ok $test_num\n" unless $loaded;}
+print "1..$Total_tests\n";
+use Test::Harness;
+$loaded = 1;
+ok(1, 'compile');
+######################### End of black magic.
+
+BEGIN {
+    %samples = (
+                simple            => {
+                                      bonus      => 0,
+                                      max        => 5,
+                                      'ok'         => 5,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+                simple_fail      => {
+                                     bonus       => 0,
+                                     max         => 5,
+                                     'ok'          => 3,
+                                     files       => 1,
+                                     bad         => 1,
+                                     good        => 0,
+                                     tests       => 1,
+                                     sub_skipped => 0,
+                                     skipped     => 0,
+                                    },
+                descriptive       => {
+                                      bonus      => 0,
+                                      max        => 5,
+                                      'ok'         => 5,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+                no_nums           => {
+                                      bonus      => 0,
+                                      max        => 5,
+                                      'ok'         => 4,
+                                      files      => 1,
+                                      bad        => 1,
+                                      good       => 0,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+                todo              => {
+                                      bonus      => 1,
+                                      max        => 5,
+                                      'ok'         => 5,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+                skip              => {
+                                      bonus      => 0,
+                                      max        => 5,
+                                      'ok'         => 5,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 1,
+                                      skipped    => 0,
+                                     },
+                bailout           => 0,
+                combined          => {
+                                      bonus      => 1,
+                                      max        => 10,
+                                      'ok'         => 8,
+                                      files      => 1,
+                                      bad        => 1,
+                                      good       => 0,
+                                      tests      => 1,
+                                      sub_skipped=> 1,
+                                      skipped    => 0
+                                     },
+                duplicates        => {
+                                      bonus      => 0,
+                                      max        => 10,
+                                      'ok'         => 11,
+                                      files      => 1,
+                                      bad        => 1,
+                                      good       => 0,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+                header_at_end     => {
+                                      bonus      => 0,
+                                      max        => 4,
+                                      'ok'         => 4,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+                skip_all          => {
+                                      bonus      => 0,
+                                      max        => 0,
+                                      'ok'         => 0,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 1,
+                                     },
+                with_comments     => {
+                                      bonus      => 2,
+                                      max        => 5,
+                                      'ok'         => 5,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+               );
+
+    $Total_tests = keys(%samples) + 1;
+}
+
+tie *NULL, 'My::Dev::Null' or die $!;
+
+while (my($test, $expect) = each %samples) {
+    # _run_all_tests() runs the tests but skips the formatting.
+    my($totals, $failed);
+    eval {
+        select NULL;    # _run_all_tests() isn't as quiet as it should be.
+        ($totals, $failed) = 
+          Test::Harness::_run_all_tests("lib/sample-tests/$test");
+    };
+    select STDOUT;
+
+    unless( $@ ) {
+        ok( eqhash( $expect, {map { $_=>$totals->{$_} } keys %$expect} ), 
+                                                                      $test );
+    }
+    else {      # special case for bailout
+        ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i),
+            $test );
+    }
+}

diff --git a/lib/Test/t/fail.t b/lib/Test/t/fail.t
new file mode 100644 (file)
index 0000000..b431502
--- /dev/null
+++ b/lib/Test/t/fail.t
@@ -0,0 +1,93 @@
+# -*-perl-*-
+use strict;
+use vars qw($Expect);
+use Test qw($TESTOUT $ntest ok skip plan); 
+plan tests => 14;
+
+open F, ">fails";
+$TESTOUT = *F{IO};
+
+my $r=0;
+{
+    # Shut up deprecated usage warning.
+    local $^W = 0;
+    $r |= skip(0,0);
+}
+$r |= ok(0);
+$r |= ok(0,1);
+$r |= ok(sub { 1+1 }, 3);
+$r |= ok(sub { 1+1 }, sub { 2 * 0});
+
+my @list = (0,0);
+$r |= ok @list, 1, "\@list=".join(',',@list);
+$r |= ok @list, 1, sub { "\@list=".join ',',@list };
+$r |= ok 'segmentation fault', '/bongo/';
+
+for (1..2) { $r |= ok(0); }
+
+$r |= ok(1, undef);
+$r |= ok(undef, 1);
+
+ok($r); # (failure==success :-)
+
+close F;
+$TESTOUT = *STDOUT{IO};
+$ntest = 1;
+
+open F, "fails";
+my $O;
+while (<F>) { $O .= $_; }
+close F;
+unlink "fails";
+
+ok join(' ', map { m/(\d+)/; $1 } grep /^not ok/, split /\n+/, $O),
+    join(' ', 1..13);
+
+my @got = split /not ok \d+\n/, $O;
+shift @got;
+
+$Expect =~ s/\n+$//;
+my @expect = split /\n\n/, $Expect;
+
+for (my $x=0; $x < @got; $x++) {
+    ok $got[$x], $expect[$x]."\n";
+}
+
+
+BEGIN {
+    $Expect = <<"EXPECT";
+# Failed test 1 in $0 at line 14
+
+# Failed test 2 in $0 at line 16
+
+# Test 3 got: '0' ($0 at line 17)
+#   Expected: '1'
+
+# Test 4 got: '2' ($0 at line 18)
+#   Expected: '3'
+
+# Test 5 got: '2' ($0 at line 19)
+#   Expected: '0'
+
+# Test 6 got: '2' ($0 at line 22)
+#   Expected: '1' (\@list=0,0)
+
+# Test 7 got: '2' ($0 at line 23)
+#   Expected: '1' (\@list=0,0)
+
+# Test 8 got: 'segmentation fault' ($0 at line 24)
+#   Expected: qr{bongo}
+
+# Failed test 9 in $0 at line 26
+
+# Failed test 10 in $0 at line 26 fail #2
+
+# Failed test 11 in $0 at line 28
+
+# Test 12 got: <UNDEF> ($0 at line 29)
+#    Expected: '1'
+
+# Failed test 13 in $0 at line 31
+EXPECT
+
+}

diff --git a/lib/Test/t/mix.t b/lib/Test/t/mix.t
new file mode 100644 (file)
index 0000000..d911689
--- /dev/null
+++ b/lib/Test/t/mix.t
@@ -0,0 +1,17 @@
+# -*-perl-*-
+use strict;
+use Test;
+BEGIN { plan tests => 4, todo => [2,3] }
+
+ok(sub { 
+       my $r = 0;
+       for (my $x=0; $x < 10; $x++) {
+          $r += $x*($r+1);
+       }
+       $r
+   }, 3628799);
+
+ok(0);
+ok(1);
+
+skip(1,0);

diff --git a/lib/Test/t/onfail.t b/lib/Test/t/onfail.t
new file mode 100644 (file)
index 0000000..dce4373
--- /dev/null
+++ b/lib/Test/t/onfail.t
@@ -0,0 +1,31 @@
+# -*-perl-*-
+
+use strict;
+use Test qw($ntest plan ok $TESTOUT);
+use vars qw($mycnt);
+
+BEGIN { plan test => 6, onfail => \&myfail }
+
+$mycnt = 0;
+
+my $why = "zero != one";
+# sneak in a test that Test::Harness wont see
+open J, ">junk";
+$TESTOUT = *J{IO};
+ok(0, 1, $why);
+$TESTOUT = *STDOUT{IO};
+close J;
+unlink "junk";
+$ntest = 1;
+
+sub myfail {
+    my ($f) = @_;
+    ok(@$f, 1);
+
+    my $t = $$f[0];
+    ok($$t{diagnostic}, $why);
+    ok($$t{'package'}, 'main');
+    ok($$t{repetition}, 1);
+    ok($$t{result}, 0);
+    ok($$t{expected}, 1);
+}

diff --git a/lib/Test/t/qr.t b/lib/Test/t/qr.t
new file mode 100644 (file)
index 0000000..ea40f87
--- /dev/null
+++ b/lib/Test/t/qr.t
@@ -0,0 +1,13 @@
+#!./perl -w
+
+use strict;
+BEGIN {
+    if ($] < 5.005) {
+       print "1..0\n";
+       print "ok 1 # skipped; this test requires at least perl 5.005\n";
+       exit;
+    }
+}
+use Test; plan tests => 1;
+
+ok 'abc', qr/b/;

diff --git a/lib/Test/t/skip.t b/lib/Test/t/skip.t
new file mode 100644 (file)
index 0000000..7db35e6
--- /dev/null
+++ b/lib/Test/t/skip.t
@@ -0,0 +1,40 @@
+# -*-perl-*-
+use strict;
+use Test qw($TESTOUT $ntest plan ok skip); plan tests => 6;
+
+open F, ">skips" or die "open skips: $!";
+$TESTOUT = *F{IO};
+
+skip(1, 0);  #should skip
+
+my $skipped=1;
+skip('hop', sub { $skipped = 0 });
+skip(sub {'jump'}, sub { $skipped = 0 });
+skip('skipping stones is more fun', sub { $skipped = 0 });
+
+close F;
+
+$TESTOUT = *STDOUT{IO};
+$ntest = 1;
+open F, "skips" or die "open skips: $!";
+
+ok $skipped, 1, 'not skipped?';
+
+my @T = <F>;
+chop @T;
+my @expect = split /\n+/, join('',<DATA>);
+ok @T, 4;
+for (my $x=0; $x < @T; $x++) {
+    ok $T[$x], $expect[$x];
+}
+
+END { close F; unlink "skips" }
+
+__DATA__
+ok 1 # skip
+
+ok 2 # skip hop
+
+ok 3 # skip jump
+
+ok 4 # skip skipping stones is more fun

diff --git a/lib/Test/t/success.t b/lib/Test/t/success.t
new file mode 100644 (file)
index 0000000..a580f0a
--- /dev/null
+++ b/lib/Test/t/success.t
@@ -0,0 +1,11 @@
+# -*-perl-*-
+use strict;
+use Test;
+BEGIN { plan tests => 11 }
+
+ok(ok(1));
+ok(ok('fixed', 'fixed'));
+ok(skip(1,0));
+ok(undef, undef);
+ok(ok 'the brown fox jumped over the lazy dog', '/lazy/');
+ok(ok 'the brown fox jumped over the lazy dog', 'm,fox,');

diff --git a/lib/Test/t/todo.t b/lib/Test/t/todo.t
new file mode 100644 (file)
index 0000000..ae02a04
--- /dev/null
+++ b/lib/Test/t/todo.t
@@ -0,0 +1,13 @@
+# -*-perl-*-
+use strict;
+use Test;
+BEGIN { 
+    my $tests = 5; 
+    plan tests => $tests, todo => [1..$tests]; 
+}
+
+ok(0);
+ok(1);
+ok(0,1);
+ok(0,1,"need more tuits");
+ok(1,1);

diff --git a/lib/Text/Balanced/t/genxt.t b/lib/Text/Balanced/t/genxt.t
new file mode 100644 (file)
index 0000000..6889653
--- /dev/null
+++ b/lib/Text/Balanced/t/genxt.t
@@ -0,0 +1,104 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..35\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( gen_extract_tagged );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+       chomp $str;
+       $str =~ s/\\n/\n/g;
+       if ($str =~ s/\A# USING://)
+       {
+               $neg = 0;
+               eval{local$^W;*f = eval $str || die};
+               next;
+       }
+       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+       $str =~ s/\\n/\n/g;
+       debug "\tUsing: $cmd\n";
+       debug "\t   on: [$str]\n";
+
+       my @res;
+       $var = eval { @res = f($str) };
+       debug "\t list got: [" . join("|",@res) . "]\n";
+       debug "\t list left: [$str]\n";
+       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+       print "ok ", $count++;
+       print " ($@)" if $@ && $DEBUG;
+       print "\n";
+
+       pos $str = 0;
+       $var = eval { scalar f($str) };
+       $var = "<undef>" unless defined $var;
+       debug "\t scalar got: [$var]\n";
+       debug "\t scalar left: [$str]\n";
+       print "not " if ($str =~ '\A;')==$neg;
+       print "ok ", $count++;
+       print " ($@)" if $@ && $DEBUG;
+       print "\n";
+}
+
+__DATA__
+
+# USING: gen_extract_tagged(qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]});
+       <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+
+# USING: gen_extract_tagged("BEGIN","END");
+       BEGIN at the BEGIN keyword and END at the END;
+       BEGIN at the beginning and end at the END;
+
+# USING: gen_extract_tagged(undef,undef,undef,{ignore=>["<[^>]*/>"]});
+       <A>aaa<B>bbb<BR/>ccc</B>ddd</A>;
+
+# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"MAX"});
+       ; at the ;-) keyword
+
+# USING: gen_extract_tagged("<[A-Z]+>",undef, undef, {ignore=>["<BR>"]});
+       <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+
+# THESE SHOULD FAIL
+       BEGIN at the beginning and end at the end;
+       BEGIN at the BEGIN keyword and END at the end;
+
+# TEST EXTRACTION OF TAGGED STRINGS
+# USING: gen_extract_tagged("BEGIN","END",undef,{reject=>["BEGIN","END"]});
+# THESE SHOULD FAIL
+       BEGIN at the BEGIN keyword and END at the end;
+
+# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"PARA"});
+       ; at the ;-) keyword
+
+
+# USING: gen_extract_tagged();
+       <A>some text</A>;
+       <B>some text<A>other text</A></B>;
+       <A>some text<A>other text</A></A>;
+       <A HREF="#section2">some text</A>;
+
+# THESE SHOULD FAIL
+       <A>some text
+       <A>some text<A>other text</A>;
+       <B>some text<A>other text</B>;

diff --git a/lib/Text/Balanced/t/xbrak.t b/lib/Text/Balanced/t/xbrak.t
new file mode 100644 (file)
index 0000000..5a8e524
--- /dev/null
+++ b/lib/Text/Balanced/t/xbrak.t
@@ -0,0 +1,81 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..19\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_bracketed );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+       chomp $str;
+       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+       $str =~ s/\\n/\n/g;
+       debug "\tUsing: $cmd\n";
+       debug "\t   on: [$str]\n";
+
+       $var = eval "() = $cmd";
+       debug "\t list got: [$var]\n";
+       debug "\t list left: [$str]\n";
+       print "not " if (substr($str,pos($str),1) eq ';')==$neg;
+       print "ok ", $count++;
+       print " ($@)" if $@ && $DEBUG;
+       print "\n";
+
+       pos $str = 0;
+       $var = eval $cmd;
+       $var = "<undef>" unless defined $var;
+       debug "\t scalar got: [$var]\n";
+       debug "\t scalar left: [$str]\n";
+       print "not " if ($str =~ '\A;')==$neg;
+       print "ok ", $count++;
+       print " ($@)" if $@ && $DEBUG;
+       print "\n";
+}
+
+__DATA__
+
+# USING: extract_bracketed($str);
+{a nested { and } are okay as are () and <> pairs and escaped \}'s };
+{a nested\n{ and } are okay as are\n() and <> pairs and escaped \}'s };
+
+# USING: extract_bracketed($str,'{}');
+{a nested { and } are okay as are unbalanced ( and < pairs and escaped \}'s };
+
+# THESE SHOULD FAIL
+{an unmatched nested { isn't okay, nor are ( and < };
+{an unbalanced nested [ even with } and ] to match them;
+
+
+# USING: extract_bracketed($str,'<"`q>');
+<a q{uoted} ">" unbalanced right bracket of /(q>)/ either sort (`>>>""">>>>`) is okay >;
+
+# USING: extract_bracketed($str,'<">');
+<a quoted ">" unbalanced right bracket is okay >;
+
+# USING: extract_bracketed($str,'<"`>');
+<a quoted ">" unbalanced right bracket of either sort (`>>>""">>>>`) is okay >;
+
+# THIS SHOULD FAIL
+<a misquoted '>' unbalanced right bracket is bad >;

diff --git a/lib/Text/Balanced/t/xcode.t b/lib/Text/Balanced/t/xcode.t
new file mode 100644 (file)
index 0000000..00be51e
--- /dev/null
+++ b/lib/Text/Balanced/t/xcode.t
@@ -0,0 +1,94 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..37\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_codeblock );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+       chomp $str;
+       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+       $str =~ s/\\n/\n/g;
+       debug "\tUsing: $cmd\n";
+       debug "\t   on: [$str]\n";
+
+       my @res;
+       $var = eval "\@res = $cmd";
+       debug "\t   Failed: $@ at " . $@+0 .")" if $@;
+       debug "\t list got: [" . join("|",@res) . "]\n";
+       debug "\t list left: [$str]\n";
+       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+       print "ok ", $count++;
+       print "\n";
+
+       pos $str = 0;
+       $var = eval $cmd;
+       $var = "<undef>" unless defined $var;
+       debug "\t scalar got: [$var]\n";
+       debug "\t scalar left: [$str]\n";
+       print "not " if ($str =~ '\A;')==$neg;
+       print "ok ", $count++;
+       print " ($@)" if $@ && $DEBUG;
+       print "\n";
+}
+
+__DATA__
+
+# USING: extract_codeblock($str,'<>');
+< %x = ( try => "this") >;
+< %x = () >;
+< %x = ( $try->{this}, "too") >;
+< %'x = ( $try->{this}, "too") >;
+< %'x'y = ( $try->{this}, "too") >;
+< %::x::y = ( $try->{this}, "too") >;
+
+# THIS SHOULD FAIL
+< %x = do { $try > 10 } >;
+
+# USING: extract_codeblock($str);
+
+{ $a = /\}/; };
+{ sub { $_[0] /= $_[1] } };  # / here
+{ 1; };
+{ $a = 1; };
+
+
+# USING: extract_codeblock($str,undef,'=*');
+========{$a=1};
+
+# USING: extract_codeblock($str,'{}<>');
+< %x = do { $try > 10 } >;
+
+# USING: extract_codeblock($str,'{}',undef,'<>');
+< %x = do { $try > 10 } >;
+
+# USING: extract_codeblock($str,'{}');
+{ $a = $b; # what's this doing here? \n };'
+{ $a = $b; \n $a =~ /$b/; \n @a = map /\s/ @b };
+
+# THIS SHOULD FAIL
+{ $a = $b; # what's this doing here? };'
+{ $a = $b; # what's this doing here? ;'

diff --git a/lib/Text/Balanced/t/xdeli.t b/lib/Text/Balanced/t/xdeli.t
new file mode 100644 (file)
index 0000000..7e5b06b
--- /dev/null
+++ b/lib/Text/Balanced/t/xdeli.t
@@ -0,0 +1,95 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..45\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_delimited );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+       chomp $str;
+       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+       $str =~ s/\\n/\n/g;
+       debug "\tUsing: $cmd\n";
+       debug "\t   on: [$str]\n";
+
+       $var = eval "() = $cmd";
+       debug "\t list got: [$var]\n";
+       debug "\t list left: [$str]\n";
+       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+       print "ok ", $count++;
+       print " ($@)" if $@ && $DEBUG;
+       print "\n";
+
+       pos $str = 0;
+       $var = eval $cmd;
+       $var = "<undef>" unless defined $var;
+       debug "\t scalar got: [$var]\n";
+       debug "\t scalar left: [$str]\n";
+       print "not " if ($str =~ '\A;')==$neg;
+       print "ok ", $count++;
+       print " ($@)" if $@ && $DEBUG;
+       print "\n";
+}
+
+__DATA__
+# USING: extract_delimited($str,'/#$',undef,'/#$');
+/a/;
+/a///;
+#b#;
+#b###;
+$c$;
+$c$$$;
+
+# TEST EXTRACTION OF DELIMITED TEXT WITH ESCAPES
+# USING: extract_delimited($str,'/#$',undef,'\\');
+/a/;
+/a\//;
+#b#;
+#b\##;
+$c$;
+$c\$$;
+
+# TEST EXTRACTION OF DELIMITED TEXT
+# USING: extract_delimited($str);
+'a';
+"b";
+`c`;
+'a\'';
+'a\\';
+'\\a';
+"a\\";
+"\\a";
+"b\'\"\'";
+`c '\`abc\`'`;
+
+# TEST EXTRACTION OF DELIMITED TEXT
+# USING: extract_delimited($str,'/#$','-->');
+-->/a/;
+-->#b#;
+-->$c$;
+
+# THIS SHOULD FAIL
+$c$;

diff --git a/lib/Text/Balanced/t/xmult.t b/lib/Text/Balanced/t/xmult.t
new file mode 100644 (file)
index 0000000..31dd7d4
--- /dev/null
+++ b/lib/Text/Balanced/t/xmult.t
@@ -0,0 +1,316 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..85\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( :ALL );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+sub expect
+{
+       local $^W;
+       my ($l1, $l2) = @_;
+
+       if (@$l1 != @$l2)
+       {
+               print "\@l1: ", join(", ", @$l1), "\n";
+               print "\@l2: ", join(", ", @$l2), "\n";
+               print "not ";
+       }
+       else
+       {
+               for (my $i = 0; $i < @$l1; $i++)
+               {
+                       if ($l1->[$i] ne $l2->[$i])
+                       {
+                               print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n";
+                               print "not ";
+                               last;
+                       }
+               }
+       }
+
+       print "ok $count\n";
+       $count++;
+}
+
+sub divide
+{
+       my ($text, @index) = @_;
+       my @bits = ();
+       unshift @index, 0;
+       push @index, length($text);
+       for ( my $i= 0; $i < $#index; $i++)
+       {
+               push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]);
+       }
+       pop @bits;
+       return @bits;
+
+}
+
+
+$stdtext1 = q{$var = do {"val" && $val;};};
+
+# TESTS 2-4
+$text = $stdtext1;
+expect [ extract_multiple($text,undef,1) ],
+       [ divide $stdtext1 => 4 ];
+
+expect [ pos $text], [ 4 ];
+expect [ $text ], [ $stdtext1 ];
+
+# TESTS 5-7
+$text = $stdtext1;
+expect [ scalar extract_multiple($text,undef,1) ],
+       [ divide $stdtext1 => 4 ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+# TESTS 8-10
+$text = $stdtext1;
+expect [ extract_multiple($text,undef,2) ],
+       [ divide($stdtext1 => 4, 10) ];
+
+expect [ pos $text], [ 10 ];
+expect [ $text ], [ $stdtext1 ];
+
+# TESTS 11-13
+$text = $stdtext1;
+expect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ],
+       [ substr($stdtext1,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+# TESTS 14-16
+$text = $stdtext1;
+expect [ extract_multiple($text,undef,3) ],
+       [ divide($stdtext1 => 4, 10, 26) ];
+
+expect [ pos $text], [ 26 ];
+expect [ $text ], [ $stdtext1 ];
+
+# TESTS 17-19
+$text = $stdtext1;
+expect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ],
+       [ substr($stdtext1,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+# TESTS 20-22
+$text = $stdtext1;
+expect [ extract_multiple($text,undef,4) ],
+       [ divide($stdtext1 => 4, 10, 26, 27) ];
+
+expect [ pos $text], [ 27 ];
+expect [ $text ], [ $stdtext1 ];
+
+# TESTS 23-25
+$text = $stdtext1;
+expect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ],
+       [ substr($stdtext1,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+# TESTS 26-28
+$text = $stdtext1;
+expect [ extract_multiple($text,undef,5) ],
+       [ divide($stdtext1 => 4, 10, 26, 27) ];
+
+expect [ pos $text], [ 27 ];
+expect [ $text ], [ $stdtext1 ];
+
+
+# TESTS 29-31
+$text = $stdtext1;
+expect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ],
+       [ substr($stdtext1,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+
+# TESTS 32-34
+$stdtext2 = q{$var = "val" && (1,2,3);};
+
+$text = $stdtext2;
+expect [ extract_multiple($text) ],
+       [ divide($stdtext2 => 4, 7, 12, 24) ];
+
+expect [ pos $text], [ 24 ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 35-37
+$text = $stdtext2;
+expect [ scalar extract_multiple($text) ],
+       [ substr($stdtext2,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext2,4) ];
+
+
+# TESTS 38-40
+$text = $stdtext2;
+expect [ extract_multiple($text,[\&extract_bracketed]) ],
+       [ substr($stdtext2,0,15), substr($stdtext2,16,7), substr($stdtext2,23) ];
+
+expect [ pos $text], [ 24 ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 41-43
+$text = $stdtext2;
+expect [ scalar extract_multiple($text,[\&extract_bracketed]) ],
+       [ substr($stdtext2,0,15) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext2,15) ];
+
+
+# TESTS 44-46
+$text = $stdtext2;
+expect [ extract_multiple($text,[\&extract_variable]) ],
+       [ substr($stdtext2,0,4), substr($stdtext2,4) ];
+
+expect [ pos $text], [ length($text) ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 47-49
+$text = $stdtext2;
+expect [ scalar extract_multiple($text,[\&extract_variable]) ],
+       [ substr($stdtext2,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext2,4) ];
+
+
+# TESTS 50-52
+$text = $stdtext2;
+expect [ extract_multiple($text,[\&extract_quotelike]) ],
+       [ substr($stdtext2,0,6), substr($stdtext2,7,5), substr($stdtext2,12) ];
+
+expect [ pos $text], [ length($text) ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 53-55
+$text = $stdtext2;
+expect [ scalar extract_multiple($text,[\&extract_quotelike]) ],
+       [ substr($stdtext2,0,6) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext2,6) ];
+
+
+# TESTS 56-58
+$text = $stdtext2;
+expect [ extract_multiple($text,[\&extract_quotelike],2,1) ],
+       [ substr($stdtext2,7,5) ];
+
+expect [ pos $text], [ 23 ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 59-61
+$text = $stdtext2;
+expect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ],
+       [ substr($stdtext2,7,5) ];
+
+expect [ pos $text], [ 6 ];
+expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
+
+
+# TESTS 62-64
+$text = $stdtext2;
+expect [ extract_multiple($text,[\&extract_quotelike],1,1) ],
+       [ substr($stdtext2,7,5) ];
+
+expect [ pos $text], [ 12 ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 65-67
+$text = $stdtext2;
+expect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ],
+       [ substr($stdtext2,7,5) ];
+
+expect [ pos $text], [ 6 ];
+expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
+
+# TESTS 68-70
+my $stdtext3 = "a,b,c";
+
+$_ = $stdtext3;
+expect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
+       [ divide($stdtext3 => 1,2,3,4,5) ];
+
+expect [ pos ], [ 5 ];
+expect [ $_ ], [ $stdtext3 ];
+
+# TESTS 71-73
+
+$_ = $stdtext3;
+expect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
+       [ divide($stdtext3 => 1) ];
+
+expect [ pos ], [ 0 ];
+expect [ $_ ], [ substr($stdtext3,1) ];
+
+
+# TESTS 74-76
+
+$_ = $stdtext3;
+expect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
+       [ divide($stdtext3 => 1,2,3,4,5) ];
+
+expect [ pos ], [ 5 ];
+expect [ $_ ], [ $stdtext3 ];
+
+# TESTS 77-79
+
+$_ = $stdtext3;
+expect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
+       [ divide($stdtext3 => 1) ];
+
+expect [ pos ], [ 0 ];
+expect [ $_ ], [ substr($stdtext3,1) ];
+
+
+# TESTS 80-82
+
+$_ = $stdtext3;
+expect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ],
+       [ qw(a b c) ];
+
+expect [ pos ], [ 5 ];
+expect [ $_ ], [ $stdtext3 ];
+
+# TESTS 83-85
+
+$_ = $stdtext3;
+expect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ],
+       [ divide($stdtext3 => 1) ];
+
+expect [ pos ], [ 0 ];
+expect [ $_ ], [ substr($stdtext3,2) ];

diff --git a/lib/Text/Balanced/t/xquot.t b/lib/Text/Balanced/t/xquot.t
new file mode 100644 (file)
index 0000000..567e0a5
--- /dev/null
+++ b/lib/Text/Balanced/t/xquot.t
@@ -0,0 +1,118 @@
+#!./perl -ws
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..89\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_quotelike );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+# $DEBUG=1;
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+       chomp $str;
+       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+       debug "\tUsing: $cmd\n";
+       debug "\t   on: [$str]\n";
+       $str =~ s/\\n/\n/g;
+       my $orig = $str;
+
+        my @res;
+       eval qq{\@res = $cmd; };
+       debug "\t  got:\n" . join "", map { $res[$_]=~s/\n/\\n/g; "\t\t\t$_: [$res[$_]]\n"} (0..$#res);
+       debug "\t left: " . (map { s/\n/\\n/g; "[$_]\n" } my $cpy1 = $str)[0];
+       debug "\t  pos: " . (map { s/\n/\\n/g; "[$_]\n" } my $cpy2 = substr($str,pos($str)))[0] . "...]\n";
+       print "not " if (substr($str,pos($str),1) eq ';')==$neg;
+       print "ok ", $count++;
+       print "\n";
+
+       $str = $orig;
+       debug "\tUsing: scalar $cmd\n";
+       debug "\t   on: [$str]\n";
+       $var = eval $cmd;
+       print " ($@)" if $@ && $DEBUG;
+       $var = "<undef>" unless defined $var;
+       debug "\t scalar got: " . (map { s/\n/\\n/g; "[$_]\n" } $var)[0];
+       debug "\t scalar left: " . (map { s/\n/\\n/g; "[$_]\n" } $str)[0];
+       print "not " if ($str =~ '\A;')==$neg;
+       print "ok ", $count++;
+       print "\n";
+}
+
+__DATA__
+
+# USING: extract_quotelike($str);
+'';
+"";
+"a";
+'b';
+`cc`;
+
+
+<<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
+     <<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
+<<"EOHERE"; done()\nline1\nline2\nEOHERE\n and next
+<<`EOHERE`; done()\nline1\nline2\nEOHERE\n and next
+<<'EOHERE'; done()\nline1\n'line2'\nEOHERE\n and next
+<<'EOHERE;'; done()\nline1\nline2\nEOHERE;\n and next
+<<"   EOHERE"; done() \nline1\nline2\n   EOHERE\nand next
+<<""; done()\nline1\nline2\n\n and next
+<<; done()\nline1\nline2\n\n and next
+
+
+"this is a nested $var[$x] {";
+/a/gci;
+m/a/gci;
+
+q(d);
+qq(e);
+qx(f);
+qr(g);
+qw(h i j);
+q{d};
+qq{e};
+qx{f};
+qr{g};
+qq{a nested { and } are okay as are () and <> pairs and escaped \}'s };
+q/slash/;
+q # slash #;
+qr qw qx;
+
+s/x/y/;
+s/x/y/cgimsox;
+s{a}{b};
+s{a}\n {b};
+s(a){b};
+s(a)/b/;
+s/'/\\'/g;
+tr/x/y/;
+y/x/y/;
+
+# THESE SHOULD FAIL
+s<$self->{pat}>{$self->{sub}};         # CAN'T HANDLE '>' in '->'
+s-$self->{pap}-$self->{sub}-;          # CAN'T HANDLE '-' in '->'
+<<EOHERE; done();\nline1\nline2\nEOHERE;\n; next;          # RDEL HAS NO ';'
+<<'EOHERE'; done();\nline1\nline2\nEOHERE;\n; next;        # RDEF HAS NO ';'
+     <<    EOTHERE; done();\nline1\nline2\n    EOTHERE\n; next;  # RDEL IS "" (!)

diff --git a/lib/Text/Balanced/t/xtagg.t b/lib/Text/Balanced/t/xtagg.t
new file mode 100644 (file)
index 0000000..c883181
--- /dev/null
+++ b/lib/Text/Balanced/t/xtagg.t
@@ -0,0 +1,118 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..53\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_tagged gen_extract_tagged );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+       chomp $str;
+       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+       $str =~ s/\\n/\n/g;
+       debug "\tUsing: $cmd\n";
+       debug "\t   on: [$str]\n";
+
+       my @res;
+       $var = eval "\@res = $cmd";
+       debug "\t list got: [" . join("|",@res) . "]\n";
+       debug "\t list left: [$str]\n";
+       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+       print "ok ", $count++;
+       print " ($@)" if $@ && $DEBUG;
+       print "\n";
+
+       pos $str = 0;
+       $var = eval $cmd;
+       $var = "<undef>" unless defined $var;
+       debug "\t scalar got: [$var]\n";
+       debug "\t scalar left: [$str]\n";
+       print "not " if ($str =~ '\A;')==$neg;
+       print "ok ", $count++;
+       print " ($@)" if $@ && $DEBUG;
+       print "\n";
+}
+
+__DATA__
+# USING: gen_extract_tagged("BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)")->($str);
+       ignore\n this and then BEGINHERE at the ENDHERE;
+       ignore\n this and then BEGINTHIS at the ENDTHIS;
+
+# USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)");
+       ignore\n this and then BEGINHERE at the ENDHERE;
+       ignore\n this and then BEGINTHIS at the ENDTHIS;
+
+# USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)");
+       ignore\n this and then BEGINHERE at the ENDHERE;
+       ignore\n this and then BEGINTHIS at the ENDTHIS;
+
+# THIS SHOULD FAIL
+       ignore\n this and then BEGINTHIS at the ENDTHAT;
+
+# USING: extract_tagged($str,"BEGIN","END","(?s).*?(?=BEGIN)");
+       ignore\n this and then BEGIN at the END;
+
+# USING: extract_tagged($str);
+       <A-1 HREF="#section2">some text</A-1>;
+
+# USING: extract_tagged($str,qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]});
+       <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+
+# USING: extract_tagged($str,"BEGIN","END");
+       BEGIN at the BEGIN keyword and END at the END;
+       BEGIN at the beginning and end at the END;
+
+# USING: extract_tagged($str,undef,undef,undef,{ignore=>["<[^>]*/>"]});
+       <A>aaa<B>bbb<BR/>ccc</B>ddd</A>;
+
+# USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"MAX"});
+       ; at the ;-) keyword
+
+# USING: extract_tagged($str,"<[A-Z]+>",undef, undef, {ignore=>["<BR>"]});
+       <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+
+# THESE SHOULD FAIL
+       BEGIN at the beginning and end at the end;
+       BEGIN at the BEGIN keyword and END at the end;
+
+# TEST EXTRACTION OF TAGGED STRINGS
+# USING: extract_tagged($str,"BEGIN","END",undef,{reject=>["BEGIN","END"]});
+# THESE SHOULD FAIL
+       BEGIN at the BEGIN keyword and END at the end;
+
+# USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"PARA"});
+       ; at the ;-) keyword
+
+
+# USING: extract_tagged($str);
+       <A>some text</A>;
+       <B>some text<A>other text</A></B>;
+       <A>some text<A>other text</A></A>;
+       <A HREF="#section2">some text</A>;
+
+# THESE SHOULD FAIL
+       <A>some text
+       <A>some text<A>other text</A>;
+       <B>some text<A>other text</B>;

diff --git a/lib/Text/Balanced/t/xvari.t b/lib/Text/Balanced/t/xvari.t
new file mode 100644 (file)
index 0000000..dd35b9c
--- /dev/null
+++ b/lib/Text/Balanced/t/xvari.t
@@ -0,0 +1,107 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..81\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_variable );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+       chomp $str;
+       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+       $str =~ s/\\n/\n/g;
+       debug "\tUsing: $cmd\n";
+       debug "\t   on: [$str]\n";
+
+       my @res;
+       $var = eval "\@res = $cmd";
+       debug "\t list got: [" . join("|",@res) . "]\n";
+       debug "\t list left: [$str]\n";
+       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+       print "ok ", $count++;
+       print " ($@)" if $@ && $DEBUG;
+       print "\n";
+
+       pos $str = 0;
+       $var = eval $cmd;
+       $var = "<undef>" unless defined $var;
+       debug "\t scalar got: [$var]\n";
+       debug "\t scalar left: [$str]\n";
+       print "not " if ($str =~ '\A;')==$neg;
+       print "ok ", $count++;
+       print " ($@)" if $@ && $DEBUG;
+       print "\n";
+}
+
+__DATA__
+
+# USING: extract_variable($str);
+# THESE SHOULD FAIL
+$a->;
+$a (1..3) { print $a };
+
+# USING: extract_variable($str);
+*var;
+*$var;
+*{var};
+*{$var};
+*var{cat};
+\&var;
+\&mod::var;
+\&mod'var;
+$a;
+$_;
+$a[1];
+$_[1];
+$a{cat};
+$_{cat};
+$a->[1];
+$a->{"cat"}[1];
+@$listref;
+@{$listref};
+$obj->nextval;
+$obj->_nextval;
+$obj->next_val_;
+@{$obj->nextval};
+@{$obj->nextval($cat,$dog)->{new}};
+@{$obj->nextval($cat?$dog:$fish)->{new}};
+@{$obj->nextval(cat()?$dog:$fish)->{new}};
+$ a {'cat'};
+$a::b::c{d}->{$e->()};
+$a'b'c'd{e}->{$e->()};
+$a'b::c'd{e}->{$e->()};
+$#_;
+$#array;
+$#{array};
+$var[$#var];
+
+# THESE SHOULD FAIL
+$a->;
+@{$;
+$ a :: b :: c
+$ a ' b ' c
+
+# USING: extract_variable($str,'=*');
+========$a;

diff --git a/lib/Text/ParseWords.t b/lib/Text/ParseWords.t
new file mode 100755 (executable)
index 0000000..261d81f
--- /dev/null
+++ b/lib/Text/ParseWords.t
@@ -0,0 +1,110 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use warnings;
+use Text::ParseWords;
+
+print "1..18\n";
+
+@words = shellwords(qq(foo "bar quiz" zoo));
+print "not " if $words[0] ne 'foo';
+print "ok 1\n";
+print "not " if $words[1] ne 'bar quiz';
+print "ok 2\n";
+print "not " if $words[2] ne 'zoo';
+print "ok 3\n";
+
+{
+  # Gonna get some undefined things back
+  no warnings 'uninitialized' ;
+
+  # Test quotewords() with other parameters and null last field
+  @words = quotewords(':+', 1, 'foo:::"bar:foo":zoo zoo:');
+  print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo;);
+  print "ok 4\n";
+}
+
+# Test $keep eq 'delimiters' and last field zero
+@words = quotewords('\s+', 'delimiters', '4 3 2 1 0');
+print "not " unless join(";", @words) eq qq(4; ;3; ;2; ;1; ;0);
+print "ok 5\n";
+
+# Big ol' nasty test (thanks, Joerk!)
+$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd" eee\\\\\\"ffff" "gg"';
+
+# First with $keep == 1
+$result = join('|', parse_line('\s+', 1, $string));
+print "not " unless $result eq 'aaaa"bbbbb"|cc\\ cc|\\\\\\"dddd" eee\\\\\\"ffff"|"gg"';
+print "ok 6\n";
+
+# Now, $keep == 0
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\"ffff|gg';
+print "ok 7\n";
+
+# Now test single quote behavior
+$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd\' eee\\\\\\"ffff\' gg';
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\\\\\"ffff|gg';
+print "ok 8\n";
+
+# Make sure @nested_quotewords does the right thing
+@lists = nested_quotewords('\s+', 0, 'a b c', '1 2 3', 'x y z');
+print "not " unless (@lists == 3 && @{$lists[0]} == 3 && @{$lists[1]} == 3 && @{$lists[2]} == 3);
+print "ok 9\n";
+
+# Now test error return
+$string = 'foo bar baz"bach blech boop';
+
+@words = shellwords($string);
+print "not " if (@words);
+print "ok 10\n";
+
+@words = parse_line('s+', 0, $string);
+print "not " if (@words);
+print "ok 11\n";
+
+@words = quotewords('s+', 0, $string);
+print "not " if (@words);
+print "ok 12\n";
+
+{
+  # Gonna get some more undefined things back
+  no warnings 'uninitialized' ;
+
+  @words = nested_quotewords('s+', 0, $string);
+  print "not " if (@words);
+  print "ok 13\n";
+
+  # Now test empty fields
+  $result = join('|', parse_line(':', 0, 'foo::0:"":::'));
+  print "not " unless ($result eq 'foo||0||||');
+  print "ok 14\n";
+
+  # Test for 0 in quotes without $keep
+  $result = join('|', parse_line(':', 0, ':"0":'));
+  print "not " unless ($result eq '|0|');
+  print "ok 15\n";
+
+  # Test for \001 in quoted string
+  $result = join('|', parse_line(':', 0, ':"' . "\001" . '":'));
+  print "not " unless ($result eq "|\1|");
+  print "ok 16\n";
+
+}
+
+# Now test perlish single quote behavior
+$Text::ParseWords::PERL_SINGLE_QUOTE = 1;
+$string = 'aaaa"bbbbb" cc\ cc \\\\\"dddd\' eee\\\\\"\\\'ffff\' gg';
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\"dddd eee\\\\"\'ffff|gg';
+print "ok 17\n";
+
+# test whitespace in the delimiters
+@words = quotewords(' ', 1, '4 3 2 1 0');
+print "not " unless join(";", @words) eq qq(4;3;2;1;0);
+print "ok 18\n";

diff --git a/lib/Text/Soundex.t b/lib/Text/Soundex.t
new file mode 100755 (executable)
index 0000000..d35f264
--- /dev/null
+++ b/lib/Text/Soundex.t
@@ -0,0 +1,143 @@
+#!./perl
+#
+# $Id: soundex.t,v 1.2 1994/03/24 00:30:27 mike Exp $
+#
+# test module for soundex.pl
+#
+# $Log: soundex.t,v $
+# Revision 1.2  1994/03/24  00:30:27  mike
+# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
+# in the way I handles leasing characters which were different but had
+# the same soundex code.  This showed up comparing it with Oracle's
+# soundex output.
+#
+# Revision 1.1  1994/03/02  13:03:02  mike
+# Initial revision
+#
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Text::Soundex;
+
+$test = 0;
+print "1..13\n";
+
+while (<DATA>)
+{
+  chop;
+  next if /^\s*;?#/;
+  next if /^\s*$/;
+
+  ++$test;
+  $bad = 0;
+
+  if (/^eval\s+/)
+  {
+    ($try = $_) =~ s/^eval\s+//;
+
+    eval ($try);
+    if ($@)
+    {
+      $bad++;
+      print "not ok $test\n";
+      print "# eval '$try' returned $@";
+    }
+  }
+  elsif (/^\(/)
+  {
+    ($in, $out) = split (':');
+
+    $try = "\@expect = $out; \@got = &soundex $in;";
+    eval ($try);
+
+    if (@expect != @got)
+    {
+      $bad++;
+      print "not ok $test\n";
+      print "# expected ", scalar @expect, " results, got ", scalar @got, "\n";
+      print "# expected (", join (', ', @expect),
+           ") got (", join (', ', @got), ")\n";
+    }
+    else
+    {
+      while (@got)
+      {
+       $expect = shift @expect;
+       $got = shift @got;
+
+       if ($expect ne $got)
+       {
+         $bad++;
+         print "not ok $test\n";
+         print "# expected $expect, got $got\n";
+       }
+      }
+    }
+  }
+  else
+  {
+    ($in, $out) = split (':');
+
+    $try = "\$expect = $out; \$got = &soundex ($in);";
+    eval ($try);
+
+    if ($expect ne $got)
+    {
+      $bad++;
+      print "not ok $test\n";
+      print "# expected $expect, got $got\n";
+    }
+  }
+
+  print "ok $test\n" unless $bad;
+}
+
+__END__
+#
+# 1..6
+#
+# Knuth's test cases, scalar in, scalar out
+#
+'Euler':'E460'
+'Gauss':'G200'
+'Hilbert':'H416'
+'Knuth':'K530'
+'Lloyd':'L300'
+'Lukasiewicz':'L222'
+#
+# 7..8
+#
+# check default bad code
+#
+'2 + 2 = 4':undef
+undef:undef
+#
+# 9
+#
+# check array in, array out
+#
+('Ellery', 'Ghosh', 'Heilbronn', 'Kant', 'Ladd', 'Lissajous'):('E460', 'G200', 'H416', 'K530', 'L300', 'L222')
+#
+# 10
+#
+# check array with explicit undef
+#
+('Mike', undef, 'Stok'):('M200', undef, 'S320')
+#
+# 11..12
+#
+# check setting $Text::Soundex::noCode
+#
+eval $soundex_nocode = 'Z000';
+('Mike', undef, 'Stok'):('M200', 'Z000', 'S320')
+#
+# 13
+#
+# a subtle difference between me & oracle, spotted by Rich Pinder
+# <rpinder@hsc.usc.edu>
+#
+CZARKOWSKA:C622

diff --git a/lib/Text/Tabs.t b/lib/Text/Tabs.t
new file mode 100755 (executable)
index 0000000..2856aff
--- /dev/null
+++ b/lib/Text/Tabs.t
@@ -0,0 +1,141 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+@tests = (split(/\nEND\n/s, <<DONE));
+TEST 1 u
+                x
+END
+               x
+END
+TEST 2 e
+               x
+END
+                x
+END
+TEST 3 e
+       x
+               y
+                       z
+END
+        x
+                y
+                        z
+END
+TEST 4 u
+        x
+                y
+                        z
+END
+       x
+               y
+                       z
+END
+TEST 5 u
+This    Is      a       test    of      a       line with many embedded tabs
+END
+This   Is      a       test    of      a       line with many embedded tabs
+END
+TEST 6 e
+This   Is      a       test    of      a       line with many embedded tabs
+END
+This    Is      a       test    of      a       line with many embedded tabs
+END
+TEST 7 u
+            x
+END
+           x
+END
+TEST 8 e
+       
+               
+       
+
+           
+END
+        
+                
+        
+
+           
+END
+TEST 9 u
+           
+END
+          
+END
+TEST 10 u
+       
+               
+       
+
+           
+END
+       
+               
+       
+
+          
+END
+TEST 11 u
+foobar                  IN     A               140.174.82.12
+
+END
+foobar                 IN      A               140.174.82.12
+
+END
+DONE
+
+$| = 1;
+
+my $testcount = "1..";
+$testcount .= @tests/2;
+print "$testcount\n";
+
+use Text::Tabs;
+
+$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
+
+$tn = 1;
+while (@tests) {
+       my $in = shift(@tests);
+       my $out = shift(@tests);
+
+       $in =~ s/^TEST\s*(\d+)?\s*(\S+)?\n//;
+
+       if ($2 eq 'e') {
+               $f = \&expand;
+               $fn = 'expand';
+       } else {
+               $f = \&unexpand;
+               $fn = 'unexpand';
+       }
+
+       my $back = &$f($in);
+
+       if ($back eq $out) {
+               print "ok $tn\n";
+       } elsif ($rerun) {
+               my $oi = $in;
+               foreach ($in, $back, $out) {
+                       s/\t/^I\t/gs;
+                       s/\n/\$\n/gs;
+               }
+               print "------------ input ------------\n";
+               print $in;
+               print "\$\n------------ $fn -----------\n";
+               print $back;
+               print "\$\n------------ expected ---------\n";
+               print $out;
+               print "\$\n-------------------------------\n";
+               $Text::Tabs::debug = 1;
+               my $back = &$f($in);
+               exit(1);
+       } else {
+               print "not ok $tn\n";
+       }
+       $tn++;
+}

diff --git a/lib/Text/Wrap/fill.t b/lib/Text/Wrap/fill.t
new file mode 100755 (executable)
index 0000000..5ff3850
--- /dev/null
+++ b/lib/Text/Wrap/fill.t
@@ -0,0 +1,98 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Text::Wrap qw(&fill);
+
+@tests = (split(/\nEND\n/s, <<DONE));
+TEST1
+Cyberdog Information
+
+Cyberdog & Netscape in the news
+Important Press Release regarding Cyberdog and Netscape. Check it out! 
+
+Cyberdog Plug-in Support!
+Cyberdog support for Netscape Plug-ins is now available to download! Go
+to the Cyberdog Beta Download page and download it now! 
+
+Cyberdog Book
+Check out Jesse Feiler's way-cool book about Cyberdog. You can find
+details out about the book as well as ordering information at Philmont
+Software Mill site. 
+
+Java!
+Looking to view Java applets in Cyberdog 1.1 Beta 3? Download and install
+the Mac OS Runtime for Java and try it out! 
+
+Cyberdog 1.1 Beta 3
+We hope that Cyberdog and OpenDoc 1.1 will be available within the next
+two weeks. In the meantime, we have released another version of
+Cyberdog, Cyberdog 1.1 Beta 3. This version fixes several bugs that were
+reported to us during out public beta period. You can check out our release
+notes to see what we fixed! 
+END
+    Cyberdog Information
+    Cyberdog & Netscape in the news Important Press Release regarding
+ Cyberdog and Netscape. Check it out! 
+    Cyberdog Plug-in Support! Cyberdog support for Netscape Plug-ins is now
+ available to download! Go to the Cyberdog Beta Download page and download
+ it now! 
+    Cyberdog Book Check out Jesse Feiler's way-cool book about Cyberdog.
+ You can find details out about the book as well as ordering information at
+ Philmont Software Mill site. 
+    Java! Looking to view Java applets in Cyberdog 1.1 Beta 3? Download and
+ install the Mac OS Runtime for Java and try it out! 
+    Cyberdog 1.1 Beta 3 We hope that Cyberdog and OpenDoc 1.1 will be
+ available within the next two weeks. In the meantime, we have released
+ another version of Cyberdog, Cyberdog 1.1 Beta 3. This version fixes
+ several bugs that were reported to us during out public beta period. You
+ can check out our release notes to see what we fixed! 
+END
+DONE
+
+
+$| = 1;
+
+print "1..", @tests/2, "\n";
+
+use Text::Wrap;
+
+$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
+
+$tn = 1;
+while (@tests) {
+       my $in = shift(@tests);
+       my $out = shift(@tests);
+
+       $in =~ s/^TEST(\d+)?\n//;
+
+       my $back = fill('    ', ' ', $in);
+
+       if ($back eq $out) {
+               print "ok $tn\n";
+       } elsif ($rerun) {
+               my $oi = $in;
+               open(F,">#o") and do { print F $back; close(F) };
+               open(F,">#e") and do { print F $out;  close(F) };
+               foreach ($in, $back, $out) {
+                       s/\t/^I\t/gs;
+                       s/\n/\$\n/gs;
+               }
+               print "------------ input ------------\n";
+               print $in;
+               print "\n------------ output -----------\n";
+               print $back;
+               print "\n------------ expected ---------\n";
+               print $out;
+               print "\n-------------------------------\n";
+               $Text::Wrap::debug = 1;
+               fill('    ', ' ', $oi);
+               exit(1);
+       } else {
+               print "not ok $tn\n";
+       }
+       $tn++;
+}

diff --git a/lib/Text/Wrap/wrap.t b/lib/Text/Wrap/wrap.t
new file mode 100755 (executable)
index 0000000..fee6ce0
--- /dev/null
+++ b/lib/Text/Wrap/wrap.t
@@ -0,0 +1,209 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+@tests = (split(/\nEND\n/s, <<DONE));
+TEST1
+This 
+is
+a
+test
+END
+   This 
+ is
+ a
+ test
+END
+TEST2
+This is a test of a very long line.  It should be broken up and put onto multiple lines.
+This is a test of a very long line.  It should be broken up and put onto multiple lines.
+
+This is a test of a very long line.  It should be broken up and put onto multiple lines.
+END
+   This is a test of a very long line. It should be broken up and put onto
+ multiple lines.
+ This is a test of a very long line.  It should be broken up and put onto
+ multiple lines.
+ 
+ This is a test of a very long line.  It should be broken up and put onto
+ multiple lines.
+END
+TEST3
+This is a test of a very long line.  It should be broken up and put onto multiple lines.
+END
+   This is a test of a very long line. It should be broken up and put onto
+ multiple lines.
+END
+TEST4
+This is a test of a very long line.  It should be broken up and put onto multiple lines.
+
+END
+   This is a test of a very long line. It should be broken up and put onto
+ multiple lines.
+
+END
+TEST5
+This is a test of a very long line. It should be broken up and put onto multiple This is a test of a very long line. It should be broken up and put
+END
+   This is a test of a very long line. It should be broken up and put onto
+ multiple This is a test of a very long line. It should be broken up and
+ put
+END
+TEST6
+11111111 22222222 33333333 44444444 55555555 66666666 77777777 888888888 999999999 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee ffffffff gggggggg hhhhhhhh iiiiiiii jjjjjjjj kkkkkkkk llllllll mmmmmmmmm nnnnnnnnn ooooooooo ppppppppp qqqqqqqqq rrrrrrrrr sssssssss
+END
+   11111111 22222222 33333333 44444444 55555555 66666666 77777777 888888888
+ 999999999 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee ffffffff
+ gggggggg hhhhhhhh iiiiiiii jjjjjjjj kkkkkkkk llllllll mmmmmmmmm nnnnnnnnn
+ ooooooooo ppppppppp qqqqqqqqq rrrrrrrrr sssssssss
+END
+TEST7
+c3t1d0s6 c4t1d0s6 c5t1d0s6 c6t1d0s6 c7t1d0s6 c8t1d0s6 c9t1d0s6 c10t1d0s6 c11t1d0s6 c12t1d0s6 c13t1d0s6 c14t1d0s6 c15t1d0s6 c16t1d0s6 c3t1d0s0 c4t1d0s0 c5t1d0s0 c6t1d0s0 c7t1d0s0 c8t1d0s0 c9t1d0s0 c10t1d0s0 c11t1d0s0 c12t1d0s0 c13t1d0s0 c14t1d0s0 c15t1d0s0 c16t1d0s0
+END
+   c3t1d0s6 c4t1d0s6 c5t1d0s6 c6t1d0s6 c7t1d0s6 c8t1d0s6 c9t1d0s6 c10t1d0s6
+ c11t1d0s6 c12t1d0s6 c13t1d0s6 c14t1d0s6 c15t1d0s6 c16t1d0s6 c3t1d0s0
+ c4t1d0s0 c5t1d0s0 c6t1d0s0 c7t1d0s0 c8t1d0s0 c9t1d0s0 c10t1d0s0 c11t1d0s0
+ c12t1d0s0 c13t1d0s0 c14t1d0s0 c15t1d0s0 c16t1d0s0
+END
+TEST8
+A test of a very very long word.
+a123456789b123456789c123456789d123456789e123456789f123456789g123456789g1234567
+END
+   A test of a very very long word.
+ a123456789b123456789c123456789d123456789e123456789f123456789g123456789g123
+ 4567
+END
+TEST9
+A test of a very very long word.  a123456789b123456789c123456789d123456789e123456789f123456789g123456789g1234567
+END
+   A test of a very very long word. 
+ a123456789b123456789c123456789d123456789e123456789f123456789g123456789g123
+ 4567
+END
+TEST10
+my mother once said
+"never eat paste my darling"
+would that I heeded
+END
+   my mother once said
+ "never eat paste my darling"
+ would that I heeded
+END
+TEST11
+This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_program_does_not_crash_and_burn
+END
+   This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_pr
+ ogram_does_not_crash_and_burn
+END
+TEST12
+This
+
+Has
+
+Blank
+
+Lines
+
+END
+   This
+ 
+ Has
+ 
+ Blank
+ 
+ Lines
+
+END
+DONE
+
+
+$| = 1;
+
+print "1..", 1 +@tests, "\n";
+
+use Text::Wrap;
+
+$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
+
+$tn = 1;
+
+@st = @tests;
+while (@st) {
+       my $in = shift(@st);
+       my $out = shift(@st);
+
+       $in =~ s/^TEST(\d+)?\n//;
+
+       my $back = wrap('   ', ' ', $in);
+
+       if ($back eq $out) {
+               print "ok $tn\n";
+       } elsif ($rerun) {
+               my $oi = $in;
+               foreach ($in, $back, $out) {
+                       s/\t/^I\t/gs;
+                       s/\n/\$\n/gs;
+               }
+               print "------------ input ------------\n";
+               print $in;
+               print "\n------------ output -----------\n";
+               print $back;
+               print "\n------------ expected ---------\n";
+               print $out;
+               print "\n-------------------------------\n";
+               $Text::Wrap::debug = 1;
+               wrap('   ', ' ', $oi);
+               exit(1);
+       } else {
+               print "not ok $tn\n";
+       }
+       $tn++;
+
+}
+
+@st = @tests;
+while(@st) {
+       my $in = shift(@st);
+       my $out = shift(@st);
+
+       $in =~ s/^TEST(\d+)?\n//;
+
+       my @in = split("\n", $in, -1);
+       @in = ((map { "$_\n" } @in[0..$#in-1]), $in[-1]);
+       
+       my $back = wrap('   ', ' ', @in);
+
+       if ($back eq $out) {
+               print "ok $tn\n";
+       } elsif ($rerun) {
+               my $oi = $in;
+               foreach ($in, $back, $out) {
+                       s/\t/^I\t/gs;
+                       s/\n/\$\n/gs;
+               }
+               print "------------ input2 ------------\n";
+               print $in;
+               print "\n------------ output2 -----------\n";
+               print $back;
+               print "\n------------ expected2 ---------\n";
+               print $out;
+               print "\n-------------------------------\n";
+               $Text::Wrap::debug = 1;
+               wrap('   ', ' ', $oi);
+               exit(1);
+       } else {
+               print "not ok $tn\n";
+       }
+       $tn++;
+}
+
+$Text::Wrap::huge = 'overflow';
+
+my $tw = 'This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_program_does_not_crash_and_burn';
+my $w = wrap('zzz','yyy',$tw);
+print (($w eq "zzz$tw") ? "ok $tn\n" : "not ok $tn");
+$tn++;
+

diff --git a/lib/Tie/Array/push.t b/lib/Tie/Array/push.t
new file mode 100755 (executable)
index 0000000..b19aa0d
--- /dev/null
+++ b/lib/Tie/Array/push.t
@@ -0,0 +1,25 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}    
+
+{
+ package Basic;
+ use Tie::Array;
+ @ISA = qw(Tie::Array);
+
+ sub TIEARRAY  { return bless [], shift }
+ sub FETCH     { $_[0]->[$_[1]] }
+ sub STORE     { $_[0]->[$_[1]] = $_[2] }
+ sub FETCHSIZE { scalar(@{$_[0]}) }
+ sub STORESIZE { $#{$_[0]} = $_[1]-1 }
+}
+
+tie @x,Basic;
+tie @get,Basic;
+tie @got,Basic;
+tie @tests,Basic;
+require "op/push.t"

diff --git a/lib/Tie/Array/splice.t b/lib/Tie/Array/splice.t
new file mode 100644 (file)
index 0000000..d7ea6cc
--- /dev/null
+++ b/lib/Tie/Array/splice.t
@@ -0,0 +1,17 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}
+
+# bug id 20001020.002
+# -dlc 20001021
+
+use Tie::Array;
+tie @a,Tie::StdArray;
+undef *Tie::StdArray::SPLICE;
+require "op/splice.t"
+
+# Pre-fix, this failed tests 6-9

diff --git a/lib/Tie/Array/std.t b/lib/Tie/Array/std.t
new file mode 100755 (executable)
index 0000000..c4ae071
--- /dev/null
+++ b/lib/Tie/Array/std.t
@@ -0,0 +1,13 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}
+
+use Tie::Array;
+tie @foo,Tie::StdArray;
+tie @ary,Tie::StdArray;
+tie @bar,Tie::StdArray;
+require "op/array.t"

diff --git a/lib/Tie/Array/stdpush.t b/lib/Tie/Array/stdpush.t
new file mode 100755 (executable)
index 0000000..31af30c
--- /dev/null
+++ b/lib/Tie/Array/stdpush.t
@@ -0,0 +1,11 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}
+
+use Tie::Array;
+tie @x,Tie::StdArray;
+require "op/push.t"

diff --git a/lib/Tie/Handle/stdhandle.t b/lib/Tie/Handle/stdhandle.t
new file mode 100755 (executable)
index 0000000..f03f5d9
--- /dev/null
+++ b/lib/Tie/Handle/stdhandle.t
@@ -0,0 +1,47 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Tie::Handle;
+tie *tst,Tie::StdHandle;
+
+$f = 'tst';
+
+print "1..13\n";
+
+# my $file tests
+
+unlink("afile.new") if -f "afile";
+print "$!\nnot " unless open($f,"+>afile") && open($f, "+<", "afile");
+print "ok 1\n";
+print "$!\nnot " unless binmode($f);
+print "ok 2\n";
+print "not " unless -f "afile";
+print "ok 3\n";
+print "not " unless print $f "SomeData\n";
+print "ok 4\n";
+print "not " unless tell($f) == 9;
+print "ok 5\n";
+print "not " unless printf $f "Some %d value\n",1234;
+print "ok 6\n";
+print "not " unless seek($f,0,0);
+print "ok 7\n";
+$b = <$f>;
+print "not " unless $b eq "SomeData\n";
+print "ok 8\n";
+print "not " if eof($f);
+print "ok 9\n";
+read($f,($b=''),4);
+print "'$b' not " unless $b eq 'Some';
+print "ok 10\n";
+print "not " unless getc($f) eq ' ';
+print "ok 11\n";
+$b = <$f>;
+print "not " unless eof($f);
+print "ok 12\n";
+print "not " unless close($f);
+print "ok 13\n";
+unlink("afile");

diff --git a/lib/Tie/RefHash.t b/lib/Tie/RefHash.t
new file mode 100644 (file)
index 0000000..d80b2e1
--- /dev/null
+++ b/lib/Tie/RefHash.t
@@ -0,0 +1,305 @@
+#!/usr/bin/perl -w
+# 
+# Basic test suite for Tie::RefHash and Tie::RefHash::Nestable.
+# 
+# The testing is in two parts: first, run lots of tests on both a tied
+# hash and an ordinary un-tied hash, and check they give the same
+# answer.  Then there are tests for those cases where the tied hashes
+# should behave differently to normal hashes, that is, when using
+# references as keys.
+# 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}    
+
+use strict;
+use Tie::RefHash;
+use Data::Dumper;
+my $numtests = 34;
+my $currtest = 1;
+print "1..$numtests\n";
+
+my $ref = []; my $ref1 = [];
+
+# Test standard hash functionality, by performing the same operations
+# on a tied hash and on a normal hash, and checking that the results
+# are the same.  This does of course assume that Perl hashes are not
+# buggy :-)
+# 
+my @tests = standard_hash_tests();
+
+my @ordinary_results = runtests(\@tests, undef);
+foreach my $class ('Tie::RefHash', 'Tie::RefHash::Nestable') {
+    my @tied_results = runtests(\@tests, $class);
+    my $all_ok = 1;
+
+    die if @ordinary_results != @tied_results;
+    foreach my $i (0 .. $#ordinary_results) {
+        my ($or, $ow, $oe) = @{$ordinary_results[$i]};
+        my ($tr, $tw, $te) = @{$tied_results[$i]};
+        
+        my $ok = 1;
+        local $^W = 0;
+        $ok = 0 if (defined($or) != defined($tr)) or ($or ne $tr);
+        $ok = 0 if (defined($ow) != defined($tw)) or ($ow ne $tw);
+        $ok = 0 if (defined($oe) != defined($te)) or ($oe ne $te);
+        
+        if (not $ok) {
+            print STDERR
+              "failed for $class: $tests[$i]\n",
+              "ordinary hash gave:\n",
+              defined $or ? "\tresult:    $or\n" : "\tundef result\n",
+              defined $ow ? "\twarning:   $ow\n" : "\tno warning\n",
+              defined $oe ? "\texception: $oe\n" : "\tno exception\n",
+              "tied $class hash gave:\n",
+              defined $tr ? "\tresult:    $tr\n" : "\tundef result\n",
+              defined $tw ? "\twarning:   $tw\n" : "\tno warning\n",
+              defined $te ? "\texception: $te\n" : "\tno exception\n",
+              "\n";
+            $all_ok = 0;
+        }
+    }
+    test($all_ok);
+}
+
+# Now test Tie::RefHash's special powers
+my (%h, $h);
+$h = eval { tie %h, 'Tie::RefHash' };
+warn $@ if $@;
+test(not $@);
+test(ref($h) eq 'Tie::RefHash');
+test(defined(tied(%h)) and tied(%h) =~ /^Tie::RefHash/);
+$h{$ref} = 'cholet';
+test($h{$ref} eq 'cholet');
+test(exists $h{$ref});
+test((keys %h) == 1);
+test(ref((keys %h)[0]) eq 'ARRAY');
+test((keys %h)[0] eq $ref);
+test((values %h) == 1);
+test((values %h)[0] eq 'cholet');
+my $count = 0;
+while (my ($k, $v) = each %h) {
+    if ($count++ == 0) {
+        test(ref($k) eq 'ARRAY');
+        test($k eq $ref);
+    }
+}
+test($count == 1);
+delete $h{$ref};
+test(not defined $h{$ref});
+test(not exists($h{$ref}));
+test((keys %h) == 0);
+test((values %h) == 0);
+undef $h;
+untie %h;
+
+# And now Tie::RefHash::Nestable's differences from Tie::RefHash.
+$h = eval { tie %h, 'Tie::RefHash::Nestable' };
+warn $@ if $@;
+test(not $@);
+test(ref($h) eq 'Tie::RefHash::Nestable');
+test(defined(tied(%h)) and tied(%h) =~ /^Tie::RefHash::Nestable/);
+$h{$ref}->{$ref1} = 'bungo';
+test($h{$ref}->{$ref1} eq 'bungo');
+
+# Test that the nested hash is also tied (for current implementation)
+test(defined(tied(%{$h{$ref}}))
+     and tied(%{$h{$ref}}) =~ /^Tie::RefHash::Nestable=/ );
+
+test((keys %h) == 1);
+test((keys %h)[0] eq $ref);
+test((keys %{$h{$ref}}) == 1);
+test((keys %{$h{$ref}})[0] eq $ref1);
+
+
+die "expected to run $numtests tests, but ran ", $currtest - 1
+  if $currtest - 1 != $numtests;
+
+@tests = ();
+undef $ref;
+undef $ref1;
+
+exit();
+
+
+# Print 'ok X' if true, 'not ok X' if false
+# Uses global $currtest.
+# 
+sub test {
+    my $t = shift;
+    print 'not ' if not $t;
+    print 'ok ', $currtest++, "\n";
+}
+
+
+# Wrapper for Data::Dumper to 'dump' a scalar as an EXPR string. 
+sub dumped {
+    my $s = shift;
+    my $d = Dumper($s);
+    $d =~ s/^\$VAR1 =\s*//;
+    $d =~ s/;$//;
+    chomp $d;
+    return $d;
+}
+
+# Crudely dump a hash into a canonical string representation (because
+# hash keys can appear in any order, Data::Dumper may give different
+# strings for the same hash).
+# 
+sub dumph {
+    my $h = shift;
+    my $r = '';
+    foreach (sort keys %$h) {
+        $r = dumped($_) . ' => ' . dumped($h->{$_}) . "\n";
+    }
+    return $r;
+}
+
+# Run the tests and give results.
+# 
+# Parameters: reference to list of tests to run
+#             name of class to use for tied hash, or undef if not tied
+# 
+# Returns: list of [R, W, E] tuples, one for each test.
+# R is the return value from running the test, W any warnings it gave,
+# and E any exception raised with 'die'.  E and W will be tidied up a
+# little to remove irrelevant details like line numbers :-)
+# 
+# Will also run a few of its own 'ok N' tests.
+# 
+sub runtests {
+    my ($tests, $class) = @_;
+    my @r;
+
+    my (%h, $h);
+    if (defined $class) {
+        $h = eval { tie %h, $class };
+        warn $@ if $@;
+        test(not $@);
+        test(ref($h) eq $class);
+        test(defined(tied(%h)) and tied(%h) =~ /^\Q$class\E/);
+    }
+
+    foreach (@$tests) {
+        my ($result, $warning, $exception);
+        local $SIG{__WARN__} = sub { $warning .= $_[0] };
+        $result = scalar(eval $_);
+        if ($@)
+         {
+          die "$@:$_" unless defined $class;
+          $exception = $@;
+         }
+
+        foreach ($warning, $exception) {
+            next if not defined;
+            s/ at .+ line \d+\.$//mg;
+            s/ at .+ line \d+, at .*//mg;
+            s/ at .+ line \d+, near .*//mg;
+        }
+
+        my (@warnings, %seen);
+        foreach (split /\n/, $warning) {
+            push @warnings, $_ unless $seen{$_}++;
+        }
+        $warning = join("\n", @warnings);
+
+        push @r, [ $result, $warning, $exception ];
+    }
+
+    return @r;
+}
+
+
+# Things that should work just the same for an ordinary hash and a
+# Tie::RefHash.
+# 
+# Each test is a code string to be eval'd, it should do something with
+# %h and give a scalar return value.  The global $ref and $ref1 may
+# also be used.
+# 
+# One thing we don't test is that the ordering from 'keys', 'values'
+# and 'each' is the same.  You can't reasonably expect that.
+# 
+sub standard_hash_tests {
+    my @r;
+
+    # Library of standard tests on keys, values and each
+    my $STD_TESTS = <<'END'
+    join $;, sort keys %h;
+    join $;, sort values %h;
+    { my ($v, %tmp); $tmp{$v}++ while (defined($v = each %h)); dumph(\%tmp) }
+    { my ($k, $v, %tmp); $tmp{"$k$;$v"}++ while (($k, $v) = each %h); dumph(\%tmp) }
+END
+  ;
+    
+    # Tests on the existence of the element 'foo'
+    my $FOO_TESTS = <<'END'
+    defined $h{foo};
+    exists $h{foo};
+    $h{foo};    
+END
+  ;
+
+    # Test storing and deleting 'foo'
+    push @r, split /\n/, <<"END"
+    $STD_TESTS;
+    $FOO_TESTS;
+    \$h{foo} = undef;
+    $STD_TESTS;
+    $FOO_TESTS;
+    \$h{foo} = 'hello';
+    $STD_TESTS;
+    $FOO_TESTS;
+    delete  \$h{foo};
+    $STD_TESTS;
+    $FOO_TESTS;
+END
+  ;
+
+    # Test storing and removing under ordinary keys
+    my @things = ('boink', 0, 1, '', undef);
+    foreach my $key (map { dumped($_) } @things) {
+        foreach my $value ((map { dumped($_) } @things), '$ref') {
+            push @r, split /\n/, <<"END"
+            \$h{$key} = $value;
+            $STD_TESTS;
+            defined \$h{$key};
+            exists \$h{$key};
+            \$h{$key};
+            delete \$h{$key};
+            $STD_TESTS;
+            defined \$h{$key};
+            exists \$h{$key};
+            \$h{$key};
+END
+  ;
+        }
+    }
+    
+    # Test hash slices
+    my @slicetests;
+    @slicetests = split /\n/, <<'END'
+    @h{'b'} = ();
+    @h{'c'} = ('d');
+    @h{'e'} = ('f', 'g');
+    @h{'h', 'i'} = ();
+    @h{'j', 'k'} = ('l');
+    @h{'m', 'n'} = ('o', 'p');
+    @h{'q', 'r'} = ('s', 't', 'u');
+END
+  ;
+    my @aaa = @slicetests;
+    foreach (@slicetests) {
+        push @r, $_;
+        push @r, split(/\n/, $STD_TESTS);
+    }
+
+    # Test CLEAR
+    push @r, '%h = ();', split(/\n/, $STD_TESTS);
+
+    return @r;
+}
+

diff --git a/lib/Tie/SubstrHash.t b/lib/Tie/SubstrHash.t
new file mode 100644 (file)
index 0000000..8256db7
--- /dev/null
+++ b/lib/Tie/SubstrHash.t
@@ -0,0 +1,111 @@
+#!/usr/bin/perl -w
+# 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}    
+
+print "1..20\n";
+
+use strict;
+
+require Tie::SubstrHash;
+
+my %a;
+
+tie %a, 'Tie::SubstrHash', 3, 3, 3;
+
+$a{abc} = 123;
+$a{bcd} = 234;
+
+print "not " unless $a{abc} == 123;
+print "ok 1\n";
+
+print "not " unless keys %a == 2;
+print "ok 2\n";
+
+delete $a{abc};
+
+print "not " unless $a{bcd} == 234;
+print "ok 3\n";
+
+print "not " unless (values %a)[0] == 234;
+print "ok 4\n";
+
+eval { $a{abcd} = 123 };
+print "not " unless $@ =~ /Key "abcd" is not 3 characters long/;
+print "ok 5\n";
+
+eval { $a{abc} = 1234 };
+print "not " unless $@ =~ /Value "1234" is not 3 characters long/;
+print "ok 6\n";
+
+eval { $a = $a{abcd}; $a++  };
+print "not " unless $@ =~ /Key "abcd" is not 3 characters long/;
+print "ok 7\n";
+
+@a{qw(abc cde)} = qw(123 345); 
+
+print "not " unless $a{cde} == 345;
+print "ok 8\n";
+
+eval { $a{def} = 456 };
+print "not " unless $@ =~ /Table is full \(3 elements\)/;
+print "ok 9\n";
+
+%a = ();
+
+print "not " unless keys %a == 0;
+print "ok 10\n";
+
+# Tests 11..16 by Linc Madison.
+
+my $hashsize = 119;                # arbitrary values from my data
+my %test;
+tie %test, "Tie::SubstrHash", 13, 86, $hashsize;
+
+for (my $i = 1; $i <= $hashsize; $i++) {
+        my $key1 = $i + 100_000;           # fix to uniform 6-digit numbers
+        my $key2 = "abcdefg$key1";
+        $test{$key2} = ("abcdefgh" x 10) . "$key1";
+}
+
+for (my $i = 1; $i <= $hashsize; $i++) {
+        my $key1 = $i + 100_000;
+        my $key2 = "abcdefg$key1";
+       unless ($test{$key2}) {
+               print "not ";
+               last;
+       }
+}
+print "ok 11\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(1) == 2;
+print "ok 12\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(2) == 2;
+print "ok 13\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(5.5) == 7;
+print "ok 14\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(13) == 13;
+print "ok 15\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(13.000001) == 17;
+print "ok 16\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(114) == 127;
+print "ok 17\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(1000) == 1009;
+print "ok 18\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(1024) == 1031;
+print "ok 19\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(10000) == 10007;
+print "ok 20\n";
+

diff --git a/lib/Time/Local.t b/lib/Time/Local.t
new file mode 100755 (executable)
index 0000000..100e076
--- /dev/null
+++ b/lib/Time/Local.t
@@ -0,0 +1,90 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Time::Local;
+
+# Set up time values to test
+@time =
+  (
+   #year,mon,day,hour,min,sec 
+   [1970,  1,  2, 00, 00, 00],
+   [1980,  2, 28, 12, 00, 00],
+   [1980,  2, 29, 12, 00, 00],
+   [1999, 12, 31, 23, 59, 59],
+   [2000,  1,  1, 00, 00, 00],
+   [2010, 10, 12, 14, 13, 12],
+  );
+
+# use vmsish 'time' makes for oddness around the Unix epoch
+if ($^O eq 'VMS') { $time[0][2]++ }
+
+print "1..", @time * 2 + 5, "\n";
+
+$count = 1;
+for (@time) {
+    my($year, $mon, $mday, $hour, $min, $sec) = @$_;
+    $year -= 1900;
+    $mon --;
+    my $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
+    # print scalar(localtime($time)), "\n";
+    my($s,$m,$h,$D,$M,$Y) = localtime($time);
+
+    if ($s == $sec &&
+       $m == $min &&
+       $h == $hour &&
+       $D == $mday &&
+       $M == $mon &&
+       $Y == $year
+       ) {
+       print "ok $count\n";
+    } else {
+       print "not ok $count\n";
+    }
+    $count++;
+
+    # Test gmtime function
+    $time = timegm($sec,$min,$hour,$mday,$mon,$year);
+    ($s,$m,$h,$D,$M,$Y) = gmtime($time);
+
+    if ($s == $sec &&
+       $m == $min &&
+       $h == $hour &&
+       $D == $mday &&
+       $M == $mon &&
+       $Y == $year
+       ) {
+       print "ok $count\n";
+    } else {
+       print "not ok $count\n";
+    }
+    $count++;
+}
+
+#print "Testing that the differences between a few dates makes sence...\n";
+
+timelocal(0,0,1,1,0,90) - timelocal(0,0,0,1,0,90) == 3600
+  or print "not ";
+print "ok ", $count++, "\n";
+
+timelocal(1,2,3,1,0,100) - timelocal(1,2,3,31,11,99) == 24 * 3600 
+  or print "not ";
+print "ok ", $count++, "\n";
+
+# Diff beween Jan 1, 1970 and Mar 1, 1970 = (31 + 28 = 59 days)
+timegm(0,0,0, 1, 2, 70) - timegm(0,0,0, 1, 0, 70) == 59 * 24 * 3600
+  or print "not ";
+print "ok ", $count++, "\n";
+
+
+#print "Testing timelocal.pl module too...\n";
+package test;
+require 'timelocal.pl';
+timegm(0,0,0,1,0,70) == main::timegm(0,0,0,1,0,70) or print "not ";
+print "ok ", $main::count++, "\n";
+
+timelocal(1,2,3,4,5,78) == main::timelocal(1,2,3,4,5,78) or print "not ";
+print "ok ", $main::count++, "\n";

diff --git a/lib/Time/gmtime.t b/lib/Time/gmtime.t
new file mode 100644 (file)
index 0000000..853ec3b
--- /dev/null
+++ b/lib/Time/gmtime.t
@@ -0,0 +1,57 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $hasgm;
+    eval { my $n = gmtime 0 };
+    $hasgm = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($hasgm) { print "1..0 # Skip: no gmtime\n"; exit 0 }
+}
+
+BEGIN {
+    our @gmtime = gmtime 0; # This is the function gmtime.
+    unless (@gmtime) { print "1..0 # Skip: gmtime failed\n"; exit 0 }
+}
+
+print "1..10\n";
+
+use Time::gmtime;
+
+print "ok 1\n";
+
+my $gmtime = gmtime 0 ; # This is the OO gmtime.
+
+print "not " unless $gmtime->sec   == $gmtime[0];
+print "ok 2\n";
+
+print "not " unless $gmtime->min   == $gmtime[1];
+print "ok 3\n";
+
+print "not " unless $gmtime->hour  == $gmtime[2];
+print "ok 4\n";
+
+print "not " unless $gmtime->mday  == $gmtime[3];
+print "ok 5\n";
+
+print "not " unless $gmtime->mon   == $gmtime[4];
+print "ok 6\n";
+
+print "not " unless $gmtime->year  == $gmtime[5];
+print "ok 7\n";
+
+print "not " unless $gmtime->wday  == $gmtime[6];
+print "ok 8\n";
+
+print "not " unless $gmtime->yday  == $gmtime[7];
+print "ok 9\n";
+
+print "not " unless $gmtime->isdst == $gmtime[8];
+print "ok 10\n";
+
+
+
+

diff --git a/lib/Time/localtime.t b/lib/Time/localtime.t
new file mode 100644 (file)
index 0000000..357615c
--- /dev/null
+++ b/lib/Time/localtime.t
@@ -0,0 +1,57 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $haslocal;
+    eval { my $n = localtime 0 };
+    $haslocal = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($haslocal) { print "1..0 # Skip: no localtime\n"; exit 0 }
+}
+
+BEGIN {
+    our @localtime = localtime 0; # This is the function localtime.
+    unless (@localtime) { print "1..0 # Skip: localtime failed\n"; exit 0 }
+}
+
+print "1..10\n";
+
+use Time::localtime;
+
+print "ok 1\n";
+
+my $localtime = localtime 0 ; # This is the OO localtime.
+
+print "not " unless $localtime->sec   == $localtime[0];
+print "ok 2\n";
+
+print "not " unless $localtime->min   == $localtime[1];
+print "ok 3\n";
+
+print "not " unless $localtime->hour  == $localtime[2];
+print "ok 4\n";
+
+print "not " unless $localtime->mday  == $localtime[3];
+print "ok 5\n";
+
+print "not " unless $localtime->mon   == $localtime[4];
+print "ok 6\n";
+
+print "not " unless $localtime->year  == $localtime[5];
+print "ok 7\n";
+
+print "not " unless $localtime->wday  == $localtime[6];
+print "ok 8\n";
+
+print "not " unless $localtime->yday  == $localtime[7];
+print "ok 9\n";
+
+print "not " unless $localtime->isdst == $localtime[8];
+print "ok 10\n";
+
+
+
+

diff --git a/lib/User/grent.t b/lib/User/grent.t
new file mode 100644 (file)
index 0000000..760b814
--- /dev/null
+++ b/lib/User/grent.t
@@ -0,0 +1,44 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $hasgr;
+    eval { my @n = getgrgid 0 };
+    $hasgr = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($hasgr) { print "1..0 # Skip: no getgrgid\n"; exit 0 }
+    use Config;
+    $hasgr = 0 unless $Config{'i_grp'} eq 'define';
+    unless ($hasgr) { print "1..0 # Skip: no grp.h\n"; exit 0 }
+}
+
+BEGIN {
+    our @grent = getgrgid 0; # This is the function getgrgid.
+    unless (@grent) { print "1..0 # Skip: no gid 0\n"; exit 0 }
+}
+
+print "1..5\n";
+
+use User::grent;
+
+print "ok 1\n";
+
+my $grent = getgrgid 0; # This is the OO getgrgid.
+
+print "not " unless $grent->gid    == 0;
+print "ok 2\n";
+
+print "not " unless $grent->name   == $grent[0];
+print "ok 3\n";
+
+print "not " unless $grent->passwd eq $grent[1];
+print "ok 4\n";
+
+print "not " unless $grent->gid    == $grent[2];
+print "ok 5\n";
+
+# Testing pretty much anything else is unportable.
+

diff --git a/lib/User/pwent.t b/lib/User/pwent.t
new file mode 100644 (file)
index 0000000..e274265
--- /dev/null
+++ b/lib/User/pwent.t
@@ -0,0 +1,63 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $haspw;
+    eval { my @n = getpwuid 0 };
+    $haspw = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($haspw) { print "1..0 # Skip: no getpwuid\n"; exit 0 }
+    use Config;
+    $haspw = 0 unless $Config{'i_pwd'} eq 'define';
+    unless ($haspw) { print "1..0 # Skip: no pwd.h\n"; exit 0 }
+}
+
+BEGIN {
+    our @pwent = getpwuid 0; # This is the function getpwuid.
+    unless (@pwent) { print "1..0 # Skip: no uid 0\n"; exit 0 }
+}
+
+print "1..9\n";
+
+use User::pwent;
+
+print "ok 1\n";
+
+my $pwent = getpwuid 0; # This is the OO getpwuid.
+
+print "not " unless $pwent->uid    == 0;
+print "ok 2\n";
+
+print "not " unless $pwent->name   == $pwent[0];
+print "ok 3\n";
+
+print "not " unless $pwent->passwd eq $pwent[1];
+print "ok 4\n";
+
+print "not " unless $pwent->uid    == $pwent[2];
+print "ok 5\n";
+
+print "not " unless $pwent->gid    == $pwent[3];
+print "ok 6\n";
+
+# The quota and comment fields are unportable.
+
+print "not " unless $pwent->gecos  eq $pwent[6];
+print "ok 7\n";
+
+print "not " unless $pwent->dir    eq $pwent[7];
+print "ok 8\n";
+
+print "not " unless $pwent->shell  eq $pwent[8];
+print "ok 9\n";
+
+# The expire field is unportable.
+
+# Testing pretty much anything else is unportable:
+# there maybe more than one username with uid 0;
+# uid 0's home directory may be "/" or "/root' or something else,
+# and so on.
+

diff --git a/lib/autouse.t b/lib/autouse.t
new file mode 100644 (file)
index 0000000..0a2d680
--- /dev/null
+++ b/lib/autouse.t
@@ -0,0 +1,57 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Test;
+BEGIN { plan tests => 10; }
+
+BEGIN {
+    require autouse;
+    eval {
+        "autouse"->import('List::Util' => 'List::Util::first(&@)');
+    };
+    ok( !$@ );
+
+    eval {
+        "autouse"->import('List::Util' => 'Foo::min');
+    };
+    ok( $@, qr/^autouse into different package attempted/ );
+
+    "autouse"->import('List::Util' => qw(max first(&@)));
+}
+
+my @a = (1,2,3,4,5.5);
+ok( max(@a), 5.5);
+
+
+# first() has a prototype of &@.  Make sure that's preserved.
+ok( (first { $_ > 3 } @a), 4);
+
+
+# Example from the docs.
+use autouse 'Carp' => qw(carp croak);
+
+{
+    my @warning;
+    local $SIG{__WARN__} = sub { push @warning, @_ };
+    carp "this carp was predeclared and autoused\n";
+    ok( scalar @warning, 1 );
+    ok( $warning[0], "this carp was predeclared and autoused\n" );
+
+    eval { croak "It is but a scratch!" };
+    ok( $@, qr/^It is but a scratch!/);
+}
+
+
+# Test that autouse's lazy module loading works.  We assume that nothing
+# involved in this test uses Text::Soundex, which is pretty safe.
+use autouse 'Text::Soundex' => qw(soundex);
+
+my $mod_file = 'Text/Soundex.pm'; # just fine and portable for %INC
+ok( !exists $INC{$mod_file} );
+ok( soundex('Basset'), 'B230' );
+ok( exists $INC{$mod_file} );
+

diff --git a/lib/bigfloat.t b/lib/bigfloat.t
new file mode 100755 (executable)
index 0000000..8e0a0ef
--- /dev/null
+++ b/lib/bigfloat.t
@@ -0,0 +1,408 @@
+#!./perl
+
+BEGIN { @INC = '../lib' }
+require "bigfloat.pl";
+
+$test = 0;
+$| = 1;
+print "1..355\n";
+while (<DATA>) {
+       chop;
+       if (/^&/) {
+               $f = $_;
+       } elsif (/^\$.*/) {
+               eval "$_;";
+       } else {
+               ++$test;
+               @args = split(/:/,$_,99);
+               $ans = pop(@args);
+               $try = "$f('" . join("','", @args) . "');";
+               if (($ans1 = eval($try)) eq $ans) {
+                       print "ok $test\n";
+               } else {
+                       print "not ok $test\n";
+                       print "# '$try' expected: '$ans' got: '$ans1'\n";
+               }
+       }
+} 
+__END__
+&fnorm
+abc:NaN
+   1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:+0E+0
++0:+0E+0
++00:+0E+0
++0 0 0:+0E+0
+000000  0000000   00000:+0E+0
+-0:+0E+0
+-0000:+0E+0
++1:+1E+0
++01:+1E+0
++001:+1E+0
++00000100000:+1E+5
+123456789:+123456789E+0
+-1:-1E+0
+-01:-1E+0
+-001:-1E+0
+-123456789:-123456789E+0
+-00000100000:-1E+5
+123.456a:NaN
+123.456:+123456E-3
+0.01:+1E-2
+.002:+2E-3
+-0.0003:-3E-4
+-.0000000004:-4E-10
+123456E2:+123456E+2
+123456E-2:+123456E-2
+-123456E2:-123456E+2
+-123456E-2:-123456E-2
+1e1:+1E+1
+2e-11:+2E-11
+-3e111:-3E+111
+-4e-1111:-4E-1111
+&fneg
+abd:NaN
++0:+0E+0
++1:-1E+0
+-1:+1E+0
++123456789:-123456789E+0
+-123456789:+123456789E+0
++123.456789:-123456789E-6
+-123456.789:+123456789E-3
+&fabs
+abc:NaN
++0:+0E+0
++1:+1E+0
+-1:+1E+0
++123456789:+123456789E+0
+-123456789:+123456789E+0
++123.456789:+123456789E-6
+-123456.789:+123456789E-3
+&fround
+$bigfloat::rnd_mode = 'trunc'
++10123456789:5:+10123E+6
+-10123456789:5:-10123E+6
++10123456789:9:+101234567E+2
+-10123456789:9:-101234567E+2
++101234500:6:+101234E+3
+-101234500:6:-101234E+3
+$bigfloat::rnd_mode = 'zero'
++20123456789:5:+20123E+6
+-20123456789:5:-20123E+6
++20123456789:9:+201234568E+2
+-20123456789:9:-201234568E+2
++201234500:6:+201234E+3
+-201234500:6:-201234E+3
+$bigfloat::rnd_mode = '+inf'
++30123456789:5:+30123E+6
+-30123456789:5:-30123E+6
++30123456789:9:+301234568E+2
+-30123456789:9:-301234568E+2
++301234500:6:+301235E+3
+-301234500:6:-301234E+3
+$bigfloat::rnd_mode = '-inf'
++40123456789:5:+40123E+6
+-40123456789:5:-40123E+6
++40123456789:9:+401234568E+2
+-40123456789:9:-401234568E+2
++401234500:6:+401234E+3
+-401234500:6:-401235E+3
+$bigfloat::rnd_mode = 'odd'
++50123456789:5:+50123E+6
+-50123456789:5:-50123E+6
++50123456789:9:+501234568E+2
+-50123456789:9:-501234568E+2
++501234500:6:+501235E+3
+-501234500:6:-501235E+3
+$bigfloat::rnd_mode = 'even'
++60123456789:5:+60123E+6
+-60123456789:5:-60123E+6
++60123456789:9:+601234568E+2
+-60123456789:9:-601234568E+2
++601234500:6:+601234E+3
+-601234500:6:-601234E+3
+&ffround
+$bigfloat::rnd_mode = 'trunc'
++1.23:-1:+12E-1
+-1.23:-1:-12E-1
++1.27:-1:+12E-1
+-1.27:-1:-12E-1
++1.25:-1:+12E-1
+-1.25:-1:-12E-1
++1.35:-1:+13E-1
+-1.35:-1:-13E-1
+-0.006:-1:+0E+0
+-0.006:-2:+0E+0
+$bigfloat::rnd_mode = 'zero'
++2.23:-1:+22E-1
+-2.23:-1:-22E-1
++2.27:-1:+23E-1
+-2.27:-1:-23E-1
++2.25:-1:+22E-1
+-2.25:-1:-22E-1
++2.35:-1:+23E-1
+-2.35:-1:-23E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-6E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+$bigfloat::rnd_mode = '+inf'
++3.23:-1:+32E-1
+-3.23:-1:-32E-1
++3.27:-1:+33E-1
+-3.27:-1:-33E-1
++3.25:-1:+33E-1
+-3.25:-1:-32E-1
++3.35:-1:+34E-1
+-3.35:-1:-33E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-6E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+$bigfloat::rnd_mode = '-inf'
++4.23:-1:+42E-1
+-4.23:-1:-42E-1
++4.27:-1:+43E-1
+-4.27:-1:-43E-1
++4.25:-1:+42E-1
+-4.25:-1:-43E-1
++4.35:-1:+43E-1
+-4.35:-1:-44E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-7E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+$bigfloat::rnd_mode = 'odd'
++5.23:-1:+52E-1
+-5.23:-1:-52E-1
++5.27:-1:+53E-1
+-5.27:-1:-53E-1
++5.25:-1:+53E-1
+-5.25:-1:-53E-1
++5.35:-1:+53E-1
+-5.35:-1:-53E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-7E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+$bigfloat::rnd_mode = 'even'
++6.23:-1:+62E-1
+-6.23:-1:-62E-1
++6.27:-1:+63E-1
+-6.27:-1:-63E-1
++6.25:-1:+62E-1
+-6.25:-1:-62E-1
++6.35:-1:+64E-1
+-6.35:-1:-64E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-6E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+&fcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
+&fadd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0E+0
++1:+0:+1E+0
++0:+1:+1E+0
++1:+1:+2E+0
+-1:+0:-1E+0
++0:-1:-1E+0
+-1:-1:-2E+0
+-1:+1:+0E+0
++1:-1:+0E+0
++9:+1:+1E+1
++99:+1:+1E+2
++999:+1:+1E+3
++9999:+1:+1E+4
++99999:+1:+1E+5
++999999:+1:+1E+6
++9999999:+1:+1E+7
++99999999:+1:+1E+8
++999999999:+1:+1E+9
++9999999999:+1:+1E+10
++99999999999:+1:+1E+11
++10:-1:+9E+0
++100:-1:+99E+0
++1000:-1:+999E+0
++10000:-1:+9999E+0
++100000:-1:+99999E+0
++1000000:-1:+999999E+0
++10000000:-1:+9999999E+0
++100000000:-1:+99999999E+0
++1000000000:-1:+999999999E+0
++10000000000:-1:+9999999999E+0
++123456789:+987654321:+111111111E+1
+-123456789:+987654321:+864197532E+0
+-123456789:-987654321:-111111111E+1
++123456789:-987654321:-864197532E+0
+&fsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0E+0
++1:+0:+1E+0
++0:+1:-1E+0
++1:+1:+0E+0
+-1:+0:-1E+0
++0:-1:+1E+0
+-1:-1:+0E+0
+-1:+1:-2E+0
++1:-1:+2E+0
++9:+1:+8E+0
++99:+1:+98E+0
++999:+1:+998E+0
++9999:+1:+9998E+0
++99999:+1:+99998E+0
++999999:+1:+999998E+0
++9999999:+1:+9999998E+0
++99999999:+1:+99999998E+0
++999999999:+1:+999999998E+0
++9999999999:+1:+9999999998E+0
++99999999999:+1:+99999999998E+0
++10:-1:+11E+0
++100:-1:+101E+0
++1000:-1:+1001E+0
++10000:-1:+10001E+0
++100000:-1:+100001E+0
++1000000:-1:+1000001E+0
++10000000:-1:+10000001E+0
++100000000:-1:+100000001E+0
++1000000000:-1:+1000000001E+0
++10000000000:-1:+10000000001E+0
++123456789:+987654321:-864197532E+0
+-123456789:+987654321:-111111111E+1
+-123456789:-987654321:+864197532E+0
++123456789:-987654321:+111111111E+1
+&fmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0E+0
++0:+1:+0E+0
++1:+0:+0E+0
++0:-1:+0E+0
+-1:+0:+0E+0
++123456789123456789:+0:+0E+0
++0:+123456789123456789:+0E+0
+-1:-1:+1E+0
+-1:+1:-1E+0
++1:-1:-1E+0
++1:+1:+1E+0
++2:+3:+6E+0
+-2:+3:-6E+0
++2:-3:-6E+0
+-2:-3:+6E+0
++111:+111:+12321E+0
++10101:+10101:+102030201E+0
++1001001:+1001001:+1002003002001E+0
++100010001:+100010001:+10002000300020001E+0
++10000100001:+10000100001:+100002000030000200001E+0
++11111111111:+9:+99999999999E+0
++22222222222:+9:+199999999998E+0
++33333333333:+9:+299999999997E+0
++44444444444:+9:+399999999996E+0
++55555555555:+9:+499999999995E+0
++66666666666:+9:+599999999994E+0
++77777777777:+9:+699999999993E+0
++88888888888:+9:+799999999992E+0
++99999999999:+9:+899999999991E+0
+&fdiv
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0E+0
++1:+0:NaN
++0:-1:+0E+0
+-1:+0:NaN
++1:+1:+1E+0
+-1:-1:+1E+0
++1:-1:-1E+0
+-1:+1:-1E+0
++1:+2:+5E-1
++2:+1:+2E+0
++10:+5:+2E+0
++100:+4:+25E+0
++1000:+8:+125E+0
++10000:+16:+625E+0
++10000:-16:-625E+0
++999999999999:+9:+111111111111E+0
++999999999999:+99:+10101010101E+0
++999999999999:+999:+1001001001E+0
++999999999999:+9999:+100010001E+0
++999999999999999:+99999:+10000100001E+0
++1000000000:+9:+1111111111111111111111111111111111111111E-31
++2000000000:+9:+2222222222222222222222222222222222222222E-31
++3000000000:+9:+3333333333333333333333333333333333333333E-31
++4000000000:+9:+4444444444444444444444444444444444444444E-31
++5000000000:+9:+5555555555555555555555555555555555555556E-31
++6000000000:+9:+6666666666666666666666666666666666666667E-31
++7000000000:+9:+7777777777777777777777777777777777777778E-31
++8000000000:+9:+8888888888888888888888888888888888888889E-31
++9000000000:+9:+1E+9
++35500000:+113:+3141592920353982300884955752212389380531E-34
++71000000:+226:+3141592920353982300884955752212389380531E-34
++106500000:+339:+3141592920353982300884955752212389380531E-34
++1000000000:+3:+3333333333333333333333333333333333333333E-31
+$bigfloat::div_scale = 20
++1000000000:+9:+11111111111111111111E-11
++2000000000:+9:+22222222222222222222E-11
++3000000000:+9:+33333333333333333333E-11
++4000000000:+9:+44444444444444444444E-11
++5000000000:+9:+55555555555555555556E-11
++6000000000:+9:+66666666666666666667E-11
++7000000000:+9:+77777777777777777778E-11
++8000000000:+9:+88888888888888888889E-11
++9000000000:+9:+1E+9
++35500000:+113:+314159292035398230088E-15
++71000000:+226:+314159292035398230088E-15
++106500000:+339:+31415929203539823009E-14
++1000000000:+3:+33333333333333333333E-11
+$bigfloat::div_scale = 40
+&fsqrt
++0:+0E+0
+-1:NaN
+-2:NaN
+-16:NaN
+-123.456:NaN
++1:+1E+0
++1.44:+12E-1
++2:+141421356237309504880168872420969807857E-38
++4:+2E+0
++16:+4E+0
++100:+1E+1
++123.456:+1111107555549866648462149404118219234119E-38
++15241.383936:+123456E-3

diff --git a/lib/bigint.t b/lib/bigint.t
new file mode 100755 (executable)
index 0000000..034c5c6
--- /dev/null
+++ b/lib/bigint.t
@@ -0,0 +1,282 @@
+#!./perl
+
+BEGIN { @INC = '../lib' }
+require "bigint.pl";
+
+$test = 0;
+$| = 1;
+print "1..246\n";
+while (<DATA>) {
+       chop;
+       if (/^&/) {
+               $f = $_;
+       } else {
+               ++$test;
+               @args = split(/:/,$_,99);
+               $ans = pop(@args);
+               $try = "$f('" . join("','", @args) . "');";
+               if (($ans1 = eval($try)) eq $ans) {
+                       print "ok $test\n";
+               } else {
+                       print "not ok $test\n";
+                       print "# '$try' expected: '$ans' got: '$ans1'\n";
+               }
+       }
+} 
+__END__
+&bnorm
+abc:NaN
+   1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:+0
++0:+0
++00:+0
++0 0 0:+0
+000000  0000000   00000:+0
+-0:+0
+-0000:+0
++1:+1
++01:+1
++001:+1
++00000100000:+100000
+123456789:+123456789
+-1:-1
+-01:-1
+-001:-1
+-123456789:-123456789
+-00000100000:-100000
+&bneg
+abd:NaN
++0:+0
++1:-1
+-1:+1
++123456789:-123456789
+-123456789:+123456789
+&babs
+abc:NaN
++0:+0
++1:+1
+-1:+1
++123456789:+123456789
+-123456789:+123456789
+&bcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
+&badd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:+1
++1:+1:+2
+-1:+0:-1
++0:-1:-1
+-1:-1:-2
+-1:+1:+0
++1:-1:+0
++9:+1:+10
++99:+1:+100
++999:+1:+1000
++9999:+1:+10000
++99999:+1:+100000
++999999:+1:+1000000
++9999999:+1:+10000000
++99999999:+1:+100000000
++999999999:+1:+1000000000
++9999999999:+1:+10000000000
++99999999999:+1:+100000000000
++10:-1:+9
++100:-1:+99
++1000:-1:+999
++10000:-1:+9999
++100000:-1:+99999
++1000000:-1:+999999
++10000000:-1:+9999999
++100000000:-1:+99999999
++1000000000:-1:+999999999
++10000000000:-1:+9999999999
++123456789:+987654321:+1111111110
+-123456789:+987654321:+864197532
+-123456789:-987654321:-1111111110
++123456789:-987654321:-864197532
+&bsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:-1
++1:+1:+0
+-1:+0:-1
++0:-1:+1
+-1:-1:+0
+-1:+1:-2
++1:-1:+2
++9:+1:+8
++99:+1:+98
++999:+1:+998
++9999:+1:+9998
++99999:+1:+99998
++999999:+1:+999998
++9999999:+1:+9999998
++99999999:+1:+99999998
++999999999:+1:+999999998
++9999999999:+1:+9999999998
++99999999999:+1:+99999999998
++10:-1:+11
++100:-1:+101
++1000:-1:+1001
++10000:-1:+10001
++100000:-1:+100001
++1000000:-1:+1000001
++10000000:-1:+10000001
++100000000:-1:+100000001
++1000000000:-1:+1000000001
++10000000000:-1:+10000000001
++123456789:+987654321:-864197532
+-123456789:+987654321:-1111111110
+-123456789:-987654321:+864197532
++123456789:-987654321:+1111111110
+&bmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+0
++1:+0:+0
++0:-1:+0
+-1:+0:+0
++123456789123456789:+0:+0
++0:+123456789123456789:+0
+-1:-1:+1
+-1:+1:-1
++1:-1:-1
++1:+1:+1
++2:+3:+6
+-2:+3:-6
++2:-3:-6
+-2:-3:+6
++111:+111:+12321
++10101:+10101:+102030201
++1001001:+1001001:+1002003002001
++100010001:+100010001:+10002000300020001
++10000100001:+10000100001:+100002000030000200001
++11111111111:+9:+99999999999
++22222222222:+9:+199999999998
++33333333333:+9:+299999999997
++44444444444:+9:+399999999996
++55555555555:+9:+499999999995
++66666666666:+9:+599999999994
++77777777777:+9:+699999999993
++88888888888:+9:+799999999992
++99999999999:+9:+899999999991
+&bdiv
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+1
+-1:-1:+1
++1:-1:-1
+-1:+1:-1
++1:+2:+0
++2:+1:+2
++1000000000:+9:+111111111
++2000000000:+9:+222222222
++3000000000:+9:+333333333
++4000000000:+9:+444444444
++5000000000:+9:+555555555
++6000000000:+9:+666666666
++7000000000:+9:+777777777
++8000000000:+9:+888888888
++9000000000:+9:+1000000000
++35500000:+113:+314159
++71000000:+226:+314159
++106500000:+339:+314159
++1000000000:+3:+333333333
++10:+5:+2
++100:+4:+25
++1000:+8:+125
++10000:+16:+625
++999999999999:+9:+111111111111
++999999999999:+99:+10101010101
++999999999999:+999:+1001001001
++999999999999:+9999:+100010001
++999999999999999:+99999:+10000100001
+&bmod
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+0
+-1:-1:+0
++1:-1:+0
+-1:+1:+0
++1:+2:+1
++2:+1:+0
++1000000000:+9:+1
++2000000000:+9:+2
++3000000000:+9:+3
++4000000000:+9:+4
++5000000000:+9:+5
++6000000000:+9:+6
++7000000000:+9:+7
++8000000000:+9:+8
++9000000000:+9:+0
++35500000:+113:+33
++71000000:+226:+66
++106500000:+339:+99
++1000000000:+3:+1
++10:+5:+0
++100:+4:+0
++1000:+8:+0
++10000:+16:+0
++999999999999:+9:+0
++999999999999:+99:+0
++999999999999:+999:+0
++999999999999:+9999:+0
++999999999999999:+99999:+0
+&bgcd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+1
++1:+0:+1
++1:+1:+1
++2:+3:+1
++3:+2:+1
++100:+625:+25
++4096:+81:+1

diff --git a/lib/charnames.t b/lib/charnames.t
new file mode 100644 (file)
index 0000000..124dad0
--- /dev/null
+++ b/lib/charnames.t
@@ -0,0 +1,131 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+    }
+}
+
+$| = 1;
+print "1..16\n";
+
+use charnames ':full';
+
+print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here\041?";
+print "ok 1\n";
+
+{
+  use bytes;                   # TEST -utf8 can switch utf8 on
+
+  print "# \$res=$res \$\@='$@'\nnot "
+    if $res = eval <<'EOE'
+use charnames ":full";
+"Here: \N{CYRILLIC SMALL LETTER BE}!";
+1
+EOE
+      or $@ !~ /above 0xFF/;
+  print "ok 2\n";
+  # print "# \$res=$res \$\@='$@'\n";
+
+  print "# \$res=$res \$\@='$@'\nnot "
+    if $res = eval <<'EOE'
+use charnames 'cyrillic';
+"Here: \N{Be}!";
+1
+EOE
+      or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/;
+  print "ok 3\n";
+}
+
+# If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt
+if (ord('A') == 65) { # as on ASCII or UTF-8 machines
+    $encoded_be = "\320\261";
+    $encoded_alpha = "\316\261";
+    $encoded_bet = "\327\221";
+    $encoded_deseng = "\360\220\221\215";
+}
+else { # EBCDIC where UTF-EBCDIC may be used (this may be 1047 specific since
+       # UTF-EBCDIC is codepage specific)
+    $encoded_be = "\270\102\130";
+    $encoded_alpha = "\264\130";
+    $encoded_bet = "\270\125\130";
+    $encoded_deseng = "\336\102\103\124";
+}
+
+sub to_bytes {
+    pack"a*", shift;
+}
+
+{
+  use charnames ':full';
+
+  print "not " unless to_bytes("\N{CYRILLIC SMALL LETTER BE}") eq $encoded_be;
+  print "ok 4\n";
+
+  use charnames qw(cyrillic greek :short);
+
+  print "not " unless to_bytes("\N{be},\N{alpha},\N{hebrew:bet}")
+    eq "$encoded_be,$encoded_alpha,$encoded_bet";
+  print "ok 5\n";
+}
+
+{
+    use charnames ':full';
+    print "not " unless "\x{263a}" eq "\N{WHITE SMILING FACE}";
+    print "ok 6\n";
+    print "not " unless length("\x{263a}") == 1;
+    print "ok 7\n";
+    print "not " unless length("\N{WHITE SMILING FACE}") == 1;
+    print "ok 8\n";
+    print "not " unless sprintf("%vx", "\x{263a}") eq "263a";
+    print "ok 9\n";
+    print "not " unless sprintf("%vx", "\N{WHITE SMILING FACE}") eq "263a";
+    print "ok 10\n";
+    print "not " unless sprintf("%vx", "\xFF\N{WHITE SMILING FACE}") eq "ff.263a";
+    print "ok 11\n";
+    print "not " unless sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}") eq "ff.263a";
+    print "ok 12\n";
+}
+
+{
+   use charnames qw(:full);
+   use utf8;
+   
+    my $x = "\x{221b}";
+    my $named = "\N{CUBE ROOT}";
+
+    print "not " unless ord($x) == ord($named);
+    print "ok 13\n";
+}
+
+{
+   use charnames qw(:full);
+   use utf8;
+   print "not " unless "\x{100}\N{CENT SIGN}" eq "\x{100}"."\N{CENT SIGN}";
+   print "ok 14\n";
+}
+
+{
+  use charnames ':full';
+
+  print "not "
+      unless to_bytes("\N{DESERET SMALL LETTER ENG}") eq $encoded_deseng;
+  print "ok 15\n";
+}
+
+{
+  # 20001114.001       
+
+  no utf8; # so that the naked 8-bit character won't gripe under use utf8
+
+  if (ord("Ä") == 0xc4) { # Try to do this only on Latin-1.
+      use charnames ':full';
+      my $text = "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}";
+      print "not " unless $text eq "\xc4" && ord($text) == 0xc4;
+      print "ok 16\n";
+  } else {
+      print "ok 16 # Skip: not Latin-1\n";
+  }
+}
+

diff --git a/lib/constant.t b/lib/constant.t
new file mode 100644 (file)
index 0000000..f932976
--- /dev/null
+++ b/lib/constant.t
@@ -0,0 +1,251 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use warnings;
+use vars qw{ @warnings };
+BEGIN {                                # ...and save 'em for later
+    $SIG{'__WARN__'} = sub { push @warnings, @_ }
+}
+END { print @warnings }
+
+######################### We start with some black magic to print on failure.
+
+BEGIN { $| = 1; print "1..82\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use constant 1.01;
+$loaded = 1;
+#print "# Version: $constant::VERSION\n";
+print "ok 1\n";
+
+######################### End of black magic.
+
+use strict;
+
+sub test ($$;$) {
+    my($num, $bool, $diag) = @_;
+    if ($bool) {
+       print "ok $num\n";
+       return;
+    }
+    print "not ok $num\n";
+    return unless defined $diag;
+    $diag =~ s/\Z\n?/\n/;                      # unchomp
+    print map "# $num : $_", split m/^/m, $diag;
+}
+
+use constant PI                => 4 * atan2 1, 1;
+
+test 2, substr(PI, 0, 7) eq '3.14159';
+test 3, defined PI;
+
+sub deg2rad { PI * $_[0] / 180 }
+
+my $ninety = deg2rad 90;
+
+test 4, $ninety > 1.5707;
+test 5, $ninety < 1.5708;
+
+use constant UNDEF1    => undef;       # the right way
+use constant UNDEF2    =>      ;       # the weird way
+use constant 'UNDEF3'          ;       # the 'short' way
+use constant EMPTY     => ( )  ;       # the right way for lists
+
+test 6, not defined UNDEF1;
+test 7, not defined UNDEF2;
+test 8, not defined UNDEF3;
+my @undef = UNDEF1;
+test 9, @undef == 1;
+test 10, not defined $undef[0];
+@undef = UNDEF2;
+test 11, @undef == 0;
+@undef = UNDEF3;
+test 12, @undef == 0;
+@undef = EMPTY;
+test 13, @undef == 0;
+
+use constant COUNTDOWN => scalar reverse 1, 2, 3, 4, 5;
+use constant COUNTLIST => reverse 1, 2, 3, 4, 5;
+use constant COUNTLAST => (COUNTLIST)[-1];
+
+test 14, COUNTDOWN eq '54321';
+my @cl = COUNTLIST;
+test 15, @cl == 5;
+test 16, COUNTDOWN eq join '', @cl;
+test 17, COUNTLAST == 1;
+test 18, (COUNTLIST)[1] == 4;
+
+use constant ABC       => 'ABC';
+test 19, "abc${\( ABC )}abc" eq "abcABCabc";
+
+use constant DEF       => 'D', 'E', chr ord 'F';
+test 20, "d e f @{[ DEF ]} d e f" eq "d e f D E F d e f";
+
+use constant SINGLE    => "'";
+use constant DOUBLE    => '"';
+use constant BACK      => '\\';
+my $tt = BACK . SINGLE . DOUBLE ;
+test 21, $tt eq q(\\'");
+
+use constant MESS      => q('"'\\"'"\\);
+test 22, MESS eq q('"'\\"'"\\);
+test 23, length(MESS) == 8;
+
+use constant TRAILING  => '12 cats';
+{
+    no warnings 'numeric';
+    test 24, TRAILING == 12;
+}
+test 25, TRAILING eq '12 cats';
+
+use constant LEADING   => " \t1234";
+test 26, LEADING == 1234;
+test 27, LEADING eq " \t1234";
+
+use constant ZERO1     => 0;
+use constant ZERO2     => 0.0;
+use constant ZERO3     => '0.0';
+test 28, ZERO1 eq '0';
+test 29, ZERO2 eq '0';
+test 30, ZERO3 eq '0.0';
+
+{
+    package Other;
+    use constant PI    => 3.141;
+}
+
+test 31, (PI > 3.1415 and PI < 3.1416);
+test 32, Other::PI == 3.141;
+
+use constant E2BIG => $! = 7;
+test 33, E2BIG == 7;
+# This is something like "Arg list too long", but the actual message
+# text may vary, so we can't test much better than this.
+test 34, length(E2BIG) > 6;
+test 35, index(E2BIG, " ") > 0;
+
+test 36, @warnings == 0, join "\n", "unexpected warning", @warnings;
+@warnings = ();                # just in case
+undef &PI;
+test 37, @warnings &&
+    ($warnings[0] =~ /Constant sub.* undefined/),
+    shift @warnings;
+
+test 38, @warnings == 0, "unexpected warning";
+test 39, 1;
+
+use constant CSCALAR   => \"ok 40\n";
+use constant CHASH     => { foo => "ok 41\n" };
+use constant CARRAY    => [ undef, "ok 42\n" ];
+use constant CPHASH    => [ { foo => 1 }, "ok 43\n" ];
+use constant CCODE     => sub { "ok $_[0]\n" };
+
+print ${+CSCALAR};
+print CHASH->{foo};
+print CARRAY->[1];
+print CPHASH->{foo};
+eval q{ CPHASH->{bar} };
+test 44, scalar($@ =~ /^No such pseudo-hash field/);
+print CCODE->(45);
+eval q{ CCODE->{foo} };
+test 46, scalar($@ =~ /^Constant is not a HASH/);
+
+# Allow leading underscore
+use constant _PRIVATE => 47;
+test 47, _PRIVATE == 47;
+
+# Disallow doubled leading underscore
+eval q{
+    use constant __DISALLOWED => "Oops";
+};
+test 48, $@ =~ /begins with '__'/;
+
+# Check on declared() and %declared. This sub should be EXACTLY the
+# same as the one quoted in the docs!
+sub declared ($) {
+    use constant 1.01;              # don't omit this!
+    my $name = shift;
+    $name =~ s/^::/main::/;
+    my $pkg = caller;
+    my $full_name = $name =~ /::/ ? $name : "${pkg}::$name";
+    $constant::declared{$full_name};
+}
+
+test 49, declared 'PI';
+test 50, $constant::declared{'main::PI'};
+
+test 51, !declared 'PIE';
+test 52, !$constant::declared{'main::PIE'};
+
+{
+    package Other;
+    use constant IN_OTHER_PACK => 42;
+    ::test 53, ::declared 'IN_OTHER_PACK';
+    ::test 54, $constant::declared{'Other::IN_OTHER_PACK'};
+    ::test 55, ::declared 'main::PI';
+    ::test 56, $constant::declared{'main::PI'};
+}
+
+test 57, declared 'Other::IN_OTHER_PACK';
+test 58, $constant::declared{'Other::IN_OTHER_PACK'};
+
+@warnings = ();
+eval q{
+    no warnings;
+    use warnings 'constant';
+    use constant 'BEGIN' => 1 ;
+    use constant 'INIT' => 1 ;
+    use constant 'CHECK' => 1 ;
+    use constant 'END' => 1 ;
+    use constant 'DESTROY' => 1 ;
+    use constant 'AUTOLOAD' => 1 ;
+    use constant 'STDIN' => 1 ;
+    use constant 'STDOUT' => 1 ;
+    use constant 'STDERR' => 1 ;
+    use constant 'ARGV' => 1 ;
+    use constant 'ARGVOUT' => 1 ;
+    use constant 'ENV' => 1 ;
+    use constant 'INC' => 1 ;
+    use constant 'SIG' => 1 ;
+};
+
+test 59, @warnings == 15 ;
+test 60, (shift @warnings) =~ /^Constant name 'BEGIN' is a Perl keyword at/;
+shift @warnings; #Constant subroutine BEGIN redefined at
+test 61, (shift @warnings) =~ /^Constant name 'INIT' is a Perl keyword at/;
+test 62, (shift @warnings) =~ /^Constant name 'CHECK' is a Perl keyword at/;
+test 63, (shift @warnings) =~ /^Constant name 'END' is a Perl keyword at/;
+test 64, (shift @warnings) =~ /^Constant name 'DESTROY' is a Perl keyword at/;
+test 65, (shift @warnings) =~ /^Constant name 'AUTOLOAD' is a Perl keyword at/;
+test 66, (shift @warnings) =~ /^Constant name 'STDIN' is forced into package main:: a/;
+test 67, (shift @warnings) =~ /^Constant name 'STDOUT' is forced into package main:: at/;
+test 68, (shift @warnings) =~ /^Constant name 'STDERR' is forced into package main:: at/;
+test 69, (shift @warnings) =~ /^Constant name 'ARGV' is forced into package main:: at/;
+test 70, (shift @warnings) =~ /^Constant name 'ARGVOUT' is forced into package main:: at/;
+test 71, (shift @warnings) =~ /^Constant name 'ENV' is forced into package main:: at/;
+test 72, (shift @warnings) =~ /^Constant name 'INC' is forced into package main:: at/;
+test 73, (shift @warnings) =~ /^Constant name 'SIG' is forced into package main:: at/;
+@warnings = ();
+
+
+use constant {
+       THREE  => 3,
+       FAMILY => [ qw( John Jane Sally ) ],
+       AGES   => { John => 33, Jane => 28, Sally => 3 },
+       RFAM   => [ [ qw( John Jane Sally ) ] ],
+       SPIT   => sub { shift },
+       PHFAM  => [ { John => 1, Jane => 2, Sally => 3 }, 33, 28, 3 ],
+};
+
+test 74, @{+FAMILY} == THREE;
+test 75, @{+FAMILY} == @{RFAM->[0]};
+test 76, FAMILY->[2] eq RFAM->[0]->[2];
+test 77, AGES->{FAMILY->[1]} == 28;
+test 78, PHFAM->{John} == AGES->{John};
+test 79, PHFAM->[3] == AGES->{FAMILY->[2]};
+test 80, @{+PHFAM} == SPIT->(THREE+1);
+test 81, THREE**3 eq SPIT->(@{+FAMILY}**3);
+test 82, AGES->{FAMILY->[THREE-1]} == PHFAM->[THREE];

diff --git a/lib/diagnostics.t b/lib/diagnostics.t
new file mode 100644 (file)
index 0000000..14014f6
--- /dev/null
+++ b/lib/diagnostics.t
@@ -0,0 +1,38 @@
+#!./perl
+
+BEGIN {
+    chdir '..' if -d '../pod' && -d '../t';
+    @INC = 'lib';
+}
+
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+use strict;
+use warnings;
+
+use vars qw($Test_Num $Total_tests);
+
+my $loaded;
+BEGIN { $| = 1; $Test_Num = 1 }
+END {print "not ok $Test_Num\n" unless $loaded;}
+print "1..$Total_tests\n";
+BEGIN { require diagnostics; } # Don't want diagnostics' noise yet.
+$loaded = 1;
+ok($loaded, 'compile');
+######################### End of black magic.
+
+sub ok {
+       my($test, $name) = shift;
+       print "not " unless $test;
+       print "ok $Test_Num";
+       print " - $name" if defined $name;
+       print "\n";
+       $Test_Num++;
+}
+
+
+# Change this to your # of ok() calls + 1
+BEGIN { $Total_tests = 1 }

diff --git a/lib/fields.t b/lib/fields.t
new file mode 100755 (executable)
index 0000000..b4b5cce
--- /dev/null
+++ b/lib/fields.t
@@ -0,0 +1,197 @@
+#!./perl -w
+
+my $w;
+
+BEGIN {
+   chdir 't' if -d 't';
+   @INC = '../lib';
+   $SIG{__WARN__} = sub {
+       if ($_[0] =~ /^Hides field 'b1' in base class/) {
+           $w++;
+           return;
+       }
+       print $_[0];
+   };
+}
+
+use strict;
+use warnings;
+use vars qw($DEBUG);
+
+package B1;
+use fields qw(b1 b2 b3);
+
+package B2;
+use fields '_b1';
+use fields qw(b1 _b2 b2);
+
+sub new { bless [], shift }
+
+package D1;
+use base 'B1';
+use fields qw(d1 d2 d3);
+
+package D2;
+use base 'B1';
+use fields qw(_d1 _d2);
+use fields qw(d1 d2);
+
+package D3;
+use base 'B2';
+use fields qw(b1 d1 _b1 _d1);  # hide b1
+
+package D4;
+use base 'D3';
+use fields qw(_d3 d3);
+
+package M;
+sub m {}
+
+package D5;
+use base qw(M B2);
+
+package Foo::Bar;
+use base 'B1';
+
+package Foo::Bar::Baz;
+use base 'Foo::Bar';
+use fields qw(foo bar baz);
+
+# Test repeatability for when modules get reloaded.
+package B1;
+use fields qw(b1 b2 b3);
+
+package D3;
+use base 'B2';
+use fields qw(b1 d1 _b1 _d1);  # hide b1
+
+package main;
+
+sub fstr {
+   my $h = shift;
+   my @tmp;
+   for my $k (sort {$h->{$a} <=> $h->{$b}} keys %$h) {
+       my $v = $h->{$k};
+        push(@tmp, "$k:$v");
+   }
+   my $str = join(",", @tmp);
+   print "$h => $str\n" if $DEBUG;
+   $str;
+}
+
+my %expect = (
+    B1 => "b1:1,b2:2,b3:3",
+    B2 => "_b1:1,b1:2,_b2:3,b2:4",
+    D1 => "b1:1,b2:2,b3:3,d1:4,d2:5,d3:6",
+    D2 => "b1:1,b2:2,b3:3,_d1:4,_d2:5,d1:6,d2:7",
+    D3 => "b2:4,b1:5,d1:6,_b1:7,_d1:8",
+    D4 => "b2:4,b1:5,d1:6,_d3:9,d3:10",
+    D5 => "b1:2,b2:4",
+    'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6',
+);
+
+print "1..", int(keys %expect)+15, "\n";
+my $testno = 0;
+while (my($class, $exp) = each %expect) {
+   no strict 'refs';
+   my $fstr = fstr(\%{$class."::FIELDS"});
+   print "EXP: $exp\nGOT: $fstr\nnot " unless $fstr eq $exp;
+   print "ok ", ++$testno, "\n";
+}
+
+# Did we get the appropriate amount of warnings?
+print "not " unless $w == 1;
+print "ok ", ++$testno, "\n";
+
+# A simple object creation and AVHV attribute access test
+my B2 $obj1 = D3->new;
+$obj1->{b1} = "B2";
+my D3 $obj2 = $obj1;
+$obj2->{b1} = "D3";
+
+print "not " unless $obj1->[2] eq "B2" && $obj1->[5] eq "D3";
+print "ok ", ++$testno, "\n";
+
+# We should get compile time failures field name typos
+eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = "");
+print "not " unless $@ && $@ =~ /^No such pseudo-hash field "notthere"/;
+print "ok ", ++$testno, "\n";
+
+# Slices
+@$obj1{"_b1", "b1"} = (17, 29);
+print "not " unless "@$obj1[1,2]" eq "17 29";
+print "ok ", ++$testno, "\n";
+@$obj1[1,2] = (44,28);
+print "not " unless "@$obj1{'b1','_b1','b1'}" eq "28 44 28";
+print "ok ", ++$testno, "\n";
+
+my $ph = fields::phash(a => 1, b => 2, c => 3);
+print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
+print "ok ", ++$testno, "\n";
+
+$ph = fields::phash([qw/a b c/], [1, 2, 3]);
+print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
+print "ok ", ++$testno, "\n";
+
+$ph = fields::phash([qw/a b c/], [1]);
+print "not " if exists $ph->{b} or exists $ph->{c} or !exists $ph->{a};
+print "ok ", ++$testno, "\n";
+
+eval '$ph = fields::phash("odd")';
+print "not " unless $@ && $@ =~ /^Odd number of/;
+print "ok ", ++$testno, "\n";
+
+#fields::_dump();
+
+# check if fields autovivify
+{
+    package Foo;
+    use fields qw(foo bar);
+    sub new { bless [], $_[0]; }
+
+    package main;
+    my Foo $a = Foo->new();
+    $a->{foo} = ['a', 'ok ' . ++$testno, 'c'];
+    $a->{bar} = { A => 'ok ' . ++$testno };
+    print $a->{foo}[1], "\n";
+    print $a->{bar}->{A}, "\n";
+}
+
+# check if fields autovivify
+{
+    package Bar;
+    use fields qw(foo bar);
+    sub new { return fields::new($_[0]) }
+
+    package main;
+    my Bar $a = Bar::->new();
+    $a->{foo} = ['a', 'ok ' . ++$testno, 'c'];
+    $a->{bar} = { A => 'ok ' . ++$testno };
+    print $a->{foo}[1], "\n";
+    print $a->{bar}->{A}, "\n";
+}
+
+
+# Test $VERSION bug
+package No::Version;
+
+use vars qw($Foo);
+sub VERSION { 42 }
+
+package Test::Version;
+
+use base qw(No::Version);
+print "not " unless $No::Version::VERSION =~ /set by base\.pm/;
+print "ok ", ++$testno ,"\n";
+
+# Test Inverse of $VERSION bug base.pm should not clobber existing $VERSION
+package Has::Version;
+
+BEGIN { $Has::Version::VERSION = '42' };
+
+package Test::Version2;
+
+use base qw(Has::Version);
+print "#$Has::Version::VERSION\nnot " unless $Has::Version::VERSION eq '42';
+print "ok ", ++$testno ,"\n";
+

diff --git a/lib/h2ph.t b/lib/h2ph.t
new file mode 100755 (executable)
index 0000000..7b339b3
--- /dev/null
+++ b/lib/h2ph.t
@@ -0,0 +1,37 @@
+#!./perl
+
+# quickie tests to see if h2ph actually runs and does more or less what is
+# expected
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+my $extracted_program = '../utils/h2ph'; # unix, nt, ...
+if ($^O eq 'VMS') { $extracted_program = '[-.utils]h2ph.com'; }
+if (!(-e $extracted_program)) {
+    print "1..0 # Skip: $extracted_program was not built\n";
+    exit 0;
+}
+
+print "1..2\n";
+
+# quickly compare two text files
+sub txt_compare {
+    local ($/, $A, $B);
+    for (($A,$B) = @_) { open(_,"<$_") ? $_ = <_> : die "$_ : $!"; close _ }
+    $A cmp $B;
+}
+
+# does it run?
+$ok = system("$^X \"-I../lib\" $extracted_program -d. \"-Q\" lib/h2ph.h");
+print(($ok == 0 ? "" : "not "), "ok 1\n");
+    
+# does it work? well, does it do what we expect? :-)
+$ok = txt_compare("lib/h2ph.ph", "lib/h2ph.pht");
+print(($ok == 0 ? "" : "not "), "ok 2\n");
+    
+# cleanup - should this be in an END block?
+unlink("lib/h2ph.ph");
+unlink("_h2ph_pre.ph");

diff --git a/lib/locale.t b/lib/locale.t
new file mode 100644 (file)
index 0000000..19fba59
--- /dev/null
+++ b/lib/locale.t
@@ -0,0 +1,839 @@
+#!./perl -wT
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    unshift @INC, '.';
+    require Config; import Config;
+    if (!$Config{d_setlocale} || $Config{ccflags} =~ /\bD?NO_LOCALE\b/) {
+       print "1..0\n";
+       exit;
+    }
+    $| = 1;
+}
+
+use strict;
+
+my $debug = 1;
+
+use Dumpvalue;
+
+my $dumper = Dumpvalue->new(
+                            tick => qq{"},
+                            quoteHighBit => 0,
+                            unctrl => "quote"
+                           );
+sub debug {
+  return unless $debug;
+  my($mess) = join "", @_;
+  chop $mess;
+  print $dumper->stringify($mess,1), "\n";
+}
+
+sub debugf {
+    printf @_ if $debug;
+}
+
+my $have_setlocale = 0;
+eval {
+    require POSIX;
+    import POSIX ':locale_h';
+    $have_setlocale++;
+};
+
+# Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
+# and mingw32 uses said silly CRT
+$have_setlocale = 0 if (($^O eq 'MSWin32' || $^O eq 'NetWare') && $Config{cc} =~ /^(cl|gcc)/i);
+
+my $last = $have_setlocale ? &last : &last_without_setlocale;
+
+print "1..$last\n";
+
+use vars qw(&LC_ALL);
+
+$a = 'abc %';
+
+sub ok {
+    my ($n, $result) = @_;
+
+    print 'not ' unless ($result);
+    print "ok $n\n";
+}
+
+# First we'll do a lot of taint checking for locales.
+# This is the easiest to test, actually, as any locale,
+# even the default locale will taint under 'use locale'.
+
+sub is_tainted { # hello, camel two.
+    no warnings 'uninitialized' ;
+    my $dummy;
+    not eval { $dummy = join("", @_), kill 0; 1 }
+}
+
+sub check_taint ($$) {
+    ok $_[0], is_tainted($_[1]);
+}
+
+sub check_taint_not ($$) {
+    ok $_[0], not is_tainted($_[1]);
+}
+
+use locale;    # engage locale and therefore locale taint.
+
+check_taint_not   1, $a;
+
+check_taint       2, uc($a);
+check_taint       3, "\U$a";
+check_taint       4, ucfirst($a);
+check_taint       5, "\u$a";
+check_taint       6, lc($a);
+check_taint       7, "\L$a";
+check_taint       8, lcfirst($a);
+check_taint       9, "\l$a";
+
+check_taint_not  10, sprintf('%e', 123.456);
+check_taint_not  11, sprintf('%f', 123.456);
+check_taint_not  12, sprintf('%g', 123.456);
+check_taint_not  13, sprintf('%d', 123.456);
+check_taint_not  14, sprintf('%x', 123.456);
+
+$_ = $a;       # untaint $_
+
+$_ = uc($a);   # taint $_
+
+check_taint      15, $_;
+
+/(\w)/;        # taint $&, $`, $', $+, $1.
+check_taint      16, $&;
+check_taint      17, $`;
+check_taint      18, $';
+check_taint      19, $+;
+check_taint      20, $1;
+check_taint_not  21, $2;
+
+/(.)/; # untaint $&, $`, $', $+, $1.
+check_taint_not  22, $&;
+check_taint_not  23, $`;
+check_taint_not  24, $';
+check_taint_not  25, $+;
+check_taint_not  26, $1;
+check_taint_not  27, $2;
+
+/(\W)/;        # taint $&, $`, $', $+, $1.
+check_taint      28, $&;
+check_taint      29, $`;
+check_taint      30, $';
+check_taint      31, $+;
+check_taint      32, $1;
+check_taint_not  33, $2;
+
+/(\s)/;        # taint $&, $`, $', $+, $1.
+check_taint      34, $&;
+check_taint      35, $`;
+check_taint      36, $';
+check_taint      37, $+;
+check_taint      38, $1;
+check_taint_not  39, $2;
+
+/(\S)/;        # taint $&, $`, $', $+, $1.
+check_taint      40, $&;
+check_taint      41, $`;
+check_taint      42, $';
+check_taint      43, $+;
+check_taint      44, $1;
+check_taint_not  45, $2;
+
+$_ = $a;       # untaint $_
+
+check_taint_not  46, $_;
+
+/(b)/;         # this must not taint
+check_taint_not  47, $&;
+check_taint_not  48, $`;
+check_taint_not  49, $';
+check_taint_not  50, $+;
+check_taint_not  51, $1;
+check_taint_not  52, $2;
+
+$_ = $a;       # untaint $_
+
+check_taint_not  53, $_;
+
+$b = uc($a);   # taint $b
+s/(.+)/$b/;    # this must taint only the $_
+
+check_taint      54, $_;
+check_taint_not  55, $&;
+check_taint_not  56, $`;
+check_taint_not  57, $';
+check_taint_not  58, $+;
+check_taint_not  59, $1;
+check_taint_not  60, $2;
+
+$_ = $a;       # untaint $_
+
+s/(.+)/b/;     # this must not taint
+check_taint_not  61, $_;
+check_taint_not  62, $&;
+check_taint_not  63, $`;
+check_taint_not  64, $';
+check_taint_not  65, $+;
+check_taint_not  66, $1;
+check_taint_not  67, $2;
+
+$b = $a;       # untaint $b
+
+($b = $a) =~ s/\w/$&/;
+check_taint      68, $b;       # $b should be tainted.
+check_taint_not  69, $a;       # $a should be not.
+
+$_ = $a;       # untaint $_
+
+s/(\w)/\l$1/;  # this must taint
+check_taint      70, $_;
+check_taint      71, $&;
+check_taint      72, $`;
+check_taint      73, $';
+check_taint      74, $+;
+check_taint      75, $1;
+check_taint_not  76, $2;
+
+$_ = $a;       # untaint $_
+
+s/(\w)/\L$1/;  # this must taint
+check_taint      77, $_;
+check_taint      78, $&;
+check_taint      79, $`;
+check_taint      80, $';
+check_taint      81, $+;
+check_taint      82, $1;
+check_taint_not  83, $2;
+
+$_ = $a;       # untaint $_
+
+s/(\w)/\u$1/;  # this must taint
+check_taint      84, $_;
+check_taint      85, $&;
+check_taint      86, $`;
+check_taint      87, $';
+check_taint      88, $+;
+check_taint      89, $1;
+check_taint_not  90, $2;
+
+$_ = $a;       # untaint $_
+
+s/(\w)/\U$1/;  # this must taint
+check_taint      91, $_;
+check_taint      92, $&;
+check_taint      93, $`;
+check_taint      94, $';
+check_taint      95, $+;
+check_taint      96, $1;
+check_taint_not  97, $2;
+
+# After all this tainting $a should be cool.
+
+check_taint_not  98, $a;
+
+sub last_without_setlocale { 98 }
+
+# I think we've seen quite enough of taint.
+# Let us do some *real* locale work now,
+# unless setlocale() is missing (i.e. minitest).
+
+exit unless $have_setlocale;
+
+# Find locales.
+
+debug "# Scanning for locales...\n";
+
+# Note that it's okay that some languages have their native names
+# capitalized here even though that's not "right".  They are lowercased
+# anyway later during the scanning process (and besides, some clueless
+# vendor might have them capitalized errorneously anyway).
+
+my $locales = <<EOF;
+Afrikaans:af:za:1 15
+Arabic:ar:dz eg sa:6 arabic8
+Brezhoneg Breton:br:fr:1 15
+Bulgarski Bulgarian:bg:bg:5
+Chinese:zh:cn tw:cn.EUC eucCN eucTW euc.CN euc.TW Big5 GB2312 tw.EUC
+Hrvatski Croatian:hr:hr:2
+Cymraeg Welsh:cy:cy:1 14 15
+Czech:cs:cz:2
+Dansk Danish:dk:da:1 15
+Nederlands Dutch:nl:be nl:1 15
+English American British:en:au ca gb ie nz us uk zw:1 15 cp850
+Esperanto:eo:eo:3
+Eesti Estonian:et:ee:4 6 13
+Suomi Finnish:fi:fi:1 15
+Flamish::fl:1 15
+Deutsch German:de:at be ch de lu:1 15
+Euskaraz Basque:eu:es fr:1 15
+Galego Galician:gl:es:1 15
+Ellada Greek:el:gr:7 g8
+Frysk:fy:nl:1 15
+Greenlandic:kl:gl:4 6
+Hebrew:iw:il:8 hebrew8
+Hungarian:hu:hu:2
+Indonesian:in:id:1 15
+Gaeilge Irish:ga:IE:1 14 15
+Italiano Italian:it:ch it:1 15
+Nihongo Japanese:ja:jp:euc eucJP jp.EUC sjis
+Korean:ko:kr:
+Latine Latin:la:va:1 15
+Latvian:lv:lv:4 6 13
+Lithuanian:lt:lt:4 6 13
+Macedonian:mk:mk:1 15
+Maltese:mt:mt:3
+Moldovan:mo:mo:2
+Norsk Norwegian:no no\@nynorsk:no:1 15
+Occitan:oc:es:1 15
+Polski Polish:pl:pl:2
+Rumanian:ro:ro:2
+Russki Russian:ru:ru su ua:5 koi8 koi8r KOI8-R koi8u cp1251 cp866
+Serbski Serbian:sr:yu:5
+Slovak:sk:sk:2
+Slovene Slovenian:sl:si:2
+Sqhip Albanian:sq:sq:1 15
+Svenska Swedish:sv:fi se:1 15
+Thai:th:th:11 tis620
+Turkish:tr:tr:9 turkish8
+Yiddish:yi::1 15
+EOF
+
+if ($^O eq 'os390') {
+    # These cause heartburn.  Broken locales?
+    $locales =~ s/Svenska Swedish:sv:fi se:1 15\n//;
+    $locales =~ s/Thai:th:th:11 tis620\n//;
+}
+
+sub in_utf8 () { $^H & 0x08 }
+
+if (in_utf8) {
+    require "locale/utf8";
+} else {
+    require "locale/latin1";
+}
+
+my @Locale;
+my $Locale;
+my @Alnum_;
+
+my @utf8locale;
+my %utf8skip;
+
+sub getalnum_ {
+    sort grep /\w/, map { chr } 0..255
+}
+
+sub trylocale {
+    my $locale = shift;
+    if (setlocale(LC_ALL, $locale)) {
+       push @Locale, $locale;
+    }
+}
+
+sub decode_encodings {
+    my @enc;
+
+    foreach (split(/ /, shift)) {
+       if (/^(\d+)$/) {
+           push @enc, "ISO8859-$1";
+           push @enc, "iso8859$1";     # HP
+           if ($1 eq '1') {
+                push @enc, "roman8";   # HP
+           }
+       } else {
+           push @enc, $_;
+           push @enc, "$_.UTF-8";
+       }
+    }
+    if ($^O eq 'os390') {
+       push @enc, qw(IBM-037 IBM-819 IBM-1047);
+    }
+
+    return @enc;
+}
+
+trylocale("C");
+trylocale("POSIX");
+foreach (0..15) {
+    trylocale("ISO8859-$_");
+    trylocale("iso8859$_");
+    trylocale("iso8859-$_");
+    trylocale("iso_8859_$_");
+    trylocale("isolatin$_");
+    trylocale("isolatin-$_");
+    trylocale("iso_latin_$_");
+}
+
+# Sanitize the environment so that we can run the external 'locale'
+# program without the taint mode getting grumpy.
+
+# $ENV{PATH} is special in VMS.
+delete $ENV{PATH} if $^O ne 'VMS' or $Config{d_setenv};
+
+# Other subversive stuff.
+delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
+
+if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) {
+    while (<LOCALES>) {
+        chomp;
+       trylocale($_);
+    }
+    close(LOCALES);
+} elsif ($^O eq 'VMS' && defined($ENV{'SYS$I18N_LOCALE'}) && -d 'SYS$I18N_LOCALE') {
+# The SYS$I18N_LOCALE logical name search list was not present on 
+# VAX VMS V5.5-12, but was on AXP && VAX VMS V6.2 as well as later versions.
+    opendir(LOCALES, "SYS\$I18N_LOCALE:");
+    while ($_ = readdir(LOCALES)) {
+        chomp;
+        trylocale($_);
+    }
+    close(LOCALES);
+} else {
+
+    # This is going to be slow.
+
+    foreach my $locale (split(/\n/, $locales)) {
+       my ($locale_name, $language_codes, $country_codes, $encodings) =
+           split(/:/, $locale);
+       my @enc = decode_encodings($encodings);
+       foreach my $loc (split(/ /, $locale_name)) {
+           trylocale($loc);
+           foreach my $enc (@enc) {
+               trylocale("$loc.$enc");
+           }
+           $loc = lc $loc;
+           foreach my $enc (@enc) {
+               trylocale("$loc.$enc");
+           }
+       }
+       foreach my $lang (split(/ /, $language_codes)) {
+           trylocale($lang);
+           foreach my $country (split(/ /, $country_codes)) {
+               my $lc = "${lang}_${country}";
+               trylocale($lc);
+               foreach my $enc (@enc) {
+                   trylocale("$lc.$enc");
+               }
+               my $lC = "${lang}_\U${country}";
+               trylocale($lC);
+               foreach my $enc (@enc) {
+                   trylocale("$lC.$enc");
+               }
+           }
+       }
+    }
+}
+
+setlocale(LC_ALL, "C");
+
+sub utf8locale { $_[0] =~ /utf-?8/i }
+
+@Locale = sort @Locale;
+
+debug "# Locales = @Locale\n";
+
+my %Problem;
+my %Okay;
+my %Testing;
+my @Neoalpha;
+my %Neoalpha;
+
+sub tryneoalpha {
+    my ($Locale, $i, $test) = @_;
+    unless ($test) {
+       $Problem{$i}{$Locale} = 1;
+       debug "# failed $i with locale '$Locale'\n";
+    } else {
+       push @{$Okay{$i}}, $Locale;
+    }
+}
+
+foreach $Locale (@Locale) {
+    debug "# Locale = $Locale\n";
+    @Alnum_ = getalnum_();
+    debug "# w = ", join("",@Alnum_), "\n";
+
+    unless (setlocale(LC_ALL, $Locale)) {
+       foreach (99..103) {
+           $Problem{$_}{$Locale} = -1;
+       }
+       next;
+    }
+
+    # Sieve the uppercase and the lowercase.
+    
+    my %UPPER = ();
+    my %lower = ();
+    my %BoThCaSe = ();
+    for (@Alnum_) {
+       if (/[^\d_]/) { # skip digits and the _
+           if (uc($_) eq $_) {
+               $UPPER{$_} = $_;
+           }
+           if (lc($_) eq $_) {
+               $lower{$_} = $_;
+           }
+       }
+    }
+    foreach (keys %UPPER) {
+       $BoThCaSe{$_}++ if exists $lower{$_};
+    }
+    foreach (keys %lower) {
+       $BoThCaSe{$_}++ if exists $UPPER{$_};
+    }
+    foreach (keys %BoThCaSe) {
+       delete $UPPER{$_};
+       delete $lower{$_};
+    }
+
+    debug "# UPPER    = ", join("", sort keys %UPPER   ), "\n";
+    debug "# lower    = ", join("", sort keys %lower   ), "\n";
+    debug "# BoThCaSe = ", join("", sort keys %BoThCaSe), "\n";
+
+    # Find the alphabets that are not alphabets in the default locale.
+
+    {
+       no locale;
+    
+       @Neoalpha = ();
+       for (keys %UPPER, keys %lower) {
+           push(@Neoalpha, $_) if (/\W/);
+           $Neoalpha{$_} = $_;
+       }
+    }
+
+    @Neoalpha = sort @Neoalpha;
+
+    debug "# Neoalpha = ", join("",@Neoalpha), "\n";
+
+    if (@Neoalpha == 0) {
+       # If we have no Neoalphas the remaining tests are no-ops.
+       debug "# no Neoalpha, skipping tests 99..102 for locale '$Locale'\n";
+       foreach (99..102) {
+           push @{$Okay{$_}}, $Locale;
+       }
+    } else {
+
+       # Test \w.
+    
+       if (utf8locale($Locale)) {
+           # utf8 and locales do not mix.
+           debug "# skipping UTF-8 locale '$Locale'\n";
+           push @utf8locale, $Locale;
+            @utf8skip{99..102} = ();
+       } else {
+           my $word = join('', @Neoalpha);
+
+           $word =~ /^(\w+)$/;
+ 
+           tryneoalpha($Locale, 99, $1 eq $word);
+       }
+       # Cross-check the whole 8-bit character set.
+
+       for (map { chr } 0..255) {
+           tryneoalpha($Locale, 100,
+                       (/\w/ xor /\W/) ||
+                       (/\d/ xor /\D/) ||
+                       (/\s/ xor /\S/));
+       }
+
+       # Test for read-only scalars' locale vs non-locale comparisons.
+
+       {
+           no locale;
+           $a = "qwerty";
+           {
+               use locale;
+               tryneoalpha($Locale, 101, ($a cmp "qwerty") == 0);
+           }
+       }
+
+       {
+           my ($from, $to, $lesser, $greater,
+               @test, %test, $test, $yes, $no, $sign);
+
+           for (0..9) {
+               # Select a slice.
+               $from = int(($_*@Alnum_)/10);
+               $to = $from + int(@Alnum_/10);
+               $to = $#Alnum_ if ($to > $#Alnum_);
+               $lesser  = join('', @Alnum_[$from..$to]);
+               # Select a slice one character on.
+               $from++; $to++;
+               $to = $#Alnum_ if ($to > $#Alnum_);
+               $greater = join('', @Alnum_[$from..$to]);
+               ($yes, $no, $sign) = ($lesser lt $greater
+                                     ? ("    ", "not ", 1)
+                                     : ("not ", "    ", -1));
+               # all these tests should FAIL (return 0).
+               # Exact lt or gt cannot be tested because
+               # in some locales, say, eacute and E may test equal.
+               @test = 
+                   (
+                    $no.'    ($lesser  le $greater)',  # 1
+                    'not      ($lesser  ne $greater)', # 2
+                    '         ($lesser  eq $greater)', # 3
+                    $yes.'    ($lesser  ge $greater)', # 4
+                    $yes.'    ($lesser  ge $greater)', # 5
+                    $yes.'    ($greater le $lesser )', # 7
+                    'not      ($greater ne $lesser )', # 8
+                    '         ($greater eq $lesser )', # 9
+                    $no.'     ($greater ge $lesser )', # 10
+                    'not (($lesser cmp $greater) == -($sign))' # 11
+                    );
+               @test{@test} = 0 x @test;
+               $test = 0;
+               for my $ti (@test) {
+                   $test{$ti} = eval $ti;
+                   $test ||= $test{$ti}
+               }
+               tryneoalpha($Locale, 102, $test == 0);
+               if ($test) {
+                   debug "# lesser  = '$lesser'\n";
+                   debug "# greater = '$greater'\n";
+                   debug "# lesser cmp greater = ",
+                         $lesser cmp $greater, "\n";
+                   debug "# greater cmp lesser = ",
+                         $greater cmp $lesser, "\n";
+                   debug "# (greater) from = $from, to = $to\n";
+                   for my $ti (@test) {
+                       debugf("# %-40s %-4s", $ti,
+                              $test{$ti} ? 'FAIL' : 'ok');
+                       if ($ti =~ /\(\.*(\$.+ +cmp +\$[^\)]+)\.*\)/) {
+                           debugf("(%s == %4d)", $1, eval $1);
+                       }
+                       debug "\n#";
+                   }
+
+                   last;
+               }
+           }
+       }
+    }
+
+    use locale;
+
+    my ($x, $y) = (1.23, 1.23);
+
+    $a = "$x";
+    printf ''; # printf used to reset locale to "C"
+    $b = "$y";
+
+    debug "# 103..107: a = $a, b = $b, Locale = $Locale\n";
+
+    tryneoalpha($Locale, 103, $a eq $b);
+
+    my $c = "$x";
+    my $z = sprintf ''; # sprintf used to reset locale to "C"
+    my $d = "$y";
+
+    debug "# 104..107: c = $c, d = $d, Locale = $Locale\n";
+
+    tryneoalpha($Locale, 104, $c eq $d); 
+
+    {
+       use warnings;
+       my $w = 0;
+       local $SIG{__WARN__} =
+           sub {
+               print "# @_\n";
+               $w++;
+           };
+
+       # The == (among other ops) used to warn for locales
+       # that had something else than "." as the radix character.
+
+       tryneoalpha($Locale, 105, $c == 1.23);
+
+       tryneoalpha($Locale, 106, $c == $x);
+
+       tryneoalpha($Locale, 107, $c == $d);
+
+       {
+#          no locale; # XXX did this ever work correctly?
+       
+           my $e = "$x";
+
+           debug "# 108..110: e = $e, Locale = $Locale\n";
+
+           tryneoalpha($Locale, 108, $e == 1.23);
+
+           tryneoalpha($Locale, 109, $e == $x);
+           
+           tryneoalpha($Locale, 110, $e == $c);
+       }
+       
+       my $f = "1.23";
+       my $g = 2.34;
+
+       debug "# 111..115: f = $f, g = $g, locale = $Locale\n";
+
+       tryneoalpha($Locale, 111, $f == 1.23);
+
+       tryneoalpha($Locale, 112, $f == $x);
+       
+       tryneoalpha($Locale, 113, $f == $c);
+
+       tryneoalpha($Locale, 114, abs(($f + $g) - 3.57) < 0.01);
+
+       tryneoalpha($Locale, 115, $w == 0);
+    }
+
+    # Does taking lc separately differ from taking
+    # the lc "in-line"?  (This was the bug 19990704.002, change #3568.)
+    # The bug was in the caching of the 'o'-magic.
+    {
+       use locale;
+
+       sub lcA {
+           my $lc0 = lc $_[0];
+           my $lc1 = lc $_[1];
+           return $lc0 cmp $lc1;
+       }
+
+        sub lcB {
+           return lc($_[0]) cmp lc($_[1]);
+       }
+
+        my $x = "ab";
+        my $y = "aa";
+        my $z = "AB";
+
+        tryneoalpha($Locale, 116,
+                   lcA($x, $y) == 1 && lcB($x, $y) == 1 ||
+                   lcA($x, $z) == 0 && lcB($x, $z) == 0);
+    }
+
+    # Does lc of an UPPER (if different from the UPPER) match
+    # case-insensitively the UPPER, and does the UPPER match
+    # case-insensitively the lc of the UPPER.  And vice versa.
+    {
+        if (utf8locale($Locale)) {
+           # utf8 and locales do not mix.
+           debug "# skipping UTF-8 locale '$Locale'\n";
+           push @utf8locale, $Locale;
+            $utf8skip{117}++;
+       } else {
+           use locale;
+           use locale;
+           no utf8; # so that the native 8-bit characters work
+
+           my @f = ();
+           foreach my $x (keys %UPPER) {
+               my $y = lc $x;
+               next unless uc $y eq $x;
+               push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
+           }
+           foreach my $x (keys %lower) {
+               my $y = uc $x;
+               next unless lc $y eq $x;
+               push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
+           }
+           tryneoalpha($Locale, 117, @f == 0);
+           if (@f) {
+               print "# failed 117 locale '$Locale' characters @f\n"
+           }
+        }
+    }
+}
+
+# Recount the errors.
+
+foreach (&last_without_setlocale()+1..$last) {
+    if ($Problem{$_} || !defined $Okay{$_} || !@{$Okay{$_}}) {
+       if ($_ == 102) {
+           print "# The failure of test 102 is not necessarily fatal.\n";
+           print "# It usually indicates a problem in the enviroment,\n";
+           print "# not in Perl itself.\n";
+       }
+       print "not ";
+    }
+    print "ok $_\n";
+}
+
+# Give final advice.
+
+my $didwarn = 0;
+
+foreach (99..$last) {
+    if ($Problem{$_}) {
+       my @f = sort keys %{ $Problem{$_} };
+       my $f = join(" ", @f);
+       $f =~ s/(.{50,60}) /$1\n#\t/g;
+       print
+           "#\n",
+            "# The locale ", (@f == 1 ? "definition" : "definitions"), "\n#\n",
+           "#\t", $f, "\n#\n",
+           "# on your system may have errors because the locale test $_\n",
+            "# failed in ", (@f == 1 ? "that locale" : "those locales"),
+            ".\n";
+       print <<EOW;
+#
+# If your users are not using these locales you are safe for the moment,
+# but please report this failure first to perlbug\@perl.com using the
+# perlbug script (as described in the INSTALL file) so that the exact
+# details of the failures can be sorted out first and then your operating
+# system supplier can be alerted about these anomalies.
+#
+EOW
+       $didwarn = 1;
+    }
+}
+
+# Tell which locales were okay and which were not.
+
+if ($didwarn) {
+    my (@s, @F);
+    
+    foreach my $l (@Locale) {
+       my $p = 0;
+       foreach my $t (102..$last) {
+           $p++ if $Problem{$t}{$l};
+       }
+       push @s, $l if $p == 0;
+      push @F, $l unless $p == 0;
+    }
+    
+    if (@s) {
+        my $s = join(" ", @s);
+        $s =~ s/(.{50,60}) /$1\n#\t/g;
+
+        warn
+           "# The following locales\n#\n",
+            "#\t", $s, "\n#\n",
+           "# tested okay.\n#\n",
+    } else {
+        warn "# None of your locales were fully okay.\n";
+    }
+
+    if (@F) {
+        my $F = join(" ", @F);
+        $F =~ s/(.{50,60}) /$1\n#\t/g;
+
+        warn
+          "# The following locales\n#\n",
+          "#\t", $F, "\n#\n",
+          "# had problems.\n#\n",
+    } else {
+        warn "# None of your locales were broken.\n";
+    }
+
+    if (@utf8locale) {
+        my $S = join(" ", @utf8locale);
+        $S =~ s/(.{50,60}) /$1\n#\t/g;
+    
+        warn "#\n# The following locales\n#\n",
+             "#\t", $S, "\n#\n",
+             "# were skipped for the tests ",
+             join(" ", sort {$a<=>$b} keys %utf8skip), "\n",
+            "# because UTF-8 and locales do not work together in Perl.\n#\n";
+    }
+}
+
+sub last { 117 }
+
+# eof

diff --git a/lib/locale/latin1 b/lib/locale/latin1
new file mode 100644 (file)
index 0000000..f40f732
--- /dev/null
+++ b/lib/locale/latin1
@@ -0,0 +1,10 @@
+$locales .= <<EOF;
+Català Catalan:ca:es:1 15
+Français French:fr:be ca ch fr lu:1 15
+Gáidhlig Gaelic:gd:gb uk:1 14 15
+Føroyskt Faroese:fo:fo:1 15
+Íslensku Icelandic:is:is:1 15
+Sámi Lappish:::4 6 13
+Português Portuguese:po:po br:1 15
+Espanõl Spanish:es:ar bo cl co cr do ec es gt hn mx ni pa pe py sv uy ve:1 15
+EOF

diff --git a/lib/locale/utf8 b/lib/locale/utf8
new file mode 100644 (file)
index 0000000..fbbe94f
--- /dev/null
+++ b/lib/locale/utf8
@@ -0,0 +1,10 @@
+$locales .= <<EOF;
+Català Catalan:ca:es:1 15
+Français French:fr:be ca ch fr lu:1 15
+Gáidhlig Gaelic:gd:gb uk:1 14 15
+Føroyskt Faroese:fo:fo:1 15
+Íslensku Icelandic:is:is:1 15
+Sámi Lappish:::4 6 13
+Português Portuguese:po:po br:1 15
+Espanõl Spanish:es:ar bo cl co cr do ec es gt hn mx ni pa pe py sv uy ve:1 15
+EOF

diff --git a/lib/overload.t b/lib/overload.t
new file mode 100644 (file)
index 0000000..d075062
--- /dev/null
+++ b/lib/overload.t
@@ -0,0 +1,1050 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+package Oscalar;
+use overload ( 
+                               # Anonymous subroutines:
+'+'    =>      sub {new Oscalar $ {$_[0]}+$_[1]},
+'-'    =>      sub {new Oscalar
+                      $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]},
+'<=>'  =>      sub {new Oscalar
+                      $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]},
+'cmp'  =>      sub {new Oscalar
+                      $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])},
+'*'    =>      sub {new Oscalar ${$_[0]}*$_[1]},
+'/'    =>      sub {new Oscalar 
+                      $_[2]? $_[1]/${$_[0]} :
+                        ${$_[0]}/$_[1]},
+'%'    =>      sub {new Oscalar
+                      $_[2]? $_[1]%${$_[0]} : ${$_[0]}%$_[1]},
+'**'   =>      sub {new Oscalar
+                      $_[2]? $_[1]**${$_[0]} : ${$_[0]}-$_[1]},
+
+qw(
+""     stringify
+0+     numify)                 # Order of arguments unsignificant
+);
+
+sub new {
+  my $foo = $_[1];
+  bless \$foo, $_[0];
+}
+
+sub stringify { "${$_[0]}" }
+sub numify { 0 + "${$_[0]}" }  # Not needed, additional overhead
+                               # comparing to direct compilation based on
+                               # stringify
+
+package main;
+
+$test = 0;
+$| = 1;
+print "1..",&last,"\n";
+
+sub test {
+  $test++; 
+  if (@_ > 1) {
+    if ($_[0] eq $_[1]) {
+      print "ok $test\n";
+    } else {
+      print "not ok $test: '$_[0]' ne '$_[1]'\n";
+    }
+  } else {
+    if (shift) {
+      print "ok $test\n";
+    } else {
+      print "not ok $test\n";
+    } 
+  }
+}
+
+$a = new Oscalar "087";
+$b= "$a";
+
+# All test numbers in comments are off by 1.
+# So much for hard-wiring them in :-) To fix this:
+test(1);                       # 1
+
+test ($b eq $a);               # 2
+test ($b eq "087");            # 3
+test (ref $a eq "Oscalar");    # 4
+test ($a eq $a);               # 5
+test ($a eq "087");            # 6
+
+$c = $a + 7;
+
+test (ref $c eq "Oscalar");    # 7
+test (!($c eq $a));            # 8
+test ($c eq "94");             # 9
+
+$b=$a;
+
+test (ref $a eq "Oscalar");    # 10
+
+$b++;
+
+test (ref $b eq "Oscalar");    # 11
+test ( $a eq "087");           # 12
+test ( $b eq "88");            # 13
+test (ref $a eq "Oscalar");    # 14
+
+$c=$b;
+$c-=$a;
+
+test (ref $c eq "Oscalar");    # 15
+test ( $a eq "087");           # 16
+test ( $c eq "1");             # 17
+test (ref $a eq "Oscalar");    # 18
+
+$b=1;
+$b+=$a;
+
+test (ref $b eq "Oscalar");    # 19
+test ( $a eq "087");           # 20
+test ( $b eq "88");            # 21
+test (ref $a eq "Oscalar");    # 22
+
+eval q[ package Oscalar; use overload ('++' => sub { $ {$_[0]}++;$_[0] } ) ];
+
+$b=$a;
+
+test (ref $a eq "Oscalar");    # 23
+
+$b++;
+
+test (ref $b eq "Oscalar");    # 24
+test ( $a eq "087");           # 25
+test ( $b eq "88");            # 26
+test (ref $a eq "Oscalar");    # 27
+
+package Oscalar;
+$dummy=bless \$dummy;          # Now cache of method should be reloaded
+package main;
+
+$b=$a;
+$b++;                          
+
+test (ref $b eq "Oscalar");    # 28
+test ( $a eq "087");           # 29
+test ( $b eq "88");            # 30
+test (ref $a eq "Oscalar");    # 31
+
+undef $b;                      # Destroying updates tables too...
+
+eval q[package Oscalar; use overload ('++' => sub { $ {$_[0]} += 2; $_[0] } ) ];
+
+$b=$a;
+
+test (ref $a eq "Oscalar");    # 32
+
+$b++;
+
+test (ref $b eq "Oscalar");    # 33
+test ( $a eq "087");           # 34
+test ( $b eq "88");            # 35
+test (ref $a eq "Oscalar");    # 36
+
+package Oscalar;
+$dummy=bless \$dummy;          # Now cache of method should be reloaded
+package main;
+
+$b++;                          
+
+test (ref $b eq "Oscalar");    # 37
+test ( $a eq "087");           # 38
+test ( $b eq "90");            # 39
+test (ref $a eq "Oscalar");    # 40
+
+$b=$a;
+$b++;
+
+test (ref $b eq "Oscalar");    # 41
+test ( $a eq "087");           # 42
+test ( $b eq "89");            # 43
+test (ref $a eq "Oscalar");    # 44
+
+
+test ($b? 1:0);                        # 45
+
+eval q[ package Oscalar; use overload ('=' => sub {$main::copies++; 
+                                                  package Oscalar;
+                                                  local $new=$ {$_[0]};
+                                                  bless \$new } ) ];
+
+$b=new Oscalar "$a";
+
+test (ref $b eq "Oscalar");    # 46
+test ( $a eq "087");           # 47
+test ( $b eq "087");           # 48
+test (ref $a eq "Oscalar");    # 49
+
+$b++;
+
+test (ref $b eq "Oscalar");    # 50
+test ( $a eq "087");           # 51
+test ( $b eq "89");            # 52
+test (ref $a eq "Oscalar");    # 53
+test ($copies == 0);           # 54
+
+$b+=1;
+
+test (ref $b eq "Oscalar");    # 55
+test ( $a eq "087");           # 56
+test ( $b eq "90");            # 57
+test (ref $a eq "Oscalar");    # 58
+test ($copies == 0);           # 59
+
+$b=$a;
+$b+=1;
+
+test (ref $b eq "Oscalar");    # 60
+test ( $a eq "087");           # 61
+test ( $b eq "88");            # 62
+test (ref $a eq "Oscalar");    # 63
+test ($copies == 0);           # 64
+
+$b=$a;
+$b++;
+
+test (ref $b eq "Oscalar") || print ref $b,"=ref(b)\n";        # 65
+test ( $a eq "087");           # 66
+test ( $b eq "89");            # 67
+test (ref $a eq "Oscalar");    # 68
+test ($copies == 1);           # 69
+
+eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
+                                                  $_[0] } ) ];
+$c=new Oscalar;                        # Cause rehash
+
+$b=$a;
+$b+=1;
+
+test (ref $b eq "Oscalar");    # 70
+test ( $a eq "087");           # 71
+test ( $b eq "90");            # 72
+test (ref $a eq "Oscalar");    # 73
+test ($copies == 2);           # 74
+
+$b+=$b;
+
+test (ref $b eq "Oscalar");    # 75
+test ( $b eq "360");           # 76
+test ($copies == 2);           # 77
+$b=-$b;
+
+test (ref $b eq "Oscalar");    # 78
+test ( $b eq "-360");          # 79
+test ($copies == 2);           # 80
+
+$b=abs($b);
+
+test (ref $b eq "Oscalar");    # 81
+test ( $b eq "360");           # 82
+test ($copies == 2);           # 83
+
+$b=abs($b);
+
+test (ref $b eq "Oscalar");    # 84
+test ( $b eq "360");           # 85
+test ($copies == 2);           # 86
+
+eval q[package Oscalar; 
+       use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]}
+                                             : "_.${$_[0]}._" x $_[1])}) ];
+
+$a=new Oscalar "yy";
+$a x= 3;
+test ($a eq "_.yy.__.yy.__.yy._"); # 87
+
+eval q[package Oscalar; 
+       use overload ('.' => sub {new Oscalar ( $_[2] ? 
+                                             "_.$_[1].__.$ {$_[0]}._"
+                                             : "_.$ {$_[0]}.__.$_[1]._")}) ];
+
+$a=new Oscalar "xx";
+
+test ("b${a}c" eq "_._.b.__.xx._.__.c._"); # 88
+
+# Check inheritance of overloading;
+{
+  package OscalarI;
+  @ISA = 'Oscalar';
+}
+
+$aI = new OscalarI "$a";
+test (ref $aI eq "OscalarI");  # 89
+test ("$aI" eq "xx");          # 90
+test ($aI eq "xx");            # 91
+test ("b${aI}c" eq "_._.b.__.xx._.__.c._");            # 92
+
+# Here we test blessing to a package updates hash
+
+eval "package Oscalar; no overload '.'";
+
+test ("b${a}" eq "_.b.__.xx._"); # 93
+$x="1";
+bless \$x, Oscalar;
+test ("b${a}c" eq "bxxc");     # 94
+new Oscalar 1;
+test ("b${a}c" eq "bxxc");     # 95
+
+# Negative overloading:
+
+$na = eval { ~$a };
+test($@ =~ /no method found/); # 96
+
+# Check AUTOLOADING:
+
+*Oscalar::AUTOLOAD = 
+  sub { *{"Oscalar::$AUTOLOAD"} = sub {"_!_" . shift() . "_!_"} ;
+       goto &{"Oscalar::$AUTOLOAD"}};
+
+eval "package Oscalar; sub comple; use overload '~' => 'comple'";
+
+$na = eval { ~$a };            # Hash was not updated
+test($@ =~ /no method found/); # 97
+
+bless \$x, Oscalar;
+
+$na = eval { ~$a };            # Hash updated
+warn "`$na', $@" if $@;
+test !$@;                      # 98
+test($na eq '_!_xx_!_');       # 99
+
+$na = 0;
+
+$na = eval { ~$aI };           # Hash was not updated
+test($@ =~ /no method found/); # 100
+
+bless \$x, OscalarI;
+
+$na = eval { ~$aI };
+print $@;
+
+test !$@;                      # 101
+test($na eq '_!_xx_!_');       # 102
+
+eval "package Oscalar; sub rshft; use overload '>>' => 'rshft'";
+
+$na = eval { $aI >> 1 };       # Hash was not updated
+test($@ =~ /no method found/); # 103
+
+bless \$x, OscalarI;
+
+$na = 0;
+
+$na = eval { $aI >> 1 };
+print $@;
+
+test !$@;                      # 104
+test($na eq '_!_xx_!_');       # 105
+
+# warn overload::Method($a, '0+'), "\n";
+test (overload::Method($a, '0+') eq \&Oscalar::numify); # 106
+test (overload::Method($aI,'0+') eq \&Oscalar::numify); # 107
+test (overload::Overloaded($aI)); # 108
+test (!overload::Overloaded('overload')); # 109
+
+test (! defined overload::Method($aI, '<<')); # 110
+test (! defined overload::Method($a, '<')); # 111
+
+test (overload::StrVal($aI) =~ /^OscalarI=SCALAR\(0x[\da-fA-F]+\)$/); # 112
+test (overload::StrVal(\$aI) eq "@{[\$aI]}"); # 113
+
+# Check overloading by methods (specified deep in the ISA tree).
+{
+  package OscalarII;
+  @ISA = 'OscalarI';
+  sub Oscalar::lshft {"_<<_" . shift() . "_<<_"}
+  eval "package OscalarI; use overload '<<' => 'lshft', '|' => 'lshft'";
+}
+
+$aaII = "087";
+$aII = \$aaII;
+bless $aII, 'OscalarII';
+bless \$fake, 'OscalarI';              # update the hash
+test(($aI | 3) eq '_<<_xx_<<_');       # 114
+# warn $aII << 3;
+test(($aII << 3) eq '_<<_087_<<_');    # 115
+
+{
+  BEGIN { $int = 7; overload::constant 'integer' => sub {$int++; shift}; }
+  $out = 2**10;
+}
+test($int, 9);         # 116
+test($out, 1024);              # 117
+
+$foo = 'foo';
+$foo1 = 'f\'o\\o';
+{
+  BEGIN { $q = $qr = 7; 
+         overload::constant 'q' => sub {$q++; push @q, shift, ($_[1] || 'none'); shift},
+                            'qr' => sub {$qr++; push @qr, shift, ($_[1] || 'none'); shift}; }
+  $out = 'foo';
+  $out1 = 'f\'o\\o';
+  $out2 = "a\a$foo,\,";
+  /b\b$foo.\./;
+}
+
+test($out, 'foo');             # 118
+test($out, $foo);              # 119
+test($out1, 'f\'o\\o');                # 120
+test($out1, $foo1);            # 121
+test($out2, "a\afoo,\,");      # 122
+test("@q", "foo q f'o\\\\o q a\\a qq ,\\, qq");        # 123
+test($q, 11);                  # 124
+test("@qr", "b\\b qq .\\. qq");        # 125
+test($qr, 9);                  # 126
+
+{
+  $_ = '!<b>!foo!<-.>!';
+  BEGIN { overload::constant 'q' => sub {push @q1, shift, ($_[1] || 'none'); "_<" . (shift) . ">_"},
+                            'qr' => sub {push @qr1, shift, ($_[1] || 'none'); "!<" . (shift) . ">!"}; }
+  $out = 'foo';
+  $out1 = 'f\'o\\o';
+  $out2 = "a\a$foo,\,";
+  $res = /b\b$foo.\./;
+  $a = <<EOF;
+oups
+EOF
+  $b = <<'EOF';
+oups1
+EOF
+  $c = bareword;
+  m'try it';
+  s'first part'second part';
+  s/yet another/tail here/;
+  tr/A-Z/a-z/;
+}
+
+test($out, '_<foo>_');         # 117
+test($out1, '_<f\'o\\o>_');            # 128
+test($out2, "_<a\a>_foo_<,\,>_");      # 129
+test("@q1", "foo q f'o\\\\o q a\\a qq ,\\, qq oups
+ qq oups1
+ q second part q tail here s A-Z tr a-z tr");  # 130
+test("@qr1", "b\\b qq .\\. qq try it q first part q yet another qq");  # 131
+test($res, 1);                 # 132
+test($a, "_<oups
+>_");  # 133
+test($b, "_<oups1
+>_");  # 134
+test($c, "bareword");  # 135
+
+{
+  package symbolic;            # Primitive symbolic calculator
+  use overload nomethod => \&wrap, '""' => \&str, '0+' => \&num,
+      '=' => \&cpy, '++' => \&inc, '--' => \&dec;
+
+  sub new { shift; bless ['n', @_] }
+  sub cpy {
+    my $self = shift;
+    bless [@$self], ref $self;
+  }
+  sub inc { $_[0] = bless ['++', $_[0], 1]; }
+  sub dec { $_[0] = bless ['--', $_[0], 1]; }
+  sub wrap {
+    my ($obj, $other, $inv, $meth) = @_;
+    if ($meth eq '++' or $meth eq '--') {
+      @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
+      return $obj;
+    }
+    ($obj, $other) = ($other, $obj) if $inv;
+    bless [$meth, $obj, $other];
+  }
+  sub str {
+    my ($meth, $a, $b) = @{+shift};
+    $a = 'u' unless defined $a;
+    if (defined $b) {
+      "[$meth $a $b]";
+    } else {
+      "[$meth $a]";
+    }
+  } 
+  my %subr = ( 'n' => sub {$_[0]} );
+  foreach my $op (split " ", $overload::ops{with_assign}) {
+    $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
+  }
+  my @bins = qw(binary 3way_comparison num_comparison str_comparison);
+  foreach my $op (split " ", "@overload::ops{ @bins }") {
+    $subr{$op} = eval "sub {shift() $op shift()}";
+  }
+  foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
+    $subr{$op} = eval "sub {$op shift()}";
+  }
+  $subr{'++'} = $subr{'+'};
+  $subr{'--'} = $subr{'-'};
+  
+  sub num {
+    my ($meth, $a, $b) = @{+shift};
+    my $subr = $subr{$meth} 
+      or die "Do not know how to ($meth) in symbolic";
+    $a = $a->num if ref $a eq __PACKAGE__;
+    $b = $b->num if ref $b eq __PACKAGE__;
+    $subr->($a,$b);
+  }
+  sub TIESCALAR { my $pack = shift; $pack->new(@_) }
+  sub FETCH { shift }
+  sub nop {  }         # Around a bug
+  sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
+  sub STORE { 
+    my $obj = shift; 
+    $#$obj = 1; 
+    $obj->[1] = shift;
+  }
+}
+
+{
+  my $foo = new symbolic 11;
+  my $baz = $foo++;
+  test( (sprintf "%d", $foo), '12');
+  test( (sprintf "%d", $baz), '11');
+  my $bar = $foo;
+  $baz = ++$foo;
+  test( (sprintf "%d", $foo), '13');
+  test( (sprintf "%d", $bar), '12');
+  test( (sprintf "%d", $baz), '13');
+  my $ban = $foo;
+  $baz = ($foo += 1);
+  test( (sprintf "%d", $foo), '14');
+  test( (sprintf "%d", $bar), '12');
+  test( (sprintf "%d", $baz), '14');
+  test( (sprintf "%d", $ban), '13');
+  $baz = 0;
+  $baz = $foo++;
+  test( (sprintf "%d", $foo), '15');
+  test( (sprintf "%d", $baz), '14');
+  test( "$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
+}
+
+{
+  my $iter = new symbolic 2;
+  my $side = new symbolic 1;
+  my $cnt = $iter;
+  
+  while ($cnt) {
+    $cnt = $cnt - 1;           # The "simple" way
+    $side = (sqrt(1 + $side**2) - 1)/$side;
+  }
+  my $pi = $side*(2**($iter+2));
+  test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
+  test( (sprintf "%f", $pi), '3.182598');
+}
+
+{
+  my $iter = new symbolic 2;
+  my $side = new symbolic 1;
+  my $cnt = $iter;
+  
+  while ($cnt--) {
+    $side = (sqrt(1 + $side**2) - 1)/$side;
+  }
+  my $pi = $side*(2**($iter+2));
+  test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
+  test( (sprintf "%f", $pi), '3.182598');
+}
+
+{
+  my ($a, $b);
+  symbolic->vars($a, $b);
+  my $c = sqrt($a**2 + $b**2);
+  $a = 3; $b = 4;
+  test( (sprintf "%d", $c), '5');
+  $a = 12; $b = 5;
+  test( (sprintf "%d", $c), '13');
+}
+
+{
+  package symbolic1;           # Primitive symbolic calculator
+  # Mutator inc/dec
+  use overload nomethod => \&wrap, '""' => \&str, '0+' => \&num, '=' => \&cpy;
+
+  sub new { shift; bless ['n', @_] }
+  sub cpy {
+    my $self = shift;
+    bless [@$self], ref $self;
+  }
+  sub wrap {
+    my ($obj, $other, $inv, $meth) = @_;
+    if ($meth eq '++' or $meth eq '--') {
+      @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
+      return $obj;
+    }
+    ($obj, $other) = ($other, $obj) if $inv;
+    bless [$meth, $obj, $other];
+  }
+  sub str {
+    my ($meth, $a, $b) = @{+shift};
+    $a = 'u' unless defined $a;
+    if (defined $b) {
+      "[$meth $a $b]";
+    } else {
+      "[$meth $a]";
+    }
+  } 
+  my %subr = ( 'n' => sub {$_[0]} );
+  foreach my $op (split " ", $overload::ops{with_assign}) {
+    $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
+  }
+  my @bins = qw(binary 3way_comparison num_comparison str_comparison);
+  foreach my $op (split " ", "@overload::ops{ @bins }") {
+    $subr{$op} = eval "sub {shift() $op shift()}";
+  }
+  foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
+    $subr{$op} = eval "sub {$op shift()}";
+  }
+  $subr{'++'} = $subr{'+'};
+  $subr{'--'} = $subr{'-'};
+  
+  sub num {
+    my ($meth, $a, $b) = @{+shift};
+    my $subr = $subr{$meth} 
+      or die "Do not know how to ($meth) in symbolic";
+    $a = $a->num if ref $a eq __PACKAGE__;
+    $b = $b->num if ref $b eq __PACKAGE__;
+    $subr->($a,$b);
+  }
+  sub TIESCALAR { my $pack = shift; $pack->new(@_) }
+  sub FETCH { shift }
+  sub nop {  }         # Around a bug
+  sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
+  sub STORE { 
+    my $obj = shift; 
+    $#$obj = 1; 
+    $obj->[1] = shift;
+  }
+}
+
+{
+  my $foo = new symbolic1 11;
+  my $baz = $foo++;
+  test( (sprintf "%d", $foo), '12');
+  test( (sprintf "%d", $baz), '11');
+  my $bar = $foo;
+  $baz = ++$foo;
+  test( (sprintf "%d", $foo), '13');
+  test( (sprintf "%d", $bar), '12');
+  test( (sprintf "%d", $baz), '13');
+  my $ban = $foo;
+  $baz = ($foo += 1);
+  test( (sprintf "%d", $foo), '14');
+  test( (sprintf "%d", $bar), '12');
+  test( (sprintf "%d", $baz), '14');
+  test( (sprintf "%d", $ban), '13');
+  $baz = 0;
+  $baz = $foo++;
+  test( (sprintf "%d", $foo), '15');
+  test( (sprintf "%d", $baz), '14');
+  test( "$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
+}
+
+{
+  my $iter = new symbolic1 2;
+  my $side = new symbolic1 1;
+  my $cnt = $iter;
+  
+  while ($cnt) {
+    $cnt = $cnt - 1;           # The "simple" way
+    $side = (sqrt(1 + $side**2) - 1)/$side;
+  }
+  my $pi = $side*(2**($iter+2));
+  test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
+  test( (sprintf "%f", $pi), '3.182598');
+}
+
+{
+  my $iter = new symbolic1 2;
+  my $side = new symbolic1 1;
+  my $cnt = $iter;
+  
+  while ($cnt--) {
+    $side = (sqrt(1 + $side**2) - 1)/$side;
+  }
+  my $pi = $side*(2**($iter+2));
+  test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
+  test( (sprintf "%f", $pi), '3.182598');
+}
+
+{
+  my ($a, $b);
+  symbolic1->vars($a, $b);
+  my $c = sqrt($a**2 + $b**2);
+  $a = 3; $b = 4;
+  test( (sprintf "%d", $c), '5');
+  $a = 12; $b = 5;
+  test( (sprintf "%d", $c), '13');
+}
+
+{
+  package two_face;            # Scalars with separate string and
+                                # numeric values.
+  sub new { my $p = shift; bless [@_], $p }
+  use overload '""' => \&str, '0+' => \&num, fallback => 1;
+  sub num {shift->[1]}
+  sub str {shift->[0]}
+}
+
+{
+  my $seven = new two_face ("vii", 7);
+  test( (sprintf "seven=$seven, seven=%d, eight=%d", $seven, $seven+1),
+       'seven=vii, seven=7, eight=8');
+  test( scalar ($seven =~ /i/), '1')
+}
+
+{
+  package sorting;
+  use overload 'cmp' => \&comp;
+  sub new { my ($p, $v) = @_; bless \$v, $p }
+  sub comp { my ($x,$y) = @_; ($$x * 3 % 10) <=> ($$y * 3 % 10) or $$x cmp $$y }
+}
+{
+  my @arr = map sorting->new($_), 0..12;
+  my @sorted1 = sort @arr;
+  my @sorted2 = map $$_, @sorted1;
+  test "@sorted2", '0 10 7 4 1 11 8 5 12 2 9 6 3';
+}
+{
+  package iterator;
+  use overload '<>' => \&iter;
+  sub new { my ($p, $v) = @_; bless \$v, $p }
+  sub iter { my ($x) = @_; return undef if $$x < 0; return $$x--; }
+}
+
+# XXX iterator overload not intended to work with CORE::GLOBAL?
+if (defined &CORE::GLOBAL::glob) {
+  test '1', '1';       # 175
+  test '1', '1';       # 176
+  test '1', '1';       # 177
+}
+else {
+  my $iter = iterator->new(5);
+  my $acc = '';
+  my $out;
+  $acc .= " $out" while $out = <${iter}>;
+  test $acc, ' 5 4 3 2 1 0';   # 175
+  $iter = iterator->new(5);
+  test scalar <${iter}>, '5';  # 176
+  $acc = '';
+  $acc .= " $out" while $out = <$iter>;
+  test $acc, ' 4 3 2 1 0';     # 177
+}
+{
+  package deref;
+  use overload '%{}' => \&hderef, '&{}' => \&cderef, 
+    '*{}' => \&gderef, '${}' => \&sderef, '@{}' => \&aderef;
+  sub new { my ($p, $v) = @_; bless \$v, $p }
+  sub deref {
+    my ($self, $key) = (shift, shift);
+    my $class = ref $self;
+    bless $self, 'deref::dummy'; # Disable overloading of %{} 
+    my $out = $self->{$key};
+    bless $self, $class;       # Restore overloading
+    $out;
+  }
+  sub hderef {shift->deref('h')}
+  sub aderef {shift->deref('a')}
+  sub cderef {shift->deref('c')}
+  sub gderef {shift->deref('g')}
+  sub sderef {shift->deref('s')}
+}
+{
+  my $deref = bless { h => { foo => 5 , fake => 23 },
+                     c => sub {return shift() + 34},
+                     's' => \123,
+                     a => [11..13],
+                     g => \*srt,
+                   }, 'deref';
+  # Hash:
+  my @cont = sort %$deref;
+  if ("\t" eq "\011") { # ascii
+      test "@cont", '23 5 fake foo';   # 178
+  } 
+  else {                # ebcdic alpha-numeric sort order
+      test "@cont", 'fake foo 23 5';   # 178
+  }
+  my @keys = sort keys %$deref;
+  test "@keys", 'fake foo';    # 179
+  my @val = sort values %$deref;
+  test "@val", '23 5';         # 180
+  test $deref->{foo}, 5;       # 181
+  test defined $deref->{bar}, ''; # 182
+  my $key;
+  @keys = ();
+  push @keys, $key while $key = each %$deref;
+  @keys = sort @keys;
+  test "@keys", 'fake foo';    # 183  
+  test exists $deref->{bar}, ''; # 184
+  test exists $deref->{foo}, 1; # 185
+  # Code:
+  test $deref->(5), 39;                # 186
+  test &$deref(6), 40;         # 187
+  sub xxx_goto { goto &$deref }
+  test xxx_goto(7), 41;                # 188
+  my $srt = bless { c => sub {$b <=> $a}
+                 }, 'deref';
+  *srt = \&$srt;
+  my @sorted = sort srt 11, 2, 5, 1, 22;
+  test "@sorted", '22 11 5 2 1'; # 189
+  # Scalar
+  test $$deref, 123;           # 190
+  # Code
+  @sorted = sort $srt 11, 2, 5, 1, 22;
+  test "@sorted", '22 11 5 2 1'; # 191
+  # Array
+  test "@$deref", '11 12 13';  # 192
+  test $#$deref, '2';          # 193
+  my $l = @$deref;
+  test $l, 3;                  # 194
+  test $deref->[2], '13';              # 195
+  $l = pop @$deref;
+  test $l, 13;                 # 196
+  $l = 1;
+  test $deref->[$l], '12';     # 197
+  # Repeated dereference
+  my $double = bless { h => $deref,
+                    }, 'deref';
+  test $double->{foo}, 5;      # 198
+}
+
+{
+  package two_refs;
+  use overload '%{}' => \&gethash, '@{}' => sub { ${shift()} };
+  sub new { 
+    my $p = shift; 
+    bless \ [@_], $p;
+  }
+  sub gethash {
+    my %h;
+    my $self = shift;
+    tie %h, ref $self, $self;
+    \%h;
+  }
+
+  sub TIEHASH { my $p = shift; bless \ shift, $p }
+  my %fields;
+  my $i = 0;
+  $fields{$_} = $i++ foreach qw{zero one two three};
+  sub STORE { 
+    my $self = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $$self->[$key] = shift;
+  }
+  sub FETCH { 
+    my $self = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $$self->[$key];
+  }
+}
+
+my $bar = new two_refs 3,4,5,6;
+$bar->[2] = 11;
+test $bar->{two}, 11;          # 199
+$bar->{three} = 13;
+test $bar->[3], 13;            # 200
+
+{
+  package two_refs_o;
+  @ISA = ('two_refs');
+}
+
+$bar = new two_refs_o 3,4,5,6;
+$bar->[2] = 11;
+test $bar->{two}, 11;          # 201
+$bar->{three} = 13;
+test $bar->[3], 13;            # 202
+
+{
+  package two_refs1;
+  use overload '%{}' => sub { ${shift()}->[1] },
+               '@{}' => sub { ${shift()}->[0] };
+  sub new { 
+    my $p = shift; 
+    my $a = [@_];
+    my %h;
+    tie %h, $p, $a;
+    bless \ [$a, \%h], $p;
+  }
+  sub gethash {
+    my %h;
+    my $self = shift;
+    tie %h, ref $self, $self;
+    \%h;
+  }
+
+  sub TIEHASH { my $p = shift; bless \ shift, $p }
+  my %fields;
+  my $i = 0;
+  $fields{$_} = $i++ foreach qw{zero one two three};
+  sub STORE { 
+    my $a = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $a->[$key] = shift;
+  }
+  sub FETCH { 
+    my $a = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $a->[$key];
+  }
+}
+
+$bar = new two_refs_o 3,4,5,6;
+$bar->[2] = 11;
+test $bar->{two}, 11;          # 203
+$bar->{three} = 13;
+test $bar->[3], 13;            # 204
+
+{
+  package two_refs1_o;
+  @ISA = ('two_refs1');
+}
+
+$bar = new two_refs1_o 3,4,5,6;
+$bar->[2] = 11;
+test $bar->{two}, 11;          # 205
+$bar->{three} = 13;
+test $bar->[3], 13;            # 206
+
+{
+  package B;
+  use overload bool => sub { ${+shift} };
+}
+
+my $aaa;
+{ my $bbbb = 0; $aaa = bless \$bbbb, B }
+
+test !$aaa, 1;                 # 207
+
+unless ($aaa) {
+  test 'ok', 'ok';             # 208
+} else {
+  test 'is not', 'ok';         # 208
+}
+
+# check that overload isn't done twice by join
+{ my $c = 0;
+  package Join;
+  use overload '""' => sub { $c++ };
+  my $x = join '', bless([]), 'pq', bless([]);
+  main::test $x, '0pq1';               # 209
+};
+
+# Test module-specific warning
+{
+    # check the Odd number of arguments for overload::constant warning
+    my $a = "" ;
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    $x = eval ' overload::constant "integer" ; ' ;
+    test($a eq "") ; # 210
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "integer" ; ' ;
+    test($a =~ /^Odd number of arguments for overload::constant at/) ; # 211
+}
+
+{
+    # check the `$_[0]' is not an overloadable type warning
+    my $a = "" ;
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    $x = eval ' overload::constant "fred" => sub {} ; ' ;
+    test($a eq "") ; # 212
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "fred" => sub {} ; ' ;
+    test($a =~ /^`fred' is not an overloadable type at/); # 213
+}
+
+{
+    # check the `$_[1]' is not a code reference warning
+    my $a = "" ;
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    $x = eval ' overload::constant "integer" => 1; ' ;
+    test($a eq "") ; # 214
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "integer" => 1; ' ;
+    test($a =~ /^`1' is not a code reference at/); # 215
+}
+
+{
+  my $c = 0;
+  package ov_int1;
+  use overload '""'    => sub { 3+shift->[0] },
+               '0+'    => sub { 10+shift->[0] },
+               'int'   => sub { 100+shift->[0] };
+  sub new {my $p = shift; bless [shift], $p}
+
+  package ov_int2;
+  use overload '""'    => sub { 5+shift->[0] },
+               '0+'    => sub { 30+shift->[0] },
+               'int'   => sub { 'ov_int1'->new(1000+shift->[0]) };
+  sub new {my $p = shift; bless [shift], $p}
+
+  package noov_int;
+  use overload '""'    => sub { 2+shift->[0] },
+               '0+'    => sub { 9+shift->[0] };
+  sub new {my $p = shift; bless [shift], $p}
+
+  package main;
+
+  my $x = new noov_int 11;
+  my $int_x = int $x;
+  main::test("$int_x" eq 20);                  # 216
+  $x = new ov_int1 31;
+  $int_x = int $x;
+  main::test("$int_x" eq 131);                 # 217
+  $x = new ov_int2 51;
+  $int_x = int $x;
+  main::test("$int_x" eq 1054);                        # 218
+}
+
+# make sure that we don't inifinitely recurse
+{
+  my $c = 0;
+  package Recurse;
+  use overload '""'    => sub { shift },
+               '0+'    => sub { shift },
+               'bool'  => sub { shift },
+               fallback => 1;
+  my $x = bless([]);
+  main::test("$x" =~ /Recurse=ARRAY/);         # 219
+  main::test($x);                               # 220
+  main::test($x+0 =~ /Recurse=ARRAY/);         # 221
+}
+
+# BugID 20010422.003
+package Foo;
+
+use overload
+  'bool' => sub { return !$_[0]->is_zero() || undef; }
+;
+ 
+sub is_zero
+  {
+  my $self = shift;
+  return $self->{var} == 0;
+  }
+
+sub new
+  {
+  my $class = shift;
+  my $self =  {};
+  $self->{var} = shift;
+  bless $self,$class;
+  }
+
+package main;
+
+use strict;
+
+my $r = Foo->new(8);
+$r = Foo->new(0);
+
+test(($r || 0) == 0); # 222
+
+# Last test is:
+sub last {222}

diff --git a/lib/ph.t b/lib/ph.t
new file mode 100755 (executable)
index 0000000..de27dee
--- /dev/null
+++ b/lib/ph.t
@@ -0,0 +1,96 @@
+#!./perl
+
+# Check for presence and correctness of .ph files; for now,
+# just socket.ph and pals.
+#   -- Kurt Starsinic <kstar@isinet.com>
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# All the constants which Socket.pm tries to make available:
+my @possibly_defined = qw(
+    INADDR_ANY INADDR_LOOPBACK INADDR_NONE AF_802 AF_APPLETALK AF_CCITT
+    AF_CHAOS AF_DATAKIT AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK
+    AF_INET AF_LAT AF_MAX AF_NBS AF_NIT AF_NS AF_OSI AF_OSINET AF_PUP
+    AF_SNA AF_UNIX AF_UNSPEC AF_X25 MSG_DONTROUTE MSG_MAXIOVLEN MSG_OOB
+    MSG_PEEK PF_802 PF_APPLETALK PF_CCITT PF_CHAOS PF_DATAKIT PF_DECnet PF_DLI
+    PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_LAT PF_MAX PF_NBS PF_NIT
+    PF_NS PF_OSI PF_OSINET PF_PUP PF_SNA PF_UNIX PF_UNSPEC PF_X25 SOCK_DGRAM
+    SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM SOL_SOCKET SOMAXCONN
+    SO_ACCEPTCONN SO_BROADCAST SO_DEBUG SO_DONTLINGER SO_DONTROUTE SO_ERROR
+    SO_KEEPALIVE SO_LINGER SO_OOBINLINE SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO
+    SO_REUSEADDR SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_TYPE SO_USELOOPBACK
+);
+
+
+# The libraries which I'm going to require:
+my @libs = qw(Socket "sys/types.ph" "sys/socket.ph" "netinet/in.ph");
+
+
+# These are defined by Socket.pm even if the C header files don't define them:
+my %ok_to_miss = (
+    INADDR_NONE         => 1,
+    INADDR_LOOPBACK     => 1,
+);
+
+
+my $total_tests = scalar @libs + scalar @possibly_defined;
+my $i           = 0;
+
+print "1..$total_tests\n";
+
+
+foreach (@libs) {
+    $i++;
+
+    if (eval "require $_" ) {
+        print "ok $i\n";
+    } else {
+        print "# Skipping tests; $_ may be missing\n";
+        foreach ($i .. $total_tests) { print "ok $_\n" }
+        exit;
+    }
+}
+
+
+foreach (@possibly_defined) {
+    $i++;
+
+    $pm_val = eval "Socket::$_()";
+    $ph_val = eval "main::$_()";
+
+    if (defined $pm_val and !defined $ph_val) {
+        if ($ok_to_miss{$_}) { print "ok $i\n" }
+        else                 { print "not ok $i\n" }
+        next;
+    } elsif (defined $ph_val and !defined $pm_val) {
+        print "not ok $i\n";
+        next;
+    }
+
+    # Socket.pm converts these to network byte order, so we convert the
+    # socket.ph version to match; note that these cases skip the following
+    # `elsif', which is only applied to _numeric_ values, not literal
+    # bitmasks.
+    if ($_ eq 'INADDR_ANY'
+    or  $_ eq 'INADDR_LOOPBACK'
+    or  $_ eq 'INADDR_NONE') {
+        $ph_val = pack("N*", $ph_val);  # htonl(3) equivalent
+    }
+
+    # Since Socket.pm and socket.ph wave their hands over macros differently,
+    # they could return functionally equivalent bitmaps with different numeric
+    # interpretations (due to sign extension).  The only apparent case of this
+    # is SO_DONTLINGER (only on Solaris, and deprecated, at that):
+    elsif ($pm_val != $ph_val) {
+        $pm_val = oct(sprintf "0x%lx", $pm_val);
+        $ph_val = oct(sprintf "0x%lx", $ph_val);
+    }
+
+    if ($pm_val == $ph_val) { print "ok $i\n" }
+    else                    { print "not ok $i\n" }
+}
+
+

diff --git a/lib/strict.t b/lib/strict.t
new file mode 100644 (file)
index 0000000..8b9083f
--- /dev/null
+++ b/lib/strict.t
@@ -0,0 +1,100 @@
+#!./perl 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    $ENV{PERL5LIB} = '../lib';
+}
+
+$| = 1;
+
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MSWin32 = $^O eq 'MSWin32';
+my $Is_NetWare = $^O eq 'NetWare';
+my $tmpfile = "tmp0000";
+my $i = 0 ;
+1 while -f ++$tmpfile;
+END { if ($tmpfile) { 1 while unlink $tmpfile; } }
+
+my @prgs = () ;
+
+foreach (sort glob($^O eq 'MacOS' ? ":pragma:strict-*" : "pragma/strict-*")) {
+
+    next if /(~|\.orig|,v)$/;
+
+    open F, "<$_" or die "Cannot open $_: $!\n" ;
+    while (<F>) {
+       last if /^__END__/ ;
+    }
+
+    {
+        local $/ = undef;
+        @prgs = (@prgs, split "\n########\n", <F>) ;
+    }
+    close F ;
+}
+
+undef $/;
+
+print "1..", scalar @prgs, "\n";
+ 
+ 
+for (@prgs){
+    my $switch = "";
+    my @temps = () ;
+    if (s/^\s*-\w+//){
+        $switch = $&;
+    }
+    my($prog,$expected) = split(/\nEXPECT\n/, $_);
+    if ( $prog =~ /--FILE--/) {
+        my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
+       shift @files ;
+       die "Internal error test $i didn't split into pairs, got " . 
+               scalar(@files) . "[" . join("%%%%", @files) ."]\n"
+           if @files % 2 ;
+       while (@files > 2) {
+           my $filename = shift @files ;
+           my $code = shift @files ;
+           $code =~ s|\./abc|:abc|g if $^O eq 'MacOS';
+           push @temps, $filename ;
+           open F, ">$filename" or die "Cannot open $filename: $!\n" ;
+           print F $code ;
+           close F ;
+       }
+       shift @files ;
+       $prog = shift @files ;
+       $prog =~ s|\./abc|:abc|g if $^O eq 'MacOS';
+    }
+    open TEST, ">$tmpfile";
+    print TEST $prog,"\n";
+    close TEST;
+    my $results = $Is_MSWin32 ?
+                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
+                  $^O eq 'MacOS' ?
+                  `$^X -I::lib $switch $tmpfile` :
+                  $^O eq 'NetWare' ?
+                  `perl -I../lib $switch $tmpfile 2>&1` :
+                  `./perl $switch $tmpfile 2>&1`;
+    my $status = $?;
+    $results =~ s/\n+$//;
+    # allow expected output to be written as if $prog is on STDIN
+    $results =~ s/tmp\d+/-/g;
+    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
+    $expected =~ s/\n+$//;
+    $expected =~ s|(\./)?abc\.pm|:abc.pm|g if $^O eq 'MacOS';
+    $expected =~ s|./abc|:abc|g if $^O eq 'MacOS';
+    my $prefix = ($results =~ s/^PREFIX\n//) ;
+    if ( $results =~ s/^SKIPPED\n//) {
+       print "$results\n" ;
+    }
+    elsif (($prefix and $results !~ /^\Q$expected/) or
+          (!$prefix and $results ne $expected)){
+        print STDERR "PROG: $switch\n$prog\n";
+        print STDERR "EXPECTED:\n$expected\n";
+        print STDERR "GOT:\n$results\n";
+        print "not ";
+    }
+    print "ok ", ++$i, "\n";
+    foreach (@temps) 
+       { unlink $_ if $_ } 
+}

diff --git a/lib/strict/refs b/lib/strict/refs
new file mode 100644 (file)
index 0000000..10599b0
--- /dev/null
+++ b/lib/strict/refs
@@ -0,0 +1,297 @@
+Check strict refs functionality
+
+__END__
+
+# no strict, should build & run ok.
+my $fred ;
+$b = "fred" ;
+$a = $$b ;
+$c = ${"def"} ;
+$c = @{"def"} ;
+$c = %{"def"} ;
+$c = *{"def"} ;
+$c = \&{"def"} ;
+$c = def->[0];
+$c = def->{xyz};
+EXPECT
+
+########
+
+# strict refs - error
+use strict ;
+my $fred ;
+my $a = ${"fred"} ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 5.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $fred ;
+my $a = ${"fred"} ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 5.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $fred ;
+my $b = "fred" ;
+my $a = $$b ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 6.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $b ;
+my $a = $$b ;
+EXPECT
+Can't use an undefined value as a SCALAR reference at - line 5.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $b ;
+my $a = @$b ;
+EXPECT
+Can't use an undefined value as an ARRAY reference at - line 5.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $b ;
+my $a = %$b ;
+EXPECT
+Can't use an undefined value as a HASH reference at - line 5.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $b ;
+my $a = *$b ;
+EXPECT
+Can't use an undefined value as a symbol reference at - line 5.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $a = fred->[0] ;
+EXPECT
+Can't use bareword ("fred") as an ARRAY ref while "strict refs" in use at - line 4.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $a = fred->{barney} ;
+EXPECT
+Can't use bareword ("fred") as a HASH ref while "strict refs" in use at - line 4.
+########
+
+# strict refs - no error
+use strict ;
+no strict 'refs' ;
+my $fred ;
+my $b = "fred" ;
+my $a = $$b ;
+use strict 'refs' ;
+EXPECT
+
+########
+
+# strict refs - no error
+use strict qw(subs vars) ;
+my $fred ;
+my $b = "fred" ;
+my $a = $$b ;
+use strict 'refs' ;
+EXPECT
+
+########
+
+# strict refs - no error
+my $fred ;
+my $b = "fred" ;
+my $a = $$b ;
+use strict 'refs' ;
+EXPECT
+
+########
+
+# strict refs - no error
+use strict 'refs' ;
+my $fred ;
+my $b = \$fred ;
+my $a = $$b ;
+EXPECT
+
+########
+
+# Check runtime scope of strict refs pragma
+use strict 'refs';
+my $fred ;
+my $b = "fred" ;
+{
+    no strict ;
+    my $a = $$b ;
+}
+my $a = $$b ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 10.
+########
+
+# Check runtime scope of strict refs pragma
+no strict ;
+my $fred ;
+my $b = "fred" ;
+{
+    use strict 'refs' ;
+    my $a = $$b ;
+}
+my $a = $$b ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
+########
+
+# Check runtime scope of strict refs pragma
+no strict ;
+my $fred ;
+my $b = "fred" ;
+{
+    use strict 'refs' ;
+    $a = sub { my $c = $$b ; }
+}
+&$a ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
+########
+
+
+--FILE-- abc
+my $a = ${"Fred"} ;
+1;
+--FILE-- 
+use strict 'refs' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'refs' ;
+1;
+--FILE-- 
+require "./abc";
+my $a = ${"Fred"} ;
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'refs' ;
+my $a = ${"Fred"} ;
+1;
+--FILE-- 
+${"Fred"} ;
+require "./abc";
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at ./abc line 2.
+Compilation failed in require at - line 2.
+########
+
+--FILE-- abc.pm
+use strict 'refs' ;
+my $a = ${"Fred"} ;
+1;
+--FILE-- 
+my $a = ${"Fred"} ;
+use abc;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at abc.pm line 2.
+Compilation failed in require at - line 2.
+BEGIN failed--compilation aborted at - line 2.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    my $a = ${"Fred"} ;
+};
+print STDERR $@ ;
+my $a = ${"Fred"} ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    use strict 'refs' ;
+    my $a = ${"Fred"} ;
+};
+print STDERR $@ ;
+my $a = ${"Fred"} ;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 6.
+########
+
+# Check scope of pragma with eval
+use strict 'refs' ;
+eval {
+    my $a = ${"Fred"} ;
+};
+print STDERR $@ ;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 5.
+########
+
+# Check scope of pragma with eval
+use strict 'refs' ;
+eval {
+    no strict ;
+    my $a = ${"Fred"} ;
+};
+print STDERR $@ ;
+my $a = ${"Fred"} ;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 9.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval '
+    my $a = ${"Fred"} ;
+'; print STDERR $@ ;
+my $a = ${"Fred"} ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval q[ 
+    use strict 'refs' ;
+    my $a = ${"Fred"} ;
+]; print STDERR $@;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+use strict 'refs' ;
+eval '
+    my $a = ${"Fred"} ;
+'; print STDERR $@ ;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+use strict 'refs' ;
+eval '
+    no strict ;
+    my $a = ${"Fred"} ;
+'; print STDERR $@;
+my $a = ${"Fred"} ;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 8.

diff --git a/lib/strict/subs b/lib/strict/subs
new file mode 100644 (file)
index 0000000..ed4fe7a
--- /dev/null
+++ b/lib/strict/subs
@@ -0,0 +1,319 @@
+Check strict subs functionality
+
+__END__
+
+# no strict, should build & run ok.
+Fred ;
+my $fred ;
+$b = "fred" ;
+$a = $$b ;
+EXPECT
+
+########
+
+use strict qw(refs vars);
+Fred ;
+EXPECT
+
+########
+
+use strict ;
+no strict 'subs' ;
+Fred ;
+EXPECT
+
+########
+
+# strict subs - error
+use strict 'subs' ;
+Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - error
+use strict 'subs' ;
+my @a = (A..Z);
+EXPECT
+Bareword "Z" not allowed while "strict subs" in use at - line 4.
+Bareword "A" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - error
+use strict 'subs' ;
+my $a = (B..Y);
+EXPECT
+Bareword "Y" not allowed while "strict subs" in use at - line 4.
+Bareword "B" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - error
+use strict ;
+Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - no error
+use strict 'subs' ;
+sub Fred {}
+Fred ;
+EXPECT
+
+########
+
+# Check compile time scope of strict subs pragma
+use strict 'subs' ;
+{
+    no strict ;
+    my $a = Fred ;
+}
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict subs pragma
+no strict;
+{
+    use strict 'subs' ;
+    my $a = Fred ;
+}
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict vars pragma
+use strict 'vars' ;
+{
+    no strict ;
+    $joe = 1 ;
+}
+$joe = 1 ;
+EXPECT
+Variable "$joe" is not imported at - line 8.
+Global symbol "$joe" requires explicit package name at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict vars pragma
+no strict;
+{
+    use strict 'vars' ;
+    $joe = 1 ;
+}
+$joe = 1 ;
+EXPECT
+Global symbol "$joe" requires explicit package name at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+# Check runtime scope of strict refs pragma
+use strict 'refs';
+my $fred ;
+my $b = "fred" ;
+{
+    no strict ;
+    my $a = $$b ;
+}
+my $a = $$b ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 10.
+########
+
+# Check runtime scope of strict refs pragma
+no strict ;
+my $fred ;
+my $b = "fred" ;
+{
+    use strict 'refs' ;
+    my $a = $$b ;
+}
+my $a = $$b ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
+########
+
+# Check runtime scope of strict refs pragma
+no strict ;
+my $fred ;
+my $b = "fred" ;
+{
+    use strict 'refs' ;
+    $a = sub { my $c = $$b ; }
+}
+&$a ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
+########
+
+use strict 'subs' ;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 3.
+Execution of - aborted due to compilation errors.
+########
+
+--FILE-- abc
+my $a = Fred ;
+1;
+--FILE-- 
+use strict 'subs' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'subs' ;
+1;
+--FILE-- 
+require "./abc";
+my $a = Fred ;
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'subs' ;
+my $a = Fred ;
+1;
+--FILE-- 
+Fred ;
+require "./abc";
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at ./abc line 2.
+Compilation failed in require at - line 2.
+########
+
+--FILE-- abc.pm
+use strict 'subs' ;
+my $a = Fred ;
+1;
+--FILE-- 
+Fred ;
+use abc;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at abc.pm line 2.
+Compilation failed in require at - line 2.
+BEGIN failed--compilation aborted at - line 2.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    my $a = Fred ;
+};
+print STDERR $@;
+my $a = Fred ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    use strict 'subs' ;
+    my $a = Fred ;
+};
+print STDERR $@;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+use strict 'subs' ;
+eval {
+    my $a = Fred ;
+};
+print STDERR $@;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 5.
+Bareword "Fred" not allowed while "strict subs" in use at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+use strict 'subs' ;
+eval {
+    no strict ;
+    my $a = Fred ;
+};
+print STDERR $@;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 9.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval '
+    Fred ;
+'; print STDERR $@ ;
+Fred ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval q[ 
+    use strict 'subs' ;
+    Fred ;
+]; print STDERR $@;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+use strict 'subs' ;
+eval '
+    Fred ;
+'; print STDERR $@ ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+use strict 'subs' ;
+eval '
+    no strict ;
+    my $a = Fred ;
+'; print STDERR $@;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# see if Foo->Bar(...) etc work under strictures
+use strict;
+package Foo; sub Bar { print "@_\n" }
+Foo->Bar('a',1);
+Bar Foo ('b',2);
+Foo->Bar(qw/c 3/);
+Bar Foo (qw/d 4/);
+Foo::->Bar('A',1);
+Bar Foo:: ('B',2);
+Foo::->Bar(qw/C 3/);
+Bar Foo:: (qw/D 4/);
+EXPECT
+Foo a 1
+Foo b 2
+Foo c 3
+Foo d 4
+Foo A 1
+Foo B 2
+Foo C 3
+Foo D 4

diff --git a/lib/strict/vars b/lib/strict/vars
new file mode 100644 (file)
index 0000000..40b5557
--- /dev/null
+++ b/lib/strict/vars
@@ -0,0 +1,410 @@
+Check strict vars functionality
+
+__END__
+
+# no strict, should build & run ok.
+Fred ;
+my $fred ;
+$b = "fred" ;
+$a = $$b ;
+EXPECT
+
+########
+
+use strict qw(subs refs) ;
+$fred ;
+EXPECT
+
+########
+
+use strict ;
+no strict 'vars' ;
+$fred ;
+EXPECT
+
+########
+
+# strict vars - no error
+use strict 'vars' ;
+use vars qw( $freddy) ;
+BEGIN { *freddy = \$joe::shmoe; }
+$freddy = 2 ;
+EXPECT
+
+########
+
+# strict vars - no error
+use strict 'vars' ;
+use vars qw( $freddy) ;
+local $abc::joe ;
+my $fred ;
+my $b = \$fred ;
+$Fred::ABC = 1 ;
+$freddy = 2 ;
+EXPECT
+
+########
+
+# strict vars - error
+use strict ;
+$fred ;
+EXPECT
+Global symbol "$fred" requires explicit package name at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict vars - error
+use strict 'vars' ;
+<$fred> ;
+EXPECT
+Global symbol "$fred" requires explicit package name at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict vars - error
+use strict 'vars' ;
+local $fred ;
+EXPECT
+Global symbol "$fred" requires explicit package name at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict vars pragma
+use strict 'vars' ;
+{
+    no strict ;
+    $joe = 1 ;
+}
+$joe = 1 ;
+EXPECT
+Variable "$joe" is not imported at - line 8.
+Global symbol "$joe" requires explicit package name at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict vars pragma
+no strict;
+{
+    use strict 'vars' ;
+    $joe = 1 ;
+}
+$joe = 1 ;
+EXPECT
+Global symbol "$joe" requires explicit package name at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+--FILE-- abc
+$joe = 1 ;
+1;
+--FILE-- 
+use strict 'vars' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'vars' ;
+1;
+--FILE-- 
+require "./abc";
+$joe = 1 ;
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'vars' ;
+$joe = 1 ;
+1;
+--FILE-- 
+$joe = 1 ;
+require "./abc";
+EXPECT
+Variable "$joe" is not imported at ./abc line 2.
+Global symbol "$joe" requires explicit package name at ./abc line 2.
+Compilation failed in require at - line 2.
+########
+
+--FILE-- abc.pm
+use strict 'vars' ;
+$joe = 1 ;
+1;
+--FILE-- 
+$joe = 1 ;
+use abc;
+EXPECT
+Variable "$joe" is not imported at abc.pm line 2.
+Global symbol "$joe" requires explicit package name at abc.pm line 2.
+Compilation failed in require at - line 2.
+BEGIN failed--compilation aborted at - line 2.
+########
+
+--FILE-- abc.pm
+package Burp;
+use strict;
+$a = 1;$f = 1;$k = 1; # just to get beyond the limit...
+$b = 1;$g = 1;$l = 1;
+$c = 1;$h = 1;$m = 1;
+$d = 1;$i = 1;$n = 1;
+$e = 1;$j = 1;$o = 1;
+$p = 0b12;
+--FILE-- 
+use abc;
+EXPECT
+Global symbol "$f" requires explicit package name at abc.pm line 3.
+Global symbol "$k" requires explicit package name at abc.pm line 3.
+Global symbol "$g" requires explicit package name at abc.pm line 4.
+Global symbol "$l" requires explicit package name at abc.pm line 4.
+Global symbol "$c" requires explicit package name at abc.pm line 5.
+Global symbol "$h" requires explicit package name at abc.pm line 5.
+Global symbol "$m" requires explicit package name at abc.pm line 5.
+Global symbol "$d" requires explicit package name at abc.pm line 6.
+Global symbol "$i" requires explicit package name at abc.pm line 6.
+Global symbol "$n" requires explicit package name at abc.pm line 6.
+Global symbol "$e" requires explicit package name at abc.pm line 7.
+Global symbol "$j" requires explicit package name at abc.pm line 7.
+Global symbol "$o" requires explicit package name at abc.pm line 7.
+Global symbol "$p" requires explicit package name at abc.pm line 8.
+Illegal binary digit '2' at abc.pm line 8, at end of line
+abc.pm has too many errors.
+Compilation failed in require at - line 1.
+BEGIN failed--compilation aborted at - line 1.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    $joe = 1 ;
+};
+print STDERR $@;
+$joe = 1 ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    use strict 'vars' ;
+    $joe = 1 ;
+};
+print STDERR $@;
+$joe = 1 ;
+EXPECT
+Global symbol "$joe" requires explicit package name at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+use strict 'vars' ;
+eval {
+    $joe = 1 ;
+};
+print STDERR $@;
+$joe = 1 ;
+EXPECT
+Global symbol "$joe" requires explicit package name at - line 5.
+Global symbol "$joe" requires explicit package name at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+use strict 'vars' ;
+eval {
+    no strict ;
+    $joe = 1 ;
+};
+print STDERR $@;
+$joe = 1 ;
+EXPECT
+Variable "$joe" is not imported at - line 9.
+Global symbol "$joe" requires explicit package name at - line 9.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval '
+    $joe = 1 ;
+'; print STDERR $@ ;
+$joe = 1 ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval q[ 
+    use strict 'vars' ;
+    $joe = 1 ;
+]; print STDERR $@;
+EXPECT
+Global symbol "$joe" requires explicit package name at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+use strict 'vars' ;
+eval '
+    $joe = 1 ;
+'; print STDERR $@ ;
+EXPECT
+Global symbol "$joe" requires explicit package name at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+use strict 'vars' ;
+eval '
+    no strict ;
+    $joe = 1 ;
+'; print STDERR $@;
+$joe = 1 ;
+EXPECT
+Global symbol "$joe" requires explicit package name at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check if multiple evals produce same errors
+use strict 'vars';
+my $ret = eval q{ print $x; };
+print $@;
+print "ok 1\n" unless defined $ret;
+$ret = eval q{ print $x; };
+print $@;
+print "ok 2\n" unless defined $ret;
+EXPECT
+Global symbol "$x" requires explicit package name at (eval 1) line 1.
+ok 1
+Global symbol "$x" requires explicit package name at (eval 2) line 1.
+ok 2
+########
+
+# strict vars with outer our - no error
+use strict 'vars' ;
+our $freddy;
+local $abc::joe ;
+my $fred ;
+my $b = \$fred ;
+$Fred::ABC = 1 ;
+$freddy = 2 ;
+EXPECT
+
+########
+
+# strict vars with inner our - no error
+use strict 'vars' ;
+sub foo {
+    our $fred;
+    $fred;
+}
+EXPECT
+
+########
+
+# strict vars with outer our, inner use - no error
+use strict 'vars' ;
+our $fred;
+sub foo {
+    $fred;
+}
+EXPECT
+
+########
+
+# strict vars with nested our - no error
+use strict 'vars' ;
+our $fred;
+sub foo {
+    our $fred;
+    $fred;
+}
+$fred ;
+EXPECT
+
+########
+
+# strict vars with elapsed our - error
+use strict 'vars' ;
+sub foo {
+    our $fred;
+    $fred;
+}
+$fred ;
+EXPECT
+Variable "$fred" is not imported at - line 8.
+Global symbol "$fred" requires explicit package name at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# nested our with local - no error
+$fred = 1;
+use strict 'vars';
+{
+    local our $fred = 2;
+    print $fred,"\n";
+}
+print our $fred,"\n";
+EXPECT
+2
+1
+########
+
+# "nailed" our declaration visibility across package boundaries
+use strict 'vars';
+our $foo;
+$foo = 20;
+package Foo;
+print $foo, "\n";
+EXPECT
+20
+########
+
+# multiple our declarations in same scope, different packages, no warning
+use strict 'vars';
+use warnings;
+our $foo;
+${foo} = 10;
+package Foo;
+our $foo = 20;
+print $foo, "\n";
+EXPECT
+20
+########
+
+# multiple our declarations in same scope, same package, warning
+use strict 'vars';
+use warnings;
+our $foo;
+${foo} = 10;
+our $foo;
+EXPECT
+"our" variable $foo masks earlier declaration in same scope at - line 7.
+########
+
+# multiple our declarations in same scope, same package, warning
+use strict 'vars';
+use warnings;
+{ our $x = 1 }
+{ our $x = 0 }
+our $foo;
+{
+    our $foo;
+    package Foo;
+    our $foo;
+}
+EXPECT
+"our" variable $foo redeclared at - line 9.
+       (Did you mean "local" instead of "our"?)
+Name "Foo::foo" used only once: possible typo at - line 11.
+########
+
+# Make sure the strict vars failure still occurs
+# now that the `@i should be written as \@i' failure does not occur
+# 20000522 mjd@plover.com (MJD)
+use strict 'vars';
+no warnings;
+"@i_like_crackers";
+EXPECT
+Global symbol "@i_like_crackers" requires explicit package name at - line 7.
+Execution of - aborted due to compilation errors.

diff --git a/lib/subs.t b/lib/subs.t
new file mode 100644 (file)
index 0000000..2f684b4
--- /dev/null
+++ b/lib/subs.t
@@ -0,0 +1,162 @@
+#!./perl 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    $ENV{PERL5LIB} = '../lib';
+}
+
+$| = 1;
+undef $/;
+my @prgs = split "\n########\n", <DATA>;
+print "1..", scalar @prgs, "\n";
+
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MSWin32 = $^O eq 'MSWin32';
+my $Is_NetWare = $^O eq 'NetWare';
+my $tmpfile = "tmp0000";
+my $i = 0 ;
+1 while -f ++$tmpfile;
+END {  if ($tmpfile) { 1 while unlink $tmpfile} }
+
+for (@prgs){
+    my $switch = "";
+    my @temps = () ;
+    if (s/^\s*-\w+//){
+        $switch = $&;
+    }
+    my($prog,$expected) = split(/\nEXPECT\n/, $_);
+    if ( $prog =~ /--FILE--/) {
+        my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
+       shift @files ;
+       die "Internal error test $i didn't split into pairs, got " . 
+               scalar(@files) . "[" . join("%%%%", @files) ."]\n"
+           if @files % 2 ;
+       while (@files > 2) {
+           my $filename = shift @files ;
+           my $code = shift @files ;
+           push @temps, $filename ;
+           open F, ">$filename" or die "Cannot open $filename: $!\n" ;
+           print F $code ;
+           close F ;
+       }
+       shift @files ;
+       $prog = shift @files ;
+    }
+    open TEST, ">$tmpfile";
+    print TEST $prog,"\n";
+    close TEST;
+    my $results = $Is_VMS ?
+                  `./perl $switch $tmpfile 2>&1` :
+                 $Is_MSWin32 ?
+                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
+                 $Is_NetWare ?
+                  `perl -I../lib $switch $tmpfile 2>&1` :
+                  `./perl $switch $tmpfile 2>&1`;
+    my $status = $?;
+    $results =~ s/\n+$//;
+    # allow expected output to be written as if $prog is on STDIN
+    $results =~ s/tmp\d+/-/g;
+    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
+# bison says 'parse error' instead of 'syntax error',
+# various yaccs may or may not capitalize 'syntax'.
+    $results =~ s/^(syntax|parse) error/syntax error/mig;
+    $expected =~ s/\n+$//;
+    my $prefix = ($results =~ s/^PREFIX\n//) ;
+    if ( $results =~ s/^SKIPPED\n//) {
+       print "$results\n" ;
+    }
+    elsif (($prefix and $results !~ /^\Q$expected/) or
+          (!$prefix and $results ne $expected)){
+        print STDERR "PROG: $switch\n$prog\n";
+        print STDERR "EXPECTED:\n$expected\n";
+        print STDERR "GOT:\n$results\n";
+        print "not ";
+    }
+    print "ok ", ++$i, "\n";
+    foreach (@temps) 
+       { unlink $_ if $_ } 
+}
+
+__END__
+
+# Error - not predeclaring a sub
+Fred 1,2 ;
+sub Fred {}
+EXPECT
+Number found where operator expected at - line 3, near "Fred 1"
+       (Do you need to predeclare Fred?)
+syntax error at - line 3, near "Fred 1"
+Execution of - aborted due to compilation errors.
+########
+
+# Error - not predeclaring a sub in time
+Fred 1,2 ;
+use subs qw( Fred ) ;
+sub Fred {}
+EXPECT
+Number found where operator expected at - line 3, near "Fred 1"
+       (Do you need to predeclare Fred?)
+syntax error at - line 3, near "Fred 1"
+BEGIN not safe after errors--compilation aborted at - line 4.
+########
+
+# AOK
+use subs qw( Fred) ;
+Fred 1,2 ;
+sub Fred { print $_[0] + $_[1], "\n" }
+EXPECT
+3
+########
+
+# override a built-in function
+use subs qw( open ) ;
+open 1,2 ;
+sub open { print $_[0] + $_[1], "\n" }
+EXPECT
+3
+########
+
+# override a built-in function, call after definition
+use subs qw( open ) ;
+sub open { print $_[0] + $_[1], "\n" }
+open 1,2 ;
+EXPECT
+3
+########
+
+# override a built-in function, call with ()
+use subs qw( open ) ;
+open (1,2) ;
+sub open { print $_[0] + $_[1], "\n" }
+EXPECT
+3
+########
+
+# override a built-in function, call with () after definition
+use subs qw( open ) ;
+sub open { print $_[0] + $_[1], "\n" }
+open (1,2) ;
+EXPECT
+3
+########
+
+--FILE-- abc
+Fred 1,2 ;
+1;
+--FILE--
+use subs qw( Fred ) ;
+require "./abc" ;
+sub Fred { print $_[0] + $_[1], "\n" }
+EXPECT
+3
+########
+
+# check that it isn't affected by block scope
+{
+    use subs qw( Fred ) ;
+}
+Fred 1, 2;
+sub Fred { print $_[0] + $_[1], "\n" }
+EXPECT
+3

diff --git a/lib/utf8.t b/lib/utf8.t
new file mode 100644 (file)
index 0000000..850470e
--- /dev/null
+++ b/lib/utf8.t
@@ -0,0 +1,103 @@
+#!./perl 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# NOTE!
+#
+# Think carefully before adding tests here.  In general this should be
+# used only for about three categories of tests:
+#
+# (1) tests that absolutely require 'use utf8', and since that in general
+#     shouldn't be needed as the utf8 is being obsoleted, this should
+#     have rather few tests.  If you want to test Unicode and regexes,
+#     you probably want to go to op/regexp or op/pat; if you want to test
+#     split, go to op/split; pack, op/pack; appending or joining,
+#     op/append or op/join, and so forth
+#
+# (2) tests that have to do with Unicode tokenizing (though it's likely
+#     that all the other Unicode tests sprinkled around the t/**/*.t are
+#     going to catch that)
+#
+# (3) complicated tests that simultaneously stress so many Unicode features
+#     that deciding into which other test script the tests should go to
+#     is hard -- maybe consider breaking up the complicated test
+#
+#
+
+use Test;
+plan tests => 15;
+
+{
+    # bug id 20001009.001
+
+    my ($a, $b);
+
+    { use bytes; $a = "\xc3\xa4" }
+    { use utf8;  $b = "\xe4"     }
+
+    my $test = 68;
+
+    ok($a ne $b);
+
+    { use utf8; ok($a ne $b) }
+}
+
+
+{
+    # bug id 20000730.004
+
+    my $smiley = "\x{263a}";
+
+    for my $s ("\x{263a}",
+              $smiley,
+               
+              "" . $smiley,
+              "" . "\x{263a}",
+
+              $smiley    . "",
+              "\x{263a}" . "",
+              ) {
+       my $length_chars = length($s);
+       my $length_bytes;
+       { use bytes; $length_bytes = length($s) }
+       my @regex_chars = $s =~ m/(.)/g;
+       my $regex_chars = @regex_chars;
+       my @split_chars = split //, $s;
+       my $split_chars = @split_chars;
+       ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
+          "1/1/1/3");
+    }
+
+    for my $s ("\x{263a}" . "\x{263a}",
+              $smiley    . $smiley,
+
+              "\x{263a}\x{263a}",
+              "$smiley$smiley",
+              
+              "\x{263a}" x 2,
+              $smiley    x 2,
+              ) {
+       my $length_chars = length($s);
+       my $length_bytes;
+       { use bytes; $length_bytes = length($s) }
+       my @regex_chars = $s =~ m/(.)/g;
+       my $regex_chars = @regex_chars;
+       my @split_chars = split //, $s;
+       my $split_chars = @split_chars;
+       ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
+          "2/2/2/6");
+    }
+}
+
+
+{
+    my $w = 0;
+    local $SIG{__WARN__} = sub { print "#($_[0])\n"; $w++ };
+    my $x = eval q/"\\/ . "\x{100}" . q/"/;;
+   
+    ok($w == 0 && $x eq "\x{100}");
+}
+

diff --git a/lib/vars.t b/lib/vars.t
new file mode 100644 (file)
index 0000000..3075f8e
--- /dev/null
+++ b/lib/vars.t
@@ -0,0 +1,105 @@
+#!./perl 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    $ENV{PERL5LIB} = '../lib';
+}
+
+$| = 1;
+
+print "1..27\n";
+
+# catch "used once" warnings
+my @warns;
+BEGIN { $SIG{__WARN__} = sub { push @warns, @_ }; $^W = 1 };
+
+%x = ();
+$y = 3;
+@z = ();
+$X::x = 13;
+
+use vars qw($p @q %r *s &t $X::p);
+
+my $e = !(grep /^Name "X::x" used only once: possible typo/, @warns) && 'not ';
+print "${e}ok 1\n";
+$e = !(grep /^Name "main::x" used only once: possible typo/, @warns) && 'not ';
+print "${e}ok 2\n";
+$e = !(grep /^Name "main::y" used only once: possible typo/, @warns) && 'not ';
+print "${e}ok 3\n";
+$e = !(grep /^Name "main::z" used only once: possible typo/, @warns) && 'not ';
+print "${e}ok 4\n";
+($e, @warns) = @warns != 4 && 'not ';
+print "${e}ok 5\n";
+
+# this is inside eval() to avoid creation of symbol table entries and
+# to avoid "used once" warnings
+eval <<'EOE';
+$e = ! $main::{p} && 'not ';
+print "${e}ok 6\n";
+$e = ! *q{ARRAY} && 'not ';
+print "${e}ok 7\n";
+$e = ! *r{HASH} && 'not ';
+print "${e}ok 8\n";
+$e = ! $main::{s} && 'not ';
+print "${e}ok 9\n";
+$e = ! *t{CODE} && 'not ';
+print "${e}ok 10\n";
+$e = defined $X::{q} && 'not ';
+print "${e}ok 11\n";
+$e = ! $X::{p} && 'not ';
+print "${e}ok 12\n";
+EOE
+$e = $@ && 'not ';
+print "${e}ok 13\n";
+
+eval q{use vars qw(@X::y !abc); $e = ! *X::y{ARRAY} && 'not '};
+print "${e}ok 14\n";
+$e = $@ !~ /^'!abc' is not a valid variable name/ && 'not ';
+print "${e}ok 15\n";
+
+eval 'use vars qw($x[3])';
+$e = $@ !~ /^Can't declare individual elements of hash or array/ && 'not ';
+print "${e}ok 16\n";
+
+{ local $^W;
+  eval 'use vars qw($!)';
+  ($e, @warns) = ($@ || @warns) ? 'not ' : '';
+  print "${e}ok 17\n";
+};
+
+# NB the next test only works because vars.pm has already been loaded
+eval 'use warnings "vars"; use vars qw($!)';
+$e = ($@ || (shift(@warns)||'') !~ /^No need to declare built-in vars/)
+                       && 'not ';
+print "${e}ok 18\n";
+
+no strict 'vars';
+eval 'use vars qw(@x%%)';
+$e = $@ && 'not ';
+print "${e}ok 19\n";
+$e = ! *{'x%%'}{ARRAY} && 'not ';
+print "${e}ok 20\n";
+eval '$u = 3; @v = (); %w = ()';
+$e = $@ && 'not ';
+print "${e}ok 21\n";
+
+use strict 'vars';
+eval 'use vars qw(@y%%)';
+$e = $@ !~ /^'\@y%%' is not a valid variable name under strict vars/ && 'not ';
+print "${e}ok 22\n";
+$e = *{'y%%'}{ARRAY} && 'not ';
+print "${e}ok 23\n";
+eval '$u = 3; @v = (); %w = ()';
+my @errs = split /\n/, $@;
+$e = @errs != 3 && 'not ';
+print "${e}ok 24\n";
+$e = !(grep(/^Global symbol "\$u" requires explicit package name/, @errs))
+                       && 'not ';
+print "${e}ok 25\n";
+$e = !(grep(/^Global symbol "\@v" requires explicit package name/, @errs))
+                       && 'not ';
+print "${e}ok 26\n";
+$e = !(grep(/^Global symbol "\%w" requires explicit package name/, @errs))
+                       && 'not ';
+print "${e}ok 27\n";

diff --git a/lib/warnings/1global b/lib/warnings/1global
new file mode 100644 (file)
index 0000000..0af8022
--- /dev/null
+++ b/lib/warnings/1global
@@ -0,0 +1,189 @@
+Check existing $^W functionality
+
+
+__END__
+
+# warnable code, warnings disabled
+$a =+ 3 ;
+EXPECT
+
+########
+-w
+# warnable code, warnings enabled via command line switch
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 3.
+Name "main::a" used only once: possible typo at - line 3.
+########
+#! perl -w
+# warnable code, warnings enabled via #! line
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 3.
+Name "main::a" used only once: possible typo at - line 3.
+########
+
+# warnable code, warnings enabled via compile time $^W
+BEGIN { $^W = 1 }
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 4.
+Name "main::a" used only once: possible typo at - line 4.
+########
+
+# compile-time warnable code, warnings enabled via runtime $^W
+# so no warning printed.
+$^W = 1 ;
+$a =+ 3 ;
+EXPECT
+
+########
+
+# warnable code, warnings enabled via runtime $^W
+$^W = 1 ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 4.
+########
+
+# warnings enabled at compile time, disabled at run time
+BEGIN { $^W = 1 }
+$^W = 0 ;
+my $b ; chop $b ;
+EXPECT
+
+########
+
+# warnings disabled at compile time, enabled at run time
+BEGIN { $^W = 0 }
+$^W = 1 ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 5.
+########
+-w
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+require "./abcd";
+EXPECT
+Use of uninitialized value in scalar chop at ./abcd line 1.
+########
+
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+#! perl -w
+require "./abcd";
+EXPECT
+Use of uninitialized value in scalar chop at ./abcd line 1.
+########
+
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+$^W =1 ;
+require "./abcd";
+EXPECT
+Use of uninitialized value in scalar chop at ./abcd line 1.
+########
+
+--FILE-- abcd
+$^W = 0;
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+$^W =1 ;
+require "./abcd";
+EXPECT
+
+########
+
+--FILE-- abcd
+$^W = 1;
+1 ;
+--FILE-- 
+$^W =0 ;
+require "./abcd";
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+$^W = 1;
+eval 'my $b ; chop $b ;' ;
+print $@ ;
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 1.
+########
+
+eval '$^W = 1;' ;
+print $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 4.
+########
+
+eval {$^W = 1;} ;
+print $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 4.
+########
+
+{
+    local ($^W) = 1;
+}
+my $b ; chop $b ;
+EXPECT
+
+########
+
+my $a ; chop $a ;
+{
+    local ($^W) = 1;
+    my $b ; chop $b ;
+}
+my $c ; chop $c ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 5.
+########
+-w
+-e undef
+EXPECT
+Use of uninitialized value in -e at - line 2.
+########
+
+$^W = 1 + 2 ;
+EXPECT
+
+########
+
+$^W = $a ;
+EXPECT
+
+########
+
+sub fred {}
+$^W = fred() ;
+EXPECT
+
+########
+
+sub fred { my $b ; chop $b ;}
+{ local $^W = 0 ;
+  fred() ;
+}
+EXPECT
+
+########
+
+sub fred { my $b ; chop $b ;}
+{ local $^W = 1 ;
+  fred() ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 2.

diff --git a/lib/warnings/2use b/lib/warnings/2use
new file mode 100644 (file)
index 0000000..e25d43a
--- /dev/null
+++ b/lib/warnings/2use
@@ -0,0 +1,354 @@
+Check lexical warnings functionality
+
+TODO
+  check that the warning hierarchy works.
+
+__END__
+
+#  check illegal category is caught
+use warnings 'this-should-never-be-a-warning-category' ;
+EXPECT
+unknown warnings category 'this-should-never-be-a-warning-category' at - line 3
+BEGIN failed--compilation aborted at - line 3.
+########
+
+# Check compile time scope of pragma
+use warnings 'syntax' ;
+{
+    no warnings ;
+    my $a =+ 1 ;
+}
+my $a =+ 1 ;
+EXPECT
+Reversed += operator at - line 8.
+########
+
+# Check compile time scope of pragma
+no warnings;
+{
+    use warnings 'syntax' ;
+    my $a =+ 1 ;
+}
+my $a =+ 1 ;
+EXPECT
+Reversed += operator at - line 6.
+########
+
+# Check runtime scope of pragma
+use warnings 'uninitialized' ;
+{
+    no warnings ;
+    my $b ; chop $b ;
+}
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check runtime scope of pragma
+no warnings ;
+{
+    use warnings 'uninitialized' ;
+    my $b ; chop $b ;
+}
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check runtime scope of pragma
+no warnings ;
+{
+    use warnings 'uninitialized' ;
+    $a = sub { my $b ; chop $b ; }
+}
+&$a ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+use warnings 'syntax' ;
+my $a =+ 1 ;
+EXPECT
+Reversed += operator at - line 3.
+########
+
+--FILE-- abc
+my $a =+ 1 ;
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use warnings 'syntax' ;
+1;
+--FILE-- 
+require "./abc";
+my $a =+ 1 ;
+EXPECT
+
+########
+
+--FILE-- abc
+use warnings 'syntax' ;
+my $a =+ 1 ;
+1;
+--FILE-- 
+use warnings 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+Reversed += operator at ./abc line 2.
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+--FILE-- abc.pm
+use warnings 'syntax' ;
+my $a =+ 1 ;
+1;
+--FILE-- 
+use warnings 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+Reversed += operator at abc.pm line 2.
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval {
+        my $b ; chop $b ;
+    }; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval {
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    }; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval {
+        my $b ; chop $b ;
+    }; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 7.
+Use of uninitialized value in scalar chop at - line 9.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval {
+        no warnings ;
+        my $b ; chop $b ;
+    }; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 10.
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval {
+        my $a =+ 1 ;
+    }; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval {
+        use warnings 'syntax' ;
+        my $a =+ 1 ;
+    }; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'syntax' ;
+    eval {
+        my $a =+ 1 ;
+    }; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 7.
+Reversed += operator at - line 9.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'syntax' ;
+    eval {
+        no warnings ;
+        my $a =+ 1 ;
+    }; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 10.
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    ]; print STDERR $@;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 9.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        no warnings ;
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 10.
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+        my $a =+ 1 ;
+    '; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'syntax' ;
+        my $a =+ 1 ;
+    ]; print STDERR $@;
+    my $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'syntax' ;
+    eval '
+        my $a =+ 1 ;
+    '; print STDERR $@;
+    my $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 9.
+Reversed += operator at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'syntax' ;
+    eval '
+        no warnings ;
+        my $a =+ 1 ;
+    '; print STDERR $@;
+    my $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 10.
+########
+
+# Check the additive nature of the pragma
+my $a =+ 1 ;
+my $a ; chop $a ;
+use warnings 'syntax' ;
+$a =+ 1 ;
+my $b ; chop $b ;
+use warnings 'uninitialized' ;
+my $c ; chop $c ;
+no warnings 'syntax' ;
+$a =+ 1 ;
+EXPECT
+Reversed += operator at - line 6.
+Use of uninitialized value in scalar chop at - line 9.

diff --git a/lib/warnings/3both b/lib/warnings/3both
new file mode 100644 (file)
index 0000000..a4d9ba8
--- /dev/null
+++ b/lib/warnings/3both
@@ -0,0 +1,266 @@
+Check interaction of $^W and lexical
+
+__END__
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    use warnings ;
+    my $b ; 
+    chop $b ;
+}
+{ local $^W = 0 ;
+  fred() ;
+}
+
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    use warnings ;
+    my $b ; 
+    chop $b ;
+}
+{ $^W = 0 ;
+  fred() ;
+}
+
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    no warnings ;
+    my $b ; 
+    chop $b ;
+}
+{ local $^W = 1 ;
+  fred() ;
+}
+
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    no warnings ;
+    my $b ; 
+    chop $b ;
+}
+{ $^W = 1 ;
+  fred() ;
+}
+
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+use warnings ;
+$^W = 1 ;
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+$^W = 1 ;
+use warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+$^W = 1 ;
+no warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+no warnings ;
+$^W = 1 ;
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+-w
+# Check interaction of $^W and use warnings
+no warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+-w
+# Check interaction of $^W and use warnings
+use warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 5.
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    use warnings ;
+    my $b ; 
+    chop $b ;
+}
+BEGIN {  $^W = 0 }
+fred() ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    no warnings ;
+    my $b ; 
+    chop $b ;
+}
+BEGIN {  $^W = 1 }
+fred() ;
+
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+use warnings ;
+BEGIN {  $^W = 1 }
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+BEGIN {  $^W = 1 }
+use warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+BEGIN {  $^W = 1 }
+no warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+no warnings ;
+BEGIN {  $^W = 1 }
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+BEGIN {  $^W = 1 }
+{
+    no warnings ;
+    my $b ; 
+    chop $b ;
+}
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 10.
+########
+
+# Check interaction of $^W and use warnings
+BEGIN {  $^W = 0 }
+{
+    use warnings ;
+    my $b ; 
+    chop $b ;
+}
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 7.
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 1 }
+{
+    no warnings ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 1 }
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    ]; print STDERR $@;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 0 }
+{
+    use warnings 'uninitialized' ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 9.
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 0 }
+{
+    use warnings 'uninitialized' ;
+    eval '
+        no warnings ;
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 10.
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 1 }
+{
+    no warnings ;
+    eval '
+        my $a =+ 1 ;
+    '; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+

diff --git a/lib/warnings/4lint b/lib/warnings/4lint
new file mode 100644 (file)
index 0000000..848822d
--- /dev/null
+++ b/lib/warnings/4lint
@@ -0,0 +1,216 @@
+Check lint
+
+__END__
+-W
+# lint: check compile time $^W is zapped
+BEGIN { $^W = 0 ;}
+$a = 1 ;
+$a =+ 1 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+Reversed += operator at - line 5.
+print() on closed filehandle STDIN at - line 6.
+########
+-W
+# lint: check runtime $^W is zapped
+$^W = 0 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+print() on closed filehandle STDIN at - line 4.
+########
+-W
+# lint: check runtime $^W is zapped
+{
+  $^W = 0 ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+print() on closed filehandle STDIN at - line 5.
+########
+-W
+# lint: check "no warnings" is zapped
+no warnings ;
+$a = 1 ;
+$a =+ 1 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+Reversed += operator at - line 5.
+print() on closed filehandle STDIN at - line 6.
+########
+-W
+# lint: check "no warnings" is zapped
+{
+  no warnings ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+print() on closed filehandle STDIN at - line 5.
+########
+-Ww
+# lint: check combination of -w and -W
+{
+  $^W = 0 ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+print() on closed filehandle STDIN at - line 5.
+########
+-W
+--FILE-- abc.pm
+no warnings 'syntax' ;
+my $a = 0;
+$a =+ 1 ;
+1;
+--FILE-- 
+no warnings 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+Reversed += operator at abc.pm line 3.
+Use of uninitialized value in scalar chop at - line 3.
+########
+-W
+--FILE-- abc
+no warnings 'syntax' ;
+my $a = 0;
+$a =+ 1 ;
+1;
+--FILE-- 
+no warnings 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+Reversed += operator at ./abc line 3.
+Use of uninitialized value in scalar chop at - line 3.
+########
+-W
+--FILE-- abc.pm
+BEGIN {$^W = 0}
+my $a = 0 ;
+$a =+ 1 ;
+1;
+--FILE-- 
+$^W = 0 ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+Reversed += operator at abc.pm line 3.
+Use of uninitialized value in scalar chop at - line 3.
+########
+-W
+--FILE-- abc
+BEGIN {$^W = 0}
+my $a = 0 ;
+$a =+ 1 ;
+1;
+--FILE-- 
+$^W = 0 ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+Reversed += operator at ./abc line 3.
+Use of uninitialized value in scalar chop at - line 3.
+########
+-W
+# Check scope of pragma with eval
+{
+    no warnings ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 8.
+########
+-W
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    ]; print STDERR $@;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 3.
+Use of uninitialized value in scalar chop at - line 10.
+########
+-W
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 9.
+########
+-W
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        no warnings ;
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 3.
+Use of uninitialized value in scalar chop at - line 10.
+########
+-W
+# Check scope of pragma with eval
+use warnings;
+{
+    my $a = "1"; my $b = "2";
+    no warnings ;
+    eval q[ 
+        use warnings 'syntax' ;
+        $a =+ 1 ;
+    ]; print STDERR $@;
+    $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 11.
+Reversed += operator at (eval 1) line 3.
+########
+-W
+# Check scope of pragma with eval
+no warnings;
+{
+    my $a = "1"; my $b = "2";
+    use warnings 'syntax' ;
+    eval '
+        $a =+ 1 ;
+    '; print STDERR $@;
+    $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 10.
+Reversed += operator at (eval 1) line 2.
+########
+-W
+# Check scope of pragma with eval
+no warnings;
+{
+    my $a = "1"; my $b = "2";
+    use warnings 'syntax' ;
+    eval '
+        no warnings ;
+        $a =+ 1 ;
+    '; print STDERR $@;
+    $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 11.
+Reversed += operator at (eval 1) line 3.

diff --git a/lib/warnings/5nolint b/lib/warnings/5nolint
new file mode 100644 (file)
index 0000000..56158a2
--- /dev/null
+++ b/lib/warnings/5nolint
@@ -0,0 +1,204 @@
+syntax anti-lint
+
+__END__
+-X
+# nolint: check compile time $^W is zapped
+BEGIN { $^W = 1 ;}
+$a = $b = 1 ;
+$a =+ 1 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+########
+-X
+# nolint: check runtime $^W is zapped
+$^W = 1 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+########
+-X
+# nolint: check runtime $^W is zapped
+{
+  $^W = 1 ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+########
+-X
+# nolint: check "no warnings" is zapped
+use warnings ;
+$a = $b = 1 ;
+$a =+ 1 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+########
+-X
+# nolint: check "no warnings" is zapped
+{
+  use warnings ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+########
+-Xw
+# nolint: check combination of -w and -X
+{
+  $^W = 1 ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+########
+-X
+--FILE-- abc.pm
+use warnings 'syntax' ;
+my $a = 0;
+$a =+ 1 ;
+1;
+--FILE-- 
+use warnings 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+########
+-X
+--FILE-- abc
+use warnings 'syntax' ;
+my $a = 0;
+$a =+ 1 ;
+1;
+--FILE-- 
+use warnings 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+########
+-X
+--FILE-- abc.pm
+BEGIN {$^W = 1}
+my ($a, $b) = (0,0);
+$a =+ 1 ;
+1;
+--FILE-- 
+$^W = 1 ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+########
+-X
+--FILE-- abc
+BEGIN {$^W = 1}
+my ($a, $b) = (0,0);
+$a =+ 1 ;
+1;
+--FILE-- 
+$^W = 1 ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+########
+-X
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    ]; print STDERR $@;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        no warnings ;
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+        my $a =+ 1 ;
+    '; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'syntax' ;
+        my $a =+ 1 ;
+    ]; print STDERR $@;
+    my $a =+ 1 ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'syntax' ;
+    eval '
+        my $a =+ 1 ;
+    '; print STDERR $@;
+    my $a =+ 1 ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'syntax' ;
+    eval '
+        no warnings ;
+        my $a =+ 1 ;
+    '; print STDERR $@;
+    my $a =+ 1 ;
+}
+EXPECT
+

diff --git a/lib/warnings/6default b/lib/warnings/6default
new file mode 100644 (file)
index 0000000..a8aafee
--- /dev/null
+++ b/lib/warnings/6default
@@ -0,0 +1,121 @@
+Check default warnings
+
+__END__
+# default warnings should be displayed if you don't add anything
+# optional shouldn't
+my $a = oct "7777777777777777777777777777777777779" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+########
+# no warnings should be displayed 
+no warnings ;
+my $a = oct "7777777777777777777777777777777777778" ;
+EXPECT
+########
+# all warnings should be displayed 
+use warnings ;
+my $a = oct "7777777777777777777777777777777777778" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+Illegal octal digit '8' ignored at - line 3.
+Octal number > 037777777777 non-portable at - line 3.
+########
+# check scope
+use warnings ;
+my $a = oct "7777777777777777777777777777777777778" ;
+{
+    no warnings ;
+    my $a = oct "7777777777777777777777777777777777778" ;
+}    
+my $c = oct "7777777777777777777777777777777777778" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+Illegal octal digit '8' ignored at - line 3.
+Octal number > 037777777777 non-portable at - line 3.
+Integer overflow in octal number at - line 8.
+Illegal octal digit '8' ignored at - line 8.
+Octal number > 037777777777 non-portable at - line 8.
+########
+# all warnings should be displayed 
+use warnings ;
+my $a = oct "0xfffffffffffffffffg" ;
+EXPECT
+Integer overflow in hexadecimal number at - line 3.
+Illegal hexadecimal digit 'g' ignored at - line 3.
+Hexadecimal number > 0xffffffff non-portable at - line 3.
+########
+# all warnings should be displayed 
+use warnings ;
+my $a = oct "0b111111111111111111111111111111111111111111111111111111111111111112";
+EXPECT
+Integer overflow in binary number at - line 3.
+Illegal binary digit '2' ignored at - line 3.
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 3.
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+       my $a = oct "0xfffffffffffffffffg" ;
+    '; print STDERR $@ ;
+    my $a = oct "0xfffffffffffffffffg" ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings ;
+       my $a = oct "0xfffffffffffffffffg" ;
+    ]; print STDERR $@;
+    my $a = oct "0xfffffffffffffffffg" ;
+}
+EXPECT
+Integer overflow in hexadecimal number at (eval 1) line 3.
+Illegal hexadecimal digit 'g' ignored at (eval 1) line 3.
+Hexadecimal number > 0xffffffff non-portable at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings ;
+    eval '
+       my $a = oct "0xfffffffffffffffffg" ;
+    '; print STDERR $@ ;
+}
+EXPECT
+Integer overflow in hexadecimal number at (eval 1) line 2.
+Illegal hexadecimal digit 'g' ignored at (eval 1) line 2.
+Hexadecimal number > 0xffffffff non-portable at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings;
+    eval '
+        no warnings ;
+       my $a = oct "0xfffffffffffffffffg" ;
+    '; print STDERR $@ ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'deprecated' ;
+    eval '
+       my $a = oct "0xfffffffffffffffffg" ;
+    '; print STDERR $@;
+}
+EXPECT
+

diff --git a/lib/warnings/7fatal b/lib/warnings/7fatal
new file mode 100644 (file)
index 0000000..a25fa2c
--- /dev/null
+++ b/lib/warnings/7fatal
@@ -0,0 +1,312 @@
+Check FATAL functionality
+
+__END__
+
+# Check compile time warning
+use warnings FATAL => 'syntax' ;
+{
+    no warnings ;
+    $a =+ 1 ;
+}
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at - line 8.
+########
+
+# Check compile time warning
+use warnings FATAL => 'all' ;
+{
+    no warnings ;
+    my $a =+ 1 ;
+}
+my $a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at - line 8.
+########
+
+# Check runtime scope of pragma
+use warnings FATAL => 'uninitialized' ;
+{
+    no warnings ;
+    my $b ; chop $b ;
+}
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check runtime scope of pragma
+use warnings FATAL => 'all' ;
+{
+    no warnings ;
+    my $b ; chop $b ;
+}
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check runtime scope of pragma
+no warnings ;
+{
+    use warnings FATAL => 'uninitialized' ;
+    $a = sub { my $b ; chop $b ; }
+}
+&$a ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check runtime scope of pragma
+no warnings ;
+{
+    use warnings FATAL => 'all' ;
+    $a = sub { my $b ; chop $b ; }
+}
+&$a ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+--FILE-- abc
+$a =+ 1 ;
+1;
+--FILE-- 
+use warnings FATAL => 'syntax' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use warnings FATAL => 'syntax' ;
+1;
+--FILE-- 
+require "./abc";
+$a =+ 1 ;
+EXPECT
+
+########
+
+--FILE-- abc
+use warnings 'syntax' ;
+$a =+ 1 ;
+1;
+--FILE-- 
+use warnings FATAL => 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at ./abc line 2.
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+--FILE-- abc.pm
+use warnings 'syntax' ;
+$a =+ 1 ;
+1;
+--FILE-- 
+use warnings FATAL => 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at abc.pm line 2.
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    use warnings FATAL => 'uninitialized' ;
+    my $b ; chop $b ;
+}; print STDERR "-- $@" ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of uninitialized value in scalar chop at - line 6.
+The End.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'uninitialized' ;
+eval {
+    my $b ; chop $b ;
+}; print STDERR "-- $@" ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of uninitialized value in scalar chop at - line 5.
+Use of uninitialized value in scalar chop at - line 7.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'uninitialized' ;
+eval {
+    no warnings ;
+    my $b ; chop $b ;
+}; print STDERR $@ ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    use warnings FATAL => 'syntax' ;
+    $a =+ 1 ;
+}; print STDERR "-- $@" ;
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at - line 6.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'syntax' ;
+eval {
+    $a =+ 1 ;
+}; print STDERR "-- $@" ;
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at - line 5.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'syntax' ;
+eval {
+    no warnings ;
+    $a =+ 1 ;
+}; print STDERR $@ ;
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    use warnings FATAL => 'syntax' ;
+}; print STDERR $@ ;
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+The End.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval q[ 
+    use warnings FATAL => 'uninitialized' ;
+    my $b ; chop $b ;
+]; print STDERR "-- $@";
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of uninitialized value in scalar chop at (eval 1) line 3.
+The End.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'uninitialized' ;
+eval '
+    my $b ; chop $b ;
+'; print STDERR "-- $@" ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 7.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'uninitialized' ;
+eval '
+    no warnings ;
+    my $b ; chop $b ;
+'; print STDERR $@ ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval q[ 
+    use warnings FATAL => 'syntax' ;
+    $a =+ 1 ;
+]; print STDERR "-- $@";
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Reversed += operator at (eval 1) line 3.
+The End.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'syntax' ;
+eval '
+    $a =+ 1 ;
+'; print STDERR "-- $@";
+print STDERR "The End.\n" ;
+EXPECT
+-- Reversed += operator at (eval 1) line 2.
+The End.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'syntax' ;
+eval '
+    no warnings ;
+    $a =+ 1 ;
+'; print STDERR "-- $@";
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at - line 8.
+########
+
+use warnings 'void' ;
+
+time ;
+
+{
+    use warnings FATAL => qw(void) ;
+    length "abc" ;
+}
+
+join "", 1,2,3 ;
+
+print "done\n" ;
+EXPECT
+Useless use of time in void context at - line 4.
+Useless use of length in void context at - line 8.
+########
+
+use warnings ;
+
+time ;
+
+{
+    use warnings FATAL => qw(void) ;
+    length "abc" ;
+}
+
+join "", 1,2,3 ;
+
+print "done\n" ;
+EXPECT
+Useless use of time in void context at - line 4.
+Useless use of length in void context at - line 8.

diff --git a/lib/warnings/8signal b/lib/warnings/8signal
new file mode 100644 (file)
index 0000000..cc1b9d9
--- /dev/null
+++ b/lib/warnings/8signal
@@ -0,0 +1,18 @@
+Check interaction of __WARN__, __DIE__ & lexical Warnings
+
+TODO
+
+__END__
+# 8signal
+BEGIN { $| = 1; $SIG{__WARN__} = sub { print "WARN -- @_" } }
+BEGIN { $SIG{__DIE__}  = sub { print "DIE -- @_" } }
+$a =+ 1 ;
+use warnings qw(syntax) ;
+$a =+ 1 ;
+use warnings FATAL => qw(syntax) ;
+$a =+ 1 ;
+print "The End.\n" ;
+EXPECT
+WARN -- Reversed += operator at - line 6.
+DIE -- Reversed += operator at - line 8.
+Reversed += operator at - line 8.

diff --git a/lib/warnings/9enabled b/lib/warnings/9enabled
new file mode 100755 (executable)
index 0000000..f5579b2
--- /dev/null
+++ b/lib/warnings/9enabled
@@ -0,0 +1,1162 @@
+Check warnings::enabled & warnings::warn
+
+__END__
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if ! warnings::enabled('all') ;
+print "ok2\n" if ! warnings::enabled("io") ;
+1;
+--FILE-- 
+no warnings;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+print "ok1\n" if !warnings::enabled('all') ;
+print "ok2\n" if warnings::enabled("syntax") ;
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'syntax' ;
+print "ok1\n" if   warnings::enabled('io') ;
+print "ok2\n" if ! warnings::enabled("syntax") ;
+1;
+--FILE-- 
+use warnings 'io' ;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+no warnings ;
+print "ok1\n" if !warnings::enabled('all') ;
+print "ok2\n" if warnings::enabled("syntax") ;
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+use warnings 'syntax' ;
+print "ok1\n" if ! warnings::enabled('all') ;
+print "ok2\n" if ! warnings::enabled("syntax") ;
+print "ok3\n" if   warnings::enabled("io") ;
+1;
+--FILE-- 
+use warnings 'io' ;
+require "abc" ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if   warnings::enabled("syntax") ;
+  print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc
+package abc ;
+no warnings ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if   warnings::enabled("syntax") ;
+  print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if ! warnings::enabled('all') ;
+print "ok2\n" if ! warnings::enabled("io") ;
+1;
+--FILE-- def.pm
+no warnings;
+use abc ;
+1;
+--FILE-- 
+use warnings;
+use def ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+print "ok1\n" if ! warnings::enabled('all') ;
+print "ok2\n" if warnings::enabled("syntax") ;
+print "ok3\n" if !warnings::enabled("io") ;
+1;
+--FILE-- def.pm
+use warnings 'syntax' ;
+print "ok4\n" if !warnings::enabled('all') ;
+print "ok5\n" if warnings::enabled("io") ;
+use abc ;
+1;
+--FILE--
+use warnings 'io' ;
+use def ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+ok5
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+eval { abc::check() ; };
+print $@ ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if   warnings::enabled("syntax") ;
+  print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+eval { abc::check() ; } ;
+print $@ ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc
+package abc ;
+no warnings ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+eval { abc::check() ; } ;
+print $@ ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+  print "ok3\n" if warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+eval { use warnings 'io' ; abc::check() ; };
+abc::check() ; 
+print $@ ;
+EXPECT
+ok1
+ok2
+ok3
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if  ! warnings::enabled('all') ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { no warnings ; abc::check() }
+fred() ;
+EXPECT
+ok1
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check {
+  print "ok1\n" if  ! warnings::enabled('all') ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if  warnings::enabled("io") ;
+  print "ok4\n" if  ! warnings::enabled("misc") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { use warnings 'io'  ; abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+########
+
+# check warnings::warn
+use warnings ;
+eval { warnings::warn() } ;
+print $@ ;
+eval { warnings::warn("fred", "joe") } ;
+print $@ ;
+EXPECT
+Usage: warnings::warn([category,] 'message') at - line 4
+unknown warnings category 'fred' at - line 6
+########
+
+# check warnings::warnif
+use warnings ;
+eval { warnings::warnif() } ;
+print $@ ;
+eval { warnings::warnif("fred", "joe") } ;
+print $@ ;
+EXPECT
+Usage: warnings::warnif([category,] 'message') at - line 4
+unknown warnings category 'fred' at - line 6
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("io", "hello") }
+1;
+--FILE--
+use warnings "io" ;
+use abc;
+abc::check() ;
+EXPECT
+hello at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("misc", "hello") }
+1;
+--FILE--
+use warnings "io" ;
+use abc;
+abc::check() ;
+EXPECT
+hello at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("io", "hello") }
+1;
+--FILE--
+use warnings qw( FATAL deprecated ) ;
+use abc;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+hello at - line 3
+       eval {...} called at - line 3
+[[]]
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("io", "hello") }
+1;
+--FILE--
+use warnings qw( FATAL io ) ;
+use abc;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+[[hello at - line 3
+       eval {...} called at - line 3
+]]
+########
+-W
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if warnings::enabled("io") ;
+print "ok2\n" if warnings::enabled("all") ;
+1;
+--FILE-- 
+no warnings;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+-X
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if !warnings::enabled("io") ;
+print "ok2\n" if !warnings::enabled("all") ;
+1;
+--FILE-- 
+use warnings;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  print "ok\n" if ! warnings::enabled() ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+package 'abc' not registered for warnings at abc.pm line 4
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  warnings::warn("fred") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+package 'abc' not registered for warnings at abc.pm line 4
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  warnings::warnif("fred") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+package 'abc' not registered for warnings at abc.pm line 4
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if  warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if !warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if warnings::enabled ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+eval { abc::check() ; };
+print $@ ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if !warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+eval { abc::check() ; } ;
+print $@ ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if  warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+sub fred { abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if  ! warnings::enabled ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { no warnings ; abc::check() }
+fred() ;
+EXPECT
+ok1
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+use warnings::register;
+sub check {
+  print "ok1\n" if  warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if  warnings::enabled("io") ;
+  print "ok4\n" if  ! warnings::enabled("misc") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+sub fred { use warnings 'io'  ; abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+use warnings::register;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+use warnings "abc" ;
+abc::check() ;
+EXPECT
+hello at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings::register;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+abc::check() ;
+EXPECT
+hello at - line 2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings::register ;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+use warnings qw( FATAL deprecated ) ;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+hello at - line 3
+       eval {...} called at - line 3
+[[]]
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings::register ;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+use warnings qw( FATAL abc ) ;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+[[hello at - line 3
+       eval {...} called at - line 3
+]]
+########
+-W
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if warnings::enabled() ;
+  print "ok2\n" if warnings::enabled("io") ;
+  print "ok3\n" if warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+no warnings;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+-X
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+no warnings;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if warnings::enabled() ;
+  print "ok2\n" if warnings::enabled("io") ;
+  print "ok3\n" if warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use warnings 'all';
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+no warnings ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+  warnings::warnif("my message 1") ;
+  warnings::warnif('abc', "my message 2") ;
+  warnings::warnif('io', "my message 3") ;
+  warnings::warnif('all', "my message 4") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "abc self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
+  print "abc def"  . (warnings::enabled('def') ? "" : " not") . " enabled\n" ;
+  print "abc all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
+}
+1;
+--FILE-- def.pm
+package def ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "def self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
+  print "def abc"  . (warnings::enabled('abc') ? "" : " not") . " enabled\n" ;
+  print "def all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
+}
+1;
+--FILE-- 
+use abc ;
+use def ;
+use warnings 'abc';
+abc::check() ;
+def::check() ;
+no warnings 'abc'  ;
+use warnings 'def'  ;
+abc::check() ;
+def::check() ;
+use warnings 'abc'  ;
+use warnings 'def'  ;
+abc::check() ;
+def::check() ;
+no warnings 'abc'  ;
+no warnings 'def'  ;
+abc::check() ;
+def::check() ;
+use warnings;
+abc::check() ;
+def::check() ;
+no warnings 'abc' ;
+abc::check() ;
+def::check() ;
+EXPECT
+abc self enabled
+abc def not enabled
+abc all not enabled
+def self not enabled
+def abc enabled
+def all not enabled
+abc self not enabled
+abc def enabled
+abc all not enabled
+def self enabled
+def abc not enabled
+def all not enabled
+abc self enabled
+abc def enabled
+abc all not enabled
+def self enabled
+def abc enabled
+def all not enabled
+abc self not enabled
+abc def not enabled
+abc all not enabled
+def self not enabled
+def abc not enabled
+def all not enabled
+abc self enabled
+abc def enabled
+abc all enabled
+def self enabled
+def abc enabled
+def all enabled
+abc self not enabled
+abc def enabled
+abc all not enabled
+def self enabled
+def abc not enabled
+def all not enabled
+########
+-w
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if warnings::enabled() ;
+  print "ok2\n" if warnings::enabled("io") ;
+  print "ok3\n" if warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+-w
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+  warnings::warnif("my message 1") ;
+  warnings::warnif('abc', "my message 2") ;
+  warnings::warnif('io', "my message 3") ;
+  warnings::warnif('all', "my message 4") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+BEGIN { $^W = 1 ; }
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+$^W = 1 ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+$| = 1;
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if  warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+  print "ok4\n" if  warnings::enabled("abc") ;
+  warnings::warn("my message 1") ;
+  warnings::warnif("my message 2") ;
+  warnings::warnif('abc', "my message 3") ;
+  warnings::warnif('io', "my message 4") ;
+  warnings::warnif('all', "my message 5") ;
+}
+sub in2 { no warnings ; check() }
+sub in1 { no warnings ; in2() }
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+abc::in1() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+my message 1 at - line 3
+my message 2 at - line 3
+my message 3 at - line 3
+########
+
+--FILE-- def.pm
+package def ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if  warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+  print "ok4\n" if  warnings::enabled("def") ;
+  warnings::warn("my message 1") ;
+  warnings::warnif("my message 2") ;
+  warnings::warnif('def', "my message 3") ;
+  warnings::warnif('io', "my message 4") ;
+  warnings::warnif('all', "my message 5") ;
+}
+sub in2 { no warnings ; check() }
+sub in1 { no warnings ; in2() }
+1;
+--FILE-- abc.pm
+$| = 1;
+package abc ;
+use def ;
+use warnings 'def';
+sub in1 { def::in1() ; }
+1;
+--FILE-- 
+use abc ;
+no warnings;
+abc::in1() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+my message 1 at abc.pm line 5
+       abc::in1() called at - line 3
+my message 2 at abc.pm line 5
+       abc::in1() called at - line 3
+my message 3 at abc.pm line 5
+       abc::in1() called at - line 3
+########
+
+--FILE-- def.pm
+$| = 1;
+package def ;
+no warnings ;
+use warnings::register ;
+require Exporter;
+@ISA = qw( Exporter ) ;
+@EXPORT = qw( in1 ) ;
+sub check { 
+  print "ok1\n" if  warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+  print "ok4\n" if  warnings::enabled("abc") ;
+  print "ok5\n" if !warnings::enabled("def") ;
+  warnings::warn("my message 1") ;
+  warnings::warnif("my message 2") ;
+  warnings::warnif('abc', "my message 3") ;
+  warnings::warnif('def', "my message 4") ;
+  warnings::warnif('io', "my message 5") ;
+  warnings::warnif('all', "my message 6") ;
+}
+sub in2 { no warnings ; check() }
+sub in1 { no warnings ; in2() }
+1;
+--FILE-- abc.pm
+package abc ;
+use warnings::register ;
+use def ;
+#@ISA = qw(def) ;
+1;
+--FILE-- 
+use abc ;
+no warnings;
+use warnings 'abc';
+abc::in1() ;
+EXPECT
+ok2
+ok3
+ok4
+ok5
+my message 1 at - line 4
+my message 3 at - line 4
+########
+
+--FILE-- def.pm
+package def ;
+no warnings ;
+use warnings::register ;
+
+sub new
+{
+    my $class = shift ;
+    bless [], $class ;
+}
+
+sub check 
+{ 
+  my $self = shift ;
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+  print "ok4\n" if  warnings::enabled("abc") ;
+  print "ok5\n" if !warnings::enabled("def") ;
+  print "ok6\n" if  warnings::enabled($self) ;
+
+  warnings::warn("my message 1") ;
+  warnings::warn($self, "my message 2") ;
+
+  warnings::warnif("my message 3") ;
+  warnings::warnif('abc', "my message 4") ;
+  warnings::warnif('def', "my message 5") ;
+  warnings::warnif('io', "my message 6") ;
+  warnings::warnif('all', "my message 7") ;
+  warnings::warnif($self, "my message 8") ;
+}
+sub in2 
+{
+  no warnings ; 
+  my $self = shift ;
+  $self->check() ;
+}
+sub in1 
+{ 
+  no warnings ;
+  my $self = shift ;
+  $self->in2();
+}
+1;
+--FILE-- abc.pm
+$| = 1;
+package abc ;
+use warnings::register ;
+use def ;
+@ISA = qw(def) ;
+sub new
+{
+    my $class = shift ;
+    bless [], $class ;
+}
+
+1;
+--FILE-- 
+use abc ;
+no warnings;
+use warnings 'abc';
+$a = new abc ;
+$a->in1() ;
+print "**\n";
+$b = new def ;
+$b->in1() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+ok5
+ok6
+my message 1 at - line 5
+my message 2 at - line 5
+my message 4 at - line 5
+my message 8 at - line 5
+**
+ok1
+ok2
+ok3
+ok4
+ok5
+my message 1 at - line 8
+my message 2 at - line 8
+my message 4 at - line 8

diff --git a/lib/warnings/av b/lib/warnings/av
new file mode 100644 (file)
index 0000000..79bd3b7
--- /dev/null
+++ b/lib/warnings/av
@@ -0,0 +1,9 @@
+  av.c 
+
+  Mandatory Warnings ALL TODO
+  ------------------
+  av_reify called on tied array                [av_reify]
+
+  Attempt to clear deleted array       [av_clear]
+  
+__END__

diff --git a/lib/warnings/doio b/lib/warnings/doio
new file mode 100644 (file)
index 0000000..2a357e2
--- /dev/null
+++ b/lib/warnings/doio
@@ -0,0 +1,209 @@
+  doio.c       
+
+  Can't open bidirectional pipe                [Perl_do_open9]
+    open(F, "| true |");
+
+  Missing command in piped open                [Perl_do_open9]
+    open(F, "| ");
+
+  Missing command in piped open                [Perl_do_open9]
+    open(F, " |");
+
+  warn(warn_nl, "open");               [Perl_do_open9]
+    open(F, "true\ncd")
+
+  close() on unopened filehandle %s    [Perl_do_close]
+    $a = "fred";close("$a")
+
+  tell() on closed filehandle          [Perl_do_tell]
+    $a = "fred";$a = tell($a)
+
+  seek() on closed filehandle          [Perl_do_seek]
+    $a = "fred";$a = seek($a,1,1)
+
+  sysseek() on closed filehandle       [Perl_do_sysseek]
+    $a = "fred";$a = seek($a,1,1)
+
+  warn(warn_uninit);                   [Perl_do_print]
+    print $a ;
+
+  -x on closed filehandle %s           [Perl_my_stat]
+    close STDIN ; -x STDIN ;
+
+  warn(warn_nl, "stat");               [Perl_my_stat]
+    stat "ab\ncd"
+
+  warn(warn_nl, "lstat");              [Perl_my_lstat]
+    lstat "ab\ncd"
+
+  Can't exec \"%s\": %s                [Perl_do_aexec5]
+
+  Can't exec \"%s\": %s                [Perl_do_exec3]
+
+  Filehandle %s opened only for output [Perl_do_eof]
+       my $a = eof STDOUT
+
+  Mandatory Warnings ALL TODO
+  ------------------
+  Can't do inplace edit: %s is not a regular file      [Perl_nextargv]
+     edit a directory
+
+  Can't do inplace edit: %s would not be unique                [Perl_nextargv]
+  Can't rename %s to %s: %s, skipping file             [Perl_nextargv]
+  Can't rename %s to %s: %s, skipping file             [Perl_nextargv]
+  Can't remove %s: %s, skipping file                   [Perl_nextargv]
+  Can't do inplace edit on %s: %s                      [Perl_nextargv]
+  
+
+__END__
+# doio.c [Perl_do_open9]
+use warnings 'io' ;
+open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
+close(F);
+no warnings 'io' ;
+open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
+close(G);
+EXPECT
+Can't open bidirectional pipe at - line 3.
+########
+# doio.c [Perl_do_open9]
+use warnings 'io' ;
+open(F, "|      ");
+no warnings 'io' ;
+open(G, "|      ");
+EXPECT
+Missing command in piped open at - line 3.
+########
+# doio.c [Perl_do_open9]
+use warnings 'io' ;
+open(F, "      |");
+no warnings 'io' ;
+open(G, "      |");
+EXPECT
+Missing command in piped open at - line 3.
+########
+# doio.c [Perl_do_open9]
+use warnings 'io' ;
+open(F, "<true\ncd");
+no warnings 'io' ;
+open(G, "<true\ncd");
+EXPECT
+Unsuccessful open on filename containing newline at - line 3.
+########
+# doio.c [Perl_do_close] <<TODO
+use warnings 'unopened' ;
+close "fred" ;
+no warnings 'unopened' ;
+close "joe" ;
+EXPECT
+close() on unopened filehandle fred at - line 3.
+########
+# doio.c [Perl_do_tell Perl_do_seek Perl_do_sysseek Perl_my_stat]
+use warnings 'io' ;
+close STDIN ;
+tell(STDIN);
+$a = seek(STDIN,1,1);
+$a = sysseek(STDIN,1,1);
+-x STDIN ;
+stat(STDIN) ;
+$a = "fred";
+tell($a);
+seek($a,1,1);
+sysseek($a,1,1);
+-x $a; # ok
+stat($a); # ok
+no warnings 'io' ;
+close STDIN ;
+tell(STDIN);
+$a = seek(STDIN,1,1);
+$a = sysseek(STDIN,1,1);
+-x STDIN ;
+stat(STDIN) ;
+$a = "fred";
+tell($a);
+seek($a,1,1);
+sysseek($a,1,1);
+-x $a;
+stat($a);
+EXPECT
+tell() on closed filehandle STDIN at - line 4.
+seek() on closed filehandle STDIN at - line 5.
+sysseek() on closed filehandle STDIN at - line 6.
+-x on closed filehandle STDIN at - line 7.
+stat() on closed filehandle STDIN at - line 8.
+tell() on unopened filehandle at - line 10.
+seek() on unopened filehandle at - line 11.
+sysseek() on unopened filehandle at - line 12.
+########
+# doio.c [Perl_do_print]
+use warnings 'uninitialized' ;
+print $a ;
+no warnings 'uninitialized' ;
+print $b ;
+EXPECT
+Use of uninitialized value in print at - line 3.
+########
+# doio.c [Perl_my_stat Perl_my_lstat]
+use warnings 'io' ;
+stat "ab\ncd";
+lstat "ab\ncd";
+no warnings 'io' ;
+stat "ab\ncd";
+lstat "ab\ncd";
+EXPECT
+Unsuccessful stat on filename containing newline at - line 3.
+Unsuccessful stat on filename containing newline at - line 4.
+########
+# doio.c [Perl_do_aexec5]
+use warnings 'io' ;
+exec "lskdjfalksdjfdjfkls","" ;
+no warnings 'io' ;
+exec "lskdjfalksdjfdjfkls","" ;
+EXPECT
+OPTION regex
+Can't exec "lskdjfalksdjfdjfkls": .+
+########
+# doio.c [Perl_do_exec3]
+use warnings 'io' ;
+exec "lskdjfalksdjfdjfkls", "abc" ;
+no warnings 'io' ;
+exec "lskdjfalksdjfdjfkls", "abc" ;
+EXPECT
+OPTION regex
+Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+
+########
+# doio.c [Perl_nextargv]
+$^W = 0 ;
+my $filename = "./temp.dir" ;
+mkdir $filename, 0777 
+  or die "Cannot create directory $filename: $!\n" ;
+{
+    local (@ARGV) = ($filename) ;
+    local ($^I) = "" ;
+    my $x = <> ;
+}
+{
+    no warnings 'inplace' ;
+    local (@ARGV) = ($filename) ;
+    local ($^I) = "" ;
+    my $x = <> ;
+}
+{
+    use warnings 'inplace' ;
+    local (@ARGV) = ($filename) ;
+    local ($^I) = "" ;
+    my $x = <> ;
+}
+rmdir $filename ;
+EXPECT
+Can't do inplace edit: ./temp.dir is not a regular file at - line 9.
+Can't do inplace edit: ./temp.dir is not a regular file at - line 21.
+
+########
+# doio.c [Perl_do_eof]
+use warnings 'io' ;
+my $a = eof STDOUT ;
+no warnings 'io' ;
+$a = eof STDOUT ;
+EXPECT
+Filehandle STDOUT opened only for output at - line 3.

diff --git a/lib/warnings/doop b/lib/warnings/doop
new file mode 100644 (file)
index 0000000..5803b44
--- /dev/null
+++ b/lib/warnings/doop
@@ -0,0 +1,6 @@
+# doop.c
+use utf8 ;
+$_ = "\x80  \xff" ;
+chop ;
+EXPECT
+########

diff --git a/lib/warnings/gv b/lib/warnings/gv
new file mode 100644 (file)
index 0000000..5ed4eca
--- /dev/null
+++ b/lib/warnings/gv
@@ -0,0 +1,54 @@
+  gv.c AOK
+
+     Can't locate package %s for @%s::ISA
+       @ISA = qw(Fred); joe()
+
+     Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated
+       sub Other::AUTOLOAD { 1 } sub Other::fred {}
+       @ISA = qw(Other) ;
+       fred() ;
+
+     Use of $# is deprecated
+     Use of $* is deprecated
+
+       $a = ${"#"} ;
+       $a = ${"*"} ;
+
+  Mandatory Warnings ALL TODO
+  ------------------
+
+    Had to create %s unexpectedly              [gv_fetchpv]
+    Attempt to free unreferenced glob pointers [gp_free]
+    
+__END__
+# gv.c
+use warnings 'misc' ;
+@ISA = qw(Fred); joe()
+EXPECT
+Can't locate package Fred for @main::ISA at - line 3.
+Undefined subroutine &main::joe called at - line 3.
+########
+# gv.c
+no warnings 'misc' ;
+@ISA = qw(Fred); joe()
+EXPECT
+Undefined subroutine &main::joe called at - line 3.
+########
+# gv.c
+sub Other::AUTOLOAD { 1 } sub Other::fred {}
+@ISA = qw(Other) ;
+use warnings 'deprecated' ;
+fred() ;
+EXPECT
+Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5.
+########
+# gv.c
+use warnings 'deprecated' ;
+$a = ${"#"};
+$a = ${"*"};
+no warnings 'deprecated' ;
+$a = ${"#"};
+$a = ${"*"};
+EXPECT
+Use of $# is deprecated at - line 3.
+Use of $* is deprecated at - line 4.

diff --git a/lib/warnings/hv b/lib/warnings/hv
new file mode 100644 (file)
index 0000000..c9eec02
--- /dev/null
+++ b/lib/warnings/hv
@@ -0,0 +1,8 @@
+  hv.c 
+
+
+  Mandatory Warnings ALL TODO
+  ------------------
+    Attempt to free non-existent shared string [unsharepvn]
+
+__END__

diff --git a/lib/warnings/malloc b/lib/warnings/malloc
new file mode 100644 (file)
index 0000000..2f8b096
--- /dev/null
+++ b/lib/warnings/malloc
@@ -0,0 +1,9 @@
+  malloc.c 
+
+
+  Mandatory Warnings ALL TODO
+  ------------------
+    %s free() ignored          [Perl_mfree]
+    %s", "Bad free() ignored   [Perl_mfree]
+
+__END__

diff --git a/lib/warnings/mg b/lib/warnings/mg
new file mode 100644 (file)
index 0000000..f224335
--- /dev/null
+++ b/lib/warnings/mg
@@ -0,0 +1,44 @@
+  mg.c AOK
+
+  No such signal: SIG%s
+    $SIG{FRED} = sub {}
+
+  SIG%s handler \"%s\" not defined.
+    $SIG{"INT"} = "ok3"; kill "INT",$$;
+
+  Mandatory Warnings TODO
+  ------------------
+  Can't break at that line     [magic_setdbline]
+
+__END__
+# mg.c
+use warnings 'signal' ;
+$SIG{FRED} = sub {};
+EXPECT
+No such signal: SIGFRED at - line 3.
+########
+# mg.c
+no warnings 'signal' ;
+$SIG{FRED} = sub {};
+EXPECT
+
+########
+# mg.c
+use warnings 'signal' ;
+if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
+    print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
+}
+$|=1;
+$SIG{"INT"} = "fred"; kill "INT",$$;
+EXPECT
+SIGINT handler "fred" not defined.
+########
+# mg.c
+no warnings 'signal' ;
+if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
+    print "SKIPPED\n# win32, can't kill() to raise()\n"; exit;
+}
+$|=1;
+$SIG{"INT"} = "fred"; kill "INT",$$;
+EXPECT
+

diff --git a/lib/warnings/op b/lib/warnings/op
new file mode 100644 (file)
index 0000000..2f847ad
--- /dev/null
+++ b/lib/warnings/op
@@ -0,0 +1,928 @@
+  op.c         AOK
+
+     "my" variable %s masks earlier declaration in same scope
+       my $x;
+       my $x ;
+
+     Variable "%s" may be unavailable 
+       sub x {
+           my $x;
+           sub y {
+               $x
+           }
+       }
+
+     Variable "%s" will not stay shared 
+       sub x {
+           my $x;
+           sub y {
+               sub { $x }
+           }
+       }
+
+     Found = in conditional, should be ==
+       1 if $a = 1 ;
+
+     Use of implicit split to @_ is deprecated
+       split ;
+
+     Use of implicit split to @_ is deprecated
+       $a = split ;
+
+     Useless use of time in void context
+     Useless use of a variable in void context
+     Useless use of a constant in void context
+       time ;
+       $a ;
+       "abc"
+
+     Applying %s to %s will act on scalar(%s)
+       my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+       @a =~ /abc/ ;
+       @a =~ s/a/b/ ;
+       @a =~ tr/a/b/ ;
+       @$b =~ /abc/ ;
+       @$b =~ s/a/b/ ;
+       @$b =~ tr/a/b/ ;
+       %a =~ /abc/ ;
+       %a =~ s/a/b/ ;
+       %a =~ tr/a/b/ ;
+       %$c =~ /abc/ ;
+       %$c =~ s/a/b/ ;
+       %$c =~ tr/a/b/ ;
+
+
+     Parentheses missing around "my" list at -e line 1.
+       my $a, $b = (1,2);
+ 
+     Parentheses missing around "local" list at -e line 1.
+       local $a, $b = (1,2);
+ 
+     Bareword found in conditional at -e line 1.
+       use warnings 'bareword'; my $x = print(ABC || 1);
+ 
+     Value of %s may be \"0\"; use \"defined\" 
+       $x = 1 if $x = <FH> ;
+       $x = 1 while $x = <FH> ;
+
+     Subroutine fred redefined at -e line 1.
+       sub fred{1;} sub fred{1;}
+ 
+     Constant subroutine %s redefined 
+        sub fred() {1;} sub fred() {1;}
+ 
+     Format FRED redefined at /tmp/x line 5.
+       format FRED =
+       .
+       format FRED =
+       .
+ 
+     Array @%s missing the @ in argument %d of %s() 
+       push fred ;
+ 
+     Hash %%%s missing the %% in argument %d of %s() 
+       keys joe ;
+ 
+     Statement unlikely to be reached
+       (Maybe you meant system() when you said exec()?
+       exec "true" ; my $a
+
+     defined(@array) is deprecated
+       (Maybe you should just omit the defined()?)
+       my @a ; defined @a ;
+       defined (@a = (1,2,3)) ;
+
+     defined(%hash) is deprecated
+       (Maybe you should just omit the defined()?)
+       my %h ; defined %h ;
+    
+     /---/ should probably be written as "---"
+        join(/---/, @foo);
+
+    %s() called too early to check prototype           [Perl_peep]
+        fred() ; sub fred ($$) {}
+
+
+    Mandatory Warnings 
+    ------------------
+    Prototype mismatch:                [cv_ckproto]
+        sub fred() ;
+        sub fred($) {}
+
+    %s never introduced                [pad_leavemy]   TODO
+    Runaway prototype          [newSUB]        TODO
+    oops: oopsAV               [oopsAV]        TODO
+    oops: oopsHV               [oopsHV]        TODO
+    
+
+__END__
+# op.c
+use warnings 'misc' ;
+my $x ;
+my $x ;
+no warnings 'misc' ;
+my $x ;
+EXPECT
+"my" variable $x masks earlier declaration in same scope at - line 4.
+########
+# op.c
+use warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         $x
+      }
+   }
+EXPECT
+Variable "$x" will not stay shared at - line 7.
+########
+# op.c
+no warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         $x
+      }
+   }
+EXPECT
+
+########
+# op.c
+use warnings 'closure' ;
+sub x {
+      our $x;
+      sub y {
+         $x
+      }
+   }
+EXPECT
+
+########
+# op.c
+use warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         sub { $x }
+      }
+   }
+EXPECT
+Variable "$x" may be unavailable at - line 6.
+########
+# op.c
+no warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         sub { $x }
+      }
+   }
+EXPECT
+
+########
+# op.c
+use warnings 'syntax' ;
+1 if $a = 1 ;
+no warnings 'syntax' ;
+1 if $a = 1 ;
+EXPECT
+Found = in conditional, should be == at - line 3.
+########
+# op.c
+use warnings 'deprecated' ;
+split ;
+no warnings 'deprecated' ;
+split ;
+EXPECT
+Use of implicit split to @_ is deprecated at - line 3.
+########
+# op.c
+use warnings 'deprecated' ;
+$a = split ;
+no warnings 'deprecated' ;
+$a = split ;
+EXPECT
+Use of implicit split to @_ is deprecated at - line 3.
+########
+# op.c
+use warnings 'deprecated';
+my (@foo, %foo);
+%main::foo->{"bar"};
+%foo->{"bar"};
+@main::foo->[23];
+@foo->[23];
+$main::foo = {}; %$main::foo->{"bar"};
+$foo = {}; %$foo->{"bar"};
+$main::foo = []; @$main::foo->[34];
+$foo = []; @$foo->[34];
+no warnings 'deprecated';
+%main::foo->{"bar"};
+%foo->{"bar"};
+@main::foo->[23];
+@foo->[23];
+$main::foo = {}; %$main::foo->{"bar"};
+$foo = {}; %$foo->{"bar"};
+$main::foo = []; @$main::foo->[34];
+$foo = []; @$foo->[34];
+EXPECT
+Using a hash as a reference is deprecated at - line 4.
+Using a hash as a reference is deprecated at - line 5.
+Using an array as a reference is deprecated at - line 6.
+Using an array as a reference is deprecated at - line 7.
+Using a hash as a reference is deprecated at - line 8.
+Using a hash as a reference is deprecated at - line 9.
+Using an array as a reference is deprecated at - line 10.
+Using an array as a reference is deprecated at - line 11.
+########
+# op.c
+use warnings 'void' ; close STDIN ;
+1 x 3 ;                        # OP_REPEAT
+                       # OP_GVSV
+wantarray ;            # OP_WANTARRAY
+                       # OP_GV
+                       # OP_PADSV
+                       # OP_PADAV
+                       # OP_PADHV
+                       # OP_PADANY
+                       # OP_AV2ARYLEN
+ref ;                  # OP_REF
+\@a ;                  # OP_REFGEN
+\$a ;                  # OP_SREFGEN
+defined $a ;           # OP_DEFINED
+hex $a ;               # OP_HEX
+oct $a ;               # OP_OCT
+length $a ;            # OP_LENGTH
+substr $a,1 ;          # OP_SUBSTR
+vec $a,1,2 ;           # OP_VEC
+index $a,1,2 ;         # OP_INDEX
+rindex $a,1,2 ;                # OP_RINDEX
+sprintf $a ;           # OP_SPRINTF
+$a[0] ;                        # OP_AELEM
+                       # OP_AELEMFAST
+@a[0] ;                        # OP_ASLICE
+#values %a ;           # OP_VALUES
+#keys %a ;             # OP_KEYS
+$a{0} ;                        # OP_HELEM
+@a{0} ;                        # OP_HSLICE
+unpack "a", "a" ;      # OP_UNPACK
+pack $a,"" ;           # OP_PACK
+join "" ;              # OP_JOIN
+(@a)[0,1] ;            # OP_LSLICE
+                       # OP_ANONLIST
+                       # OP_ANONHASH
+sort(1,2) ;            # OP_SORT
+reverse(1,2) ;         # OP_REVERSE
+                       # OP_RANGE
+                       # OP_FLIP
+(1 ..2) ;              # OP_FLOP
+caller ;               # OP_CALLER
+fileno STDIN ;         # OP_FILENO
+eof STDIN ;            # OP_EOF
+tell STDIN ;           # OP_TELL
+readlink 1;            # OP_READLINK
+time ;                 # OP_TIME
+localtime ;            # OP_LOCALTIME
+gmtime ;               # OP_GMTIME
+eval { getgrnam 1 };   # OP_GGRNAM
+eval { getgrgid 1 };   # OP_GGRGID
+eval { getpwnam 1 };   # OP_GPWNAM
+eval { getpwuid 1 };   # OP_GPWUID
+EXPECT
+Useless use of repeat (x) in void context at - line 3.
+Useless use of wantarray in void context at - line 5.
+Useless use of reference-type operator in void context at - line 12.
+Useless use of reference constructor in void context at - line 13.
+Useless use of single ref constructor in void context at - line 14.
+Useless use of defined operator in void context at - line 15.
+Useless use of hex in void context at - line 16.
+Useless use of oct in void context at - line 17.
+Useless use of length in void context at - line 18.
+Useless use of substr in void context at - line 19.
+Useless use of vec in void context at - line 20.
+Useless use of index in void context at - line 21.
+Useless use of rindex in void context at - line 22.
+Useless use of sprintf in void context at - line 23.
+Useless use of array element in void context at - line 24.
+Useless use of array slice in void context at - line 26.
+Useless use of hash element in void context at - line 29.
+Useless use of hash slice in void context at - line 30.
+Useless use of unpack in void context at - line 31.
+Useless use of pack in void context at - line 32.
+Useless use of join or string in void context at - line 33.
+Useless use of list slice in void context at - line 34.
+Useless use of sort in void context at - line 37.
+Useless use of reverse in void context at - line 38.
+Useless use of range (or flop) in void context at - line 41.
+Useless use of caller in void context at - line 42.
+Useless use of fileno in void context at - line 43.
+Useless use of eof in void context at - line 44.
+Useless use of tell in void context at - line 45.
+Useless use of readlink in void context at - line 46.
+Useless use of time in void context at - line 47.
+Useless use of localtime in void context at - line 48.
+Useless use of gmtime in void context at - line 49.
+Useless use of getgrnam in void context at - line 50.
+Useless use of getgrgid in void context at - line 51.
+Useless use of getpwnam in void context at - line 52.
+Useless use of getpwuid in void context at - line 53.
+########
+# op.c
+no warnings 'void' ; close STDIN ;
+1 x 3 ;                        # OP_REPEAT
+                       # OP_GVSV
+wantarray ;            # OP_WANTARRAY
+                       # OP_GV
+                       # OP_PADSV
+                       # OP_PADAV
+                       # OP_PADHV
+                       # OP_PADANY
+                       # OP_AV2ARYLEN
+ref ;                  # OP_REF
+\@a ;                  # OP_REFGEN
+\$a ;                  # OP_SREFGEN
+defined $a ;           # OP_DEFINED
+hex $a ;               # OP_HEX
+oct $a ;               # OP_OCT
+length $a ;            # OP_LENGTH
+substr $a,1 ;          # OP_SUBSTR
+vec $a,1,2 ;           # OP_VEC
+index $a,1,2 ;         # OP_INDEX
+rindex $a,1,2 ;                # OP_RINDEX
+sprintf $a ;           # OP_SPRINTF
+$a[0] ;                        # OP_AELEM
+                       # OP_AELEMFAST
+@a[0] ;                        # OP_ASLICE
+#values %a ;           # OP_VALUES
+#keys %a ;             # OP_KEYS
+$a{0} ;                        # OP_HELEM
+@a{0} ;                        # OP_HSLICE
+unpack "a", "a" ;      # OP_UNPACK
+pack $a,"" ;           # OP_PACK
+join "" ;              # OP_JOIN
+(@a)[0,1] ;            # OP_LSLICE
+                       # OP_ANONLIST
+                       # OP_ANONHASH
+sort(1,2) ;            # OP_SORT
+reverse(1,2) ;         # OP_REVERSE
+                       # OP_RANGE
+                       # OP_FLIP
+(1 ..2) ;              # OP_FLOP
+caller ;               # OP_CALLER
+fileno STDIN ;         # OP_FILENO
+eof STDIN ;            # OP_EOF
+tell STDIN ;           # OP_TELL
+readlink 1;            # OP_READLINK
+time ;                 # OP_TIME
+localtime ;            # OP_LOCALTIME
+gmtime ;               # OP_GMTIME
+eval { getgrnam 1 };   # OP_GGRNAM
+eval { getgrgid 1 };   # OP_GGRGID
+eval { getpwnam 1 };   # OP_GPWNAM
+eval { getpwuid 1 };   # OP_GPWUID
+EXPECT
+########
+# op.c
+use warnings 'void' ;
+for (@{[0]}) { "$_" }          # check warning isn't duplicated
+no warnings 'void' ;
+for (@{[0]}) { "$_" }          # check warning isn't duplicated
+EXPECT
+Useless use of string in void context at - line 3.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_telldir}) {
+        print <<EOM ;
+SKIPPED
+# telldir not present
+EOM
+        exit 
+    }
+}
+telldir 1 ;            # OP_TELLDIR
+no warnings 'void' ;
+telldir 1 ;            # OP_TELLDIR
+EXPECT
+Useless use of telldir in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_getppid}) {
+        print <<EOM ;
+SKIPPED
+# getppid not present
+EOM
+        exit 
+    }
+}
+getppid ;              # OP_GETPPID
+no warnings 'void' ;
+getppid ;              # OP_GETPPID
+EXPECT
+Useless use of getppid in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_getpgrp}) {
+        print <<EOM ;
+SKIPPED
+# getpgrp not present
+EOM
+        exit 
+    }
+}
+getpgrp ;              # OP_GETPGRP
+no warnings 'void' ;
+getpgrp ;              # OP_GETPGRP
+EXPECT
+Useless use of getpgrp in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_times}) {
+        print <<EOM ;
+SKIPPED
+# times not present
+EOM
+        exit 
+    }
+}
+times ;                        # OP_TMS
+no warnings 'void' ;
+times ;                        # OP_TMS
+EXPECT
+Useless use of times in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_getprior} or $^O eq 'os2') { # Locks before fixpak22
+        print <<EOM ;
+SKIPPED
+# getpriority not present
+EOM
+        exit 
+    }
+}
+getpriority 1,2;       # OP_GETPRIORITY
+no warnings 'void' ;
+getpriority 1,2;       # OP_GETPRIORITY
+EXPECT
+Useless use of getpriority in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_getlogin}) {
+        print <<EOM ;
+SKIPPED
+# getlogin not present
+EOM
+        exit 
+    }
+}
+getlogin ;                     # OP_GETLOGIN
+no warnings 'void' ;
+getlogin ;                     # OP_GETLOGIN
+EXPECT
+Useless use of getlogin in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ; BEGIN {
+if ( ! $Config{d_socket}) {
+    print <<EOM ;
+SKIPPED
+# getsockname not present
+# getpeername not present
+# gethostbyname not present
+# gethostbyaddr not present
+# gethostent not present
+# getnetbyname not present
+# getnetbyaddr not present
+# getnetent not present
+# getprotobyname not present
+# getprotobynumber not present
+# getprotoent not present
+# getservbyname not present
+# getservbyport not present
+# getservent not present
+EOM
+    exit 
+} }
+getsockname STDIN ;    # OP_GETSOCKNAME
+getpeername STDIN ;    # OP_GETPEERNAME
+gethostbyname 1 ;      # OP_GHBYNAME
+gethostbyaddr 1,2;     # OP_GHBYADDR
+gethostent ;           # OP_GHOSTENT
+getnetbyname 1 ;       # OP_GNBYNAME
+getnetbyaddr 1,2 ;     # OP_GNBYADDR
+getnetent ;            # OP_GNETENT
+getprotobyname 1;      # OP_GPBYNAME
+getprotobynumber 1;    # OP_GPBYNUMBER
+getprotoent ;          # OP_GPROTOENT
+getservbyname 1,2;     # OP_GSBYNAME
+getservbyport 1,2;     # OP_GSBYPORT
+getservent ;           # OP_GSERVENT
+
+no warnings 'void' ;
+getsockname STDIN ;    # OP_GETSOCKNAME
+getpeername STDIN ;    # OP_GETPEERNAME
+gethostbyname 1 ;      # OP_GHBYNAME
+gethostbyaddr 1,2;     # OP_GHBYADDR
+gethostent ;           # OP_GHOSTENT
+getnetbyname 1 ;       # OP_GNBYNAME
+getnetbyaddr 1,2 ;     # OP_GNBYADDR
+getnetent ;            # OP_GNETENT
+getprotobyname 1;      # OP_GPBYNAME
+getprotobynumber 1;    # OP_GPBYNUMBER
+getprotoent ;          # OP_GPROTOENT
+getservbyname 1,2;     # OP_GSBYNAME
+getservbyport 1,2;     # OP_GSBYPORT
+getservent ;           # OP_GSERVENT
+INIT {
+   # some functions may not be there, so we exit without running
+   exit;
+}
+EXPECT
+Useless use of getsockname in void context at - line 24.
+Useless use of getpeername in void context at - line 25.
+Useless use of gethostbyname in void context at - line 26.
+Useless use of gethostbyaddr in void context at - line 27.
+Useless use of gethostent in void context at - line 28.
+Useless use of getnetbyname in void context at - line 29.
+Useless use of getnetbyaddr in void context at - line 30.
+Useless use of getnetent in void context at - line 31.
+Useless use of getprotobyname in void context at - line 32.
+Useless use of getprotobynumber in void context at - line 33.
+Useless use of getprotoent in void context at - line 34.
+Useless use of getservbyname in void context at - line 35.
+Useless use of getservbyport in void context at - line 36.
+Useless use of getservent in void context at - line 37.
+########
+# op.c
+use warnings 'void' ;
+*a ; # OP_RV2GV
+$a ; # OP_RV2SV
+@a ; # OP_RV2AV
+%a ; # OP_RV2HV
+no warnings 'void' ;
+*a ; # OP_RV2GV
+$a ; # OP_RV2SV
+@a ; # OP_RV2AV
+%a ; # OP_RV2HV
+EXPECT
+Useless use of a variable in void context at - line 3.
+Useless use of a variable in void context at - line 4.
+Useless use of a variable in void context at - line 5.
+Useless use of a variable in void context at - line 6.
+########
+# op.c
+use warnings 'void' ;
+"abc"; # OP_CONST
+7 ; # OP_CONST
+no warnings 'void' ;
+"abc"; # OP_CONST
+7 ; # OP_CONST
+EXPECT
+Useless use of a constant in void context at - line 3.
+Useless use of a constant in void context at - line 4.
+########
+# op.c
+#
+use warnings 'misc' ;
+my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+@a =~ /abc/ ;
+@a =~ s/a/b/ ;
+@a =~ tr/a/b/ ;
+@$b =~ /abc/ ;
+@$b =~ s/a/b/ ;
+@$b =~ tr/a/b/ ;
+%a =~ /abc/ ;
+%a =~ s/a/b/ ;
+%a =~ tr/a/b/ ;
+%$c =~ /abc/ ;
+%$c =~ s/a/b/ ;
+%$c =~ tr/a/b/ ;
+{
+no warnings 'misc' ;
+my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+@a =~ /abc/ ;
+@a =~ s/a/b/ ;
+@a =~ tr/a/b/ ;
+@$b =~ /abc/ ;
+@$b =~ s/a/b/ ;
+@$b =~ tr/a/b/ ;
+%a =~ /abc/ ;
+%a =~ s/a/b/ ;
+%a =~ tr/a/b/ ;
+%$c =~ /abc/ ;
+%$c =~ s/a/b/ ;
+%$c =~ tr/a/b/ ;
+}
+EXPECT
+Applying pattern match (m//) to @array will act on scalar(@array) at - line 5.
+Applying substitution (s///) to @array will act on scalar(@array) at - line 6.
+Applying transliteration (tr///) to @array will act on scalar(@array) at - line 7.
+Applying pattern match (m//) to @array will act on scalar(@array) at - line 8.
+Applying substitution (s///) to @array will act on scalar(@array) at - line 9.
+Applying transliteration (tr///) to @array will act on scalar(@array) at - line 10.
+Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 11.
+Applying substitution (s///) to %hash will act on scalar(%hash) at - line 12.
+Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 13.
+Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 14.
+Applying substitution (s///) to %hash will act on scalar(%hash) at - line 15.
+Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16.
+Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;"
+BEGIN not safe after errors--compilation aborted at - line 18.
+########
+# op.c
+use warnings 'syntax' ;
+my $a, $b = (1,2);
+no warnings 'syntax' ;
+my $c, $d = (1,2);
+EXPECT
+Parentheses missing around "my" list at - line 3.
+########
+# op.c
+use warnings 'syntax' ;
+local $a, $b = (1,2);
+no warnings 'syntax' ;
+local $c, $d = (1,2);
+EXPECT
+Parentheses missing around "local" list at - line 3.
+########
+# op.c
+use warnings 'bareword' ;
+print (ABC || 1) ;
+no warnings 'bareword' ;
+print (ABC || 1) ;
+EXPECT
+Bareword found in conditional at - line 3.
+########
+--FILE-- abc
+
+--FILE--
+# op.c
+use warnings 'misc' ;
+open FH, "<abc" ;
+$x = 1 if $x = <FH> ;
+no warnings 'misc' ;
+$x = 1 if $x = <FH> ;
+EXPECT
+Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warnings 'misc' ;
+opendir FH, "." ;
+$x = 1 if $x = readdir FH ;
+no warnings 'misc' ;
+$x = 1 if $x = readdir FH ;
+closedir FH ;
+EXPECT
+Value of readdir() operator can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warnings 'misc' ;
+$x = 1 if $x = <*> ;
+no warnings 'misc' ;
+$x = 1 if $x = <*> ;
+EXPECT
+Value of glob construct can be "0"; test with defined() at - line 3.
+########
+# op.c
+use warnings 'misc' ;
+%a = (1,2,3,4) ;
+$x = 1 if $x = each %a ;
+no warnings 'misc' ;
+$x = 1 if $x = each %a ;
+EXPECT
+Value of each() operator can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warnings 'misc' ;
+$x = 1 while $x = <*> and 0 ;
+no warnings 'misc' ;
+$x = 1 while $x = <*> and 0 ;
+EXPECT
+Value of glob construct can be "0"; test with defined() at - line 3.
+########
+# op.c
+use warnings 'misc' ;
+opendir FH, "." ;
+$x = 1 while $x = readdir FH and 0 ;
+no warnings 'misc' ;
+$x = 1 while $x = readdir FH and 0 ;
+closedir FH ;
+EXPECT
+Value of readdir() operator can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warnings 'redefine' ;
+sub fred {}
+sub fred {}
+no warnings 'redefine' ;
+sub fred {}
+EXPECT
+Subroutine fred redefined at - line 4.
+########
+# op.c
+use warnings 'redefine' ;
+sub fred () { 1 }
+sub fred () { 1 }
+no warnings 'redefine' ;
+sub fred () { 1 }
+EXPECT
+Constant subroutine fred redefined at - line 4.
+########
+# op.c
+no warnings 'redefine' ;
+sub fred () { 1 }
+sub fred () { 2 }
+EXPECT
+Constant subroutine fred redefined at - line 4.
+########
+# op.c
+no warnings 'redefine' ;
+sub fred () { 1 }
+*fred = sub () { 2 };
+EXPECT
+Constant subroutine fred redefined at - line 4.
+########
+# op.c
+use warnings 'redefine' ;
+format FRED =
+.
+format FRED =
+.
+no warnings 'redefine' ;
+format FRED =
+.
+EXPECT
+Format FRED redefined at - line 5.
+########
+# op.c
+use warnings 'deprecated' ;
+push FRED;
+no warnings 'deprecated' ;
+push FRED;
+EXPECT
+Array @FRED missing the @ in argument 1 of push() at - line 3.
+########
+# op.c
+use warnings 'deprecated' ;
+@a = keys FRED ;
+no warnings 'deprecated' ;
+@a = keys FRED ;
+EXPECT
+Hash %FRED missing the % in argument 1 of keys() at - line 3.
+########
+# op.c
+use warnings 'syntax' ;
+exec "$^X -e 1" ; 
+my $a
+EXPECT
+Statement unlikely to be reached at - line 4.
+       (Maybe you meant system() when you said exec()?)
+########
+# op.c
+use warnings 'deprecated' ;
+my @a; defined(@a);
+EXPECT
+defined(@array) is deprecated at - line 3.
+       (Maybe you should just omit the defined()?)
+########
+# op.c
+use warnings 'deprecated' ;
+defined(@a = (1,2,3));
+EXPECT
+defined(@array) is deprecated at - line 3.
+       (Maybe you should just omit the defined()?)
+########
+# op.c
+use warnings 'deprecated' ;
+my %h; defined(%h);
+EXPECT
+defined(%hash) is deprecated at - line 3.
+       (Maybe you should just omit the defined()?)
+########
+# op.c
+no warnings 'syntax' ;
+exec "$^X -e 1" ; 
+my $a
+EXPECT
+
+########
+# op.c
+sub fred();
+sub fred($) {}
+EXPECT
+Prototype mismatch: sub main::fred () vs ($) at - line 3.
+########
+# op.c
+$^W = 0 ;
+sub fred() ;
+sub fred($) {}
+{
+    no warnings 'prototype' ;
+    sub Fred() ;
+    sub Fred($) {}
+    use warnings 'prototype' ;
+    sub freD() ;
+    sub freD($) {}
+}
+sub FRED() ;
+sub FRED($) {}
+EXPECT
+Prototype mismatch: sub main::fred () vs ($) at - line 4.
+Prototype mismatch: sub main::freD () vs ($) at - line 11.
+Prototype mismatch: sub main::FRED () vs ($) at - line 14.
+########
+# op.c
+use warnings 'syntax' ;
+join /---/, 'x', 'y', 'z';
+EXPECT
+/---/ should probably be written as "---" at - line 3.
+########
+# op.c [Perl_peep]
+use warnings 'prototype' ;
+fred() ; 
+sub fred ($$) {}
+no warnings 'prototype' ;
+joe() ; 
+sub joe ($$) {}
+EXPECT
+main::fred() called too early to check prototype at - line 3.
+########
+# op.c [Perl_newATTRSUB]
+--FILE-- abc.pm
+use warnings 'void' ;
+BEGIN { $| = 1; print "in begin\n"; }
+CHECK { print "in check\n"; }
+INIT { print "in init\n"; }
+END { print "in end\n"; }
+print "in mainline\n";
+1;
+--FILE--
+use abc;
+delete $INC{"abc.pm"};
+require abc;
+do "abc.pm";
+EXPECT
+in begin
+in mainline
+in check
+in init
+in begin
+Too late to run CHECK block at abc.pm line 3.
+Too late to run INIT block at abc.pm line 4.
+in mainline
+in begin
+Too late to run CHECK block at abc.pm line 3.
+Too late to run INIT block at abc.pm line 4.
+in mainline
+in end
+in end
+in end
+########
+# op.c [Perl_newATTRSUB]
+--FILE-- abc.pm
+no warnings 'void' ;
+BEGIN { $| = 1; print "in begin\n"; }
+CHECK { print "in check\n"; }
+INIT { print "in init\n"; }
+END { print "in end\n"; }
+print "in mainline\n";
+1;
+--FILE--
+require abc;
+do "abc.pm";
+EXPECT
+in begin
+in mainline
+in begin
+in mainline
+in end
+in end
+########
+# op.c
+my @x;
+use warnings 'syntax' ;
+push(@x);
+unshift(@x);
+no warnings 'syntax' ;
+push(@x);
+unshift(@x);
+EXPECT
+Useless use of push with no values at - line 4.
+Useless use of unshift with no values at - line 5.

diff --git a/lib/warnings/perl b/lib/warnings/perl
new file mode 100644 (file)
index 0000000..512ee7f
--- /dev/null
+++ b/lib/warnings/perl
@@ -0,0 +1,72 @@
+  perl.c       AOK
+
+  gv_check(defstash)
+       Name \"%s::%s\" used only once: possible typo 
+
+  Mandatory Warnings All TODO
+  ------------------
+  Recompile perl with -DDEBUGGING to use -D switch     [moreswitches]
+  Unbalanced scopes: %ld more ENTERs than LEAVEs       [perl_destruct]
+  Unbalanced saves: %ld more saves than restores       [perl_destruct]
+  Unbalanced tmps: %ld more allocs than frees          [perl_destruct]
+  Unbalanced context: %ld more PUSHes than POPs                [perl_destruct]
+  Unbalanced string table refcount: (%d) for \"%s\"    [perl_destruct]
+  Scalars leaked: %ld                                  [perl_destruct]
+
+
+__END__
+# perl.c
+no warnings 'once' ;
+$x = 3 ;
+use warnings 'once' ;
+$z = 3 ;
+EXPECT
+Name "main::z" used only once: possible typo at - line 5.
+########
+-w
+# perl.c
+$x = 3 ;
+no warnings 'once' ;
+$z = 3 
+EXPECT
+Name "main::x" used only once: possible typo at - line 3.
+########
+# perl.c
+BEGIN { $^W =1 ; }
+$x = 3 ;
+no warnings 'once' ;
+$z = 3 
+EXPECT
+Name "main::x" used only once: possible typo at - line 3.
+########
+-W
+# perl.c
+no warnings 'once' ;
+$x = 3 ;
+use warnings 'once' ;
+$z = 3 ;
+EXPECT
+Name "main::z" used only once: possible typo at - line 6.
+Name "main::x" used only once: possible typo at - line 4.
+########
+-X
+# perl.c
+use warnings 'once' ;
+$x = 3 ;
+EXPECT
+########
+
+# perl.c
+{ use warnings 'once' ; $x = 3 ; }
+$y = 3 ;
+EXPECT
+Name "main::x" used only once: possible typo at - line 3.
+########
+
+# perl.c
+$z = 3 ;
+BEGIN { $^W = 1 }
+{ no warnings 'once' ; $x = 3 ; }
+$y = 3 ;
+EXPECT
+Name "main::y" used only once: possible typo at - line 6.

diff --git a/lib/warnings/perlio b/lib/warnings/perlio
new file mode 100644 (file)
index 0000000..18c0dfa
--- /dev/null
+++ b/lib/warnings/perlio
@@ -0,0 +1,10 @@
+  perlio.c 
+
+
+  Mandatory Warnings ALL TODO
+  ------------------
+    Setting cnt to %d
+    Setting ptr %p > end+1 %p
+    Setting cnt to %d, ptr implies %d
+
+__END__

diff --git a/lib/warnings/perly b/lib/warnings/perly
new file mode 100644 (file)
index 0000000..afc5dcc
--- /dev/null
+++ b/lib/warnings/perly
@@ -0,0 +1,31 @@
+  perly.y      AOK
+
+  dep() => deprecate("\"do\" to call subroutines") 
+  Use of "do" to call subroutines is deprecated
+
+       sub fred {} do fred()
+       sub fred {} do fred(1)
+       sub fred {} $a = "fred" ; do $a()
+       sub fred {} $a = "fred" ; do $a(1)
+
+
+__END__
+# perly.y
+use warnings 'deprecated' ;
+sub fred {} 
+do fred() ;
+do fred(1) ;
+$a = "fred" ; 
+do $a() ;
+do $a(1) ;
+no warnings 'deprecated' ;
+do fred() ;
+do fred(1) ;
+$a = "fred" ; 
+do $a() ;
+do $a(1) ;
+EXPECT
+Use of "do" to call subroutines is deprecated at - line 4.
+Use of "do" to call subroutines is deprecated at - line 5.
+Use of "do" to call subroutines is deprecated at - line 7.
+Use of "do" to call subroutines is deprecated at - line 8.

diff --git a/lib/warnings/pp b/lib/warnings/pp
new file mode 100644 (file)
index 0000000..62f054a
--- /dev/null
+++ b/lib/warnings/pp
@@ -0,0 +1,150 @@
+  pp.c TODO
+
+  substr outside of string
+    $a = "ab" ; $b = substr($a, 4,5) ;
+
+  Attempt to use reference as lvalue in substr 
+    $a = "ab" ; $b = \$a ;  substr($b, 1,1) = $b
+
+  uninitialized        in pp_rv2gv()
+       my *b = *{ undef()}
+
+  uninitialized        in pp_rv2sv()
+       my $a = undef ; my $b = $$a
+
+  Odd number of elements in hash list
+       my $a = { 1,2,3 } ;
+
+  Invalid type in unpack: '%c
+       my $A = pack ("A,A", 1,2) ;
+       my @A = unpack ("A,A", "22") ;
+
+  Attempt to pack pointer to temporary value
+       pack("p", "abc") ;
+
+  Explicit blessing to '' (assuming package main)
+       bless \[], "";
+
+  Constant subroutine %s undefined                     <<<TODO
+  Constant subroutine (anonymous) undefined            <<<TODO
+
+__END__
+# pp.c
+use warnings 'substr' ;
+$a = "ab" ; 
+$b = substr($a, 4,5) ;
+no warnings 'substr' ;
+$a = "ab" ; 
+$b = substr($a, 4,5)  ;
+EXPECT
+substr outside of string at - line 4.
+########
+# pp.c
+use warnings 'substr' ;
+$a = "ab" ; 
+$b = \$a ;  
+substr($b, 1,1) = "ab" ;
+no warnings 'substr' ;
+substr($b, 1,1) = "ab" ;
+EXPECT
+Attempt to use reference as lvalue in substr at - line 5.
+########
+# pp.c
+use warnings 'uninitialized' ;
+# TODO
+EXPECT
+
+########
+# pp.c
+use warnings 'misc' ;
+my $a = { 1,2,3};
+no warnings 'misc' ;
+my $b = { 1,2,3};
+EXPECT
+Odd number of elements in hash assignment at - line 3.
+########
+# pp.c
+use warnings 'pack' ;
+use warnings 'unpack' ;
+my @a = unpack ("A,A", "22") ;
+my $a = pack ("A,A", 1,2) ;
+no warnings 'pack' ;
+no warnings 'unpack' ;
+my @b = unpack ("A,A", "22") ;
+my $b = pack ("A,A", 1,2) ;
+EXPECT
+Invalid type in unpack: ',' at - line 4.
+Invalid type in pack: ',' at - line 5.
+########
+# pp.c
+use warnings 'uninitialized' ;
+my $a = undef ; 
+my $b = $$a;
+no warnings 'uninitialized' ;
+my $c = $$a;
+EXPECT
+Use of uninitialized value in scalar dereference at - line 4.
+########
+# pp.c
+use warnings 'pack' ;
+sub foo { my $a = "a"; return $a . $a++ . $a++ }
+my $a = pack("p", &foo) ;
+no warnings 'pack' ;
+my $b = pack("p", &foo) ;
+EXPECT
+Attempt to pack pointer to temporary value at - line 4.
+########
+# pp.c
+use warnings 'misc' ;
+bless \[], "" ;
+no warnings 'misc' ;
+bless \[], "" ;
+EXPECT
+Explicit blessing to '' (assuming package main) at - line 3.
+########
+# pp.c
+use utf8 ;
+$_ = "\x80  \xff" ;
+reverse ;
+EXPECT
+########
+# pp.c
+use warnings 'pack' ;
+print unpack("C", pack("C",   -1)), "\n";
+print unpack("C", pack("C",    0)), "\n";
+print unpack("C", pack("C",  255)), "\n";
+print unpack("C", pack("C",  256)), "\n";
+print unpack("c", pack("c", -129)), "\n";
+print unpack("c", pack("c", -128)), "\n";
+print unpack("c", pack("c",  127)), "\n";
+print unpack("c", pack("c",  128)), "\n";
+no warnings 'pack' ;
+print unpack("C", pack("C",   -1)), "\n";
+print unpack("C", pack("C",    0)), "\n";
+print unpack("C", pack("C",  255)), "\n";
+print unpack("C", pack("C",  256)), "\n";
+print unpack("c", pack("c", -129)), "\n";
+print unpack("c", pack("c", -128)), "\n";
+print unpack("c", pack("c",  127)), "\n";
+print unpack("c", pack("c",  128)), "\n";
+EXPECT
+Character in "C" format wrapped at - line 3.
+Character in "C" format wrapped at - line 6.
+Character in "c" format wrapped at - line 7.
+Character in "c" format wrapped at - line 10.
+255
+0
+255
+0
+127
+-128
+127
+-128
+255
+0
+255
+0
+127
+-128
+127
+-128

diff --git a/lib/warnings/pp_ctl b/lib/warnings/pp_ctl
new file mode 100644 (file)
index 0000000..ac01f27
--- /dev/null
+++ b/lib/warnings/pp_ctl
@@ -0,0 +1,230 @@
+  pp_ctl.c     AOK
+ 
+     Not enough format arguments       
+       format STDOUT =
+       @<<< @<<<
+       $a
+       .
+       write;
+     
+
+    Exiting substitution via %s
+       $_ = "abc" ;
+       while ($i ++ == 0)
+       {
+           s/ab/last/e ;
+       }
+
+    Exiting subroutine via %s          
+       sub fred { last }
+       { fred() }
+
+    Exiting eval via %s        
+       { eval "last" }
+
+    Exiting pseudo-block via %s 
+       @a = (1,2) ; @b = sort { last } @a ;
+
+    Exiting substitution via %s
+       $_ = "abc" ;
+       last fred:
+       while ($i ++ == 0)
+       {
+           s/ab/last fred/e ;
+       }
+
+
+    Exiting subroutine via %s
+       sub fred { last joe }
+       joe: { fred() }
+
+    Exiting eval via %s
+       fred: { eval "last fred" }
+
+    Exiting pseudo-block via %s 
+       @a = (1,2) ; fred: @b = sort { last fred } @a ;
+
+
+    Deep recursion on subroutine \"%s\"
+       sub fred
+       {
+         fred() if $a++ < 200
+       }
+        
+       fred()
+
+      (in cleanup) foo bar
+       package Foo;
+       DESTROY { die "foo bar" }
+       { bless [], 'Foo' for 1..10 }
+
+__END__
+# pp_ctl.c
+use warnings 'syntax' ;
+format STDOUT =
+@<<< @<<<
+1
+.
+write;
+EXPECT
+Not enough format arguments at - line 5.
+1
+########
+# pp_ctl.c
+no warnings 'syntax' ;
+format =
+@<<< @<<<
+1
+.
+write ;
+EXPECT
+1
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+$_ = "abc" ;
+ 
+while ($i ++ == 0)
+{
+    s/ab/last/e ;
+}
+no warnings 'exiting' ;
+while ($i ++ == 0)
+{
+    s/ab/last/e ;
+}
+EXPECT
+Exiting substitution via last at - line 7.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+sub fred { last }
+{ fred() }
+no warnings 'exiting' ;
+sub joe { last }
+{ joe() }
+EXPECT
+Exiting subroutine via last at - line 3.
+########
+# pp_ctl.c
+{
+  eval "use warnings 'exiting' ; last;" 
+}
+print STDERR $@ ;
+{
+  eval "no warnings 'exiting' ;last;" 
+} 
+print STDERR $@ ;
+EXPECT
+Exiting eval via last at (eval 1) line 1.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+@a = (1,2) ;
+@b = sort { last } @a ;
+no warnings 'exiting' ;
+@b = sort { last } @a ;
+EXPECT
+Exiting pseudo-block via last at - line 4.
+Can't "last" outside a loop block at - line 4.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+$_ = "abc" ;
+fred: 
+while ($i ++ == 0)
+{
+    s/ab/last fred/e ;
+}
+no warnings 'exiting' ;
+while ($i ++ == 0)
+{
+    s/ab/last fred/e ;
+}
+EXPECT
+Exiting substitution via last at - line 7.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+sub fred { last joe }
+joe: { fred() }
+no warnings 'exiting' ;
+sub Fred { last Joe }
+Joe: { Fred() }
+EXPECT
+Exiting subroutine via last at - line 3.
+########
+# pp_ctl.c
+joe:
+{ eval "use warnings 'exiting' ; last joe;" }
+print STDERR $@ ;
+Joe:
+{ eval "no warnings 'exiting' ; last Joe;" }
+print STDERR $@ ;
+EXPECT
+Exiting eval via last at (eval 1) line 1.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+@a = (1,2) ;
+fred: @b = sort { last fred } @a ;
+no warnings 'exiting' ;
+Fred: @b = sort { last Fred } @a ;
+EXPECT
+Exiting pseudo-block via last at - line 4.
+Label not found for "last fred" at - line 4.
+########
+# pp_ctl.c
+use warnings 'recursion' ;
+BEGIN { warn "PREFIX\n" ;}
+sub fred
+{
+    fred() if $a++ < 200
+}
+ 
+fred()
+EXPECT
+Deep recursion on subroutine "main::fred" at - line 6.
+########
+# pp_ctl.c
+no warnings 'recursion' ;
+BEGIN { warn "PREFIX\n" ;}
+sub fred
+{
+    fred() if $a++ < 200
+}
+ 
+fred()
+EXPECT
+########
+# pp_ctl.c
+use warnings 'misc' ;
+package Foo;
+DESTROY { die "@{$_[0]} foo bar" }
+{ bless ['A'], 'Foo' for 1..10 }
+{ bless ['B'], 'Foo' for 1..10 }
+EXPECT
+       (in cleanup) A foo bar at - line 4.
+       (in cleanup) B foo bar at - line 4.
+########
+# pp_ctl.c
+no warnings 'misc' ;
+package Foo;
+DESTROY { die "@{$_[0]} foo bar" }
+{ bless ['A'], 'Foo' for 1..10 }
+{ bless ['B'], 'Foo' for 1..10 }
+EXPECT
+########
+# pp_ctl.c
+use warnings;
+eval 'print $foo';
+EXPECT
+Use of uninitialized value in print at (eval 1) line 1.
+########
+# pp_ctl.c
+use warnings;
+{
+    no warnings;
+    eval 'print $foo';
+}
+EXPECT

diff --git a/lib/warnings/pp_hot b/lib/warnings/pp_hot
new file mode 100644 (file)
index 0000000..c5a3790
--- /dev/null
+++ b/lib/warnings/pp_hot
@@ -0,0 +1,284 @@
+  pp_hot.c     
+
+  print() on unopened filehandle abc           [pp_print]
+    $f = $a = "abc" ; print $f $a
+
+  Filehandle %s opened only for input          [pp_print]
+    print STDIN "abc" ;
+
+  Filehandle %s opened only for output         [pp_print]
+    print <STDOUT> ;
+
+  print() on closed filehandle %s              [pp_print]
+    close STDIN ; print STDIN "abc" ;
+
+  uninitialized                                        [pp_rv2av]
+       my $a = undef ; my @b = @$a
+
+  uninitialized                                        [pp_rv2hv]
+       my $a = undef ; my %b = %$a
+
+  Odd number of elements in hash list          [pp_aassign]
+       %X = (1,2,3) ;
+
+  Reference found where even-sized list expected [pp_aassign]
+       $X = [ 1 ..3 ];
+
+  Filehandle %s opened only for output         [Perl_do_readline] 
+       open (FH, ">./xcv") ;
+       my $a = <FH> ;
+
+  glob failed (can't start child: %s)          [Perl_do_readline] <<TODO
+
+  readline() on closed filehandle %s           [Perl_do_readline]
+    close STDIN ; $a = <STDIN>;
+
+  readline() on closed filehandle %s           [Perl_do_readline]
+    readline(NONESUCH);
+
+  glob failed (child exited with status %d%s)  [Perl_do_readline] <<TODO
+
+  Deep recursion on subroutine \"%s\"          [Perl_sub_crush_depth]
+    sub fred { fred() if $a++ < 200} fred()
+
+  Deep recursion on anonymous subroutine       [Perl_sub_crush_depth]
+    $a = sub { &$a if $a++ < 200} &$a
+
+  Possible Y2K bug: about to append an integer to '19' [pp_concat]
+    $x     = "19$yy\n";
+
+  Use of reference "%s" as array index [pp_aelem]
+    $x[\1]
+
+__END__
+# pp_hot.c [pp_print]
+use warnings 'unopened' ;
+$f = $a = "abc" ; 
+print $f $a;
+no warnings 'unopened' ;
+print $f $a;
+EXPECT
+print() on unopened filehandle abc at - line 4.
+########
+# pp_hot.c [pp_print]
+use warnings 'io' ;
+print STDIN "anc";
+print <STDOUT>;
+print <STDERR>;
+open(FOO, ">&STDOUT") and print <FOO>;
+print getc(STDERR);
+print getc(FOO);
+####################################################################
+# The next test is known to fail on some systems (Linux+old glibc, #
+# some *BSDs (including Mac OS X and NeXT), among others.          #
+# We skip it for now (on the grounds that it is "just" a warning). #
+####################################################################
+#read(FOO,$_,1);
+no warnings 'io' ;
+print STDIN "anc";
+EXPECT
+Filehandle STDIN opened only for input at - line 3.
+Filehandle STDOUT opened only for output at - line 4.
+Filehandle STDERR opened only for output at - line 5.
+Filehandle FOO opened only for output at - line 6.
+Filehandle STDERR opened only for output at - line 7.
+Filehandle FOO opened only for output at - line 8.
+########
+# pp_hot.c [pp_print]
+use warnings 'closed' ;
+close STDIN ;
+print STDIN "anc";
+opendir STDIN, ".";
+print STDIN "anc";
+closedir STDIN;
+no warnings 'closed' ;
+print STDIN "anc";
+opendir STDIN, ".";
+print STDIN "anc";
+EXPECT
+print() on closed filehandle STDIN at - line 4.
+print() on closed filehandle STDIN at - line 6.
+       (Are you trying to call print() on dirhandle STDIN?)
+########
+# pp_hot.c [pp_rv2av]
+use warnings 'uninitialized' ;
+my $a = undef ;
+my @b = @$a;
+no warnings 'uninitialized' ;
+my @c = @$a;
+EXPECT
+Use of uninitialized value in array dereference at - line 4.
+########
+# pp_hot.c [pp_rv2hv]
+use warnings 'uninitialized' ;
+my $a = undef ;
+my %b = %$a;
+no warnings 'uninitialized' ;
+my %c = %$a;
+EXPECT
+Use of uninitialized value in hash dereference at - line 4.
+########
+# pp_hot.c [pp_aassign]
+use warnings 'misc' ;
+my %X ; %X = (1,2,3) ;
+no warnings 'misc' ;
+my %Y ; %Y = (1,2,3) ;
+EXPECT
+Odd number of elements in hash assignment at - line 3.
+########
+# pp_hot.c [pp_aassign]
+use warnings 'misc' ;
+my %X ; %X = [1 .. 3] ;
+no warnings 'misc' ;
+my %Y ; %Y = [1 .. 3] ;
+EXPECT
+Reference found where even-sized list expected at - line 3.
+########
+# pp_hot.c [Perl_do_readline]
+use warnings 'closed' ;
+close STDIN        ; $a = <STDIN> ;
+opendir STDIN, "." ; $a = <STDIN> ;
+closedir STDIN;
+no warnings 'closed' ;
+opendir STDIN, "." ; $a = <STDIN> ;
+$a = <STDIN> ;
+EXPECT
+readline() on closed filehandle STDIN at - line 3.
+readline() on closed filehandle STDIN at - line 4.
+       (Are you trying to call readline() on dirhandle STDIN?)
+########
+# pp_hot.c [Perl_do_readline]
+use warnings 'io' ;
+my $file = "./xcv" ; unlink $file ;
+open (FH, ">./xcv") ;
+my $a = <FH> ;
+no warnings 'io' ;
+$a = <FH> ;
+close (FH) ;
+unlink $file ;
+EXPECT
+Filehandle FH opened only for output at - line 5.
+########
+# pp_hot.c [Perl_sub_crush_depth]
+use warnings 'recursion' ;
+sub fred 
+{ 
+    fred() if $a++ < 200
+} 
+{
+  local $SIG{__WARN__} = sub {
+    die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
+  };
+  fred();
+}
+EXPECT
+ok
+########
+# pp_hot.c [Perl_sub_crush_depth]
+no warnings 'recursion' ;
+sub fred 
+{ 
+    fred() if $a++ < 200
+} 
+{
+  local $SIG{__WARN__} = sub {
+    die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
+  };
+  fred();
+}
+EXPECT
+
+########
+# pp_hot.c [Perl_sub_crush_depth]
+use warnings 'recursion' ;
+$b = sub 
+{ 
+    &$b if $a++ < 200
+}  ;
+
+&$b ;
+EXPECT
+Deep recursion on anonymous subroutine at - line 5.
+########
+# pp_hot.c [Perl_sub_crush_depth]
+no warnings 'recursion' ;
+$b = sub 
+{ 
+    &$b if $a++ < 200
+}  ;
+
+&$b ;
+EXPECT
+########
+# pp_hot.c [pp_concat]
+use warnings 'uninitialized';
+my($x, $y);
+sub a { shift }
+a($x . "x");   # should warn once
+a($x . $y);    # should warn twice
+$x .= $y;      # should warn once
+$y .= $y;      # should warn once
+EXPECT
+Use of uninitialized value in concatenation (.) or string at - line 5.
+Use of uninitialized value in concatenation (.) or string at - line 6.
+Use of uninitialized value in concatenation (.) or string at - line 6.
+Use of uninitialized value in concatenation (.) or string at - line 7.
+Use of uninitialized value in concatenation (.) or string at - line 8.
+########
+# pp_hot.c [pp_concat]
+use warnings 'y2k';
+use Config;
+BEGIN {
+    unless ($Config{ccflags} =~ /Y2KWARN/) {
+       print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
+       exit 0;
+    }
+}
+my $x;
+my $yy = 78;
+$x     = "19$yy\n";
+$x     = "19" . $yy . "\n";
+$x     = "319$yy\n";
+$x     = "319" . $yy . "\n";
+$yy = 19;
+$x     = "ok $yy\n";
+$yy = 9;
+$x     = 1 . $yy;
+no warnings 'y2k';
+$x     = "19$yy\n";
+$x     = "19" . $yy . "\n";
+EXPECT
+Possible Y2K bug: about to append an integer to '19' at - line 12.
+Possible Y2K bug: about to append an integer to '19' at - line 13.
+########
+# pp_hot.c [pp_aelem]
+{
+use warnings 'misc';
+print $x[\1];
+}
+{
+no warnings 'misc';
+print $x[\1];
+}
+
+EXPECT
+OPTION regex
+Use of reference ".*" as array index at - line 4.
+########
+# pp_hot.c [pp_aelem]
+package Foo;use overload q("") => sub {};package main;$a = bless {}, "Foo";
+$b = {};
+{
+use warnings 'misc';
+print $x[$a];
+print $x[$b];
+}
+{
+no warnings 'misc';
+print $x[$a];
+print $x[$b];
+}
+
+EXPECT
+OPTION regex
+Use of reference ".*" as array index at - line 7.

diff --git a/lib/warnings/pp_sys b/lib/warnings/pp_sys
new file mode 100644 (file)
index 0000000..e30637b
--- /dev/null
+++ b/lib/warnings/pp_sys
@@ -0,0 +1,419 @@
+  pp_sys.c     AOK
+
+  untie attempted while %d inner references still exist        [pp_untie]
+    sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
+
+  fileno() on unopened filehandle abc          [pp_fileno]
+    $a = "abc"; fileno($a)
+
+  binmode() on unopened filehandle abc         [pp_binmode]
+    $a = "abc"; fileno($a)
+
+  printf() on unopened filehandle abc          [pp_prtf]
+    $a = "abc"; printf $a "fred"
+
+  Filehandle %s opened only for input          [pp_leavewrite]
+    format STDIN =
+    .
+    write STDIN;
+
+  write() on closed filehandle %s              [pp_leavewrite]
+    format STDIN =
+    .
+    close STDIN;
+    write STDIN ;
+
+  page overflow                                        [pp_leavewrite]
+
+  printf() on unopened filehandle abc          [pp_prtf]
+    $a = "abc"; printf $a "fred"
+
+  Filehandle %s opened only for input          [pp_prtf]
+    $a = "abc"; 
+    printf $a "fred"
+
+  printf() on closed filehandle %s             [pp_prtf]
+    close STDIN ;
+    printf STDIN "fred"
+
+  syswrite() on closed filehandle %s           [pp_send]
+    close STDIN; 
+    syswrite STDIN, "fred", 1;
+
+  send() on closed socket %s                   [pp_send]
+    close STDIN; 
+    send STDIN, "fred", 1
+
+  bind() on closed socket %s                   [pp_bind]
+    close STDIN; 
+    bind STDIN, "fred" ;
+
+
+  connect() on closed socket %s                        [pp_connect]
+    close STDIN; 
+    connect STDIN, "fred" ;
+
+  listen() on closed socket %s                 [pp_listen]
+    close STDIN; 
+    listen STDIN, 2;
+
+  accept() on closed socket %s                 [pp_accept]
+    close STDIN; 
+    accept "fred", STDIN ;
+
+  shutdown() on closed socket %s               [pp_shutdown]
+    close STDIN; 
+    shutdown STDIN, 0;
+
+  setsockopt() on closed socket %s             [pp_ssockopt]
+  getsockopt() on closed socket        %s              [pp_ssockopt]
+    close STDIN; 
+    setsockopt STDIN, 1,2,3;
+    getsockopt STDIN, 1,2;
+
+  getsockname() on closed socket %s            [pp_getpeername]
+  getpeername() on closed socket %s            [pp_getpeername]
+    close STDIN; 
+    getsockname STDIN;
+    getpeername STDIN;
+
+  flock() on closed socket %s                  [pp_flock]
+  flock() on closed socket                     [pp_flock]
+    close STDIN;
+    flock STDIN, 8;
+    flock $a, 8;
+
+  The stat preceding lstat() wasn't an lstat %s        [pp_stat]
+    lstat(STDIN);
+
+  warn(warn_nl, "stat");                       [pp_stat]
+
+  -T on closed filehandle %s
+  stat() on closed filehandle %s
+       close STDIN ; -T STDIN ; stat(STDIN) ;
+
+  warn(warn_nl, "open");                       [pp_fttext]
+    -T "abc\ndef" ;
+
+  Filehandle %s opened only for output         [pp_sysread]
+       my $file = "./xcv" ;
+       open(F, ">$file") ; 
+       my $a = sysread(F, $a,10) ;
+  
+  
+
+__END__
+# pp_sys.c [pp_untie]
+use warnings 'untie' ;
+sub TIESCALAR { bless [] } ; 
+$b = tie $a, 'main'; 
+untie $a ;
+no warnings 'untie' ;
+$c = tie $d, 'main'; 
+untie $d ;
+EXPECT
+untie attempted while 1 inner references still exist at - line 5.
+########
+# pp_sys.c [pp_leavewrite]
+use warnings 'io' ;
+format STDIN =
+.
+write STDIN;
+no warnings 'io' ;
+write STDIN;
+EXPECT
+Filehandle STDIN opened only for input at - line 5.
+########
+# pp_sys.c [pp_leavewrite]
+use warnings 'closed' ;
+format STDIN =
+.
+close STDIN;
+write STDIN;
+opendir STDIN, ".";
+write STDIN;
+closedir STDIN;
+no warnings 'closed' ;
+write STDIN;
+opendir STDIN, ".";
+write STDIN;
+EXPECT
+write() on closed filehandle STDIN at - line 6.
+write() on closed filehandle STDIN at - line 8.
+       (Are you trying to call write() on dirhandle STDIN?)
+########
+# pp_sys.c [pp_leavewrite]
+use warnings 'io' ;
+format STDOUT_TOP =
+abc
+.
+format STDOUT =
+def
+ghi
+.
+$= = 1 ;
+$- =1 ;
+open STDOUT, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
+write ;
+no warnings 'io' ;
+write ;
+EXPECT
+page overflow at - line 13.
+########
+# pp_sys.c [pp_prtf]
+use warnings 'unopened' ;
+$a = "abc"; 
+printf $a "fred";
+no warnings 'unopened' ;
+printf $a "fred";
+EXPECT
+printf() on unopened filehandle abc at - line 4.
+########
+# pp_sys.c [pp_prtf]
+use warnings 'closed' ;
+close STDIN ;
+printf STDIN "fred";
+opendir STDIN, ".";
+printf STDIN "fred";
+closedir STDIN;
+no warnings 'closed' ;
+printf STDIN "fred";
+opendir STDIN, ".";
+printf STDIN "fred";
+EXPECT
+printf() on closed filehandle STDIN at - line 4.
+printf() on closed filehandle STDIN at - line 6.
+       (Are you trying to call printf() on dirhandle STDIN?)
+########
+# pp_sys.c [pp_prtf]
+use warnings 'io' ;
+printf STDIN "fred";
+no warnings 'io' ;
+printf STDIN "fred";
+EXPECT
+Filehandle STDIN opened only for input at - line 3.
+########
+# pp_sys.c [pp_send]
+use warnings 'closed' ;
+close STDIN; 
+syswrite STDIN, "fred", 1;
+opendir STDIN, ".";
+syswrite STDIN, "fred", 1;
+closedir STDIN;
+no warnings 'closed' ;
+syswrite STDIN, "fred", 1;
+opendir STDIN, ".";
+syswrite STDIN, "fred", 1;
+EXPECT
+syswrite() on closed filehandle STDIN at - line 4.
+syswrite() on closed filehandle STDIN at - line 6.
+       (Are you trying to call syswrite() on dirhandle STDIN?)
+########
+# pp_sys.c [pp_flock]
+use Config; 
+BEGIN { 
+  if ( !$Config{d_flock} &&
+       !$Config{d_fcntl_can_lock} &&
+       !$Config{d_lockf} ) {
+    print <<EOM ;
+SKIPPED
+# flock not present
+EOM
+    exit ;
+  } 
+}
+use warnings qw(unopened closed);
+close STDIN;
+flock STDIN, 8;
+opendir STDIN, ".";
+flock STDIN, 8;
+flock FOO, 8;
+flock $a, 8;
+no warnings qw(unopened closed);
+flock STDIN, 8;
+opendir STDIN, ".";
+flock STDIN, 8;
+flock FOO, 8;
+flock $a, 8;
+EXPECT
+flock() on closed filehandle STDIN at - line 16.
+flock() on closed filehandle STDIN at - line 18.
+       (Are you trying to call flock() on dirhandle STDIN?)
+flock() on unopened filehandle FOO at - line 19.
+flock() on unopened filehandle at - line 20.
+########
+# pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
+use warnings 'io' ;
+use Config; 
+BEGIN { 
+  if ( $^O ne 'VMS' and ! $Config{d_socket}) {
+    print <<EOM ;
+SKIPPED
+# send not present
+# bind not present
+# connect not present
+# accept not present
+# shutdown not present
+# setsockopt not present
+# getsockopt not present
+# getsockname not present
+# getpeername not present
+EOM
+    exit ;
+  } 
+}
+close STDIN; 
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept "fred", STDIN;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+opendir STDIN, ".";
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept "fred", STDIN;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+closedir STDIN;
+no warnings 'io' ;
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept STDIN, "fred" ;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+opendir STDIN, ".";
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept "fred", STDIN;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+EXPECT
+send() on closed socket STDIN at - line 22.
+bind() on closed socket STDIN at - line 23.
+connect() on closed socket STDIN at - line 24.
+listen() on closed socket STDIN at - line 25.
+accept() on closed socket STDIN at - line 26.
+shutdown() on closed socket STDIN at - line 27.
+setsockopt() on closed socket STDIN at - line 28.
+getsockopt() on closed socket STDIN at - line 29.
+getsockname() on closed socket STDIN at - line 30.
+getpeername() on closed socket STDIN at - line 31.
+send() on closed socket STDIN at - line 33.
+       (Are you trying to call send() on dirhandle STDIN?)
+bind() on closed socket STDIN at - line 34.
+       (Are you trying to call bind() on dirhandle STDIN?)
+connect() on closed socket STDIN at - line 35.
+       (Are you trying to call connect() on dirhandle STDIN?)
+listen() on closed socket STDIN at - line 36.
+       (Are you trying to call listen() on dirhandle STDIN?)
+accept() on closed socket STDIN at - line 37.
+       (Are you trying to call accept() on dirhandle STDIN?)
+shutdown() on closed socket STDIN at - line 38.
+       (Are you trying to call shutdown() on dirhandle STDIN?)
+setsockopt() on closed socket STDIN at - line 39.
+       (Are you trying to call setsockopt() on dirhandle STDIN?)
+getsockopt() on closed socket STDIN at - line 40.
+       (Are you trying to call getsockopt() on dirhandle STDIN?)
+getsockname() on closed socket STDIN at - line 41.
+       (Are you trying to call getsockname() on dirhandle STDIN?)
+getpeername() on closed socket STDIN at - line 42.
+       (Are you trying to call getpeername() on dirhandle STDIN?)
+########
+# pp_sys.c [pp_stat]
+use warnings 'newline' ;
+stat "abc\ndef";
+no warnings 'newline' ;
+stat "abc\ndef";
+EXPECT
+Unsuccessful stat on filename containing newline at - line 3.
+########
+# pp_sys.c [pp_stat]
+use Config; 
+BEGIN { 
+  if ($^O eq 'd_lstat') {
+    print <<EOM ;
+SKIPPED
+# lstat not present
+EOM
+    exit ;
+  } 
+}
+use warnings 'io' ;
+lstat(STDIN) ;
+no warnings 'io' ;
+lstat(STDIN) ;
+EXPECT
+The stat preceding lstat() wasn't an lstat at - line 13.
+########
+# pp_sys.c [pp_fttext]
+use warnings qw(unopened closed) ;
+close STDIN ; 
+-T STDIN ;
+stat(STDIN) ;
+-T HOCUS;
+stat(POCUS);
+no warnings qw(unopened closed) ;
+-T STDIN ;
+stat(STDIN);
+-T HOCUS;
+stat(POCUS);
+EXPECT
+-T on closed filehandle STDIN at - line 4.
+stat() on closed filehandle STDIN at - line 5.
+-T on unopened filehandle HOCUS at - line 6.
+stat() on unopened filehandle POCUS at - line 7.
+########
+# pp_sys.c [pp_fttext]
+use warnings 'newline' ;
+-T "abc\ndef" ;
+no warnings 'newline' ;
+-T "abc\ndef" ;
+EXPECT
+Unsuccessful open on filename containing newline at - line 3.
+########
+# pp_sys.c [pp_sysread]
+use warnings 'io' ;
+if ($^O eq 'dos') {
+    print <<EOM ;
+SKIPPED
+# skipped on dos
+EOM
+    exit ;
+}
+my $file = "./xcv" ;
+open(F, ">$file") ; 
+my $a = sysread(F, $a,10) ;
+no warnings 'io' ;
+my $a = sysread(F, $a,10) ;
+close F ;
+unlink $file ;
+EXPECT
+Filehandle F opened only for output at - line 12.
+########
+# pp_sys.c [pp_binmode]
+use warnings 'unopened' ;
+binmode(BLARG);
+$a = "BLERG";binmode($a);
+EXPECT
+binmode() on unopened filehandle BLARG at - line 3.
+binmode() on unopened filehandle at - line 4.

diff --git a/lib/warnings/regcomp b/lib/warnings/regcomp
new file mode 100644 (file)
index 0000000..ceca441
--- /dev/null
+++ b/lib/warnings/regcomp
@@ -0,0 +1,239 @@
+  regcomp.c    AOK
+
+  Quantifier unexpected on zero-length expression [S_study_chunk] 
+
+  (?p{}) is deprecated - use (??{})  [S_reg]
+    $a =~ /(?p{'x'})/ ;
+    
+
+  Useless (%s%c) - %suse /%c modifier [S_reg] 
+  Useless (%sc) - %suse /gc modifier [S_reg] 
+
+
+
+  Strange *+?{} on zero-length expression      [S_study_chunk]
+       /(?=a)?/
+
+  %.*s matches null string many times          [S_regpiece]
+       $a = "ABC123" ; $a =~ /(?=a)*/'
+
+  /%.127s/: Unrecognized escape \\%c passed through    [S_regatom] 
+       $x = '\m' ; /$x/
+
+  POSIX syntax [%c %c] is reserved for future extensions [S_checkposixcc] 
+
+
+  Character class [:%.*s:] unknown     [S_regpposixcc]
+
+  Character class syntax [%c %c] belongs inside character classes [S_checkposixcc] 
+  
+  /%.127s/: false [] range \"%*.*s\" in regexp [S_regclass]
+
+  /%.127s/: false [] range \"%*.*s\" in regexp [S_regclassutf8]
+
+  /%.127s/: Unrecognized escape \\%c in character class passed through"        [S_regclass] 
+
+  /%.127s/: Unrecognized escape \\%c in character class passed through"        [S_regclassutf8] 
+
+  False [] range \"%*.*s\" [S_regclass]
+
+__END__
+# regcomp.c [S_regpiece]
+use warnings 'regexp' ;
+my $a = "ABC123" ; 
+$a =~ /(?=a)*/ ;
+no warnings 'regexp' ;
+$a =~ /(?=a)*/ ;
+EXPECT
+(?=a)* matches null string many times in regex; marked by <-- HERE in m/(?=a)* <-- HERE / at - line 4.
+########
+# regcomp.c [S_study_chunk]
+use warnings 'regexp' ;
+$_ = "" ;
+/(?=a)?/;
+no warnings 'regexp' ;
+/(?=a)?/;
+EXPECT
+Quantifier unexpected on zero-length expression in regex; marked by <-- HERE in m/(?=a)? <-- HERE / at - line 4.
+########
+# regcomp.c [S_regatom]
+$x = '\m' ;
+use warnings 'regexp' ;
+$a =~ /a$x/ ;
+no warnings 'regexp' ;
+$a =~ /a$x/ ;
+EXPECT
+Unrecognized escape \m passed through in regex; marked by <-- HERE in m/a\m <-- HERE / at - line 4.
+########
+# regcomp.c [S_regpposixcc S_checkposixcc]
+#
+use warnings 'regexp' ;
+$_ = "" ;
+/[:alpha:]/;
+/[:zog:]/;
+/[[:zog:]]/;
+no warnings 'regexp' ;
+/[:alpha:]/;
+/[:zog:]/;
+/[[:zog:]]/;
+EXPECT
+POSIX syntax [: :] belongs inside character classes in regex; marked by <-- HERE in m/[:alpha:] <-- HERE / at - line 5.
+POSIX syntax [: :] belongs inside character classes in regex; marked by <-- HERE in m/[:zog:] <-- HERE / at - line 6.
+POSIX class [:zog:] unknown in regex; marked by <-- HERE in m/[[:zog:] <-- HERE ]/
+########
+# regcomp.c [S_checkposixcc]
+#
+use warnings 'regexp' ;
+$_ = "" ;
+/[.zog.]/;
+no warnings 'regexp' ;
+/[.zog.]/;
+EXPECT
+POSIX syntax [. .] belongs inside character classes in regex; marked by <-- HERE in m/[.zog.] <-- HERE / at - line 5.
+POSIX syntax [. .] is reserved for future extensions in regex; marked by <-- HERE in m/[.zog.] <-- HERE /
+########
+# regcomp.c [S_checkposixcc]
+#
+use warnings 'regexp' ;
+$_ = "" ;
+/[[.zog.]]/;
+no warnings 'regexp' ;
+/[[.zog.]]/;
+EXPECT
+POSIX syntax [. .] is reserved for future extensions in regex; marked by <-- HERE in m/[[.zog.] <-- HERE ]/
+########
+# regcomp.c [S_regclass]
+$_ = "";
+use warnings 'regexp' ;
+/[a-b]/;
+/[a-\d]/;
+/[\d-b]/;
+/[\s-\d]/;
+/[\d-\s]/;
+/[a-[:digit:]]/;
+/[[:digit:]-b]/;
+/[[:alpha:]-[:digit:]]/;
+/[[:digit:]-[:alpha:]]/;
+no warnings 'regexp' ;
+/[a-b]/;
+/[a-\d]/;
+/[\d-b]/;
+/[\s-\d]/;
+/[\d-\s]/;
+/[a-[:digit:]]/;
+/[[:digit:]-b]/;
+/[[:alpha:]-[:digit:]]/;
+/[[:digit:]-[:alpha:]]/;
+EXPECT
+False [] range "a-\d" in regex; marked by <-- HERE in m/[a-\d <-- HERE ]/ at - line 5.
+False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE b]/ at - line 6.
+False [] range "\s-" in regex; marked by <-- HERE in m/[\s- <-- HERE \d]/ at - line 7.
+False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE \s]/ at - line 8.
+False [] range "a-[:digit:]" in regex; marked by <-- HERE in m/[a-[:digit:] <-- HERE ]/ at - line 9.
+False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE b]/ at - line 10.
+False [] range "[:alpha:]-" in regex; marked by <-- HERE in m/[[:alpha:]- <-- HERE [:digit:]]/ at - line 11.
+False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE [:alpha:]]/ at - line 12.
+########
+# regcomp.c [S_regclassutf8]
+BEGIN {
+    if (ord("\t") == 5) {
+        print "SKIPPED\n# ebcdic regular expression ranges differ.";
+        exit 0;
+    }
+}
+use utf8;
+$_ = "";
+use warnings 'regexp' ;
+/[a-b]/;
+/[a-\d]/;
+/[\d-b]/;
+/[\s-\d]/;
+/[\d-\s]/;
+/[a-[:digit:]]/;
+/[[:digit:]-b]/;
+/[[:alpha:]-[:digit:]]/;
+/[[:digit:]-[:alpha:]]/;
+no warnings 'regexp' ;
+/[a-b]/;
+/[a-\d]/;
+/[\d-b]/;
+/[\s-\d]/;
+/[\d-\s]/;
+/[a-[:digit:]]/;
+/[[:digit:]-b]/;
+/[[:alpha:]-[:digit:]]/;
+/[[:digit:]-[:alpha:]]/;
+EXPECT
+False [] range "a-\d" in regex; marked by <-- HERE in m/[a-\d <-- HERE ]/ at - line 12.
+False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE b]/ at - line 13.
+False [] range "\s-" in regex; marked by <-- HERE in m/[\s- <-- HERE \d]/ at - line 14.
+False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE \s]/ at - line 15.
+False [] range "a-[:digit:]" in regex; marked by <-- HERE in m/[a-[:digit:] <-- HERE ]/ at - line 16.
+False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE b]/ at - line 17.
+False [] range "[:alpha:]-" in regex; marked by <-- HERE in m/[[:alpha:]- <-- HERE [:digit:]]/ at - line 18.
+False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE [:alpha:]]/ at - line 19.
+########
+# regcomp.c [S_regclass S_regclassutf8]
+use warnings 'regexp' ;
+$a =~ /[a\zb]/ ;
+no warnings 'regexp' ;
+$a =~ /[a\zb]/ ;
+EXPECT
+Unrecognized escape \z in character class passed through in regex; marked by <-- HERE in m/[a\z <-- HERE b]/ at - line 3.
+
+########
+# regcomp.c [S_study_chunk]
+use warnings 'deprecated' ;
+$a = "xx" ;
+$a =~ /(?p{'x'})/ ;
+no warnings ;
+use warnings 'regexp' ;
+$a =~ /(?p{'x'})/ ;
+use warnings;
+no warnings 'deprecated' ;
+no warnings 'regexp' ;
+$a =~ /(?p{'x'})/ ;
+EXPECT
+(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 4.
+(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 7.
+########
+# regcomp.c [S_reg]
+use warnings 'regexp' ;
+$a = qr/(?c)/;
+$a = qr/(?-c)/;
+$a = qr/(?g)/;
+$a = qr/(?-g)/;
+$a = qr/(?o)/;
+$a = qr/(?-o)/;
+$a = qr/(?g-o)/;
+$a = qr/(?g-c)/;
+$a = qr/(?o-cg)/;  # (?c) means (?g) error won't be thrown
+$a = qr/(?ogc)/;
+no warnings 'regexp' ;
+$a = qr/(?c)/;
+$a = qr/(?-c)/;
+$a = qr/(?g)/;
+$a = qr/(?-g)/;
+$a = qr/(?o)/;
+$a = qr/(?-o)/;
+$a = qr/(?g-o)/;
+$a = qr/(?g-c)/;
+$a = qr/(?o-cg)/;  # (?c) means (?g) error won't be thrown
+$a = qr/(?ogc)/;
+#EXPECT
+EXPECT
+Useless (?c) - use /gc modifier in regex; marked by <-- HERE in m/(?c <-- HERE )/ at - line 3.
+Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?-c <-- HERE )/ at - line 4.
+Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE )/ at - line 5.
+Useless (?-g) - don't use /g modifier in regex; marked by <-- HERE in m/(?-g <-- HERE )/ at - line 6.
+Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE )/ at - line 7.
+Useless (?-o) - don't use /o modifier in regex; marked by <-- HERE in m/(?-o <-- HERE )/ at - line 8.
+Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE -o)/ at - line 9.
+Useless (?-o) - don't use /o modifier in regex; marked by <-- HERE in m/(?g-o <-- HERE )/ at - line 9.
+Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE -c)/ at - line 10.
+Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?g-c <-- HERE )/ at - line 10.
+Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE -cg)/ at - line 11.
+Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?o-c <-- HERE g)/ at - line 11.
+Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE gc)/ at - line 12.
+Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?og <-- HERE c)/ at - line 12.
+Useless (?c) - use /gc modifier in regex; marked by <-- HERE in m/(?ogc <-- HERE )/ at - line 12.

diff --git a/lib/warnings/regexec b/lib/warnings/regexec
new file mode 100644 (file)
index 0000000..73696df
--- /dev/null
+++ b/lib/warnings/regexec
@@ -0,0 +1,119 @@
+  regexec.c    
+
+  This test generates "bad free" warnings when run under
+  PERL_DESTRUCT_LEVEL.  This file merely serves as a placeholder
+  for investigation.
+
+  Complex regular subexpression recursion limit (%d) exceeded
+
+        $_ = 'a' x (2**15+1); /^()(a\1)*$/ ;
+  Complex regular subexpression recursion limit (%d) exceeded
+
+        $_ = 'a' x (2**15+1); /^()(a\1)*?$/ ;
+
+  (The actual value substituted for %d is masked in the tests so that
+  REG_INFTY configuration variable value does not affect outcome.)
+__END__
+# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+use warnings 'regexp' ;
+$SIG{__WARN__} = sub{local ($m) = shift;
+                 $m =~ s/\(\d+\)/(*MASKED*)/;
+                 print STDERR $m};
+$_ = 'a' x (2**15+1); 
+/^()(a\1)*$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
+EXPECT
+Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9.
+########
+# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+no warnings 'regexp' ;
+$SIG{__WARN__} = sub{local ($m) = shift;
+                 $m =~ s/\(\d+\)/(*MASKED*)/;
+                 print STDERR $m};
+$_ = 'a' x (2**15+1); 
+/^()(a\1)*$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
+EXPECT
+
+########
+# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+use warnings 'regexp' ;
+$SIG{__WARN__} = sub{local ($m) = shift;
+                 $m =~ s/\(\d+\)/(*MASKED*)/;
+                 print STDERR $m};
+$_ = 'a' x (2**15+1);
+/^()(a\1)*?$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
+EXPECT
+Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9.
+########
+# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+no warnings 'regexp' ;
+$SIG{__WARN__} = sub{local ($m) = shift;
+                 $m =~ s/\(\d+\)/(*MASKED*)/;
+                 print STDERR $m};
+$_ = 'a' x (2**15+1);
+/^()(a\1)*?$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
+EXPECT
+

diff --git a/lib/warnings/run b/lib/warnings/run
new file mode 100644 (file)
index 0000000..7a4be20
--- /dev/null
+++ b/lib/warnings/run
@@ -0,0 +1,8 @@
+  run.c 
+
+
+  Mandatory Warnings ALL TODO
+  ------------------
+        NULL OP IN RUN
+
+__END__

diff --git a/lib/warnings/sv b/lib/warnings/sv
new file mode 100644 (file)
index 0000000..b3929e2
--- /dev/null
+++ b/lib/warnings/sv
@@ -0,0 +1,320 @@
+  sv.c 
+
+  warn(warn_uninit);
+
+  warn(warn_uninit);
+
+  warn(warn_uninit);
+
+  warn(warn_uninit);
+
+  not_a_number(sv);
+
+  not_a_number(sv);
+
+  warn(warn_uninit);
+
+  not_a_number(sv);
+
+  warn(warn_uninit);
+
+  not_a_number(sv);
+
+  not_a_number(sv);
+
+  warn(warn_uninit);
+
+  warn(warn_uninit);
+
+  Subroutine %s redefined      
+
+  Invalid conversion in %s:
+
+  Undefined value assigned to typeglob
+
+  Possible Y2K bug: %d format string following '19'
+
+  Reference is already weak                    [Perl_sv_rvweaken] <<TODO
+
+  Mandatory Warnings
+  ------------------
+  Malformed UTF-8 character [sv_pos_b2u] (not tested: difficult to produce
+                                          with perl now)
+
+  Mandatory Warnings TODO
+  ------------------
+    Attempt to free non-arena SV: 0x%lx                [del_sv]
+    Reference miscount in sv_replace()         [sv_replace]
+    Attempt to free unreferenced scalar                [sv_free]
+    Attempt to free temp prematurely: SV 0x%lx [sv_free]
+    semi-panic: attempt to dup freed string    [newSVsv]
+    
+
+__END__
+# sv.c
+use integer ;
+use warnings 'uninitialized' ;
+$x = 1 + $a[0] ; # a
+no warnings 'uninitialized' ;
+$x = 1 + $b[0] ; # a
+EXPECT
+Use of uninitialized value in integer addition (+) at - line 4.
+########
+# sv.c (sv_2iv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use integer ;
+use warnings 'uninitialized' ;
+$A *= 2 ;
+no warnings 'uninitialized' ;
+$A *= 2 ;
+EXPECT
+Use of uninitialized value in integer multiplication (*) at - line 10.
+########
+# sv.c
+use integer ;
+use warnings 'uninitialized' ;
+my $x *= 2 ; #b 
+no warnings 'uninitialized' ;
+my $y *= 2 ; #b 
+EXPECT
+Use of uninitialized value in integer multiplication (*) at - line 4.
+########
+# sv.c (sv_2uv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use warnings 'uninitialized' ;
+$B = 0 ;
+$B |= $A ;
+no warnings 'uninitialized' ;
+$B = 0 ;
+$B |= $A ;
+EXPECT
+Use of uninitialized value in bitwise or (|) at - line 10.
+########
+# sv.c
+use warnings 'uninitialized' ;
+my $Y = 1 ; 
+my $x = 1 | $a[$Y] ;
+no warnings 'uninitialized' ;
+my $Y = 1 ; 
+$x = 1 | $b[$Y] ;
+EXPECT
+Use of uninitialized value in bitwise or (|) at - line 4.
+########
+# sv.c
+use warnings 'uninitialized' ;
+my $x *= 1 ; # d
+no warnings 'uninitialized' ;
+my $y *= 1 ; # d
+EXPECT
+Use of uninitialized value in multiplication (*) at - line 3.
+########
+# sv.c
+use warnings 'uninitialized' ;
+$x = 1 + $a[0] ; # e
+no warnings 'uninitialized' ;
+$x = 1 + $b[0] ; # e
+EXPECT
+Use of uninitialized value in addition (+) at - line 3.
+########
+# sv.c (sv_2nv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use warnings 'uninitialized' ;
+$A *= 2 ;
+no warnings 'uninitialized' ;
+$A *= 2 ;
+EXPECT
+Use of uninitialized value in multiplication (*) at - line 9.
+########
+# sv.c
+use warnings 'uninitialized' ;
+$x = $y + 1 ; # f
+no warnings 'uninitialized' ;
+$x = $z + 1 ; # f
+EXPECT
+Use of uninitialized value in addition (+) at - line 3.
+########
+# sv.c
+use warnings 'uninitialized' ;
+$x = chop undef ; # g
+no warnings 'uninitialized' ;
+$x = chop undef ; # g
+EXPECT
+Modification of a read-only value attempted at - line 3.
+########
+# sv.c
+use warnings 'uninitialized' ;
+$x = chop $y ; # h
+no warnings 'uninitialized' ;
+$x = chop $z ; # h
+EXPECT
+Use of uninitialized value in scalar chop at - line 3.
+########
+# sv.c (sv_2pv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use warnings 'uninitialized' ;
+$B = "" ;
+$B .= $A ;
+no warnings 'uninitialized' ;
+$C = "" ;
+$C .= $A ;
+EXPECT
+Use of uninitialized value in concatenation (.) or string at - line 10.
+########
+# sv.c 
+use warnings 'numeric' ;
+sub TIESCALAR{bless[]} ; 
+sub FETCH {"def"} ; 
+tie $a,"main" ; 
+my $b = 1 + $a;
+no warnings 'numeric' ;
+my $c = 1 + $a;
+EXPECT
+Argument "def" isn't numeric in addition (+) at - line 6.
+########
+# sv.c
+use warnings 'numeric' ;
+my $x = 1 + "def" ;
+no warnings 'numeric' ;
+my $z = 1 + "def" ;
+EXPECT
+Argument "def" isn't numeric in addition (+) at - line 3.
+########
+# sv.c
+use warnings 'numeric' ;
+my $a = "def" ;
+my $x = 1 + $a ;
+no warnings 'numeric' ;
+my $y = 1 + $a ;
+EXPECT
+Argument "def" isn't numeric in addition (+) at - line 4.
+########
+# sv.c
+use warnings 'numeric' ; use integer ;
+my $a = "def" ;
+my $x = 1 + $a ;
+no warnings 'numeric' ;
+my $z = 1 + $a ;
+EXPECT
+Argument "def" isn't numeric in integer addition (+) at - line 4.
+########
+# sv.c
+use warnings 'numeric' ;
+my $x = 1 & "def" ;
+no warnings 'numeric' ;
+my $z = 1 & "def" ;
+EXPECT
+Argument "def" isn't numeric in bitwise and (&) at - line 3.
+########
+# sv.c
+use warnings 'numeric' ;
+my $x = pack i => "def" ;
+no warnings 'numeric' ;
+my $z = pack i => "def" ;
+EXPECT
+Argument "def" isn't numeric in pack at - line 3.
+########
+# sv.c
+use warnings 'numeric' ; 
+my $a = "d\0f" ;
+my $x = 1 + $a ;
+no warnings 'numeric' ;
+my $z = 1 + $a ;
+EXPECT
+Argument "d\0f" isn't numeric in addition (+) at - line 4.
+########
+# sv.c
+use warnings 'redefine' ;
+sub fred {}  
+sub joe {} 
+*fred = \&joe ;
+no warnings 'redefine' ;
+sub jim {} 
+*jim = \&joe ;
+EXPECT
+Subroutine fred redefined at - line 5.
+########
+# sv.c
+use warnings 'printf' ;
+open F, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
+printf F "%z\n" ;
+my $a = sprintf "%z" ;
+printf F "%" ;
+$a = sprintf "%" ;
+printf F "%\x02" ;
+$a = sprintf "%\x02" ;
+no warnings 'printf' ;
+printf F "%z\n" ;
+$a = sprintf "%z" ;
+printf F "%" ;
+$a = sprintf "%" ;
+printf F "%\x02" ;
+$a = sprintf "%\x02" ;
+EXPECT
+Invalid conversion in sprintf: "%z" at - line 5.
+Invalid conversion in sprintf: end of string at - line 7.
+Invalid conversion in sprintf: "%\002" at - line 9.
+Invalid conversion in printf: "%z" at - line 4.
+Invalid conversion in printf: end of string at - line 6.
+Invalid conversion in printf: "%\002" at - line 8.
+########
+# sv.c
+use warnings 'misc' ;
+*a = undef ;
+no warnings 'misc' ;
+*b = undef ;
+EXPECT
+Undefined value assigned to typeglob at - line 3.
+########
+# sv.c
+use warnings 'y2k';
+use Config;
+BEGIN {
+    unless ($Config{ccflags} =~ /Y2KWARN/) {
+       print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
+       exit 0;
+    }
+    $|=1;
+}
+my $x;
+my $yy = 78;
+$x     = printf  "19%02d\n", $yy;
+$x     = sprintf "#19%02d\n", $yy;
+$x     = printf  " 19%02d\n", 78;
+$x     = sprintf "19%02d\n", 78;
+$x     = printf  "319%02d\n", $yy;
+$x     = sprintf "319%02d\n", $yy;
+no warnings 'y2k';
+$x     = printf  "19%02d\n", $yy;
+$x     = sprintf "19%02d\n", $yy;
+$x     = printf  "19%02d\n", 78;
+$x     = sprintf "19%02d\n", 78;
+EXPECT
+Possible Y2K bug: %d format string following '19' at - line 16.
+Possible Y2K bug: %d format string following '19' at - line 13.
+1978
+Possible Y2K bug: %d format string following '19' at - line 14.
+Possible Y2K bug: %d format string following '19' at - line 15.
+ 1978
+31978
+1978
+1978

diff --git a/lib/warnings/taint b/lib/warnings/taint
new file mode 100644 (file)
index 0000000..fd6deed
--- /dev/null
+++ b/lib/warnings/taint
@@ -0,0 +1,49 @@
+  taint.c AOK
+
+  Insecure %s%s while running with -T switch
+
+__END__
+-T
+--FILE-- abc
+def
+--FILE--
+# taint.c
+open(FH, "<abc") ;
+$a = <FH> ;
+close FH ;
+chdir $a ;
+print "xxx\n" ;
+EXPECT
+Insecure dependency in chdir while running with -T switch at - line 5.
+########
+-TU
+--FILE-- abc
+def
+--FILE--
+# taint.c
+open(FH, "<abc") ;
+$a = <FH> ;
+close FH ;
+chdir $a ;
+print "xxx\n" ;
+EXPECT
+xxx
+########
+-TU
+--FILE-- abc
+def
+--FILE--
+# taint.c
+open(FH, "<abc") ;
+$a = <FH> ;
+close FH ;
+use warnings 'taint' ;
+chdir $a ;
+print "xxx\n" ;
+no warnings 'taint' ;
+chdir $a ;
+print "yyy\n" ;
+EXPECT
+Insecure dependency in chdir while running with -T switch at - line 6.
+xxx
+yyy

diff --git a/lib/warnings/toke b/lib/warnings/toke
new file mode 100644 (file)
index 0000000..242b005
--- /dev/null
+++ b/lib/warnings/toke
@@ -0,0 +1,732 @@
+toke.c AOK
+
+    we seem to have lost a few ambiguous warnings!!
+
+ 
+               $a = <<;
+               Use of comma-less variable list is deprecated 
+               (called 3 times via depcom)
+
+     \1 better written as $1 
+       use warnings 'syntax' ;
+       s/(abc)/\1/;
+ 
+     warn(warn_nosemi) 
+     Semicolon seems to be missing
+       $a = 1
+       &time ;
+
+
+     Reversed %c= operator 
+       my $a =+ 2 ;
+       $a =- 2 ;
+       $a =* 2 ;
+       $a =% 2 ;
+       $a =& 2 ;
+       $a =. 2 ;
+       $a =^ 2 ;
+       $a =| 2 ;
+       $a =< 2 ;
+       $a =/ 2 ;
+
+     Multidimensional syntax %.*s not supported 
+       my $a = $a[1,2] ;
+
+     You need to quote \"%s\"" 
+       sub fred {} ; $SIG{TERM} = fred;
+
+     Scalar value %.*s better written as $%.*s" 
+       @a[3] = 2;
+       @a{3} = 2;
+
+     Can't use \\%c to mean $%c in expression 
+       $_ = "ab" ; s/(ab)/\1/e;
+
+     Unquoted string "abc" may clash with future reserved word at - line 3.
+     warn(warn_reserved        
+       $a = abc;
+
+     chmod() mode argument is missing initial 0 
+       chmod 3;
+
+     Possible attempt to separate words with commas 
+       @a = qw(a, b, c) ;
+
+     Possible attempt to put comments in qw() list 
+       @a = qw(a b # c) ;
+
+     umask: argument is missing initial 0 
+       umask 3;
+
+     %s (...) interpreted as function 
+       print ("")
+       printf ("")
+       sort ("")
+
+     Ambiguous use of %c{%s%s} resolved to %c%s%s 
+       $a = ${time[2]}
+       $a = ${time{2}}
+
+
+     Ambiguous use of %c{%s} resolved to %c%s
+       $a = ${time}
+       sub fred {} $a = ${fred}
+
+     Misplaced _ in number 
+       $a = 1_2;
+       $a = 1_2345_6;
+
+    Bareword \"%s\" refers to nonexistent package
+       $a = FRED:: ;
+
+    Ambiguous call resolved as CORE::%s(), qualify as such or use &
+       sub time {} 
+       my $a = time()
+
+    Unrecognized escape \\%c passed through
+        $a = "\m" ;
+
+    %s number > %s non-portable
+        my $a =  0b011111111111111111111111111111110 ;
+        $a =  0b011111111111111111111111111111111 ;
+        $a =  0b111111111111111111111111111111111 ;
+        $a =  0x0fffffffe ;
+        $a =  0x0ffffffff ;
+        $a =  0x1ffffffff ;
+        $a =  0037777777776 ;
+        $a =  0037777777777 ;
+        $a =  0047777777777 ;
+
+    Integer overflow in binary number
+        my $a =  0b011111111111111111111111111111110 ;
+        $a =  0b011111111111111111111111111111111 ;
+        $a =  0b111111111111111111111111111111111 ;
+        $a =  0x0fffffffe ;
+        $a =  0x0ffffffff ;
+        $a =  0x1ffffffff ;
+        $a =  0037777777776 ;
+        $a =  0037777777777 ;
+        $a =  0047777777777 ;
+     
+    Mandatory Warnings
+    ------------------
+    Use of "%s" without parentheses is ambiguous       [check_uni]
+        rand + 4 
+
+    Ambiguous use of -%s resolved as -&%s()            [yylex]
+        sub fred {} ; - fred ;
+
+    Precedence problem: open %.*s should be open(%.*s) [yylex]
+       open FOO || die;
+
+    Operator or semicolon missing before %c%s          [yylex]
+    Ambiguous use of %c resolved as operator %c
+        *foo *foo
+
+__END__
+# toke.c 
+use warnings 'deprecated' ;
+format STDOUT =
+@<<<  @|||  @>>>  @>>>
+$a    $b    "abc" 'def'
+.
+no warnings 'deprecated' ;
+format STDOUT =
+@<<<  @|||  @>>>  @>>>
+$a    $b    "abc" 'def'
+.
+EXPECT
+Use of comma-less variable list is deprecated at - line 5.
+Use of comma-less variable list is deprecated at - line 5.
+Use of comma-less variable list is deprecated at - line 5.
+########
+# toke.c
+use warnings 'deprecated' ;
+$a = <<;
+
+no warnings 'deprecated' ;
+$a = <<;
+
+EXPECT
+Use of bare << to mean <<"" is deprecated at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+s/(abc)/\1/;
+no warnings 'syntax' ;
+s/(abc)/\1/;
+EXPECT
+\1 better written as $1 at - line 3.
+########
+# toke.c
+use warnings 'semicolon' ;
+$a = 1
+&time ;
+no warnings 'semicolon' ;
+$a = 1
+&time ;
+EXPECT
+Semicolon seems to be missing at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+my $a =+ 2 ;
+$a =- 2 ;
+$a =* 2 ;
+$a =% 2 ;
+$a =& 2 ;
+$a =. 2 ;
+$a =^ 2 ;
+$a =| 2 ;
+$a =< 2 ;
+$a =/ 2 ;
+EXPECT
+Reversed += operator at - line 3.
+Reversed -= operator at - line 4.
+Reversed *= operator at - line 5.
+Reversed %= operator at - line 6.
+Reversed &= operator at - line 7.
+Reversed .= operator at - line 8.
+Reversed ^= operator at - line 9.
+Reversed |= operator at - line 10.
+Reversed <= operator at - line 11.
+syntax error at - line 8, near "=."
+syntax error at - line 9, near "=^"
+syntax error at - line 10, near "=|"
+Unterminated <> operator at - line 11.
+########
+# toke.c
+no warnings 'syntax' ;
+my $a =+ 2 ;
+$a =- 2 ;
+$a =* 2 ;
+$a =% 2 ;
+$a =& 2 ;
+$a =. 2 ;
+$a =^ 2 ;
+$a =| 2 ;
+$a =< 2 ;
+$a =/ 2 ;
+EXPECT
+syntax error at - line 8, near "=."
+syntax error at - line 9, near "=^"
+syntax error at - line 10, near "=|"
+Unterminated <> operator at - line 11.
+########
+# toke.c
+use warnings 'syntax' ;
+my $a = $a[1,2] ;
+no warnings 'syntax' ;
+my $a = $a[1,2] ;
+EXPECT
+Multidimensional syntax $a[1,2] not supported at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+sub fred {} ; $SIG{TERM} = fred;
+no warnings 'syntax' ;
+$SIG{TERM} = fred;
+EXPECT
+You need to quote "fred" at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+@a[3] = 2;
+@a{3} = 2;
+no warnings 'syntax' ;
+@a[3] = 2;
+@a{3} = 2;
+EXPECT
+Scalar value @a[3] better written as $a[3] at - line 3.
+Scalar value @a{3} better written as $a{3} at - line 4.
+########
+# toke.c
+use warnings 'syntax' ;
+$_ = "ab" ; 
+s/(ab)/\1/e;
+no warnings 'syntax' ;
+$_ = "ab" ; 
+s/(ab)/\1/e;
+EXPECT
+Can't use \1 to mean $1 in expression at - line 4.
+########
+# toke.c
+use warnings 'reserved' ;
+$a = abc;
+$a = { def
+
+=> 1 };
+no warnings 'reserved' ;
+$a = abc;
+EXPECT
+Unquoted string "abc" may clash with future reserved word at - line 3.
+########
+# toke.c
+use warnings 'chmod' ;
+chmod 3;
+no warnings 'chmod' ;
+chmod 3;
+EXPECT
+chmod() mode argument is missing initial 0 at - line 3.
+########
+# toke.c
+use warnings 'qw' ;
+@a = qw(a, b, c) ;
+no warnings 'qw' ;
+@a = qw(a, b, c) ;
+EXPECT
+Possible attempt to separate words with commas at - line 3.
+########
+# toke.c
+use warnings 'qw' ;
+@a = qw(a b #) ;
+no warnings 'qw' ;
+@a = qw(a b #) ;
+EXPECT
+Possible attempt to put comments in qw() list at - line 3.
+########
+# toke.c
+use warnings 'umask' ;
+umask 3;
+no warnings 'umask' ;
+umask 3;
+EXPECT
+umask: argument is missing initial 0 at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+print ("")
+EXPECT
+print (...) interpreted as function at - line 3.
+########
+# toke.c
+no warnings 'syntax' ;
+print ("")
+EXPECT
+
+########
+# toke.c
+use warnings 'syntax' ;
+printf ("")
+EXPECT
+printf (...) interpreted as function at - line 3.
+########
+# toke.c
+no warnings 'syntax' ;
+printf ("")
+EXPECT
+
+########
+# toke.c
+use warnings 'syntax' ;
+sort ("")
+EXPECT
+sort (...) interpreted as function at - line 3.
+########
+# toke.c
+no warnings 'syntax' ;
+sort ("")
+EXPECT
+
+########
+# toke.c
+use warnings 'ambiguous' ;
+$a = ${time[2]};
+no warnings 'ambiguous' ;
+$a = ${time[2]};
+EXPECT
+Ambiguous use of ${time[...]} resolved to $time[...] at - line 3.
+########
+# toke.c
+use warnings 'ambiguous' ;
+$a = ${time{2}};
+EXPECT
+Ambiguous use of ${time{...}} resolved to $time{...} at - line 3.
+########
+# toke.c
+no warnings 'ambiguous' ;
+$a = ${time{2}};
+EXPECT
+
+########
+# toke.c
+use warnings 'ambiguous' ;
+$a = ${time} ;
+no warnings 'ambiguous' ;
+$a = ${time} ;
+EXPECT
+Ambiguous use of ${time} resolved to $time at - line 3.
+########
+# toke.c
+use warnings 'ambiguous' ;
+sub fred {}
+$a = ${fred} ;
+no warnings 'ambiguous' ;
+$a = ${fred} ;
+EXPECT
+Ambiguous use of ${fred} resolved to $fred at - line 4.
+########
+# toke.c
+use warnings 'syntax' ;
+$a = _123; print "$a\n";               #( 3    string)
+$a = 1_23; print "$a\n";
+$a = 12_3; print "$a\n";
+$a = 123_; print "$a\n";               #  6
+$a = _+123; print "$a\n";              #  7    string)
+$a = +_123; print "$a\n";              #( 8    string)
+$a = +1_23; print "$a\n";
+$a = +12_3; print "$a\n";
+$a = +123_; print "$a\n";              # 11
+$a = _-123; print "$a\n";              #(12    string)
+$a = -_123; print "$a\n";              #(13    string)
+$a = -1_23; print "$a\n";
+$a = -12_3; print "$a\n";
+$a = -123_; print "$a\n";              # 16
+$a = 123._456; print "$a\n";           # 17
+$a = 123.4_56; print "$a\n";
+$a = 123.45_6; print "$a\n";
+$a = 123.456_; print "$a\n";           # 20
+$a = +123._456; print "$a\n";          # 21
+$a = +123.4_56; print "$a\n";  
+$a = +123.45_6; print "$a\n";  
+$a = +123.456_; print "$a\n";          # 24
+$a = -123._456; print "$a\n";          # 25
+$a = -123.4_56; print "$a\n";  
+$a = -123.45_6; print "$a\n";
+$a = -123.456_; print "$a\n";          # 28
+$a = 123.456E_12; print "$a\n";                # 29
+$a = 123.456E1_2; print "$a\n";
+$a = 123.456E12_; print "$a\n";                # 31
+$a = 123.456E_+12; print "$a\n";       # 32
+$a = 123.456E+_12; print "$a\n";       # 33
+$a = 123.456E+1_2; print "$a\n";
+$a = 123.456E+12_; print "$a\n";       # 35
+$a = 123.456E_-12; print "$a\n";       # 36
+$a = 123.456E-_12; print "$a\n";       # 37
+$a = 123.456E-1_2; print "$a\n";
+$a = 123.456E-12_; print "$a\n";       # 39
+$a = 1__23; print "$a\n";              # 40
+$a = 12.3__4; print "$a\n";            # 41
+$a = 12.34e1__2; print "$a\n";         # 42
+no warnings 'syntax' ;
+$a = _123; print "$a\n";
+$a = 1_23; print "$a\n";
+$a = 12_3; print "$a\n";
+$a = 123_; print "$a\n";
+$a = _+123; print "$a\n";
+$a = +_123; print "$a\n";
+$a = +1_23; print "$a\n";
+$a = +12_3; print "$a\n";
+$a = +123_; print "$a\n";
+$a = _-123; print "$a\n";
+$a = -_123; print "$a\n";
+$a = -1_23; print "$a\n";
+$a = -12_3; print "$a\n";
+$a = -123_; print "$a\n";
+$a = 123._456; print "$a\n";
+$a = 123.4_56; print "$a\n";
+$a = 123.45_6; print "$a\n";
+$a = 123.456_; print "$a\n";
+$a = +123._456; print "$a\n";
+$a = +123.4_56; print "$a\n";
+$a = +123.45_6; print "$a\n";
+$a = +123.456_; print "$a\n";
+$a = -123._456; print "$a\n";
+$a = -123.4_56; print "$a\n";
+$a = -123.45_6; print "$a\n";
+$a = -123.456_; print "$a\n";
+$a = 123.456E_12; print "$a\n";
+$a = 123.456E1_2; print "$a\n";
+$a = 123.456E12_; print "$a\n";
+$a = 123.456E_+12; print "$a\n";
+$a = 123.456E+_12; print "$a\n";
+$a = 123.456E+1_2; print "$a\n";
+$a = 123.456E+12_; print "$a\n";
+$a = 123.456E_-12; print "$a\n";
+$a = 123.456E-_12; print "$a\n";
+$a = 123.456E-1_2; print "$a\n";
+$a = 123.456E-12_; print "$a\n";
+$a = 1__23; print "$a\n";
+$a = 12.3__4; print "$a\n";
+$a = 12.34e1__2; print "$a\n";
+EXPECT
+OPTIONS regex
+Misplaced _ in number at - line 6.
+Misplaced _ in number at - line 11.
+Misplaced _ in number at - line 16.
+Misplaced _ in number at - line 17.
+Misplaced _ in number at - line 20.
+Misplaced _ in number at - line 21.
+Misplaced _ in number at - line 24.
+Misplaced _ in number at - line 25.
+Misplaced _ in number at - line 28.
+Misplaced _ in number at - line 29.
+Misplaced _ in number at - line 31.
+Misplaced _ in number at - line 32.
+Misplaced _ in number at - line 33.
+Misplaced _ in number at - line 35.
+Misplaced _ in number at - line 36.
+Misplaced _ in number at - line 37.
+Misplaced _ in number at - line 39.
+Misplaced _ in number at - line 40.
+Misplaced _ in number at - line 41.
+Misplaced _ in number at - line 42.
+_123
+123
+123
+123
+123
+_123
+123
+123
+123
+-123
+-_123
+-123
+-123
+-123
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+-123.456
+-123.456
+-123.456
+-123.456
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+1.23456e-0?10
+1.23456e-0?10
+1.23456e-0?10
+1.23456e-0?10
+123
+12.34
+12340000000000
+_123
+123
+123
+123
+123
+_123
+123
+123
+123
+-123
+-_123
+-123
+-123
+-123
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+-123.456
+-123.456
+-123.456
+-123.456
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+1.23456e-0?10
+1.23456e-0?10
+1.23456e-0?10
+1.23456e-0?10
+123
+12.34
+12340000000000
+########
+# toke.c
+use warnings 'bareword' ;
+#line 25 "bar"
+$a = FRED:: ;
+no warnings 'bareword' ;
+#line 25 "bar"
+$a = FRED:: ;
+EXPECT
+Bareword "FRED::" refers to nonexistent package at bar line 25.
+########
+# toke.c
+use warnings 'ambiguous' ;
+sub time {}
+my $a = time() ;
+no warnings 'ambiguous' ;
+my $b = time() ;
+EXPECT
+Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4.
+########
+# toke.c
+use warnings ;
+eval <<'EOE';
+#  line 30 "foo"
+warn "yelp";
+{
+  $_ = " \x{123} " ;
+}
+EOE
+EXPECT
+yelp at foo line 30.
+########
+# toke.c
+my $a = rand + 4 ;
+EXPECT
+Warning: Use of "rand" without parens is ambiguous at - line 2.
+########
+# toke.c
+$^W = 0 ;
+my $a = rand + 4 ;
+{
+    no warnings 'ambiguous' ;
+    $a = rand + 4 ;
+    use warnings 'ambiguous' ;
+    $a = rand + 4 ;
+}
+$a = rand + 4 ;
+EXPECT
+Warning: Use of "rand" without parens is ambiguous at - line 3.
+Warning: Use of "rand" without parens is ambiguous at - line 8.
+Warning: Use of "rand" without parens is ambiguous at - line 10.
+########
+# toke.c
+sub fred {};
+-fred ;
+EXPECT
+Ambiguous use of -fred resolved as -&fred() at - line 3.
+########
+# toke.c
+$^W = 0 ;
+sub fred {} ;
+-fred ;
+{
+    no warnings 'ambiguous' ;
+    -fred ;
+    use warnings 'ambiguous' ;
+    -fred ;
+}
+-fred ;
+EXPECT
+Ambiguous use of -fred resolved as -&fred() at - line 4.
+Ambiguous use of -fred resolved as -&fred() at - line 9.
+Ambiguous use of -fred resolved as -&fred() at - line 11.
+########
+# toke.c
+open FOO || time;
+EXPECT
+Precedence problem: open FOO should be open(FOO) at - line 2.
+########
+# toke.c
+$^W = 0 ;
+open FOO || time;
+{
+    no warnings 'precedence' ;
+    open FOO || time;
+    use warnings 'precedence' ;
+    open FOO || time;
+}
+open FOO || time;
+EXPECT
+Precedence problem: open FOO should be open(FOO) at - line 3.
+Precedence problem: open FOO should be open(FOO) at - line 8.
+Precedence problem: open FOO should be open(FOO) at - line 10.
+########
+# toke.c
+$^W = 0 ;
+*foo *foo ;
+{
+    no warnings 'ambiguous' ;
+    *foo *foo ;
+    use warnings 'ambiguous' ;
+    *foo *foo ;
+}
+*foo *foo ;
+EXPECT
+Operator or semicolon missing before *foo at - line 3.
+Ambiguous use of * resolved as operator * at - line 3.
+Operator or semicolon missing before *foo at - line 8.
+Ambiguous use of * resolved as operator * at - line 8.
+Operator or semicolon missing before *foo at - line 10.
+Ambiguous use of * resolved as operator * at - line 10.
+########
+# toke.c
+use warnings 'misc' ;
+my $a = "\m" ;
+no warnings 'misc' ;
+$a = "\m" ;
+EXPECT
+Unrecognized escape \m passed through at - line 3.
+########
+# toke.c
+use warnings 'portable' ;
+my $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+no warnings 'portable' ;
+   $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+EXPECT
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
+Hexadecimal number > 0xffffffff non-portable at - line 8.
+Octal number > 037777777777 non-portable at - line 11.
+########
+# toke.c
+use warnings 'overflow' ;
+my $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b10000000000000000000000000000000000000000000000000000000000000000 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x10000000000000000 ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  002000000000000000000000;
+no warnings 'overflow' ;
+   $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b10000000000000000000000000000000000000000000000000000000000000000 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x10000000000000000 ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  002000000000000000000000;
+EXPECT
+Integer overflow in binary number at - line 5.
+Integer overflow in hexadecimal number at - line 8.
+Integer overflow in octal number at - line 11.
+########
+# toke.c
+use warnings 'ambiguous';
+"@mjd_previously_unused_array";        
+no warnings 'ambiguous';
+"@mjd_previously_unused_array";        
+EXPECT
+Possible unintended interpolation of @mjd_previously_unused_array in string at - line 3.

diff --git a/lib/warnings/universal b/lib/warnings/universal
new file mode 100644 (file)
index 0000000..d9b1883
--- /dev/null
+++ b/lib/warnings/universal
@@ -0,0 +1,14 @@
+  universal.c AOK
+
+  Can't locate package %s for @%s::ISA [S_isa_lookup]
+      
+
+
+__END__
+# universal.c [S_isa_lookup]
+use warnings 'misc' ;
+@ISA = qw(Joe) ;
+my $a = bless [] ;
+UNIVERSAL::isa $a, Jim ;
+EXPECT
+Can't locate package Joe for @main::ISA at - line 5.

diff --git a/lib/warnings/utf8 b/lib/warnings/utf8
new file mode 100644 (file)
index 0000000..9a7dbaf
--- /dev/null
+++ b/lib/warnings/utf8
@@ -0,0 +1,35 @@
+
+  utf8.c AOK
+
+     [utf8_to_uv]
+     Malformed UTF-8 character
+       my $a = ord "\x80" ;
+
+     Malformed UTF-8 character
+       my $a = ord "\xf080" ;
+     <<<<<< this warning can't be easily triggered from perl anymore
+
+     [utf16_to_utf8]
+     Malformed UTF-16 surrogate                
+     <<<<<< Add a test when somethig actually calls utf16_to_utf8
+
+__END__
+# utf8.c [utf8_to_uv] -W
+BEGIN {
+    if (ord('A') == 193) {
+        print "SKIPPED\n# ebcdic platforms do not generate Malformed UTF-8 warnings.";
+        exit 0;
+    }
+}
+use utf8 ;
+my $a = "snøstorm" ;
+{
+    no warnings 'utf8' ;
+    my $a = "snøstorm";
+    use warnings 'utf8' ;
+    my $a = "snøstorm";
+}
+EXPECT
+Malformed UTF-8 character (unexpected non-continuation byte 0x73 after start byte 0xf8) at - line 9.
+Malformed UTF-8 character (unexpected non-continuation byte 0x73 after start byte 0xf8) at - line 14.
+########

diff --git a/lib/warnings/util b/lib/warnings/util
new file mode 100644 (file)
index 0000000..e82d6a6
--- /dev/null
+++ b/lib/warnings/util
@@ -0,0 +1,108 @@
+  util.c AOK
+ 
+     Illegal octal digit ignored 
+       my $a = oct "029" ;
+
+     Illegal hex digit ignored 
+       my $a = hex "0xv9" ;
+
+     Illegal binary digit ignored
+      my $a = oct "0b9" ;
+     
+     Integer overflow in binary number
+       my $a =  oct "0b111111111111111111111111111111111111111111" ;
+     Binary number > 0b11111111111111111111111111111111 non-portable
+       $a =  oct "0b111111111111111111111111111111111" ;
+     Integer overflow in octal number
+       my $a =  oct "077777777777777777777777777777" ;
+     Octal number > 037777777777 non-portable
+       $a =  oct "0047777777777" ;
+     Integer overflow in hexadecimal number
+       my $a =  hex "0xffffffffffffffffffff" ;
+     Hexadecimal number > 0xffffffff non-portable
+       $a =  hex "0x1ffffffff" ;
+
+__END__
+# util.c
+use warnings 'digit' ;
+my $a = oct "029" ;
+no warnings 'digit' ;
+$a = oct "029" ;
+EXPECT
+Illegal octal digit '9' ignored at - line 3.
+########
+# util.c
+use warnings 'digit' ;
+my $a =  hex "0xv9" ;
+no warnings 'digit' ;
+$a =  hex "0xv9" ;
+EXPECT
+Illegal hexadecimal digit 'v' ignored at - line 3.
+########
+# util.c
+use warnings 'digit' ;
+my $a =  oct "0b9" ;
+no warnings 'digit' ;
+$a =  oct "0b9" ;
+EXPECT
+Illegal binary digit '9' ignored at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  oct "0b11111111111111111111111111111111111111111111111111111111111111111";
+no warnings 'overflow' ;
+$a =  oct "0b11111111111111111111111111111111111111111111111111111111111111111";
+EXPECT
+Integer overflow in binary number at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  hex "0xffffffffffffffffffff" ;
+no warnings 'overflow' ;
+$a =  hex "0xffffffffffffffffffff" ;
+EXPECT
+Integer overflow in hexadecimal number at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  oct "077777777777777777777777777777" ;
+no warnings 'overflow' ;
+$a =  oct "077777777777777777777777777777" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  oct "0b011111111111111111111111111111110" ;
+   $a =  oct "0b011111111111111111111111111111111" ;
+   $a =  oct "0b111111111111111111111111111111111" ;
+no warnings 'portable' ;
+   $a =  oct "0b011111111111111111111111111111110" ;
+   $a =  oct "0b011111111111111111111111111111111" ;
+   $a =  oct "0b111111111111111111111111111111111" ;
+EXPECT
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  hex "0x0fffffffe" ;
+   $a =  hex "0x0ffffffff" ;
+   $a =  hex "0x1ffffffff" ;
+no warnings 'portable' ;
+   $a =  hex "0x0fffffffe" ;
+   $a =  hex "0x0ffffffff" ;
+   $a =  hex "0x1ffffffff" ;
+EXPECT
+Hexadecimal number > 0xffffffff non-portable at - line 5.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  oct "0037777777776" ;
+   $a =  oct "0037777777777" ;
+   $a =  oct "0047777777777" ;
+no warnings 'portable' ;
+   $a =  oct "0037777777776" ;
+   $a =  oct "0037777777777" ;
+   $a =  oct "0047777777777" ;
+EXPECT
+Octal number > 037777777777 non-portable at - line 5.

diff --git a/t/TEST b/t/TEST
index ec8c8f2f1522103735fee4bf6e9f2022fdc2ed08..5fcc26865ae8f06b6ba8d12f746ae915624f7458 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -64,13 +64,13 @@ sub _find_tests {
 }
 
 unless (@ARGV) {
-    foreach my $dir (qw(base comp cmd run io op pragma lib pod)) {
+    foreach my $dir (qw(base comp cmd run io op lib)) {
         _find_tests($dir);
     }
     my $mani = File::Spec->catdir($updir, "MANIFEST");
     if (open(MANI, $mani)) {
         while (<MANI>) { # similar code in t/harness
-           if (m!^(ext/.+/([^/]+\.t|test\.pl)|lib/.+(\.t|test\.pl))\s!) {
+           if (m!^(ext/\S+/([^/]+\.t|test\.pl)|lib/\S+?(\.t|test\.pl))\s!) {
                push @ARGV, $1;
                $OVER{$1} = File::Spec->catdir($updir, $1);
            }
@@ -78,6 +78,7 @@ unless (@ARGV) {
     } else {
         warn "$0: cannot open $mani: $!\n";
     }
+    _find_tests('pod');
 }
 
 # Tests known to cause infinite loops for the perlcc tests.
@@ -146,7 +147,7 @@ EOT
            }
        }
        $te = $test;
-       chop($te);
+       $te =~ s/\.\w+$/./;
        print "$te" . '.' x ($dotdotdot - length($te));
 
        $test = $OVER{$test} if exists $OVER{$test};

diff --git a/t/harness b/t/harness
index e5ec0d6a26b2f6b07b0f530016310975a2fc79f3..9b2e09798aa45596fba1eae5c251d1206dff7d67 100644 (file)
--- a/t/harness
+++ b/t/harness
@@ -29,7 +29,6 @@ $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v';
                op/runlevel.t           1
                op/tie.t                1
                op/lex_assign.t         1
-               pragma/subs.t           1
                );
 
 foreach (keys %datahandle) {
@@ -39,18 +38,21 @@ foreach (keys %datahandle) {
 if (@ARGV) {
     @tests = @ARGV;
 } else {
-    @tests = <base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t lib/*.t pod/*.t> unless @tests;
-    use File::Spec;
-    my $updir = File::Spec->updir;
-    my $mani  = File::Spec->catdir(File::Spec->updir, "MANIFEST");
-    if (open(MANI, $mani)) {
-        while (<MANI>) { # similar code in t/TEST
-           if (m!^(ext/.+/([^/]+\.t|test\.pl)|lib/.+(\.t|test\.pl))\s!) {
-               push @tests, File::Spec->catdir($updir, $1);
+    unless (@tests) {
+       @tests = <base/*.t comp/*.t cmd/*.t io/*.t op/*.t lib/*.t>;
+       use File::Spec;
+       my $updir = File::Spec->updir;
+       my $mani  = File::Spec->catdir(File::Spec->updir, "MANIFEST");
+       if (open(MANI, $mani)) {
+           while (<MANI>) { # similar code in t/TEST
+           if (m!^(ext/\S+/([^/]+\.t|test\.pl)|lib/\S+?(\.t|test\.pl))\s!) {
+                   push @tests, File::Spec->catdir($updir, $1);
+               }
            }
+       } else {
+           warn "$0: cannot open $mani: $!\n";
        }
-    } else {
-        warn "$0: cannot open $mani: $!\n";
+       push @tests, <pod/*.t>;
     }
 }
 

diff --git a/t/lib/Test/fail.t b/t/lib/Test/fail.t
deleted file mode 100644 (file)
index b431502..0000000
--- a/t/lib/Test/fail.t
+++ /dev/null
@@ -1,93 +0,0 @@
-# -*-perl-*-
-use strict;
-use vars qw($Expect);
-use Test qw($TESTOUT $ntest ok skip plan); 
-plan tests => 14;
-
-open F, ">fails";
-$TESTOUT = *F{IO};
-
-my $r=0;
-{
-    # Shut up deprecated usage warning.
-    local $^W = 0;
-    $r |= skip(0,0);
-}
-$r |= ok(0);
-$r |= ok(0,1);
-$r |= ok(sub { 1+1 }, 3);
-$r |= ok(sub { 1+1 }, sub { 2 * 0});
-
-my @list = (0,0);
-$r |= ok @list, 1, "\@list=".join(',',@list);
-$r |= ok @list, 1, sub { "\@list=".join ',',@list };
-$r |= ok 'segmentation fault', '/bongo/';
-
-for (1..2) { $r |= ok(0); }
-
-$r |= ok(1, undef);
-$r |= ok(undef, 1);
-
-ok($r); # (failure==success :-)
-
-close F;
-$TESTOUT = *STDOUT{IO};
-$ntest = 1;
-
-open F, "fails";
-my $O;
-while (<F>) { $O .= $_; }
-close F;
-unlink "fails";
-
-ok join(' ', map { m/(\d+)/; $1 } grep /^not ok/, split /\n+/, $O),
-    join(' ', 1..13);
-
-my @got = split /not ok \d+\n/, $O;
-shift @got;
-
-$Expect =~ s/\n+$//;
-my @expect = split /\n\n/, $Expect;
-
-for (my $x=0; $x < @got; $x++) {
-    ok $got[$x], $expect[$x]."\n";
-}
-
-
-BEGIN {
-    $Expect = <<"EXPECT";
-# Failed test 1 in $0 at line 14
-
-# Failed test 2 in $0 at line 16
-
-# Test 3 got: '0' ($0 at line 17)
-#   Expected: '1'
-
-# Test 4 got: '2' ($0 at line 18)
-#   Expected: '3'
-
-# Test 5 got: '2' ($0 at line 19)
-#   Expected: '0'
-
-# Test 6 got: '2' ($0 at line 22)
-#   Expected: '1' (\@list=0,0)
-
-# Test 7 got: '2' ($0 at line 23)
-#   Expected: '1' (\@list=0,0)
-
-# Test 8 got: 'segmentation fault' ($0 at line 24)
-#   Expected: qr{bongo}
-
-# Failed test 9 in $0 at line 26
-
-# Failed test 10 in $0 at line 26 fail #2
-
-# Failed test 11 in $0 at line 28
-
-# Test 12 got: <UNDEF> ($0 at line 29)
-#    Expected: '1'
-
-# Failed test 13 in $0 at line 31
-EXPECT
-
-}

diff --git a/t/lib/Test/mix.t b/t/lib/Test/mix.t
deleted file mode 100644 (file)
index d911689..0000000
--- a/t/lib/Test/mix.t
+++ /dev/null
@@ -1,17 +0,0 @@
-# -*-perl-*-
-use strict;
-use Test;
-BEGIN { plan tests => 4, todo => [2,3] }
-
-ok(sub { 
-       my $r = 0;
-       for (my $x=0; $x < 10; $x++) {
-          $r += $x*($r+1);
-       }
-       $r
-   }, 3628799);
-
-ok(0);
-ok(1);
-
-skip(1,0);

diff --git a/t/lib/Test/onfail.t b/t/lib/Test/onfail.t
deleted file mode 100644 (file)
index dce4373..0000000
--- a/t/lib/Test/onfail.t
+++ /dev/null
@@ -1,31 +0,0 @@
-# -*-perl-*-
-
-use strict;
-use Test qw($ntest plan ok $TESTOUT);
-use vars qw($mycnt);
-
-BEGIN { plan test => 6, onfail => \&myfail }
-
-$mycnt = 0;
-
-my $why = "zero != one";
-# sneak in a test that Test::Harness wont see
-open J, ">junk";
-$TESTOUT = *J{IO};
-ok(0, 1, $why);
-$TESTOUT = *STDOUT{IO};
-close J;
-unlink "junk";
-$ntest = 1;
-
-sub myfail {
-    my ($f) = @_;
-    ok(@$f, 1);
-
-    my $t = $$f[0];
-    ok($$t{diagnostic}, $why);
-    ok($$t{'package'}, 'main');
-    ok($$t{repetition}, 1);
-    ok($$t{result}, 0);
-    ok($$t{expected}, 1);
-}

diff --git a/t/lib/Test/qr.t b/t/lib/Test/qr.t
deleted file mode 100644 (file)
index ea40f87..0000000
--- a/t/lib/Test/qr.t
+++ /dev/null
@@ -1,13 +0,0 @@
-#!./perl -w
-
-use strict;
-BEGIN {
-    if ($] < 5.005) {
-       print "1..0\n";
-       print "ok 1 # skipped; this test requires at least perl 5.005\n";
-       exit;
-    }
-}
-use Test; plan tests => 1;
-
-ok 'abc', qr/b/;

diff --git a/t/lib/Test/skip.t b/t/lib/Test/skip.t
deleted file mode 100644 (file)
index 7db35e6..0000000
--- a/t/lib/Test/skip.t
+++ /dev/null
@@ -1,40 +0,0 @@
-# -*-perl-*-
-use strict;
-use Test qw($TESTOUT $ntest plan ok skip); plan tests => 6;
-
-open F, ">skips" or die "open skips: $!";
-$TESTOUT = *F{IO};
-
-skip(1, 0);  #should skip
-
-my $skipped=1;
-skip('hop', sub { $skipped = 0 });
-skip(sub {'jump'}, sub { $skipped = 0 });
-skip('skipping stones is more fun', sub { $skipped = 0 });
-
-close F;
-
-$TESTOUT = *STDOUT{IO};
-$ntest = 1;
-open F, "skips" or die "open skips: $!";
-
-ok $skipped, 1, 'not skipped?';
-
-my @T = <F>;
-chop @T;
-my @expect = split /\n+/, join('',<DATA>);
-ok @T, 4;
-for (my $x=0; $x < @T; $x++) {
-    ok $T[$x], $expect[$x];
-}
-
-END { close F; unlink "skips" }
-
-__DATA__
-ok 1 # skip
-
-ok 2 # skip hop
-
-ok 3 # skip jump
-
-ok 4 # skip skipping stones is more fun

diff --git a/t/lib/Test/success.t b/t/lib/Test/success.t
deleted file mode 100644 (file)
index a580f0a..0000000
--- a/t/lib/Test/success.t
+++ /dev/null
@@ -1,11 +0,0 @@
-# -*-perl-*-
-use strict;
-use Test;
-BEGIN { plan tests => 11 }
-
-ok(ok(1));
-ok(ok('fixed', 'fixed'));
-ok(skip(1,0));
-ok(undef, undef);
-ok(ok 'the brown fox jumped over the lazy dog', '/lazy/');
-ok(ok 'the brown fox jumped over the lazy dog', 'm,fox,');

diff --git a/t/lib/Test/todo.t b/t/lib/Test/todo.t
deleted file mode 100644 (file)
index ae02a04..0000000
--- a/t/lib/Test/todo.t
+++ /dev/null
@@ -1,13 +0,0 @@
-# -*-perl-*-
-use strict;
-use Test;
-BEGIN { 
-    my $tests = 5; 
-    plan tests => $tests, todo => [1..$tests]; 
-}
-
-ok(0);
-ok(1);
-ok(0,1);
-ok(0,1,"need more tuits");
-ok(1,1);

diff --git a/t/lib/ansicolor.t b/t/lib/ansicolor.t
deleted file mode 100755 (executable)
index f38e905..0000000
--- a/t/lib/ansicolor.t
+++ /dev/null
@@ -1,81 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# Test suite for the Term::ANSIColor Perl module.  Before `make install' is
-# performed this script should be runnable with `make test'.  After `make
-# install' it should work as `perl test.pl'.
-
-############################################################################
-# Ensure module can be loaded
-############################################################################
-
-BEGIN { $| = 1; print "1..8\n" }
-END   { print "not ok 1\n" unless $loaded }
-use Term::ANSIColor qw(:constants color colored);
-$loaded = 1;
-print "ok 1\n";
-
-
-############################################################################
-# Test suite
-############################################################################
-
-# Test simple color attributes.
-if (color ('blue on_green', 'bold') eq "\e[34;42;1m") {
-    print "ok 2\n";
-} else {
-    print "not ok 2\n";
-}
-
-# Test colored.
-if (colored ("testing", 'blue', 'bold') eq "\e[34;1mtesting\e[0m") {
-    print "ok 3\n";
-} else {
-    print "not ok 3\n";
-}
-
-# Test the constants.
-if (BLUE BOLD "testing" eq "\e[34m\e[1mtesting") {
-    print "ok 4\n";
-} else {
-    print "not ok 4\n";
-}
-
-# Test AUTORESET.
-$Term::ANSIColor::AUTORESET = 1;
-if (BLUE BOLD "testing" eq "\e[34m\e[1mtesting\e[0m\e[0m") {
-    print "ok 5\n";
-} else {
-    print "not ok 5\n";
-}
-
-# Test EACHLINE.
-$Term::ANSIColor::EACHLINE = "\n";
-if (colored ("test\n\ntest", 'bold')
-    eq "\e[1mtest\e[0m\n\n\e[1mtest\e[0m") {
-    print "ok 6\n";
-} else {
-    print colored ("test\n\ntest", 'bold'), "\n";
-    print "not ok 6\n";
-}
-
-# Test EACHLINE with multiple trailing delimiters.
-$Term::ANSIColor::EACHLINE = "\r\n";
-if (colored ("test\ntest\r\r\n\r\n", 'bold')
-    eq "\e[1mtest\ntest\r\e[0m\r\n\r\n") {
-    print "ok 7\n";
-} else {
-    print "not ok 7\n";
-}
-
-# Test the array ref form.
-$Term::ANSIColor::EACHLINE = "\n";
-if (colored (['bold', 'on_green'], "test\n", "\n", "test")
-    eq "\e[1;42mtest\e[0m\n\n\e[1;42mtest\e[0m") {
-    print "ok 8\n";
-} else {
-    print colored (['bold', 'on_green'], "test\n", "\n", "test");
-    print "not ok 8\n";
-}

diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t
deleted file mode 100755 (executable)
index 30b3c7a..0000000
--- a/t/lib/anydbm.t
+++ /dev/null
@@ -1,155 +0,0 @@
-#!./perl
-
-# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if (($Config{'extensions'} !~ /\b(DB|[A-Z]DBM)_File\b/) ){
-      print "1..0 # Skipping (no DB_File or [A-Z]DBM_File)\n";
-      exit 0;
-    }
-}
-require AnyDBM_File;
-use Fcntl;
-
-print "1..12\n";
-
-$Is_Dosish = ($^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare' or $^O eq 'dos' or
-             $^O eq 'os2' or $^O eq 'mint');
-
-unlink <Op_dbmx*>;
-
-umask(0);
-print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640)
-       ? "ok 1\n" : "not ok 1\n");
-
-$Dfile = "Op_dbmx.pag";
-if (! -e $Dfile) {
-       ($Dfile) = <Op_dbmx*>;
-}
-if ($Is_Dosish || $^O eq 'MacOS') {
-    print "ok 2 # Skipped: different file permission semantics\n";
-}
-else {
-    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-     $blksize,$blocks) = stat($Dfile);
-    print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
-}
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-print (!$i ? "ok 3\n" : "not ok 3 # i=$i\n\n");
-
-$h{'goner1'} = 'snork';
-
-$h{'abc'} = 'ABC';
-$h{'def'} = 'DEF';
-$h{'jkl','mno'} = "JKL\034MNO";
-$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
-$h{'a'} = 'A';
-$h{'b'} = 'B';
-$h{'c'} = 'C';
-$h{'d'} = 'D';
-$h{'e'} = 'E';
-$h{'f'} = 'F';
-$h{'g'} = 'G';
-$h{'h'} = 'H';
-$h{'i'} = 'I';
-
-$h{'goner2'} = 'snork';
-delete $h{'goner2'};
-
-untie(%h);
-print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
-
-$h{'j'} = 'J';
-$h{'k'} = 'K';
-$h{'l'} = 'L';
-$h{'m'} = 'M';
-$h{'n'} = 'N';
-$h{'o'} = 'O';
-$h{'p'} = 'P';
-$h{'q'} = 'Q';
-$h{'r'} = 'R';
-$h{'s'} = 'S';
-$h{'t'} = 'T';
-$h{'u'} = 'U';
-$h{'v'} = 'V';
-$h{'w'} = 'W';
-$h{'x'} = 'X';
-$h{'y'} = 'Y';
-$h{'z'} = 'Z';
-
-$h{'goner3'} = 'snork';
-
-delete $h{'goner1'};
-delete $h{'goner3'};
-
-@keys = keys(%h);
-@values = values(%h);
-
-if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
-
-while (($key,$value) = each(%h)) {
-    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
-       $key =~ y/a-z/A-Z/;
-       $i++ if $key eq $value;
-    }
-}
-
-if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
-
-@keys = ('blurfl', keys(%h), 'dyick');
-if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
-
-$h{'foo'} = '';
-$h{''} = 'bar';
-
-# check cache overflow and numeric keys and contents
-$ok = 1;
-for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
-for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
-print ($ok ? "ok 8\n" : "not ok 8\n");
-
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-print ($size > 0 ? "ok 9\n" : "not ok 9\n");
-
-@h{0..200} = 200..400;
-@foo = @h{0..200};
-print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
-
-print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
-if ($h{''} eq 'bar') {
-   print "ok 12\n" ;
-}
-else {
-   if ($AnyDBM_File::ISA[0] eq 'DB_File' && $DB_File::db_ver >= 2.004010) {
-     ($major, $minor, $patch) = ($DB_File::db_ver =~ /^(\d+)\.(\d\d\d)(\d\d\d)/) ;
-     $major =~ s/^0+// ;
-     $minor =~ s/^0+// ;
-     $patch =~ s/^0+// ;
-     $compact = "$major.$minor.$patch" ;
-     #
-     # anydbm.t test 12 will fail when AnyDBM_File uses the combination of
-     # DB_File and Berkeley DB 2.4.10 (or greater). 
-     # You are using DB_File $DB_File::VERSION and Berkeley DB $compact
-     #
-     # Berkeley DB 2 from version 2.4.10 onwards does not allow null keys.
-     # This feature will be reenabled in a future version of Berkeley DB.
-     #
-     print "ok 12 # skipped: db v$compact, no null key support\n" ;
-   }
-   else {
-     print "not ok 12\n" ;
-   }
-}
-
-untie %h;
-if ($^O eq 'VMS') {
-  unlink 'Op_dbmx.sdbm_dir', $Dfile;
-} else {
-  unlink 'Op_dbmx.dir', $Dfile;  
-}

diff --git a/t/lib/attrhand.t b/t/lib/attrhand.t
deleted file mode 100644 (file)
index 5056fa8..0000000
--- a/t/lib/attrhand.t
+++ /dev/null
@@ -1,130 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-END {print "not ok 1\n" unless $loaded;}
-use v5.6.0;
-use Attribute::Handlers;
-$loaded = 1;
-
-######################### End of black magic.
-
-# Insert your test code below (better if it prints "ok 13"
-# (correspondingly "not ok 13") depending on the success of chunk 13
-# of the test code):
-
-sub ok { $::count++; push @::results, [$_[1], $_[0]?"":"not "]; }
-
-END { print "1..$::count\n";
-      print map "$_->[1]ok $_->[0]\n", sort {$a->[0]<=>$b->[0]} @::results }
-
-package Test;
-use warnings;
-no warnings 'redefine';
-
-sub UNIVERSAL::Okay :ATTR { ::ok @{$_[4]} }
-
-sub Dokay :ATTR(SCALAR) { ::ok @{$_[4]} }
-sub Dokay :ATTR(HASH)   { ::ok @{$_[4]} }
-sub Dokay :ATTR(ARRAY)  { ::ok @{$_[4]} }
-sub Dokay :ATTR(CODE)   { ::ok @{$_[4]} }
-
-sub Vokay :ATTR(VAR)    { ::ok @{$_[4]} }
-
-sub Aokay :ATTR(ANY)    { ::ok @{$_[4]} }
-
-package main;
-use warnings;
-
-my $x1 :Okay(1,1);
-my @x1 :Okay(1=>2);
-my %x1 :Okay(1,3);
-sub x1 :Okay(1,4) {}
-
-my Test $x2 :Dokay(1,5);
-
-package Test;
-my $x3 :Dokay(1,6);
-my Test $x4 :Dokay(1,7);
-sub x3 :Dokay(1,8) {}
-
-my $y1 :Okay(1,9);
-my @y1 :Okay(1,10);
-my %y1 :Okay(1,11);
-sub y1 :Okay(1,12) {}
-
-my $y2 :Vokay(1,13);
-my @y2 :Vokay(1,14);
-my %y2 :Vokay(1,15);
-# BEGIN {eval 'sub y2 :Vokay(0,16) {}; 1' or
-::ok(1,16);
-# }
-
-my $z :Aokay(1,17);
-my @z :Aokay(1,18);
-my %z :Aokay(1,19);
-sub z :Aokay(1,20) {};
-
-package DerTest;
-use base 'Test';
-use warnings;
-
-my $x5 :Dokay(1,21);
-my Test $x6 :Dokay(1,22);
-sub x5 :Dokay(1,23);
-
-my $y3 :Okay(1,24);
-my @y3 :Okay(1,25);
-my %y3 :Okay(1,26);
-sub y3 :Okay(1,27) {}
-
-package Unrelated;
-
-BEGIN { eval 'my $x7 :Dokay(0,28)' or ::ok(1,28); }
-my Test $x8 :Dokay(1,29);
-eval 'sub x7 :Dokay(0,30) {}' or ::ok(1,30);
-
-
-package Tie::Loud;
-
-sub TIESCALAR { ::ok(1,31); bless {}, $_[0] }
-sub FETCH { ::ok(1,32); return 1 }
-sub STORE { ::ok(1,33); return 1 }
-
-package Tie::Noisy;
-
-sub TIEARRAY { ::ok(1,$_[1]); bless {}, $_[0] }
-sub FETCH { ::ok(1,35); return 1 }
-sub STORE { ::ok(1,36); return 1 }
-sub FETCHSIZE { 100 }
-
-package Tie::Rowdy;
-
-sub TIEHASH { ::ok(1,$_[1]); bless {}, $_[0] }
-sub FETCH { ::ok(1,38); return 1 }
-sub STORE { ::ok(1,39); return 1 }
-
-package main;
-
-use Attribute::Handlers autotie => {      Other::Loud => Tie::Loud,
-                                               Noisy => Tie::Noisy,
-                                    UNIVERSAL::Rowdy => Tie::Rowdy,
-                                   };
-
-my Other $loud : Loud;
-$loud++;
-
-my @noisy : Noisy(34);
-$noisy[0]++;
-
-my %rowdy : Rowdy(37);
-$rowdy{key}++;

diff --git a/t/lib/attrs.t b/t/lib/attrs.t
deleted file mode 100644 (file)
index 18a02ab..0000000
--- a/t/lib/attrs.t
+++ /dev/null
@@ -1,141 +0,0 @@
-#!./perl
-
-# Regression tests for attrs.pm and the C<sub x : attrs> syntax.
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    eval 'require attrs; 1' or do {
-       print "1..0\n";
-       exit 0;
-    }
-}
-
-use warnings;
-no warnings qw(deprecated);     # else attrs cries.
-
-sub NTESTS () ;
-
-my ($test, $ntests);
-BEGIN {$ntests=0}
-$test=0;
-my $failed = 0;
-
-print "1..".NTESTS."\n";
-
-eval 'sub t1 ($) { use attrs "locked"; $_[0]++ }';
-(print "not "), $failed=1 if $@;
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-eval 'sub t2 { use attrs "locked"; $_[0]++ }';
-(print "not "), $failed=1 if $@;
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-eval 'sub t3 ($) : locked ;';
-(print "not "), $failed=1 if $@;
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-eval 'sub t4 : locked ;';
-(print "not "), $failed=1 if $@;
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-my $anon1;
-eval '$anon1 = sub ($) { use attrs qw(locked method); $_[0]++ }';
-(print "not "), $failed=1 if $@;
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-my $anon2;
-eval '$anon2 = sub { use attrs qw(locked method); $_[0]++ }';
-(print "not "), $failed=1 if $@;
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-my $anon3;
-eval '$anon3 = sub { use attrs "method"; $_[0]->[1] }';
-(print "not "), $failed=1 if $@;
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-my @attrs = attrs::get($anon3 ? $anon3 : \&ns);
-(print "not "), $failed=1 unless "@attrs" eq "method";
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-@attrs = sort +attrs::get($anon2 ? $anon2 : \&ns);
-(print "not "), $failed=1 unless "@attrs" eq "locked method";
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-@attrs = sort +attrs::get($anon1 ? $anon1 : \&ns);
-(print "not "), $failed=1 unless "@attrs" eq "locked method";
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-eval 'sub e1 ($) : plugh ;';
-unless ($@ && $@ =~ m/^Invalid CODE attribute: ["']?plugh["']? at/) {
-    my $x = $@;
-    $x =~ s/\n.*\z//s;
-    print "# $x\n";
-    print "not ";
-    $failed = 1;
-}
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-eval 'sub e2 ($) : plugh(0,0) xyzzy ;';
-unless ($@ && $@ =~ m/^Invalid CODE attributes: ["']?plugh\(0,0\)["']? /) {
-    my $x = $@;
-    $x =~ s/\n.*\z//s;
-    print "# $x\n";
-    print "not ";
-    $failed = 1;
-}
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-eval 'sub e3 ($) : plugh(0,0 xyzzy ;';
-unless ($@ && $@ =~ m/Unterminated attribute parameter in attribute list at/) {
-    my $x = $@;
-    $x =~ s/\n.*\z//s;
-    print "# $x\n";
-    print "not ";
-    $failed = 1;
-}
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-eval 'sub e4 ($) : plugh + xyzzy ;';
-unless ($@ && $@ =~ m/Invalid separator character '[+]' in attribute list at/) {
-    my $x = $@;
-    $x =~ s/\n.*\z//s;
-    print "# $x\n";
-    print "not ";
-    $failed = 1;
-}
-print "ok ",++$test,"\n";
-BEGIN {++$ntests}
-
-{
-    my $w = "" ;
-    local $SIG{__WARN__} = sub {$w = shift} ;
-    eval 'sub w1 ($) { use warnings "deprecated"; use attrs "locked"; $_[0]++ }';
-    (print "not "), $failed=1 if $@;
-    print "ok ",++$test,"\n";
-    BEGIN {++$ntests}
-    (print "not "), $failed=1 
-       if $w !~ /^pragma "attrs" is deprecated, use "sub NAME : ATTRS" instead at/;
-    print "ok ",++$test,"\n";
-    BEGIN {++$ntests}
-}
-
-
-# Other tests should be added above this line
-
-sub NTESTS () { $ntests }
-
-exit $failed;

diff --git a/t/lib/autoloader.t b/t/lib/autoloader.t
deleted file mode 100755 (executable)
index f2fae7f..0000000
--- a/t/lib/autoloader.t
+++ /dev/null
@@ -1,128 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    if ($^O eq 'MacOS') {
-       $dir = ":auto-$$";
-       $sep = ":";
-    } else {
-       $dir = "auto-$$";
-       $sep = "/";
-    }
-    @INC = $dir;
-    push @INC, '../lib';
-}
-
-print "1..11\n";
-
-# First we must set up some autoloader files
-mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
-mkdir "$dir${sep}auto", 0755     or die "Can't mkdir: $!";
-mkdir "$dir${sep}auto${sep}Foo", 0755 or die "Can't mkdir: $!";
-
-open(FOO, ">$dir${sep}auto${sep}Foo${sep}foo.al") or die;
-print FOO <<'EOT';
-package Foo;
-sub foo { shift; shift || "foo" }
-1;
-EOT
-close(FOO);
-
-open(BAR, ">$dir${sep}auto${sep}Foo${sep}bar.al") or die;
-print BAR <<'EOT';
-package Foo;
-sub bar { shift; shift || "bar" }
-1;
-EOT
-close(BAR);
-
-open(BAZ, ">$dir${sep}auto${sep}Foo${sep}bazmarkhian.al") or die;
-print BAZ <<'EOT';
-package Foo;
-sub bazmarkhianish { shift; shift || "baz" }
-1;
-EOT
-close(BAZ);
-
-# Let's define the package
-package Foo;
-require AutoLoader;
-@ISA=qw(AutoLoader);
-
-sub new { bless {}, shift };
-
-package main;
-
-$foo = new Foo;
-
-print "not " unless $foo->foo eq 'foo';  # autoloaded first time
-print "ok 1\n";
-
-print "not " unless $foo->foo eq 'foo';  # regular call
-print "ok 2\n";
-
-# Try an undefined method
-eval {
-    $foo->will_fail;
-};
-print "not " unless $@ =~ /^Can't locate/;
-print "ok 3\n";
-
-# Used to be trouble with this
-eval {
-    my $foo = new Foo;
-    die "oops";
-};
-print "not " unless $@ =~ /oops/;
-print "ok 4\n";
-
-# Pass regular expression variable to autoloaded function.  This used
-# to go wrong because AutoLoader used regular expressions to generate
-# autoloaded filename.
-"foo" =~ /(\w+)/;
-print "not " unless $1 eq 'foo';
-print "ok 5\n";
-
-print "not " unless $foo->bar($1) eq 'foo';
-print "ok 6\n";
-
-print "not " unless $foo->bar($1) eq 'foo';
-print "ok 7\n";
-
-print "not " unless $foo->bazmarkhianish($1) eq 'foo';
-print "ok 8\n";
-
-print "not " unless $foo->bazmarkhianish($1) eq 'foo';
-print "ok 9\n";
-
-# test recursive autoloads
-open(F, ">$dir${sep}auto${sep}Foo${sep}a.al") or die;
-print F <<'EOT';
-package Foo;
-BEGIN { b() }
-sub a { print "ok 11\n"; }
-1;
-EOT
-close(F);
-
-open(F, ">$dir${sep}auto${sep}Foo${sep}b.al") or die;
-print F <<'EOT';
-package Foo;
-sub b { print "ok 10\n"; }
-1;
-EOT
-close(F);
-Foo::a();
-
-# cleanup
-END {
-return unless $dir && -d $dir;
-unlink "$dir${sep}auto${sep}Foo${sep}foo.al";
-unlink "$dir${sep}auto${sep}Foo${sep}bar.al";
-unlink "$dir${sep}auto${sep}Foo${sep}bazmarkhian.al";
-unlink "$dir${sep}auto${sep}Foo${sep}a.al";
-unlink "$dir${sep}auto${sep}Foo${sep}b.al";
-rmdir "$dir${sep}auto${sep}Foo";
-rmdir "$dir${sep}auto";
-rmdir "$dir";
-}

diff --git a/t/lib/b-debug.t b/t/lib/b-debug.t
deleted file mode 100644 (file)
index 286dac3..0000000
--- a/t/lib/b-debug.t
+++ /dev/null
@@ -1,70 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    if ($^O eq 'MacOS') {
-       @INC = qw(: ::lib ::macos:lib);
-    } else {
-       @INC = '.';
-       push @INC, '../lib';
-    }
-}
-
-$|  = 1;
-use warnings;
-use strict;
-use Config;
-
-print "1..3\n";
-
-my $test = 1;
-
-sub ok { print "ok $test\n"; $test++ }
-
-
-my $a;
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MacOS = $^O eq 'MacOS';
-
-my $path = join " ", map { qq["-I$_"] } @INC;
-my $redir = $Is_MacOS ? "" : "2>&1";
-
-$a = `$^X $path "-MO=Debug" -e 1 $redir`;
-print "not " unless $a =~
-/\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
-ok;
-
-
-$a = `$^X $path "-MO=Terse" -e 1 $redir`;
-print "not " unless $a =~
-/\bLISTOP\b.*leave.*\n    OP\b.*enter.*\n    COP\b.*nextstate.*\n    OP\b.*null/s;
-ok;
-
-$a = `$^X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
-$a =~ s/\(0x[^)]+\)//g;
-$a =~ s/\[[^\]]+\]//g;
-$a =~ s/-e syntax OK//;
-$a =~ s/[^a-z ]+//g;
-$a =~ s/\s+/ /g;
-$a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
-$a =~ s/^\s+//;
-$a =~ s/\s+$//;
-my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
-if ($is_thread) {
-    $b=<<EOF;
-leave enter nextstate label leaveloop enterloop null and defined null
-threadsv readline gv lineseq nextstate aassign null pushmark split pushre
-threadsv const null pushmark rvav gv nextstate subst const unstack nextstate
-EOF
-} else {
-    $b=<<EOF;
-leave enter nextstate label leaveloop enterloop null and defined null
-null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
-null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate
-EOF
-}
-$b=~s/\n/ /g;$b=~s/\s+/ /g;
-$b =~ s/\s+$//;
-print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
-ok;
-

diff --git a/t/lib/b-deparse.t b/t/lib/b-deparse.t
deleted file mode 100644 (file)
index 048ce31..0000000
--- a/t/lib/b-deparse.t
+++ /dev/null
@@ -1,176 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    if ($^O eq 'MacOS') {
-       @INC = qw(: ::lib ::macos:lib);
-    } else {
-       @INC = '.';
-       push @INC, '../lib';
-    }
-}
-
-$|  = 1;
-use warnings;
-use strict;
-use Config;
-
-print "1..14\n";
-
-use B::Deparse;
-my $deparse = B::Deparse->new() or print "not ";
-my $i=1;
-print "ok ", $i++, "\n";
-
-
-# Tell B::Deparse about our ambient pragmas
-{ my ($hint_bits, $warning_bits);
- BEGIN {($hint_bits, $warning_bits) = ($^H, ${^WARNING_BITS})}
- $deparse->ambient_pragmas (
-     hint_bits    => $hint_bits,
-     warning_bits => $warning_bits,
-     '$['         => 0 + $[
- );
-}
-
-$/ = "\n####\n";
-while (<DATA>) {
-    chomp;
-    s/#.*$//mg;
-
-    my ($input, $expected);
-    if (/(.*)\n>>>>\n(.*)/s) {
-       ($input, $expected) = ($1, $2);
-    }
-    else {
-       ($input, $expected) = ($_, $_);
-    }
-
-    my $coderef = eval "sub {$input}";
-
-    if ($@) {
-       print "not ok ", $i++, "\n";
-       print "# $@";
-    }
-    else {
-       my $deparsed = $deparse->coderef2text( $coderef );
-       my $regex = quotemeta($expected);
-       do {
-           no warnings 'misc';
-           $regex =~ s/\s+/\s+/g;
-       };
-
-       my $ok = ($deparsed =~ /^\{\s*$regex\s*\}$/);
-       print ($ok ? "ok " : "not ok ");
-       print $i++, "\n";
-       if (!$ok) {
-           print "# EXPECTED:\n";
-           $regex =~ s/^/# /mg;
-           print "$regex\n";
-
-           print "\n# GOT: \n";
-           $deparsed =~ s/^/# /mg;
-           print "$deparsed\n";
-       }
-    }
-}
-
-use constant 'c', 'stuff';
-print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
-print "ok ", $i++, "\n";
-
-$a = 0;
-print "not " if "{\n    (-1) ** \$a;\n}"
-               ne $deparse->coderef2text(sub{(-1) ** $a });
-print "ok ", $i++, "\n";
-
-# XXX ToDo - constsub that returns a reference
-#use constant cr => ['hello'];
-#my $string = "sub " . $deparse->coderef2text(\&cr);
-#my $val = (eval $string)->();
-#print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello';
-#print "ok ", $i++, "\n";
-
-my $a;
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MacOS = $^O eq 'MacOS';
-
-my $path = join " ", map { qq["-I$_"] } @INC;
-my $redir = $Is_MacOS ? "" : "2>&1";
-
-$a = `$^X $path "-MO=Deparse" -anle 1 $redir`;
-$a =~ s/-e syntax OK\n//g;
-$a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
-$a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
-$b = <<'EOF';
-
-LINE: while (defined($_ = <ARGV>)) {
-    chomp $_;
-    @F = split(" ", $_, 0);
-    '???';
-}
-
-EOF
-print "# [$a]\n\# vs expected\n# [$b]\nnot " if $a ne $b;
-print "ok ", $i++, "\n";
-
-__DATA__
-# 1
-1;
-####
-# 2
-{
-    no warnings;
-    '???';
-    2;
-}
-####
-# 3
-my $test;
-++$test and $test /= 2;
->>>>
-my $test;
-$test /= 2 if ++$test;
-####
-# 4
--((1, 2) x 2);
-####
-# 5
-{
-    my $test = sub : lvalue {
-       my $x;
-    }
-    ;
-}
-####
-# 6
-{
-    my $test = sub : method {
-       my $x;
-    }
-    ;
-}
-####
-# 7
-{
-    my $test = sub : locked method {
-       my $x;
-    }
-    ;
-}
-####
-# 8
-{
-    234;
-}
-continue {
-    123;
-}
-####
-# 9
-my $x;
-print $main::x;
-####
-# 10
-my @x;
-print $main::x[1];

diff --git a/t/lib/b-showlex.t b/t/lib/b-showlex.t
deleted file mode 100644 (file)
index a21f03b..0000000
--- a/t/lib/b-showlex.t
+++ /dev/null
@@ -1,39 +0,0 @@
-#!./perl
-
-BEGIN {
-    if ($^O eq 'MacOS') {
-       @INC = qw(: ::lib ::macos:lib);
-    }
-}
-
-$|  = 1;
-use warnings;
-use strict;
-use Config;
-
-print "1..1\n";
-
-my $test = 1;
-
-sub ok { print "ok $test\n"; $test++ }
-
-my $a;
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MacOS = $^O eq 'MacOS';
-
-my $path = join " ", map { qq["-I$_"] } @INC;
-my $redir = $Is_MacOS ? "" : "2>&1";
-my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
-
-if ($is_thread) {
-    print "# use5005threads: test $test skipped\n";
-} else {
-    $a = `$^X $path "-MO=Showlex" -e "my %one" $redir`;
-    if (ord('A') != 193) { # ASCIIish
-        print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
-    }
-    else { # EBCDICish C<1: PVNV (0x1a7ede34) "%\226\225\205">
-        print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%\\[0-9].*sv_undef.*HV/s;
-    }
-}
-ok;

diff --git a/t/lib/b-stash.t b/t/lib/b-stash.t
deleted file mode 100644 (file)
index bc9d896..0000000
--- a/t/lib/b-stash.t
+++ /dev/null
@@ -1,60 +0,0 @@
-#!./perl
-
-BEGIN {
-    if ($^O eq 'MacOS') {
-       @INC = qw(: ::lib ::macos:lib);
-    }
-}
-
-$|  = 1;
-use warnings;
-use strict;
-use Config;
-
-print "1..1\n";
-
-my $test = 1;
-
-sub ok { print "ok $test\n"; $test++ }
-
-
-my $a;
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MacOS = $^O eq 'MacOS';
-
-my $path = join " ", map { qq["-I$_"] } @INC;
-my $redir = $Is_MacOS ? "" : "2>&1";
-
-
-chomp($a = `$^X $path "-MB::Stash" "-Mwarnings" -e1`);
-$a = join ',', sort split /,/, $a;
-$a =~ s/-u(PerlIO|open)(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define';
-$a =~ s/-uWin32,// if $^O eq 'MSWin32';
-$a =~ s/-uNetWare,// if $^O eq 'NetWare';
-$a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
-$a =~ s/-uCwd,// if $^O eq 'cygwin';
-  $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
-     . '-umain,-ustrict,-uutf8,-uwarnings';
-if ($Is_VMS) {
-    $a =~ s/-uFile,-uFile::Copy,//;
-    $a =~ s/-uVMS,-uVMS::Filespec,//;
-    $a =~ s/-uSocket,//; # Socket is optional/compiler version dependent
-}
-
-{
-    no strict 'vars';
-    use vars '$OS2::is_aout';
-}
-if (($Config{static_ext} eq ' ' ||
-     ($Config{static_ext} eq 'Socket' && $Is_VMS))
-    && !($^O eq 'os2' and $OS2::is_aout)
-       ) {
-    if (ord('A') == 193) { # EBCDIC sort order is qw(a A) not qw(A a)
-       $b = join ',', sort split /,/, $b;
-    }
-    print "# [$a]\n# vs.\n# [$b]\nnot " if $a ne $b;
-    ok;
-} else {
-    print "ok $test # skipped: one or more static extensions\n"; $test++;
-}
-

diff --git a/t/lib/b.t b/t/lib/b.t
deleted file mode 100755 (executable)
index f21f489..0000000
--- a/t/lib/b.t
+++ /dev/null
@@ -1,63 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    if ($^O eq 'MacOS') {
-       @INC = qw(: ::lib ::macos:lib);
-    } else {
-       @INC = '.';
-       push @INC, '../lib';
-    }
-}
-
-$|  = 1;
-use warnings;
-use strict;
-use Config;
-
-print "1..2\n";
-
-my $test = 1;
-
-sub ok { print "ok $test\n"; $test++ }
-
-use B;
-
-
-package Testing::Symtable;
-use vars qw($This @That %wibble $moo %moo);
-my $not_a_sym = 'moo';
-
-sub moo { 42 }
-sub car { 23 }
-
-
-package Testing::Symtable::Foo;
-sub yarrow { "Hock" }
-
-package Testing::Symtable::Bar;
-sub hock { "yarrow" }
-
-package main;
-use vars qw(%Subs);
-local %Subs = ();
-B::walksymtable(\%Testing::Symtable::, 'find_syms', sub { $_[0] =~ /Foo/ },
-                'Testing::Symtable::');
-
-sub B::GV::find_syms {
-    my($symbol) = @_;
-
-    $main::Subs{$symbol->STASH->NAME . '::' . $symbol->NAME}++;
-}
-
-my @syms = map { 'Testing::Symtable::'.$_ } qw(This That wibble moo car
-                                               BEGIN);
-push @syms, "Testing::Symtable::Foo::yarrow";
-
-# Make sure we hit all the expected symbols.
-print "not " unless join('', sort @syms) eq join('', sort keys %Subs);
-ok;
-
-# Make sure we only hit them each once.
-print "not " unless !grep $_ != 1, values %Subs;
-ok;

diff --git a/t/lib/basename.t b/t/lib/basename.t
deleted file mode 100755 (executable)
index 9bee1bf..0000000
--- a/t/lib/basename.t
+++ /dev/null
@@ -1,144 +0,0 @@
-#!./perl -T
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use File::Basename qw(fileparse basename dirname);
-
-print "1..41\n";
-
-# import correctly?
-print +(defined(&basename) && !defined(&fileparse_set_fstype) ?
-        '' : 'not '),"ok 1\n";
-
-# set fstype -- should replace non-null default
-print +(length(File::Basename::fileparse_set_fstype('unix')) ?
-        '' : 'not '),"ok 2\n";
-
-# Unix syntax tests
-($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7','\.book\d+');
-if ($base eq 'draft' and $path eq '/virgil/aeneid/' and $type eq '.book7') {
-  print "ok 3\n";
-}
-else {
-  print "not ok 3      |$base|$path|$type|\n";
-}
-print +(basename('/arma/virumque.cano') eq 'virumque.cano' ?
-        '' : 'not '),"ok 4\n";
-print +(dirname('/arma/virumque.cano') eq '/arma' ? '' : 'not '),"ok 5\n";
-print +(dirname('arma/') eq '.' ? '' : 'not '),"ok 6\n";
-print +(dirname('/') eq '/' ? '' : 'not '),"ok 7\n";
-
-
-# set fstype -- should replace non-null default
-print +(File::Basename::fileparse_set_fstype('VMS') eq 'unix' ?
-        '' : 'not '),"ok 8\n";
-
-# VMS syntax tests
-($base,$path,$type) = fileparse('virgil:[aeneid]draft.book7','\.book\d+');
-if ($base eq 'draft' and $path eq 'virgil:[aeneid]' and $type eq '.book7') {
-  print "ok 9\n";
-}
-else {
-  print "not ok 9      |$base|$path|$type|\n";
-}
-print +(basename('arma:[virumque]cano.trojae') eq 'cano.trojae' ?
-        '' : 'not '),"ok 10\n";
-print +(dirname('arma:[virumque]cano.trojae') eq 'arma:[virumque]' ?
-        '' : 'not '),"ok 11\n";
-print +(dirname('arma:<virumque>cano.trojae') eq 'arma:<virumque>' ?
-        '' : 'not '),"ok 12\n";
-print +(dirname('arma:virumque.cano') eq 'arma:' ? '' : 'not '),"ok 13\n";
-$ENV{DEFAULT} = '' unless exists $ENV{DEFAULT};
-print +(dirname('virumque.cano') eq $ENV{DEFAULT} ? '' : 'not '),"ok 14\n";
-print +(dirname('arma/') eq '.' ? '' : 'not '),"ok 15\n";
-
-# set fstype -- should replace non-null default
-print +(File::Basename::fileparse_set_fstype('MSDOS') eq 'VMS' ?
-        '' : 'not '),"ok 16\n";
-
-# MSDOS syntax tests
-($base,$path,$type) = fileparse('C:\\virgil\\aeneid\\draft.book7','\.book\d+');
-if ($base eq 'draft' and $path eq 'C:\\virgil\\aeneid\\' and $type eq '.book7') {
-  print "ok 17\n";
-}
-else {
-  print "not ok 17     |$base|$path|$type|\n";
-}
-print +(basename('A:virumque\\cano.trojae') eq 'cano.trojae' ?
-        '' : 'not '),"ok 18\n";
-print +(dirname('A:\\virumque\\cano.trojae') eq 'A:\\virumque' ?
-        '' : 'not '),"ok 19\n";
-print +(dirname('A:\\') eq 'A:\\' ? '' : 'not '),"ok 20\n";
-print +(dirname('arma\\') eq '.' ? '' : 'not '),"ok 21\n";
-
-# Yes "/" is a legal path separator under MSDOS
-basename("lib/File/Basename.pm") eq "Basename.pm" or print "not ";
-print "ok 22\n";
-
-
-
-# set fstype -- should replace non-null default
-print +(File::Basename::fileparse_set_fstype('MacOS') eq 'MSDOS' ?
-        '' : 'not '),"ok 23\n";
-
-# MacOS syntax tests
-($base,$path,$type) = fileparse('virgil:aeneid:draft.book7','\.book\d+');
-if ($base eq 'draft' and $path eq 'virgil:aeneid:' and $type eq '.book7') {
-  print "ok 24\n";
-}
-else {
-  print "not ok 24     |$base|$path|$type|\n";
-}
-print +(basename(':arma:virumque:cano.trojae') eq 'cano.trojae' ?
-        '' : 'not '),"ok 25\n";
-print +(dirname(':arma:virumque:cano.trojae') eq ':arma:virumque:' ?
-        '' : 'not '),"ok 26\n";
-print +(dirname(':arma:virumque:') eq ':arma:' ? '' : 'not '),"ok 27\n";
-print +(dirname(':arma:virumque') eq ':arma:' ? '' : 'not '),"ok 28\n";
-print +(dirname(':arma:') eq ':' ? '' : 'not '),"ok 29\n";
-print +(dirname(':arma') eq ':' ? '' : 'not '),"ok 30\n";
-print +(dirname('arma:') eq 'arma:' ? '' : 'not '),"ok 31\n";
-print +(dirname('arma') eq ':' ? '' : 'not '),"ok 32\n";
-print +(dirname(':') eq ':' ? '' : 'not '),"ok 33\n";
-
-
-# Check quoting of metacharacters in suffix arg by basename()
-print +(basename(':arma:virumque:cano.trojae','.trojae') eq 'cano' ?
-        '' : 'not '),"ok 34\n";
-print +(basename(':arma:virumque:cano_trojae','.trojae') eq 'cano_trojae' ?
-        '' : 'not '),"ok 35\n";
-
-# extra tests for a few specific bugs
-
-File::Basename::fileparse_set_fstype 'MSDOS';
-# perl5.003_18 gives C:/perl/.\
-print +((fileparse 'C:/perl/lib')[1] eq 'C:/perl/' ? '' : 'not '), "ok 36\n";
-# perl5.003_18 gives C:\perl\
-print +(dirname('C:\\perl\\lib\\') eq 'C:\\perl' ? '' : 'not '), "ok 37\n";
-
-File::Basename::fileparse_set_fstype 'UNIX';
-# perl5.003_18 gives '.'
-print +(dirname('/perl/') eq '/' ? '' : 'not '), "ok 38\n";
-# perl5.003_18 gives '/perl/lib'
-print +(dirname('/perl/lib//') eq '/perl' ? '' : 'not '), "ok 39\n";
-
-#   The empty tainted value, for tainting strings
-my $TAINT = substr($^X, 0, 0);
-# How to identify taint when you see it
-sub any_tainted (@) {
-    not eval { join("",@_), kill 0; 1 };
-}
-sub tainted ($) {
-    any_tainted @_;
-}
-sub all_tainted (@) {
-    for (@_) { return 0 unless tainted $_ }
-    1;
-}
-
-print +(tainted(dirname($TAINT.'/perl/lib//')) ? '' : 'not '), "ok 40\n";
-print +(all_tainted(fileparse($TAINT.'/dir/draft.book7','\.book\d+'))
-               ? '' : 'not '), "ok 41\n";

diff --git a/t/lib/bigfloat.t b/t/lib/bigfloat.t
deleted file mode 100755 (executable)
index 8e0a0ef..0000000
--- a/t/lib/bigfloat.t
+++ /dev/null
@@ -1,408 +0,0 @@
-#!./perl
-
-BEGIN { @INC = '../lib' }
-require "bigfloat.pl";
-
-$test = 0;
-$| = 1;
-print "1..355\n";
-while (<DATA>) {
-       chop;
-       if (/^&/) {
-               $f = $_;
-       } elsif (/^\$.*/) {
-               eval "$_;";
-       } else {
-               ++$test;
-               @args = split(/:/,$_,99);
-               $ans = pop(@args);
-               $try = "$f('" . join("','", @args) . "');";
-               if (($ans1 = eval($try)) eq $ans) {
-                       print "ok $test\n";
-               } else {
-                       print "not ok $test\n";
-                       print "# '$try' expected: '$ans' got: '$ans1'\n";
-               }
-       }
-} 
-__END__
-&fnorm
-abc:NaN
-   1 a:NaN
-1bcd2:NaN
-11111b:NaN
-+1z:NaN
--1z:NaN
-0:+0E+0
-+0:+0E+0
-+00:+0E+0
-+0 0 0:+0E+0
-000000  0000000   00000:+0E+0
--0:+0E+0
--0000:+0E+0
-+1:+1E+0
-+01:+1E+0
-+001:+1E+0
-+00000100000:+1E+5
-123456789:+123456789E+0
--1:-1E+0
--01:-1E+0
--001:-1E+0
--123456789:-123456789E+0
--00000100000:-1E+5
-123.456a:NaN
-123.456:+123456E-3
-0.01:+1E-2
-.002:+2E-3
--0.0003:-3E-4
--.0000000004:-4E-10
-123456E2:+123456E+2
-123456E-2:+123456E-2
--123456E2:-123456E+2
--123456E-2:-123456E-2
-1e1:+1E+1
-2e-11:+2E-11
--3e111:-3E+111
--4e-1111:-4E-1111
-&fneg
-abd:NaN
-+0:+0E+0
-+1:-1E+0
--1:+1E+0
-+123456789:-123456789E+0
--123456789:+123456789E+0
-+123.456789:-123456789E-6
--123456.789:+123456789E-3
-&fabs
-abc:NaN
-+0:+0E+0
-+1:+1E+0
--1:+1E+0
-+123456789:+123456789E+0
--123456789:+123456789E+0
-+123.456789:+123456789E-6
--123456.789:+123456789E-3
-&fround
-$bigfloat::rnd_mode = 'trunc'
-+10123456789:5:+10123E+6
--10123456789:5:-10123E+6
-+10123456789:9:+101234567E+2
--10123456789:9:-101234567E+2
-+101234500:6:+101234E+3
--101234500:6:-101234E+3
-$bigfloat::rnd_mode = 'zero'
-+20123456789:5:+20123E+6
--20123456789:5:-20123E+6
-+20123456789:9:+201234568E+2
--20123456789:9:-201234568E+2
-+201234500:6:+201234E+3
--201234500:6:-201234E+3
-$bigfloat::rnd_mode = '+inf'
-+30123456789:5:+30123E+6
--30123456789:5:-30123E+6
-+30123456789:9:+301234568E+2
--30123456789:9:-301234568E+2
-+301234500:6:+301235E+3
--301234500:6:-301234E+3
-$bigfloat::rnd_mode = '-inf'
-+40123456789:5:+40123E+6
--40123456789:5:-40123E+6
-+40123456789:9:+401234568E+2
--40123456789:9:-401234568E+2
-+401234500:6:+401234E+3
--401234500:6:-401235E+3
-$bigfloat::rnd_mode = 'odd'
-+50123456789:5:+50123E+6
--50123456789:5:-50123E+6
-+50123456789:9:+501234568E+2
--50123456789:9:-501234568E+2
-+501234500:6:+501235E+3
--501234500:6:-501235E+3
-$bigfloat::rnd_mode = 'even'
-+60123456789:5:+60123E+6
--60123456789:5:-60123E+6
-+60123456789:9:+601234568E+2
--60123456789:9:-601234568E+2
-+601234500:6:+601234E+3
--601234500:6:-601234E+3
-&ffround
-$bigfloat::rnd_mode = 'trunc'
-+1.23:-1:+12E-1
--1.23:-1:-12E-1
-+1.27:-1:+12E-1
--1.27:-1:-12E-1
-+1.25:-1:+12E-1
--1.25:-1:-12E-1
-+1.35:-1:+13E-1
--1.35:-1:-13E-1
--0.006:-1:+0E+0
--0.006:-2:+0E+0
-$bigfloat::rnd_mode = 'zero'
-+2.23:-1:+22E-1
--2.23:-1:-22E-1
-+2.27:-1:+23E-1
--2.27:-1:-23E-1
-+2.25:-1:+22E-1
--2.25:-1:-22E-1
-+2.35:-1:+23E-1
--2.35:-1:-23E-1
--0.0065:-1:+0E+0
--0.0065:-2:-1E-2
--0.0065:-3:-6E-3
--0.0065:-4:-65E-4
--0.0065:-5:-65E-4
-$bigfloat::rnd_mode = '+inf'
-+3.23:-1:+32E-1
--3.23:-1:-32E-1
-+3.27:-1:+33E-1
--3.27:-1:-33E-1
-+3.25:-1:+33E-1
--3.25:-1:-32E-1
-+3.35:-1:+34E-1
--3.35:-1:-33E-1
--0.0065:-1:+0E+0
--0.0065:-2:-1E-2
--0.0065:-3:-6E-3
--0.0065:-4:-65E-4
--0.0065:-5:-65E-4
-$bigfloat::rnd_mode = '-inf'
-+4.23:-1:+42E-1
--4.23:-1:-42E-1
-+4.27:-1:+43E-1
--4.27:-1:-43E-1
-+4.25:-1:+42E-1
--4.25:-1:-43E-1
-+4.35:-1:+43E-1
--4.35:-1:-44E-1
--0.0065:-1:+0E+0
--0.0065:-2:-1E-2
--0.0065:-3:-7E-3
--0.0065:-4:-65E-4
--0.0065:-5:-65E-4
-$bigfloat::rnd_mode = 'odd'
-+5.23:-1:+52E-1
--5.23:-1:-52E-1
-+5.27:-1:+53E-1
--5.27:-1:-53E-1
-+5.25:-1:+53E-1
--5.25:-1:-53E-1
-+5.35:-1:+53E-1
--5.35:-1:-53E-1
--0.0065:-1:+0E+0
--0.0065:-2:-1E-2
--0.0065:-3:-7E-3
--0.0065:-4:-65E-4
--0.0065:-5:-65E-4
-$bigfloat::rnd_mode = 'even'
-+6.23:-1:+62E-1
--6.23:-1:-62E-1
-+6.27:-1:+63E-1
--6.27:-1:-63E-1
-+6.25:-1:+62E-1
--6.25:-1:-62E-1
-+6.35:-1:+64E-1
--6.35:-1:-64E-1
--0.0065:-1:+0E+0
--0.0065:-2:-1E-2
--0.0065:-3:-6E-3
--0.0065:-4:-65E-4
--0.0065:-5:-65E-4
-&fcmp
-abc:abc:
-abc:+0:
-+0:abc:
-+0:+0:0
--1:+0:-1
-+0:-1:1
-+1:+0:1
-+0:+1:-1
--1:+1:-1
-+1:-1:1
--1:-1:0
-+1:+1:0
-+123:+123:0
-+123:+12:1
-+12:+123:-1
--123:-123:0
--123:-12:-1
--12:-123:1
-+123:+124:-1
-+124:+123:1
--123:-124:1
--124:-123:-1
-&fadd
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0E+0
-+1:+0:+1E+0
-+0:+1:+1E+0
-+1:+1:+2E+0
--1:+0:-1E+0
-+0:-1:-1E+0
--1:-1:-2E+0
--1:+1:+0E+0
-+1:-1:+0E+0
-+9:+1:+1E+1
-+99:+1:+1E+2
-+999:+1:+1E+3
-+9999:+1:+1E+4
-+99999:+1:+1E+5
-+999999:+1:+1E+6
-+9999999:+1:+1E+7
-+99999999:+1:+1E+8
-+999999999:+1:+1E+9
-+9999999999:+1:+1E+10
-+99999999999:+1:+1E+11
-+10:-1:+9E+0
-+100:-1:+99E+0
-+1000:-1:+999E+0
-+10000:-1:+9999E+0
-+100000:-1:+99999E+0
-+1000000:-1:+999999E+0
-+10000000:-1:+9999999E+0
-+100000000:-1:+99999999E+0
-+1000000000:-1:+999999999E+0
-+10000000000:-1:+9999999999E+0
-+123456789:+987654321:+111111111E+1
--123456789:+987654321:+864197532E+0
--123456789:-987654321:-111111111E+1
-+123456789:-987654321:-864197532E+0
-&fsub
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0E+0
-+1:+0:+1E+0
-+0:+1:-1E+0
-+1:+1:+0E+0
--1:+0:-1E+0
-+0:-1:+1E+0
--1:-1:+0E+0
--1:+1:-2E+0
-+1:-1:+2E+0
-+9:+1:+8E+0
-+99:+1:+98E+0
-+999:+1:+998E+0
-+9999:+1:+9998E+0
-+99999:+1:+99998E+0
-+999999:+1:+999998E+0
-+9999999:+1:+9999998E+0
-+99999999:+1:+99999998E+0
-+999999999:+1:+999999998E+0
-+9999999999:+1:+9999999998E+0
-+99999999999:+1:+99999999998E+0
-+10:-1:+11E+0
-+100:-1:+101E+0
-+1000:-1:+1001E+0
-+10000:-1:+10001E+0
-+100000:-1:+100001E+0
-+1000000:-1:+1000001E+0
-+10000000:-1:+10000001E+0
-+100000000:-1:+100000001E+0
-+1000000000:-1:+1000000001E+0
-+10000000000:-1:+10000000001E+0
-+123456789:+987654321:-864197532E+0
--123456789:+987654321:-111111111E+1
--123456789:-987654321:+864197532E+0
-+123456789:-987654321:+111111111E+1
-&fmul
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0E+0
-+0:+1:+0E+0
-+1:+0:+0E+0
-+0:-1:+0E+0
--1:+0:+0E+0
-+123456789123456789:+0:+0E+0
-+0:+123456789123456789:+0E+0
--1:-1:+1E+0
--1:+1:-1E+0
-+1:-1:-1E+0
-+1:+1:+1E+0
-+2:+3:+6E+0
--2:+3:-6E+0
-+2:-3:-6E+0
--2:-3:+6E+0
-+111:+111:+12321E+0
-+10101:+10101:+102030201E+0
-+1001001:+1001001:+1002003002001E+0
-+100010001:+100010001:+10002000300020001E+0
-+10000100001:+10000100001:+100002000030000200001E+0
-+11111111111:+9:+99999999999E+0
-+22222222222:+9:+199999999998E+0
-+33333333333:+9:+299999999997E+0
-+44444444444:+9:+399999999996E+0
-+55555555555:+9:+499999999995E+0
-+66666666666:+9:+599999999994E+0
-+77777777777:+9:+699999999993E+0
-+88888888888:+9:+799999999992E+0
-+99999999999:+9:+899999999991E+0
-&fdiv
-abc:abc:NaN
-abc:+1:abc:NaN
-+1:abc:NaN
-+0:+0:NaN
-+0:+1:+0E+0
-+1:+0:NaN
-+0:-1:+0E+0
--1:+0:NaN
-+1:+1:+1E+0
--1:-1:+1E+0
-+1:-1:-1E+0
--1:+1:-1E+0
-+1:+2:+5E-1
-+2:+1:+2E+0
-+10:+5:+2E+0
-+100:+4:+25E+0
-+1000:+8:+125E+0
-+10000:+16:+625E+0
-+10000:-16:-625E+0
-+999999999999:+9:+111111111111E+0
-+999999999999:+99:+10101010101E+0
-+999999999999:+999:+1001001001E+0
-+999999999999:+9999:+100010001E+0
-+999999999999999:+99999:+10000100001E+0
-+1000000000:+9:+1111111111111111111111111111111111111111E-31
-+2000000000:+9:+2222222222222222222222222222222222222222E-31
-+3000000000:+9:+3333333333333333333333333333333333333333E-31
-+4000000000:+9:+4444444444444444444444444444444444444444E-31
-+5000000000:+9:+5555555555555555555555555555555555555556E-31
-+6000000000:+9:+6666666666666666666666666666666666666667E-31
-+7000000000:+9:+7777777777777777777777777777777777777778E-31
-+8000000000:+9:+8888888888888888888888888888888888888889E-31
-+9000000000:+9:+1E+9
-+35500000:+113:+3141592920353982300884955752212389380531E-34
-+71000000:+226:+3141592920353982300884955752212389380531E-34
-+106500000:+339:+3141592920353982300884955752212389380531E-34
-+1000000000:+3:+3333333333333333333333333333333333333333E-31
-$bigfloat::div_scale = 20
-+1000000000:+9:+11111111111111111111E-11
-+2000000000:+9:+22222222222222222222E-11
-+3000000000:+9:+33333333333333333333E-11
-+4000000000:+9:+44444444444444444444E-11
-+5000000000:+9:+55555555555555555556E-11
-+6000000000:+9:+66666666666666666667E-11
-+7000000000:+9:+77777777777777777778E-11
-+8000000000:+9:+88888888888888888889E-11
-+9000000000:+9:+1E+9
-+35500000:+113:+314159292035398230088E-15
-+71000000:+226:+314159292035398230088E-15
-+106500000:+339:+31415929203539823009E-14
-+1000000000:+3:+33333333333333333333E-11
-$bigfloat::div_scale = 40
-&fsqrt
-+0:+0E+0
--1:NaN
--2:NaN
--16:NaN
--123.456:NaN
-+1:+1E+0
-+1.44:+12E-1
-+2:+141421356237309504880168872420969807857E-38
-+4:+2E+0
-+16:+4E+0
-+100:+1E+1
-+123.456:+1111107555549866648462149404118219234119E-38
-+15241.383936:+123456E-3

diff --git a/t/lib/bigfltpm.t b/t/lib/bigfltpm.t
deleted file mode 100755 (executable)
index e8de58d..0000000
--- a/t/lib/bigfltpm.t
+++ /dev/null
@@ -1,708 +0,0 @@
-#!/usr/bin/perl -w
-
-use Test;
-use strict;
-
-BEGIN
-  {
-  $| = 1;
-  unshift @INC, '../lib'; # for running manually
-  # chdir 't' if -d 't';
-  plan tests => 514;
-  }
-
-use Math::BigFloat;
-use Math::BigInt;
-
-my ($x,$y,$f,@args,$ans,$try,$ans1,$ans1_str,$setup);
-while (<DATA>)
-  {
-  chop;
-  $_ =~ s/#.*$//;      # remove comments
-  $_ =~ s/\s+$//;      # trailing spaces
-  next if /^$/;                # skip empty lines & comments
-  if (s/^&//)
-    {
-    $f = $_;
-    }
-  elsif (/^\$/)
-    {
-    $setup = $_; $setup =~ s/^\$/\$Math::BigFloat::/;  # rnd_mode, div_scale 
-    # print "$setup\n";
-    }
-  else
-    {
-    if (m|^(.*?):(/.+)$|)
-      {
-      $ans = $2;
-      @args = split(/:/,$1,99);
-      }
-    else
-      {
-      @args = split(/:/,$_,99); $ans = pop(@args);
-      }
-    $try = "\$x = new Math::BigFloat \"$args[0]\";";
-    if ($f eq "fnorm")
-      {
-        $try .= "\$x;";
-      } elsif ($f eq "binf") {
-        $try .= "\$x->binf('$args[1]');";
-      } elsif ($f eq "bsstr") {
-        $try .= "\$x->bsstr();";
-      } elsif ($f eq "_set") {
-        $try .= "\$x->_set('$args[1]'); \$x;";
-      } elsif ($f eq "fneg") {
-        $try .= "-\$x;";
-      } elsif ($f eq "bfloor") {
-        $try .= "\$x->bfloor();";
-      } elsif ($f eq "bceil") {
-        $try .= "\$x->bceil();";
-      } elsif ($f eq "is_zero") {
-        $try .= "\$x->is_zero()+0;";
-      } elsif ($f eq "is_one") {
-        $try .= "\$x->is_one()+0;";
-      } elsif ($f eq "is_odd") {
-        $try .= "\$x->is_odd()+0;";
-      } elsif ($f eq "is_even") {
-        $try .= "\$x->is_even()+0;";
-      } elsif ($f eq "as_number") {
-        $try .= "\$x->as_number();";
-      } elsif ($f eq "fpow") {
-        $try .= "\$x ** $args[1];";
-      } elsif ($f eq "fabs") {
-        $try .= "abs \$x;";
-      }elsif ($f eq "fround") {
-        $try .= "$setup; \$x->fround($args[1]);";
-      } elsif ($f eq "ffround") {
-        $try .= "$setup; \$x->ffround($args[1]);";
-      } elsif ($f eq "fsqrt") {
-        $try .= "$setup; \$x->fsqrt();";
-      }
-    else
-      {
-      $try .= "\$y = new Math::BigFloat \"$args[1]\";";
-      if ($f eq "fcmp") {
-        $try .= "\$x <=> \$y;";
-      } elsif ($f eq "fadd") {
-        $try .= "\$x + \$y;";
-      } elsif ($f eq "fsub") {
-        $try .= "\$x - \$y;";
-      } elsif ($f eq "fmul") {
-        $try .= "\$x * \$y;";
-      } elsif ($f eq "fdiv") {
-        $try .= "$setup; \$x / \$y;";
-      } elsif ($f eq "fmod") {
-        $try .= "\$x % \$y;";
-      } else { warn "Unknown op '$f'"; }
-    }
-    $ans1 = eval $try;
-    if ($ans =~ m|^/(.*)$|)
-      {
-      my $pat = $1;
-      if ($ans1 =~ /$pat/)
-        {
-        ok (1,1);
-        }
-      else
-        {
-        print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0);
-        }
-      }
-    else
-      {
-      if ($ans eq "")
-        {
-        ok_undef ($ans1);
-        }
-      else
-        {
-        print "# Tried: '$try'\n" if !ok ($ans1, $ans);
-        } 
-      } # end pattern or string
-    }
-  } # end while
-
-# all done
-
-###############################################################################
-# Perl 5.005 does not like ok ($x,undef)
-
-sub ok_undef
-  {
-  my $x = shift;
-
-  ok (1,1) and return if !defined $x;
-  ok ($x,'undef');
-  }
-   
-__END__
-&as_number
-0:0
-1:1
-1.2:1
-2.345:2
--2:-2
--123.456:-123
--200:-200
-&binf
-1:+:+inf
-2:-:-inf
-3:abc:+inf
-&bsstr
-+inf:+inf
--inf:-inf
-abc:NaN
-&fnorm
-+inf:+inf
--inf:-inf
-+infinity:NaN
-+-inf:NaN
-abc:NaN
-   1 a:NaN
-1bcd2:NaN
-11111b:NaN
-+1z:NaN
--1z:NaN
-0:0
-+0:0
-+00:0
-+0_0_0:0
-000000_0000000_00000:0
--0:0
--0000:0
-+1:1
-+01:1
-+001:1
-+00000100000:100000
-123456789:123456789
--1:-1
--01:-1
--001:-1
--123456789:-123456789
--00000100000:-100000
-123.456a:NaN
-123.456:123.456
-0.01:0.01
-.002:0.002
-+.2:0.2
--0.0003:-0.0003
--.0000000004:-0.0000000004
-123456E2:12345600
-123456E-2:1234.56
--123456E2:-12345600
--123456E-2:-1234.56
-1e1:10
-2e-11:0.00000000002
--3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
--4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004
-&fpow
-2:2:4
-1:2:1
-1:3:1
--1:2:1
--1:3:-1
-123.456:2:15241.383936
-2:-2:0.25
-2:-3:0.125
-128:-2:0.00006103515625
-&fneg
-abc:NaN
-+0:0
-+1:-1
--1:1
-+123456789:-123456789
--123456789:123456789
-+123.456789:-123.456789
--123456.789:123456.789
-&fabs
-abc:NaN
-+0:0
-+1:1
--1:1
-+123456789:123456789
--123456789:123456789
-+123.456789:123.456789
--123456.789:123456.789
-&fround
-$rnd_mode = "trunc"
-+10123456789:5:10123000000
--10123456789:5:-10123000000
-+10123456789.123:5:10123000000
--10123456789.123:5:-10123000000
-+10123456789:9:10123456700
--10123456789:9:-10123456700
-+101234500:6:101234000
--101234500:6:-101234000
-$rnd_mode = "zero"
-+20123456789:5:20123000000
--20123456789:5:-20123000000
-+20123456789.123:5:20123000000
--20123456789.123:5:-20123000000
-+20123456789:9:20123456800
--20123456789:9:-20123456800
-+201234500:6:201234000
--201234500:6:-201234000
-$rnd_mode = "+inf"
-+30123456789:5:30123000000
--30123456789:5:-30123000000
-+30123456789.123:5:30123000000
--30123456789.123:5:-30123000000
-+30123456789:9:30123456800
--30123456789:9:-30123456800
-+301234500:6:301235000
--301234500:6:-301234000
-$rnd_mode = "-inf"
-+40123456789:5:40123000000
--40123456789:5:-40123000000
-+40123456789.123:5:40123000000
--40123456789.123:5:-40123000000
-+40123456789:9:40123456800
--40123456789:9:-40123456800
-+401234500:6:401234000
--401234500:6:-401235000
-$rnd_mode = "odd"
-+50123456789:5:50123000000
--50123456789:5:-50123000000
-+50123456789.123:5:50123000000
--50123456789.123:5:-50123000000
-+50123456789:9:50123456800
--50123456789:9:-50123456800
-+501234500:6:501235000
--501234500:6:-501235000
-$rnd_mode = "even"
-+60123456789:5:60123000000
--60123456789:5:-60123000000
-+60123456789:9:60123456800
--60123456789:9:-60123456800
-+601234500:6:601234000
--601234500:6:-601234000
-+60123456789.0123:5:60123000000
--60123456789.0123:5:-60123000000
-&ffround
-$rnd_mode = "trunc"
-+1.23:-1:1.2
-+1.234:-1:1.2
-+1.2345:-1:1.2
-+1.23:-2:1.23
-+1.234:-2:1.23
-+1.2345:-2:1.23
-+1.23:-3:1.23
-+1.234:-3:1.234
-+1.2345:-3:1.234
--1.23:-1:-1.2
-+1.27:-1:1.2
--1.27:-1:-1.2
-+1.25:-1:1.2
--1.25:-1:-1.2
-+1.35:-1:1.3
--1.35:-1:-1.3
--0.0061234567890:-1:0
--0.0061:-1:0
--0.00612:-1:0
--0.00612:-2:0
--0.006:-1:0
--0.006:-2:0
--0.0006:-2:0
--0.0006:-3:0
--0.0065:-3:/-0\.006|-6e-03
--0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
--0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
-0.05:0:0
-0.5:0:0
-0.51:0:0
-0.41:0:0
-$rnd_mode = "zero"
-+2.23:-1:/2.2(?:0{5}\d+)?
--2.23:-1:/-2.2(?:0{5}\d+)?
-+2.27:-1:/2.(?:3|29{5}\d+)
--2.27:-1:/-2.(?:3|29{5}\d+)
-+2.25:-1:/2.2(?:0{5}\d+)?
--2.25:-1:/-2.2(?:0{5}\d+)?
-+2.35:-1:/2.(?:3|29{5}\d+)
--2.35:-1:/-2.(?:3|29{5}\d+)
--0.0065:-1:0
--0.0065:-2:/-0\.01|-1e-02
--0.0065:-3:/-0\.006|-6e-03
--0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
--0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
-0.05:0:0
-0.5:0:0
-0.51:0:1
-0.41:0:0
-$rnd_mode = "+inf"
-+3.23:-1:/3.2(?:0{5}\d+)?
--3.23:-1:/-3.2(?:0{5}\d+)?
-+3.27:-1:/3.(?:3|29{5}\d+)
--3.27:-1:/-3.(?:3|29{5}\d+)
-+3.25:-1:/3.(?:3|29{5}\d+)
--3.25:-1:/-3.2(?:0{5}\d+)?
-+3.35:-1:/3.(?:4|39{5}\d+)
--3.35:-1:/-3.(?:3|29{5}\d+)
--0.0065:-1:0
--0.0065:-2:/-0\.01|-1e-02
--0.0065:-3:/-0\.006|-6e-03
--0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
--0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
-0.05:0:0
-0.5:0:1
-0.51:0:1
-0.41:0:0
-$rnd_mode = "-inf"
-+4.23:-1:/4.2(?:0{5}\d+)?
--4.23:-1:/-4.2(?:0{5}\d+)?
-+4.27:-1:/4.(?:3|29{5}\d+)
--4.27:-1:/-4.(?:3|29{5}\d+)
-+4.25:-1:/4.2(?:0{5}\d+)?
--4.25:-1:/-4.(?:3|29{5}\d+)
-+4.35:-1:/4.(?:3|29{5}\d+)
--4.35:-1:/-4.(?:4|39{5}\d+)
--0.0065:-1:0
--0.0065:-2:/-0\.01|-1e-02
--0.0065:-3:/-0\.007|-7e-03
--0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
--0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
-0.05:0:0
-0.5:0:0
-0.51:0:1
-0.41:0:0
-$rnd_mode = "odd"
-+5.23:-1:/5.2(?:0{5}\d+)?
--5.23:-1:/-5.2(?:0{5}\d+)?
-+5.27:-1:/5.(?:3|29{5}\d+)
--5.27:-1:/-5.(?:3|29{5}\d+)
-+5.25:-1:/5.(?:3|29{5}\d+)
--5.25:-1:/-5.(?:3|29{5}\d+)
-+5.35:-1:/5.(?:3|29{5}\d+)
--5.35:-1:/-5.(?:3|29{5}\d+)
--0.0065:-1:0
--0.0065:-2:/-0\.01|-1e-02
--0.0065:-3:/-0\.007|-7e-03
--0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
--0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
-0.05:0:0
-0.5:0:1
-0.51:0:1
-0.41:0:0
-$rnd_mode = "even"
-+6.23:-1:/6.2(?:0{5}\d+)?
--6.23:-1:/-6.2(?:0{5}\d+)?
-+6.27:-1:/6.(?:3|29{5}\d+)
--6.27:-1:/-6.(?:3|29{5}\d+)
-+6.25:-1:/6.(?:2(?:0{5}\d+)?|29{5}\d+)
--6.25:-1:/-6.(?:2(?:0{5}\d+)?|29{5}\d+)
-+6.35:-1:/6.(?:4|39{5}\d+|29{8}\d+)
--6.35:-1:/-6.(?:4|39{5}\d+|29{8}\d+)
--0.0065:-1:0
--0.0065:-2:/-0\.01|-1e-02
--0.0065:-3:/-0\.006|-7e-03
--0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
--0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
-0.05:0:0
-0.5:0:0
-0.51:0:1
-0.41:0:0
-0.01234567:-3:0.012
-0.01234567:-4:0.0123
-0.01234567:-5:0.01235
-0.01234567:-6:0.012346
-0.01234567:-7:0.0123457
-0.01234567:-8:0.01234567
-0.01234567:-9:0.01234567
-0.01234567:-12:0.01234567
-&fcmp
-abc:abc:
-abc:+0:
-+0:abc:
-+0:+0:0
--1:+0:-1
-+0:-1:1
-+1:+0:1
-+0:+1:-1
--1:+1:-1
-+1:-1:1
--1:-1:0
-+1:+1:0
--1.1:0:-1
-+0:-1.1:1
-+1.1:+0:1
-+0:+1.1:-1
-+123:+123:0
-+123:+12:1
-+12:+123:-1
--123:-123:0
--123:-12:-1
--12:-123:1
-+123:+124:-1
-+124:+123:1
--123:-124:1
--124:-123:-1
-0:0.01:-1
-0:0.0001:-1
-0:-0.0001:1
-0:-0.1:1
-0.1:0:1
-0.00001:0:1
--0.0001:0:-1
--0.1:0:-1
-0:0.0001234:-1
-0:-0.0001234:1
-0.0001234:0:1
--0.0001234:0:-1
-0.0001:0.0005:-1
-0.0005:0.0001:1
-0.005:0.0001:1
-0.001:0.0005:1
-0.000001:0.0005:-2     # <0, but can't test this
-0.00000123:0.0005:-2   # <0, but can't test this
-0.00512:0.0001:1
-0.005:0.000112:1
-0.00123:0.0005:1
-&fadd
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:0
-+1:+0:1
-+0:+1:1
-+1:+1:2
--1:+0:-1
-+0:-1:-1
--1:-1:-2
--1:+1:0
-+1:-1:0
-+9:+1:10
-+99:+1:100
-+999:+1:1000
-+9999:+1:10000
-+99999:+1:100000
-+999999:+1:1000000
-+9999999:+1:10000000
-+99999999:+1:100000000
-+999999999:+1:1000000000
-+9999999999:+1:10000000000
-+99999999999:+1:100000000000
-+10:-1:9
-+100:-1:99
-+1000:-1:999
-+10000:-1:9999
-+100000:-1:99999
-+1000000:-1:999999
-+10000000:-1:9999999
-+100000000:-1:99999999
-+1000000000:-1:999999999
-+10000000000:-1:9999999999
-+123456789:+987654321:1111111110
--123456789:+987654321:864197532
--123456789:-987654321:-1111111110
-+123456789:-987654321:-864197532
-&fsub
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:0
-+1:+0:1
-+0:+1:-1
-+1:+1:0
--1:+0:-1
-+0:-1:1
--1:-1:0
--1:+1:-2
-+1:-1:2
-+9:+1:8
-+99:+1:98
-+999:+1:998
-+9999:+1:9998
-+99999:+1:99998
-+999999:+1:999998
-+9999999:+1:9999998
-+99999999:+1:99999998
-+999999999:+1:999999998
-+9999999999:+1:9999999998
-+99999999999:+1:99999999998
-+10:-1:11
-+100:-1:101
-+1000:-1:1001
-+10000:-1:10001
-+100000:-1:100001
-+1000000:-1:1000001
-+10000000:-1:10000001
-+100000000:-1:100000001
-+1000000000:-1:1000000001
-+10000000000:-1:10000000001
-+123456789:+987654321:-864197532
--123456789:+987654321:-1111111110
--123456789:-987654321:864197532
-+123456789:-987654321:1111111110
-&fmul
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:0
-+0:+1:0
-+1:+0:0
-+0:-1:0
--1:+0:0
-+123456789123456789:+0:0
-+0:+123456789123456789:0
--1:-1:1
--1:+1:-1
-+1:-1:-1
-+1:+1:1
-+2:+3:6
--2:+3:-6
-+2:-3:-6
--2:-3:6
-+111:+111:12321
-+10101:+10101:102030201
-+1001001:+1001001:1002003002001
-+100010001:+100010001:10002000300020001
-+10000100001:+10000100001:100002000030000200001
-+11111111111:+9:99999999999
-+22222222222:+9:199999999998
-+33333333333:+9:299999999997
-+44444444444:+9:399999999996
-+55555555555:+9:499999999995
-+66666666666:+9:599999999994
-+77777777777:+9:699999999993
-+88888888888:+9:799999999992
-+99999999999:+9:899999999991
-&fdiv
-$div_scale = 40; $Math::BigFloat::rnd_mode = 'even'
-abc:abc:NaN
-abc:+1:abc:NaN
-+1:abc:NaN
-+0:+0:NaN
-+0:+1:0
-+1:+0:NaN
-+0:-1:0
--1:+0:NaN
-+1:+1:1
--1:-1:1
-+1:-1:-1
--1:+1:-1
-+1:+2:0.5
-+2:+1:2
-+10:+5:2
-+100:+4:25
-+1000:+8:125
-+10000:+16:625
-+10000:-16:-625
-+999999999999:+9:111111111111
-+999999999999:+99:10101010101
-+999999999999:+999:1001001001
-+999999999999:+9999:100010001
-+999999999999999:+99999:10000100001
-+1000000000:+9:111111111.1111111111111111111111111111111
-+2000000000:+9:222222222.2222222222222222222222222222222
-+3000000000:+9:333333333.3333333333333333333333333333333
-+4000000000:+9:444444444.4444444444444444444444444444444
-+5000000000:+9:555555555.5555555555555555555555555555556
-+6000000000:+9:666666666.6666666666666666666666666666667
-+7000000000:+9:777777777.7777777777777777777777777777778
-+8000000000:+9:888888888.8888888888888888888888888888889
-+9000000000:+9:1000000000
-+35500000:+113:314159.2920353982300884955752212389380531
-+71000000:+226:314159.2920353982300884955752212389380531
-+106500000:+339:314159.2920353982300884955752212389380531
-+1000000000:+3:333333333.3333333333333333333333333333333
-$div_scale = 20
-+1000000000:+9:111111111.11111111111
-+2000000000:+9:222222222.22222222222
-+3000000000:+9:333333333.33333333333
-+4000000000:+9:444444444.44444444444
-+5000000000:+9:555555555.55555555556
-+6000000000:+9:666666666.66666666667
-+7000000000:+9:777777777.77777777778
-+8000000000:+9:888888888.88888888889
-+9000000000:+9:1000000000
-# following two cases are the "old" behaviour, but are now (>v0.01) different
-#+35500000:+113:314159.292035398230088
-#+71000000:+226:314159.292035398230088
-+35500000:+113:314159.29203539823009
-+71000000:+226:314159.29203539823009
-+106500000:+339:314159.29203539823009
-+1000000000:+3:333333333.33333333333
-$div_scale = 1
-# div_scale will be 3 since $x has 3 digits
-+124:+3:41.3
-# reset scale for further tests
-$div_scale = 40
-&fmod
-+0:0:NaN
-+0:1:0
-+3:1:0
-#+5:2:1
-#+9:4:1
-#+9:5:4
-#+9000:56:40
-#+56:9000:56
-&fsqrt
-+0:0
--1:NaN
--2:NaN
--16:NaN
--123.45:NaN
-+1:1
-#+1.44:1.2
-#+2:1.41421356237309504880168872420969807857
-#+4:2
-#+16:4
-#+100:10
-#+123.456:11.11107555549866648462149404118219234119
-#+15241.38393:123.456
-&is_odd
-abc:0
-0:0
--1:1
--3:1
-1:1
-3:1
-1000001:1
-1000002:0
-2:0
-&is_even
-abc:0
-0:1
--1:0
--3:0
-1:0
-3:0
-1000001:0
-1000002:1
-2:1
-&is_zero
-NaNzero:0
-0:1
--1:0
-1:0
-&is_one
-0:0
-2:0
-1:1
--1:0
--2:0
-&_set
-NaN:2:2
-2:abc:NaN
-1:-1:-1
-2:1:1
--2:0:0
-128:-2:-2
-&bfloor
-0:0
-abc:NaN
-+inf:+inf
--inf:-inf
-1:1
--51:-51
--51.2:-52
-12.2:12
-&bceil
-0:0
-abc:NaN
-+inf:+inf
--inf:-inf
-1:1
--51:-51
--51.2:-51
-12.2:13

diff --git a/t/lib/bigint.t b/t/lib/bigint.t
deleted file mode 100755 (executable)
index 034c5c6..0000000
--- a/t/lib/bigint.t
+++ /dev/null
@@ -1,282 +0,0 @@
-#!./perl
-
-BEGIN { @INC = '../lib' }
-require "bigint.pl";
-
-$test = 0;
-$| = 1;
-print "1..246\n";
-while (<DATA>) {
-       chop;
-       if (/^&/) {
-               $f = $_;
-       } else {
-               ++$test;
-               @args = split(/:/,$_,99);
-               $ans = pop(@args);
-               $try = "$f('" . join("','", @args) . "');";
-               if (($ans1 = eval($try)) eq $ans) {
-                       print "ok $test\n";
-               } else {
-                       print "not ok $test\n";
-                       print "# '$try' expected: '$ans' got: '$ans1'\n";
-               }
-       }
-} 
-__END__
-&bnorm
-abc:NaN
-   1 a:NaN
-1bcd2:NaN
-11111b:NaN
-+1z:NaN
--1z:NaN
-0:+0
-+0:+0
-+00:+0
-+0 0 0:+0
-000000  0000000   00000:+0
--0:+0
--0000:+0
-+1:+1
-+01:+1
-+001:+1
-+00000100000:+100000
-123456789:+123456789
--1:-1
--01:-1
--001:-1
--123456789:-123456789
--00000100000:-100000
-&bneg
-abd:NaN
-+0:+0
-+1:-1
--1:+1
-+123456789:-123456789
--123456789:+123456789
-&babs
-abc:NaN
-+0:+0
-+1:+1
--1:+1
-+123456789:+123456789
--123456789:+123456789
-&bcmp
-abc:abc:
-abc:+0:
-+0:abc:
-+0:+0:0
--1:+0:-1
-+0:-1:1
-+1:+0:1
-+0:+1:-1
--1:+1:-1
-+1:-1:1
--1:-1:0
-+1:+1:0
-+123:+123:0
-+123:+12:1
-+12:+123:-1
--123:-123:0
--123:-12:-1
--12:-123:1
-+123:+124:-1
-+124:+123:1
--123:-124:1
--124:-123:-1
-&badd
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0
-+1:+0:+1
-+0:+1:+1
-+1:+1:+2
--1:+0:-1
-+0:-1:-1
--1:-1:-2
--1:+1:+0
-+1:-1:+0
-+9:+1:+10
-+99:+1:+100
-+999:+1:+1000
-+9999:+1:+10000
-+99999:+1:+100000
-+999999:+1:+1000000
-+9999999:+1:+10000000
-+99999999:+1:+100000000
-+999999999:+1:+1000000000
-+9999999999:+1:+10000000000
-+99999999999:+1:+100000000000
-+10:-1:+9
-+100:-1:+99
-+1000:-1:+999
-+10000:-1:+9999
-+100000:-1:+99999
-+1000000:-1:+999999
-+10000000:-1:+9999999
-+100000000:-1:+99999999
-+1000000000:-1:+999999999
-+10000000000:-1:+9999999999
-+123456789:+987654321:+1111111110
--123456789:+987654321:+864197532
--123456789:-987654321:-1111111110
-+123456789:-987654321:-864197532
-&bsub
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0
-+1:+0:+1
-+0:+1:-1
-+1:+1:+0
--1:+0:-1
-+0:-1:+1
--1:-1:+0
--1:+1:-2
-+1:-1:+2
-+9:+1:+8
-+99:+1:+98
-+999:+1:+998
-+9999:+1:+9998
-+99999:+1:+99998
-+999999:+1:+999998
-+9999999:+1:+9999998
-+99999999:+1:+99999998
-+999999999:+1:+999999998
-+9999999999:+1:+9999999998
-+99999999999:+1:+99999999998
-+10:-1:+11
-+100:-1:+101
-+1000:-1:+1001
-+10000:-1:+10001
-+100000:-1:+100001
-+1000000:-1:+1000001
-+10000000:-1:+10000001
-+100000000:-1:+100000001
-+1000000000:-1:+1000000001
-+10000000000:-1:+10000000001
-+123456789:+987654321:-864197532
--123456789:+987654321:-1111111110
--123456789:-987654321:+864197532
-+123456789:-987654321:+1111111110
-&bmul
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0
-+0:+1:+0
-+1:+0:+0
-+0:-1:+0
--1:+0:+0
-+123456789123456789:+0:+0
-+0:+123456789123456789:+0
--1:-1:+1
--1:+1:-1
-+1:-1:-1
-+1:+1:+1
-+2:+3:+6
--2:+3:-6
-+2:-3:-6
--2:-3:+6
-+111:+111:+12321
-+10101:+10101:+102030201
-+1001001:+1001001:+1002003002001
-+100010001:+100010001:+10002000300020001
-+10000100001:+10000100001:+100002000030000200001
-+11111111111:+9:+99999999999
-+22222222222:+9:+199999999998
-+33333333333:+9:+299999999997
-+44444444444:+9:+399999999996
-+55555555555:+9:+499999999995
-+66666666666:+9:+599999999994
-+77777777777:+9:+699999999993
-+88888888888:+9:+799999999992
-+99999999999:+9:+899999999991
-&bdiv
-abc:abc:NaN
-abc:+1:abc:NaN
-+1:abc:NaN
-+0:+0:NaN
-+0:+1:+0
-+1:+0:NaN
-+0:-1:+0
--1:+0:NaN
-+1:+1:+1
--1:-1:+1
-+1:-1:-1
--1:+1:-1
-+1:+2:+0
-+2:+1:+2
-+1000000000:+9:+111111111
-+2000000000:+9:+222222222
-+3000000000:+9:+333333333
-+4000000000:+9:+444444444
-+5000000000:+9:+555555555
-+6000000000:+9:+666666666
-+7000000000:+9:+777777777
-+8000000000:+9:+888888888
-+9000000000:+9:+1000000000
-+35500000:+113:+314159
-+71000000:+226:+314159
-+106500000:+339:+314159
-+1000000000:+3:+333333333
-+10:+5:+2
-+100:+4:+25
-+1000:+8:+125
-+10000:+16:+625
-+999999999999:+9:+111111111111
-+999999999999:+99:+10101010101
-+999999999999:+999:+1001001001
-+999999999999:+9999:+100010001
-+999999999999999:+99999:+10000100001
-&bmod
-abc:abc:NaN
-abc:+1:abc:NaN
-+1:abc:NaN
-+0:+0:NaN
-+0:+1:+0
-+1:+0:NaN
-+0:-1:+0
--1:+0:NaN
-+1:+1:+0
--1:-1:+0
-+1:-1:+0
--1:+1:+0
-+1:+2:+1
-+2:+1:+0
-+1000000000:+9:+1
-+2000000000:+9:+2
-+3000000000:+9:+3
-+4000000000:+9:+4
-+5000000000:+9:+5
-+6000000000:+9:+6
-+7000000000:+9:+7
-+8000000000:+9:+8
-+9000000000:+9:+0
-+35500000:+113:+33
-+71000000:+226:+66
-+106500000:+339:+99
-+1000000000:+3:+1
-+10:+5:+0
-+100:+4:+0
-+1000:+8:+0
-+10000:+16:+0
-+999999999999:+9:+0
-+999999999999:+99:+0
-+999999999999:+999:+0
-+999999999999:+9999:+0
-+999999999999999:+99999:+0
-&bgcd
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0
-+0:+1:+1
-+1:+0:+1
-+1:+1:+1
-+2:+3:+1
-+3:+2:+1
-+100:+625:+25
-+4096:+81:+1

diff --git a/t/lib/bigintpm.t b/t/lib/bigintpm.t
deleted file mode 100755 (executable)
index f819104..0000000
--- a/t/lib/bigintpm.t
+++ /dev/null
@@ -1,1238 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-use Test;
-
-BEGIN 
-  {
-  $| = 1;
-  # chdir 't' if -d 't';
-  unshift @INC, '../lib'; # for running manually
-  plan tests => 1190;
-  }
-
-##############################################################################
-# for testing inheritance of _swap
-
-package Math::Foo;
-
-use Math::BigInt;
-use vars qw/@ISA/;
-@ISA = (qw/Math::BigInt/);
-
-use overload
-# customized overload for sub, since original does not use swap there
-'-'     =>      sub { my @a = ref($_[0])->_swap(@_);
-                   $a[0]->bsub($a[1])};
-
-sub _swap
-  {
-  # a fake _swap, which reverses the params
-  my $self = shift;                     # for override in subclass
-  if ($_[2])
-    {
-    my $c = ref ($_[0] ) || 'Math::Foo';
-    return ( $_[0]->copy(), $_[1] );
-    }
-  else
-    {
-    return ( Math::Foo->new($_[1]), $_[0] );
-    }
-  }
-
-##############################################################################
-package main;
-
-use Math::BigInt;
-
-my (@args,$f,$try,$x,$y,$z,$a,$exp,$ans,$ans1,@a,$m,$e,$round_mode);
-
-while (<DATA>) 
-  {
-  chop;
-  next if /^#/;        # skip comments
-  if (s/^&//) 
-    {
-    $f = $_;
-    }
-  elsif (/^\$/) 
-    {
-    $round_mode = $_;
-    $round_mode =~ s/^\$/Math::BigInt->/;
-    # print "$round_mode\n";
-    }
-  else 
-    {
-    @args = split(/:/,$_,99);
-    $ans = pop(@args);
-    $try = "\$x = Math::BigInt->new(\"$args[0]\");";
-    if ($f eq "bnorm"){
-      # $try .= '$x+0;';
-    } elsif ($f eq "_set") {
-      $try .= '$x->_set($args[1]); "$x";';
-    } elsif ($f eq "is_zero") {
-      $try .= '$x->is_zero()+0;';
-    } elsif ($f eq "is_one") {
-      $try .= '$x->is_one()+0;';
-    } elsif ($f eq "is_odd") {
-      $try .= '$x->is_odd()+0;';
-    } elsif ($f eq "is_even") {
-      $try .= '$x->is_even()+0;';
-    } elsif ($f eq "binf") {
-      $try .= "\$x->binf('$args[1]');";
-    } elsif ($f eq "bfloor") {
-      $try .= '$x->bfloor();';
-    } elsif ($f eq "bceil") {
-      $try .= '$x->bceil();';
-    } elsif ($f eq "is_inf") {
-      $try .= "\$x->is_inf('$args[1]')+0;";
-    } elsif ($f eq "bsstr") {
-      $try .= '$x->bsstr();';
-    } elsif ($f eq "bneg") {
-      $try .= '-$x;';
-    } elsif ($f eq "babs") {
-      $try .= 'abs $x;';
-    } elsif ($f eq "binc") {
-      $try .= '++$x;'; 
-    } elsif ($f eq "bdec") {
-      $try .= '--$x;'; 
-    }elsif ($f eq "bnot") {
-      $try .= '~$x;';
-    }elsif ($f eq "bsqrt") {
-      $try .= '$x->bsqrt();';
-    }elsif ($f eq "length") {
-      $try .= "\$x->length();";
-    }elsif ($f eq "bround") {
-      $try .= "$round_mode; \$x->bround($args[1]);";
-    }elsif ($f eq "exponent"){
-      $try .= '$x = $x->exponent()->bstr();';
-    }elsif ($f eq "mantissa"){
-      $try .= '$x = $x->mantissa()->bstr();';
-    }elsif ($f eq "parts"){
-      $try .= "(\$m,\$e) = \$x->parts();"; 
-      $try .= '$m = $m->bstr(); $m = "NaN" if !defined $m;';
-      $try .= '$e = $e->bstr(); $e = "NaN" if !defined $e;';
-      $try .= '"$m,$e";';
-    } else {
-      $try .= "\$y = new Math::BigInt \"$args[1]\";";
-      if ($f eq "bcmp"){
-        $try .= '$x <=> $y;';
-      }elsif ($f eq "bacmp"){
-        $try .= '$x->bacmp($y);';
-      }elsif ($f eq "badd"){
-        $try .= "\$x + \$y;";
-      }elsif ($f eq "bsub"){
-        $try .= "\$x - \$y;";
-      }elsif ($f eq "bmul"){
-        $try .= "\$x * \$y;";
-      }elsif ($f eq "bdiv"){
-        $try .= "\$x / \$y;";
-      }elsif ($f eq "bmod"){
-        $try .= "\$x % \$y;";
-      }elsif ($f eq "bgcd")
-        {
-        if (defined $args[2])
-          {
-          $try .= " \$z = new Math::BigInt \"$args[2]\"; ";
-          }
-        $try .= "Math::BigInt::bgcd(\$x, \$y";
-        $try .= ", \$z" if (defined $args[2]);
-        $try .= " );";
-        }
-      elsif ($f eq "blcm")
-        {
-        if (defined $args[2])
-          {
-          $try .= " \$z = new Math::BigInt \"$args[2]\"; ";
-          }
-        $try .= "Math::BigInt::blcm(\$x, \$y";
-        $try .= ", \$z" if (defined $args[2]);
-        $try .= " );";
-      }elsif ($f eq "blsft"){
-        if (defined $args[2])
-          {
-          $try .= "\$x->blsft(\$y,$args[2]);";
-          }
-        else
-          {
-          $try .= "\$x << \$y;";
-          }
-      }elsif ($f eq "brsft"){
-        if (defined $args[2])
-          {
-          $try .= "\$x->brsft(\$y,$args[2]);";
-          }
-        else
-          {
-          $try .= "\$x >> \$y;";
-          }
-      }elsif ($f eq "band"){
-        $try .= "\$x & \$y;";
-      }elsif ($f eq "bior"){
-        $try .= "\$x | \$y;";
-      }elsif ($f eq "bxor"){
-        $try .= "\$x ^ \$y;";
-      }elsif ($f eq "bpow"){
-        $try .= "\$x ** \$y;";
-      }elsif ($f eq "digit"){
-        $try = "\$x = Math::BigInt->new(\"$args[0]\"); \$x->digit($args[1]);";
-      } else { warn "Unknown op '$f'"; }
-    }
-    # print "trying $try\n";
-    $ans1 = eval $try;
-    $ans =~ s/^[+]([0-9])/$1/;                 # remove leading '+' 
-    if ($ans eq "")
-      {
-      ok_undef ($ans1); 
-      }
-    else
-      {
-      #print "try: $try ans: $ans1 $ans\n";
-      print "# Tried: '$try'\n" if !ok ($ans1, $ans);
-      }
-    # check internal state of number objects
-    is_valid($ans1) if ref $ans1; 
-    }
-  } # endwhile data tests
-close DATA;
-
-# test whether constant works or not
-$try = "use Math::BigInt (1.31,'babs',':constant');";
-$try .= ' $x = 2**150; babs($x); $x = "$x";';
-$ans1 = eval $try;
-
-ok ( $ans1, "1427247692705959881058285969449495136382746624");
-
-# test some more
-@a = ();
-for (my $i = 1; $i < 10; $i++) 
-  {
-  push @a, $i;
-  }
-ok "@a", "1 2 3 4 5 6 7 8 9";
-
-# test whether selfmultiplication works correctly (result is 2**64)
-$try = '$x = new Math::BigInt "+4294967296";';
-$try .= '$a = $x->bmul($x);';
-$ans1 = eval $try;
-print "# Tried: '$try'\n" if !ok ($ans1, Math::BigInt->new(2) ** 64);
-
-# test whether op detroys args or not (should better not)
-
-$x = new Math::BigInt (3);
-$y = new Math::BigInt (4);
-$z = $x & $y;
-ok ($x,3);
-ok ($y,4);
-ok ($z,0);
-$z = $x | $y;
-ok ($x,3);
-ok ($y,4);
-ok ($z,7);
-$x = new Math::BigInt (1);
-$y = new Math::BigInt (2);
-$z = $x | $y;
-ok ($x,1);
-ok ($y,2);
-ok ($z,3);
-
-$x = new Math::BigInt (5);
-$y = new Math::BigInt (4);
-$z = $x ^ $y;
-ok ($x,5);
-ok ($y,4);
-ok ($z,1);
-
-$x = new Math::BigInt (-5); $y = -$x;
-ok ($x, -5);
-
-$x = new Math::BigInt (-5); $y = abs($x);
-ok ($x, -5);
-
-# check whether overloading cmp works
-$try = "\$x = Math::BigInt->new(0);";
-$try .= "\$y = 10;";
-$try .= "'false' if \$x ne \$y;";
-$ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "false" ); 
-
-# we cant test for working cmpt with other objects here, we would need a dummy
-# object with stringify overload for this. see Math::String tests
-
-###############################################################################
-# check shortcuts
-$try = "\$x = Math::BigInt->new(1); \$x += 9;";
-$try .= "'ok' if \$x == 10;";
-$ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-$try = "\$x = Math::BigInt->new(1); \$x -= 9;";
-$try .= "'ok' if \$x == -8;";
-$ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-$try = "\$x = Math::BigInt->new(1); \$x *= 9;";
-$try .= "'ok' if \$x == 9;";
-$ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-$try = "\$x = Math::BigInt->new(10); \$x /= 2;";
-$try .= "'ok' if \$x == 5;";
-$ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-###############################################################################
-# check reversed order of arguments
-$try = "\$x = Math::BigInt->new(10); \$x = 2 ** \$x;";
-$try .= "'ok' if \$x == 1024;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-$try = "\$x = Math::BigInt->new(10); \$x = 2 * \$x;";
-$try .= "'ok' if \$x == 20;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-$try = "\$x = Math::BigInt->new(10); \$x = 2 + \$x;";
-$try .= "'ok' if \$x == 12;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-$try = "\$x = Math::BigInt->new(10); \$x = 2 - \$x;";
-$try .= "'ok' if \$x == -8;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-$try = "\$x = Math::BigInt->new(10); \$x = 20 / \$x;";
-$try .= "'ok' if \$x == 2;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-###############################################################################
-# check badd(4,5) form
-
-$try = "\$x = Math::BigInt::badd(4,5);";
-$try .= "'ok' if \$x == 9;";
-$ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-$try = "\$x = Math::BigInt->badd(4,5);";
-$try .= "'ok' if \$x == 9;";
-$ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-###############################################################################
-# check proper length of internal arrays
-
-$x = Math::BigInt->new(99999); 
-ok ($x,99999);
-ok (scalar @{$x->{value}}, 1);
-$x += 1;
-ok ($x,100000);
-ok (scalar @{$x->{value}}, 2);
-$x -= 1;
-ok ($x,99999);
-ok (scalar @{$x->{value}}, 1);
-
-###############################################################################
-# check numify
-
-my $BASE = int(1e5);
-$x = Math::BigInt->new($BASE-1);     ok ($x->numify(),$BASE-1); 
-$x = Math::BigInt->new(-($BASE-1));  ok ($x->numify(),-($BASE-1)); 
-$x = Math::BigInt->new($BASE);       ok ($x->numify(),$BASE); 
-$x = Math::BigInt->new(-$BASE);      ok ($x->numify(),-$BASE);
-$x = Math::BigInt->new( -($BASE*$BASE*1+$BASE*1+1) ); 
-ok($x->numify(),-($BASE*$BASE*1+$BASE*1+1)); 
-
-###############################################################################
-# test bug in _digits with length($c[-1]) where $c[-1] was "00001" instead of 1
-
-$x = Math::BigInt->new(99998); $x++; $x++; $x++; $x++;
-if ($x > 100000) { ok (1,1) } else { ok ("$x < 100000","$x > 100000"); }
-
-$x = Math::BigInt->new(100003); $x++;
-$y = Math::BigInt->new(1000000);
-if ($x < 1000000) { ok (1,1) } else { ok ("$x > 1000000","$x < 1000000"); }
-
-###############################################################################
-# bug in sub where number with at least 6 trailing zeros after any op failed
-
-$x = Math::BigInt->new(123456); $z = Math::BigInt->new(10000); $z *= 10;
-$x -= $z;
-ok ($z, 100000);
-ok ($x, 23456);
-
-###############################################################################
-# bug with rest "-0" in div, causing further div()s to fail
-
-$x = Math::BigInt->new(-322056000); ($x,$y) = $x->bdiv('-12882240');
-
-ok ($y,'0');   # not '-0'
-is_valid($y);
-
-###############################################################################
-# check undefs: NOT DONE YET
-
-###############################################################################
-# bool
-
-$x = Math::BigInt->new(1); if ($x) { ok (1,1); } else { ok($x,'to be true') }
-$x = Math::BigInt->new(0); if (!$x) { ok (1,1); } else { ok($x,'to be false') }
-
-###############################################################################
-# objectify()
-
-@args = Math::BigInt::objectify(2,4,5);
-ok (scalar @args,3);           # 'Math::BigInt', 4, 5
-ok ($args[0],'Math::BigInt');
-ok ($args[1],4);
-ok ($args[2],5);
-
-@args = Math::BigInt::objectify(0,4,5);
-ok (scalar @args,3);           # 'Math::BigInt', 4, 5
-ok ($args[0],'Math::BigInt');
-ok ($args[1],4);
-ok ($args[2],5);
-
-@args = Math::BigInt::objectify(2,4,5);
-ok (scalar @args,3);           # 'Math::BigInt', 4, 5
-ok ($args[0],'Math::BigInt');
-ok ($args[1],4);
-ok ($args[2],5);
-
-@args = Math::BigInt::objectify(2,4,5,6,7);
-ok (scalar @args,5);           # 'Math::BigInt', 4, 5, 6, 7
-ok ($args[0],'Math::BigInt');
-ok ($args[1],4); ok (ref($args[1]),$args[0]);
-ok ($args[2],5); ok (ref($args[2]),$args[0]);
-ok ($args[3],6); ok (ref($args[3]),'');
-ok ($args[4],7); ok (ref($args[4]),'');
-
-@args = Math::BigInt::objectify(2,'Math::BigInt',4,5,6,7);
-ok (scalar @args,5);           # 'Math::BigInt', 4, 5, 6, 7
-ok ($args[0],'Math::BigInt');
-ok ($args[1],4); ok (ref($args[1]),$args[0]);
-ok ($args[2],5); ok (ref($args[2]),$args[0]);
-ok ($args[3],6); ok (ref($args[3]),'');
-ok ($args[4],7); ok (ref($args[4]),'');
-
-###############################################################################
-# test for flaoting-point input (other tests in bnorm() below)
-
-$z = 1050000000000000;          # may be int on systems with 64bit?
-$x = Math::BigInt->new($z); ok ($x->bsstr(),'105e+13');        # not 1.03e+15?
-$z = 1e+129;                   # definitely a float
-$x = Math::BigInt->new($z); ok ($x->bsstr(),$z);
-
-###############################################################################
-# prime number tests, also test for **= and length()
-# found on: http://www.utm.edu/research/primes/notes/by_year.html
-
-# ((2^148)-1)/17
-$x = Math::BigInt->new(2); $x **= 148; $x++; $x = $x / 17;
-ok ($x,"20988936657440586486151264256610222593863921");
-ok ($x->length(),length "20988936657440586486151264256610222593863921");
-
-# MM7 = 2^127-1
-$x = Math::BigInt->new(2); $x **= 127; $x--;
-ok ($x,"170141183460469231731687303715884105727");
-
-# I am afraid the following is not yet possible due to slowness
-# Also, testing for 2 meg output is a bit hard ;)
-#$x = new Math::BigInt(2); $x **= 6972593; $x--;
-
-# 593573509*2^332162+1 has exactly 100.000 digits
-# takes over 16 mins and still not complete, so can not be done yet ;)
-#$x = Math::BigInt->new(2); $x **= 332162; $x *= "593573509"; $x++;
-#ok ($x->digits(),100000);
-
-###############################################################################
-# inheritance and overriding of _swap
-
-$x = Math::Foo->new(5);
-$x = $x - 8;           # 8 - 5 instead of 5-8
-ok ($x,3);
-ok (ref($x),'Math::Foo');
-
-$x = Math::Foo->new(5);
-$x = 8 - $x;           # 5 - 8 instead of 8 - 5
-ok ($x,-3);
-ok (ref($x),'Math::Foo');
-
-###############################################################################
-# all tests done
-
-# devel test, see whether valid catches errors
-#$x = Math::BigInt->new(0);
-#$x->{sign} = '-';
-#is_valid($x); # nok
-#
-#$x->{sign} = 'e';
-#is_valid($x); # nok
-#
-#$x->{value}->[0] = undef;
-#is_valid($x); # nok
-#
-#$x->{value}->[0] = 1e6;
-#is_valid($x); # nok
-#
-#$x->{value}->[0] = -2;
-#is_valid($x); # nok
-#
-#$x->{sign} = '+';
-#is_valid($x); # ok
-
-###############################################################################
-# Perl 5.005 does not like ok ($x,undef)
-
-sub ok_undef
-  {
-  my $x = shift;
-
-  ok (1,1) and return if !defined $x;
-  ok ($x,'undef');
-  }
-
-###############################################################################
-# sub to check validity of a BigInt internally, to ensure that no op leaves a
-# number object in an invalid state (f.i. "-0")
-
-sub is_valid
-  {
-  my $x = shift;
-
-  my $error = ["",];
-
-  # ok as reference? 
-  is_okay('ref($x)','Math::BigInt',ref($x),$error);
-
-  # has ok sign?
-  is_okay('$x->{sign}',"'+', '-', '-inf', '+inf' or 'NaN'",$x->{sign},$error)
-   if $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
-
-  # is not -0?
-  if (($x->{sign} eq '-') && (@{$x->{value}} == 1) && ($x->{value}->[0] == 0))
-     {
-     is_okay("\$x ne '-0'","0",$x,$error);
-     }
-  # all parts are valid?
-  my $i = 0; my $j = scalar @{$x->{value}}; my $e; my $try;
-  while ($i < $j)
-    {
-    $e = $x->{value}->[$i]; $e = 'undef' unless defined $e;
-    $try = '=~ /^[\+]?[0-9]+\$/; '."($f, $x, $e)";
-    last if $e !~ /^[+]?[0-9]+$/;
-    $try = ' < 0 || >= 1e5; '."($f, $x, $e)";
-    last if $e <0 || $e >= 1e5;
-    # this test is disabled, since new/bnorm and certain ops (like early out
-    # in add/sub) are allowed/expected to leave '00000' in some elements
-    #$try = '=~ /^00+/; '."($f, $x, $e)";
-    #last if $e =~ /^00+/;
-    $i++;
-    }
-  is_okay("\$x->{value}->[$i] $try","not $e",$e,$error)
-   if $i < $j; # trough all?
-  
-  # see whether errors crop up
-  $error->[1] = 'undef' unless defined $error->[1];
-  if ($error->[0] ne "")
-    {
-    ok ($error->[1],$error->[2]);
-    print "# Tried: $error->[0]\n";
-    }
-  else
-    {
-    ok (1,1);
-    }
-  }
-
-sub is_okay
-  {
-  my ($tried,$expected,$try,$error) = @_;
-
-  return if $error->[0] ne ""; # error, no further testing
-
-  @$error = ( $tried, $try, $expected ) if $try ne $expected;
-  }
-
-__END__
-&bnorm
-# binary input
-0babc:NaN
-0b123:NaN
-0b0:0
--0b0:0
--0b1:-1
-0b0001:1
-0b001:1
-0b011:3
-0b101:5
-0b1000000000000000000000000000000:1073741824
-# hex input
--0x0:0
-0xabcdefgh:NaN
-0x1234:4660
-0xabcdef:11259375
--0xABCDEF:-11259375
--0x1234:-4660
-0x12345678:305419896
-# inf input
-+inf:+inf
--inf:-inf
-0inf:NaN
-# normal input
-:NaN
-abc:NaN
-   1 a:NaN
-1bcd2:NaN
-11111b:NaN
-+1z:NaN
--1z:NaN
-0:0
-+0:0
-+00:0
-+000:0
-000000000000000000:0
--0:0
--0000:0
-+1:1
-+01:1
-+001:1
-+00000100000:100000
-123456789:123456789
--1:-1
--01:-1
--001:-1
--123456789:-123456789
--00000100000:-100000
-1_2_3:123
-_123:NaN
-_123_:NaN
-_123_:NaN
-1__23:NaN
-10000000000E-1_0:1
-1E2:100
-1E1:10
-1E0:1
-E1:NaN
-E23:NaN
-1.23E2:123
-1.23E1:NaN
-1.23E-1:NaN
-100E-1:10
-# floating point input
-1.01E2:101
-1010E-1:101
--1010E0:-1010
--1010E1:-10100
--1010E-2:NaN
--1.01E+1:NaN
--1.01E-1:NaN
-&binf
-1:+:+inf
-2:-:-inf
-3:abc:+inf
-&is_inf
-+inf::1
--inf::1
-abc::0
-1::0
-NaN::0
--1::0
-+inf:-:0
-+inf:+:1
--inf:-:1
--inf:+:0
-&blsft
-abc:abc:NaN
-+2:+2:+8
-+1:+32:+4294967296
-+1:+48:+281474976710656
-+8:-2:NaN
-# excercise base 10
-+12345:4:10:123450000
--1234:0:10:-1234
-+1234:0:10:+1234
-+2:2:10:200
-+12:2:10:1200
-+1234:-3:10:NaN
-1234567890123:12:10:1234567890123000000000000
-&brsft
-abc:abc:NaN
-+8:+2:+2
-+4294967296:+32:+1
-+281474976710656:+48:+1
-+2:-2:NaN
-# excercise base 10
--1234:0:10:-1234
-+1234:0:10:+1234
-+200:2:10:2
-+1234:3:10:1
-+1234:2:10:12
-+1234:-3:10:NaN
-310000:4:10:31
-12300000:5:10:123
-1230000000000:10:10:123
-09876123456789067890:12:10:9876123
-1234561234567890123:13:10:123456
-&bsstr
-1e+34:1e+34
-123.456E3:123456e+0
-100:1e+2
-abc:NaN
-&bneg
-abd:NaN
-+0:+0
-+1:-1
--1:+1
-+123456789:-123456789
--123456789:+123456789
-&babs
-abc:NaN
-+0:+0
-+1:+1
--1:+1
-+123456789:+123456789
--123456789:+123456789
-&bcmp
-abc:abc:
-abc:+0:
-+0:abc:
-+0:+0:0
--1:+0:-1
-+0:-1:1
-+1:+0:1
-+0:+1:-1
--1:+1:-1
-+1:-1:1
--1:-1:0
-+1:+1:0
-+123:+123:0
-+123:+12:1
-+12:+123:-1
--123:-123:0
--123:-12:-1
--12:-123:1
-+123:+124:-1
-+124:+123:1
--123:-124:1
--124:-123:-1
-+100:+5:1
--123456789:+987654321:-1
-+123456789:-987654321:1
--987654321:+123456789:-1
-&bacmp
-+0:-0:0
-+0:+1:-1
--1:+1:0
-+1:-1:0
--1:+2:-1
-+2:-1:1
--123456789:+987654321:-1
-+123456789:-987654321:-1
--987654321:+123456789:1
-&binc
-abc:NaN
-+0:+1
-+1:+2
--1:+0
-&bdec
-abc:NaN
-+0:-1
-+1:+0
--1:-2
-&badd
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0
-+1:+0:+1
-+0:+1:+1
-+1:+1:+2
--1:+0:-1
-+0:-1:-1
--1:-1:-2
--1:+1:+0
-+1:-1:+0
-+9:+1:+10
-+99:+1:+100
-+999:+1:+1000
-+9999:+1:+10000
-+99999:+1:+100000
-+999999:+1:+1000000
-+9999999:+1:+10000000
-+99999999:+1:+100000000
-+999999999:+1:+1000000000
-+9999999999:+1:+10000000000
-+99999999999:+1:+100000000000
-+10:-1:+9
-+100:-1:+99
-+1000:-1:+999
-+10000:-1:+9999
-+100000:-1:+99999
-+1000000:-1:+999999
-+10000000:-1:+9999999
-+100000000:-1:+99999999
-+1000000000:-1:+999999999
-+10000000000:-1:+9999999999
-+123456789:+987654321:+1111111110
--123456789:+987654321:+864197532
--123456789:-987654321:-1111111110
-+123456789:-987654321:-864197532
-&bsub
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0
-+1:+0:+1
-+0:+1:-1
-+1:+1:+0
--1:+0:-1
-+0:-1:+1
--1:-1:+0
--1:+1:-2
-+1:-1:+2
-+9:+1:+8
-+99:+1:+98
-+999:+1:+998
-+9999:+1:+9998
-+99999:+1:+99998
-+999999:+1:+999998
-+9999999:+1:+9999998
-+99999999:+1:+99999998
-+999999999:+1:+999999998
-+9999999999:+1:+9999999998
-+99999999999:+1:+99999999998
-+10:-1:+11
-+100:-1:+101
-+1000:-1:+1001
-+10000:-1:+10001
-+100000:-1:+100001
-+1000000:-1:+1000001
-+10000000:-1:+10000001
-+100000000:-1:+100000001
-+1000000000:-1:+1000000001
-+10000000000:-1:+10000000001
-+123456789:+987654321:-864197532
--123456789:+987654321:-1111111110
--123456789:-987654321:+864197532
-+123456789:-987654321:+1111111110
-&bmul
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0
-+0:+1:+0
-+1:+0:+0
-+0:-1:+0
--1:+0:+0
-+123456789123456789:+0:+0
-+0:+123456789123456789:+0
--1:-1:+1
--1:+1:-1
-+1:-1:-1
-+1:+1:+1
-+2:+3:+6
--2:+3:-6
-+2:-3:-6
--2:-3:+6
-+111:+111:+12321
-+10101:+10101:+102030201
-+1001001:+1001001:+1002003002001
-+100010001:+100010001:+10002000300020001
-+10000100001:+10000100001:+100002000030000200001
-+11111111111:+9:+99999999999
-+22222222222:+9:+199999999998
-+33333333333:+9:+299999999997
-+44444444444:+9:+399999999996
-+55555555555:+9:+499999999995
-+66666666666:+9:+599999999994
-+77777777777:+9:+699999999993
-+88888888888:+9:+799999999992
-+99999999999:+9:+899999999991
-+25:+25:+625
-+12345:+12345:+152399025
-+99999:+11111:+1111088889
-&bdiv
-abc:abc:NaN
-abc:+1:abc:NaN
-+1:abc:NaN
-+0:+0:NaN
-+0:+1:+0
-+1:+0:NaN
-+0:-1:+0
--1:+0:NaN
-+1:+1:+1
--1:-1:+1
-+1:-1:-1
--1:+1:-1
-+1:+2:+0
-+2:+1:+2
-+1:+26:+0
-+1000000000:+9:+111111111
-+2000000000:+9:+222222222
-+3000000000:+9:+333333333
-+4000000000:+9:+444444444
-+5000000000:+9:+555555555
-+6000000000:+9:+666666666
-+7000000000:+9:+777777777
-+8000000000:+9:+888888888
-+9000000000:+9:+1000000000
-+35500000:+113:+314159
-+71000000:+226:+314159
-+106500000:+339:+314159
-+1000000000:+3:+333333333
-+10:+5:+2
-+100:+4:+25
-+1000:+8:+125
-+10000:+16:+625
-+999999999999:+9:+111111111111
-+999999999999:+99:+10101010101
-+999999999999:+999:+1001001001
-+999999999999:+9999:+100010001
-+999999999999999:+99999:+10000100001
-+1111088889:+99999:+11111
--5:-3:1
-4:3:1
-1:3:0
--2:-3:0
--2:3:-1
-1:-3:-1
--5:3:-2
-4:-3:-2
-&bmod
-abc:abc:NaN
-abc:+1:abc:NaN
-+1:abc:NaN
-+0:+0:NaN
-+0:+1:+0
-+1:+0:NaN
-+0:-1:+0
--1:+0:NaN
-+1:+1:+0
--1:-1:+0
-+1:-1:+0
--1:+1:+0
-+1:+2:+1
-+2:+1:+0
-+1000000000:+9:+1
-+2000000000:+9:+2
-+3000000000:+9:+3
-+4000000000:+9:+4
-+5000000000:+9:+5
-+6000000000:+9:+6
-+7000000000:+9:+7
-+8000000000:+9:+8
-+9000000000:+9:+0
-+35500000:+113:+33
-+71000000:+226:+66
-+106500000:+339:+99
-+1000000000:+3:+1
-+10:+5:+0
-+100:+4:+0
-+1000:+8:+0
-+10000:+16:+0
-+999999999999:+9:+0
-+999999999999:+99:+0
-+999999999999:+999:+0
-+999999999999:+9999:+0
-+999999999999999:+99999:+0
--9:+5:+1
-+9:-5:-1
--9:-5:-4
--5:3:1
--2:3:1
-4:3:1
-1:3:1
--5:-3:-2
--2:-3:-2
-4:-3:-2
-1:-3:-2
-&bgcd
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0
-+0:+1:+1
-+1:+0:+1
-+1:+1:+1
-+2:+3:+1
-+3:+2:+1
--3:+2:+1
-+100:+625:+25
-+4096:+81:+1
-+1034:+804:+2
-+27:+90:+56:+1
-+27:+90:+54:+9
-&blcm
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:NaN
-+1:+0:+0
-+0:+1:+0
-+27:+90:+270
-+1034:+804:+415668
-&band
-abc:abc:NaN
-abc:0:NaN
-0:abc:NaN
-+8:+2:+0
-+281474976710656:+0:+0
-+281474976710656:+1:+0
-+281474976710656:+281474976710656:+281474976710656
-&bior
-abc:abc:NaN
-abc:0:NaN
-0:abc:NaN
-+8:+2:+10
-+281474976710656:+0:+281474976710656
-+281474976710656:+1:+281474976710657
-+281474976710656:+281474976710656:+281474976710656
-&bxor
-abc:abc:NaN
-abc:0:NaN
-0:abc:NaN
-+8:+2:+10
-+281474976710656:+0:+281474976710656
-+281474976710656:+1:+281474976710657
-+281474976710656:+281474976710656:+0
-&bnot
-abc:NaN
-+0:-1
-+8:-9
-+281474976710656:-281474976710657
-&digit
-0:0:0
-12:0:2
-12:1:1
-123:0:3
-123:1:2
-123:2:1
-123:-1:1
-123:-2:2
-123:-3:3
-123456:0:6
-123456:1:5
-123456:2:4
-123456:3:3
-123456:4:2
-123456:5:1
-123456:-1:1
-123456:-2:2
-123456:-3:3
-100000:-3:0
-100000:0:0
-100000:1:0
-&mantissa
-abc:NaN
-1e4:1
-2e0:2
-123:123
--1:-1
--2:-2
-&exponent
-abc:NaN
-1e4:4
-2e0:0
-123:0
--1:0
--2:0
-0:1
-&parts
-abc:NaN,NaN
-1e4:1,4
-2e0:2,0
-123:123,0
--1:-1,0
--2:-2,0
-0:0,1
-&bpow
-0:0:1
-0:1:0
-0:2:0
-0:-1:NaN
-0:-2:NaN
-1:0:1
-1:1:1
-1:2:1
-1:3:1
-1:-1:1
-1:-2:1
-1:-3:1
-2:0:1
-2:1:2
-2:2:4
-2:3:8
-3:3:27
-2:-1:NaN
--2:-1:NaN
-2:-2:NaN
--2:-2:NaN
-# 1 ** -x => 1 / (1 ** x)
--1:0:1
--2:0:1
--1:1:-1
--1:2:1
--1:3:-1
--1:4:1
--1:5:-1
--1:-1:-1
--1:-2:1
--1:-3:-1
--1:-4:1
-10:2:100
-10:3:1000
-10:4:10000
-10:5:100000
-10:6:1000000
-10:7:10000000
-10:8:100000000
-10:9:1000000000
-10:20:100000000000000000000
-123456:2:15241383936
-&length
-100:3
-10:2
-1:1
-0:1
-12345:5
-10000000000000000:17
--123:3
-&bsqrt
-144:12
-16:4
-4:2
-2:1
-12:3
-256:16
-100000000:10000
-4000000000000:2000000
-1:1
-0:0
--2:NaN
-Nan:NaN
-&bround
-$round_mode('trunc')
-1234:0:1234
-1234:2:1200
-123456:4:123400
-123456:5:123450
-123456:6:123456
-+10123456789:5:+10123000000
--10123456789:5:-10123000000
-+10123456789:9:+10123456700
--10123456789:9:-10123456700
-+101234500:6:+101234000
--101234500:6:-101234000
-#+101234500:-4:+101234000
-#-101234500:-4:-101234000
-$round_mode('zero')
-+20123456789:5:+20123000000
--20123456789:5:-20123000000
-+20123456789:9:+20123456800
--20123456789:9:-20123456800
-+201234500:6:+201234000
--201234500:6:-201234000
-#+201234500:-4:+201234000
-#-201234500:-4:-201234000
-+12345000:4:12340000
--12345000:4:-12340000
-$round_mode('+inf')
-+30123456789:5:+30123000000
--30123456789:5:-30123000000
-+30123456789:9:+30123456800
--30123456789:9:-30123456800
-+301234500:6:+301235000
--301234500:6:-301234000
-#+301234500:-4:+301235000
-#-301234500:-4:-301234000
-+12345000:4:12350000
--12345000:4:-12340000
-$round_mode('-inf')
-+40123456789:5:+40123000000
--40123456789:5:-40123000000
-+40123456789:9:+40123456800
--40123456789:9:-40123456800
-+401234500:6:+401234000
-+401234500:6:+401234000
-#-401234500:-4:-401235000
-#-401234500:-4:-401235000
-+12345000:4:12340000
--12345000:4:-12350000
-$round_mode('odd')
-+50123456789:5:+50123000000
--50123456789:5:-50123000000
-+50123456789:9:+50123456800
--50123456789:9:-50123456800
-+501234500:6:+501235000
--501234500:6:-501235000
-#+501234500:-4:+501235000
-#-501234500:-4:-501235000
-+12345000:4:12350000
--12345000:4:-12350000
-$round_mode('even')
-+60123456789:5:+60123000000
--60123456789:5:-60123000000
-+60123456789:9:+60123456800
--60123456789:9:-60123456800
-+601234500:6:+601234000
--601234500:6:-601234000
-#+601234500:-4:+601234000
-#-601234500:-4:-601234000
-#-601234500:-9:0
-#-501234500:-9:0
-#-601234500:-8:0
-#-501234500:-8:0
-+1234567:7:1234567
-+1234567:6:1234570
-+12345000:4:12340000
--12345000:4:-12340000
-&is_odd
-abc:0
-0:0
-1:1
-3:1
--1:1
--3:1
-10000001:1
-10000002:0
-2:0
-&is_even
-abc:0
-0:1
-1:0
-3:0
--1:0
--3:0
-10000001:0
-10000002:1
-2:1
-&is_zero
-0:1
-NaNzero:0
-123:0
--1:0
-1:0
-&_set
-2:-1:-1
--2:1:1
-NaN:2:2
-2:abc:NaN
-&is_one
-0:0
-1:1
-2:0
--1:0
--2:0
-# floor and ceil tests are pretty pointless in integer space...but play safe
-&bfloor
-0:0
--1:-1
--2:-2
-2:2
-3:3
-abc:NaN
-&bceil
-0:0
--1:-1
--2:-2
-2:2
-3:3
-abc:NaN

diff --git a/t/lib/carp.t b/t/lib/carp.t
deleted file mode 100644 (file)
index a318c19..0000000
--- a/t/lib/carp.t
+++ /dev/null
@@ -1,53 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-}
-
-use Carp qw(carp cluck croak confess);
-
-print "1..7\n";
-
-print "ok 1\n";
-
-$SIG{__WARN__} = sub {
-    print "ok $1\n"
-       if $_[0] =~ m!ok (\d+)$! };
-
-carp  "ok 2\n";
-       
-$SIG{__WARN__} = sub {
-    print "ok $1\n"
-       if $_[0] =~ m!(\d+) at .+\b(?i:carp\.t) line \d+$! };
-
-carp 3;
-
-sub sub_4 {
-
-$SIG{__WARN__} = sub {
-    print "ok $1\n"
-       if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at .+\b(?i:carp\.t) line \d+$! };
-
-cluck 4;
-
-}
-
-sub_4;
-
-$SIG{__DIE__} = sub {
-    print "ok $1\n"
-       if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at .+\b(?i:carp\.t) line \d+$! };
-
-eval { croak 5 };
-
-sub sub_6 {
-    $SIG{__DIE__} = sub {
-       print "ok $1\n"
-           if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at .+\b(?i:carp\.t) line \d+\n\tmain::sub_6\(\) called at .+\b(?i:carp\.t) line \d+$! };
-
-    eval { confess 6 };
-}
-
-sub_6;
-
-print "ok 7\n";
-

diff --git a/t/lib/cgi-esc.t b/t/lib/cgi-esc.t
deleted file mode 100644 (file)
index f0471cf..0000000
--- a/t/lib/cgi-esc.t
+++ /dev/null
@@ -1,56 +0,0 @@
-#!/usr/local/bin/perl -w
-
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
-# Test ability to escape() and unescape() punctuation characters
-# except for qw(- . _).
-######################### We start with some black magic to print on failure.
-use lib '../blib/lib','../blib/arch';
-
-BEGIN {$| = 1; print "1..59\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Config;
-use CGI::Util qw(escape unescape);
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# util
-sub test {
-    local($^W) = 0;
-    my($num, $true,$msg) = @_;
-    print($true ? "ok $num\n" : "not ok $num $msg\n");
-}
-
-# ASCII order, ASCII codepoints, ASCII repertoire
-
-my %punct = (
-    ' ' => '20',  '!' => '21',  '"' => '22',  '#' =>  '23', 
-    '$' => '24',  '%' => '25',  '&' => '26',  '\'' => '27', 
-    '(' => '28',  ')' => '29',  '*' => '2A',  '+' =>  '2B', 
-    ',' => '2C',                              '/' =>  '2F',  # '-' => '2D',  '.' => '2E' 
-    ':' => '3A',  ';' => '3B',  '<' => '3C',  '=' =>  '3D', 
-    '>' => '3E',  '?' => '3F',  '[' => '5B',  '\\' => '5C', 
-    ']' => '5D',  '^' => '5E',                '`' =>  '60',  # '_' => '5F',
-    '{' => '7B',  '|' => '7C',  '}' => '7D',  '~' =>  '7E', 
-         );
-
-# The sort order may not be ASCII on EBCDIC machines:
-
-my $i = 1;
-
-foreach(sort(keys(%punct))) { 
-    $i++;
-    my $escape = "AbC\%$punct{$_}dEF";
-    my $cgi_escape = escape("AbC$_" . "dEF");
-    test($i, $escape eq $cgi_escape , "# $escape ne $cgi_escape");
-    $i++;
-    my $unescape = "AbC$_" . "dEF";
-    my $cgi_unescape = unescape("AbC\%$punct{$_}dEF");
-    test($i, $unescape eq $cgi_unescape , "# $unescape ne $cgi_unescape");
-}
-

diff --git a/t/lib/cgi-form.t b/t/lib/cgi-form.t
deleted file mode 100755 (executable)
index 2922903..0000000
--- a/t/lib/cgi-form.t
+++ /dev/null
@@ -1,90 +0,0 @@
-#!/usr/local/bin/perl -w
-
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
-# Test ability to retrieve HTTP request info
-######################### We start with some black magic to print on failure.
-use lib '../blib/lib','../blib/arch';
-
-BEGIN {$| = 1; print "1..17\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use CGI (':standard','-no_debug');
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# util
-sub test {
-    local($^W) = 0;
-    my($num, $true,$msg) = @_;
-    print($true ? "ok $num\n" : "not ok $num $msg\n");
-}
-
-my $CRLF = "\015\012";
-if ($^O eq 'VMS') { 
-    $CRLF = "\n";  # via web server carriage is inserted automatically
-}
-if (ord("\t") != 9) { # EBCDIC?
-    $CRLF = "\r\n";
-}
-
-
-# Set up a CGI environment
-$ENV{REQUEST_METHOD}='GET';
-$ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
-$ENV{PATH_INFO}     ='/somewhere/else';
-$ENV{PATH_TRANSLATED} ='/usr/local/somewhere/else';
-$ENV{SCRIPT_NAME}   ='/cgi-bin/foo.cgi';
-$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
-$ENV{SERVER_PORT} = 8080;
-$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
-
-test(2,start_form(-action=>'foobar',-method=>'get') eq 
-     qq(<form method="get" action="foobar" enctype="application/x-www-form-urlencoded">\n),
-     "start_form()");
-
-test(3,submit() eq qq(<input type="submit" name=".submit" />),"submit()");
-test(4,submit(-name=>'foo',-value=>'bar') eq qq(<input type="submit" name="foo" value="bar" />),"submit(-name,-value)");
-test(5,submit({-name=>'foo',-value=>'bar'}) eq qq(<input type="submit" name="foo" value="bar" />),"submit({-name,-value})");
-test(6,textfield(-name=>'weather') eq qq(<input type="text" name="weather" value="dull" />),"textfield({-name})");
-test(7,textfield(-name=>'weather',-value=>'nice') eq qq(<input type="text" name="weather" value="dull" />),"textfield({-name,-value})");
-test(8,textfield(-name=>'weather',-value=>'nice',-override=>1) eq qq(<input type="text" name="weather" value="nice" />),
-     "textfield({-name,-value,-override})");
-test(9,checkbox(-name=>'weather',-value=>'nice') eq qq(<input type="checkbox" name="weather" value="nice" />weather),
-     "checkbox()");
-test(10,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast') eq 
-     qq(<input type="checkbox" name="weather" value="nice" />forecast),
-     "checkbox()");
-test(11,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast',-checked=>1,-override=>1) eq 
-     qq(<input type="checkbox" name="weather" value="nice" checked />forecast),
-     "checkbox()");
-test(12,checkbox(-name=>'weather',-value=>'dull',-label=>'forecast') eq 
-     qq(<input type="checkbox" name="weather" value="dull" checked />forecast),
-     "checkbox()");
-
-test(13,radio_group(-name=>'game') eq 
-     qq(<input type="radio" name="game" value="chess" checked />chess <input type="radio" name="game" value="checkers" />checkers),
-     'radio_group()');
-test(14,radio_group(-name=>'game',-labels=>{'chess'=>'ping pong'}) eq 
-     qq(<input type="radio" name="game" value="chess" checked />ping pong <input type="radio" name="game" value="checkers" />checkers),
-     'radio_group()');
-
-test(15, checkbox_group(-name=>'game',-Values=>[qw/checkers chess cribbage/]) eq 
-     qq(<input type="checkbox" name="game" value="checkers" checked />checkers <input type="checkbox" name="game" value="chess" checked />chess <input type="checkbox" name="game" value="cribbage" />cribbage),
-     'checkbox_group()');
-
-test(16, checkbox_group(-name=>'game',-values=>[qw/checkers chess cribbage/],-defaults=>['cribbage'],-override=>1) eq 
-     qq(<input type="checkbox" name="game" value="checkers" />checkers <input type="checkbox" name="game" value="chess" />chess <input type="checkbox" name="game" value="cribbage" checked />cribbage),
-     'checkbox_group()');
-test(17, popup_menu(-name=>'game',-values=>[qw/checkers chess cribbage/],-default=>'cribbage',-override=>1) eq <<END,'checkbox_group()');
-<select name="game">
-<option  value="checkers">checkers</option>
-<option  value="chess">chess</option>
-<option selected value="cribbage">cribbage</option>
-</select>
-END
-

diff --git a/t/lib/cgi-function.t b/t/lib/cgi-function.t
deleted file mode 100755 (executable)
index b670e33..0000000
--- a/t/lib/cgi-function.t
+++ /dev/null
@@ -1,111 +0,0 @@
-#!/usr/local/bin/perl -w
-
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
-# Test ability to retrieve HTTP request info
-######################### We start with some black magic to print on failure.
-use lib '../blib/lib','../blib/arch';
-
-BEGIN {$| = 1; print "1..27\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Config;
-use CGI (':standard','keywords');
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# util
-sub test {
-    local($^W) = 0;
-    my($num, $true,$msg) = @_;
-    print($true ? "ok $num\n" : "not ok $num $msg\n");
-}
-
-my $CRLF = "\015\012";
-
-# A peculiarity of sending "\n" through MBX|Socket|web-server on VMS 
-# is that a CR character gets inserted automatically in the web server 
-# case but not internal to perl's double quoted strings "\n".  This
-# test would need to be modified to use the "\015\012" on VMS if it
-# were actually run through a web server.
-# Thanks to Peter Prymmer for this
-
-if ($^O eq 'VMS') { $CRLF = "\n"; }
-
-# Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII
-# translation hence CRLF is used as \r\n within CGI.pm on such machines.
-
-if (ord("\t") != 9) { $CRLF = "\r\n"; }
-
-# Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII
-# translation hence CRLF is used as \r\n within CGI.pm on such machines.
-
-if (ord("\t") != 9) { $CRLF = "\r\n"; }
- 
-# Set up a CGI environment
-$ENV{REQUEST_METHOD}='GET';
-$ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
-$ENV{PATH_INFO}     ='/somewhere/else';
-$ENV{PATH_TRANSLATED} ='/usr/local/somewhere/else';
-$ENV{SCRIPT_NAME}   ='/cgi-bin/foo.cgi';
-$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
-$ENV{SERVER_PORT} = 8080;
-$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
-$ENV{HTTP_LOVE} = 'true';
-
-test(2,request_method() eq 'GET',"CGI::request_method()");
-test(3,query_string() eq 'game=chess;game=checkers;weather=dull',"CGI::query_string()");
-test(4,param() == 2,"CGI::param()");
-test(5,join(' ',sort {$a cmp $b} param()) eq 'game weather',"CGI::param()");
-test(6,param('game') eq 'chess',"CGI::param()");
-test(7,param('weather') eq 'dull',"CGI::param()");
-test(8,join(' ',param('game')) eq 'chess checkers',"CGI::param()");
-test(9,param(-name=>'foo',-value=>'bar'),'CGI::param() put');
-test(10,param(-name=>'foo') eq 'bar','CGI::param() get');
-test(11,query_string() eq 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux");
-test(12,http('love') eq 'true',"CGI::http()");
-test(13,script_name() eq '/cgi-bin/foo.cgi',"CGI::script_name()");
-test(14,url() eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
-test(15,self_url() eq 
-     'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
-     "CGI::url()");
-test(16,url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
-test(17,url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
-test(18,url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
-test(19,url(-relative=>1,-path=>1,-query=>1) eq 
-     'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
-     'CGI::url(-relative=>1,-path=>1,-query=>1)');
-Delete('foo');
-test(20,!param('foo'),'CGI::delete()');
-
-CGI::_reset_globals();
-$ENV{QUERY_STRING}='mary+had+a+little+lamb';
-test(21,join(' ',keywords()) eq 'mary had a little lamb','CGI::keywords');
-test(22,join(' ',param('keywords')) eq 'mary had a little lamb','CGI::keywords');
-
-CGI::_reset_globals;
-if ($Config{d_fork}) {
-  $test_string = 'game=soccer&game=baseball&weather=nice';
-  $ENV{REQUEST_METHOD}='POST';
-  $ENV{CONTENT_LENGTH}=length($test_string);
-  $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
-  if (open(CHILD,"|-")) {  # cparent
-    print CHILD $test_string;
-    close CHILD;
-    exit 0;
-  }
-  # at this point, we're in a new (child) process
-  test(23,param('weather') eq 'nice',"CGI::param() from POST");
-  test(24,(url_param('big_balls') eq 'basketball'),"CGI::url_param()");
-} else {
-  print "ok 23 # Skip\n";
-  print "ok 24 # Skip\n";
-}
-test(25,redirect('http://somewhere.else') eq "Status: 302 Moved${CRLF}location: http://somewhere.else${CRLF}${CRLF}","CGI::redirect() 1");
-my $h = redirect(-Location=>'http://somewhere.else',-Type=>'text/html');
-test(26,$h eq "Status: 302 Moved${CRLF}location: http://somewhere.else${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
-test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html') eq "Status: 302 Moved${CRLF}location: http://somewhere.else/bin/foo&bar${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");

diff --git a/t/lib/cgi-html.t b/t/lib/cgi-html.t
deleted file mode 100755 (executable)
index 93e5dac..0000000
--- a/t/lib/cgi-html.t
+++ /dev/null
@@ -1,95 +0,0 @@
-#!/usr/local/bin/perl -w
-
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
-# Test ability to retrieve HTTP request info
-######################### We start with some black magic to print on failure.
-use lib '../blib/lib','../blib/arch';
-
-BEGIN {$| = 1; print "1..24\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use CGI (':standard','-no_debug','*h3','start_table');
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-my $CRLF = "\015\012";
-if ($^O eq 'VMS') { 
-  $CRLF = "\n";  # via web server carriage is inserted automatically
-}
-if (ord("\t") != 9) { # EBCDIC?
-  $CRLF = "\r\n";
-}
-
-
-# util
-sub test {
-    local($^W) = 0;
-    my($num, $true,$msg) = @_;
-    print($true ? "ok $num\n" : "not ok $num $msg\n");
-}
-
-# all the automatic tags
-test(2,h1() eq '<h1 />',"single tag");
-test(3,h1('fred') eq '<h1>fred</h1>',"open/close tag");
-test(4,h1('fred','agnes','maura') eq '<h1>fred agnes maura</h1>',"open/close tag multiple");
-test(5,h1({-align=>'CENTER'},'fred') eq '<h1 align="CENTER">fred</h1>',"open/close tag with attribute");
-test(6,h1({-align=>undef},'fred') eq '<h1 align>fred</h1>',"open/close tag with orphan attribute");
-test(7,h1({-align=>'CENTER'},['fred','agnes']) eq 
-     '<h1 align="CENTER">fred</h1> <h1 align="CENTER">agnes</h1>',
-     "distributive tag with attribute");
-{
-    local($") = '-'; 
-    test(8,h1('fred','agnes','maura') eq '<h1>fred-agnes-maura</h1>',"open/close tag \$\" interpolation");
-}
-test(9,header() eq "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","header()");
-test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${CRLF}${CRLF}","header()");
-test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${CRLF}Content-Type: image/gif${CRLF}${CRLF}","header()");
-test(12,header(-nph=>1) =~ m!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,"header()");
-test(13,start_html() ."\n" eq <<END,"start_html()");
-<?xml version="1.0" encoding="utf-8"?>
-<!DOCTYPE html
-       PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN"
-       "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
-</head><body>
-END
-    ;
-test(14,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR") ."\n" eq <<END,"start_html()");
-<!DOCTYPE html
-       PUBLIC "-//IETF//DTD HTML 3.2//FR">
-<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
-</head><body>
-END
-    ;
-test(15,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
-<?xml version="1.0" encoding="utf-8"?>
-<!DOCTYPE html
-       PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN"
-       "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>The world of foo</title>
-</head><body>
-END
-    ;
-test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 'fred=chocolate&chip; path=/',"cookie()");
-my $h = header(-Cookie=>$cookie);
-test(17,$h =~ m!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Date:.*${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s, 
-  "header(-cookie)");
-test(18,start_h3 eq '<h3>');
-test(19,end_h3 eq '</h3>');
-test(20,start_table({-border=>undef}) eq '<table border>');
-test(21,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; &#139;right&#155;</h1>');
-charset('utf-8');
-if (ord("\t") == 9) {
-test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; \8bright\9b</h1>');
-}
-else {
-test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; »rightº</h1>');
-}
-test(23,i(p('hello there')) eq '<i><p>hello there</p></i>');
-my $q = new CGI;
-test(24,$q->h1('hi') eq '<h1>hi</h1>');

diff --git a/t/lib/cgi-pretty.t b/t/lib/cgi-pretty.t
deleted file mode 100755 (executable)
index 14f6447..0000000
--- a/t/lib/cgi-pretty.t
+++ /dev/null
@@ -1,41 +0,0 @@
-#!/usr/local/bin/perl -w
-
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
-# Test ability to retrieve HTTP request info
-######################### We start with some black magic to print on failure.
-use lib '../blib/lib','../blib/arch';
-
-BEGIN {$| = 1; print "1..5\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use CGI::Pretty (':standard','-no_debug','*h3','start_table');
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# util
-sub test {
-    local($^W) = 0;
-    my($num, $true,$msg) = @_;
-    print($true ? "ok $num\n" : "not ok $num $msg\n");
-}
-
-# all the automatic tags
-test(2,h1() eq '<h1>',"single tag");
-test(3,ol(li('fred'),li('ethel')) eq "<ol>\n\t<li>\n\t\tfred\n\t</li>\n\t <li>\n\t\tethel\n\t</li>\n</ol>\n","basic indentation");
-test(4,p('hi',pre('there'),'frog') eq 
-'<p>
-       hi <pre>there</pre>
-        frog
-</p>
-',"<pre> tags");
-test(5,p('hi',a({-href=>'frog'},'there'),'frog') eq 
-'<p>
-       hi <a href="frog">there</a>
-        frog
-</p>
-',"as-is");

diff --git a/t/lib/cgi-request.t b/t/lib/cgi-request.t
deleted file mode 100755 (executable)
index fde3fd0..0000000
--- a/t/lib/cgi-request.t
+++ /dev/null
@@ -1,103 +0,0 @@
-#!/usr/local/bin/perl -w
-
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
-# Test ability to retrieve HTTP request info
-######################### We start with some black magic to print on failure.
-use lib '../blib/lib','../blib/arch';
-
-BEGIN {$| = 1; print "1..33\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use CGI ();
-use Config;
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# util
-sub test {
-    local($^W) = 0;
-    my($num, $true,$msg) = @_;
-    print($true ? "ok $num\n" : "not ok $num $msg\n");
-}
-
-# Set up a CGI environment
-$ENV{REQUEST_METHOD}  = 'GET';
-$ENV{QUERY_STRING}    = 'game=chess&game=checkers&weather=dull';
-$ENV{PATH_INFO}       = '/somewhere/else';
-$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
-$ENV{SCRIPT_NAME}     = '/cgi-bin/foo.cgi';
-$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
-$ENV{SERVER_PORT}     = 8080;
-$ENV{SERVER_NAME}     = 'the.good.ship.lollypop.com';
-$ENV{REQUEST_URI}     = "$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?$ENV{QUERY_STRING}";
-$ENV{HTTP_LOVE}       = 'true';
-
-$q = new CGI;
-test(2,$q,"CGI::new()");
-test(3,$q->request_method eq 'GET',"CGI::request_method()");
-test(4,$q->query_string eq 'game=chess;game=checkers;weather=dull',"CGI::query_string()");
-test(5,$q->param() == 2,"CGI::param()");
-test(6,join(' ',sort $q->param()) eq 'game weather',"CGI::param()");
-test(7,$q->param('game') eq 'chess',"CGI::param()");
-test(8,$q->param('weather') eq 'dull',"CGI::param()");
-test(9,join(' ',$q->param('game')) eq 'chess checkers',"CGI::param()");
-test(10,$q->param(-name=>'foo',-value=>'bar'),'CGI::param() put');
-test(11,$q->param(-name=>'foo') eq 'bar','CGI::param() get');
-test(12,$q->query_string eq 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux");
-test(13,$q->http('love') eq 'true',"CGI::http()");
-test(14,$q->script_name eq '/cgi-bin/foo.cgi',"CGI::script_name()");
-test(15,$q->url eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
-test(16,$q->self_url eq 
-     'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
-     "CGI::url()");
-test(17,$q->url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
-test(18,$q->url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
-test(19,$q->url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
-test(20,$q->url(-relative=>1,-path=>1,-query=>1) eq 
-     'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
-     'CGI::url(-relative=>1,-path=>1,-query=>1)');
-$q->delete('foo');
-test(21,!$q->param('foo'),'CGI::delete()');
-
-$q->_reset_globals;
-$ENV{QUERY_STRING}='mary+had+a+little+lamb';
-test(22,$q=new CGI,"CGI::new() redux");
-test(23,join(' ',$q->keywords) eq 'mary had a little lamb','CGI::keywords');
-test(24,join(' ',$q->param('keywords')) eq 'mary had a little lamb','CGI::keywords');
-test(25,$q=new CGI('foo=bar&foo=baz'),"CGI::new() redux");
-test(26,$q->param('foo') eq 'bar','CGI::param() redux');
-test(27,$q=new CGI({'foo'=>'bar','bar'=>'froz'}),"CGI::new() redux 2");
-test(28,$q->param('bar') eq 'froz',"CGI::param() redux 2");
-
-# test tied interface
-my $p = $q->Vars;
-test(29,$p->{bar} eq 'froz',"tied interface fetch");
-$p->{bar} = join("\0",qw(foo bar baz));
-test(30,join(' ',$q->param('bar')) eq 'foo bar baz','tied interface store');
-
-# test posting
-$q->_reset_globals;
-if ($Config{d_fork}) {
-  $test_string = 'game=soccer&game=baseball&weather=nice';
-  $ENV{REQUEST_METHOD}='POST';
-  $ENV{CONTENT_LENGTH}=length($test_string);
-  $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
-  if (open(CHILD,"|-")) {  # cparent
-    print CHILD $test_string;
-    close CHILD;
-    exit 0;
-  }
-  # at this point, we're in a new (child) process
-  test(31,$q=new CGI,"CGI::new() from POST");
-  test(32,$q->param('weather') eq 'nice',"CGI::param() from POST");
-  test(33,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
-} else {
-  print "ok 31 # Skip\n";
-  print "ok 32 # Skip\n";
-  print "ok 33 # Skip\n";
-}

diff --git a/t/lib/charnames.t b/t/lib/charnames.t
deleted file mode 100644 (file)
index 124dad0..0000000
--- a/t/lib/charnames.t
+++ /dev/null
@@ -1,131 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-    }
-}
-
-$| = 1;
-print "1..16\n";
-
-use charnames ':full';
-
-print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here\041?";
-print "ok 1\n";
-
-{
-  use bytes;                   # TEST -utf8 can switch utf8 on
-
-  print "# \$res=$res \$\@='$@'\nnot "
-    if $res = eval <<'EOE'
-use charnames ":full";
-"Here: \N{CYRILLIC SMALL LETTER BE}!";
-1
-EOE
-      or $@ !~ /above 0xFF/;
-  print "ok 2\n";
-  # print "# \$res=$res \$\@='$@'\n";
-
-  print "# \$res=$res \$\@='$@'\nnot "
-    if $res = eval <<'EOE'
-use charnames 'cyrillic';
-"Here: \N{Be}!";
-1
-EOE
-      or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/;
-  print "ok 3\n";
-}
-
-# If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt
-if (ord('A') == 65) { # as on ASCII or UTF-8 machines
-    $encoded_be = "\320\261";
-    $encoded_alpha = "\316\261";
-    $encoded_bet = "\327\221";
-    $encoded_deseng = "\360\220\221\215";
-}
-else { # EBCDIC where UTF-EBCDIC may be used (this may be 1047 specific since
-       # UTF-EBCDIC is codepage specific)
-    $encoded_be = "\270\102\130";
-    $encoded_alpha = "\264\130";
-    $encoded_bet = "\270\125\130";
-    $encoded_deseng = "\336\102\103\124";
-}
-
-sub to_bytes {
-    pack"a*", shift;
-}
-
-{
-  use charnames ':full';
-
-  print "not " unless to_bytes("\N{CYRILLIC SMALL LETTER BE}") eq $encoded_be;
-  print "ok 4\n";
-
-  use charnames qw(cyrillic greek :short);
-
-  print "not " unless to_bytes("\N{be},\N{alpha},\N{hebrew:bet}")
-    eq "$encoded_be,$encoded_alpha,$encoded_bet";
-  print "ok 5\n";
-}
-
-{
-    use charnames ':full';
-    print "not " unless "\x{263a}" eq "\N{WHITE SMILING FACE}";
-    print "ok 6\n";
-    print "not " unless length("\x{263a}") == 1;
-    print "ok 7\n";
-    print "not " unless length("\N{WHITE SMILING FACE}") == 1;
-    print "ok 8\n";
-    print "not " unless sprintf("%vx", "\x{263a}") eq "263a";
-    print "ok 9\n";
-    print "not " unless sprintf("%vx", "\N{WHITE SMILING FACE}") eq "263a";
-    print "ok 10\n";
-    print "not " unless sprintf("%vx", "\xFF\N{WHITE SMILING FACE}") eq "ff.263a";
-    print "ok 11\n";
-    print "not " unless sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}") eq "ff.263a";
-    print "ok 12\n";
-}
-
-{
-   use charnames qw(:full);
-   use utf8;
-   
-    my $x = "\x{221b}";
-    my $named = "\N{CUBE ROOT}";
-
-    print "not " unless ord($x) == ord($named);
-    print "ok 13\n";
-}
-
-{
-   use charnames qw(:full);
-   use utf8;
-   print "not " unless "\x{100}\N{CENT SIGN}" eq "\x{100}"."\N{CENT SIGN}";
-   print "ok 14\n";
-}
-
-{
-  use charnames ':full';
-
-  print "not "
-      unless to_bytes("\N{DESERET SMALL LETTER ENG}") eq $encoded_deseng;
-  print "ok 15\n";
-}
-
-{
-  # 20001114.001       
-
-  no utf8; # so that the naked 8-bit character won't gripe under use utf8
-
-  if (ord("Ä") == 0xc4) { # Try to do this only on Latin-1.
-      use charnames ':full';
-      my $text = "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}";
-      print "not " unless $text eq "\xc4" && ord($text) == 0xc4;
-      print "ok 16\n";
-  } else {
-      print "ok 16 # Skip: not Latin-1\n";
-  }
-}
-

diff --git a/t/lib/checktree.t b/t/lib/checktree.t
deleted file mode 100755 (executable)
index b5426ca..0000000
--- a/t/lib/checktree.t
+++ /dev/null
@@ -1,19 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-print "1..1\n";
-
-use File::CheckTree;
-
-# We assume that we run from the perl "t" directory.
-
-validate q{
-    lib              -d || die
-    lib/checktree.t  -f || die
-};
-
-print "ok 1\n";

diff --git a/t/lib/class-isa.t b/t/lib/class-isa.t
deleted file mode 100644 (file)
index b09e2a9..0000000
--- a/t/lib/class-isa.t
+++ /dev/null
@@ -1,40 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-}
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..2\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Class::ISA;
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# Insert your test code below (better if it prints "ok 13"
-# (correspondingly "not ok 13") depending on the success of chunk 13
-# of the test code):
-
-  @Food::Fishstick::ISA = qw(Food::Fish  Life::Fungus  Chemicals);
-  @Food::Fish::ISA = qw(Food);
-  @Food::ISA = qw(Matter);
-  @Life::Fungus::ISA = qw(Life);
-  @Chemicals::ISA = qw(Matter);
-  @Life::ISA = qw(Matter);
-  @Matter::ISA = qw();
-
-  use Class::ISA;
-  my @path = Class::ISA::super_path('Food::Fishstick');
-  my $flat_path = join ' ', @path;
-  print "# Food::Fishstick path is:\n# $flat_path\n";
-  print "not " unless
-   "Food::Fish Food Matter Life::Fungus Life Chemicals" eq $flat_path;
-  print "ok 2\n";

diff --git a/t/lib/class-struct.t b/t/lib/class-struct.t
deleted file mode 100644 (file)
index 2dfaf85..0000000
--- a/t/lib/class-struct.t
+++ /dev/null
@@ -1,76 +0,0 @@
-#!./perl -w
-
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-}
-
-print "1..10\n";
-
-package aClass;
-
-sub new { bless {}, shift }
-
-sub meth { 42 }
-
-package MyObj;
-
-use Class::Struct;
-use Class::Struct 'struct'; # test out both forms
-
-use Class::Struct SomeClass => { SomeElem => '$' };
-
-struct( s => '$', a => '@', h => '%', c => 'aClass' );
-
-my $obj = MyObj->new;
-
-$obj->s('foo');
-
-print "not " unless $obj->s() eq 'foo';
-print "ok 1\n";
-
-my $arf = $obj->a;
-
-print "not " unless ref $arf eq 'ARRAY';
-print "ok 2\n";
-
-$obj->a(2, 'secundus');
-
-print "not " unless $obj->a(2) eq 'secundus';
-print "ok 3\n";
-
-my $hrf = $obj->h;
-
-print "not " unless ref $hrf eq 'HASH';
-print "ok 4\n";
-
-$obj->h('x', 10);
-
-print "not " unless $obj->h('x') == 10;
-print "ok 5\n";
-
-my $orf = $obj->c;
-
-print "not " unless ref $orf eq 'aClass';
-print "ok 6\n";
-
-print "not " unless $obj->c->meth() == 42;
-print "ok 7\n";
-
-my $obk = SomeClass->new();
-
-$obk->SomeElem(123);
-
-print "not " unless $obk->SomeElem() == 123;
-print "ok 8\n";
-
-$obj->a([4,5,6]);
-
-print "not " unless $obj->a(1) == 5;
-print "ok 9\n";
-
-$obj->h({h=>7,r=>8,f=>9});
-
-print "not " unless $obj->h('r') == 8;
-print "ok 10\n";
-

diff --git a/t/lib/complex.t b/t/lib/complex.t
deleted file mode 100755 (executable)
index 334374d..0000000
--- a/t/lib/complex.t
+++ /dev/null
@@ -1,979 +0,0 @@
-#!./perl
-
-# $RCSfile: complex.t,v $
-#
-# Regression tests for the Math::Complex pacakge
-# -- Raphael Manfredi  since Sep 1996
-# -- Jarkko Hietaniemi since Mar 1997
-# -- Daniel S. Lewart  since Sep 1997
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use Math::Complex;
-
-use vars qw($VERSION);
-
-$VERSION = 1.91;
-
-my ($args, $op, $target, $test, $test_set, $try, $val, $zvalue, @set, @val);
-
-$test = 0;
-$| = 1;
-my @script = (
-    'my ($res, $s0,$s1,$s2,$s3,$s4,$s5,$s6,$s7,$s8,$s9,$s10, $z0,$z1,$z2);' .
-       "\n\n"
-);
-my $eps = 1e-13;
-
-if ($^O eq 'unicos') {         # For some reason root() produces very inaccurate
-    $eps = 1e-10;      # results in Cray UNICOS, and occasionally also
-}                      # cos(), sin(), cosh(), sinh().  The division
-                       # of doubles is the current suspect.
-
-while (<DATA>) {
-       s/^\s+//;
-       next if $_ eq '' || /^\#/;
-       chomp;
-       $test_set = 0;          # Assume not a test over a set of values
-       if (/^&(.+)/) {
-               $op = $1;
-               next;
-       }
-       elsif (/^\{(.+)\}/) {
-               set($1, \@set, \@val);
-               next;
-       }
-       elsif (s/^\|//) {
-               $test_set = 1;  # Requests we loop over the set...
-       }
-       my @args = split(/:/);
-       if ($test_set == 1) {
-               my $i;
-               for ($i = 0; $i < @set; $i++) {
-                       # complex number
-                       $target = $set[$i];
-                       # textual value as found in set definition
-                       $zvalue = $val[$i];
-                       test($zvalue, $target, @args);
-               }
-       } else {
-               test($op, undef, @args);
-       }
-}
-
-#
-
-sub test_mutators {
-    my $op;
-
-    $test++;
-push(@script, <<'EOT');
-{
-    my $z = cplx(  1,  1);
-    $z->Re(2);
-    $z->Im(3);
-    print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
-    print 'not ' unless Re($z) == 2 and Im($z) == 3;
-EOT
-    push(@script, qq(print "ok $test\\n"}\n));
-
-    $test++;
-push(@script, <<'EOT');
-{
-    my $z = cplx(  1,  1);
-    $z->abs(3 * sqrt(2));
-    print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
-    print 'not ' unless (abs($z) - 3 * sqrt(2)) < $eps and
-                        (arg($z) - pi / 4     ) < $eps and
-                        (Re($z) - 3           ) < $eps and
-                        (Im($z) - 3           ) < $eps;
-EOT
-    push(@script, qq(print "ok $test\\n"}\n));
-
-    $test++;
-push(@script, <<'EOT');
-{
-    my $z = cplx(  1,  1);
-    $z->arg(-3 / 4 * pi);
-    print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
-    print 'not ' unless (arg($z) + 3 / 4 * pi) < $eps and
-                        (abs($z) - sqrt(2)   ) < $eps and
-                        (Re($z) + 1          ) < $eps and
-                        (Im($z) + 1          ) < $eps;
-EOT
-    push(@script, qq(print "ok $test\\n"}\n));
-}
-
-test_mutators();
-
-my $constants = '
-my $i    = cplx(0,  1);
-my $pi   = cplx(pi, 0);
-my $pii  = cplx(0, pi);
-my $pip2 = cplx(pi/2, 0);
-my $zero = cplx(0, 0);
-';
-
-push(@script, $constants);
-
-
-# test the divbyzeros
-
-sub test_dbz {
-    for my $op (@_) {
-       $test++;
-       push(@script, <<EOT);
-       eval '$op';
-       (\$bad) = (\$@ =~ /(.+)/);
-       print "# $test op = $op divbyzero? \$bad...\n";
-       print 'not ' unless (\$@ =~ /Division by zero/);
-EOT
-        push(@script, qq(print "ok $test\\n";\n));
-    }
-}
-
-# test the logofzeros
-
-sub test_loz {
-    for my $op (@_) {
-       $test++;
-       push(@script, <<EOT);
-       eval '$op';
-       (\$bad) = (\$@ =~ /(.+)/);
-       print "# $test op = $op logofzero? \$bad...\n";
-       print 'not ' unless (\$@ =~ /Logarithm of zero/);
-EOT
-        push(@script, qq(print "ok $test\\n";\n));
-    }
-}
-
-test_dbz(
-        'i/0',
-        'acot(0)',
-        'acot(+$i)',
-#       'acoth(-1)',   # Log of zero.
-        'acoth(0)',
-        'acoth(+1)',
-        'acsc(0)',
-        'acsch(0)',
-        'asec(0)',
-        'asech(0)',
-        'atan($i)',
-#       'atanh(-1)',   # Log of zero.
-        'atanh(+1)',
-        'cot(0)',
-        'coth(0)',
-        'csc(0)',
-        'csch(0)',
-       );
-
-test_loz(
-        'log($zero)',
-        'atan(-$i)',
-        'acot(-$i)',
-        'atanh(-1)',
-        'acoth(-1)',
-       );
-
-# test the bad roots
-
-sub test_broot {
-    for my $op (@_) {
-       $test++;
-       push(@script, <<EOT);
-       eval 'root(2, $op)';
-       (\$bad) = (\$@ =~ /(.+)/);
-       print "# $test op = $op badroot? \$bad...\n";
-       print 'not ' unless (\$@ =~ /root rank must be/);
-EOT
-        push(@script, qq(print "ok $test\\n";\n));
-    }
-}
-
-test_broot(qw(-3 -2.1 0 0.99));
-
-sub test_display_format {
-    $test++;
-    push @script, <<EOS;
-    print "# package display_format cartesian?\n";
-    print "not " unless Math::Complex->display_format eq 'cartesian';
-    print "ok $test\n";
-EOS
-
-    push @script, <<EOS;
-    my \$j = (root(1,3))[1];
-
-    \$j->display_format('polar');
-EOS
-
-    $test++;
-    push @script, <<EOS;
-    print "# j display_format polar?\n";
-    print "not " unless \$j->display_format eq 'polar';
-    print "ok $test\n";
-EOS
-
-    $test++;
-    push @script, <<EOS;
-    print "# j = \$j\n";
-    print "not " unless "\$j" eq "[1,2pi/3]";
-    print "ok $test\n";
-
-    my %display_format;
-
-    %display_format = \$j->display_format;
-EOS
-
-    $test++;
-    push @script, <<EOS;
-    print "# display_format{style} polar?\n";
-    print "not " unless \$display_format{style} eq 'polar';
-    print "ok $test\n";
-EOS
-
-    $test++;
-    push @script, <<EOS;
-    print "# keys %display_format == 2?\n";
-    print "not " unless keys %display_format == 2;
-    print "ok $test\n";
-
-    \$j->display_format('style' => 'cartesian', 'format' => '%.5f');
-EOS
-
-    $test++;
-    push @script, <<EOS;
-    print "# j = \$j\n";
-    print "not " unless "\$j" eq "-0.50000+0.86603i";
-    print "ok $test\n";
-
-    %display_format = \$j->display_format;
-EOS
-
-    $test++;
-    push @script, <<EOS;
-    print "# display_format{format} %.5f?\n";
-    print "not " unless \$display_format{format} eq '%.5f';
-    print "ok $test\n";
-EOS
-
-    $test++;
-    push @script, <<EOS;
-    print "# keys %display_format == 3?\n";
-    print "not " unless keys %display_format == 3;
-    print "ok $test\n";
-
-    \$j->display_format('format' => undef);
-EOS
-
-    $test++;
-    push @script, <<EOS;
-    print "# j = \$j\n";
-    print "not " unless "\$j" =~ /^-0(?:\\.5(?:0000\\d+)?|\\.49999\\d+)\\+0.86602540\\d+i\$/;
-    print "ok $test\n";
-
-    \$j->display_format('style' => 'polar', 'polar_pretty_print' => 0);
-EOS
-
-    $test++;
-    push @script, <<EOS;
-    print "# j = \$j\n";
-    print "not " unless "\$j" =~ /^\\[1,2\\.09439510\\d+\\]\$/;
-    print "ok $test\n";
-
-    \$j->display_format('style' => 'cartesian', 'format' => '(%.5g)');
-EOS
-
-    $test++;
-    push @script, <<EOS;
-    print "# j = \$j\n";
-    print "not " unless "\$j" eq "(-0.5)+(0.86603)i";
-    print "ok $test\n";
-EOS
-
-    $test++;
-    push @script, <<EOS;
-    print "# j display_format cartesian?\n";
-    print "not " unless \$j->display_format eq 'cartesian';
-    print "ok $test\n";
-EOS
-}
-
-test_display_format();
-
-print "1..$test\n";
-eval join '', @script;
-die $@ if $@;
-
-sub abop {
-       my ($op) = @_;
-
-       push(@script, qq(print "# $op=\n";));
-}
-
-sub test {
-       my ($op, $z, @args) = @_;
-       my ($baop) = 0;
-       $test++;
-       my $i;
-       $baop = 1 if ($op =~ s/;=$//);
-       for ($i = 0; $i < @args; $i++) {
-               $val = value($args[$i]);
-               push @script, "\$z$i = $val;\n";
-       }
-       if (defined $z) {
-               $args = "'$op'";                # Really the value
-               $try = "abs(\$z0 - \$z1) <= $eps ? \$z1 : \$z0";
-               push @script, "\$res = $try; ";
-               push @script, "check($test, $args[0], \$res, \$z$#args, $args);\n";
-       } else {
-               my ($try, $args);
-               if (@args == 2) {
-                       $try = "$op \$z0";
-                       $args = "'$args[0]'";
-               } else {
-                       $try = ($op =~ /^\w/) ? "$op(\$z0, \$z1)" : "\$z0 $op \$z1";
-                       $args = "'$args[0]', '$args[1]'";
-               }
-               push @script, "\$res = $try; ";
-               push @script, "check($test, '$try', \$res, \$z$#args, $args);\n";
-               if (@args > 2 and $baop) { # binary assignment ops
-                       $test++;
-                       # check the op= works
-                       push @script, <<EOB;
-{
-       my \$za = cplx(ref \$z0 ? \@{\$z0->cartesian} : (\$z0, 0));
-
-       my (\$z1r, \$z1i) = ref \$z1 ? \@{\$z1->cartesian} : (\$z1, 0);
-
-       my \$zb = cplx(\$z1r, \$z1i);
-
-       \$za $op= \$zb;
-       my (\$zbr, \$zbi) = \@{\$zb->cartesian};
-
-       check($test, '\$z0 $op= \$z1', \$za, \$z$#args, $args);
-EOB
-                       $test++;
-                       # check that the rhs has not changed
-                       push @script, qq(print "not " unless (\$zbr == \$z1r and \$zbi == \$z1i););
-                       push @script, qq(print "ok $test\\n";\n);
-                       push @script, "}\n";
-               }
-       }
-}
-
-sub set {
-       my ($set, $setref, $valref) = @_;
-       @{$setref} = ();
-       @{$valref} = ();
-       my @set = split(/;\s*/, $set);
-       my @res;
-       my $i;
-       for ($i = 0; $i < @set; $i++) {
-               push(@{$valref}, $set[$i]);
-               my $val = value($set[$i]);
-               push @script, "\$s$i = $val;\n";
-               push @{$setref}, "\$s$i";
-       }
-}
-
-sub value {
-       local ($_) = @_;
-       if (/^\s*\((.*),(.*)\)/) {
-               return "cplx($1,$2)";
-       }
-       elsif (/^\s*([\-\+]?(?:\d+(\.\d+)?|\.\d+)(?:[e[\-\+]\d+])?)/) {
-               return "cplx($1,0)";
-       }
-       elsif (/^\s*\[(.*),(.*)\]/) {
-               return "cplxe($1,$2)";
-       }
-       elsif (/^\s*'(.*)'/) {
-               my $ex = $1;
-               $ex =~ s/\bz\b/$target/g;
-               $ex =~ s/\br\b/abs($target)/g;
-               $ex =~ s/\bt\b/arg($target)/g;
-               $ex =~ s/\ba\b/Re($target)/g;
-               $ex =~ s/\bb\b/Im($target)/g;
-               return $ex;
-       }
-       elsif (/^\s*"(.*)"/) {
-               return "\"$1\"";
-       }
-       return $_;
-}
-
-sub check {
-       my ($test, $try, $got, $expected, @z) = @_;
-
-       print "# @_\n";
-
-       if ("$got" eq "$expected"
-           ||
-           ($expected =~ /^-?\d/ && $got == $expected)
-           ||
-           (abs($got - $expected) < $eps)
-           ) {
-               print "ok $test\n";
-       } else {
-               print "not ok $test\n";
-               my $args = (@z == 1) ? "z = $z[0]" : "z0 = $z[0], z1 = $z[1]";
-               print "# '$try' expected: '$expected' got: '$got' for $args\n";
-       }
-}
-
-sub addsq {
-    my ($z1, $z2) = @_;
-    return ($z1 + i*$z2) * ($z1 - i*$z2);
-}
-
-sub subsq {
-    my ($z1, $z2) = @_;
-    return ($z1 + $z2) * ($z1 - $z2);
-}
-
-__END__
-&+;=
-(3,4):(3,4):(6,8)
-(-3,4):(3,-4):(0,0)
-(3,4):-3:(0,4)
-1:(4,2):(5,2)
-[2,0]:[2,pi]:(0,0)
-
-&++
-(2,1):(3,1)
-
-&-;=
-(2,3):(-2,-3)
-[2,pi/2]:[2,-(pi)/2]
-2:[2,0]:(0,0)
-[3,0]:2:(1,0)
-3:(4,5):(-1,-5)
-(4,5):3:(1,5)
-(2,1):(3,5):(-1,-4)
-
-&--
-(1,2):(0,2)
-[2,pi]:[3,pi]
-
-&*;=
-(0,1):(0,1):(-1,0)
-(4,5):(1,0):(4,5)
-[2,2*pi/3]:(1,0):[2,2*pi/3]
-2:(0,1):(0,2)
-(0,1):3:(0,3)
-(0,1):(4,1):(-1,4)
-(2,1):(4,-1):(9,2)
-
-&/;=
-(3,4):(3,4):(1,0)
-(4,-5):1:(4,-5)
-1:(0,1):(0,-1)
-(0,6):(0,2):(3,0)
-(9,2):(4,-1):(2,1)
-[4,pi]:[2,pi/2]:[2,pi/2]
-[2,pi/2]:[4,pi]:[0.5,-(pi)/2]
-
-&**;=
-(2,0):(3,0):(8,0)
-(3,0):(2,0):(9,0)
-(2,3):(4,0):(-119,-120)
-(0,0):(1,0):(0,0)
-(0,0):(2,3):(0,0)
-(1,0):(0,0):(1,0)
-(1,0):(1,0):(1,0)
-(1,0):(2,3):(1,0)
-(2,3):(0,0):(1,0)
-(2,3):(1,0):(2,3)
-(0,0):(0,0):(1,0)
-
-&Re
-(3,4):3
-(-3,4):-3
-[1,pi/2]:0
-
-&Im
-(3,4):4
-(3,-4):-4
-[1,pi/2]:1
-
-&abs
-(3,4):5
-(-3,4):5
-
-&arg
-[2,0]:0
-[-2,0]:pi
-
-&~
-(4,5):(4,-5)
-(-3,4):(-3,-4)
-[2,pi/2]:[2,-(pi)/2]
-
-&<
-(3,4):(1,2):0
-(3,4):(3,2):0
-(3,4):(3,8):1
-(4,4):(5,129):1
-
-&==
-(3,4):(4,5):0
-(3,4):(3,5):0
-(3,4):(2,4):0
-(3,4):(3,4):1
-
-&sqrt
--9:(0,3)
-(-100,0):(0,10)
-(16,-30):(5,-3)
-
-&stringify_cartesian
-(-100,0):"-100"
-(0,1):"i"
-(4,-3):"4-3i"
-(4,0):"4"
-(-4,0):"-4"
-(-2,4):"-2+4i"
-(-2,-1):"-2-i"
-
-&stringify_polar
-[-1, 0]:"[1,pi]"
-[1, pi/3]:"[1,pi/3]"
-[6, -2*pi/3]:"[6,-2pi/3]"
-[0.5, -9*pi/11]:"[0.5,-9pi/11]"
-
-{ (4,3); [3,2]; (-3,4); (0,2); [2,1] }
-
-|'z + ~z':'2*Re(z)'
-|'z - ~z':'2*i*Im(z)'
-|'z * ~z':'abs(z) * abs(z)'
-
-{ (0.5, 0); (-0.5, 0); (2,3); [3,2]; (-3,2); (0,2); 3; 1.2; (-3, 0); (-2, -1); [2,1] }
-
-|'(root(z, 4))[1] ** 4':'z'
-|'(root(z, 5))[3] ** 5':'z'
-|'(root(z, 8))[7] ** 8':'z'
-|'abs(z)':'r'
-|'acot(z)':'acotan(z)'
-|'acsc(z)':'acosec(z)'
-|'acsc(z)':'asin(1 / z)'
-|'asec(z)':'acos(1 / z)'
-|'cbrt(z)':'cbrt(r) * exp(i * t/3)'
-|'cos(acos(z))':'z'
-|'addsq(cos(z), sin(z))':1
-|'cos(z)':'cosh(i*z)'
-|'subsq(cosh(z), sinh(z))':1
-|'cot(acot(z))':'z'
-|'cot(z)':'1 / tan(z)'
-|'cot(z)':'cotan(z)'
-|'csc(acsc(z))':'z'
-|'csc(z)':'1 / sin(z)'
-|'csc(z)':'cosec(z)'
-|'exp(log(z))':'z'
-|'exp(z)':'exp(a) * exp(i * b)'
-|'ln(z)':'log(z)'
-|'log(exp(z))':'z'
-|'log(z)':'log(r) + i*t'
-|'log10(z)':'log(z) / log(10)'
-|'logn(z, 2)':'log(z) / log(2)'
-|'logn(z, 3)':'log(z) / log(3)'
-|'sec(asec(z))':'z'
-|'sec(z)':'1 / cos(z)'
-|'sin(asin(z))':'z'
-|'sin(i * z)':'i * sinh(z)'
-|'sqrt(z) * sqrt(z)':'z'
-|'sqrt(z)':'sqrt(r) * exp(i * t/2)'
-|'tan(atan(z))':'z'
-|'z**z':'exp(z * log(z))'
-
-{ (1,1); [1,0.5]; (-2, -1); 2; -3; (-1,0.5); (0,0.5); 0.5; (2, 0); (-1, -2) }
-
-|'cosh(acosh(z))':'z'
-|'coth(acoth(z))':'z'
-|'coth(z)':'1 / tanh(z)'
-|'coth(z)':'cotanh(z)'
-|'csch(acsch(z))':'z'
-|'csch(z)':'1 / sinh(z)'
-|'csch(z)':'cosech(z)'
-|'sech(asech(z))':'z'
-|'sech(z)':'1 / cosh(z)'
-|'sinh(asinh(z))':'z'
-|'tanh(atanh(z))':'z'
-
-{ (0.2,-0.4); [1,0.5]; -1.2; (-1,0.5); 0.5; (1.1, 0) }
-
-|'acos(cos(z)) ** 2':'z * z'
-|'acosh(cosh(z)) ** 2':'z * z'
-|'acoth(z)':'acotanh(z)'
-|'acoth(z)':'atanh(1 / z)'
-|'acsch(z)':'acosech(z)'
-|'acsch(z)':'asinh(1 / z)'
-|'asech(z)':'acosh(1 / z)'
-|'asin(sin(z))':'z'
-|'asinh(sinh(z))':'z'
-|'atan(tan(z))':'z'
-|'atanh(tanh(z))':'z'
-
-&log
-(-2.0,0):(   0.69314718055995,  3.14159265358979)
-(-1.0,0):(   0               ,  3.14159265358979)
-(-0.5,0):(  -0.69314718055995,  3.14159265358979)
-( 0.5,0):(  -0.69314718055995,  0               )
-( 1.0,0):(   0               ,  0               )
-( 2.0,0):(   0.69314718055995,  0               )
-
-&log
-( 2, 3):(    1.28247467873077,  0.98279372324733)
-(-2, 3):(    1.28247467873077,  2.15879893034246)
-(-2,-3):(    1.28247467873077, -2.15879893034246)
-( 2,-3):(    1.28247467873077, -0.98279372324733)
-
-&sin
-(-2.0,0):(  -0.90929742682568,  0               )
-(-1.0,0):(  -0.84147098480790,  0               )
-(-0.5,0):(  -0.47942553860420,  0               )
-( 0.0,0):(   0               ,  0               )
-( 0.5,0):(   0.47942553860420,  0               )
-( 1.0,0):(   0.84147098480790,  0               )
-( 2.0,0):(   0.90929742682568,  0               )
-
-&sin
-( 2, 3):(  9.15449914691143, -4.16890695996656)
-(-2, 3):( -9.15449914691143, -4.16890695996656)
-(-2,-3):( -9.15449914691143,  4.16890695996656)
-( 2,-3):(  9.15449914691143,  4.16890695996656)
-
-&cos
-(-2.0,0):(  -0.41614683654714,  0               )
-(-1.0,0):(   0.54030230586814,  0               )
-(-0.5,0):(   0.87758256189037,  0               )
-( 0.0,0):(   1               ,  0               )
-( 0.5,0):(   0.87758256189037,  0               )
-( 1.0,0):(   0.54030230586814,  0               )
-( 2.0,0):(  -0.41614683654714,  0               )
-
-&cos
-( 2, 3):( -4.18962569096881, -9.10922789375534)
-(-2, 3):( -4.18962569096881,  9.10922789375534)
-(-2,-3):( -4.18962569096881, -9.10922789375534)
-( 2,-3):( -4.18962569096881,  9.10922789375534)
-
-&tan
-(-2.0,0):(   2.18503986326152,  0               )
-(-1.0,0):(  -1.55740772465490,  0               )
-(-0.5,0):(  -0.54630248984379,  0               )
-( 0.0,0):(   0               ,  0               )
-( 0.5,0):(   0.54630248984379,  0               )
-( 1.0,0):(   1.55740772465490,  0               )
-( 2.0,0):(  -2.18503986326152,  0               )
-
-&tan
-( 2, 3):( -0.00376402564150,  1.00323862735361)
-(-2, 3):(  0.00376402564150,  1.00323862735361)
-(-2,-3):(  0.00376402564150, -1.00323862735361)
-( 2,-3):( -0.00376402564150, -1.00323862735361)
-
-&sec
-(-2.0,0):(  -2.40299796172238,  0               )
-(-1.0,0):(   1.85081571768093,  0               )
-(-0.5,0):(   1.13949392732455,  0               )
-( 0.0,0):(   1               ,  0               )
-( 0.5,0):(   1.13949392732455,  0               )
-( 1.0,0):(   1.85081571768093,  0               )
-( 2.0,0):(  -2.40299796172238,  0               )
-
-&sec
-( 2, 3):( -0.04167496441114,  0.09061113719624)
-(-2, 3):( -0.04167496441114, -0.09061113719624)
-(-2,-3):( -0.04167496441114,  0.09061113719624)
-( 2,-3):( -0.04167496441114, -0.09061113719624)
-
-&csc
-(-2.0,0):(  -1.09975017029462,  0               )
-(-1.0,0):(  -1.18839510577812,  0               )
-(-0.5,0):(  -2.08582964293349,  0               )
-( 0.5,0):(   2.08582964293349,  0               )
-( 1.0,0):(   1.18839510577812,  0               )
-( 2.0,0):(   1.09975017029462,  0               )
-
-&csc
-( 2, 3):(  0.09047320975321,  0.04120098628857)
-(-2, 3):( -0.09047320975321,  0.04120098628857)
-(-2,-3):( -0.09047320975321, -0.04120098628857)
-( 2,-3):(  0.09047320975321, -0.04120098628857)
-
-&cot
-(-2.0,0):(   0.45765755436029,  0               )
-(-1.0,0):(  -0.64209261593433,  0               )
-(-0.5,0):(  -1.83048772171245,  0               )
-( 0.5,0):(   1.83048772171245,  0               )
-( 1.0,0):(   0.64209261593433,  0               )
-( 2.0,0):(  -0.45765755436029,  0               )
-
-&cot
-( 2, 3):( -0.00373971037634, -0.99675779656936)
-(-2, 3):(  0.00373971037634, -0.99675779656936)
-(-2,-3):(  0.00373971037634,  0.99675779656936)
-( 2,-3):( -0.00373971037634,  0.99675779656936)
-
-&asin
-(-2.0,0):(  -1.57079632679490,  1.31695789692482)
-(-1.0,0):(  -1.57079632679490,  0               )
-(-0.5,0):(  -0.52359877559830,  0               )
-( 0.0,0):(   0               ,  0               )
-( 0.5,0):(   0.52359877559830,  0               )
-( 1.0,0):(   1.57079632679490,  0               )
-( 2.0,0):(   1.57079632679490, -1.31695789692482)
-
-&asin
-( 2, 3):(  0.57065278432110,  1.98338702991654)
-(-2, 3):( -0.57065278432110,  1.98338702991654)
-(-2,-3):( -0.57065278432110, -1.98338702991654)
-( 2,-3):(  0.57065278432110, -1.98338702991654)
-
-&acos
-(-2.0,0):(   3.14159265358979, -1.31695789692482)
-(-1.0,0):(   3.14159265358979,  0               )
-(-0.5,0):(   2.09439510239320,  0               )
-( 0.0,0):(   1.57079632679490,  0               )
-( 0.5,0):(   1.04719755119660,  0               )
-( 1.0,0):(   0               ,  0               )
-( 2.0,0):(   0               ,  1.31695789692482)
-
-&acos
-( 2, 3):(  1.00014354247380, -1.98338702991654)
-(-2, 3):(  2.14144911111600, -1.98338702991654)
-(-2,-3):(  2.14144911111600,  1.98338702991654)
-( 2,-3):(  1.00014354247380,  1.98338702991654)
-
-&atan
-(-2.0,0):(  -1.10714871779409,  0               )
-(-1.0,0):(  -0.78539816339745,  0               )
-(-0.5,0):(  -0.46364760900081,  0               )
-( 0.0,0):(   0               ,  0               )
-( 0.5,0):(   0.46364760900081,  0               )
-( 1.0,0):(   0.78539816339745,  0               )
-( 2.0,0):(   1.10714871779409,  0               )
-
-&atan
-( 2, 3):(  1.40992104959658,  0.22907268296854)
-(-2, 3):( -1.40992104959658,  0.22907268296854)
-(-2,-3):( -1.40992104959658, -0.22907268296854)
-( 2,-3):(  1.40992104959658, -0.22907268296854)
-
-&asec
-(-2.0,0):(   2.09439510239320,  0               )
-(-1.0,0):(   3.14159265358979,  0               )
-(-0.5,0):(   3.14159265358979, -1.31695789692482)
-( 0.5,0):(   0               ,  1.31695789692482)
-( 1.0,0):(   0               ,  0               )
-( 2.0,0):(   1.04719755119660,  0               )
-
-&asec
-( 2, 3):(  1.42041072246703,  0.23133469857397)
-(-2, 3):(  1.72118193112276,  0.23133469857397)
-(-2,-3):(  1.72118193112276, -0.23133469857397)
-( 2,-3):(  1.42041072246703, -0.23133469857397)
-
-&acsc
-(-2.0,0):(  -0.52359877559830,  0               )
-(-1.0,0):(  -1.57079632679490,  0               )
-(-0.5,0):(  -1.57079632679490,  1.31695789692482)
-( 0.5,0):(   1.57079632679490, -1.31695789692482)
-( 1.0,0):(   1.57079632679490,  0               )
-( 2.0,0):(   0.52359877559830,  0               )
-
-&acsc
-( 2, 3):(  0.15038560432786, -0.23133469857397)
-(-2, 3):( -0.15038560432786, -0.23133469857397)
-(-2,-3):( -0.15038560432786,  0.23133469857397)
-( 2,-3):(  0.15038560432786,  0.23133469857397)
-
-&acot
-(-2.0,0):(  -0.46364760900081,  0               )
-(-1.0,0):(  -0.78539816339745,  0               )
-(-0.5,0):(  -1.10714871779409,  0               )
-( 0.5,0):(   1.10714871779409,  0               )
-( 1.0,0):(   0.78539816339745,  0               )
-( 2.0,0):(   0.46364760900081,  0               )
-
-&acot
-( 2, 3):(  0.16087527719832, -0.22907268296854)
-(-2, 3):( -0.16087527719832, -0.22907268296854)
-(-2,-3):( -0.16087527719832,  0.22907268296854)
-( 2,-3):(  0.16087527719832,  0.22907268296854)
-
-&sinh
-(-2.0,0):(  -3.62686040784702,  0               )
-(-1.0,0):(  -1.17520119364380,  0               )
-(-0.5,0):(  -0.52109530549375,  0               )
-( 0.0,0):(   0               ,  0               )
-( 0.5,0):(   0.52109530549375,  0               )
-( 1.0,0):(   1.17520119364380,  0               )
-( 2.0,0):(   3.62686040784702,  0               )
-
-&sinh
-( 2, 3):( -3.59056458998578,  0.53092108624852)
-(-2, 3):(  3.59056458998578,  0.53092108624852)
-(-2,-3):(  3.59056458998578, -0.53092108624852)
-( 2,-3):( -3.59056458998578, -0.53092108624852)
-
-&cosh
-(-2.0,0):(   3.76219569108363,  0               )
-(-1.0,0):(   1.54308063481524,  0               )
-(-0.5,0):(   1.12762596520638,  0               )
-( 0.0,0):(   1               ,  0               )
-( 0.5,0):(   1.12762596520638,  0               )
-( 1.0,0):(   1.54308063481524,  0               )
-( 2.0,0):(   3.76219569108363,  0               )
-
-&cosh
-( 2, 3):( -3.72454550491532,  0.51182256998738)
-(-2, 3):( -3.72454550491532, -0.51182256998738)
-(-2,-3):( -3.72454550491532,  0.51182256998738)
-( 2,-3):( -3.72454550491532, -0.51182256998738)
-
-&tanh
-(-2.0,0):(  -0.96402758007582,  0               )
-(-1.0,0):(  -0.76159415595576,  0               )
-(-0.5,0):(  -0.46211715726001,  0               )
-( 0.0,0):(   0               ,  0               )
-( 0.5,0):(   0.46211715726001,  0               )
-( 1.0,0):(   0.76159415595576,  0               )
-( 2.0,0):(   0.96402758007582,  0               )
-
-&tanh
-( 2, 3):(  0.96538587902213, -0.00988437503832)
-(-2, 3):( -0.96538587902213, -0.00988437503832)
-(-2,-3):( -0.96538587902213,  0.00988437503832)
-( 2,-3):(  0.96538587902213,  0.00988437503832)
-
-&sech
-(-2.0,0):(   0.26580222883408,  0               )
-(-1.0,0):(   0.64805427366389,  0               )
-(-0.5,0):(   0.88681888397007,  0               )
-( 0.0,0):(   1               ,  0               )
-( 0.5,0):(   0.88681888397007,  0               )
-( 1.0,0):(   0.64805427366389,  0               )
-( 2.0,0):(   0.26580222883408,  0               )
-
-&sech
-( 2, 3):( -0.26351297515839, -0.03621163655877)
-(-2, 3):( -0.26351297515839,  0.03621163655877)
-(-2,-3):( -0.26351297515839, -0.03621163655877)
-( 2,-3):( -0.26351297515839,  0.03621163655877)
-
-&csch
-(-2.0,0):(  -0.27572056477178,  0               )
-(-1.0,0):(  -0.85091812823932,  0               )
-(-0.5,0):(  -1.91903475133494,  0               )
-( 0.5,0):(   1.91903475133494,  0               )
-( 1.0,0):(   0.85091812823932,  0               )
-( 2.0,0):(   0.27572056477178,  0               )
-
-&csch
-( 2, 3):( -0.27254866146294, -0.04030057885689)
-(-2, 3):(  0.27254866146294, -0.04030057885689)
-(-2,-3):(  0.27254866146294,  0.04030057885689)
-( 2,-3):( -0.27254866146294,  0.04030057885689)
-
-&coth
-(-2.0,0):(  -1.03731472072755,  0               )
-(-1.0,0):(  -1.31303528549933,  0               )
-(-0.5,0):(  -2.16395341373865,  0               )
-( 0.5,0):(   2.16395341373865,  0               )
-( 1.0,0):(   1.31303528549933,  0               )
-( 2.0,0):(   1.03731472072755,  0               )
-
-&coth
-( 2, 3):(  1.03574663776500,  0.01060478347034)
-(-2, 3):( -1.03574663776500,  0.01060478347034)
-(-2,-3):( -1.03574663776500, -0.01060478347034)
-( 2,-3):(  1.03574663776500, -0.01060478347034)
-
-&asinh
-(-2.0,0):(  -1.44363547517881,  0               )
-(-1.0,0):(  -0.88137358701954,  0               )
-(-0.5,0):(  -0.48121182505960,  0               )
-( 0.0,0):(   0               ,  0               )
-( 0.5,0):(   0.48121182505960,  0               )
-( 1.0,0):(   0.88137358701954,  0               )
-( 2.0,0):(   1.44363547517881,  0               )
-
-&asinh
-( 2, 3):(  1.96863792579310,  0.96465850440760)
-(-2, 3):( -1.96863792579310,  0.96465850440761)
-(-2,-3):( -1.96863792579310, -0.96465850440761)
-( 2,-3):(  1.96863792579310, -0.96465850440760)
-
-&acosh
-(-2.0,0):(   1.31695789692482,  3.14159265358979)
-(-1.0,0):(   0,                 3.14159265358979)
-(-0.5,0):(   0,                 2.09439510239320)
-( 0.0,0):(   0,                 1.57079632679490)
-( 0.5,0):(   0,                 1.04719755119660)
-( 1.0,0):(   0               ,  0               )
-( 2.0,0):(   1.31695789692482,  0               )
-
-&acosh
-( 2, 3):(  1.98338702991654,  1.00014354247380)
-(-2, 3):(  1.98338702991653,  2.14144911111600)
-(-2,-3):(  1.98338702991653, -2.14144911111600)
-( 2,-3):(  1.98338702991654, -1.00014354247380)
-
-&atanh
-(-2.0,0):(  -0.54930614433405,  1.57079632679490)
-(-0.5,0):(  -0.54930614433405,  0               )
-( 0.0,0):(   0               ,  0               )
-( 0.5,0):(   0.54930614433405,  0               )
-( 2.0,0):(   0.54930614433405,  1.57079632679490)
-
-&atanh
-( 2, 3):(  0.14694666622553,  1.33897252229449)
-(-2, 3):( -0.14694666622553,  1.33897252229449)
-(-2,-3):( -0.14694666622553, -1.33897252229449)
-( 2,-3):(  0.14694666622553, -1.33897252229449)
-
-&asech
-(-2.0,0):(   0               , 2.09439510239320)
-(-1.0,0):(   0               , 3.14159265358979)
-(-0.5,0):(   1.31695789692482, 3.14159265358979)
-( 0.5,0):(   1.31695789692482, 0               )
-( 1.0,0):(   0               , 0               )
-( 2.0,0):(   0               , 1.04719755119660)
-
-&asech
-( 2, 3):(  0.23133469857397, -1.42041072246703)
-(-2, 3):(  0.23133469857397, -1.72118193112276)
-(-2,-3):(  0.23133469857397,  1.72118193112276)
-( 2,-3):(  0.23133469857397,  1.42041072246703)
-
-&acsch
-(-2.0,0):(  -0.48121182505960, 0               )
-(-1.0,0):(  -0.88137358701954, 0               )
-(-0.5,0):(  -1.44363547517881, 0               )
-( 0.5,0):(   1.44363547517881, 0               )
-( 1.0,0):(   0.88137358701954, 0               )
-( 2.0,0):(   0.48121182505960, 0               )
-
-&acsch
-( 2, 3):(  0.15735549884499, -0.22996290237721)
-(-2, 3):( -0.15735549884499, -0.22996290237721)
-(-2,-3):( -0.15735549884499,  0.22996290237721)
-( 2,-3):(  0.15735549884499,  0.22996290237721)
-
-&acoth
-(-2.0,0):(  -0.54930614433405, 0               )
-(-0.5,0):(  -0.54930614433405, 1.57079632679490)
-( 0.5,0):(   0.54930614433405, 1.57079632679490)
-( 2.0,0):(   0.54930614433405, 0               )
-
-&acoth
-( 2, 3):(  0.14694666622553, -0.23182380450040)
-(-2, 3):( -0.14694666622553, -0.23182380450040)
-(-2,-3):( -0.14694666622553,  0.23182380450040)
-( 2,-3):(  0.14694666622553,  0.23182380450040)
-
-# eof

diff --git a/t/lib/cpan-loadme.t b/t/lib/cpan-loadme.t
deleted file mode 100644 (file)
index dce7e10..0000000
--- a/t/lib/cpan-loadme.t
+++ /dev/null
@@ -1,16 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-}
-
-BEGIN {
-    print "1..1\n";
-}
-use strict;
-use CPAN;
-use CPAN::FirstTime;
-
-print "ok 1\n";
-

diff --git a/t/lib/cpan-vcmp.t b/t/lib/cpan-vcmp.t
deleted file mode 100644 (file)
index 290fc3d..0000000
--- a/t/lib/cpan-vcmp.t
+++ /dev/null
@@ -1,62 +0,0 @@
-# -*- Mode: cperl; coding: utf-8; -*-
-
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-}
-
-use strict;
-use CPAN;
-use vars qw($D $N);
-
-while (<DATA>) {
-  next if /^v/ && $]<5.006; # v-string tests are not for pre-5.6.0
-  chomp;
-  s/\s*#.*//;
-  push @$D, [ split ];
-}
-
-$N = scalar @$D;
-print "1..$N\n";
-
-while (@$D) {
-  my($l,$r,$exp) = @{shift @$D};
-  my $res = CPAN::Version->vcmp($l,$r);
-  if ($res != $exp){
-    print "# l[$l]r[$r]exp[$exp]res[$res]\n";
-    print "not ";
-  }
-  print "ok ", $N-@$D, "\n";
-}
-
-__END__
-0 0 0
-1 0 1
-0 1 -1
-1 1 0
-1.1 0.0a 1
-1.1a 0.0 1
-1.2.3 1.1.1 1
-v1.2.3 v1.1.1 1
-v1.2.3 v1.2.1 1
-v1.2.3 v1.2.11 -1
-1.2.3 1.2.11 1 # not what they wanted
-1.9 1.10 1
-VERSION VERSION 0
-0.02 undef 1
-1.57_00 1.57 1
-1.5700 1.57 1
-1.57_01 1.57 1
-0.2.10 0.2 1
-20000000.00 19990108 1
-1.00 0.96 1
-0.7.02 0.7 1
-1.3a5 1.3 1
-undef 1.00 -1
-v1.0 undef 1
-v0.2.4 0.24 -1
-v1.0.22 122 -1
-5.00556 v5.5.560 0
-5.005056 v5.5.56 0
-5.00557 v5.5.560 1
-5.00056 v5.0.561 -1

diff --git a/t/lib/cwd.t b/t/lib/cwd.t
deleted file mode 100644 (file)
index 09b45d6..0000000
--- a/t/lib/cwd.t
+++ /dev/null
@@ -1,134 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use Config;
-use Cwd;
-use strict;
-use warnings;
-
-print "1..14\n";
-
-# check imports
-print +(defined(&cwd) && 
-       defined(&getcwd) &&
-       defined(&fastcwd) &&
-       defined(&fastgetcwd) ?
-        "" : "not "), "ok 1\n";
-print +(!defined(&chdir) &&
-       !defined(&abs_path) &&
-       !defined(&fast_abs_path) ?
-       "" : "not "), "ok 2\n";
-
-# XXX force Cwd to bootsrap its XSUBs since we have set @INC = "../lib"
-# XXX and subsequent chdir()s can make them impossible to find
-eval { fastcwd };
-
-# Must find an external pwd (or equivalent) command.
-
-my $pwd_cmd =
-    ($^O eq "MSWin32" || $^O eq "NetWare") ? "cd" : (grep { -x && -f } map { "$_/pwd" }
-                              split m/$Config{path_sep}/, $ENV{PATH})[0];
-
-if ($^O eq 'VMS') { $pwd_cmd = 'SHOW DEFAULT'; }
-
-if (defined $pwd_cmd) {
-    chomp(my $start = `$pwd_cmd`);
-    # Win32's cd returns native C:\ style
-    $start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
-    # DCL SHOW DEFAULT has leading spaces
-    $start =~ s/^\s+// if $^O eq 'VMS';
-    if ($?) {
-       for (3..6) {
-           print "ok $_ # Skip: '$pwd_cmd' failed\n";
-       }
-    } else {
-       my $cwd        = cwd;
-       my $getcwd     = getcwd;
-       my $fastcwd    = fastcwd;
-       my $fastgetcwd = fastgetcwd;
-       print +($cwd        eq $start ? "" : "not "), "ok 3\n";
-       print +($getcwd     eq $start ? "" : "not "), "ok 4\n";
-       print +($fastcwd    eq $start ? "" : "not "), "ok 5\n";
-       print +($fastgetcwd eq $start ? "" : "not "), "ok 6\n";
-    }
-} else {
-    for (3..6) {
-       print "ok $_ # Skip: no pwd command found\n";
-    }
-}
-
-mkdir "pteerslt", 0777;
-mkdir "pteerslt/path", 0777;
-mkdir "pteerslt/path/to", 0777;
-mkdir "pteerslt/path/to/a", 0777;
-mkdir "pteerslt/path/to/a/dir", 0777;
-Cwd::chdir "pteerslt/path/to/a/dir";
-my $cwd        = cwd;
-my $getcwd     = getcwd;
-my $fastcwd    = fastcwd;
-my $fastgetcwd = fastgetcwd;
-my $want = "t/pteerslt/path/to/a/dir";
-print "# cwd        = '$cwd'\n";
-print "# getcwd     = '$getcwd'\n";
-print "# fastcwd    = '$fastcwd'\n";
-print "# fastgetcwd = '$fastgetcwd'\n";
-# This checked out OK on ODS-2 and ODS-5:
-$want = "T\.PTEERSLT\.PATH\.TO\.A\.DIR\]" if $^O eq 'VMS';
-print +($cwd        =~ m|$want$| ? "" : "not "), "ok 7\n";
-print +($getcwd     =~ m|$want$| ? "" : "not "), "ok 8\n";
-print +($fastcwd    =~ m|$want$| ? "" : "not "), "ok 9\n";
-print +($fastgetcwd =~ m|$want$| ? "" : "not "), "ok 10\n";
-
-# Cwd::chdir should also update $ENV{PWD}
-print "#$ENV{PWD}\n";
-print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n";
-Cwd::chdir ".."; rmdir "dir";
-print "#$ENV{PWD}\n";
-Cwd::chdir ".."; rmdir "a";
-print "#$ENV{PWD}\n";
-Cwd::chdir ".."; rmdir "to";
-print "#$ENV{PWD}\n";
-Cwd::chdir ".."; rmdir "path";
-print "#$ENV{PWD}\n";
-Cwd::chdir ".."; rmdir "pteerslt";
-print "#$ENV{PWD}\n";
-if ($^O eq 'VMS') {
-    # This checked out OK on ODS-2 and ODS-5:
-    print +($ENV{PWD}  =~ m|\bT\]$| ? "" : "not "), "ok 12\n";
-}
-else {
-    print +($ENV{PWD}  =~ m|\bt$| ? "" : "not "), "ok 12\n";
-}
-
-if ($Config{d_symlink}) {
-    mkdir "pteerslt", 0777;
-    mkdir "pteerslt/path", 0777;
-    mkdir "pteerslt/path/to", 0777;
-    mkdir "pteerslt/path/to/a", 0777;
-    mkdir "pteerslt/path/to/a/dir", 0777;
-    symlink "pteerslt/path/to/a/dir" => "linktest";
-
-    my $abs_path      =  Cwd::abs_path("linktest");
-    my $fast_abs_path =  Cwd::fast_abs_path("linktest");
-    my $want          = "t/pteerslt/path/to/a/dir";
-
-    print "# abs_path      $abs_path\n";
-    print "# fast_abs_path $fast_abs_path\n";
-    print "# want          $want\n";
-    print +($abs_path      =~ m|$want$| ? "" : "not "), "ok 13\n";
-    print +($fast_abs_path =~ m|$want$| ? "" : "not "), "ok 14\n";
-
-    rmdir "pteerslt/path/to/a/dir";
-    rmdir "pteerslt/path/to/a";
-    rmdir "pteerslt/path/to";
-    rmdir "pteerslt/path";
-    rmdir "pteerslt";
-    unlink "linktest";
-} else {
-    print "ok 13 # skipped\n";
-    print "ok 14 # skipped\n";
-}

diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t
deleted file mode 100755 (executable)
index 4b4a796..0000000
--- a/t/lib/db-btree.t
+++ /dev/null
@@ -1,1296 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bDB_File\b/) {
-       print "1..0 # Skip: DB_File was not built\n";
-       exit 0;
-    }
-}
-
-use warnings;
-use strict;
-use DB_File; 
-use Fcntl;
-
-print "1..157\n";
-
-sub ok
-{
-    my $no = shift ;
-    my $result = shift ;
- 
-    print "not " unless $result ;
-    print "ok $no\n" ;
-}
-
-sub lexical
-{
-    my(@a) = unpack ("C*", $a) ;
-    my(@b) = unpack ("C*", $b) ;
-
-    my $len = (@a > @b ? @b : @a) ;
-    my $i = 0 ;
-
-    foreach $i ( 0 .. $len -1) {
-        return $a[$i] - $b[$i] if $a[$i] != $b[$i] ;
-    }
-
-    return @a - @b ;
-}
-
-{
-    package Redirect ;
-    use Symbol ;
-
-    sub new
-    {
-        my $class = shift ;
-        my $filename = shift ;
-       my $fh = gensym ;
-       open ($fh, ">$filename") || die "Cannot open $filename: $!" ;
-       my $real_stdout = select($fh) ;
-       return bless [$fh, $real_stdout ] ;
-
-    }
-    sub DESTROY
-    {
-        my $self = shift ;
-       close $self->[0] ;
-       select($self->[1]) ;
-    }
-}
-
-sub docat
-{ 
-    my $file = shift;
-    #local $/ = undef unless wantarray ;
-    open(CAT,$file) || die "Cannot open $file: $!";
-    my @result = <CAT>;
-    close(CAT);
-    wantarray ? @result : join("", @result) ;
-}   
-
-sub docat_del
-{ 
-    my $file = shift;
-    #local $/ = undef unless wantarray ;
-    open(CAT,$file) || die "Cannot open $file: $!";
-    my @result = <CAT>;
-    close(CAT);
-    unlink $file ;
-    wantarray ? @result : join("", @result) ;
-}   
-
-
-my $db185mode =  ($DB_File::db_version == 1 && ! $DB_File::db_185_compat) ;
-my $null_keys_allowed = ($DB_File::db_ver < 2.004010 
-                               || $DB_File::db_ver >= 3.1 );
-
-my $Dfile = "dbbtree.tmp";
-unlink $Dfile;
-
-umask(0);
-
-# Check the interface to BTREEINFO
-
-my $dbh = new DB_File::BTREEINFO ;
-ok(1, ! defined $dbh->{flags}) ;
-ok(2, ! defined $dbh->{cachesize}) ;
-ok(3, ! defined $dbh->{psize}) ;
-ok(4, ! defined $dbh->{lorder}) ;
-ok(5, ! defined $dbh->{minkeypage}) ;
-ok(6, ! defined $dbh->{maxkeypage}) ;
-ok(7, ! defined $dbh->{compare}) ;
-ok(8, ! defined $dbh->{prefix}) ;
-
-$dbh->{flags} = 3000 ;
-ok(9, $dbh->{flags} == 3000) ;
-
-$dbh->{cachesize} = 9000 ;
-ok(10, $dbh->{cachesize} == 9000);
-
-$dbh->{psize} = 400 ;
-ok(11, $dbh->{psize} == 400) ;
-
-$dbh->{lorder} = 65 ;
-ok(12, $dbh->{lorder} == 65) ;
-
-$dbh->{minkeypage} = 123 ;
-ok(13, $dbh->{minkeypage} == 123) ;
-
-$dbh->{maxkeypage} = 1234 ;
-ok(14, $dbh->{maxkeypage} == 1234 );
-
-$dbh->{compare} = 1234 ;
-ok(15, $dbh->{compare} == 1234) ;
-
-$dbh->{prefix} = 1234 ;
-ok(16, $dbh->{prefix} == 1234 );
-
-# Check that an invalid entry is caught both for store & fetch
-eval '$dbh->{fred} = 1234' ;
-ok(17, $@ =~ /^DB_File::BTREEINFO::STORE - Unknown element 'fred' at/ ) ;
-eval 'my $q = $dbh->{fred}' ;
-ok(18, $@ =~ /^DB_File::BTREEINFO::FETCH - Unknown element 'fred' at/ ) ;
-
-# Now check the interface to BTREE
-
-my ($X, %h) ;
-ok(19, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ;
-
-my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-ok(20, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare');
-
-my ($key, $value, $i);
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-ok(21, !$i ) ;
-
-$h{'goner1'} = 'snork';
-
-$h{'abc'} = 'ABC';
-ok(22, $h{'abc'} eq 'ABC' );
-ok(23, ! defined $h{'jimmy'} ) ;
-ok(24, ! exists $h{'jimmy'} ) ;
-ok(25,  defined $h{'abc'} ) ;
-
-$h{'def'} = 'DEF';
-$h{'jkl','mno'} = "JKL\034MNO";
-$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
-$h{'a'} = 'A';
-
-#$h{'b'} = 'B';
-$X->STORE('b', 'B') ;
-
-$h{'c'} = 'C';
-
-#$h{'d'} = 'D';
-$X->put('d', 'D') ;
-
-$h{'e'} = 'E';
-$h{'f'} = 'F';
-$h{'g'} = 'X';
-$h{'h'} = 'H';
-$h{'i'} = 'I';
-
-$h{'goner2'} = 'snork';
-delete $h{'goner2'};
-
-
-# IMPORTANT - $X must be undefined before the untie otherwise the
-#             underlying DB close routine will not get called.
-undef $X ;
-untie(%h);
-
-# tie to the same file again
-ok(26, $X = tie(%h,'DB_File',$Dfile, O_RDWR, 0640, $DB_BTREE)) ;
-
-# Modify an entry from the previous tie
-$h{'g'} = 'G';
-
-$h{'j'} = 'J';
-$h{'k'} = 'K';
-$h{'l'} = 'L';
-$h{'m'} = 'M';
-$h{'n'} = 'N';
-$h{'o'} = 'O';
-$h{'p'} = 'P';
-$h{'q'} = 'Q';
-$h{'r'} = 'R';
-$h{'s'} = 'S';
-$h{'t'} = 'T';
-$h{'u'} = 'U';
-$h{'v'} = 'V';
-$h{'w'} = 'W';
-$h{'x'} = 'X';
-$h{'y'} = 'Y';
-$h{'z'} = 'Z';
-
-$h{'goner3'} = 'snork';
-
-delete $h{'goner1'};
-$X->DELETE('goner3');
-
-my @keys = keys(%h);
-my @values = values(%h);
-
-ok(27, $#keys == 29 && $#values == 29) ;
-
-$i = 0 ;
-while (($key,$value) = each(%h)) {
-    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
-       $key =~ y/a-z/A-Z/;
-       $i++ if $key eq $value;
-    }
-}
-
-ok(28, $i == 30) ;
-
-@keys = ('blurfl', keys(%h), 'dyick');
-ok(29, $#keys == 31) ;
-
-#Check that the keys can be retrieved in order
-my @b = keys %h ;
-my @c = sort lexical @b ;
-ok(30, ArrayCompare(\@b, \@c)) ;
-
-$h{'foo'} = '';
-ok(31, $h{'foo'} eq '' ) ;
-
-# Berkeley DB from version 2.4.10 to 3.0 does not allow null keys.
-# This feature was reenabled in version 3.1 of Berkeley DB.
-my $result = 0 ;
-if ($null_keys_allowed) {
-    $h{''} = 'bar';
-    $result = ( $h{''} eq 'bar' );
-}
-else
-  { $result = 1 }
-ok(32, $result) ;
-
-# check cache overflow and numeric keys and contents
-my $ok = 1;
-for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
-for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
-ok(33, $ok);
-
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-ok(34, $size > 0 );
-
-@h{0..200} = 200..400;
-my @foo = @h{0..200};
-ok(35, join(':',200..400) eq join(':',@foo) );
-
-# Now check all the non-tie specific stuff
-
-
-# Check R_NOOVERWRITE flag will make put fail when attempting to overwrite
-# an existing record.
- 
-my $status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ;
-ok(36, $status == 1 );
- 
-# check that the value of the key 'x' has not been changed by the 
-# previous test
-ok(37, $h{'x'} eq 'X' );
-
-# standard put
-$status = $X->put('key', 'value') ;
-ok(38, $status == 0 );
-
-#check that previous put can be retrieved
-$value = 0 ;
-$status = $X->get('key', $value) ;
-ok(39, $status == 0 );
-ok(40, $value eq 'value' );
-
-# Attempting to delete an existing key should work
-
-$status = $X->del('q') ;
-ok(41, $status == 0 );
-if ($null_keys_allowed) {
-    $status = $X->del('') ;
-} else {
-    $status = 0 ;
-}
-ok(42, $status == 0 );
-
-# Make sure that the key deleted, cannot be retrieved
-ok(43, ! defined $h{'q'}) ;
-ok(44, ! defined $h{''}) ;
-
-undef $X ;
-untie %h ;
-
-ok(45, $X = tie(%h, 'DB_File',$Dfile, O_RDWR, 0640, $DB_BTREE ));
-
-# Attempting to delete a non-existant key should fail
-
-$status = $X->del('joe') ;
-ok(46, $status == 1 );
-
-# Check the get interface
-
-# First a non-existing key
-$status = $X->get('aaaa', $value) ;
-ok(47, $status == 1 );
-
-# Next an existing key
-$status = $X->get('a', $value) ;
-ok(48, $status == 0 );
-ok(49, $value eq 'A' );
-
-# seq
-# ###
-
-# use seq to find an approximate match
-$key = 'ke' ;
-$value = '' ;
-$status = $X->seq($key, $value, R_CURSOR) ;
-ok(50, $status == 0 );
-ok(51, $key eq 'key' );
-ok(52, $value eq 'value' );
-
-# seq when the key does not match
-$key = 'zzz' ;
-$value = '' ;
-$status = $X->seq($key, $value, R_CURSOR) ;
-ok(53, $status == 1 );
-
-
-# use seq to set the cursor, then delete the record @ the cursor.
-
-$key = 'x' ;
-$value = '' ;
-$status = $X->seq($key, $value, R_CURSOR) ;
-ok(54, $status == 0 );
-ok(55, $key eq 'x' );
-ok(56, $value eq 'X' );
-$status = $X->del(0, R_CURSOR) ;
-ok(57, $status == 0 );
-$status = $X->get('x', $value) ;
-ok(58, $status == 1 );
-
-# ditto, but use put to replace the key/value pair.
-$key = 'y' ;
-$value = '' ;
-$status = $X->seq($key, $value, R_CURSOR) ;
-ok(59, $status == 0 );
-ok(60, $key eq 'y' );
-ok(61, $value eq 'Y' );
-
-$key = "replace key" ;
-$value = "replace value" ;
-$status = $X->put($key, $value, R_CURSOR) ;
-ok(62, $status == 0 );
-ok(63, $key eq 'replace key' );
-ok(64, $value eq 'replace value' );
-$status = $X->get('y', $value) ;
-ok(65, 1) ; # hard-wire to always pass. the previous test ($status == 1)
-           # only worked because of a bug in 1.85/6
-
-# use seq to walk forwards through a file 
-
-$status = $X->seq($key, $value, R_FIRST) ;
-ok(66, $status == 0 );
-my $previous = $key ;
-
-$ok = 1 ;
-while (($status = $X->seq($key, $value, R_NEXT)) == 0)
-{
-    ($ok = 0), last if ($previous cmp $key) == 1 ;
-}
-
-ok(67, $status == 1 );
-ok(68, $ok == 1 );
-
-# use seq to walk backwards through a file 
-$status = $X->seq($key, $value, R_LAST) ;
-ok(69, $status == 0 );
-$previous = $key ;
-
-$ok = 1 ;
-while (($status = $X->seq($key, $value, R_PREV)) == 0)
-{
-    ($ok = 0), last if ($previous cmp $key) == -1 ;
-    #print "key = [$key] value = [$value]\n" ;
-}
-
-ok(70, $status == 1 );
-ok(71, $ok == 1 );
-
-
-# check seq FIRST/LAST
-
-# sync
-# ####
-
-$status = $X->sync ;
-ok(72, $status == 0 );
-
-
-# fd
-# ##
-
-$status = $X->fd ;
-ok(73, $status != 0 );
-
-
-undef $X ;
-untie %h ;
-
-unlink $Dfile;
-
-# Now try an in memory file
-my $Y;
-ok(74, $Y = tie(%h, 'DB_File',undef, O_RDWR|O_CREAT, 0640, $DB_BTREE ));
-
-# fd with an in memory file should return failure
-$status = $Y->fd ;
-ok(75, $status == -1 );
-
-
-undef $Y ;
-untie %h ;
-
-# Duplicate keys
-my $bt = new DB_File::BTREEINFO ;
-$bt->{flags} = R_DUP ;
-my ($YY, %hh);
-ok(76, $YY = tie(%hh, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $bt )) ;
-
-$hh{'Wall'} = 'Larry' ;
-$hh{'Wall'} = 'Stone' ; # Note the duplicate key
-$hh{'Wall'} = 'Brick' ; # Note the duplicate key
-$hh{'Wall'} = 'Brick' ; # Note the duplicate key and value
-$hh{'Smith'} = 'John' ;
-$hh{'mouse'} = 'mickey' ;
-
-# first work in scalar context
-ok(77, scalar $YY->get_dup('Unknown') == 0 );
-ok(78, scalar $YY->get_dup('Smith') == 1 );
-ok(79, scalar $YY->get_dup('Wall') == 4 );
-
-# now in list context
-my @unknown = $YY->get_dup('Unknown') ;
-ok(80, "@unknown" eq "" );
-
-my @smith = $YY->get_dup('Smith') ;
-ok(81, "@smith" eq "John" );
-
-{
-my @wall = $YY->get_dup('Wall') ;
-my %wall ;
-@wall{@wall} = @wall ;
-ok(82, (@wall == 4 && $wall{'Larry'} && $wall{'Stone'} && $wall{'Brick'}) );
-}
-
-# hash
-my %unknown = $YY->get_dup('Unknown', 1) ;
-ok(83, keys %unknown == 0 );
-
-my %smith = $YY->get_dup('Smith', 1) ;
-ok(84, keys %smith == 1 && $smith{'John'}) ;
-
-my %wall = $YY->get_dup('Wall', 1) ;
-ok(85, keys %wall == 3 && $wall{'Larry'} == 1 && $wall{'Stone'} == 1 
-               && $wall{'Brick'} == 2);
-
-undef $YY ;
-untie %hh ;
-unlink $Dfile;
-
-
-# test multiple callbacks
-my $Dfile1 = "btree1" ;
-my $Dfile2 = "btree2" ;
-my $Dfile3 = "btree3" ;
- 
-my $dbh1 = new DB_File::BTREEINFO ;
-$dbh1->{compare} = sub { 
-       no warnings 'numeric' ;
-       $_[0] <=> $_[1] } ; 
- 
-my $dbh2 = new DB_File::BTREEINFO ;
-$dbh2->{compare} = sub { $_[0] cmp $_[1] } ;
- 
-my $dbh3 = new DB_File::BTREEINFO ;
-$dbh3->{compare} = sub { length $_[0] <=> length $_[1] } ;
- 
- 
-my (%g, %k);
-tie(%h, 'DB_File',$Dfile1, O_RDWR|O_CREAT, 0640, $dbh1 ) ; 
-tie(%g, 'DB_File',$Dfile2, O_RDWR|O_CREAT, 0640, $dbh2 ) ;
-tie(%k, 'DB_File',$Dfile3, O_RDWR|O_CREAT, 0640, $dbh3 ) ;
- 
-my @Keys = qw( 0123 12 -1234 9 987654321 def  ) ;
-my (@srt_1, @srt_2, @srt_3);
-{ 
-  no warnings 'numeric' ;
-  @srt_1 = sort { $a <=> $b } @Keys ; 
-}
-@srt_2 = sort { $a cmp $b } @Keys ;
-@srt_3 = sort { length $a <=> length $b } @Keys ;
- 
-foreach (@Keys) {
-    $h{$_} = 1 ;
-    $g{$_} = 1 ;
-    $k{$_} = 1 ;
-}
- 
-sub ArrayCompare
-{
-    my($a, $b) = @_ ;
- 
-    return 0 if @$a != @$b ;
- 
-    foreach (1 .. length @$a)
-    {
-        return 0 unless $$a[$_] eq $$b[$_] ;
-    }
- 
-    1 ;
-}
- 
-ok(86, ArrayCompare (\@srt_1, [keys %h]) );
-ok(87, ArrayCompare (\@srt_2, [keys %g]) );
-ok(88, ArrayCompare (\@srt_3, [keys %k]) );
-
-untie %h ;
-untie %g ;
-untie %k ;
-unlink $Dfile1, $Dfile2, $Dfile3 ;
-
-# clear
-# #####
-
-ok(89, tie(%h, 'DB_File', $Dfile1, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-foreach (1 .. 10)
-  { $h{$_} = $_ * 100 }
-
-# check that there are 10 elements in the hash
-$i = 0 ;
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-ok(90, $i == 10);
-
-# now clear the hash
-%h = () ;
-
-# check it is empty
-$i = 0 ;
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-ok(91, $i == 0);
-
-untie %h ;
-unlink $Dfile1 ;
-
-{
-    # check that attempting to tie an array to a DB_BTREE will fail
-
-    my $filename = "xyz" ;
-    my @x ;
-    eval { tie @x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE ; } ;
-    ok(92, $@ =~ /^DB_File can only tie an associative array to a DB_BTREE database/) ;
-    unlink $filename ;
-}
-
-{
-   # sub-class test
-
-   package Another ;
-
-   use warnings ;
-   use strict ;
-
-   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
-   print FILE <<'EOM' ;
-
-   package SubDB ;
-
-   use warnings ;
-   use strict ;
-   use vars qw( @ISA @EXPORT) ;
-
-   require Exporter ;
-   use DB_File;
-   @ISA=qw(DB_File);
-   @EXPORT = @DB_File::EXPORT ;
-
-   sub STORE { 
-       my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::STORE($key, $value * 2) ;
-   }
-
-   sub FETCH { 
-       my $self = shift ;
-        my $key = shift ;
-        $self->SUPER::FETCH($key) - 1 ;
-   }
-
-   sub put { 
-       my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::put($key, $value * 3) ;
-   }
-
-   sub get { 
-       my $self = shift ;
-        $self->SUPER::get($_[0], $_[1]) ;
-       $_[1] -= 2 ;
-   }
-
-   sub A_new_method
-   {
-       my $self = shift ;
-        my $key = shift ;
-        my $value = $self->FETCH($key) ;
-       return "[[$value]]" ;
-   }
-
-   1 ;
-EOM
-
-    close FILE ;
-
-    BEGIN { push @INC, '.'; }    
-    eval 'use SubDB ; ';
-    main::ok(93, $@ eq "") ;
-    my %h ;
-    my $X ;
-    eval '
-       $X = tie(%h, "SubDB","dbbtree.tmp", O_RDWR|O_CREAT, 0640, $DB_BTREE );
-       ' ;
-
-    main::ok(94, $@ eq "") ;
-
-    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
-    main::ok(95, $@ eq "") ;
-    main::ok(96, $ret == 5) ;
-
-    my $value = 0;
-    $ret = eval '$X->put("joe", 4) ; $X->get("joe", $value) ; return $value' ;
-    main::ok(97, $@ eq "") ;
-    main::ok(98, $ret == 10) ;
-
-    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
-    main::ok(99, $@ eq "" ) ;
-    main::ok(100, $ret == 1) ;
-
-    $ret = eval '$X->A_new_method("joe") ' ;
-    main::ok(101, $@ eq "") ;
-    main::ok(102, $ret eq "[[11]]") ;
-
-    undef $X;
-    untie(%h);
-    unlink "SubDB.pm", "dbbtree.tmp" ;
-
-}
-
-{
-   # DBM Filter tests
-   use warnings ;
-   use strict ;
-   my (%h, $db) ;
-   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   unlink $Dfile;
-
-   sub checkOutput
-   {
-       my($fk, $sk, $fv, $sv) = @_ ;
-       return
-           $fetch_key eq $fk && $store_key eq $sk && 
-          $fetch_value eq $fv && $store_value eq $sv &&
-          $_ eq 'original' ;
-   }
-   
-   ok(103, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-
-   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
-   $db->filter_store_key   (sub { $store_key = $_ }) ;
-   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
-   $db->filter_store_value (sub { $store_value = $_ }) ;
-
-   $_ = "original" ;
-
-   $h{"fred"} = "joe" ;
-   #                   fk   sk     fv   sv
-   ok(104, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(105, $h{"fred"} eq "joe");
-   #                   fk    sk     fv    sv
-   ok(106, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(107, $db->FIRSTKEY() eq "fred") ;
-   #                    fk     sk  fv  sv
-   ok(108, checkOutput( "fred", "", "", "")) ;
-
-   # replace the filters, but remember the previous set
-   my ($old_fk) = $db->filter_fetch_key   
-                       (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
-   my ($old_sk) = $db->filter_store_key   
-                       (sub { $_ = lc $_ ; $store_key = $_ }) ;
-   my ($old_fv) = $db->filter_fetch_value 
-                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
-   my ($old_sv) = $db->filter_store_value 
-                       (sub { s/o/x/g; $store_value = $_ }) ;
-   
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"Fred"} = "Joe" ;
-   #                   fk   sk     fv    sv
-   ok(109, checkOutput( "", "fred", "", "Jxe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(110, $h{"Fred"} eq "[Jxe]");
-   #                   fk   sk     fv    sv
-   ok(111, checkOutput( "", "fred", "[Jxe]", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(112, $db->FIRSTKEY() eq "FRED") ;
-   #                   fk   sk     fv    sv
-   ok(113, checkOutput( "FRED", "", "", "")) ;
-
-   # put the original filters back
-   $db->filter_fetch_key   ($old_fk);
-   $db->filter_store_key   ($old_sk);
-   $db->filter_fetch_value ($old_fv);
-   $db->filter_store_value ($old_sv);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"fred"} = "joe" ;
-   ok(114, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(115, $h{"fred"} eq "joe");
-   ok(116, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(117, $db->FIRSTKEY() eq "fred") ;
-   ok(118, checkOutput( "fred", "", "", "")) ;
-
-   # delete the filters
-   $db->filter_fetch_key   (undef);
-   $db->filter_store_key   (undef);
-   $db->filter_fetch_value (undef);
-   $db->filter_store_value (undef);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"fred"} = "joe" ;
-   ok(119, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(120, $h{"fred"} eq "joe");
-   ok(121, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(122, $db->FIRSTKEY() eq "fred") ;
-   ok(123, checkOutput( "", "", "", "")) ;
-
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-{    
-    # DBM Filter with a closure
-
-    use warnings ;
-    use strict ;
-    my (%h, $db) ;
-
-    unlink $Dfile;
-    ok(124, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-
-    my %result = () ;
-
-    sub Closure
-    {
-        my ($name) = @_ ;
-       my $count = 0 ;
-       my @kept = () ;
-
-       return sub { ++$count ; 
-                    push @kept, $_ ; 
-                    $result{$name} = "$name - $count: [@kept]" ;
-                  }
-    }
-
-    $db->filter_store_key(Closure("store key")) ;
-    $db->filter_store_value(Closure("store value")) ;
-    $db->filter_fetch_key(Closure("fetch key")) ;
-    $db->filter_fetch_value(Closure("fetch value")) ;
-
-    $_ = "original" ;
-
-    $h{"fred"} = "joe" ;
-    ok(125, $result{"store key"} eq "store key - 1: [fred]");
-    ok(126, $result{"store value"} eq "store value - 1: [joe]");
-    ok(127, ! defined $result{"fetch key"} );
-    ok(128, ! defined $result{"fetch value"} );
-    ok(129, $_ eq "original") ;
-
-    ok(130, $db->FIRSTKEY() eq "fred") ;
-    ok(131, $result{"store key"} eq "store key - 1: [fred]");
-    ok(132, $result{"store value"} eq "store value - 1: [joe]");
-    ok(133, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(134, ! defined $result{"fetch value"} );
-    ok(135, $_ eq "original") ;
-
-    $h{"jim"}  = "john" ;
-    ok(136, $result{"store key"} eq "store key - 2: [fred jim]");
-    ok(137, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(138, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(139, ! defined $result{"fetch value"} );
-    ok(140, $_ eq "original") ;
-
-    ok(141, $h{"fred"} eq "joe");
-    ok(142, $result{"store key"} eq "store key - 3: [fred jim fred]");
-    ok(143, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(144, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(145, $result{"fetch value"} eq "fetch value - 1: [joe]");
-    ok(146, $_ eq "original") ;
-
-    undef $db ;
-    untie %h;
-    unlink $Dfile;
-}              
-
-{
-   # DBM Filter recursion detection
-   use warnings ;
-   use strict ;
-   my (%h, $db) ;
-   unlink $Dfile;
-
-   ok(147, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-
-   $db->filter_store_key (sub { $_ = $h{$_} }) ;
-
-   eval '$h{1} = 1234' ;
-   ok(148, $@ =~ /^recursion detected in filter_store_key at/ );
-   
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-
-{
-   # Examples from the POD
-
-
-  my $file = "xyzt" ;
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 1
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
-
-    my %h ;
-
-    sub Compare
-    {
-        my ($key1, $key2) = @_ ;
-        "\L$key1" cmp "\L$key2" ;
-    }
-
-    # specify the Perl sub that will do the comparison
-    $DB_BTREE->{'compare'} = \&Compare ;
-
-    unlink "tree" ;
-    tie %h, "DB_File", "tree", O_RDWR|O_CREAT, 0640, $DB_BTREE 
-        or die "Cannot open file 'tree': $!\n" ;
-
-    # Add a key/value pair to the file
-    $h{'Wall'} = 'Larry' ;
-    $h{'Smith'} = 'John' ;
-    $h{'mouse'} = 'mickey' ;
-    $h{'duck'}  = 'donald' ;
-
-    # Delete
-    delete $h{"duck"} ;
-
-    # Cycle through the keys printing them in order.
-    # Note it is not necessary to sort the keys as
-    # the btree will have kept them in order automatically.
-    foreach (keys %h)
-      { print "$_\n" }
-
-    untie %h ;
-
-    unlink "tree" ;
-  }  
-
-  delete $DB_BTREE->{'compare'} ;
-
-  ok(149, docat_del($file) eq <<'EOM') ;
-mouse
-Smith
-Wall
-EOM
-   
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 2
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
-
-    use vars qw($filename %h ) ;
-
-    $filename = "tree" ;
-    unlink $filename ;
- 
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
- 
-    tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
-       or die "Cannot open $filename: $!\n";
- 
-    # Add some key/value pairs to the file
-    $h{'Wall'} = 'Larry' ;
-    $h{'Wall'} = 'Brick' ; # Note the duplicate key
-    $h{'Wall'} = 'Brick' ; # Note the duplicate key and value
-    $h{'Smith'} = 'John' ;
-    $h{'mouse'} = 'mickey' ;
-
-    # iterate through the associative array
-    # and print each key/value pair.
-    foreach (keys %h)
-      { print "$_      -> $h{$_}\n" }
-
-    untie %h ;
-
-    unlink $filename ;
-  }  
-
-  ok(150, docat_del($file) eq ($db185mode ? <<'EOM' : <<'EOM') ) ;
-Smith  -> John
-Wall   -> Brick
-Wall   -> Brick
-Wall   -> Brick
-mouse  -> mickey
-EOM
-Smith  -> John
-Wall   -> Larry
-Wall   -> Larry
-Wall   -> Larry
-mouse  -> mickey
-EOM
-
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 3
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
- 
-    use vars qw($filename $x %h $status $key $value) ;
-
-    $filename = "tree" ;
-    unlink $filename ;
- 
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
- 
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
-       or die "Cannot open $filename: $!\n";
- 
-    # Add some key/value pairs to the file
-    $h{'Wall'} = 'Larry' ;
-    $h{'Wall'} = 'Brick' ; # Note the duplicate key
-    $h{'Wall'} = 'Brick' ; # Note the duplicate key and value
-    $h{'Smith'} = 'John' ;
-    $h{'mouse'} = 'mickey' ;
- 
-    # iterate through the btree using seq
-    # and print each key/value pair.
-    $key = $value = 0 ;
-    for ($status = $x->seq($key, $value, R_FIRST) ;
-         $status == 0 ;
-         $status = $x->seq($key, $value, R_NEXT) )
-      {  print "$key   -> $value\n" }
- 
- 
-    undef $x ;
-    untie %h ;
-  }
-
-  ok(151, docat_del($file) eq ($db185mode == 1 ? <<'EOM' : <<'EOM') ) ;
-Smith  -> John
-Wall   -> Brick
-Wall   -> Brick
-Wall   -> Larry
-mouse  -> mickey
-EOM
-Smith  -> John
-Wall   -> Larry
-Wall   -> Brick
-Wall   -> Brick
-mouse  -> mickey
-EOM
-
-
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 4
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
- 
-    use vars qw($filename $x %h ) ;
-
-    $filename = "tree" ;
- 
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
- 
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
-       or die "Cannot open $filename: $!\n";
- 
-    my $cnt  = $x->get_dup("Wall") ;
-    print "Wall occurred $cnt times\n" ;
-
-    my %hash = $x->get_dup("Wall", 1) ;
-    print "Larry is there\n" if $hash{'Larry'} ;
-    print "There are $hash{'Brick'} Brick Walls\n" ;
-
-    my @list = sort $x->get_dup("Wall") ;
-    print "Wall =>     [@list]\n" ;
-
-    @list = $x->get_dup("Smith") ;
-    print "Smith =>    [@list]\n" ;
- 
-    @list = $x->get_dup("Dog") ;
-    print "Dog =>      [@list]\n" ; 
- 
-    undef $x ;
-    untie %h ;
-  }
-
-  ok(152, docat_del($file) eq <<'EOM') ;
-Wall occurred 3 times
-Larry is there
-There are 2 Brick Walls
-Wall =>        [Brick Brick Larry]
-Smith =>       [John]
-Dog => []
-EOM
-
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 5
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
- 
-    use vars qw($filename $x %h $found) ;
-
-    my $filename = "tree" ;
- 
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
- 
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
-       or die "Cannot open $filename: $!\n";
-
-    $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ; 
-    print "Larry Wall is $found there\n" ;
-    
-    $found = ( $x->find_dup("Wall", "Harry") == 0 ? "" : "not") ; 
-    print "Harry Wall is $found there\n" ;
-    
-    undef $x ;
-    untie %h ;
-  }
-
-  ok(153, docat_del($file) eq <<'EOM') ;
-Larry Wall is  there
-Harry Wall is not there
-EOM
-
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 6
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
- 
-    use vars qw($filename $x %h $found) ;
-
-    my $filename = "tree" ;
- 
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
- 
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
-       or die "Cannot open $filename: $!\n";
-
-    $x->del_dup("Wall", "Larry") ;
-
-    $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ; 
-    print "Larry Wall is $found there\n" ;
-    
-    undef $x ;
-    untie %h ;
-
-    unlink $filename ;
-  }
-
-  ok(154, docat_del($file) eq <<'EOM') ;
-Larry Wall is not there
-EOM
-
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 7
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
-    use Fcntl ;
-
-    use vars qw($filename $x %h $st $key $value) ;
-
-    sub match
-    {
-        my $key = shift ;
-        my $value = 0;
-        my $orig_key = $key ;
-        $x->seq($key, $value, R_CURSOR) ;
-        print "$orig_key\t-> $key\t-> $value\n" ;
-    }
-
-    $filename = "tree" ;
-    unlink $filename ;
-
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE
-        or die "Cannot open $filename: $!\n";
- 
-    # Add some key/value pairs to the file
-    $h{'mouse'} = 'mickey' ;
-    $h{'Wall'} = 'Larry' ;
-    $h{'Walls'} = 'Brick' ; 
-    $h{'Smith'} = 'John' ;
- 
-
-    $key = $value = 0 ;
-    print "IN ORDER\n" ;
-    for ($st = $x->seq($key, $value, R_FIRST) ;
-        $st == 0 ;
-         $st = $x->seq($key, $value, R_NEXT) )
-       
-      {  print "$key   -> $value\n" }
- 
-    print "\nPARTIAL MATCH\n" ;
-
-    match "Wa" ;
-    match "A" ;
-    match "a" ;
-
-    undef $x ;
-    untie %h ;
-
-    unlink $filename ;
-
-  }
-
-  ok(155, docat_del($file) eq <<'EOM') ;
-IN ORDER
-Smith  -> John
-Wall   -> Larry
-Walls  -> Brick
-mouse  -> mickey
-
-PARTIAL MATCH
-Wa     -> Wall -> Larry
-A      -> Smith        -> John
-a      -> mouse        -> mickey
-EOM
-
-}
-
-#{
-#   # R_SETCURSOR
-#   use strict ;
-#   my (%h, $db) ;
-#   unlink $Dfile;
-#
-#   ok(156, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-#
-#   $h{abc} = 33 ;
-#   my $k = "newest" ;
-#   my $v = 44 ;
-#   my $status = $db->put($k, $v, R_SETCURSOR) ;
-#   print "status = [$status]\n" ;
-#   ok(157, $status == 0) ;
-#   $status = $db->del($k, R_CURSOR) ;
-#   print "status = [$status]\n" ;
-#   ok(158, $status == 0) ;
-#   $k = "newest" ;
-#   ok(159, $db->get($k, $v, R_CURSOR)) ;
-#
-#   ok(160, keys %h == 1) ;
-#   
-#   undef $db ;
-#   untie %h;
-#   unlink $Dfile;
-#}
-
-{
-    # Bug ID 20001013.009
-    #
-    # test that $hash{KEY} = undef doesn't produce the warning
-    #     Use of uninitialized value in null operation 
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    unlink $Dfile;
-    my %h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    tie %h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_BTREE
-       or die "Can't open file: $!\n" ;
-    $h{ABC} = undef;
-    ok(156, $a eq "") ;
-    untie %h ;
-    unlink $Dfile;
-}
-
-{
-    # test that %hash = () doesn't produce the warning
-    #     Argument "" isn't numeric in entersub
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    unlink $Dfile;
-    my %h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    tie %h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_BTREE
-       or die "Can't open file: $!\n" ;
-    %h = (); ;
-    ok(157, $a eq "") ;
-    untie %h ;
-    unlink $Dfile;
-}
-
-exit ;

diff --git a/t/lib/db-hash.t b/t/lib/db-hash.t
deleted file mode 100755 (executable)
index 6f2ef37..0000000
--- a/t/lib/db-hash.t
+++ /dev/null
@@ -1,743 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bDB_File\b/) {
-       print "1..0 # Skip: DB_File was not built\n";
-       exit 0;
-    }
-}
-
-use strict;
-use warnings;
-use DB_File; 
-use Fcntl;
-
-print "1..111\n";
-
-sub ok
-{
-    my $no = shift ;
-    my $result = shift ;
- 
-    print "not " unless $result ;
-    print "ok $no\n" ;
-}
-
-{
-    package Redirect ;
-    use Symbol ;
-
-    sub new
-    {
-        my $class = shift ;
-        my $filename = shift ;
-       my $fh = gensym ;
-       open ($fh, ">$filename") || die "Cannot open $filename: $!" ;
-       my $real_stdout = select($fh) ;
-       return bless [$fh, $real_stdout ] ;
-
-    }
-    sub DESTROY
-    {
-        my $self = shift ;
-       close $self->[0] ;
-       select($self->[1]) ;
-    }
-}
-
-sub docat_del
-{ 
-    my $file = shift;
-    local $/ = undef;
-    open(CAT,$file) || die "Cannot open $file: $!";
-    my $result = <CAT>;
-    close(CAT);
-    unlink $file ;
-    return $result;
-}   
-
-my $Dfile = "dbhash.tmp";
-my $null_keys_allowed = ($DB_File::db_ver < 2.004010 
-                               || $DB_File::db_ver >= 3.1 );
-
-unlink $Dfile;
-
-umask(0);
-
-# Check the interface to HASHINFO
-
-my $dbh = new DB_File::HASHINFO ;
-
-ok(1, ! defined $dbh->{bsize}) ;
-ok(2, ! defined $dbh->{ffactor}) ;
-ok(3, ! defined $dbh->{nelem}) ;
-ok(4, ! defined $dbh->{cachesize}) ;
-ok(5, ! defined $dbh->{hash}) ;
-ok(6, ! defined $dbh->{lorder}) ;
-
-$dbh->{bsize} = 3000 ;
-ok(7, $dbh->{bsize} == 3000 );
-
-$dbh->{ffactor} = 9000 ;
-ok(8, $dbh->{ffactor} == 9000 );
-
-$dbh->{nelem} = 400 ;
-ok(9, $dbh->{nelem} == 400 );
-
-$dbh->{cachesize} = 65 ;
-ok(10, $dbh->{cachesize} == 65 );
-
-$dbh->{hash} = "abc" ;
-ok(11, $dbh->{hash} eq "abc" );
-
-$dbh->{lorder} = 1234 ;
-ok(12, $dbh->{lorder} == 1234 );
-
-# Check that an invalid entry is caught both for store & fetch
-eval '$dbh->{fred} = 1234' ;
-ok(13, $@ =~ /^DB_File::HASHINFO::STORE - Unknown element 'fred' at/ );
-eval 'my $q = $dbh->{fred}' ;
-ok(14, $@ =~ /^DB_File::HASHINFO::FETCH - Unknown element 'fred' at/ );
-
-
-# Now check the interface to HASH
-my ($X, %h);
-ok(15, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-ok(16, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare');
-
-my ($key, $value, $i);
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-ok(17, !$i );
-
-$h{'goner1'} = 'snork';
-
-$h{'abc'} = 'ABC';
-ok(18, $h{'abc'} eq 'ABC' );
-ok(19, !defined $h{'jimmy'} );
-ok(20, !exists $h{'jimmy'} );
-ok(21, exists $h{'abc'} );
-
-$h{'def'} = 'DEF';
-$h{'jkl','mno'} = "JKL\034MNO";
-$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
-$h{'a'} = 'A';
-
-#$h{'b'} = 'B';
-$X->STORE('b', 'B') ;
-
-$h{'c'} = 'C';
-
-#$h{'d'} = 'D';
-$X->put('d', 'D') ;
-
-$h{'e'} = 'E';
-$h{'f'} = 'F';
-$h{'g'} = 'X';
-$h{'h'} = 'H';
-$h{'i'} = 'I';
-
-$h{'goner2'} = 'snork';
-delete $h{'goner2'};
-
-
-# IMPORTANT - $X must be undefined before the untie otherwise the
-#             underlying DB close routine will not get called.
-undef $X ;
-untie(%h);
-
-
-# tie to the same file again, do not supply a type - should default to HASH
-ok(22, $X = tie(%h,'DB_File',$Dfile, O_RDWR, 0640) );
-
-# Modify an entry from the previous tie
-$h{'g'} = 'G';
-
-$h{'j'} = 'J';
-$h{'k'} = 'K';
-$h{'l'} = 'L';
-$h{'m'} = 'M';
-$h{'n'} = 'N';
-$h{'o'} = 'O';
-$h{'p'} = 'P';
-$h{'q'} = 'Q';
-$h{'r'} = 'R';
-$h{'s'} = 'S';
-$h{'t'} = 'T';
-$h{'u'} = 'U';
-$h{'v'} = 'V';
-$h{'w'} = 'W';
-$h{'x'} = 'X';
-$h{'y'} = 'Y';
-$h{'z'} = 'Z';
-
-$h{'goner3'} = 'snork';
-
-delete $h{'goner1'};
-$X->DELETE('goner3');
-
-my @keys = keys(%h);
-my @values = values(%h);
-
-ok(23, $#keys == 29 && $#values == 29) ;
-
-$i = 0 ;
-while (($key,$value) = each(%h)) {
-    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
-       $key =~ y/a-z/A-Z/;
-       $i++ if $key eq $value;
-    }
-}
-
-ok(24, $i == 30) ;
-
-@keys = ('blurfl', keys(%h), 'dyick');
-ok(25, $#keys == 31) ;
-
-$h{'foo'} = '';
-ok(26, $h{'foo'} eq '' );
-
-# Berkeley DB from version 2.4.10 to 3.0 does not allow null keys.
-# This feature was reenabled in version 3.1 of Berkeley DB.
-my $result = 0 ;
-if ($null_keys_allowed) {
-    $h{''} = 'bar';
-    $result = ( $h{''} eq 'bar' );
-}
-else
-  { $result = 1 }
-ok(27, $result) ;
-
-# check cache overflow and numeric keys and contents
-my $ok = 1;
-for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
-for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
-ok(28, $ok );
-
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-ok(29, $size > 0 );
-
-@h{0..200} = 200..400;
-my @foo = @h{0..200};
-ok(30, join(':',200..400) eq join(':',@foo) );
-
-
-# Now check all the non-tie specific stuff
-
-# Check NOOVERWRITE will make put fail when attempting to overwrite
-# an existing record.
- 
-my $status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ;
-ok(31, $status == 1 );
- 
-# check that the value of the key 'x' has not been changed by the 
-# previous test
-ok(32, $h{'x'} eq 'X' );
-
-# standard put
-$status = $X->put('key', 'value') ;
-ok(33, $status == 0 );
-
-#check that previous put can be retrieved
-$value = 0 ;
-$status = $X->get('key', $value) ;
-ok(34, $status == 0 );
-ok(35, $value eq 'value' );
-
-# Attempting to delete an existing key should work
-
-$status = $X->del('q') ;
-ok(36, $status == 0 );
-
-# Make sure that the key deleted, cannot be retrieved
-{
-    no warnings 'uninitialized' ;
-    ok(37, $h{'q'} eq undef );
-}
-
-# Attempting to delete a non-existant key should fail
-
-$status = $X->del('joe') ;
-ok(38, $status == 1 );
-
-# Check the get interface
-
-# First a non-existing key
-$status = $X->get('aaaa', $value) ;
-ok(39, $status == 1 );
-
-# Next an existing key
-$status = $X->get('a', $value) ;
-ok(40, $status == 0 );
-ok(41, $value eq 'A' );
-
-# seq
-# ###
-
-# ditto, but use put to replace the key/value pair.
-
-# use seq to walk backwards through a file - check that this reversed is
-
-# check seq FIRST/LAST
-
-# sync
-# ####
-
-$status = $X->sync ;
-ok(42, $status == 0 );
-
-
-# fd
-# ##
-
-$status = $X->fd ;
-ok(43, $status != 0 );
-
-undef $X ;
-untie %h ;
-
-unlink $Dfile;
-
-# clear
-# #####
-
-ok(44, tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-foreach (1 .. 10)
-  { $h{$_} = $_ * 100 }
-
-# check that there are 10 elements in the hash
-$i = 0 ;
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-ok(45, $i == 10);
-
-# now clear the hash
-%h = () ;
-
-# check it is empty
-$i = 0 ;
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-ok(46, $i == 0);
-
-untie %h ;
-unlink $Dfile ;
-
-
-# Now try an in memory file
-ok(47, $X = tie(%h, 'DB_File',undef, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-# fd with an in memory file should return fail
-$status = $X->fd ;
-ok(48, $status == -1 );
-
-undef $X ;
-untie %h ;
-
-{
-    # check ability to override the default hashing
-    my %x ;
-    my $filename = "xyz" ;
-    my $hi = new DB_File::HASHINFO ;
-    $::count = 0 ;
-    $hi->{hash} = sub { ++$::count ; length $_[0] } ;
-    ok(49, tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $hi ) ;
-    $h{"abc"} = 123 ;
-    ok(50, $h{"abc"} == 123) ;
-    untie %x ;
-    unlink $filename ;
-    ok(51, $::count >0) ;
-}
-
-{
-    # check that attempting to tie an array to a DB_HASH will fail
-
-    my $filename = "xyz" ;
-    my @x ;
-    eval { tie @x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_HASH ; } ;
-    ok(52, $@ =~ /^DB_File can only tie an associative array to a DB_HASH database/) ;
-    unlink $filename ;
-}
-
-{
-   # sub-class test
-
-   package Another ;
-
-   use warnings ;
-   use strict ;
-
-   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
-   print FILE <<'EOM' ;
-
-   package SubDB ;
-
-   use warnings ;
-   use strict ;
-   use vars qw( @ISA @EXPORT) ;
-
-   require Exporter ;
-   use DB_File;
-   @ISA=qw(DB_File);
-   @EXPORT = @DB_File::EXPORT ;
-
-   sub STORE { 
-       my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::STORE($key, $value * 2) ;
-   }
-
-   sub FETCH { 
-       my $self = shift ;
-        my $key = shift ;
-        $self->SUPER::FETCH($key) - 1 ;
-   }
-
-   sub put { 
-       my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::put($key, $value * 3) ;
-   }
-
-   sub get { 
-       my $self = shift ;
-        $self->SUPER::get($_[0], $_[1]) ;
-       $_[1] -= 2 ;
-   }
-
-   sub A_new_method
-   {
-       my $self = shift ;
-        my $key = shift ;
-        my $value = $self->FETCH($key) ;
-       return "[[$value]]" ;
-   }
-
-   1 ;
-EOM
-
-    close FILE ;
-
-    BEGIN { push @INC, '.'; }             
-    eval 'use SubDB ; ';
-    main::ok(53, $@ eq "") ;
-    my %h ;
-    my $X ;
-    eval '
-       $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640, $DB_HASH );
-       ' ;
-
-    main::ok(54, $@ eq "") ;
-
-    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
-    main::ok(55, $@ eq "") ;
-    main::ok(56, $ret == 5) ;
-
-    my $value = 0;
-    $ret = eval '$X->put("joe", 4) ; $X->get("joe", $value) ; return $value' ;
-    main::ok(57, $@ eq "") ;
-    main::ok(58, $ret == 10) ;
-
-    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
-    main::ok(59, $@ eq "" ) ;
-    main::ok(60, $ret == 1) ;
-
-    $ret = eval '$X->A_new_method("joe") ' ;
-    main::ok(61, $@ eq "") ;
-    main::ok(62, $ret eq "[[11]]") ;
-
-    undef $X;
-    untie(%h);
-    unlink "SubDB.pm", "dbhash.tmp" ;
-
-}
-
-{
-   # DBM Filter tests
-   use warnings ;
-   use strict ;
-   my (%h, $db) ;
-   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   unlink $Dfile;
-
-   sub checkOutput
-   {
-       my($fk, $sk, $fv, $sv) = @_ ;
-       return
-           $fetch_key eq $fk && $store_key eq $sk && 
-          $fetch_value eq $fv && $store_value eq $sv &&
-          $_ eq 'original' ;
-   }
-   
-   ok(63, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
-   $db->filter_store_key   (sub { $store_key = $_ }) ;
-   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
-   $db->filter_store_value (sub { $store_value = $_ }) ;
-
-   $_ = "original" ;
-
-   $h{"fred"} = "joe" ;
-   #                   fk   sk     fv   sv
-   ok(64, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(65, $h{"fred"} eq "joe");
-   #                   fk    sk     fv    sv
-   ok(66, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(67, $db->FIRSTKEY() eq "fred") ;
-   #                    fk     sk  fv  sv
-   ok(68, checkOutput( "fred", "", "", "")) ;
-
-   # replace the filters, but remember the previous set
-   my ($old_fk) = $db->filter_fetch_key   
-                       (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
-   my ($old_sk) = $db->filter_store_key   
-                       (sub { $_ = lc $_ ; $store_key = $_ }) ;
-   my ($old_fv) = $db->filter_fetch_value 
-                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
-   my ($old_sv) = $db->filter_store_value 
-                       (sub { s/o/x/g; $store_value = $_ }) ;
-   
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"Fred"} = "Joe" ;
-   #                   fk   sk     fv    sv
-   ok(69, checkOutput( "", "fred", "", "Jxe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(70, $h{"Fred"} eq "[Jxe]");
-   #                   fk   sk     fv    sv
-   ok(71, checkOutput( "", "fred", "[Jxe]", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(72, $db->FIRSTKEY() eq "FRED") ;
-   #                   fk   sk     fv    sv
-   ok(73, checkOutput( "FRED", "", "", "")) ;
-
-   # put the original filters back
-   $db->filter_fetch_key   ($old_fk);
-   $db->filter_store_key   ($old_sk);
-   $db->filter_fetch_value ($old_fv);
-   $db->filter_store_value ($old_sv);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"fred"} = "joe" ;
-   ok(74, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(75, $h{"fred"} eq "joe");
-   ok(76, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(77, $db->FIRSTKEY() eq "fred") ;
-   ok(78, checkOutput( "fred", "", "", "")) ;
-
-   # delete the filters
-   $db->filter_fetch_key   (undef);
-   $db->filter_store_key   (undef);
-   $db->filter_fetch_value (undef);
-   $db->filter_store_value (undef);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"fred"} = "joe" ;
-   ok(79, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(80, $h{"fred"} eq "joe");
-   ok(81, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(82, $db->FIRSTKEY() eq "fred") ;
-   ok(83, checkOutput( "", "", "", "")) ;
-
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-{    
-    # DBM Filter with a closure
-
-    use warnings ;
-    use strict ;
-    my (%h, $db) ;
-
-    unlink $Dfile;
-    ok(84, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-    my %result = () ;
-
-    sub Closure
-    {
-        my ($name) = @_ ;
-       my $count = 0 ;
-       my @kept = () ;
-
-       return sub { ++$count ; 
-                    push @kept, $_ ; 
-                    $result{$name} = "$name - $count: [@kept]" ;
-                  }
-    }
-
-    $db->filter_store_key(Closure("store key")) ;
-    $db->filter_store_value(Closure("store value")) ;
-    $db->filter_fetch_key(Closure("fetch key")) ;
-    $db->filter_fetch_value(Closure("fetch value")) ;
-
-    $_ = "original" ;
-
-    $h{"fred"} = "joe" ;
-    ok(85, $result{"store key"} eq "store key - 1: [fred]");
-    ok(86, $result{"store value"} eq "store value - 1: [joe]");
-    ok(87, ! defined $result{"fetch key"} );
-    ok(88, ! defined $result{"fetch value"} );
-    ok(89, $_ eq "original") ;
-
-    ok(90, $db->FIRSTKEY() eq "fred") ;
-    ok(91, $result{"store key"} eq "store key - 1: [fred]");
-    ok(92, $result{"store value"} eq "store value - 1: [joe]");
-    ok(93, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(94, ! defined $result{"fetch value"} );
-    ok(95, $_ eq "original") ;
-
-    $h{"jim"}  = "john" ;
-    ok(96, $result{"store key"} eq "store key - 2: [fred jim]");
-    ok(97, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(98, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(99, ! defined $result{"fetch value"} );
-    ok(100, $_ eq "original") ;
-
-    ok(101, $h{"fred"} eq "joe");
-    ok(102, $result{"store key"} eq "store key - 3: [fred jim fred]");
-    ok(103, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(104, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(105, $result{"fetch value"} eq "fetch value - 1: [joe]");
-    ok(106, $_ eq "original") ;
-
-    undef $db ;
-    untie %h;
-    unlink $Dfile;
-}              
-
-{
-   # DBM Filter recursion detection
-   use warnings ;
-   use strict ;
-   my (%h, $db) ;
-   unlink $Dfile;
-
-   ok(107, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-   $db->filter_store_key (sub { $_ = $h{$_} }) ;
-
-   eval '$h{1} = 1234' ;
-   ok(108, $@ =~ /^recursion detected in filter_store_key at/ );
-   
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-
-{
-   # Examples from the POD
-
-  my $file = "xyzt" ;
-  {
-    my $redirect = new Redirect $file ;
-
-    use warnings FATAL => qw(all);
-    use strict ;
-    use DB_File ;
-    use vars qw( %h $k $v ) ;
-
-    unlink "fruit" ;
-    tie %h, "DB_File", "fruit", O_RDWR|O_CREAT, 0640, $DB_HASH 
-        or die "Cannot open file 'fruit': $!\n";
-
-    # Add a few key/value pairs to the file
-    $h{"apple"} = "red" ;
-    $h{"orange"} = "orange" ;
-    $h{"banana"} = "yellow" ;
-    $h{"tomato"} = "red" ;
-
-    # Check for existence of a key
-    print "Banana Exists\n\n" if $h{"banana"} ;
-
-    # Delete a key/value pair.
-    delete $h{"apple"} ;
-
-    # print the contents of the file
-    while (($k, $v) = each %h)
-      { print "$k -> $v\n" }
-
-    untie %h ;
-
-    unlink "fruit" ;
-  }  
-
-  ok(109, docat_del($file) eq <<'EOM') ;
-Banana Exists
-
-orange -> orange
-tomato -> red
-banana -> yellow
-EOM
-   
-}
-
-{
-    # Bug ID 20001013.009
-    #
-    # test that $hash{KEY} = undef doesn't produce the warning
-    #     Use of uninitialized value in null operation 
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    unlink $Dfile;
-    my %h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    tie %h, 'DB_File', $Dfile or die "Can't open file: $!\n" ;
-    $h{ABC} = undef;
-    ok(110, $a eq "") ;
-    untie %h ;
-    unlink $Dfile;
-}
-
-{
-    # test that %hash = () doesn't produce the warning
-    #     Argument "" isn't numeric in entersub
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    unlink $Dfile;
-    my %h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    tie %h, 'DB_File', $Dfile or die "Can't open file: $!\n" ;
-    %h = (); ;
-    ok(111, $a eq "") ;
-    untie %h ;
-    unlink $Dfile;
-}
-
-exit ;

diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t
deleted file mode 100755 (executable)
index 6dd913c..0000000
--- a/t/lib/db-recno.t
+++ /dev/null
@@ -1,889 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bDB_File\b/) {
-       print "1..0 # Skip: DB_File was not built\n";
-       exit 0;
-    }
-}
-
-use DB_File; 
-use Fcntl;
-use strict ;
-use warnings;
-use vars qw($dbh $Dfile $bad_ones $FA) ;
-
-# full tied array support started in Perl 5.004_57
-# Double check to see if it is available.
-
-{
-    sub try::TIEARRAY { bless [], "try" }
-    sub try::FETCHSIZE { $FA = 1 }
-    $FA = 0 ;
-    my @a ; 
-    tie @a, 'try' ;
-    my $a = @a ;
-}
-
-
-sub ok
-{
-    my $no = shift ;
-    my $result = shift ;
-
-    print "not " unless $result ;
-    print "ok $no\n" ;
-
-    return $result ;
-}
-
-{
-    package Redirect ;
-    use Symbol ;
-
-    sub new
-    {
-        my $class = shift ;
-        my $filename = shift ;
-       my $fh = gensym ;
-       open ($fh, ">$filename") || die "Cannot open $filename: $!" ;
-       my $real_stdout = select($fh) ;
-       return bless [$fh, $real_stdout ] ;
-
-    }
-    sub DESTROY
-    {
-        my $self = shift ;
-       close $self->[0] ;
-       select($self->[1]) ;
-    }
-}
-
-sub docat
-{
-    my $file = shift;
-    local $/ = undef;
-    open(CAT,$file) || die "Cannot open $file:$!";
-    my $result = <CAT>;
-    close(CAT);
-    return $result;
-}
-
-sub docat_del
-{ 
-    my $file = shift;
-    local $/ = undef;
-    open(CAT,$file) || die "Cannot open $file: $!";
-    my $result = <CAT>;
-    close(CAT);
-    unlink $file ;
-    return $result;
-}   
-
-sub bad_one
-{
-    print STDERR <<EOM unless $bad_ones++ ;
-#
-# Some older versions of Berkeley DB version 1 will fail tests 51,
-# 53 and 55.
-#
-# You can safely ignore the errors if you're never going to use the
-# broken functionality (recno databases with a modified bval). 
-# Otherwise you'll have to upgrade your DB library.
-#
-# If you want to use Berkeley DB version 1, then 1.85 and 1.86 are the
-# last versions that were released. Berkeley DB version 2 is continually
-# being updated -- Check out http://www.sleepycat.com/ for more details.
-#
-EOM
-}
-
-print "1..128\n";
-
-my $Dfile = "recno.tmp";
-unlink $Dfile ;
-
-umask(0);
-
-# Check the interface to RECNOINFO
-
-my $dbh = new DB_File::RECNOINFO ;
-ok(1, ! defined $dbh->{bval}) ;
-ok(2, ! defined $dbh->{cachesize}) ;
-ok(3, ! defined $dbh->{psize}) ;
-ok(4, ! defined $dbh->{flags}) ;
-ok(5, ! defined $dbh->{lorder}) ;
-ok(6, ! defined $dbh->{reclen}) ;
-ok(7, ! defined $dbh->{bfname}) ;
-
-$dbh->{bval} = 3000 ;
-ok(8, $dbh->{bval} == 3000 );
-
-$dbh->{cachesize} = 9000 ;
-ok(9, $dbh->{cachesize} == 9000 );
-
-$dbh->{psize} = 400 ;
-ok(10, $dbh->{psize} == 400 );
-
-$dbh->{flags} = 65 ;
-ok(11, $dbh->{flags} == 65 );
-
-$dbh->{lorder} = 123 ;
-ok(12, $dbh->{lorder} == 123 );
-
-$dbh->{reclen} = 1234 ;
-ok(13, $dbh->{reclen} == 1234 );
-
-$dbh->{bfname} = 1234 ;
-ok(14, $dbh->{bfname} == 1234 );
-
-
-# Check that an invalid entry is caught both for store & fetch
-eval '$dbh->{fred} = 1234' ;
-ok(15, $@ =~ /^DB_File::RECNOINFO::STORE - Unknown element 'fred' at/ );
-eval 'my $q = $dbh->{fred}' ;
-ok(16, $@ =~ /^DB_File::RECNOINFO::FETCH - Unknown element 'fred' at/ );
-
-# Now check the interface to RECNOINFO
-
-my $X  ;
-my @h ;
-ok(17, $X = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
-
-ok(18, ((stat($Dfile))[2] & 0777) == ($^O eq 'os2' ? 0666 : 0640)
-       ||  $^O eq 'MSWin32' ||  $^O eq 'NetWare' || $^O eq 'amigaos') ;
-
-#my $l = @h ;
-my $l = $X->length ;
-ok(19, ($FA ? @h == 0 : !$l) );
-
-my @data = qw( a b c d ever f g h  i j k longername m n o p) ;
-
-$h[0] = shift @data ;
-ok(20, $h[0] eq 'a' );
-
-my $ i;
-foreach (@data)
-  { $h[++$i] = $_ }
-
-unshift (@data, 'a') ;
-
-ok(21, defined $h[1] );
-ok(22, ! defined $h[16] );
-ok(23, $FA ? @h == @data : $X->length == @data );
-
-
-# Overwrite an entry & check fetch it
-$h[3] = 'replaced' ;
-$data[3] = 'replaced' ;
-ok(24, $h[3] eq 'replaced' );
-
-#PUSH
-my @push_data = qw(added to the end) ;
-($FA ? push(@h, @push_data) : $X->push(@push_data)) ;
-push (@data, @push_data) ;
-ok(25, $h[++$i] eq 'added' );
-ok(26, $h[++$i] eq 'to' );
-ok(27, $h[++$i] eq 'the' );
-ok(28, $h[++$i] eq 'end' );
-
-# POP
-my $popped = pop (@data) ;
-my $value = ($FA ? pop @h : $X->pop) ;
-ok(29, $value eq $popped) ;
-
-# SHIFT
-$value = ($FA ? shift @h : $X->shift) ;
-my $shifted = shift @data ;
-ok(30, $value eq $shifted );
-
-# UNSHIFT
-
-# empty list
-($FA ? unshift @h,() : $X->unshift) ;
-ok(31, ($FA ? @h == @data : $X->length == @data ));
-
-my @new_data = qw(add this to the start of the array) ;
-$FA ? unshift (@h, @new_data) : $X->unshift (@new_data) ;
-unshift (@data, @new_data) ;
-ok(32, $FA ? @h == @data : $X->length == @data );
-ok(33, $h[0] eq "add") ;
-ok(34, $h[1] eq "this") ;
-ok(35, $h[2] eq "to") ;
-ok(36, $h[3] eq "the") ;
-ok(37, $h[4] eq "start") ;
-ok(38, $h[5] eq "of") ;
-ok(39, $h[6] eq "the") ;
-ok(40, $h[7] eq "array") ;
-ok(41, $h[8] eq $data[8]) ;
-
-# SPLICE
-
-# Now both arrays should be identical
-
-my $ok = 1 ;
-my $j = 0 ;
-foreach (@data)
-{
-   $ok = 0, last if $_ ne $h[$j ++] ; 
-}
-ok(42, $ok );
-
-# Neagtive subscripts
-
-# get the last element of the array
-ok(43, $h[-1] eq $data[-1] );
-ok(44, $h[-1] eq $h[ ($FA ? @h : $X->length) -1] );
-
-# get the first element using a negative subscript
-eval '$h[ - ( $FA ? @h : $X->length)] = "abcd"' ;
-ok(45, $@ eq "" );
-ok(46, $h[0] eq "abcd" );
-
-# now try to read before the start of the array
-eval '$h[ - (1 + ($FA ? @h : $X->length))] = 1234' ;
-ok(47, $@ =~ '^Modification of non-creatable array value attempted' );
-
-# IMPORTANT - $X must be undefined before the untie otherwise the
-#             underlying DB close routine will not get called.
-undef $X ;
-untie(@h);
-
-unlink $Dfile;
-
-
-{
-    # Check bval defaults to \n
-
-    my @h = () ;
-    my $dbh = new DB_File::RECNOINFO ;
-    ok(48, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
-    $h[0] = "abc" ;
-    $h[1] = "def" ;
-    $h[3] = "ghi" ;
-    untie @h ;
-    my $x = docat($Dfile) ;
-    unlink $Dfile;
-    ok(49, $x eq "abc\ndef\n\nghi\n") ;
-}
-
-{
-    # Change bval
-
-    my @h = () ;
-    my $dbh = new DB_File::RECNOINFO ;
-    $dbh->{bval} = "-" ;
-    ok(50, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
-    $h[0] = "abc" ;
-    $h[1] = "def" ;
-    $h[3] = "ghi" ;
-    untie @h ;
-    my $x = docat($Dfile) ;
-    unlink $Dfile;
-    my $ok = ($x eq "abc-def--ghi-") ;
-    bad_one() unless $ok ;
-    ok(51, $ok) ;
-}
-
-{
-    # Check R_FIXEDLEN with default bval (space)
-
-    my @h = () ;
-    my $dbh = new DB_File::RECNOINFO ;
-    $dbh->{flags} = R_FIXEDLEN ;
-    $dbh->{reclen} = 5 ;
-    ok(52, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
-    $h[0] = "abc" ;
-    $h[1] = "def" ;
-    $h[3] = "ghi" ;
-    untie @h ;
-    my $x = docat($Dfile) ;
-    unlink $Dfile;
-    my $ok = ($x eq "abc  def       ghi  ") ;
-    bad_one() unless $ok ;
-    ok(53, $ok) ;
-}
-
-{
-    # Check R_FIXEDLEN with user-defined bval
-
-    my @h = () ;
-    my $dbh = new DB_File::RECNOINFO ;
-    $dbh->{flags} = R_FIXEDLEN ;
-    $dbh->{bval} = "-" ;
-    $dbh->{reclen} = 5 ;
-    ok(54, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
-    $h[0] = "abc" ;
-    $h[1] = "def" ;
-    $h[3] = "ghi" ;
-    untie @h ;
-    my $x = docat($Dfile) ;
-    unlink $Dfile;
-    my $ok = ($x eq "abc--def-------ghi--") ;
-    bad_one() unless $ok ;
-    ok(55, $ok) ;
-}
-
-{
-    # check that attempting to tie an associative array to a DB_RECNO will fail
-
-    my $filename = "xyz" ;
-    my %x ;
-    eval { tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_RECNO ; } ;
-    ok(56, $@ =~ /^DB_File can only tie an array to a DB_RECNO database/) ;
-    unlink $filename ;
-}
-
-{
-   # sub-class test
-
-   package Another ;
-
-   use warnings ;
-   use strict ;
-
-   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
-   print FILE <<'EOM' ;
-
-   package SubDB ;
-
-   use warnings ;
-   use strict ;
-   use vars qw( @ISA @EXPORT) ;
-
-   require Exporter ;
-   use DB_File;
-   @ISA=qw(DB_File);
-   @EXPORT = @DB_File::EXPORT ;
-
-   sub STORE { 
-       my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::STORE($key, $value * 2) ;
-   }
-
-   sub FETCH { 
-       my $self = shift ;
-        my $key = shift ;
-        $self->SUPER::FETCH($key) - 1 ;
-   }
-
-   sub put { 
-       my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::put($key, $value * 3) ;
-   }
-
-   sub get { 
-       my $self = shift ;
-        $self->SUPER::get($_[0], $_[1]) ;
-       $_[1] -= 2 ;
-   }
-
-   sub A_new_method
-   {
-       my $self = shift ;
-        my $key = shift ;
-        my $value = $self->FETCH($key) ;
-       return "[[$value]]" ;
-   }
-
-   1 ;
-EOM
-
-    close FILE ;
-
-    BEGIN { push @INC, '.'; } 
-    eval 'use SubDB ; ';
-    main::ok(57, $@ eq "") ;
-    my @h ;
-    my $X ;
-    eval '
-       $X = tie(@h, "SubDB","recno.tmp", O_RDWR|O_CREAT, 0640, $DB_RECNO );
-       ' ;
-
-    main::ok(58, $@ eq "") ;
-
-    my $ret = eval '$h[3] = 3 ; return $h[3] ' ;
-    main::ok(59, $@ eq "") ;
-    main::ok(60, $ret == 5) ;
-
-    my $value = 0;
-    $ret = eval '$X->put(1, 4) ; $X->get(1, $value) ; return $value' ;
-    main::ok(61, $@ eq "") ;
-    main::ok(62, $ret == 10) ;
-
-    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
-    main::ok(63, $@ eq "" ) ;
-    main::ok(64, $ret == 1) ;
-
-    $ret = eval '$X->A_new_method(1) ' ;
-    main::ok(65, $@ eq "") ;
-    main::ok(66, $ret eq "[[11]]") ;
-
-    undef $X;
-    untie(@h);
-    unlink "SubDB.pm", "recno.tmp" ;
-
-}
-
-{
-
-    # test $#
-    my $self ;
-    unlink $Dfile;
-    ok(67, $self = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
-    $h[0] = "abc" ;
-    $h[1] = "def" ;
-    $h[2] = "ghi" ;
-    $h[3] = "jkl" ;
-    ok(68, $FA ? $#h == 3 : $self->length() == 4) ;
-    undef $self ;
-    untie @h ;
-    my $x = docat($Dfile) ;
-    ok(69, $x eq "abc\ndef\nghi\njkl\n") ;
-
-    # $# sets array to same length
-    ok(70, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
-    if ($FA)
-      { $#h = 3 }
-    else 
-      { $self->STORESIZE(4) }
-    ok(71, $FA ? $#h == 3 : $self->length() == 4) ;
-    undef $self ;
-    untie @h ;
-    $x = docat($Dfile) ;
-    ok(72, $x eq "abc\ndef\nghi\njkl\n") ;
-
-    # $# sets array to bigger
-    ok(73, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
-    if ($FA)
-      { $#h = 6 }
-    else 
-      { $self->STORESIZE(7) }
-    ok(74, $FA ? $#h == 6 : $self->length() == 7) ;
-    undef $self ;
-    untie @h ;
-    $x = docat($Dfile) ;
-    ok(75, $x eq "abc\ndef\nghi\njkl\n\n\n\n") ;
-
-    # $# sets array smaller
-    ok(76, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
-    if ($FA)
-      { $#h = 2 }
-    else 
-      { $self->STORESIZE(3) }
-    ok(77, $FA ? $#h == 2 : $self->length() == 3) ;
-    undef $self ;
-    untie @h ;
-    $x = docat($Dfile) ;
-    ok(78, $x eq "abc\ndef\nghi\n") ;
-
-    unlink $Dfile;
-
-
-}
-
-{
-   # DBM Filter tests
-   use warnings ;
-   use strict ;
-   my (@h, $db) ;
-   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   unlink $Dfile;
-
-   sub checkOutput
-   {
-       my($fk, $sk, $fv, $sv) = @_ ;
-       return
-           $fetch_key eq $fk && $store_key eq $sk && 
-          $fetch_value eq $fv && $store_value eq $sv &&
-          $_ eq 'original' ;
-   }
-   
-   ok(79, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) );
-
-   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
-   $db->filter_store_key   (sub { $store_key = $_ }) ;
-   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
-   $db->filter_store_value (sub { $store_value = $_ }) ;
-
-   $_ = "original" ;
-
-   $h[0] = "joe" ;
-   #                   fk   sk     fv   sv
-   ok(80, checkOutput( "", 0, "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(81, $h[0] eq "joe");
-   #                   fk  sk  fv    sv
-   ok(82, checkOutput( "", 0, "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(83, $db->FIRSTKEY() == 0) ;
-   #                    fk     sk  fv  sv
-   ok(84, checkOutput( 0, "", "", "")) ;
-
-   # replace the filters, but remember the previous set
-   my ($old_fk) = $db->filter_fetch_key   
-                       (sub { ++ $_ ; $fetch_key = $_ }) ;
-   my ($old_sk) = $db->filter_store_key   
-                       (sub { $_ *= 2 ; $store_key = $_ }) ;
-   my ($old_fv) = $db->filter_fetch_value 
-                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
-   my ($old_sv) = $db->filter_store_value 
-                       (sub { s/o/x/g; $store_value = $_ }) ;
-   
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h[1] = "Joe" ;
-   #                   fk   sk     fv    sv
-   ok(85, checkOutput( "", 2, "", "Jxe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(86, $h[1] eq "[Jxe]");
-   #                   fk   sk     fv    sv
-   ok(87, checkOutput( "", 2, "[Jxe]", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(88, $db->FIRSTKEY() == 1) ;
-   #                   fk   sk     fv    sv
-   ok(89, checkOutput( 1, "", "", "")) ;
-   
-   # put the original filters back
-   $db->filter_fetch_key   ($old_fk);
-   $db->filter_store_key   ($old_sk);
-   $db->filter_fetch_value ($old_fv);
-   $db->filter_store_value ($old_sv);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h[0] = "joe" ;
-   ok(90, checkOutput( "", 0, "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(91, $h[0] eq "joe");
-   ok(92, checkOutput( "", 0, "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(93, $db->FIRSTKEY() == 0) ;
-   ok(94, checkOutput( 0, "", "", "")) ;
-
-   # delete the filters
-   $db->filter_fetch_key   (undef);
-   $db->filter_store_key   (undef);
-   $db->filter_fetch_value (undef);
-   $db->filter_store_value (undef);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h[0] = "joe" ;
-   ok(95, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(96, $h[0] eq "joe");
-   ok(97, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(98, $db->FIRSTKEY() == 0) ;
-   ok(99, checkOutput( "", "", "", "")) ;
-
-   undef $db ;
-   untie @h;
-   unlink $Dfile;
-}
-
-{    
-    # DBM Filter with a closure
-
-    use warnings ;
-    use strict ;
-    my (@h, $db) ;
-
-    unlink $Dfile;
-    ok(100, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) );
-
-    my %result = () ;
-
-    sub Closure
-    {
-        my ($name) = @_ ;
-       my $count = 0 ;
-       my @kept = () ;
-
-       return sub { ++$count ; 
-                    push @kept, $_ ; 
-                    $result{$name} = "$name - $count: [@kept]" ;
-                  }
-    }
-
-    $db->filter_store_key(Closure("store key")) ;
-    $db->filter_store_value(Closure("store value")) ;
-    $db->filter_fetch_key(Closure("fetch key")) ;
-    $db->filter_fetch_value(Closure("fetch value")) ;
-
-    $_ = "original" ;
-
-    $h[0] = "joe" ;
-    ok(101, $result{"store key"} eq "store key - 1: [0]");
-    ok(102, $result{"store value"} eq "store value - 1: [joe]");
-    ok(103, ! defined $result{"fetch key"} );
-    ok(104, ! defined $result{"fetch value"} );
-    ok(105, $_ eq "original") ;
-
-    ok(106, $db->FIRSTKEY() == 0 ) ;
-    ok(107, $result{"store key"} eq "store key - 1: [0]");
-    ok(108, $result{"store value"} eq "store value - 1: [joe]");
-    ok(109, $result{"fetch key"} eq "fetch key - 1: [0]");
-    ok(110, ! defined $result{"fetch value"} );
-    ok(111, $_ eq "original") ;
-
-    $h[7]  = "john" ;
-    ok(112, $result{"store key"} eq "store key - 2: [0 7]");
-    ok(113, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(114, $result{"fetch key"} eq "fetch key - 1: [0]");
-    ok(115, ! defined $result{"fetch value"} );
-    ok(116, $_ eq "original") ;
-
-    ok(117, $h[0] eq "joe");
-    ok(118, $result{"store key"} eq "store key - 3: [0 7 0]");
-    ok(119, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(120, $result{"fetch key"} eq "fetch key - 1: [0]");
-    ok(121, $result{"fetch value"} eq "fetch value - 1: [joe]");
-    ok(122, $_ eq "original") ;
-
-    undef $db ;
-    untie @h;
-    unlink $Dfile;
-}              
-
-{
-   # DBM Filter recursion detection
-   use warnings ;
-   use strict ;
-   my (@h, $db) ;
-   unlink $Dfile;
-
-   ok(123, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) );
-
-   $db->filter_store_key (sub { $_ = $h[0] }) ;
-
-   eval '$h[1] = 1234' ;
-   ok(124, $@ =~ /^recursion detected in filter_store_key at/ );
-   
-   undef $db ;
-   untie @h;
-   unlink $Dfile;
-}
-
-
-{
-   # Examples from the POD
-
-  my $file = "xyzt" ;
-  {
-    my $redirect = new Redirect $file ;
-
-    use warnings FATAL => qw(all);
-    use strict ;
-    use DB_File ;
-
-    my $filename = "text" ;
-    unlink $filename ;
-
-    my @h ;
-    my $x = tie @h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_RECNO 
-        or die "Cannot open file 'text': $!\n" ;
-
-    # Add a few key/value pairs to the file
-    $h[0] = "orange" ;
-    $h[1] = "blue" ;
-    $h[2] = "yellow" ;
-
-    $FA ? push @h, "green", "black" 
-        : $x->push("green", "black") ;
-
-    my $elements = $FA ? scalar @h : $x->length ;
-    print "The array contains $elements entries\n" ;
-
-    my $last = $FA ? pop @h : $x->pop ;
-    print "popped $last\n" ;
-
-    $FA ? unshift @h, "white" 
-        : $x->unshift("white") ;
-    my $first = $FA ? shift @h : $x->shift ;
-    print "shifted $first\n" ;
-
-    # Check for existence of a key
-    print "Element 1 Exists with value $h[1]\n" if $h[1] ;
-
-    # use a negative index
-    print "The last element is $h[-1]\n" ;
-    print "The 2nd last element is $h[-2]\n" ;
-
-    undef $x ;
-    untie @h ;
-
-    unlink $filename ;
-  }  
-
-  ok(125, docat_del($file) eq <<'EOM') ;
-The array contains 5 entries
-popped black
-shifted white
-Element 1 Exists with value blue
-The last element is green
-The 2nd last element is yellow
-EOM
-
-  my $save_output = "xyzt" ;
-  {
-    my $redirect = new Redirect $save_output ;
-
-    use warnings FATAL => qw(all);
-    use strict ;
-    use vars qw(@h $H $file $i) ;
-    use DB_File ;
-    use Fcntl ;
-    
-    $file = "text" ;
-
-    unlink $file ;
-
-    $H = tie @h, "DB_File", $file, O_RDWR|O_CREAT, 0640, $DB_RECNO 
-        or die "Cannot open file $file: $!\n" ;
-    
-    # first create a text file to play with
-    $h[0] = "zero" ;
-    $h[1] = "one" ;
-    $h[2] = "two" ;
-    $h[3] = "three" ;
-    $h[4] = "four" ;
-
-    
-    # Print the records in order.
-    #
-    # The length method is needed here because evaluating a tied
-    # array in a scalar context does not return the number of
-    # elements in the array.  
-
-    print "\nORIGINAL\n" ;
-    foreach $i (0 .. $H->length - 1) {
-        print "$i: $h[$i]\n" ;
-    }
-
-    # use the push & pop methods
-    $a = $H->pop ;
-    $H->push("last") ;
-    print "\nThe last record was [$a]\n" ;
-
-    # and the shift & unshift methods
-    $a = $H->shift ;
-    $H->unshift("first") ;
-    print "The first record was [$a]\n" ;
-
-    # Use the API to add a new record after record 2.
-    $i = 2 ;
-    $H->put($i, "Newbie", R_IAFTER) ;
-
-    # and a new record before record 1.
-    $i = 1 ;
-    $H->put($i, "New One", R_IBEFORE) ;
-
-    # delete record 3
-    $H->del(3) ;
-
-    # now print the records in reverse order
-    print "\nREVERSE\n" ;
-    for ($i = $H->length - 1 ; $i >= 0 ; -- $i)
-      { print "$i: $h[$i]\n" }
-
-    # same again, but use the API functions instead
-    print "\nREVERSE again\n" ;
-    my ($s, $k, $v)  = (0, 0, 0) ;
-    for ($s = $H->seq($k, $v, R_LAST) ; 
-             $s == 0 ; 
-             $s = $H->seq($k, $v, R_PREV))
-      { print "$k: $v\n" }
-
-    undef $H ;
-    untie @h ;    
-
-    unlink $file ;
-  }  
-
-  ok(126, docat_del($save_output) eq <<'EOM') ;
-
-ORIGINAL
-0: zero
-1: one
-2: two
-3: three
-4: four
-
-The last record was [four]
-The first record was [zero]
-
-REVERSE
-5: last
-4: three
-3: Newbie
-2: one
-1: New One
-0: first
-
-REVERSE again
-5: last
-4: three
-3: Newbie
-2: one
-1: New One
-0: first
-EOM
-   
-}
-
-{
-    # Bug ID 20001013.009
-    #
-    # test that $hash{KEY} = undef doesn't produce the warning
-    #     Use of uninitialized value in null operation 
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    unlink $Dfile;
-    my @h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO 
-       or die "Can't open file: $!\n" ;
-    $h[0] = undef;
-    ok(127, $a eq "") ;
-    untie @h ;
-    unlink $Dfile;
-}
-
-{
-    # test that %hash = () doesn't produce the warning
-    #     Argument "" isn't numeric in entersub
-    use warnings ;
-    use strict ;
-    use DB_File ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-
-    unlink $Dfile;
-    my @h ;
-    
-    tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO 
-       or die "Can't open file: $!\n" ;
-    @h = (); ;
-    ok(128, $a eq "") ;
-    untie @h ;
-    unlink $Dfile;
-}
-
-exit ;

diff --git a/t/lib/digest.t b/t/lib/digest.t
deleted file mode 100644 (file)
index 5741b77..0000000
--- a/t/lib/digest.t
+++ /dev/null
@@ -1,26 +0,0 @@
-print "1..3\n";
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use Digest;
-
-my $hexdigest = "900150983cd24fb0d6963f7d28e17f72";
-if (ord('A') == 193) { # EBCDIC
-    $hexdigest = "fe4ea0d98f9cd8d1d27f102a93cb0bb0"; # IBM-1047
-}
-
-print "not " unless Digest->MD5->add("abc")->hexdigest eq $hexdigest;
-print "ok 1\n";
-
-print "not " unless Digest->MD5->add("abc")->hexdigest eq $hexdigest;
-print "ok 2\n";
-
-eval {
-    print "not " unless Digest->new("HMAC-MD5" => "Jefe")->add("what do ya want for nothing?")->hexdigest eq "750c783e6ab0b503eaa86e310a5db738";
-    print "ok 3\n";
-};
-print "ok 3\n" if $@ && $@ =~ /^Can't locate/;
-

diff --git a/t/lib/dirhand.t b/t/lib/dirhand.t
deleted file mode 100755 (executable)
index e83ea13..0000000
--- a/t/lib/dirhand.t
+++ /dev/null
@@ -1,34 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if (not $Config{'d_readdir'}) {
-       print "1..0\n";
-       exit 0;
-    }
-}
-
-use DirHandle;
-
-print "1..5\n";
-
-$dot = new DirHandle ($^O eq 'MacOS' ? ':' : '.');
-
-print defined($dot) ? "ok" : "not ok", " 1\n";
-
-@a = sort <*>;
-do { $first = $dot->read } while defined($first) && $first =~ /^\./;
-print +(grep { $_ eq $first } @a) ? "ok" : "not ok", " 2\n";
-
-@b = sort($first, (grep {/^[^.]/} $dot->read));
-print +(join("\0", @a) eq join("\0", @b)) ? "ok" : "not ok", " 3\n";
-
-$dot->rewind;
-@c = sort grep {/^[^.]/} $dot->read;
-print +(join("\0", @b) eq join("\0", @c)) ? "ok" : "not ok", " 4\n";
-
-$dot->close;
-$dot->rewind;
-print defined($dot->read) ? "not ok" : "ok", " 5\n";

diff --git a/t/lib/dosglob.t b/t/lib/dosglob.t
deleted file mode 100755 (executable)
index fd9bb1d..0000000
--- a/t/lib/dosglob.t
+++ /dev/null
@@ -1,112 +0,0 @@
-#!./perl
-
-#
-# test glob() in File::DosGlob
-#
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-print "1..10\n";
-
-# override it in main::
-use File::DosGlob 'glob';
-
-# test if $_ takes as the default
-$_ = "lib/a*.t";
-my @r = glob;
-print "not " if $_ ne 'lib/a*.t';
-print "ok 1\n";
-# we should have at least abbrev.t, anydbm.t, autoloader.t
-print "# |@r|\nnot " if @r < 3;
-print "ok 2\n";
-
-# check if <*/*> works
-@r = <*/a*.t>;
-# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
-print "not " if @r < 9;
-print "ok 3\n";
-my $r = scalar @r;
-
-# check if scalar context works
-@r = ();
-while (defined($_ = <*/a*.t>)) {
-    print "# $_\n";
-    push @r, $_;
-}
-print "not " if @r != $r;
-print "ok 4\n";
-
-# check if list context works
-@r = ();
-for (<*/a*.t>) {
-    print "# $_\n";
-    push @r, $_;
-}
-print "not " if @r != $r;
-print "ok 5\n";
-
-# test if implicit assign to $_ in while() works
-@r = ();
-while (<*/a*.t>) {
-    print "# $_\n";
-    push @r, $_;
-}
-print "not " if @r != $r;
-print "ok 6\n";
-
-# test if explicit glob() gets assign magic too
-my @s = ();
-while (glob '*/a*.t') {
-    print "# $_\n";
-    push @s, $_;
-}
-print "not " if "@r" ne "@s";
-print "ok 7\n";
-
-# how about in a different package, like?
-package Foo;
-use File::DosGlob 'glob';
-@s = ();
-while (glob '*/a*.t') {
-    print "# $_\n";
-    push @s, $_;
-}
-print "not " if "@r" ne "@s";
-print "ok 8\n";
-
-# test if different glob ops maintain independent contexts
-@s = ();
-while (<*/a*.t>) {
-    my $i = 0;
-    print "# $_ <";
-    push @s, $_;
-    while (<*/b*.t>) {
-        print " $_";
-       $i++;
-    }
-    print " >\n";
-}
-print "not " if "@r" ne "@s";
-print "ok 9\n";
-
-# how about a global override, hm?
-eval <<'EOT';
-use File::DosGlob 'GLOBAL_glob';
-package Bar;
-@s = ();
-while (<*/a*.t>) {
-    my $i = 0;
-    print "# $_ <";
-    push @s, $_;
-    while (glob '*/b*.t') {
-        print " $_";
-       $i++;
-    }
-    print " >\n";
-}
-print "not " if "@r" ne "@s";
-print "ok 10\n";
-EOT

diff --git a/t/lib/dprof.t b/t/lib/dprof.t
deleted file mode 100755 (executable)
index be711f1..0000000
--- a/t/lib/dprof.t
+++ /dev/null
@@ -1,88 +0,0 @@
-#!perl
-
-BEGIN {
-    chdir( 't' ) if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bDevel\/DProf\b/){
-      print "1..0 # Skip: Devel::DProf was not built\n";
-      exit 0;
-    }
-}
-
-END {
-    while(-e 'tmon.out' && unlink 'tmon.out') {}
-    while(-e 'err' && unlink 'err') {}
-}
-
-use Benchmark qw( timediff timestr );
-use Getopt::Std 'getopts';
-getopts('vI:p:');
-
-# -v   Verbose
-# -I   Add to @INC
-# -p   Name of perl binary
-
-@tests = @ARGV ? @ARGV : sort (<lib/dprof/*_t>, <lib/dprof/*_v>);  # glob-sort, for OS/2
-
-$path_sep = $Config{path_sep} || ':';
-$perl5lib = $opt_I || join( $path_sep, @INC );
-$perl = $opt_p || $^X;
-
-if( $opt_v ){
-       print "tests: @tests\n";
-       print "perl: $perl\n";
-       print "perl5lib: $perl5lib\n";
-}
-if( $perl =~ m|^\./| ){
-       # turn ./perl into ../perl, because of chdir(t) above.
-       $perl = ".$perl";
-}
-if( ! -f $perl ){ die "Where's Perl?" }
-
-sub profile {
-       my $test = shift;
-       my @results;
-       local $ENV{PERL5LIB} = $perl5lib;
-       my $opt_d = '-d:DProf';
-
-       my $t_start = new Benchmark;
-        open( R, "$perl \"$opt_d\" $test |" ) || warn "$0: Can't run. $!\n";
-       @results = <R>;
-       close R;
-       my $t_total = timediff( new Benchmark, $t_start );
-
-       if( $opt_v ){
-               print "\n";
-               print @results
-       }
-
-        print '# ',timestr( $t_total, 'nop' ), "\n";
-}
-
-
-sub verify {
-       my $test = shift;
-
-       my $command = $perl.' "-I../lib" "-I./lib/dprof" '.$test;
-       $command .= ' -v' if $opt_v;
-       $command .= ' -p '. $perl;
-       system $command;
-}
-
-
-$| = 1;
-print "1..18\n";
-while( @tests ){
-       $test = shift @tests;
-        $test =~ s/\.$// if $^O eq 'VMS';
-       if( $test =~ /_t$/i ){
-               print "# $test" . '.' x (20 - length $test);
-               profile $test;
-       }
-       else{
-               verify $test;
-       }
-}
-
-unlink("tmon.out");

diff --git a/t/lib/dumper-ovl.t b/t/lib/dumper-ovl.t
deleted file mode 100755 (executable)
index d4b3a92..0000000
--- a/t/lib/dumper-ovl.t
+++ /dev/null
@@ -1,35 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
-      print "1..0 # Skip: Data::Dumper was not built\n";
-      exit 0;
-    }
-}
-
-use Data::Dumper;
-
-print "1..1\n";
-
-package Foo;
-use overload '""' => 'as_string';
-
-sub new { bless { foo => "bar" }, shift }
-sub as_string { "%%%%" }
-
-package main;
-
-my $f = Foo->new;
-
-print "#\$f=$f\n";
-
-$_ = Dumper($f);
-s/^/#/mg;
-print $_;
-
-print "not " unless /bar/ && /Foo/;
-print "ok 1\n";
-

diff --git a/t/lib/dumper.t b/t/lib/dumper.t
deleted file mode 100755 (executable)
index 10add1c..0000000
--- a/t/lib/dumper.t
+++ /dev/null
@@ -1,810 +0,0 @@
-#!./perl -w
-#
-# testsuite for Data::Dumper
-#
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
-      print "1..0 # Skip: Data::Dumper was not built\n";
-      exit 0;
-    }
-}
-
-use Data::Dumper;
-use Config;
-my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
-
-$Data::Dumper::Pad = "#";
-my $TMAX;
-my $XS;
-my $TNUM = 0;
-my $WANT = '';
-
-sub TEST {
-  my $string = shift;
-  my $t = eval $string;
-  ++$TNUM;
-  $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
-      if ($WANT =~ /deadbeef/);
-  if ($Is_ebcdic) {
-      # these data need massaging with non ascii character sets
-      # because of hashing order differences
-      $WANT = join("\n",sort(split(/\n/,$WANT)));
-      $WANT =~ s/\,$//mg;
-      $t    = join("\n",sort(split(/\n/,$t)));
-      $t    =~ s/\,$//mg;
-  }
-  print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
-       : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
-
-  ++$TNUM;
-  eval "$t";
-  print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n";
-
-  $t = eval $string;
-  ++$TNUM;
-  $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
-      if ($WANT =~ /deadbeef/);
-  if ($Is_ebcdic) {
-      # here too there are hashing order differences
-      $WANT = join("\n",sort(split(/\n/,$WANT)));
-      $WANT =~ s/\,$//mg;
-      $t    = join("\n",sort(split(/\n/,$t)));
-      $t    =~ s/\,$//mg;
-  }
-  print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
-       : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
-}
-
-if (defined &Data::Dumper::Dumpxs) {
-  print "### XS extension loaded, will run XS tests\n";
-  $TMAX = 186; $XS = 1;
-}
-else {
-  print "### XS extensions not loaded, will NOT run XS tests\n";
-  $TMAX = 93; $XS = 0;
-}
-
-print "1..$TMAX\n";
-
-#############
-#############
-
-@c = ('c');
-$c = \@c;
-$b = {};
-$a = [1, $b, $c];
-$b->{a} = $a;
-$b->{b} = $a->[1];
-$b->{c} = $a->[2];
-
-############# 1
-##
-$WANT = <<'EOT';
-#$a = [
-#       1,
-#       {
-#         'c' => [
-#                  'c'
-#                ],
-#         'a' => $a,
-#         'b' => $a->[1]
-#       },
-#       $a->[1]{'c'}
-#     ];
-#$b = $a->[1];
-#$c = $a->[1]{'c'};
-EOT
-
-TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]));
-TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b c)])) if $XS;
-
-
-############# 7
-##
-$WANT = <<'EOT';
-#@a = (
-#       1,
-#       {
-#         'c' => [
-#                  'c'
-#                ],
-#         'a' => [],
-#         'b' => {}
-#       },
-#       []
-#     );
-#$a[1]{'a'} = \@a;
-#$a[1]{'b'} = $a[1];
-#$a[2] = $a[1]{'c'};
-#$b = $a[1];
-EOT
-
-$Data::Dumper::Purity = 1;         # fill in the holes for eval
-TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
-TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
-
-############# 13
-##
-$WANT = <<'EOT';
-#%b = (
-#       'c' => [
-#                'c'
-#              ],
-#       'a' => [
-#                1,
-#                {},
-#                []
-#              ],
-#       'b' => {}
-#     );
-#$b{'a'}[1] = \%b;
-#$b{'a'}[2] = $b{'c'};
-#$b{'b'} = \%b;
-#$a = $b{'a'};
-EOT
-
-TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
-TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
-
-############# 19
-##
-$WANT = <<'EOT';
-#$a = [
-#  1,
-#  {
-#    'c' => [],
-#    'a' => [],
-#    'b' => {}
-#  },
-#  []
-#];
-#$a->[1]{'c'} = \@c;
-#$a->[1]{'a'} = $a;
-#$a->[1]{'b'} = $a->[1];
-#$a->[2] = \@c;
-#$b = $a->[1];
-EOT
-
-$Data::Dumper::Indent = 1;
-TEST q(
-       $d = Data::Dumper->new([$a,$b], [qw(a b)]);
-       $d->Seen({'*c' => $c});
-       $d->Dump;
-      );
-if ($XS) {
-  TEST q(
-        $d = Data::Dumper->new([$a,$b], [qw(a b)]);
-        $d->Seen({'*c' => $c});
-        $d->Dumpxs;
-       );
-}
-
-
-############# 25
-##
-$WANT = <<'EOT';
-#$a = [
-#       #0
-#       1,
-#       #1
-#       {
-#         c => [
-#                #0
-#                'c'
-#              ],
-#         a => $a,
-#         b => $a->[1]
-#       },
-#       #2
-#       $a->[1]{c}
-#     ];
-#$b = $a->[1];
-EOT
-
-$d->Indent(3);
-$d->Purity(0)->Quotekeys(0);
-TEST q( $d->Reset; $d->Dump );
-
-TEST q( $d->Reset; $d->Dumpxs ) if $XS;
-
-############# 31
-##
-$WANT = <<'EOT';
-#$VAR1 = [
-#  1,
-#  {
-#    'c' => [
-#      'c'
-#    ],
-#    'a' => [],
-#    'b' => {}
-#  },
-#  []
-#];
-#$VAR1->[1]{'a'} = $VAR1;
-#$VAR1->[1]{'b'} = $VAR1->[1];
-#$VAR1->[2] = $VAR1->[1]{'c'};
-EOT
-
-TEST q(Dumper($a));
-TEST q(Data::Dumper::DumperX($a)) if $XS;
-
-############# 37
-##
-$WANT = <<'EOT';
-#[
-#  1,
-#  {
-#    c => [
-#      'c'
-#    ],
-#    a => $VAR1,
-#    b => $VAR1->[1]
-#  },
-#  $VAR1->[1]{c}
-#]
-EOT
-
-{
-  local $Data::Dumper::Purity = 0;
-  local $Data::Dumper::Quotekeys = 0;
-  local $Data::Dumper::Terse = 1;
-  TEST q(Dumper($a));
-  TEST q(Data::Dumper::DumperX($a)) if $XS;
-}
-
-
-############# 43
-##
-$WANT = <<'EOT';
-#$VAR1 = {
-#  "reftest" => \\1,
-#  "abc\0'\efg" => "mno\0"
-#};
-EOT
-
-$foo = { "abc\000\'\efg" => "mno\000",
-         "reftest" => \\1,
-       };
-{
-  local $Data::Dumper::Useqq = 1;
-  TEST q(Dumper($foo));
-}
-
-  $WANT = <<"EOT";
-#\$VAR1 = {
-#  'reftest' => \\\\1,
-#  'abc\0\\'\efg' => 'mno\0'
-#};
-EOT
-
-  {
-    local $Data::Dumper::Useqq = 1;
-    TEST q(Data::Dumper::DumperX($foo)) if $XS;   # cheat
-  }
-
-
-
-#############
-#############
-
-{
-  package main;
-  use Data::Dumper;
-  $foo = 5;
-  @foo = (-10,\*foo);
-  %foo = (a=>1,b=>\$foo,c=>\@foo);
-  $foo{d} = \%foo;
-  $foo[2] = \%foo;
-
-############# 49
-##
-  $WANT = <<'EOT';
-#$foo = \*::foo;
-#*::foo = \5;
-#*::foo = [
-#           #0
-#           -10,
-#           #1
-#           do{my $o},
-#           #2
-#           {
-#             'c' => [],
-#             'a' => 1,
-#             'b' => do{my $o},
-#             'd' => {}
-#           }
-#         ];
-#*::foo{ARRAY}->[1] = $foo;
-#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
-#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
-#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
-#*::foo = *::foo{ARRAY}->[2];
-#@bar = @{*::foo{ARRAY}};
-#%baz = %{*::foo{ARRAY}->[2]};
-EOT
-
-  $Data::Dumper::Purity = 1;
-  $Data::Dumper::Indent = 3;
-  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
-  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
-
-############# 55
-##
-  $WANT = <<'EOT';
-#$foo = \*::foo;
-#*::foo = \5;
-#*::foo = [
-#  -10,
-#  do{my $o},
-#  {
-#    'c' => [],
-#    'a' => 1,
-#    'b' => do{my $o},
-#    'd' => {}
-#  }
-#];
-#*::foo{ARRAY}->[1] = $foo;
-#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
-#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
-#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
-#*::foo = *::foo{ARRAY}->[2];
-#$bar = *::foo{ARRAY};
-#$baz = *::foo{ARRAY}->[2];
-EOT
-
-  $Data::Dumper::Indent = 1;
-  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
-  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
-
-############# 61
-##
-  $WANT = <<'EOT';
-#@bar = (
-#  -10,
-#  \*::foo,
-#  {}
-#);
-#*::foo = \5;
-#*::foo = \@bar;
-#*::foo = {
-#  'c' => [],
-#  'a' => 1,
-#  'b' => do{my $o},
-#  'd' => {}
-#};
-#*::foo{HASH}->{'c'} = \@bar;
-#*::foo{HASH}->{'b'} = *::foo{SCALAR};
-#*::foo{HASH}->{'d'} = *::foo{HASH};
-#$bar[2] = *::foo{HASH};
-#%baz = %{*::foo{HASH}};
-#$foo = $bar[1];
-EOT
-
-  TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
-  TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
-
-############# 67
-##
-  $WANT = <<'EOT';
-#$bar = [
-#  -10,
-#  \*::foo,
-#  {}
-#];
-#*::foo = \5;
-#*::foo = $bar;
-#*::foo = {
-#  'c' => [],
-#  'a' => 1,
-#  'b' => do{my $o},
-#  'd' => {}
-#};
-#*::foo{HASH}->{'c'} = $bar;
-#*::foo{HASH}->{'b'} = *::foo{SCALAR};
-#*::foo{HASH}->{'d'} = *::foo{HASH};
-#$bar->[2] = *::foo{HASH};
-#$baz = *::foo{HASH};
-#$foo = $bar->[1];
-EOT
-
-  TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
-  TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
-
-############# 73
-##
-  $WANT = <<'EOT';
-#$foo = \*::foo;
-#@bar = (
-#  -10,
-#  $foo,
-#  {
-#    c => \@bar,
-#    a => 1,
-#    b => \5,
-#    d => $bar[2]
-#  }
-#);
-#%baz = %{$bar[2]};
-EOT
-
-  $Data::Dumper::Purity = 0;
-  $Data::Dumper::Quotekeys = 0;
-  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
-  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
-
-############# 79
-##
-  $WANT = <<'EOT';
-#$foo = \*::foo;
-#$bar = [
-#  -10,
-#  $foo,
-#  {
-#    c => $bar,
-#    a => 1,
-#    b => \5,
-#    d => $bar->[2]
-#  }
-#];
-#$baz = $bar->[2];
-EOT
-
-  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
-  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
-
-}
-
-#############
-#############
-{
-  package main;
-  @dogs = ( 'Fido', 'Wags' );
-  %kennel = (
-            First => \$dogs[0],
-            Second =>  \$dogs[1],
-           );
-  $dogs[2] = \%kennel;
-  $mutts = \%kennel;
-  $mutts = $mutts;         # avoid warning
-  
-############# 85
-##
-  $WANT = <<'EOT';
-#%kennels = (
-#  Second => \'Wags',
-#  First => \'Fido'
-#);
-#@dogs = (
-#  ${$kennels{First}},
-#  ${$kennels{Second}},
-#  \%kennels
-#);
-#%mutts = %kennels;
-EOT
-
-  TEST q(
-        $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
-                               [qw(*kennels *dogs *mutts)] );
-        $d->Dump;
-       );
-  if ($XS) {
-    TEST q(
-          $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
-                                 [qw(*kennels *dogs *mutts)] );
-          $d->Dumpxs;
-         );
-  }
-  
-############# 91
-##
-  $WANT = <<'EOT';
-#%kennels = %kennels;
-#@dogs = @dogs;
-#%mutts = %kennels;
-EOT
-
-  TEST q($d->Dump);
-  TEST q($d->Dumpxs) if $XS;
-  
-############# 97
-##
-  $WANT = <<'EOT';
-#%kennels = (
-#  Second => \'Wags',
-#  First => \'Fido'
-#);
-#@dogs = (
-#  ${$kennels{First}},
-#  ${$kennels{Second}},
-#  \%kennels
-#);
-#%mutts = %kennels;
-EOT
-
-  
-  TEST q($d->Reset; $d->Dump);
-  if ($XS) {
-    TEST q($d->Reset; $d->Dumpxs);
-  }
-
-############# 103
-##
-  $WANT = <<'EOT';
-#@dogs = (
-#  'Fido',
-#  'Wags',
-#  {
-#    Second => \$dogs[1],
-#    First => \$dogs[0]
-#  }
-#);
-#%kennels = %{$dogs[2]};
-#%mutts = %{$dogs[2]};
-EOT
-
-  TEST q(
-        $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
-                               [qw(*dogs *kennels *mutts)] );
-        $d->Dump;
-       );
-  if ($XS) {
-    TEST q(
-          $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
-                                 [qw(*dogs *kennels *mutts)] );
-          $d->Dumpxs;
-         );
-  }
-  
-############# 109
-##
-  TEST q($d->Reset->Dump);
-  if ($XS) {
-    TEST q($d->Reset->Dumpxs);
-  }
-
-############# 115
-##
-  $WANT = <<'EOT';
-#@dogs = (
-#  'Fido',
-#  'Wags',
-#  {
-#    Second => \'Wags',
-#    First => \'Fido'
-#  }
-#);
-#%kennels = (
-#  Second => \'Wags',
-#  First => \'Fido'
-#);
-EOT
-
-  TEST q(
-        $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
-        $d->Deepcopy(1)->Dump;
-       );
-  if ($XS) {
-    TEST q($d->Reset->Dumpxs);
-  }
-  
-}
-
-{
-
-sub z { print "foo\n" }
-$c = [ \&z ];
-
-############# 121
-##
-  $WANT = <<'EOT';
-#$a = $b;
-#$c = [
-#  $b
-#];
-EOT
-
-TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;);
-TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;)
-       if $XS;
-
-############# 127
-##
-  $WANT = <<'EOT';
-#$a = \&b;
-#$c = [
-#  \&b
-#];
-EOT
-
-TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;);
-TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;)
-       if $XS;
-
-############# 133
-##
-  $WANT = <<'EOT';
-#*a = \&b;
-#@c = (
-#  \&b
-#);
-EOT
-
-TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;);
-TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
-       if $XS;
-
-}
-
-{
-  $a = [];
-  $a->[1] = \$a->[0];
-
-############# 139
-##
-  $WANT = <<'EOT';
-#@a = (
-#  undef,
-#  do{my $o}
-#);
-#$a[1] = \$a[0];
-EOT
-
-TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;);
-TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;)
-       if $XS;
-}
-
-{
-  $a = \\\\\'foo';
-  $b = $$$a;
-
-############# 145
-##
-  $WANT = <<'EOT';
-#$a = \\\\\'foo';
-#$b = ${${$a}};
-EOT
-
-TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
-TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
-       if $XS;
-}
-
-{
-  $a = [{ a => \$b }, { b => undef }];
-  $b = [{ c => \$b }, { d => \$a }];
-
-############# 151
-##
-  $WANT = <<'EOT';
-#$a = [
-#  {
-#    a => \[
-#        {
-#          c => do{my $o}
-#        },
-#        {
-#          d => \[]
-#        }
-#      ]
-#  },
-#  {
-#    b => undef
-#  }
-#];
-#${$a->[0]{a}}->[0]->{c} = $a->[0]{a};
-#${${$a->[0]{a}}->[1]->{d}} = $a;
-#$b = ${$a->[0]{a}};
-EOT
-
-TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
-TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
-       if $XS;
-}
-
-{
-  $a = [[[[\\\\\'foo']]]];
-  $b = $a->[0][0];
-  $c = $${$b->[0][0]};
-
-############# 157
-##
-  $WANT = <<'EOT';
-#$a = [
-#  [
-#    [
-#      [
-#        \\\\\'foo'
-#      ]
-#    ]
-#  ]
-#];
-#$b = $a->[0][0];
-#$c = ${${$a->[0][0][0][0]}};
-EOT
-
-TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
-TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
-       if $XS;
-}
-
-{
-    $f = "pearl";
-    $e = [        $f ];
-    $d = { 'e' => $e };
-    $c = [        $d ];
-    $b = { 'c' => $c };
-    $a = { 'b' => $b };
-
-############# 163
-##
-  $WANT = <<'EOT';
-#$a = {
-#  b => {
-#    c => [
-#      {
-#        e => 'ARRAY(0xdeadbeef)'
-#      }
-#    ]
-#  }
-#};
-#$b = $a->{b};
-#$c = $a->{b}{c};
-EOT
-
-TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;);
-TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;)
-       if $XS;
-
-############# 169
-##
-  $WANT = <<'EOT';
-#$a = {
-#  b => 'HASH(0xdeadbeef)'
-#};
-#$b = $a->{b};
-#$c = [
-#  'HASH(0xdeadbeef)'
-#];
-EOT
-
-TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;);
-TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;)
-       if $XS;
-}
-
-{
-    $a = \$a;
-    $b = [$a];
-
-############# 175
-##
-  $WANT = <<'EOT';
-#$b = [
-#  \$b->[0]
-#];
-EOT
-
-TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;);
-TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;)
-       if $XS;
-
-############# 181
-##
-  $WANT = <<'EOT';
-#$b = [
-#  \do{my $o}
-#];
-#${$b->[0]} = $b->[0];
-EOT
-
-
-TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;);
-TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;)
-       if $XS;
-}

diff --git a/t/lib/encode.t b/t/lib/encode.t
deleted file mode 100644 (file)
index ceeb422..0000000
--- a/t/lib/encode.t
+++ /dev/null
@@ -1,122 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\Encode\b/) {
-      print "1..0 # Skip: Encode was not built\n";
-      exit 0;
-    }
-}
-use Test;
-use Encode qw(from_to encode decode encode_utf8 decode_utf8 find_encoding);
-use charnames qw(greek);
-my @encodings = grep(/iso-?8859/,Encode::encodings());
-my $n = 2;
-my @character_set = ('0'..'9', 'A'..'Z', 'a'..'z');
-my @source = qw(ascii iso8859-1 cp1250);
-my @destiny = qw(cp1047 cp37 posix-bc);
-my @ebcdic_sets = qw(cp1047 cp37 posix-bc);
-plan test => 38+$n*@encodings + 2*@source*@destiny*@character_set + 2*@ebcdic_sets*256;
-my $str = join('',map(chr($_),0x20..0x7E));
-my $cpy = $str;
-ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong");
-ok($cpy,$str,"ASCII mangled by translating from iso8859-1 to Unicode");
-$cpy = $str;
-ok(from_to($cpy,'Unicode','iso8859-1'),length($str),"Length wrong");
-ok($cpy,$str,"ASCII mangled by translating from Unicode to iso8859-1");
-
-$str = join('',map(chr($_),0xa0..0xff));
-$cpy = $str;
-ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong");
-
-my $sym = Encode->getEncoding('symbol');
-my $uni = $sym->decode(encode(ascii => 'a'));
-ok("\N{alpha}",substr($uni,0,1),"alpha does not map to symbol 'a'");
-$str = $sym->encode("\N{Beta}");
-ok("B",decode(ascii => substr($str,0,1)),"Symbol 'B' does not map to Beta");
-
-foreach my $enc (qw(symbol dingbats ascii),@encodings)
- {
-  my $tab = Encode->getEncoding($enc);
-  ok(1,defined($tab),"Could not load $enc");
-  $str = join('',map(chr($_),0x20..0x7E));
-  $uni = $tab->decode($str);
-  $cpy = $tab->encode($uni);
-  ok($cpy,$str,"$enc mangled translating to Unicode and back");
- }
-
-# On ASCII based machines see if we can map several codepoints from
-# three distinct ASCII sets to three distinct EBCDIC coded character sets.
-# On EBCDIC machines see if we can map from three EBCDIC sets to three
-# distinct ASCII sets.
-
-my @expectation = (240..249, 193..201,209..217,226..233, 129..137,145..153,162..169);
-if (ord('A') != 65) {
-    my @temp = @destiny;
-    @destiny = @source;
-    @source = @temp;
-    undef(@temp);
-    @expectation = (48..57, 65..90, 97..122);
-}
-
-foreach my $to (@destiny)
- {
-  foreach my $from (@source)
-   {
-    my @expected = @expectation;
-    foreach my $chr (@character_set)
-     {
-      my $native_chr = $chr;
-      my $cpy = $chr;
-      my $rc = from_to($cpy,$from,$to);
-      ok(1,$rc,"Could not translate from $from to $to");
-      ok(ord($cpy),shift(@expected),"mangled translating $native_chr from $from to $to");
-     }
-   }
- }
-
-# On either ASCII or EBCDIC machines ensure we can take the full one
-# byte repetoire to EBCDIC sets and back.
-
-my $enc_as = 'iso8859-1';
-foreach my $enc_eb (@ebcdic_sets)
- {
-  foreach my $ord (0..255)
-   {
-    $str = chr($ord);
-    my $rc = from_to($str,$enc_as,$enc_eb);
-    $rc += from_to($str,$enc_eb,$enc_as);
-    ok($rc,2,"return code for $ord $enc_eb -> $enc_as -> $enc_eb was not obtained");
-    ok($ord,ord($str),"$enc_as mangled translating $ord to $enc_eb and back");
-   }
- }
-
-my $mime = find_encoding('iso-8859-2');
-ok(defined($mime),1,"Cannot find MIME-ish'iso-8859-2'");
-my $x11 = find_encoding('iso8859-2');
-ok(defined($x11),1,"Cannot find X11-ish 'iso8859-2'");
-ok($mime,$x11,"iso8598-2 and iso-8859-2 not same");
-my $spc = find_encoding('iso 8859-2');
-ok(defined($spc),1,"Cannot find 'iso 8859-2'");
-ok($spc,$mime,"iso 8859-2 and iso-8859-2 not same");
-
-for my $i (256,128,129,256)
- {
-  my $c = chr($i);
-  my $s = "$c\n".sprintf("%02X",$i);
-  ok(utf8::valid($s),1,"concat of $i botched");
-  utf8::upgrade($s);
-  ok(utf8::valid($s),1,"concat of $i botched");
- }
-
-# Spot check a few points in/out of utf8
-for my $i (0x41,128,256,0x20AC)
- {
-  my $c = chr($i);
-  my $o = encode_utf8($c);
-  ok(decode_utf8($o),$c,"decode_utf8 not inverse of encode_utf8 for $i");
-  ok(encode('utf8',$c),$o,"utf8 encode by name broken for $i");
-  ok(decode('utf8',$o),$c,"utf8 decode by name broken for $i");
- }
-
-

diff --git a/t/lib/english.t b/t/lib/english.t
deleted file mode 100755 (executable)
index 459dc3b..0000000
--- a/t/lib/english.t
+++ /dev/null
@@ -1,65 +0,0 @@
-#!./perl
-
-print "1..22\n";
-
-BEGIN { @INC = '../lib' }
-use English qw( -no_match_vars ) ;
-use Config;
-my $threads = $Config{'use5005threads'} || 0;
-
-print $PID == $$ ? "ok 1\n" : "not ok 1\n";
-
-$_ = 1;
-print $ARG == $_  || $threads ? "ok 2\n" : "not ok 2\n";
-
-sub foo {
-    print $ARG[0] == $_[0] || $threads ? "ok 3\n" : "not ok 3\n";
-}
-&foo(1);
-
-"abc" =~ /b/;
-
-print ! $PREMATCH  ? "" : "not ", "ok 4\n" ;
-print ! $MATCH     ? "" : "not ", "ok 5\n" ;
-print ! $POSTMATCH ? "" : "not ", "ok 6\n" ;
-
-$OFS = " ";
-$ORS = "\n";
-print 'ok',7;
-undef $OUTPUT_FIELD_SEPARATOR;
-
-if ($threads) { $" = "\n" } else { $LIST_SEPARATOR = "\n" };
-@foo = ("ok 8", "ok 9");
-print "@foo";
-undef $OUTPUT_RECORD_SEPARATOR;
-
-eval 'NO SUCH FUNCTION';
-print "ok 10\n" if $EVAL_ERROR =~ /method/ || $threads;
-
-print $UID == $< ? "ok 11\n" : "not ok 11\n";
-print $GID == $( ? "ok 12\n" : "not ok 12\n";
-print $EUID == $> ? "ok 13\n" : "not ok 13\n";
-print $EGID == $) ? "ok 14\n" : "not ok 14\n";
-
-print $PROGRAM_NAME eq $0 ? "ok 15\n" : "not ok 15\n";
-print $BASETIME == $^T ? "ok 16\n" : "not ok 16\n";
-
-package B ;
-
-use English ;
-
-"abc" =~ /b/;
-
-print $PREMATCH  ? "" : "not ", "ok 17\n" ;
-print $MATCH     ? "" : "not ", "ok 18\n" ;
-print $POSTMATCH ? "" : "not ", "ok 19\n" ;
-
-package C ;
-
-use English qw( -no_match_vars ) ;
-
-"abc" =~ /b/;
-
-print ! $PREMATCH  ? "" : "not ", "ok 20\n" ;
-print ! $MATCH     ? "" : "not ", "ok 21\n" ;
-print ! $POSTMATCH ? "" : "not ", "ok 22\n" ;

diff --git a/t/lib/env-array.t b/t/lib/env-array.t
deleted file mode 100755 (executable)
index c5068fd..0000000
--- a/t/lib/env-array.t
+++ /dev/null
@@ -1,100 +0,0 @@
-#!./perl
-
-$| = 1;
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-if ($^O eq 'VMS') {
-    print "1..11\n";
-    foreach (1..11) { print "ok $_ # skipped for VMS\n"; }
-    exit 0;
-}
-
-use Env  qw(@FOO);
-use vars qw(@BAR);
-
-sub array_equal
-{
-    my ($a, $b) = @_;
-    return 0 unless scalar(@$a) == scalar(@$b);
-    for my $i (0..scalar(@$a) - 1) {
-       return 0 unless $a->[$i] eq $b->[$i];
-    }
-    return 1;
-}
-
-sub test
-{
-    my ($desc, $code) = @_;
-
-    &$code;
-
-    print "# $desc...\n";
-    print "#    FOO = (", join(", ", @FOO), ")\n";
-    print "#    BAR = (", join(", ", @BAR), ")\n";
-
-    if (defined $check) { print "not " unless &$check; }
-    else { print "not " unless array_equal(\@FOO, \@BAR); }
-
-    print "ok ", ++$i, "\n";
-}
-
-print "1..11\n";
-
-test "Assignment", sub {
-    @FOO = qw(a B c);
-    @BAR = qw(a B c);
-};
-
-test "Storing", sub {
-    $FOO[1] = 'b';
-    $BAR[1] = 'b';
-};
-
-test "Truncation", sub {
-    $#FOO = 0;
-    $#BAR = 0;
-};
-
-test "Push", sub {
-    push @FOO, 'b', 'c';
-    push @BAR, 'b', 'c';
-};
-
-test "Pop", sub {
-    pop @FOO;
-    pop @BAR;
-};
-
-test "Shift", sub {
-    shift @FOO;
-    shift @BAR;
-};
-
-test "Push", sub {
-    push @FOO, 'c';
-    push @BAR, 'c';
-};
-
-test "Unshift", sub {
-    unshift @FOO, 'a';
-    unshift @BAR, 'a';
-};
-
-test "Reverse", sub {
-    @FOO = reverse @FOO;
-    @BAR = reverse @BAR;
-};
-
-test "Sort", sub {
-    @FOO = sort @FOO;
-    @BAR = sort @BAR;
-};
-
-test "Splice", sub {
-    splice @FOO, 1, 1, 'B';
-    splice @BAR, 1, 1, 'B';
-};

diff --git a/t/lib/env.t b/t/lib/env.t
deleted file mode 100755 (executable)
index ff6af2e..0000000
--- a/t/lib/env.t
+++ /dev/null
@@ -1,25 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN {
-       $ENV{FOO} = "foo";
-       $ENV{BAR} = "bar";
-}
-
-use Env qw(FOO $BAR);
-
-$FOO .= "/bar";
-$BAR .= "/baz";
-
-print "1..2\n";
-
-print "not " if $FOO ne 'foo/bar';
-print "ok 1\n";
-
-print "not " if $BAR ne 'bar/baz';
-print "ok 2\n";
-

diff --git a/t/lib/errno.t b/t/lib/errno.t
deleted file mode 100755 (executable)
index 02f5ce2..0000000
--- a/t/lib/errno.t
+++ /dev/null
@@ -1,54 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-       chdir 't' if -d 't';
-       if ($^O eq 'MacOS') { 
-           @INC = qw(: ::lib ::macos:lib); 
-       } else { 
-           @INC = '../lib'; 
-       }
-    }
-}
-
-use Errno;
-
-print "1..5\n";
-
-print "not " unless @Errno::EXPORT_OK;
-print "ok 1\n";
-die unless @Errno::EXPORT_OK;
-
-$err = $Errno::EXPORT_OK[0];
-$num = &{"Errno::$err"};
-
-print "not " unless &{"Errno::$err"} == $num;
-print "ok 2\n";
-
-$! = $num;
-print "not " unless $!{$err};
-print "ok 3\n";
-
-$! = 0;
-print "not " if $!{$err};
-print "ok 4\n";
-
-$s1 = join(",",sort keys(%!));
-$s2 = join(",",sort @Errno::EXPORT_OK);
-
-if($s1 ne $s2) {
-    my @s1 = keys(%!);
-    my @s2 = @Errno::EXPORT_OK;
-    my(%s1,%s2);
-    @s1{@s1} = ();
-    @s2{@s2} = ();
-    delete @s2{@s1};
-    delete @s1{@s2};
-    print "# These are only in \%!\n";
-    print "# ",join(" ",map { "'$_'" } keys %s1),"\n";
-    print "# These are only in \@EXPORT_OK\n";
-    print "# ",join(" ",map { "'$_'" } keys %s2),"\n";
-    print "not ";
-}
-
-print "ok 5\n";

diff --git a/t/lib/exporter.t b/t/lib/exporter.t
deleted file mode 100644 (file)
index a0028fe..0000000
--- a/t/lib/exporter.t
+++ /dev/null
@@ -1,145 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# Utility testing functions.
-my $test_num = 1;
-sub ok ($;$) {
-    my($test, $name) = @_;
-    print "not " unless $test;
-    print "ok $test_num";
-    print " - $name" if (defined $name && ! $^O eq 'VMS');
-    print "\n";
-    $test_num++;
-}
-
-
-my $loaded;
-BEGIN { $| = 1; $^W = 1; }
-END {print "not ok $test_num\n" unless $loaded;}
-print "1..$Total_tests\n";
-use Exporter;
-$loaded = 1;
-ok(1, 'compile');
-
-
-BEGIN {
-    # Methods which Exporter says it implements.
-    @Exporter_Methods = qw(import
-                           export_to_level
-                           require_version
-                           export_fail
-                          );
-}
-
-BEGIN { $Total_tests = 14 + @Exporter_Methods }
-
-package Testing;
-require Exporter;
-@ISA = qw(Exporter);
-
-# Make sure Testing can do everything its supposed to.
-foreach my $meth (@::Exporter_Methods) {
-    ::ok( Testing->can($meth), "subclass can $meth()" );
-}
-
-%EXPORT_TAGS = (
-                This => [qw(stuff %left)],
-                That => [qw(Above the @wailing)],
-                tray => [qw(Fasten $seatbelt)],
-               );
-@EXPORT    = qw(lifejacket);
-@EXPORT_OK = qw(under &your $seat);
-$VERSION = '1.05';
-
-::ok( Testing->require_version(1.05),   'require_version()' );
-eval { Testing->require_version(1.11); 1 };
-::ok( $@,                               'require_version() fail' );
-::ok( Testing->require_version(0),      'require_version(0)' );
-
-sub lifejacket  { 'lifejacket'  }
-sub stuff       { 'stuff'       }
-sub Above       { 'Above'       }
-sub the         { 'the'         }
-sub Fasten      { 'Fasten'      }
-sub your        { 'your'        }
-sub under       { 'under'       }
-use vars qw($seatbelt $seat @wailing %left);
-$seatbelt = 'seatbelt';
-$seat     = 'seat';
-@wailing = qw(AHHHHHH);
-%left = ( left => "right" );
-
-
-Exporter::export_ok_tags;
-
-my %tags     = map { $_ => 1 } map { @$_ } values %EXPORT_TAGS;
-my %exportok = map { $_ => 1 } @EXPORT_OK;
-my $ok = 1;
-foreach my $tag (keys %tags) {
-    $ok = exists $exportok{$tag};
-}
-::ok( $ok, 'export_ok_tags()' );
-
-
-package Foo;
-Testing->import;
-
-::ok( defined &lifejacket,      'simple import' );
-
-
-package Bar;
-my @imports = qw($seatbelt &Above stuff @wailing %left);
-Testing->import(@imports);
-
-::ok( (!grep { eval "!defined $_" } map({ /^\w/ ? "&$_" : $_ } @imports)),
-      'import by symbols' );
-
-
-package Yar;
-my @tags = qw(:This :tray);
-Testing->import(@tags);
-
-::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
-             map { @$_ } @{$Testing::EXPORT_TAGS{@tags}}),
-      'import by tags' );
-
-
-package Arrr;
-Testing->import(qw(!lifejacket));
-
-::ok( !defined &lifejacket,     'deny import by !' );
-
-
-package Mars;
-Testing->import('/e/');
-
-::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
-            grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
-      'import by regex');
-
-
-package Venus;
-Testing->import('!/e/');
-
-::ok( (!grep { eval "defined $_" } map { /^\w/ ? "&$_" : $_ }
-            grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
-      'deny import by regex');
-::ok( !defined &lifejacket, 'further denial' );
-
-
-package More::Testing;
-@ISA = qw(Exporter);
-$VERSION = 0;
-eval { More::Testing->require_version(0); 1 };
-::ok(!$@,       'require_version(0) and $VERSION = 0');
-
-
-package Yet::More::Testing;
-@ISA = qw(Exporter);
-$VERSION = 0;
-eval { Yet::More::Testing->require_version(10); 1 };
-::ok($@ !~ /\(undef\)/,       'require_version(10) and $VERSION = 0');

diff --git a/t/lib/extutils.t b/t/lib/extutils.t
deleted file mode 100644 (file)
index 50a9fe4..0000000
--- a/t/lib/extutils.t
+++ /dev/null
@@ -1,483 +0,0 @@
-#!./perl -w
-
-print "1..27\n";
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use warnings;
-use strict;
-use ExtUtils::MakeMaker;
-use ExtUtils::Constant qw (constant_types C_constant XS_constant autoload);
-use Config;
-use File::Spec::Functions;
-use File::Spec;
-# Because were are going to be changing directory before running Makefile.PL
-my $perl = File::Spec->rel2abs( $^X );
-# ExtUtils::Constant::C_constant uses $^X inside a comment, and we want to
-# compare output to ensure that it is the same. We were probably run as ./perl
-# whereas we will run the child with the full path in $perl. So make $^X for
-# us the same as our child will see.
-$^X = $perl;
-
-print "# perl=$perl\n";
-my $runperl = "$perl -x \"-I../../lib\"";
-
-$| = 1;
-
-my $dir = "ext-$$";
-my @files;
-
-print "# $dir being created...\n";
-mkdir $dir, 0777 or die "mkdir: $!\n";
-
-
-END {
-    use File::Path;
-    print "# $dir being removed...\n";
-    rmtree($dir);
-}
-
-my $package = "ExtTest";
-
-# Test the code that generates 1 and 2 letter name comparisons.
-my %compass = (
-N => 0, NE => 45, E => 90, SE => 135, S => 180, SW => 225, W => 270, NW => 315
-);
-
-my $parent_rfc1149 =
-  'A Standard for the Transmission of IP Datagrams on Avian Carriers';
-
-my @names = ("FIVE", {name=>"OK6", type=>"PV",},
-             {name=>"OK7", type=>"PVN",
-              value=>['"not ok 7\\n\\0ok 7\\n"', 15]},
-             {name => "FARTHING", type=>"NV"},
-             {name => "NOT_ZERO", type=>"UV", value=>"~(UV)0"},
-             {name => "OPEN", type=>"PV", value=>'"/*"', macro=>1},
-             {name => "CLOSE", type=>"PV", value=>'"*/"',
-              macro=>["#if 1\n", "#endif\n"]},
-             {name => "ANSWER", default=>["UV", 42]}, "NOTDEF",
-             {name => "Yes", type=>"YES"},
-             {name => "No", type=>"NO"},
-             {name => "Undef", type=>"UNDEF"},
-# OK. It wasn't really designed to allow the creation of dual valued constants.
-# It was more for INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
-             {name=>"RFC1149", type=>"SV", value=>"sv_2mortal(temp_sv)",
-              pre=>"SV *temp_sv = newSVpv(RFC1149, 0); "
-                  . "(void) SvUPGRADE(temp_sv,SVt_PVIV); SvIOK_on(temp_sv); "
-                   . "SvIVX(temp_sv) = 1149;"},
-);
-
-push @names, $_ foreach keys %compass;
-
-my @names_only = map {(ref $_) ? $_->{name} : $_} @names;
-
-my $types = {};
-my $constant_types = constant_types(); # macro defs
-my $C_constant = join "\n",
-  C_constant ($package, undef, "IV", $types, undef, undef, @names);
-my $XS_constant = XS_constant ($package, $types); # XS for ExtTest::constant
-
-################ Header
-my $header = catfile($dir, "test.h");
-push @files, "test.h";
-open FH, ">$header" or die "open >$header: $!\n";
-print FH <<"EOT";
-#define FIVE 5
-#define OK6 "ok 6\\n"
-#define OK7 1
-#define FARTHING 0.25
-#define NOT_ZERO 1
-#define Yes 0
-#define No 1
-#define Undef 1
-#define RFC1149 "$parent_rfc1149"
-#undef NOTDEF
-
-EOT
-
-while (my ($point, $bearing) = each %compass) {
-  print FH "#define $point $bearing\n"
-}
-close FH or die "close $header: $!\n";
-
-################ XS
-my $xs = catfile($dir, "$package.xs");
-push @files, "$package.xs";
-open FH, ">$xs" or die "open >$xs: $!\n";
-
-print FH <<'EOT';
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-EOT
-
-print FH "#include \"test.h\"\n\n";
-print FH $constant_types;
-print FH $C_constant, "\n";
-print FH "MODULE = $package            PACKAGE = $package\n";
-print FH "PROTOTYPES: ENABLE\n";
-print FH $XS_constant;
-close FH or die "close $xs: $!\n";
-
-################ PM
-my $pm = catfile($dir, "$package.pm");
-push @files, "$package.pm";
-open FH, ">$pm" or die "open >$pm: $!\n";
-print FH "package $package;\n";
-print FH "use $];\n";
-
-print FH <<'EOT';
-
-use strict;
-use warnings;
-use Carp;
-
-require Exporter;
-require DynaLoader;
-use vars qw ($VERSION @ISA @EXPORT_OK);
-
-$VERSION = '0.01';
-@ISA = qw(Exporter DynaLoader);
-@EXPORT_OK = qw(
-EOT
-
-print FH "\t$_\n" foreach (@names_only);
-print FH ");\n";
-print FH autoload ($package, $]);
-print FH "bootstrap $package \$VERSION;\n1;\n__END__\n";
-close FH or die "close $pm: $!\n";
-
-################ test.pl
-my $testpl = catfile($dir, "test.pl");
-push @files, "test.pl";
-open FH, ">$testpl" or die "open >$testpl: $!\n";
-
-print FH "use strict;\n";
-print FH "use $package qw(@names_only);\n";
-print FH <<'EOT';
-
-# IV
-my $five = FIVE;
-if ($five == 5) {
-  print "ok 5\n";
-} else {
-  print "not ok 5 # $five\n";
-}
-
-# PV
-print OK6;
-
-# PVN containing embedded \0s
-$_ = OK7;
-s/.*\0//s;
-print;
-
-# NV
-my $farthing = FARTHING;
-if ($farthing == 0.25) {
-  print "ok 8\n";
-} else {
-  print "not ok 8 # $farthing\n";
-}
-
-# UV
-my $not_zero = NOT_ZERO;
-if ($not_zero > 0 && $not_zero == ~0) {
-  print "ok 9\n";
-} else {
-  print "not ok 9 # \$not_zero=$not_zero ~0=" . (~0) . "\n";
-}
-
-# Value includes a "*/" in an attempt to bust out of a C comment.
-# Also tests custom cpp #if clauses
-my $close = CLOSE;
-if ($close eq '*/') {
-  print "ok 10\n";
-} else {
-  print "not ok 10 # \$close='$close'\n";
-}
-
-# Default values if macro not defined.
-my $answer = ANSWER;
-if ($answer == 42) {
-  print "ok 11\n";
-} else {
-  print "not ok 11 # What do you get if you multiply six by nine? '$answer'\n";
-}
-
-# not defined macro
-my $notdef = eval { NOTDEF; };
-if (defined $notdef) {
-  print "not ok 12 # \$notdef='$notdef'\n";
-} elsif ($@ !~ /Your vendor has not defined ExtTest macro NOTDEF/) {
-  print "not ok 12 # \$@='$@'\n";
-} else {
-  print "ok 12\n";
-}
-
-# not a macro
-my $notthere = eval { &ExtTest::NOTTHERE; };
-if (defined $notthere) {
-  print "not ok 13 # \$notthere='$notthere'\n";
-} elsif ($@ !~ /NOTTHERE is not a valid ExtTest macro/) {
-  chomp $@;
-  print "not ok 13 # \$@='$@'\n";
-} else {
-  print "ok 13\n";
-}
-
-# Truth
-my $yes = Yes;
-if ($yes) {
-  print "ok 14\n";
-} else {
-  print "not ok 14 # $yes='\$yes'\n";
-}
-
-# Falsehood
-my $no = No;
-if (defined $no and !$no) {
-  print "ok 15\n";
-} else {
-  print "not ok 15 # \$no=" . defined ($no) ? "'$no'\n" : "undef\n";
-}
-
-# Undef
-my $undef = Undef;
-unless (defined $undef) {
-  print "ok 16\n";
-} else {
-  print "not ok 16 # \$undef='$undef'\n";
-}
-
-
-# invalid macro (chosen to look like a mix up between No and SW)
-$notdef = eval { &ExtTest::So };
-if (defined $notdef) {
-  print "not ok 17 # \$notdef='$notdef'\n";
-} elsif ($@ !~ /^So is not a valid ExtTest macro/) {
-  print "not ok 17 # \$@='$@'\n";
-} else {
-  print "ok 17\n";
-}
-
-# invalid defined macro
-$notdef = eval { &ExtTest::EW };
-if (defined $notdef) {
-  print "not ok 18 # \$notdef='$notdef'\n";
-} elsif ($@ !~ /^EW is not a valid ExtTest macro/) {
-  print "not ok 18 # \$@='$@'\n";
-} else {
-  print "ok 18\n";
-}
-
-my %compass = (
-EOT
-
-while (my ($point, $bearing) = each %compass) {
-  print FH "$point => $bearing, "
-}
-
-print FH <<'EOT';
-
-);
-
-my $fail;
-while (my ($point, $bearing) = each %compass) {
-  my $val = eval $point;
-  if ($@) {
-    print "# $point: \$@='$@'\n";
-    $fail = 1;
-  } elsif (!defined $bearing) {
-    print "# $point: \$val=undef\n";
-    $fail = 1;
-  } elsif ($val != $bearing) {
-    print "# $point: \$val=$val, not $bearing\n";
-    $fail = 1;
-  }
-}
-if ($fail) {
-  print "not ok 19\n";
-} else {
-  print "ok 19\n";
-}
-
-EOT
-
-print FH <<"EOT";
-my \$rfc1149 = RFC1149;
-if (\$rfc1149 ne "$parent_rfc1149") {
-  print "not ok 20 # '\$rfc1149' ne '$parent_rfc1149'\n";
-} else {
-  print "ok 20\n";
-}
-
-if (\$rfc1149 != 1149) {
-  printf "not ok 21 # %d != 1149\n", \$rfc1149;
-} else {
-  print "ok 21\n";
-}
-
-EOT
-
-print FH <<'EOT';
-# test macro=>1
-my $open = OPEN;
-if ($open eq '/*') {
-  print "ok 22\n";
-} else {
-  print "not ok 22 # \$open='$open'\n";
-}
-EOT
-close FH or die "close $testpl: $!\n";
-
-################ Makefile.PL
-# We really need a Makefile.PL because make test for a no dynamic linking perl
-# will run Makefile.PL again as part of the "make perl" target.
-my $makefilePL = catfile($dir, "Makefile.PL");
-push @files, "Makefile.PL";
-open FH, ">$makefilePL" or die "open >$makefilePL: $!\n";
-print FH <<"EOT";
-#!$perl -w
-use ExtUtils::MakeMaker;
-WriteMakefile(
-              'NAME'           => "$package",
-              'VERSION_FROM'   => "$package.pm", # finds \$VERSION
-              (\$] >= 5.005 ?
-               (#ABSTRACT_FROM => "$package.pm", # XXX add this
-                AUTHOR     => "$0") : ())
-             );
-EOT
-
-close FH or die "close $makefilePL: $!\n";
-
-chdir $dir or die $!; push @INC,  '../../lib';
-END {chdir ".." or warn $!};
-
-my @perlout = `$runperl Makefile.PL`;
-if ($?) {
-  print "not ok 1 # $runperl Makefile.PL failed: $?\n";
-  print "# $_" foreach @perlout;
-  exit($?);
-} else {
-  print "ok 1\n";
-}
-
-
-my $makefile = ($^O eq 'VMS' ? 'descrip' : 'Makefile');
-my $makefile_ext = ($^O eq 'VMS' ? '.mms' : '');
-if (-f "$makefile$makefile_ext") {
-  print "ok 2\n";
-} else {
-  print "not ok 2\n";
-}
-my $makefile_rename = ($^O eq 'VMS' ? '.mms' : '.old');
-push @files, "$makefile$makefile_rename"; # Renamed by make clean
-
-my $make = $Config{make};
-
-$make = $ENV{MAKE} if exists $ENV{MAKE};
-
-my $makeout;
-
-print "# make = '$make'\n";
-$makeout = `$make`;
-if ($?) {
-  print "not ok 3 # $make failed: $?\n";
-  exit($?);
-} else {
-  print "ok 3\n";
-}
-
-if ($Config{usedl}) {
-  print "ok 4\n";
-} else {
-  push @files, "perl$Config{exe_ext}";
-  my $makeperl = "$make perl";
-  print "# make = '$makeperl'\n";
-  $makeout = `$makeperl`;
-  if ($?) {
-    print "not ok 4 # $makeperl failed: $?\n";
-    exit($?);
-  } else {
-    print "ok 4\n";
-  }
-}
-
-my $test = 23;
-my $maketest = "$make test";
-print "# make = '$maketest'\n";
-$makeout = `$maketest`;
-
-# echo of running the test script
-$makeout =~ s/^\s*PERL_DL_NONLAZY=.+?\n//m;
-$makeout =~ s/^MCR.+test.pl\n//mig if $^O eq 'VMS';
-
-# GNU make babblings
-$makeout =~ s/^\w*?make.+?(?:entering|leaving) directory.+?\n//mig;
-
-# Hopefully gets most make's babblings
-# make -f Makefile.aperl perl
-$makeout =~ s/^\w*?make.+\sperl[^A-Za-z0-9]*\n//mig;
-# make[1]: `perl' is up to date.
-$makeout =~ s/^\w*?make.+perl.+?is up to date.*?\n//mig;
-
-print $makeout;
-
-if ($?) {
-  print "not ok $test # $maketest failed: $?\n";
-} else {
-  print "ok $test\n";
-}
-$test++;
-
-my $regen = `$runperl $package.xs`;
-if ($?) {
-  print "not ok $test # $runperl $package.xs failed: $?\n";
-} else {
-  print "ok $test\n";
-}
-$test++;
-
-my $expect = $constant_types . $C_constant .
-  "\n#### XS Section:\n" . $XS_constant;
-
-if ($expect eq $regen) {
-  print "ok $test\n";
-} else {
-  print "not ok $test\n";
-  # open FOO, ">expect"; print FOO $expect;
-  # open FOO, ">regen"; print FOO $regen; close FOO;
-}
-$test++;
-
-my $makeclean = "$make clean";
-print "# make = '$makeclean'\n";
-$makeout = `$makeclean`;
-if ($?) {
-  print "not ok $test # $make failed: $?\n";
-} else {
-  print "ok $test\n";
-}
-$test++;
-
-foreach (@files) {
-  unlink $_ or warn "unlink $_: $!";
-}
-
-my $fail;
-opendir DIR, "." or die "opendir '.': $!";
-while (defined (my $entry = readdir DIR)) {
-  next if $entry =~ /^\.\.?$/;
-  print "# Extra file '$entry'\n";
-  $fail = 1;
-}
-closedir DIR or warn "closedir '.': $!";
-if ($fail) {
-  print "not ok $test\n";
-} else {
-  print "ok $test\n";
-}

diff --git a/t/lib/fatal.t b/t/lib/fatal.t
deleted file mode 100755 (executable)
index f00b876..0000000
--- a/t/lib/fatal.t
+++ /dev/null
@@ -1,36 +0,0 @@
-#!./perl -w
-
-BEGIN {
-   chdir 't' if -d 't';
-   @INC = '../lib';
-   print "1..15\n";
-}
-
-use strict;
-use Fatal qw(open close :void opendir);
-
-my $i = 1;
-eval { open FOO, '<lkjqweriuapofukndajsdlfjnvcvn' };
-print "not " unless $@ =~ /^Can't open/;
-print "ok $i\n"; ++$i;
-
-my $foo = 'FOO';
-for ('$foo', "'$foo'", "*$foo", "\\*$foo") {
-    eval qq{ open $_, '<$0' };
-    print "not " if $@;
-    print "ok $i\n"; ++$i;
-
-    print "not " if $@ or scalar(<$foo>) !~ m|^#!./perl|;
-    print "ok $i\n"; ++$i;
-    eval qq{ close FOO };
-    print "not " if $@;
-    print "ok $i\n"; ++$i;
-}
-
-eval { opendir FOO, 'lkjqweriuapofukndajsdlfjnvcvn' };
-print "not " unless $@ =~ /^Can't open/;
-print "ok $i\n"; ++$i;
-
-eval { my $a = opendir FOO, 'lkjqweriuapofukndajsdlfjnvcvn' };
-print "not " if $@ =~ /^Can't open/;
-print "ok $i\n"; ++$i;

diff --git a/t/lib/fcntl.t b/t/lib/fcntl.t
deleted file mode 100644 (file)
index 24ade27..0000000
--- a/t/lib/fcntl.t
+++ /dev/null
@@ -1,46 +0,0 @@
-#!./perl
-
-# A modest test: exercises only O_WRONLY, O_CREAT, and O_RDONLY.
-# Have to be modest to be portable: could possibly extend testing
-# also to O_RDWR and O_APPEND, but dunno about the portability of,
-# say, O_TRUNC and O_EXCL, not to mention O_NONBLOCK.
-
-use Fcntl;
-
-print "1..6\n";
-
-print "ok 1\n";
-
-if (sysopen(my $wo, "fcntl$$", O_WRONLY|O_CREAT)) {
-    print "ok 2\n";
-    if (syswrite($wo, "foo") == 3) {
-       print "ok 3\n";
-       close($wo);
-       if (sysopen(my $ro, "fcntl$$", O_RDONLY)) {
-           print "ok 4\n";
-           if (sysread($ro, my $read, 3)) {
-               print "ok 5\n";
-               if ($read eq "foo") {
-                   print "ok 6\n";
-               } else {
-                   print "not ok 6 # content '$read' not ok\n";
-               }
-           } else {
-               print "not ok 5 # sysread failed: $!\n";
-           }
-       } else {
-           print "not ok 4 # sysopen O_RDONLY failed: $!\n";
-       }
-       close($ro);
-    } else {
-       print "not ok 3 # syswrite failed: $!\n";
-    }
-    close($wo);
-} else {
-    print "not ok 2 # sysopen O_WRONLY failed: $!\n";
-}
-
-END {
-    1 while unlink "fcntl$$";
-}
-

diff --git a/t/lib/fields.t b/t/lib/fields.t
deleted file mode 100755 (executable)
index b4b5cce..0000000
--- a/t/lib/fields.t
+++ /dev/null
@@ -1,197 +0,0 @@
-#!./perl -w
-
-my $w;
-
-BEGIN {
-   chdir 't' if -d 't';
-   @INC = '../lib';
-   $SIG{__WARN__} = sub {
-       if ($_[0] =~ /^Hides field 'b1' in base class/) {
-           $w++;
-           return;
-       }
-       print $_[0];
-   };
-}
-
-use strict;
-use warnings;
-use vars qw($DEBUG);
-
-package B1;
-use fields qw(b1 b2 b3);
-
-package B2;
-use fields '_b1';
-use fields qw(b1 _b2 b2);
-
-sub new { bless [], shift }
-
-package D1;
-use base 'B1';
-use fields qw(d1 d2 d3);
-
-package D2;
-use base 'B1';
-use fields qw(_d1 _d2);
-use fields qw(d1 d2);
-
-package D3;
-use base 'B2';
-use fields qw(b1 d1 _b1 _d1);  # hide b1
-
-package D4;
-use base 'D3';
-use fields qw(_d3 d3);
-
-package M;
-sub m {}
-
-package D5;
-use base qw(M B2);
-
-package Foo::Bar;
-use base 'B1';
-
-package Foo::Bar::Baz;
-use base 'Foo::Bar';
-use fields qw(foo bar baz);
-
-# Test repeatability for when modules get reloaded.
-package B1;
-use fields qw(b1 b2 b3);
-
-package D3;
-use base 'B2';
-use fields qw(b1 d1 _b1 _d1);  # hide b1
-
-package main;
-
-sub fstr {
-   my $h = shift;
-   my @tmp;
-   for my $k (sort {$h->{$a} <=> $h->{$b}} keys %$h) {
-       my $v = $h->{$k};
-        push(@tmp, "$k:$v");
-   }
-   my $str = join(",", @tmp);
-   print "$h => $str\n" if $DEBUG;
-   $str;
-}
-
-my %expect = (
-    B1 => "b1:1,b2:2,b3:3",
-    B2 => "_b1:1,b1:2,_b2:3,b2:4",
-    D1 => "b1:1,b2:2,b3:3,d1:4,d2:5,d3:6",
-    D2 => "b1:1,b2:2,b3:3,_d1:4,_d2:5,d1:6,d2:7",
-    D3 => "b2:4,b1:5,d1:6,_b1:7,_d1:8",
-    D4 => "b2:4,b1:5,d1:6,_d3:9,d3:10",
-    D5 => "b1:2,b2:4",
-    'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6',
-);
-
-print "1..", int(keys %expect)+15, "\n";
-my $testno = 0;
-while (my($class, $exp) = each %expect) {
-   no strict 'refs';
-   my $fstr = fstr(\%{$class."::FIELDS"});
-   print "EXP: $exp\nGOT: $fstr\nnot " unless $fstr eq $exp;
-   print "ok ", ++$testno, "\n";
-}
-
-# Did we get the appropriate amount of warnings?
-print "not " unless $w == 1;
-print "ok ", ++$testno, "\n";
-
-# A simple object creation and AVHV attribute access test
-my B2 $obj1 = D3->new;
-$obj1->{b1} = "B2";
-my D3 $obj2 = $obj1;
-$obj2->{b1} = "D3";
-
-print "not " unless $obj1->[2] eq "B2" && $obj1->[5] eq "D3";
-print "ok ", ++$testno, "\n";
-
-# We should get compile time failures field name typos
-eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = "");
-print "not " unless $@ && $@ =~ /^No such pseudo-hash field "notthere"/;
-print "ok ", ++$testno, "\n";
-
-# Slices
-@$obj1{"_b1", "b1"} = (17, 29);
-print "not " unless "@$obj1[1,2]" eq "17 29";
-print "ok ", ++$testno, "\n";
-@$obj1[1,2] = (44,28);
-print "not " unless "@$obj1{'b1','_b1','b1'}" eq "28 44 28";
-print "ok ", ++$testno, "\n";
-
-my $ph = fields::phash(a => 1, b => 2, c => 3);
-print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
-print "ok ", ++$testno, "\n";
-
-$ph = fields::phash([qw/a b c/], [1, 2, 3]);
-print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
-print "ok ", ++$testno, "\n";
-
-$ph = fields::phash([qw/a b c/], [1]);
-print "not " if exists $ph->{b} or exists $ph->{c} or !exists $ph->{a};
-print "ok ", ++$testno, "\n";
-
-eval '$ph = fields::phash("odd")';
-print "not " unless $@ && $@ =~ /^Odd number of/;
-print "ok ", ++$testno, "\n";
-
-#fields::_dump();
-
-# check if fields autovivify
-{
-    package Foo;
-    use fields qw(foo bar);
-    sub new { bless [], $_[0]; }
-
-    package main;
-    my Foo $a = Foo->new();
-    $a->{foo} = ['a', 'ok ' . ++$testno, 'c'];
-    $a->{bar} = { A => 'ok ' . ++$testno };
-    print $a->{foo}[1], "\n";
-    print $a->{bar}->{A}, "\n";
-}
-
-# check if fields autovivify
-{
-    package Bar;
-    use fields qw(foo bar);
-    sub new { return fields::new($_[0]) }
-
-    package main;
-    my Bar $a = Bar::->new();
-    $a->{foo} = ['a', 'ok ' . ++$testno, 'c'];
-    $a->{bar} = { A => 'ok ' . ++$testno };
-    print $a->{foo}[1], "\n";
-    print $a->{bar}->{A}, "\n";
-}
-
-
-# Test $VERSION bug
-package No::Version;
-
-use vars qw($Foo);
-sub VERSION { 42 }
-
-package Test::Version;
-
-use base qw(No::Version);
-print "not " unless $No::Version::VERSION =~ /set by base\.pm/;
-print "ok ", ++$testno ,"\n";
-
-# Test Inverse of $VERSION bug base.pm should not clobber existing $VERSION
-package Has::Version;
-
-BEGIN { $Has::Version::VERSION = '42' };
-
-package Test::Version2;
-
-use base qw(Has::Version);
-print "#$Has::Version::VERSION\nnot " unless $Has::Version::VERSION eq '42';
-print "ok ", ++$testno ,"\n";
-

diff --git a/t/lib/filecache.t b/t/lib/filecache.t
deleted file mode 100755 (executable)
index a97fdd5..0000000
--- a/t/lib/filecache.t
+++ /dev/null
@@ -1,25 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-print "1..1\n";
-
-use FileCache;
-
-# This is really not a complete test as I don't bother to open enough
-# files to make real swapping of open filedescriptor happen.
-
-$path = "foo";
-cacheout $path;
-
-print $path "\n";
-
-close $path;
-
-print "not " unless -f $path;
-print "ok 1\n";
-
-unlink $path;

diff --git a/t/lib/filecomp.t b/t/lib/filecomp.t
deleted file mode 100644 (file)
index aedc323..0000000
--- a/t/lib/filecomp.t
+++ /dev/null
@@ -1,114 +0,0 @@
-#!./perl
-
-BEGIN {
-  chdir 't' if -d 't';
-  @INC = '../lib';
-}
-
-BEGIN {
-  our @TEST = stat "TEST";
-  our @README = stat "README";
-  unless (@TEST && @README) {
-    print "1..0 # Skip: no file TEST or README\n";
-    exit 0;
-  }
-}
-
-print "1..12\n";
-
-use File::Compare qw(compare compare_text);
-
-print "ok 1\n";
-
-# named files, same, existing but different, cause an error
-print "not " unless compare("README","README") == 0;
-print "ok 2\n";
-
-print "not " unless compare("TEST","README") == 1;
-print "ok 3\n";
-
-print "not " unless compare("README","HLAGHLAG") == -1;
-                               # a file which doesn't exist
-print "ok 4\n";
-
-# compare_text, the same file, different but existing files
-# cause error, test sub form.
-print "not " unless compare_text("README","README") == 0;
-print "ok 5\n";
-
-print "not " unless compare_text("TEST","README") == 1;
-print "ok 6\n";
-
-print "not " unless compare_text("TEST","HLAGHLAG") == -1;
-print "ok 7\n";
-
-print "not " unless
-  compare_text("README","README",sub {$_[0] ne $_[1]}) == 0;
-print "ok 8\n";
-
-# filehandle and same file
-{
-  my $fh;
-  open ($fh, "<README") or print "not ";
-  binmode($fh);
-  print "not " unless compare($fh,"README") == 0;
-  print "ok 9\n";
-  close $fh;
-}
-
-# filehandle and different (but existing) file.
-{
-  my $fh;
-  open ($fh, "<README") or print "not ";
-  binmode($fh);
-  print "not " unless compare_text($fh,"TEST") == 1;
-  print "ok 10\n";
-  close $fh;
-}
-
-# Different file with contents of known file,
-# will use File::Temp to do this, skip rest of
-# tests if this doesn't seem to work
-
-my @donetests;
-eval {
-  require File::Spec; import File::Spec;
-  require File::Path; import File::Path;
-  require File::Temp; import File::Temp qw/ :mktemp unlink0 /;
-
-  my $template = File::Spec->catfile(File::Spec->tmpdir, 'fcmpXXXX');
-  my($tfh,$filename) = mkstemp($template);
-  {
-    local $/; #slurp
-    my $fh;
-    open($fh,'README');
-    binmode($fh);
-    my $data = <$fh>;
-    print $tfh $data;
-    close($fh);
-  }
-  seek($tfh,0,0);
-  $donetests[0] = compare($tfh, 'README');
-  $donetests[1] = compare($filename, 'README');
-  unlink0($tfh,$filename);
-};
-print "# problems when testing with a tempory file\n" if $@;
-
-if (@donetests == 2) {
-  print "not " unless $donetests[0] == 0;
-  print "ok 11\n";
-  if ($^O eq 'VMS') {
-    # The open attempt on FROM in File::Compare::compare should fail
-    # on this OS since files are not shared by default.
-    print "not " unless $donetests[1] == -1;
-    print "ok 12\n";
-  }
-  else {
-    print "not " unless $donetests[1] == 0;
-    print "ok 12\n";
-  }
-}
-else {
-  print "ok 11# Skip\nok 12 # Skip Likely due to File::Temp\n";
-}
-

diff --git a/t/lib/filecopy.t b/t/lib/filecopy.t
deleted file mode 100755 (executable)
index 44b5827..0000000
--- a/t/lib/filecopy.t
+++ /dev/null
@@ -1,147 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    push @INC, "::lib:$MacPerl::Architecture" if $^O eq 'MacOS';
-}
-
-$| = 1;
-
-my @pass = (0,1);
-my $tests = $^O eq 'MacOS' ? 14 : 11;
-printf "1..%d\n", $tests * scalar(@pass);
-
-use File::Copy;
-
-for my $pass (@pass) {
-
-  my $loopconst = $pass*$tests;
-
-  # First we create a file
-  open(F, ">file-$$") or die;
-  binmode F; # for DOSISH platforms, because test 3 copies to stdout
-  printf F "ok %d\n", 3 + $loopconst;
-  close F;
-
-  copy "file-$$", "copy-$$";
-
-  open(F, "copy-$$") or die;
-  $foo = <F>;
-  close(F);
-
-  print "not " if -s "file-$$" != -s "copy-$$";
-  printf "ok %d\n", 1 + $loopconst;
-
-  print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
-  printf "ok %d\n", 2+$loopconst;
-
-  binmode STDOUT unless $^O eq 'VMS'; # Copy::copy works in binary mode
-  copy "copy-$$", \*STDOUT;
-  unlink "copy-$$" or die "unlink: $!";
-
-  open(F,"file-$$");
-  copy(*F, "copy-$$");
-  open(R, "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R);
-  print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
-  printf "ok %d\n", 4+$loopconst;
-  unlink "copy-$$" or die "unlink: $!";
-  open(F,"file-$$");
-  copy(\*F, "copy-$$");
-  close(F) or die "close: $!";
-  open(R, "copy-$$") or die; $foo = <R>; close(R) or die "close: $!";
-  print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
-  printf "ok %d\n", 5+$loopconst;
-  unlink "copy-$$" or die "unlink: $!";
-
-  require IO::File;
-  $fh = IO::File->new(">copy-$$") or die "Cannot open copy-$$:$!";
-  binmode $fh or die;
-  copy("file-$$",$fh);
-  $fh->close or die "close: $!";
-  open(R, "copy-$$") or die; $foo = <R>; close(R);
-  print "# foo=`$foo'\nnot " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
-  printf "ok %d\n", 6+$loopconst;
-  unlink "copy-$$" or die "unlink: $!";
-  require FileHandle;
-  my $fh = FileHandle->new(">copy-$$") or die "Cannot open copy-$$:$!";
-  binmode $fh or die;
-  copy("file-$$",$fh);
-  $fh->close;
-  open(R, "copy-$$") or die; $foo = <R>; close(R);
-  print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
-  printf "ok %d\n", 7+$loopconst;
-  unlink "file-$$" or die "unlink: $!";
-
-  print "# moved missing file.\nnot " if move("file-$$", "copy-$$");
-  print "# target disappeared.\nnot " if not -e "copy-$$";
-  printf "ok %d\n", 8+$loopconst;
-
-  move "copy-$$", "file-$$" or print "# move did not succeed.\n";
-  print "# not moved: $!\nnot " unless -e "file-$$" and not -e "copy-$$";
-  open(R, "file-$$") or die; $foo = <R>; close(R);
-  print "# foo=`$foo'\nnot " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
-  printf "ok %d\n", 9+$loopconst;
-
-  if ($^O eq 'MacOS') {
-       
-    copy "file-$$", "lib";     
-    open(R, ":lib:file-$$") or die; $foo = <R>; close(R);
-    print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
-    printf "ok %d\n", 10+$loopconst;
-    unlink ":lib:file-$$" or die "unlink: $!";
-       
-    copy "file-$$", ":lib";    
-    open(R, ":lib:file-$$") or die; $foo = <R>; close(R);
-    print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
-    printf "ok %d\n", 11+$loopconst;
-    unlink ":lib:file-$$" or die "unlink: $!";
-       
-    copy "file-$$", ":lib:";   
-    open(R, ":lib:file-$$") or die; $foo = <R>; close(R);
-    print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
-    printf "ok %d\n", 12+$loopconst;
-    unlink ":lib:file-$$" or die "unlink: $!";
-       
-    unless (-e 'lib:') { # make sure there's no volume called 'lib'
-       undef $@;
-       eval { (copy "file-$$", "lib:") || die "'lib:' is not a volume name"; };
-       print "# Died: $@";
-       print "not " unless ( $@ =~ m|'lib:' is not a volume name| );
-    }
-    printf "ok %d\n", 13+$loopconst;
-
-    move "file-$$", ":lib:";
-    open(R, ":lib:file-$$") or die "open :lib:file-$$: $!"; $foo = <R>; close(R);
-    print "not " unless $foo eq sprintf("ok %d\n", 3+$loopconst)
-        and not -e "file-$$";;
-    printf "ok %d\n", 14+$loopconst;
-    unlink ":lib:file-$$" or die "unlink: $!";
-  
-  } else {
-    
-    copy "file-$$", "lib";
-    open(R, "lib/file-$$") or die; $foo = <R>; close(R);
-    print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
-    printf "ok %d\n", 10+$loopconst;
-    unlink "lib/file-$$" or die "unlink: $!";
-
-    move "file-$$", "lib";
-    open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = <R>; close(R);
-    print "not " unless $foo eq sprintf("ok %d\n", 3+$loopconst)
-        and not -e "file-$$";;
-    printf "ok %d\n", 11+$loopconst;
-    unlink "lib/file-$$" or die "unlink: $!";
-  
-  }
-}
-
-
-END {
-    1 while unlink "file-$$";
-    if ($^O eq 'MacOS') {
-        1 while unlink ":lib:file-$$";
-    } else {
-        1 while unlink "lib/file-$$";
-    }
-}

diff --git a/t/lib/filefind.t b/t/lib/filefind.t
deleted file mode 100755 (executable)
index 51e3ed8..0000000
--- a/t/lib/filefind.t
+++ /dev/null
@@ -1,734 +0,0 @@
-#!./perl
-
-
-my %Expect_File = (); # what we expect for $_ 
-my %Expect_Name = (); # what we expect for $File::Find::name/fullname
-my %Expect_Dir  = (); # what we expect for $File::Find::dir
-my $symlink_exists = eval { symlink("",""); 1 };
-my $warn_msg;
-
-
-BEGIN {
-    chdir 't' if -d 't';
-    unshift @INC => '../lib';
-
-    $SIG{'__WARN__'} = sub { $warn_msg = $_[0]; warn "# $_[0]"; }
-}
-
-if ( $symlink_exists ) { print "1..188\n"; }
-else                   { print "1..78\n";  }
-
-use File::Find;
-use File::Spec;
-
-cleanup();
-
-find({wanted => sub { print "ok 1\n" if $_ eq 'filefind.t'; } },
-   File::Spec->curdir);
-
-finddepth({wanted => sub { print "ok 2\n" if $_ eq 'filefind.t'; } },
-       File::Spec->curdir);
-
-my $case = 2;
-my $FastFileTests_OK = 0;
-
-sub cleanup {
-    if (-d dir_path('for_find')) {
-        chdir(dir_path('for_find'));
-    }
-    if (-d dir_path('fa')) {
-        unlink file_path('fa', 'fa_ord'),
-               file_path('fa', 'fsl'),
-               file_path('fa', 'faa', 'faa_ord'),
-               file_path('fa', 'fab', 'fab_ord'),
-               file_path('fa', 'fab', 'faba', 'faba_ord'),
-               file_path('fb', 'fb_ord'),
-               file_path('fb', 'fba', 'fba_ord');
-        rmdir dir_path('fa', 'faa');
-        rmdir dir_path('fa', 'fab', 'faba');
-        rmdir dir_path('fa', 'fab');
-        rmdir dir_path('fa');
-        rmdir dir_path('fb', 'fba');
-        rmdir dir_path('fb');
-        chdir File::Spec->updir;
-        rmdir dir_path('for_find');
-    }
-}
-
-END {
-    cleanup();
-}
-
-sub Check($) {
-    $case++;
-    if ($_[0]) { print "ok $case\n"; }
-    else       { print "not ok $case\n"; }
-}
-
-sub CheckDie($) {
-    $case++;
-    if ($_[0]) { print "ok $case\n"; }
-    else { print "not ok $case\n $!\n"; exit 0; }
-}
-
-sub touch {
-    CheckDie( open(my $T,'>',$_[0]) );
-}
-
-sub MkDir($$) {
-    CheckDie( mkdir($_[0],$_[1]) );
-}
-
-sub wanted_File_Dir {
-    print "# \$File::Find::dir => '$File::Find::dir'\n";
-    print "# \$_ => '$_'\n";
-    s#\.$## if ($^O eq 'VMS' && $_ ne '.');
-    Check( $Expect_File{$_} );
-    if ( $FastFileTests_OK ) {
-        delete $Expect_File{ $_} 
-          unless ( $Expect_Dir{$_} && ! -d _ );
-    } else {
-        delete $Expect_File{$_} 
-          unless ( $Expect_Dir{$_} && ! -d $_ );
-    }
-}
-
-sub wanted_File_Dir_prune {
-    &wanted_File_Dir;
-    $File::Find::prune=1 if  $_ eq 'faba';
-}
-
-sub wanted_Name {
-    my $n = $File::Find::name;
-    $n =~ s#\.$## if ($^O eq 'VMS' && $n ne '.');
-    print "# \$File::Find::name => '$n'\n";
-    my $i = rindex($n,'/');
-    my $OK = exists($Expect_Name{$n});
-    unless ($^O eq 'MacOS') {
-        if ( $OK ) {
-            $OK= exists($Expect_Name{substr($n,0,$i)})  if $i >= 0;    
-        }
-    }
-    Check($OK);
-    delete $Expect_Name{$n};
-}
-
-sub wanted_File {
-    print "# \$_ => '$_'\n";
-    s#\.$## if ($^O eq 'VMS' && $_ ne '.');
-    my $i = rindex($_,'/');
-    my $OK = exists($Expect_File{ $_});
-    unless ($^O eq 'MacOS') {
-        if ( $OK ) {
-            $OK= exists($Expect_File{ substr($_,0,$i)})  if $i >= 0;
-        }
-    }
-    Check($OK);
-    delete $Expect_File{ $_};
-}
-
-sub simple_wanted {
-    print "# \$File::Find::dir => '$File::Find::dir'\n";
-    print "# \$_ => '$_'\n";
-}
-
-sub noop_wanted {}
-
-sub my_preprocess {
-    @files = @_;
-    print "# --preprocess--\n";
-    print "#   \$File::Find::dir => '$File::Find::dir' \n";
-    foreach $file (@files) {
-        print "#   $file \n";
-        delete $Expect_Dir{ $File::Find::dir }->{$file};
-    }
-    print "# --end preprocess--\n";
-    Check(scalar(keys %{$Expect_Dir{ $File::Find::dir }}) == 0);
-    if (scalar(keys %{$Expect_Dir{ $File::Find::dir }}) == 0) {
-        delete $Expect_Dir{ $File::Find::dir }
-    }
-    return @files;
-}
-
-sub my_postprocess {
-    print "# postprocess: \$File::Find::dir => '$File::Find::dir' \n";
-    delete $Expect_Dir{ $File::Find::dir};
-}
-
-
-# Use dir_path() to specify a directory path that's expected for
-# $File::Find::dir (%Expect_Dir). Also use it in file operations like
-# chdir, rmdir etc.
-#
-# dir_path() concatenates directory names to form a _relative_
-# directory path, independant from the platform it's run on, although
-# there are limitations.  Don't try to create an absolute path,
-# because that may fail on operating systems that have the concept of
-# volume names (e.g. Mac OS). Be careful when you want to create an
-# updir path like ../fa (Unix) or ::fa: (Mac OS). Plain directory
-# names will work best. As a special case, you can pass it a "." as
-# first argument, to create a directory path like "./fa/dir" on
-# operating systems other than Mac OS (actually, Mac OS will ignore
-# the ".", if it's the first argument). If there's no second argument,
-# this function will return the empty string on Mac OS and the string
-# "./" otherwise.
-
-sub dir_path {
-    my $first_item = shift @_;
-
-    if ($first_item eq '.') {
-        if ($^O eq 'MacOS') {
-            return '' unless @_;
-            # ignore first argument; return a relative path
-            # with leading ":" and with trailing ":"
-            return File::Spec->catdir("", @_); 
-        } else { # other OS
-            return './' unless @_;
-            my $path = File::Spec->catdir(@_);
-            # add leading "./"
-            $path = "./$path";
-            return $path;
-        }
-
-    } else { # $first_item ne '.'
-        return $first_item unless @_; # return plain filename
-        if ($^O eq 'MacOS') {
-            # relative path with leading ":" and with trailing ":"
-            return File::Spec->catdir("", $first_item, @_);
-        } else { # other OS
-            return File::Spec->catdir($first_item, @_);
-        }
-    }
-}
-
-
-# Use topdir() to specify a directory path that you want to pass to
-#find/finddepth Basically, topdir() does the same as dir_path() (see
-#above), except that there's no trailing ":" on Mac OS.
-
-sub topdir {
-    my $path = dir_path(@_);
-    $path =~ s/:$// if ($^O eq 'MacOS');
-    return $path;
-}
-
-
-# Use file_path() to specify a file path that's expected for $_
-# (%Expect_File).  Also suitable for file operations like unlink etc.
-#
-# file_path() concatenates directory names (if any) and a filename to
-# form a _relative_ file path (the last argument is assumed to be a
-# file). It's independant from the platform it's run on, although
-# there are limitations (see the warnings for dir_path() above). As a
-# special case, you can pass it a "." as first argument, to create a
-# file path like "./fa/file" on operating systems other than Mac OS
-# (actually, Mac OS will ignore the ".", if it's the first
-# argument). If there's no second argument, this function will return
-# the empty string on Mac OS and the string "./" otherwise.
-
-sub file_path {
-    my $first_item = shift @_;
-
-    if ($first_item eq '.') {
-        if ($^O eq 'MacOS') {
-            return '' unless @_;
-            # ignore first argument; return a relative path  
-            # with leading ":", but without trailing ":"
-            return File::Spec->catfile("", @_); 
-        } else { # other OS
-            return './' unless @_;
-            my $path = File::Spec->catfile(@_);
-            # add leading "./" 
-            $path = "./$path"; 
-            return $path;
-        }
-
-    } else { # $first_item ne '.'
-        return $first_item unless @_; # return plain filename
-        if ($^O eq 'MacOS') {
-            # relative path with leading ":", but without trailing ":"
-            return File::Spec->catfile("", $first_item, @_);
-        } else { # other OS
-            return File::Spec->catfile($first_item, @_);
-        }
-    }
-}
-
-
-# Use file_path_name() to specify a file path that's expected for
-# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1
-# option is in effect, $_ is the same as $File::Find::Name. In that
-# case, also use this function to specify a file path that's expected
-# for $_.
-#
-# Basically, file_path_name() does the same as file_path() (see
-# above), except that there's always a leading ":" on Mac OS, even for
-# plain file/directory names.
-
-sub file_path_name {
-    my $path = file_path(@_);
-    $path = ":$path" if (($^O eq 'MacOS') && ($path !~ /:/));
-    return $path;
-}
-
-
-
-MkDir( dir_path('for_find'), 0770 );
-CheckDie(chdir( dir_path('for_find')));
-MkDir( dir_path('fa'), 0770 );
-MkDir( dir_path('fb'), 0770  );
-touch( file_path('fb', 'fb_ord') );
-MkDir( dir_path('fb', 'fba'), 0770  );
-touch( file_path('fb', 'fba', 'fba_ord') );
-if ($^O eq 'MacOS') {
-      CheckDie( symlink(':fb',':fa:fsl') ) if $symlink_exists;
-} else {
-      CheckDie( symlink('../fb','fa/fsl') ) if $symlink_exists;
-}
-touch( file_path('fa', 'fa_ord') );
-
-MkDir( dir_path('fa', 'faa'), 0770  );
-touch( file_path('fa', 'faa', 'faa_ord') );
-MkDir( dir_path('fa', 'fab'), 0770  );
-touch( file_path('fa', 'fab', 'fab_ord') );
-MkDir( dir_path('fa', 'fab', 'faba'), 0770  );
-touch( file_path('fa', 'fab', 'faba', 'faba_ord') );
-
-
-%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1,
-                file_path('fa_ord') => 1, file_path('fab') => 1,
-                file_path('fab_ord') => 1, file_path('faba') => 1,
-                file_path('faa') => 1, file_path('faa_ord') => 1);
-
-delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
-%Expect_Name = ();
-
-%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
-                dir_path('fab') => 1, dir_path('faba') => 1,
-                dir_path('fb') => 1, dir_path('fba') => 1);
-
-delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
-File::Find::find( {wanted => \&wanted_File_Dir_prune}, topdir('fa') ); 
-Check( scalar(keys %Expect_File) == 0 );
-
-
-print "# check re-entrancy\n";
-
-%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1,
-                file_path('fa_ord') => 1, file_path('fab') => 1,
-                file_path('fab_ord') => 1, file_path('faba') => 1,
-                file_path('faa') => 1, file_path('faa_ord') => 1);
-
-delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
-%Expect_Name = ();
-
-%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
-                dir_path('fab') => 1, dir_path('faba') => 1,
-                dir_path('fb') => 1, dir_path('fba') => 1);
-
-delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
-
-File::Find::find( {wanted => sub { wanted_File_Dir_prune();
-                                    File::Find::find( {wanted => sub
-                                    {} }, File::Spec->curdir ); } },
-                                    topdir('fa') );
-
-Check( scalar(keys %Expect_File) == 0 ); 
-
-
-# no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File
-
-%Expect_File = (file_path_name('fa') => 1,
-               file_path_name('fa', 'fsl') => 1,
-                file_path_name('fa', 'fa_ord') => 1,
-                file_path_name('fa', 'fab') => 1,
-               file_path_name('fa', 'fab', 'fab_ord') => 1,
-               file_path_name('fa', 'fab', 'faba') => 1,
-               file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
-               file_path_name('fa', 'faa') => 1,
-                file_path_name('fa', 'faa', 'faa_ord') => 1,);
-
-delete $Expect_File{ file_path_name('fa', 'fsl') } unless $symlink_exists;
-%Expect_Name = ();
-
-%Expect_Dir = (dir_path('fa') => 1,
-              dir_path('fa', 'faa') => 1,
-               dir_path('fa', 'fab') => 1,
-              dir_path('fa', 'fab', 'faba') => 1,
-              dir_path('fb') => 1,
-              dir_path('fb', 'fba') => 1);
-
-delete @Expect_Dir{ dir_path('fb'), dir_path('fb', 'fba') }
-    unless $symlink_exists;
-
-File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1},
-                 topdir('fa') ); Check( scalar(keys %Expect_File) == 0 );
-
-
-%Expect_File = ();
-
-%Expect_Name = (File::Spec->curdir => 1,
-               file_path_name('.', 'fa') => 1,
-                file_path_name('.', 'fa', 'fsl') => 1,
-                file_path_name('.', 'fa', 'fa_ord') => 1,
-                file_path_name('.', 'fa', 'fab') => 1,
-                file_path_name('.', 'fa', 'fab', 'fab_ord') => 1,
-                file_path_name('.', 'fa', 'fab', 'faba') => 1,
-                file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1,
-                file_path_name('.', 'fa', 'faa') => 1,
-                file_path_name('.', 'fa', 'faa', 'faa_ord') => 1,
-                file_path_name('.', 'fb') => 1,
-               file_path_name('.', 'fb', 'fba') => 1,
-               file_path_name('.', 'fb', 'fba', 'fba_ord') => 1,
-               file_path_name('.', 'fb', 'fb_ord') => 1);
-
-delete $Expect_Name{ file_path('.', 'fa', 'fsl') } unless $symlink_exists;
-%Expect_Dir = (); 
-File::Find::finddepth( {wanted => \&wanted_Name}, File::Spec->curdir );
-Check( scalar(keys %Expect_Name) == 0 );
-
-
-# no_chdir is in effect, hence we use file_path_name to specify the
-# expected paths for %Expect_File
-
-%Expect_File = (File::Spec->curdir => 1,
-               file_path_name('.', 'fa') => 1,
-                file_path_name('.', 'fa', 'fsl') => 1,
-                file_path_name('.', 'fa', 'fa_ord') => 1,
-                file_path_name('.', 'fa', 'fab') => 1,
-                file_path_name('.', 'fa', 'fab', 'fab_ord') => 1,
-                file_path_name('.', 'fa', 'fab', 'faba') => 1,
-                file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1,
-                file_path_name('.', 'fa', 'faa') => 1,
-                file_path_name('.', 'fa', 'faa', 'faa_ord') => 1,
-                file_path_name('.', 'fb') => 1,
-               file_path_name('.', 'fb', 'fba') => 1,
-               file_path_name('.', 'fb', 'fba', 'fba_ord') => 1,
-               file_path_name('.', 'fb', 'fb_ord') => 1);
-
-delete $Expect_File{ file_path_name('.', 'fa', 'fsl') } unless $symlink_exists;
-%Expect_Name = ();
-%Expect_Dir = (); 
-
-File::Find::finddepth( {wanted => \&wanted_File, no_chdir => 1},
-                    File::Spec->curdir );
-
-Check( scalar(keys %Expect_File) == 0 );
-
-
-print "# check preprocess\n";
-%Expect_File = ();
-%Expect_Name = ();
-%Expect_Dir = (
-          File::Spec->curdir                 => {fa => 1, fb => 1}, 
-          dir_path('.', 'fa')                => {faa => 1, fab => 1, fa_ord => 1},
-          dir_path('.', 'fa', 'faa')         => {faa_ord => 1},
-          dir_path('.', 'fa', 'fab')         => {faba => 1, fab_ord => 1},
-          dir_path('.', 'fa', 'fab', 'faba') => {faba_ord => 1},
-          dir_path('.', 'fb')                => {fba => 1, fb_ord => 1},
-          dir_path('.', 'fb', 'fba')         => {fba_ord => 1}
-          );
-
-File::Find::find( {wanted => \&noop_wanted,
-                  preprocess => \&my_preprocess}, File::Spec->curdir );
-
-Check( scalar(keys %Expect_Dir) == 0 );
-
-
-print "# check postprocess\n";
-%Expect_File = ();
-%Expect_Name = ();
-%Expect_Dir = (
-          File::Spec->curdir                 => 1,
-          dir_path('.', 'fa')                => 1,
-          dir_path('.', 'fa', 'faa')         => 1,
-          dir_path('.', 'fa', 'fab')         => 1,
-          dir_path('.', 'fa', 'fab', 'faba') => 1,
-          dir_path('.', 'fb')                => 1,
-          dir_path('.', 'fb', 'fba')         => 1
-          );
-
-File::Find::find( {wanted => \&noop_wanted,
-                  postprocess => \&my_postprocess}, File::Spec->curdir );
-
-Check( scalar(keys %Expect_Dir) == 0 );
-
-
-if ( $symlink_exists ) {
-    print "# --- symbolic link tests --- \n";
-    $FastFileTests_OK= 1;
-
-
-    # Verify that File::Find::find will call wanted even if the topdir of
-    # is a symlink to a directory, and it shouldn't follow the link
-    # unless follow is set, which it isn't in this case
-    %Expect_File = ( file_path('fsl') => 1 );
-    %Expect_Name = ();
-    %Expect_Dir = ();
-    File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa', 'fsl') );
-    Check( scalar(keys %Expect_File) == 0 );
-
- 
-    %Expect_File = (File::Spec->curdir => 1, file_path('fa_ord') => 1,
-                    file_path('fsl') => 1, file_path('fb_ord') => 1,
-                    file_path('fba') => 1, file_path('fba_ord') => 1,
-                    file_path('fab') => 1, file_path('fab_ord') => 1,
-                    file_path('faba') => 1, file_path('faa') => 1,
-                    file_path('faa_ord') => 1);
-
-    %Expect_Name = ();
-
-    %Expect_Dir = (File::Spec->curdir => 1, dir_path('fa') => 1,
-                   dir_path('faa') => 1, dir_path('fab') => 1,
-                   dir_path('faba') => 1, dir_path('fb') => 1,
-                   dir_path('fba') => 1);
-
-    File::Find::find( {wanted => \&wanted_File_Dir_prune,
-                      follow_fast => 1}, topdir('fa') );
-
-    Check( scalar(keys %Expect_File) == 0 );  
-
-
-    # no_chdir is in effect, hence we use file_path_name to specify
-    # the expected paths for %Expect_File
-
-    %Expect_File = (file_path_name('fa') => 1,
-                   file_path_name('fa', 'fa_ord') => 1,
-                   file_path_name('fa', 'fsl') => 1,
-                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
-                    file_path_name('fa', 'fsl', 'fba') => 1,
-                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
-                    file_path_name('fa', 'fab') => 1,
-                    file_path_name('fa', 'fab', 'fab_ord') => 1,
-                    file_path_name('fa', 'fab', 'faba') => 1,
-                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
-                    file_path_name('fa', 'faa') => 1,
-                    file_path_name('fa', 'faa', 'faa_ord') => 1);
-
-    %Expect_Name = ();
-
-    %Expect_Dir = (dir_path('fa') => 1,
-                  dir_path('fa', 'faa') => 1,
-                   dir_path('fa', 'fab') => 1,
-                  dir_path('fa', 'fab', 'faba') => 1,
-                  dir_path('fb') => 1,
-                  dir_path('fb', 'fba') => 1);
-
-    File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1,
-                      no_chdir => 1}, topdir('fa') );
-
-    Check( scalar(keys %Expect_File) == 0 );
-
-    %Expect_File = ();
-
-    %Expect_Name = (file_path_name('fa') => 1,
-                   file_path_name('fa', 'fa_ord') => 1,
-                   file_path_name('fa', 'fsl') => 1,
-                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
-                    file_path_name('fa', 'fsl', 'fba') => 1,
-                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
-                    file_path_name('fa', 'fab') => 1,
-                    file_path_name('fa', 'fab', 'fab_ord') => 1,
-                    file_path_name('fa', 'fab', 'faba') => 1,
-                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
-                    file_path_name('fa', 'faa') => 1,
-                    file_path_name('fa', 'faa', 'faa_ord') => 1);
-
-    %Expect_Dir = ();
-
-    File::Find::finddepth( {wanted => \&wanted_Name,
-                           follow_fast => 1}, topdir('fa') );
-
-    Check( scalar(keys %Expect_Name) == 0 );
-
-    # no_chdir is in effect, hence we use file_path_name to specify
-    # the expected paths for %Expect_File
-
-    %Expect_File = (file_path_name('fa') => 1,
-                   file_path_name('fa', 'fa_ord') => 1,
-                   file_path_name('fa', 'fsl') => 1,
-                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
-                    file_path_name('fa', 'fsl', 'fba') => 1,
-                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
-                    file_path_name('fa', 'fab') => 1,
-                    file_path_name('fa', 'fab', 'fab_ord') => 1,
-                    file_path_name('fa', 'fab', 'faba') => 1,
-                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
-                    file_path_name('fa', 'faa') => 1,
-                    file_path_name('fa', 'faa', 'faa_ord') => 1);
-
-    %Expect_Name = ();
-    %Expect_Dir = ();
-
-    File::Find::finddepth( {wanted => \&wanted_File, follow_fast => 1,
-                           no_chdir => 1}, topdir('fa') );
-
-    Check( scalar(keys %Expect_File) == 0 );     
-
- 
-    print "# check dangling symbolic links\n";
-    MkDir( dir_path('dangling_dir'), 0770 );
-    CheckDie( symlink( dir_path('dangling_dir'),
-                      file_path('dangling_dir_sl') ) );
-    rmdir dir_path('dangling_dir');
-    touch(file_path('dangling_file'));  
-    if ($^O eq 'MacOS') {
-        CheckDie( symlink('dangling_file', ':fa:dangling_file_sl') );
-    } else {
-        CheckDie( symlink('../dangling_file','fa/dangling_file_sl') );
-    }      
-    unlink file_path('dangling_file');
-
-    { 
-        # these tests should also emit a warning
-       use warnings;
-
-        %Expect_File = (File::Spec->curdir => 1,
-                       file_path('fa_ord') => 1,
-                        file_path('fsl') => 1,
-                        file_path('fb_ord') => 1,
-                       file_path('fba') => 1,
-                        file_path('fba_ord') => 1,
-                       file_path('fab') => 1,
-                        file_path('fab_ord') => 1,
-                        file_path('faba') => 1,
-                       file_path('faba_ord') => 1,
-                        file_path('faa') => 1,
-                        file_path('faa_ord') => 1);
-
-        %Expect_Name = ();
-        %Expect_Dir = ();
-        undef $warn_msg;
-
-        File::Find::find( {wanted => \&wanted_File, follow => 1,
-                          dangling_symlinks =>
-                              sub { $warn_msg = "$_[0] is a dangling symbolic link" }
-                           },
-                           topdir('dangling_dir_sl'), topdir('fa') );
-
-        Check( scalar(keys %Expect_File) == 0 );
-        Check( $warn_msg =~ m|dangling_dir_sl is a dangling symbolic link| );  
-        unlink file_path('fa', 'dangling_file_sl'),
-                         file_path('dangling_dir_sl');
-
-    }
-
-
-    print "# check recursion\n";
-    if ($^O eq 'MacOS') {
-        CheckDie( symlink(':fa:faa',':fa:faa:faa_sl') );
-    } else {
-        CheckDie( symlink('../faa','fa/faa/faa_sl') );
-    }
-    undef $@;
-    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
-                             no_chdir => 1}, topdir('fa') ); };
-    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]faa_sl is a recursive symbolic link| );  
-    unlink file_path('fa', 'faa', 'faa_sl'); 
-
-
-    print "# check follow_skip (file)\n";
-    if ($^O eq 'MacOS') {
-        CheckDie( symlink(':fa:fa_ord',':fa:fa_ord_sl') ); # symlink to a file
-    } else {
-        CheckDie( symlink('./fa_ord','fa/fa_ord_sl') ); # symlink to a file
-    }
-    undef $@;
-
-    eval {File::Find::finddepth( {wanted => \&simple_wanted,
-                                  follow => 1,
-                                  follow_skip => 0, no_chdir => 1},
-                                  topdir('fa') );};
-
-    Check( $@ =~ m|for_find[:/]fa[:/]fa_ord encountered a second time| );
-
-
-    # no_chdir is in effect, hence we use file_path_name to specify
-    # the expected paths for %Expect_File
-
-    %Expect_File = (file_path_name('fa') => 1,
-                   file_path_name('fa', 'fa_ord') => 1,
-                   file_path_name('fa', 'fsl') => 1,
-                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
-                    file_path_name('fa', 'fsl', 'fba') => 1,
-                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
-                    file_path_name('fa', 'fab') => 1,
-                    file_path_name('fa', 'fab', 'fab_ord') => 1,
-                    file_path_name('fa', 'fab', 'faba') => 1,
-                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
-                    file_path_name('fa', 'faa') => 1,
-                    file_path_name('fa', 'faa', 'faa_ord') => 1);
-
-    %Expect_Name = ();
-
-    %Expect_Dir = (dir_path('fa') => 1,
-                  dir_path('fa', 'faa') => 1,
-                   dir_path('fa', 'fab') => 1,
-                  dir_path('fa', 'fab', 'faba') => 1,
-                  dir_path('fb') => 1,
-                  dir_path('fb','fba') => 1);
-
-    File::Find::finddepth( {wanted => \&wanted_File_Dir, follow => 1,
-                           follow_skip => 1, no_chdir => 1},
-                           topdir('fa') );
-
-    Check( scalar(keys %Expect_File) == 0 );
-    unlink file_path('fa', 'fa_ord_sl');
-
-
-    print "# check follow_skip (directory)\n";
-    if ($^O eq 'MacOS') {
-        CheckDie( symlink(':fa:faa',':fa:faa_sl') ); # symlink to a directory
-    } else {
-        CheckDie( symlink('./faa','fa/faa_sl') ); # symlink to a directory
-    }
-    undef $@;
-
-    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
-                            follow_skip => 0, no_chdir => 1},
-                            topdir('fa') );};
-
-    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time| );
-
-  
-    undef $@;
-
-    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
-                            follow_skip => 1, no_chdir => 1},
-                            topdir('fa') );};
-
-    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time| );  
-
-    # no_chdir is in effect, hence we use file_path_name to specify
-    # the expected paths for %Expect_File
-
-    %Expect_File = (file_path_name('fa') => 1,
-                   file_path_name('fa', 'fa_ord') => 1,
-                   file_path_name('fa', 'fsl') => 1,
-                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
-                    file_path_name('fa', 'fsl', 'fba') => 1,
-                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
-                    file_path_name('fa', 'fab') => 1,
-                    file_path_name('fa', 'fab', 'fab_ord') => 1,
-                    file_path_name('fa', 'fab', 'faba') => 1,
-                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
-                    file_path_name('fa', 'faa') => 1,
-                    file_path_name('fa', 'faa', 'faa_ord') => 1);
-
-    %Expect_Name = ();
-
-    %Expect_Dir = (dir_path('fa') => 1,
-                  dir_path('fa', 'faa') => 1,
-                   dir_path('fa', 'fab') => 1,
-                  dir_path('fa', 'fab', 'faba') => 1,
-                  dir_path('fb') => 1,
-                  dir_path('fb', 'fba') => 1);
-
-    File::Find::find( {wanted => \&wanted_File_Dir, follow => 1,
-                      follow_skip => 2, no_chdir => 1}, topdir('fa') );
-
-    Check( scalar(keys %Expect_File) == 0 );
-    unlink file_path('fa', 'faa_sl');
-
-} 
-

diff --git a/t/lib/filefunc.t b/t/lib/filefunc.t
deleted file mode 100755 (executable)
index 9268122..0000000
--- a/t/lib/filefunc.t
+++ /dev/null
@@ -1,17 +0,0 @@
-#!./perl
-
-BEGIN {
-    $^O = '';
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-print "1..1\n";
-
-use File::Spec::Functions;
-
-if (catfile('a','b','c') eq 'a/b/c') {
-    print "ok 1\n";
-} else {
-    print "not ok 1\n";
-}

diff --git a/t/lib/filehand.t b/t/lib/filehand.t
deleted file mode 100755 (executable)
index eaddf49..0000000
--- a/t/lib/filehand.t
+++ /dev/null
@@ -1,91 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
-       print "1..0\n";
-       exit 0;
-    }
-}
-
-use FileHandle;
-use strict subs;
-
-autoflush STDOUT 1;
-
-$mystdout = new_from_fd FileHandle 1,"w";
-$| = 1;
-autoflush $mystdout;
-print "1..11\n";
-
-print $mystdout "ok ".fileno($mystdout)."\n";
-
-$fh = (new FileHandle "./TEST", O_RDONLY
-       or new FileHandle "TEST", O_RDONLY)
-  and print "ok 2\n";
-
-
-$buffer = <$fh>;
-print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n";
-
-
-ungetc $fh ord 'A';
-CORE::read($fh, $buf,1);
-print $buf eq 'A' ? "ok 4\n" : "not ok 4\n";
-
-close $fh;
-
-$fh = new FileHandle;
-
-print "not " unless ($fh->open("< TEST") && <$fh> eq $buffer);
-print "ok 5\n";
-
-$fh->seek(0,0);
-print "#possible mixed CRLF/LF in t/TEST\nnot " unless (<$fh> eq $buffer);
-print "ok 6\n";
-
-$fh->seek(0,2);
-$line = <$fh>;
-print "not " if (defined($line) || !$fh->eof);
-print "ok 7\n";
-
-print "not " unless ($fh->open("TEST","r") && !$fh->tell && $fh->close);
-print "ok 8\n";
-
-autoflush STDOUT 0;
-
-print "not " if ($|);
-print "ok 9\n";
-
-autoflush STDOUT 1;
-
-print "not " unless ($|);
-print "ok 10\n";
-
-if ($^O eq 'dos')
-{
-    printf("ok %d\n",11);
-    exit(0);
-}
-
-($rd,$wr) = FileHandle::pipe;
-
-if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare' ||
-    $Config{d_fork} ne 'define') {
-  $wr->autoflush;
-  $wr->printf("ok %d\n",11);
-  print $rd->getline;
-}
-else {
-  if (fork) {
-   $wr->close;
-   print $rd->getline;
-  }
-  else {
-   $rd->close;
-   $wr->printf("ok %d\n",11);
-   exit(0);
-  }
-}

diff --git a/t/lib/filepath.t b/t/lib/filepath.t
deleted file mode 100755 (executable)
index 42e0ae9..0000000
--- a/t/lib/filepath.t
+++ /dev/null
@@ -1,28 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use File::Path;
-use strict;
-
-my $count = 0;
-use warnings;
-
-print "1..4\n";
-
-# first check for stupid permissions second for full, so we clean up
-# behind ourselves
-for my $perm (0111,0777) {
-    mkpath("foo/bar");
-    chmod $perm, "foo", "foo/bar";
-
-    print "not " unless -d "foo" && -d "foo/bar";
-    print "ok ", ++$count, "\n";
-
-    rmtree("foo");
-    print "not " if -e "foo";
-    print "ok ", ++$count, "\n";
-}

diff --git a/t/lib/filespec.t b/t/lib/filespec.t
deleted file mode 100755 (executable)
index c6d155f..0000000
--- a/t/lib/filespec.t
+++ /dev/null
@@ -1,379 +0,0 @@
-#!./perl
-
-BEGIN {
-    $^O = '';
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# Each element in this array is a single test. Storing them this way makes
-# maintenance easy, and should be OK since perl should be pretty functional
-# before these tests are run.
-
-@tests = (
-# Function                      Expected
-[ "Unix->catfile('a','b','c')", 'a/b/c'  ],
-
-[ "Unix->splitpath('file')",            ',,file'            ],
-[ "Unix->splitpath('/d1/d2/d3/')",      ',/d1/d2/d3/,'      ],
-[ "Unix->splitpath('d1/d2/d3/')",       ',d1/d2/d3/,'       ],
-[ "Unix->splitpath('/d1/d2/d3/.')",     ',/d1/d2/d3/.,'     ],
-[ "Unix->splitpath('/d1/d2/d3/..')",    ',/d1/d2/d3/..,'    ],
-[ "Unix->splitpath('/d1/d2/d3/.file')", ',/d1/d2/d3/,.file' ],
-[ "Unix->splitpath('d1/d2/d3/file')",   ',d1/d2/d3/,file'   ],
-[ "Unix->splitpath('/../../d1/')",      ',/../../d1/,'      ],
-[ "Unix->splitpath('/././d1/')",        ',/././d1/,'        ],
-
-[ "Unix->catpath('','','file')",            'file'            ],
-[ "Unix->catpath('','/d1/d2/d3/','')",      '/d1/d2/d3/'      ],
-[ "Unix->catpath('','d1/d2/d3/','')",       'd1/d2/d3/'       ],
-[ "Unix->catpath('','/d1/d2/d3/.','')",     '/d1/d2/d3/.'     ],
-[ "Unix->catpath('','/d1/d2/d3/..','')",    '/d1/d2/d3/..'    ],
-[ "Unix->catpath('','/d1/d2/d3/','.file')", '/d1/d2/d3/.file' ],
-[ "Unix->catpath('','d1/d2/d3/','file')",   'd1/d2/d3/file'   ],
-[ "Unix->catpath('','/../../d1/','')",      '/../../d1/'      ],
-[ "Unix->catpath('','/././d1/','')",        '/././d1/'        ],
-[ "Unix->catpath('d1','d2/d3/','')",        'd2/d3/'          ],
-[ "Unix->catpath('d1','d2','d3/')",         'd2/d3/'          ],
-
-[ "Unix->splitdir('')",           ''           ],
-[ "Unix->splitdir('/d1/d2/d3/')", ',d1,d2,d3,' ],
-[ "Unix->splitdir('d1/d2/d3/')",  'd1,d2,d3,'  ],
-[ "Unix->splitdir('/d1/d2/d3')",  ',d1,d2,d3'  ],
-[ "Unix->splitdir('d1/d2/d3')",   'd1,d2,d3'   ],
-
-[ "Unix->catdir()",                     ''          ],
-[ "Unix->catdir('/')",                  '/'         ],
-[ "Unix->catdir('','d1','d2','d3','')", '/d1/d2/d3' ],
-[ "Unix->catdir('d1','d2','d3','')",    'd1/d2/d3'  ],
-[ "Unix->catdir('','d1','d2','d3')",    '/d1/d2/d3' ],
-[ "Unix->catdir('d1','d2','d3')",       'd1/d2/d3'  ],
-
-[ "Unix->catfile('a','b','c')", 'a/b/c' ],
-
-[ "Unix->canonpath('')",                                      ''          ],
-[ "Unix->canonpath('///../../..//./././a//b/.././c/././')",   '/a/b/../c' ],
-[ "Unix->canonpath('/.')",                                    '/.'        ],
-
-[  "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')",          ''                   ],
-[  "Unix->abs2rel('/t1/t2/t4','/t1/t2/t3')",          '../t4'              ],
-[  "Unix->abs2rel('/t1/t2','/t1/t2/t3')",             '..'                 ],
-[  "Unix->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')",       't4'                 ],
-[  "Unix->abs2rel('/t4/t5/t6','/t1/t2/t3')",          '../../../t4/t5/t6'  ],
-#[ "Unix->abs2rel('../t4','/t1/t2/t3')",              '../t4'              ],
-[  "Unix->abs2rel('/','/t1/t2/t3')",                  '../../..'           ],
-[  "Unix->abs2rel('///','/t1/t2/t3')",                '../../..'           ],
-[  "Unix->abs2rel('/.','/t1/t2/t3')",                 '../../../.'         ],
-[  "Unix->abs2rel('/./','/t1/t2/t3')",                '../../..'           ],
-#[ "Unix->abs2rel('../t4','/t1/t2/t3')",              '../t4'              ],
-
-[ "Unix->rel2abs('t4','/t1/t2/t3')",             '/t1/t2/t3/t4'    ],
-[ "Unix->rel2abs('t4/t5','/t1/t2/t3')",          '/t1/t2/t3/t4/t5' ],
-[ "Unix->rel2abs('.','/t1/t2/t3')",              '/t1/t2/t3'       ],
-[ "Unix->rel2abs('..','/t1/t2/t3')",             '/t1/t2/t3/..'    ],
-[ "Unix->rel2abs('../t4','/t1/t2/t3')",          '/t1/t2/t3/../t4' ],
-[ "Unix->rel2abs('/t1','/t1/t2/t3')",            '/t1'             ],
-
-[ "Win32->splitpath('file')",                            ',,file'                            ],
-[ "Win32->splitpath('\\d1/d2\\d3/')",                    ',\\d1/d2\\d3/,'                    ],
-[ "Win32->splitpath('d1/d2\\d3/')",                      ',d1/d2\\d3/,'                      ],
-[ "Win32->splitpath('\\d1/d2\\d3/.')",                   ',\\d1/d2\\d3/.,'                   ],
-[ "Win32->splitpath('\\d1/d2\\d3/..')",                  ',\\d1/d2\\d3/..,'                  ],
-[ "Win32->splitpath('\\d1/d2\\d3/.file')",               ',\\d1/d2\\d3/,.file'               ],
-[ "Win32->splitpath('\\d1/d2\\d3/file')",                ',\\d1/d2\\d3/,file'                ],
-[ "Win32->splitpath('d1/d2\\d3/file')",                  ',d1/d2\\d3/,file'                  ],
-[ "Win32->splitpath('C:\\d1/d2\\d3/')",                  'C:,\\d1/d2\\d3/,'                  ],
-[ "Win32->splitpath('C:d1/d2\\d3/')",                    'C:,d1/d2\\d3/,'                    ],
-[ "Win32->splitpath('C:\\d1/d2\\d3/file')",              'C:,\\d1/d2\\d3/,file'              ],
-[ "Win32->splitpath('C:d1/d2\\d3/file')",                'C:,d1/d2\\d3/,file'                ],
-[ "Win32->splitpath('C:\\../d2\\d3/file')",              'C:,\\../d2\\d3/,file'              ],
-[ "Win32->splitpath('C:../d2\\d3/file')",                'C:,../d2\\d3/,file'                ],
-[ "Win32->splitpath('\\../..\\d1/')",                    ',\\../..\\d1/,'                    ],
-[ "Win32->splitpath('\\./.\\d1/')",                      ',\\./.\\d1/,'                      ],
-[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/')",     '\\\\node\\share,\\d1/d2\\d3/,'     ],
-[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/file')", '\\\\node\\share,\\d1/d2\\d3/,file' ],
-[ "Win32->splitpath('\\\\node\\share\\d1/d2\\file')",    '\\\\node\\share,\\d1/d2\\,file'    ],
-[ "Win32->splitpath('file',1)",                          ',file,'                            ],
-[ "Win32->splitpath('\\d1/d2\\d3/',1)",                  ',\\d1/d2\\d3/,'                    ],
-[ "Win32->splitpath('d1/d2\\d3/',1)",                    ',d1/d2\\d3/,'                      ],
-[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/',1)",   '\\\\node\\share,\\d1/d2\\d3/,'     ],
-
-[ "Win32->catpath('','','file')",                            'file'                            ],
-[ "Win32->catpath('','\\d1/d2\\d3/','')",                    '\\d1/d2\\d3/'                    ],
-[ "Win32->catpath('','d1/d2\\d3/','')",                      'd1/d2\\d3/'                      ],
-[ "Win32->catpath('','\\d1/d2\\d3/.','')",                   '\\d1/d2\\d3/.'                   ],
-[ "Win32->catpath('','\\d1/d2\\d3/..','')",                  '\\d1/d2\\d3/..'                  ],
-[ "Win32->catpath('','\\d1/d2\\d3/','.file')",               '\\d1/d2\\d3/.file'               ],
-[ "Win32->catpath('','\\d1/d2\\d3/','file')",                '\\d1/d2\\d3/file'                ],
-[ "Win32->catpath('','d1/d2\\d3/','file')",                  'd1/d2\\d3/file'                  ],
-[ "Win32->catpath('C:','\\d1/d2\\d3/','')",                  'C:\\d1/d2\\d3/'                  ],
-[ "Win32->catpath('C:','d1/d2\\d3/','')",                    'C:d1/d2\\d3/'                    ],
-[ "Win32->catpath('C:','\\d1/d2\\d3/','file')",              'C:\\d1/d2\\d3/file'              ],
-[ "Win32->catpath('C:','d1/d2\\d3/','file')",                'C:d1/d2\\d3/file'                ],
-[ "Win32->catpath('C:','\\../d2\\d3/','file')",              'C:\\../d2\\d3/file'              ],
-[ "Win32->catpath('C:','../d2\\d3/','file')",                'C:../d2\\d3/file'                ],
-[ "Win32->catpath('','\\../..\\d1/','')",                    '\\../..\\d1/'                    ],
-[ "Win32->catpath('','\\./.\\d1/','')",                      '\\./.\\d1/'                      ],
-[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','')",     '\\\\node\\share\\d1/d2\\d3/'     ],
-[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','file')", '\\\\node\\share\\d1/d2\\d3/file' ],
-[ "Win32->catpath('\\\\node\\share','\\d1/d2\\','file')",    '\\\\node\\share\\d1/d2\\file'    ],
-
-[ "Win32->splitdir('')",             ''           ],
-[ "Win32->splitdir('\\d1/d2\\d3/')", ',d1,d2,d3,' ],
-[ "Win32->splitdir('d1/d2\\d3/')",   'd1,d2,d3,'  ],
-[ "Win32->splitdir('\\d1/d2\\d3')",  ',d1,d2,d3'  ],
-[ "Win32->splitdir('d1/d2\\d3')",    'd1,d2,d3'   ],
-
-[ "Win32->catdir()",                        ''                   ],
-[ "Win32->catdir('')",                      '\\'                 ],
-[ "Win32->catdir('/')",                     '\\'                 ],
-[ "Win32->catdir('//d1','d2')",             '\\\\d1\\d2'         ],
-[ "Win32->catdir('','/d1','d2')",           '\\\\d1\\d2'         ],
-[ "Win32->catdir('','','/d1','d2')",        '\\\\\\d1\\d2'       ],
-[ "Win32->catdir('','//d1','d2')",          '\\\\\\d1\\d2'       ],
-[ "Win32->catdir('','','//d1','d2')",       '\\\\\\\\d1\\d2'     ],
-[ "Win32->catdir('','d1','','d2','')",      '\\d1\\d2'           ],
-[ "Win32->catdir('','d1','d2','d3','')",    '\\d1\\d2\\d3'       ],
-[ "Win32->catdir('d1','d2','d3','')",       'd1\\d2\\d3'         ],
-[ "Win32->catdir('','d1','d2','d3')",       '\\d1\\d2\\d3'       ],
-[ "Win32->catdir('d1','d2','d3')",          'd1\\d2\\d3'         ],
-[ "Win32->catdir('A:/d1','d2','d3')",       'A:\\d1\\d2\\d3'     ],
-[ "Win32->catdir('A:/d1','d2','d3','')",    'A:\\d1\\d2\\d3'     ],
-#[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\d2\\d3'     ],
-[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\B:\\d2\\d3' ],
-[ "Win32->catdir('A:/')",                   'A:\\'               ],
-
-[ "Win32->catfile('a','b','c')", 'a\\b\\c' ],
-
-[ "Win32->canonpath('')",               ''                    ],
-[ "Win32->canonpath('a:')",             'A:'                  ],
-[ "Win32->canonpath('A:f')",            'A:f'                 ],
-[ "Win32->canonpath('//a\\b//c')",      '\\\\a\\b\\c'         ],
-[ "Win32->canonpath('/a/..../c')",      '\\a\\....\\c'        ],
-[ "Win32->canonpath('//a/b\\c')",       '\\\\a\\b\\c'         ],
-[ "Win32->canonpath('////')",           '\\\\\\'              ],
-[ "Win32->canonpath('//')",             '\\'                  ],
-[ "Win32->canonpath('/.')",             '\\.'                 ],
-[ "Win32->canonpath('//a/b/../../c')",  '\\\\a\\b\\..\\..\\c' ],
-[ "Win32->canonpath('//a/../../c')",    '\\\\a\\..\\..\\c'    ],
-
-[  "Win32->abs2rel('/t1/t2/t3','/t1/t2/t3')",    ''                       ],
-[  "Win32->abs2rel('/t1/t2/t4','/t1/t2/t3')",    '..\\t4'                 ],
-[  "Win32->abs2rel('/t1/t2','/t1/t2/t3')",       '..'                     ],
-[  "Win32->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4'                     ],
-[  "Win32->abs2rel('/t4/t5/t6','/t1/t2/t3')",    '..\\..\\..\\t4\\t5\\t6' ],
-#[ "Win32->abs2rel('../t4','/t1/t2/t3')",        '\\t1\\t2\\t3\\..\\t4'   ],
-[  "Win32->abs2rel('/','/t1/t2/t3')",            '..\\..\\..'             ],
-[  "Win32->abs2rel('///','/t1/t2/t3')",          '..\\..\\..'             ],
-[  "Win32->abs2rel('/.','/t1/t2/t3')",           '..\\..\\..\\.'          ],
-[  "Win32->abs2rel('/./','/t1/t2/t3')",          '..\\..\\..'             ],
-[  "Win32->abs2rel('\\\\a/t1/t2/t4','/t2/t3')",  '..\\t4'                 ],
-[  "Win32->abs2rel('//a/t1/t2/t4','/t2/t3')",    '..\\t4'                 ],
-
-[ "Win32->rel2abs('temp','C:/')",                       'C:\\temp'                        ],
-[ "Win32->rel2abs('temp','C:/a')",                      'C:\\a\\temp'                     ],
-[ "Win32->rel2abs('temp','C:/a/')",                     'C:\\a\\temp'                     ],
-[ "Win32->rel2abs('../','C:/')",                        'C:\\..'                          ],
-[ "Win32->rel2abs('../','C:/a')",                       'C:\\a\\..'                       ],
-[ "Win32->rel2abs('temp','//prague_main/work/')",       '\\\\prague_main\\work\\temp'     ],
-[ "Win32->rel2abs('../temp','//prague_main/work/')",    '\\\\prague_main\\work\\..\\temp' ],
-[ "Win32->rel2abs('temp','//prague_main/work')",        '\\\\prague_main\\work\\temp'     ],
-[ "Win32->rel2abs('../','//prague_main/work')",         '\\\\prague_main\\work\\..'       ],
-
-[ "VMS->splitpath('file')",                                       ',,file'                                   ],
-[ "VMS->splitpath('[d1.d2.d3]')",                                 ',[d1.d2.d3],'                               ],
-[ "VMS->splitpath('[.d1.d2.d3]')",                                ',[.d1.d2.d3],'                              ],
-[ "VMS->splitpath('[d1.d2.d3]file')",                             ',[d1.d2.d3],file'                           ],
-[ "VMS->splitpath('d1/d2/d3/file')",                              ',[.d1.d2.d3],file'                          ],
-[ "VMS->splitpath('/d1/d2/d3/file')",                             'd1:,[d2.d3],file'                         ],
-[ "VMS->splitpath('[.d1.d2.d3]file')",                            ',[.d1.d2.d3],file'                          ],
-[ "VMS->splitpath('node::volume:[d1.d2.d3]')",                    'node::volume:,[d1.d2.d3],'                  ],
-[ "VMS->splitpath('node::volume:[d1.d2.d3]file')",                'node::volume:,[d1.d2.d3],file'              ],
-[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]')",     'node"access_spec"::volume:,[d1.d2.d3],'     ],
-[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]file')", 'node"access_spec"::volume:,[d1.d2.d3],file' ],
-
-[ "VMS->catpath('','','file')",                                       'file'                                     ],
-[ "VMS->catpath('','[d1.d2.d3]','')",                                 '[d1.d2.d3]'                               ],
-[ "VMS->catpath('','[.d1.d2.d3]','')",                                '[.d1.d2.d3]'                              ],
-[ "VMS->catpath('','[d1.d2.d3]','file')",                             '[d1.d2.d3]file'                           ],
-[ "VMS->catpath('','[.d1.d2.d3]','file')",                            '[.d1.d2.d3]file'                          ],
-[ "VMS->catpath('','d1/d2/d3','file')",                               '[.d1.d2.d3]file'                            ],
-[ "VMS->catpath('v','d1/d2/d3','file')",                              'v:[.d1.d2.d3]file'                            ],
-[ "VMS->catpath('node::volume:','[d1.d2.d3]','')",                    'node::volume:[d1.d2.d3]'                  ],
-[ "VMS->catpath('node::volume:','[d1.d2.d3]','file')",                'node::volume:[d1.d2.d3]file'              ],
-[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','')",     'node"access_spec"::volume:[d1.d2.d3]'     ],
-[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','file')", 'node"access_spec"::volume:[d1.d2.d3]file' ],
-
-[ "VMS->canonpath('')",                                    ''                        ],
-[ "VMS->canonpath('volume:[d1]file')",                     'volume:[d1]file'         ],
-[ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')",              'volume:[d2.d3]'          ],
-[ "VMS->canonpath('volume:[000000.d1]d2.dir;1')",                 'volume:[d1]d2.dir;1'   ],
-
-[ "VMS->splitdir('')",            ''          ],
-[ "VMS->splitdir('[]')",          ''          ],
-[ "VMS->splitdir('d1.d2.d3')",    'd1,d2,d3'  ],
-[ "VMS->splitdir('[d1.d2.d3]')",  'd1,d2,d3'  ],
-[ "VMS->splitdir('.d1.d2.d3')",   ',d1,d2,d3' ],
-[ "VMS->splitdir('[.d1.d2.d3]')", ',d1,d2,d3' ],
-[ "VMS->splitdir('.-.d2.d3')",    ',-,d2,d3'  ],
-[ "VMS->splitdir('[.-.d2.d3]')",  ',-,d2,d3'  ],
-
-[ "VMS->catdir('')",                                                      ''                 ],
-[ "VMS->catdir('d1','d2','d3')",                                          '[.d1.d2.d3]'         ],
-[ "VMS->catdir('d1','d2/','d3')",                                         '[.d1.d2.d3]'         ],
-[ "VMS->catdir('','d1','d2','d3')",                                       '[.d1.d2.d3]'        ],
-[ "VMS->catdir('','-','d2','d3')",                                        '[-.d2.d3]'         ],
-[ "VMS->catdir('','-','','d3')",                                          '[-.d3]'            ],
-[ "VMS->catdir('dir.dir','d2.dir','d3.dir')",                             '[.dir.d2.d3]'        ],
-[ "VMS->catdir('[.name]')",                                               '[.name]'            ],
-[ "VMS->catdir('[.name]','[.name]')",                                     '[.name.name]'],    
-
-[  "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", ''                 ],
-[  "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]'           ],
-[  "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')",              ''                 ],
-[  "VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')",          'file'             ],
-[  "VMS->abs2rel('[t1.t2.t4]','[t1.t2.t3]')",              '[-.t4]'           ],
-[  "VMS->abs2rel('[t1.t2]file','[t1.t2.t3]')",             '[-]file'          ],
-[  "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')",           '[t4]'             ],
-[  "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')",              '[---.t4.t5.t6]'   ],
-[ "VMS->abs2rel('[000000]','[t1.t2.t3]')",                 '[---.000000]'     ],
-[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')",             '[-.t4]'           ],
-[ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')",              '[---.b]'          ],
-
-[ "VMS->rel2abs('[.t4]','[t1.t2.t3]')",          '[t1.t2.t3.t4]'    ],
-[ "VMS->rel2abs('[.t4.t5]','[t1.t2.t3]')",       '[t1.t2.t3.t4.t5]' ],
-[ "VMS->rel2abs('[]','[t1.t2.t3]')",             '[t1.t2.t3]'       ],
-[ "VMS->rel2abs('[-]','[t1.t2.t3]')",            '[t1.t2]'          ],
-[ "VMS->rel2abs('[-.t4]','[t1.t2.t3]')",         '[t1.t2.t4]'       ],
-[ "VMS->rel2abs('[t1]','[t1.t2.t3]')",           '[t1]'             ],
-
-[ "OS2->catdir('A:/d1','B:/d2','d3','')", 'A:/d1/B:/d2/d3' ],
-[ "OS2->catfile('a','b','c')",            'a/b/c'          ],
-
-[ "Mac->splitpath('file')",          ',,file'          ],
-[ "Mac->splitpath(':file')",         ',:,file'         ],
-[ "Mac->splitpath(':d1',1)",         ',:d1:,'          ],
-[ "Mac->splitpath('d1',1)",          'd1:,,'           ],
-[ "Mac->splitpath('d1:d2:d3:')",     'd1:,d2:d3:,'     ],
-[ "Mac->splitpath('d1:d2:d3',1)",    'd1:,d2:d3:,'     ],
-[ "Mac->splitpath(':d1:d2:d3:')",    ',:d1:d2:d3:,'    ],
-[ "Mac->splitpath(':d1:d2:d3:',1)",  ',:d1:d2:d3:,'    ],
-[ "Mac->splitpath('d1:d2:d3:file')", 'd1:,d2:d3:,file' ],
-[ "Mac->splitpath('d1:d2:d3',1)",    'd1:,d2:d3:,'     ],
-
-[ "Mac->catdir('')",                ':'           ],
-[ "Mac->catdir('d1','d2','d3')",    'd1:d2:d3:'   ],
-[ "Mac->catdir('d1','d2/','d3')",   'd1:d2/:d3:'  ],
-[ "Mac->catdir('','d1','d2','d3')", ':d1:d2:d3:'  ],
-[ "Mac->catdir('','','d2','d3')",   '::d2:d3:'    ],
-[ "Mac->catdir('','','','d3')",     ':::d3:'      ],
-[ "Mac->catdir(':name')",           ':name:'      ],
-[ "Mac->catdir(':name',':name')",   ':name:name:' ],
-
-[ "Mac->catfile('a','b','c')", 'a:b:c' ],
-
-[ "Mac->canonpath('')",                   ''     ],
-[ "Mac->canonpath(':')",                  ':'    ],
-[ "Mac->canonpath('::')",                 '::'   ],
-[ "Mac->canonpath('a::')",                'a::'  ],
-[ "Mac->canonpath(':a::')",               ':a::' ],
-
-[ "Mac->abs2rel('t1:t2:t3','t1:t2:t3')",    ':'            ],
-[ "Mac->abs2rel('t1:t2','t1:t2:t3')",       '::'           ],
-[ "Mac->abs2rel('t1:t4','t1:t2:t3')",       ':::t4'        ],
-[ "Mac->abs2rel('t1:t2:t4','t1:t2:t3')",    '::t4'         ],
-[ "Mac->abs2rel('t1:t2:t3:t4','t1:t2:t3')", ':t4'          ],
-[ "Mac->abs2rel('t4:t5:t6','t1:t2:t3')",    '::::t4:t5:t6' ],
-[ "Mac->abs2rel('t1','t1:t2:t3')",          ':::'          ],
-
-[ "Mac->rel2abs(':t4','t1:t2:t3')",          't1:t2:t3:t4'    ],
-[ "Mac->rel2abs(':t4:t5','t1:t2:t3')",       't1:t2:t3:t4:t5' ],
-[ "Mac->rel2abs('','t1:t2:t3')",             ''               ],
-[ "Mac->rel2abs('::','t1:t2:t3')",           't1:t2:t3::'     ],
-[ "Mac->rel2abs('::t4','t1:t2:t3')",         't1:t2:t3::t4'   ],
-[ "Mac->rel2abs('t1','t1:t2:t3')",           't1'             ],
-) ;
-
-# Grab all of the plain routines from File::Spec
-use File::Spec @File::Spec::EXPORT_OK ;
-
-require File::Spec::Unix ;
-require File::Spec::Win32 ;
-
-eval {
-   require VMS::Filespec ;
-} ;
-
-my $skip_exception = "Install VMS::Filespec (from vms/ext)" ;
-
-if ( $@ ) {
-   # Not pretty, but it allows testing of things not implemented soley
-   # on VMS.  It might be better to change File::Spec::VMS to do this,
-   # making it more usable when running on (say) Unix but working with
-   # VMS paths.
-   eval qq-
-      sub File::Spec::VMS::vmsify  { die "$skip_exception" }
-      sub File::Spec::VMS::unixify { die "$skip_exception" }
-      sub File::Spec::VMS::vmspath { die "$skip_exception" }
-   - ;
-   $INC{"VMS/Filespec.pm"} = 1 ;
-}
-require File::Spec::VMS ;
-
-require File::Spec::OS2 ;
-require File::Spec::Mac ;
-
-print "1..", scalar( @tests ), "\n" ;
-
-my $current_test= 1 ;
-
-# Test out the class methods
-for ( @tests ) {
-   tryfunc( @$_ ) ;
-}
-
-
-
-#
-# Tries a named function with the given args and compares the result against
-# an expected result. Works with functions that return scalars or arrays.
-#
-sub tryfunc {
-    my $function = shift ;
-    my $expected = shift ;
-    my $platform = shift ;
-
-    if ($platform && $^O ne $platform) {
-       print "ok $current_test # skipped: $function\n" ;
-       ++$current_test ;
-       return;
-    }
-
-    $function =~ s#\\#\\\\#g ;
-
-    my $got ;
-    if ( $function =~ /^[^\$].*->/ ) {
-       $got = eval( "join( ',', File::Spec::$function )" ) ;
-    }
-    else {
-       $got = eval( "join( ',', $function )" ) ;
-    }
-
-    if ( $@ ) {
-        if ( substr( $@, 0, length $skip_exception ) eq $skip_exception ) {
-           chomp $@ ;
-           print "ok $current_test # skip $function: $@\n" ;
-       }
-       else {
-           chomp $@ ;
-           print "not ok $current_test # $function: $@\n" ;
-       }
-    }
-    elsif ( !defined( $got ) || $got ne $expected ) {
-       print "not ok $current_test # $function: got '$got', expected '$expected'\n" ;
-    }
-    else {
-       print "ok $current_test # $function\n" ;
-    }
-    ++$current_test ;
-}

diff --git a/t/lib/filestat.t b/t/lib/filestat.t
deleted file mode 100644 (file)
index ac6d95f..0000000
--- a/t/lib/filestat.t
+++ /dev/null
@@ -1,70 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN {
-    our $hasst;
-    eval { my @n = stat "TEST" };
-    $hasst = 1 unless $@ && $@ =~ /unimplemented/;
-    unless ($hasst) { print "1..0 # Skip: no stat\n"; exit 0 }
-    use Config;
-    $hasst = 0 unless $Config{'i_sysstat'} eq 'define';
-    unless ($hasst) { print "1..0 # Skip: no sys/stat.h\n"; exit 0 }
-}
-
-BEGIN {
-    our @stat = stat "TEST"; # This is the function stat.
-    unless (@stat) { print "1..0 # Skip: no file TEST\n"; exit 0 }
-}
-
-print "1..14\n";
-
-use File::stat;
-
-print "ok 1\n";
-
-my $stat = stat "TEST"; # This is the OO stat.
-
-print "not " unless $stat->dev     == $stat[ 0];
-print "ok 2\n";
-
-print "not " unless $stat->ino     == $stat[ 1];
-print "ok 3\n";
-
-print "not " unless $stat->mode    == $stat[ 2];
-print "ok 4\n";
-
-print "not " unless $stat->nlink   == $stat[ 3];
-print "ok 5\n";
-
-print "not " unless $stat->uid     == $stat[ 4];
-print "ok 6\n";
-
-print "not " unless $stat->gid     == $stat[ 5];
-print "ok 7\n";
-
-print "not " unless $stat->rdev    == $stat[ 6];
-print "ok 8\n";
-
-print "not " unless $stat->size    == $stat[ 7];
-print "ok 9\n";
-
-print "not " unless $stat->atime   == $stat[ 8];
-print "ok 10\n";
-
-print "not " unless $stat->mtime   == $stat[ 9];
-print "ok 11\n";
-
-print "not " unless $stat->ctime   == $stat[10];
-print "ok 12\n";
-
-print "not " unless $stat->blksize == $stat[11];
-print "ok 13\n";
-
-print "not " unless $stat->blocks  == $stat[12];
-print "ok 14\n";
-
-# Testing pretty much anything else is unportable.

diff --git a/t/lib/filter-simple.t b/t/lib/filter-simple.t
deleted file mode 100644 (file)
index 3fb3270..0000000
--- a/t/lib/filter-simple.t
+++ /dev/null
@@ -1,27 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir('t') if -d 't';    
-    @INC = 'lib';
-}
-
-print "1..6\n";
-
-use MyFilter qr/not ok/ => "ok", fail => "ok";
-
-sub fail { print "fail ", $_[0], "\n" }
-
-print "not ok 1\n";
-print "fail 2\n";
-
-fail(3);
-&fail(4);
-
-print "not " unless "whatnot okapi" eq "whatokapi";
-print "ok 5\n";
-
-no MyFilter;
-
-print "not " unless "not ok" =~ /^not /;
-print "ok 6\n";
-

diff --git a/t/lib/filter-util.t b/t/lib/filter-util.t
deleted file mode 100644 (file)
index dc667c9..0000000
--- a/t/lib/filter-util.t
+++ /dev/null
@@ -1,795 +0,0 @@
-BEGIN {
-    chdir('t') if -d 't';    
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ m{\bFilter/Util/Call\b}) {
-        print "1..0 # Skip: Filter::Util::Call was not built\n";
-        exit 0;
-    }
-    require 'lib/filter-util.pl';
-}
-
-use strict;
-use warnings;
-
-use vars qw($Inc $Perl);
-
-print "1..28\n" ;
-
-$Perl = "$Perl -w" ;
-
-use Cwd ;
-my $here = getcwd ;
-
-
-my $filename = "call.tst" ;
-my $filenamebin = "call.bin" ;
-my $module   = "MyTest" ;
-my $module2  = "MyTest2" ;
-my $module3  = "MyTest3" ;
-my $module4  = "MyTest4" ;
-my $module5  = "MyTest5" ;
-my $nested   = "nested" ;
-my $block   = "block" ;
-
-# Test error cases
-##################
-
-# no filter function in module 
-###############################
-
-writeFile("${module}.pm", <<EOM) ;
-package ${module} ;
-
-use Filter::Util::Call ;
- 
-sub import { filter_add(bless []) }
-
-1 ;
-EOM
- 
-my $a = `$Perl "-I." $Inc -e "use ${module} ;"  2>&1` ;
-ok(1, (($? >>8) != 0 or (($^O eq 'MSWin32' || $^O eq 'NetWare') && $? != 0))) ;
-ok(2, $a =~ /^Can't locate object method "filter" via package "MyTest"/) ;
- 
-# no reference parameter in filter_add
-######################################
-
-writeFile("${module}.pm", <<EOM) ;
-package ${module} ;
- 
-use Filter::Util::Call ;
- 
-sub import { filter_add() }
- 
-1 ;
-EOM
- 
-$a = `$Perl "-I." $Inc -e "use ${module} ;"  2>&1` ;
-ok(3, (($? >>8) != 0 or (($^O eq 'MSWin32' || $^O eq 'NetWare') && $? != 0))) ;
-#ok(4, $a =~ /^usage: filter_add\(ref\) at ${module}.pm/) ;
-ok(4, $a =~ /^Not enough arguments for Filter::Util::Call::filter_add/) ;
- 
-
-
-
-# non-error cases
-#################
-
-
-# a simple filter, using a closure
-#################
-
-writeFile("${module}.pm", <<EOM, <<'EOM') ;
-package ${module} ;
- 
-EOM
-use Filter::Util::Call ;
-sub import { 
-    filter_add(
-       sub {
- 
-           my ($status) ;
- 
-           if (($status = filter_read()) > 0) {
-               s/ABC/DEF/g 
-           }
-           $status ;
-       } ) ;
-}
-
-1 ;
-EOM
- 
-writeFile($filename, <<EOM, <<'EOM') ;
-
-use $module ;
-EOM
-
-use Cwd ;
-$here = getcwd ;
-print "I am $here\n" ;
-print "some letters ABC\n" ;
-$y = "ABCDEF" ;
-print <<EOF ;
-Alphabetti Spagetti ($y)
-EOF
-
-EOM
-
-$a = `$Perl "-I." $Inc $filename  2>&1` ;
-ok(5, ($? >>8) == 0) ;
-ok(6, $a eq <<EOM) ;
-I am $here
-some letters DEF
-Alphabetti Spagetti (DEFDEF)
-EOM
-
-# a simple filter, not using a closure
-#################
- 
-writeFile("${module}.pm", <<EOM, <<'EOM') ;
-package ${module} ;
- 
-EOM
-use Filter::Util::Call ;
-sub import { filter_add(bless []) }
- 
-sub filter
-{
-    my ($self) = @_ ;
-    my ($status) ;
- 
-    if (($status = filter_read()) > 0) {
-        s/ABC/DEF/g
-    }
-    $status ;
-}
-
- 
-1 ;
-EOM
- 
-writeFile($filename, <<EOM, <<'EOM') ;
- 
-use $module ;
-EOM
- 
-use Cwd ;
-$here = getcwd ;
-print "I am $here\n" ;
-print "some letters ABC\n" ;
-$y = "ABCDEF" ;
-print <<EOF ;
-Alphabetti Spagetti ($y)
-EOF
- 
-EOM
- 
-$a = `$Perl "-I." $Inc $filename  2>&1` ;
-ok(7, ($? >>8) == 0) ;
-ok(8, $a eq <<EOM) ;
-I am $here
-some letters DEF
-Alphabetti Spagetti (DEFDEF)
-EOM
-
-
-# nested filters
-################
-
-
-writeFile("${module2}.pm", <<EOM, <<'EOM') ;
-package ${module2} ;
-use Filter::Util::Call ;
- 
-EOM
-sub import { filter_add(bless []) }
- 
-sub filter
-{
-    my ($self) = @_ ;
-    my ($status) ;
- 
-    if (($status = filter_read()) > 0) {
-        s/XYZ/PQR/g
-    }
-    $status ;
-}
- 
-1 ;
-EOM
- 
-writeFile("${module3}.pm", <<EOM, <<'EOM') ;
-package ${module3} ;
-use Filter::Util::Call ;
- 
-EOM
-sub import { filter_add(
- 
-    sub 
-    {
-        my ($status) ;
-     
-        if (($status = filter_read()) > 0) {
-            s/Fred/Joe/g
-        }
-        $status ;
-    } ) ;
-}
- 
-1 ;
-EOM
- 
-writeFile("${module4}.pm", <<EOM) ;
-package ${module4} ;
- 
-use $module5 ;
-
-print "I'm feeling used!\n" ;
-print "Fred Joe ABC DEF PQR XYZ\n" ;
-print "See you Today\n" ;
-1;
-EOM
-
-writeFile("${module5}.pm", <<EOM, <<'EOM') ;
-package ${module5} ;
-use Filter::Util::Call ;
- 
-EOM
-sub import { filter_add(bless []) }
- 
-sub filter
-{
-    my ($self) = @_ ;
-    my ($status) ;
- 
-    if (($status = filter_read()) > 0) {
-        s/Today/Tomorrow/g
-    }
-    $status ;
-}
- 
-1 ;
-EOM
-
-writeFile($filename, <<EOM, <<'EOM') ;
- 
-# two filters for this file
-use $module ;
-use $module2 ;
-require "$nested" ;
-use $module4 ;
-EOM
- 
-print "some letters ABCXYZ\n" ;
-$y = "ABCDEFXYZ" ;
-print <<EOF ;
-Fred likes Alphabetti Spagetti ($y)
-EOF
- 
-EOM
- 
-writeFile($nested, <<EOM, <<'EOM') ;
-use $module3 ;
-EOM
- 
-print "This is another file XYZ\n" ;
-print <<EOF ;
-Where is Fred?
-EOF
- 
-EOM
-
-$a = `$Perl "-I." $Inc $filename  2>&1` ;
-ok(9, ($? >>8) == 0) ;
-ok(10, $a eq <<EOM) ;
-I'm feeling used!
-Fred Joe ABC DEF PQR XYZ
-See you Tomorrow
-This is another file XYZ
-Where is Joe?
-some letters DEFPQR
-Fred likes Alphabetti Spagetti (DEFDEFPQR)
-EOM
-
-# using the module context (with a closure)
-###########################################
- 
- 
-writeFile("${module2}.pm", <<EOM, <<'EOM') ;
-package ${module2} ;
-use Filter::Util::Call ;
- 
-EOM
-sub import
-{
-    my ($type) = shift ;
-    my (@strings) = @_ ;
- 
- 
-    filter_add (
- 
-       sub 
-       {
-           my ($status) ;
-           my ($pattern) ;
-            
-           if (($status = filter_read()) > 0) {
-                foreach $pattern (@strings)
-                   { s/$pattern/PQR/g }
-           }
-            
-           $status ;
-       }
-       )
- 
-}
-1 ;
-EOM
- 
- 
-writeFile($filename, <<EOM, <<'EOM') ;
- 
-use $module2 qw( XYZ KLM) ;
-use $module2 qw( ABC NMO) ;
-EOM
- 
-print "some letters ABCXYZ KLM NMO\n" ;
-$y = "ABCDEFXYZKLMNMO" ;
-print <<EOF ;
-Alphabetti Spagetti ($y)
-EOF
- 
-EOM
- 
-$a = `$Perl "-I." $Inc $filename  2>&1` ;
-ok(11, ($? >>8) == 0) ;
-ok(12, $a eq <<EOM) ;
-some letters PQRPQR PQR PQR
-Alphabetti Spagetti (PQRDEFPQRPQRPQR)
-EOM
- 
-
-
-# using the module context (without a closure)
-##############################################
-
-
-writeFile("${module2}.pm", <<EOM, <<'EOM') ;
-package ${module2} ;
-use Filter::Util::Call ;
- 
-EOM
-sub import 
-{ 
-    my ($type) = shift ;
-    my (@strings) = @_ ;
-
-  
-    filter_add (bless [@strings]) 
-}
- 
-sub filter
-{
-    my ($self) = @_ ;
-    my ($status) ;
-    my ($pattern) ;
- 
-    if (($status = filter_read()) > 0) {
-       foreach $pattern (@$self)
-          { s/$pattern/PQR/g }
-    }
-
-    $status ;
-}
- 
-1 ;
-EOM
- 
- 
-writeFile($filename, <<EOM, <<'EOM') ;
- 
-use $module2 qw( XYZ KLM) ;
-use $module2 qw( ABC NMO) ;
-EOM
- 
-print "some letters ABCXYZ KLM NMO\n" ;
-$y = "ABCDEFXYZKLMNMO" ;
-print <<EOF ;
-Alphabetti Spagetti ($y)
-EOF
- 
-EOM
- 
-$a = `$Perl "-I." $Inc $filename  2>&1` ;
-ok(13, ($? >>8) == 0) ;
-ok(14, $a eq <<EOM) ;
-some letters PQRPQR PQR PQR
-Alphabetti Spagetti (PQRDEFPQRPQRPQR)
-EOM
-
-# multi line test
-#################
-
-
-writeFile("${module2}.pm", <<EOM, <<'EOM') ;
-package ${module2} ;
-use Filter::Util::Call ;
- 
-EOM
-sub import
-{ 
-    my ($type) = shift ;
-    my (@strings) = @_ ;
-
-  
-    filter_add(bless []) 
-}
- 
-sub filter
-{
-    my ($self) = @_ ;
-    my ($status) ;
- 
-    # read first line
-    if (($status = filter_read()) > 0) {
-       chop ;
-       s/\r$//;
-       # and now the second line (it will append)
-        $status = filter_read() ;
-    }
-
-    $status ;
-}
- 
-1 ;
-EOM
- 
- 
-writeFile($filename, <<EOM, <<'EOM') ;
- 
-use $module2  ;
-EOM
-print "don't cut me 
-in half\n" ;
-print  
-<<EOF ;
-appen
-ded
-EO
-F
- 
-EOM
- 
-$a = `$Perl "-I." $Inc $filename  2>&1` ;
-ok(15, ($? >>8) == 0) ;
-ok(16, $a eq <<EOM) ;
-don't cut me in half
-appended
-EOM
-
-# Block test
-#############
-
-writeFile("${block}.pm", <<EOM, <<'EOM') ;
-package ${block} ;
-use Filter::Util::Call ;
- 
-EOM
-sub import
-{ 
-    my ($type) = shift ;
-    my (@strings) = @_ ;
-
-  
-    filter_add (bless [@strings] )
-}
- 
-sub filter
-{
-    my ($self) = @_ ;
-    my ($status) ;
-    my ($pattern) ;
- 
-    filter_read(20)  ;
-}
- 
-1 ;
-EOM
-
-my $string = <<'EOM' ;
-print "hello mum\n" ;
-$x = 'me ' x 3 ;
-print "Who wants it?\n$x\n" ;
-EOM
-
-
-writeFile($filename, <<EOM, $string ) ;
-use $block ;
-EOM
- 
-$a = `$Perl "-I." $Inc $filename  2>&1` ;
-ok(17, ($? >>8) == 0) ;
-ok(18, $a eq <<EOM) ;
-hello mum
-Who wants it?
-me me me 
-EOM
-
-# use in the filter
-####################
-
-writeFile("${block}.pm", <<EOM, <<'EOM') ;
-package ${block} ;
-use Filter::Util::Call ;
- 
-EOM
-use Cwd ;
-
-sub import
-{ 
-    my ($type) = shift ;
-    my (@strings) = @_ ;
-
-  
-    filter_add(bless [@strings] )
-}
- 
-sub filter
-{
-    my ($self) = @_ ;
-    my ($status) ;
-    my ($here) = quotemeta getcwd ;
- 
-    if (($status = filter_read()) > 0) {
-        s/DIR/$here/g
-    }
-    $status ;
-}
- 
-1 ;
-EOM
-
-writeFile($filename, <<EOM, <<'EOM') ;
-use $block ;
-EOM
-print "We are in DIR\n" ;
-EOM
- 
-$a = `$Perl "-I." $Inc $filename  2>&1` ;
-ok(19, ($? >>8) == 0) ;
-ok(20, $a eq <<EOM) ;
-We are in $here
-EOM
-
-
-# filter_del
-#############
- 
-writeFile("${block}.pm", <<EOM, <<'EOM') ;
-package ${block} ;
-use Filter::Util::Call ;
- 
-EOM
- 
-sub import
-{
-    my ($type) = shift ;
-    my ($count) = @_ ;
- 
- 
-    filter_add(bless \$count )
-}
- 
-sub filter
-{
-    my ($self) = @_ ;
-    my ($status) ;
- 
-    s/HERE/THERE/g
-        if ($status = filter_read()) > 0 ;
-
-    -- $$self ;
-    filter_del() if $$self <= 0 ;
-
-    $status ;
-}
- 
-1 ;
-EOM
- 
-writeFile($filename, <<EOM, <<'EOM') ;
-use $block (3) ;
-EOM
-print "
-HERE I am
-I am HERE
-HERE today gone tomorrow\n" ;
-EOM
- 
-$a = `$Perl "-I." $Inc $filename  2>&1` ;
-ok(21, ($? >>8) == 0) ;
-ok(22, $a eq <<EOM) ;
-
-THERE I am
-I am THERE
-HERE today gone tomorrow
-EOM
-
-
-# filter_read_exact
-####################
- 
-writeFile("${block}.pm", <<EOM, <<'EOM') ;
-package ${block} ;
-use Filter::Util::Call ;
- 
-EOM
- 
-sub import
-{
-    my ($type) = shift ;
- 
-    filter_add(bless [] )
-}
- 
-sub filter
-{
-    my ($self) = @_ ;
-    my ($status) ;
- 
-    if (($status = filter_read_exact(9)) > 0) {
-        s/HERE/THERE/g
-    }
- 
-    $status ;
-}
- 
-1 ;
-EOM
- 
-writeFile($filenamebin, <<EOM, <<'EOM') ;
-use $block ;
-EOM
-print "
-HERE I am
-I'm HERE
-HERE today gone tomorrow\n" ;
-EOM
- 
-$a = `$Perl "-I." $Inc $filenamebin  2>&1` ;
-ok(23, ($? >>8) == 0) ;
-ok(24, $a eq <<EOM) ;
-
-HERE I am
-I'm THERE
-THERE today gone tomorrow
-EOM
-
-{
-
-# Check __DATA__
-####################
- 
-writeFile("${block}.pm", <<EOM, <<'EOM') ;
-package ${block} ;
-use Filter::Util::Call ;
- 
-EOM
- 
-sub import
-{
-    my ($type) = shift ;
- 
-    filter_add(bless [] )
-}
- 
-sub filter
-{
-    my ($self) = @_ ;
-    my ($status) ;
- 
-    if (($status = filter_read()) > 0) {
-        s/HERE/THERE/g
-    }
- 
-    $status ;
-}
- 
-1 ;
-EOM
- 
-writeFile($filename, <<EOM, <<'EOM') ;
-use $block ;
-EOM
-print "HERE HERE\n";
-@a = <DATA>;
-print @a;
-__DATA__
-HERE I am
-I'm HERE
-HERE today gone tomorrow
-EOM
- 
-$a = `$Perl "-I." $Inc $filename  2>&1` ;
-ok(25, ($? >>8) == 0) ;
-ok(26, $a eq <<EOM) ;
-THERE THERE
-HERE I am
-I'm HERE
-HERE today gone tomorrow
-EOM
-
-}
-
-{
-
-# Check __END__
-####################
- 
-writeFile("${block}.pm", <<EOM, <<'EOM') ;
-package ${block} ;
-use Filter::Util::Call ;
- 
-EOM
- 
-sub import
-{
-    my ($type) = shift ;
- 
-    filter_add(bless [] )
-}
- 
-sub filter
-{
-    my ($self) = @_ ;
-    my ($status) ;
- 
-    if (($status = filter_read()) > 0) {
-        s/HERE/THERE/g
-    }
- 
-    $status ;
-}
- 
-1 ;
-EOM
- 
-writeFile($filename, <<EOM, <<'EOM') ;
-use $block ;
-EOM
-print "HERE HERE\n";
-@a = <DATA>;
-print @a;
-__END__
-HERE I am
-I'm HERE
-HERE today gone tomorrow
-EOM
- 
-$a = `$Perl "-I." $Inc $filename  2>&1` ;
-ok(27, ($? >>8) == 0) ;
-ok(28, $a eq <<EOM) ;
-THERE THERE
-HERE I am
-I'm HERE
-HERE today gone tomorrow
-EOM
-
-}
-
-END {
-    1 while unlink $filename ;
-    1 while unlink $filenamebin ;
-    1 while unlink "${module}.pm" ;
-    1 while unlink "${module2}.pm" ;
-    1 while unlink "${module3}.pm" ;
-    1 while unlink "${module4}.pm" ;
-    1 while unlink "${module5}.pm" ;
-    1 while unlink $nested ;
-    1 while unlink "${block}.pm" ;
-}
-
-

diff --git a/t/lib/findbin.t b/t/lib/findbin.t
deleted file mode 100755 (executable)
index 3e742f9..0000000
--- a/t/lib/findbin.t
+++ /dev/null
@@ -1,13 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-print "1..1\n";
-
-use FindBin qw($Bin);
-
-print "not " unless $Bin =~ m,t[/.]lib\]?$,;
-print "ok 1\n";

diff --git a/t/lib/findtaint.t b/t/lib/findtaint.t
deleted file mode 100644 (file)
index b2c33c4..0000000
--- a/t/lib/findtaint.t
+++ /dev/null
@@ -1,388 +0,0 @@
-#!./perl -T
-
-
-my %Expect_File = (); # what we expect for $_ 
-my %Expect_Name = (); # what we expect for $File::Find::name/fullname
-my %Expect_Dir  = (); # what we expect for $File::Find::dir
-my $symlink_exists = eval { symlink("",""); 1 };
-my $cwd;
-my $cwd_untainted;
-
-BEGIN {
-    chdir 't' if -d 't';
-    unshift @INC => '../lib';
-
-    for (keys %ENV) { # untaint ENV
-    ($ENV{$_}) = $ENV{$_} =~ /(.*)/;
-    }
-}
-
-if ( $symlink_exists ) { print "1..45\n"; }
-else                   { print "1..27\n";  }
-
-use File::Find;
-use File::Spec;
-use Cwd;
-
-# Remove insecure directories from PATH
-my @path;
-my $sep = ($^O eq 'MSWin32') ? ';' : ':';
-foreach my $dir (split(/$sep/,$ENV{'PATH'}))
- {
-  push(@path,$dir) unless -w $dir;
- }
-$ENV{'PATH'} = join($sep,@path);
-
-cleanup();
-
-find({wanted => sub { print "ok 1\n" if $_ eq 'filefind.t'; },
-      untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir);
-
-finddepth({wanted => sub { print "ok 2\n" if $_ eq 'filefind.t'; },
-           untaint => 1, untaint_pattern => qr|^(.+)$|},
-           File::Spec->curdir);
-
-my $case = 2;
-my $FastFileTests_OK = 0;
-
-sub cleanup {
-    if (-d dir_path('for_find')) {
-        chdir(dir_path('for_find'));
-    }
-    if (-d dir_path('fa')) {
-        unlink file_path('fa', 'fa_ord'),
-               file_path('fa', 'fsl'),
-               file_path('fa', 'faa', 'faa_ord'),
-               file_path('fa', 'fab', 'fab_ord'),
-               file_path('fa', 'fab', 'faba', 'faba_ord'),
-               file_path('fb', 'fb_ord'),
-               file_path('fb', 'fba', 'fba_ord');
-        rmdir dir_path('fa', 'faa');
-        rmdir dir_path('fa', 'fab', 'faba');
-        rmdir dir_path('fa', 'fab');
-        rmdir dir_path('fa');
-        rmdir dir_path('fb', 'fba');
-        rmdir dir_path('fb');
-        chdir File::Spec->updir;
-        rmdir dir_path('for_find');
-    }
-}
-
-END {
-    cleanup();
-}
-
-sub Check($) {
-    $case++;
-    if ($_[0]) { print "ok $case\n"; }
-    else       { print "not ok $case\n"; }
-}
-
-sub CheckDie($) {
-    $case++;
-    if ($_[0]) { print "ok $case\n"; }
-    else { print "not ok $case\n $!\n"; exit 0; }
-}
-
-sub touch {
-    CheckDie( open(my $T,'>',$_[0]) );
-}
-
-sub MkDir($$) {
-    CheckDie( mkdir($_[0],$_[1]) );
-}
-
-sub wanted_File_Dir {
-    print "# \$File::Find::dir => '$File::Find::dir'\n";
-    print "# \$_ => '$_'\n";
-    s#\.$## if ($^O eq 'VMS' && $_ ne '.');
-    Check( $Expect_File{$_} );
-    if ( $FastFileTests_OK ) {
-        delete $Expect_File{ $_} 
-          unless ( $Expect_Dir{$_} && ! -d _ );
-    } else {
-        delete $Expect_File{$_} 
-          unless ( $Expect_Dir{$_} && ! -d $_ );
-    }
-}
-
-sub wanted_File_Dir_prune {
-    &wanted_File_Dir;
-    $File::Find::prune=1 if  $_ eq 'faba';
-}
-
-
-sub simple_wanted {
-    print "# \$File::Find::dir => '$File::Find::dir'\n";
-    print "# \$_ => '$_'\n";
-}
-
-
-# Use dir_path() to specify a directory path that's expected for
-# $File::Find::dir (%Expect_Dir). Also use it in file operations like
-# chdir, rmdir etc.
-#
-# dir_path() concatenates directory names to form a _relative_
-# directory path, independant from the platform it's run on, although
-# there are limitations.  Don't try to create an absolute path,
-# because that may fail on operating systems that have the concept of
-# volume names (e.g. Mac OS). Be careful when you want to create an
-# updir path like ../fa (Unix) or ::fa: (Mac OS). Plain directory
-# names will work best. As a special case, you can pass it a "." as
-# first argument, to create a directory path like "./fa/dir" on
-# operating systems other than Mac OS (actually, Mac OS will ignore
-# the ".", if it's the first argument). If there's no second argument,
-# this function will return the empty string on Mac OS and the string
-# "./" otherwise.
-
-sub dir_path {
-    my $first_item = shift @_;
-
-    if ($first_item eq '.') {
-        if ($^O eq 'MacOS') {
-            return '' unless @_;
-            # ignore first argument; return a relative path
-            # with leading ":" and with trailing ":"
-            return File::Spec->catdir("", @_); 
-        } else { # other OS
-            return './' unless @_;
-            my $path = File::Spec->catdir(@_);
-            # add leading "./"
-            $path = "./$path";
-            return $path;
-        }
-
-    } else { # $first_item ne '.'
-        return $first_item unless @_; # return plain filename
-        if ($^O eq 'MacOS') {
-            # relative path with leading ":" and with trailing ":"
-            return File::Spec->catdir("", $first_item, @_);
-        } else { # other OS
-            return File::Spec->catdir($first_item, @_);
-        }
-    }
-}
-
-
-# Use topdir() to specify a directory path that you want to pass to
-#find/finddepth Basically, topdir() does the same as dir_path() (see
-#above), except that there's no trailing ":" on Mac OS.
-
-sub topdir {
-    my $path = dir_path(@_);
-    $path =~ s/:$// if ($^O eq 'MacOS');
-    return $path;
-}
-
-
-# Use file_path() to specify a file path that's expected for $_ (%Expect_File).
-# Also suitable for file operations like unlink etc.
-
-# file_path() concatenates directory names (if any) and a filename to
-# form a _relative_ file path (the last argument is assumed to be a
-# file). It's independant from the platform it's run on, although
-# there are limitations (see the warnings for dir_path() above). As a
-# special case, you can pass it a "." as first argument, to create a
-# file path like "./fa/file" on operating systems other than Mac OS
-# (actually, Mac OS will ignore the ".", if it's the first
-# argument). If there's no second argument, this function will return
-# the empty string on Mac OS and the string "./" otherwise.
-
-sub file_path {
-    my $first_item = shift @_;
-
-    if ($first_item eq '.') {
-        if ($^O eq 'MacOS') {
-            return '' unless @_;
-            # ignore first argument; return a relative path  
-            # with leading ":", but without trailing ":"
-            return File::Spec->catfile("", @_); 
-        } else { # other OS
-            return './' unless @_;
-            my $path = File::Spec->catfile(@_);
-            # add leading "./" 
-            $path = "./$path"; 
-            return $path;
-        }
-
-    } else { # $first_item ne '.'
-        return $first_item unless @_; # return plain filename
-        if ($^O eq 'MacOS') {
-            # relative path with leading ":", but without trailing ":"
-            return File::Spec->catfile("", $first_item, @_);
-        } else { # other OS
-            return File::Spec->catfile($first_item, @_);
-        }
-    }
-}
-
-
-# Use file_path_name() to specify a file path that's expected for
-# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1
-# option is in effect, $_ is the same as $File::Find::Name. In that
-# case, also use this function to specify a file path that's expected
-# for $_.
-#
-# Basically, file_path_name() does the same as file_path() (see
-# above), except that there's always a leading ":" on Mac OS, even for
-# plain file/directory names.
-
-sub file_path_name {
-    my $path = file_path(@_);
-    $path = ":$path" if (($^O eq 'MacOS') && ($path !~ /:/));
-    return $path;
-}
-
-
-
-MkDir( dir_path('for_find'), 0770 );
-CheckDie(chdir( dir_path('for_find')));
-
-$cwd = cwd(); # save cwd
-( $cwd_untainted ) = $cwd =~ m|^(.+)$|; # untaint it
-
-MkDir( dir_path('fa'), 0770 );
-MkDir( dir_path('fb'), 0770  );
-touch( file_path('fb', 'fb_ord') );
-MkDir( dir_path('fb', 'fba'), 0770  );
-touch( file_path('fb', 'fba', 'fba_ord') );
-if ($^O eq 'MacOS') {
-      CheckDie( symlink(':fb',':fa:fsl') ) if $symlink_exists;
-} else {
-      CheckDie( symlink('../fb','fa/fsl') ) if $symlink_exists;
-}
-touch( file_path('fa', 'fa_ord') );
-
-MkDir( dir_path('fa', 'faa'), 0770  );
-touch( file_path('fa', 'faa', 'faa_ord') );
-MkDir( dir_path('fa', 'fab'), 0770  );
-touch( file_path('fa', 'fab', 'fab_ord') );
-MkDir( dir_path('fa', 'fab', 'faba'), 0770  );
-touch( file_path('fa', 'fab', 'faba', 'faba_ord') );
-
-print "# check untainting (no follow)\n";
-
-# untainting here should work correctly
-
-%Expect_File = (File::Spec->curdir => 1, file_path('fsl') =>
-                1,file_path('fa_ord') => 1, file_path('fab') => 1,
-                file_path('fab_ord') => 1, file_path('faba') => 1,
-                file_path('faa') => 1, file_path('faa_ord') => 1);
-delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
-%Expect_Name = ();
-
-%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
-                dir_path('fab') => 1, dir_path('faba') => 1,
-                dir_path('fb') => 1, dir_path('fba') => 1);
-
-delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
-
-File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1,
-                  untaint_pattern => qr|^(.+)$|}, topdir('fa') );
-
-Check( scalar(keys %Expect_File) == 0 );
-
-
-# don't untaint at all, should die
-%Expect_File = ();
-%Expect_Name = ();
-%Expect_Dir  = ();
-undef $@;
-eval {File::Find::find( {wanted => \&simple_wanted}, topdir('fa') );};
-Check( $@ =~ m|Insecure dependency| );
-chdir($cwd_untainted);
-
-
-# untaint pattern doesn't match, should die 
-undef $@;
-
-eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
-                         untaint_pattern => qr|^(NO_MATCH)$|},
-                         topdir('fa') );};
-
-Check( $@ =~ m|is still tainted| );
-chdir($cwd_untainted);
-
-
-# untaint pattern doesn't match, should die when we chdir to cwd   
-print "# check untaint_skip (no follow)\n";
-undef $@;
-
-eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
-                         untaint_skip => 1, untaint_pattern =>
-                         qr|^(NO_MATCH)$|}, topdir('fa') );};
-
-Check( $@ =~ m|insecure cwd| );
-chdir($cwd_untainted);
-
-
-if ( $symlink_exists ) {
-    print "# --- symbolic link tests --- \n";
-    $FastFileTests_OK= 1;
-
-    print "# check untainting (follow)\n";
-
-    # untainting here should work correctly
-    # no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File
-
-    %Expect_File = (file_path_name('fa') => 1,
-                   file_path_name('fa','fa_ord') => 1,
-                   file_path_name('fa', 'fsl') => 1,
-                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
-                    file_path_name('fa', 'fsl', 'fba') => 1,
-                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
-                    file_path_name('fa', 'fab') => 1,
-                    file_path_name('fa', 'fab', 'fab_ord') => 1,
-                    file_path_name('fa', 'fab', 'faba') => 1,
-                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
-                    file_path_name('fa', 'faa') => 1,
-                    file_path_name('fa', 'faa', 'faa_ord') => 1);
-
-    %Expect_Name = ();
-
-    %Expect_Dir = (dir_path('fa') => 1,
-                  dir_path('fa', 'faa') => 1,
-                   dir_path('fa', 'fab') => 1,
-                  dir_path('fa', 'fab', 'faba') => 1,
-                  dir_path('fb') => 1,
-                  dir_path('fb', 'fba') => 1);
-
-    File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1,
-                       no_chdir => 1, untaint => 1, untaint_pattern =>
-                       qr|^(.+)$| }, topdir('fa') );
-
-    Check( scalar(keys %Expect_File) == 0 );
- 
-    
-    # don't untaint at all, should die
-    undef $@;
-
-    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1},
-                           topdir('fa') );};
-
-    Check( $@ =~ m|Insecure dependency| );
-    chdir($cwd_untainted);
-
-    # untaint pattern doesn't match, should die
-    undef $@;
-
-    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
-                             untaint => 1, untaint_pattern =>
-                             qr|^(NO_MATCH)$|}, topdir('fa') );};
-
-    Check( $@ =~ m|is still tainted| );
-    chdir($cwd_untainted);
-
-    # untaint pattern doesn't match, should die when we chdir to cwd
-    print "# check untaint_skip (follow)\n";
-    undef $@;
-
-    eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
-                             untaint_skip => 1, untaint_pattern =>
-                             qr|^(NO_MATCH)$|}, topdir('fa') );};
-
-    Check( $@ =~ m|insecure cwd| );
-    chdir($cwd_untainted);
-
-} 
-

diff --git a/t/lib/ftmp-mktemp.t b/t/lib/ftmp-mktemp.t
deleted file mode 100755 (executable)
index 4e31d01..0000000
--- a/t/lib/ftmp-mktemp.t
+++ /dev/null
@@ -1,115 +0,0 @@
-#!/usr/bin/perl -w
-
-# Test for mktemp family of commands in File::Temp
-# Use STANDARD safe level for these tests
-
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Test; import Test;
-       plan(tests => 9);
-}
-
-use strict;
-
-use File::Spec;
-use File::Path;
-use File::Temp qw/ :mktemp unlink0 /;
-use FileHandle;
-
-ok(1);
-
-# MKSTEMP - test
-
-# Create file in temp directory
-my $template = File::Spec->catfile(File::Spec->tmpdir, 'wowserXXXX');
-
-(my $fh, $template) = mkstemp($template);
-
-print "# MKSTEMP: FH is $fh File is $template fileno=".fileno($fh)."\n";
-# Check if the file exists
-ok( (-e $template) );
-
-# Autoflush
-$fh->autoflush(1) if $] >= 5.006;
-
-# Try printing something to the file
-my $string = "woohoo\n";
-print $fh $string;
-
-# rewind the file
-ok(seek( $fh, 0, 0));
-
-# Read from the file
-my $line = <$fh>;
-
-# compare with previous string
-ok($string, $line);
-
-# Tidy up
-# This test fails on Windows NT since it seems that the size returned by 
-# stat(filehandle) does not always equal the size of the stat(filename)
-# This must be due to caching. In particular this test writes 7 bytes
-# to the file which are not recognised by stat(filename)
-# Simply waiting 3 seconds seems to be enough for the system to update
-
-if ($^O eq 'MSWin32') {
-  sleep 3;
-}
-my $status = unlink0($fh, $template);
-if ($status) {
-  ok( $status );
-} else {
-  skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
-}
-
-# MKSTEMPS
-# File with suffix. This is created in the current directory so
-# may be problematic on NFS
-
-$template = "suffixXXXXXX";
-my $suffix = ".dat";
-
-($fh, my $fname) = mkstemps($template, $suffix);
-
-print "# MKSTEMPS: File is $template -> $fname fileno=".fileno($fh)."\n";
-# Check if the file exists
-ok( (-e $fname) );
-
-# This fails if you are running on NFS
-# If this test fails simply skip it rather than doing a hard failure
-$status = unlink0($fh, $fname);
-
-if ($status) {
-  ok($status);
-} else {
-  skip("Skip test failed probably due to cwd being on NFS",1)
-}
-
-# MKDTEMP
-# Temp directory
-
-$template = File::Spec->catdir(File::Spec->tmpdir, 'tmpdirXXXXXX');
-
-my $tmpdir = mkdtemp($template);
-
-print "# MKDTEMP: Name is $tmpdir from template $template\n";
-
-ok( (-d $tmpdir ) );
-
-# Need to tidy up after myself
-rmtree($tmpdir);
-
-# MKTEMP
-# Just a filename, not opened
-
-$template = File::Spec->catfile(File::Spec->tmpdir, 'mytestXXXXXX');
-
-my $tmpfile = mktemp($template);
-
-print "# MKTEMP: Tempfile is $template -> $tmpfile\n";
-
-# Okay if template no longer has XXXXX in
-
-
-ok( ($tmpfile !~ /XXXXX$/) );

diff --git a/t/lib/ftmp-posix.t b/t/lib/ftmp-posix.t
deleted file mode 100755 (executable)
index 0a5e860..0000000
--- a/t/lib/ftmp-posix.t
+++ /dev/null
@@ -1,83 +0,0 @@
-#!/usr/bin/perl -w
-# Test for File::Temp - POSIX functions
-
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Test; import Test;
-       plan(tests => 7);
-}
-
-use strict;
-
-use File::Temp qw/ :POSIX unlink0 /;
-use FileHandle;
-
-ok(1);
-
-# TMPNAM - scalar
-
-print "# TMPNAM: in a scalar context: \n";
-my $tmpnam = tmpnam();
-
-# simply check that the file does not exist
-# Not a 100% water tight test though if another program 
-# has managed to create one in the meantime.
-ok( !(-e $tmpnam ));
-
-print "# TMPNAM file name: $tmpnam\n";
-
-# TMPNAM list context
-# Not strict posix behaviour
-(my $fh, $tmpnam) = tmpnam();
-
-print "# TMPNAM: in list context: $fh $tmpnam\n";
-
-# File is opened - make sure it exists
-ok( (-e $tmpnam ));
-
-# Unlink it - a possible NFS issue again if TMPDIR is not a local disk
-my $status = unlink0($fh, $tmpnam);
-if ($status) {
-  ok( $status );
-} else {
-  skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
-}
-
-# TMPFILE
-
-$fh = tmpfile();
-
-if (defined $fh) {
-  ok( $fh );
-  print "# TMPFILE: tmpfile got FH $fh\n";
-
-  $fh->autoflush(1) if $] >= 5.006;
-
-  # print something to it
-  my $original = "Hello a test\n";
-  print "# TMPFILE: Wrote line: $original";
-  print $fh $original
-    or die "Error printing to tempfile\n";
-
-  # rewind it
-  ok( seek($fh,0,0) );
-
-  # Read from it
-  my $line = <$fh>;
-
-  print "# TMPFILE: Read line: $line";
-  ok( $original, $line);
-
-  close($fh);
-
-} else {
-  # Skip all the remaining tests
-  foreach (1..3) {
-    skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
-  }
-}
-
-
-
-

diff --git a/t/lib/ftmp-security.t b/t/lib/ftmp-security.t
deleted file mode 100755 (executable)
index f9be237..0000000
--- a/t/lib/ftmp-security.t
+++ /dev/null
@@ -1,140 +0,0 @@
-#!/usr/bin/perl -w
-# Test for File::Temp - Security levels
-
-# Some of the security checking will not work on all platforms
-# Test a simple open in the cwd and tmpdir foreach of the
-# security levels
-
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Test; import Test;
-       plan(tests => 13);
-}
-
-use strict;
-use File::Spec;
-
-# Set up END block - this needs to happen before we load
-# File::Temp since this END block must be evaluated after the
-# END block configured by File::Temp
-my @files; # list of files to remove
-END { foreach (@files) { ok( !(-e $_) )} }
-
-use File::Temp qw/ tempfile unlink0 /;
-ok(1);
-
-# The high security tests must currently be skipped on some platforms
-my $skipplat = ( (
-                 # No sticky bits.
-                 $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'os2' || $^O eq 'dos'
-                 ) ? 1 : 0 );
-
-# Can not run high security tests in perls before 5.6.0
-my $skipperl  = ($] < 5.006 ? 1 : 0 );
-
-# Determine whether we need to skip things and why
-my $skip = 0;
-if ($skipplat) {
-  $skip = "Skip Not supported on this platform";
-} elsif ($skipperl) {
-  $skip = "Skip Perl version must be v5.6.0 for these tests";
-
-}
-
-print "# We will be skipping some tests : $skip\n" if $skip;
-
-# start off with basic checking
-
-File::Temp->safe_level( File::Temp::STANDARD );
-
-print "# Testing with STANDARD security...\n";
-
-&test_security(0);
-
-# Try medium
-
-File::Temp->safe_level( File::Temp::MEDIUM )
-  unless $skip;
-
-print "# Testing with MEDIUM security...\n";
-
-# Now we need to start skipping tests
-&test_security($skip);
-
-# Try HIGH
-
-File::Temp->safe_level( File::Temp::HIGH )
-  unless $skip;
-
-print "# Testing with HIGH security...\n";
-
-&test_security($skip);
-
-exit;
-
-# Subroutine to open two temporary files.
-# one is opened in the current dir and the other in the temp dir
-
-sub test_security {
-
-  # Read in the skip flag
-  my $skip = shift;
-
-  # If we are skipping we need to simply fake the correct number
-  # of tests -- we dont use skip since the tempfile() commands will
-  # fail with MEDIUM/HIGH security before the skip() command would be run
-  if ($skip) {
-
-    skip($skip,1);
-    skip($skip,1);
-
-    # plus we need an end block so the tests come out in the right order
-    eval q{ END { skip($skip,1); skip($skip,1)  } 1; } || die;
-
-    return;
-  }
-
-  # Create the tempfile
-  my $template = "tmpXXXXX";
-  my ($fh1, $fname1) = eval { tempfile ( $template, 
-                                 DIR => File::Spec->tmpdir,
-                                 UNLINK => 1,
-                               );
-                           };
-
-  if (defined $fname1) {
-      print "# fname1 = $fname1\n";
-      ok( (-e $fname1) );
-      push(@files, $fname1); # store for end block
-  } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
-      my $skip2 = "Skip system possibly insecure, see INSTALL, section 'make test'";
-      skip($skip2, 1);
-      # plus we need an end block so the tests come out in the right order
-      eval q{ END { skip($skip2,1); } 1; } || die;
-  } else {
-      ok(0);
-  }
-
-  # Explicitly 
-  if ( $< < File::Temp->top_system_uid() ){
-      skip("Skip Test inappropriate for root", 1);
-      eval q{ END { skip($skip,1); } 1; } || die;
-      return;
-  }
-  my ($fh2, $fname2) = eval { tempfile ($template,  UNLINK => 1 ); };
-  if (defined $fname2) {
-      print "# fname2 = $fname2\n";
-      ok( (-e $fname2) );
-      push(@files, $fname2); # store for end block
-      close($fh2);
-  } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
-      my $skip2 = "Skip system possibly insecure, see INSTALL, section 'make test'";
-      skip($skip2, 1);
-      # plus we need an end block so the tests come out in the right order
-      eval q{ END { skip($skip2,1); } 1; } || die;
-  } else {
-      ok(0);
-  }
-
-}

diff --git a/t/lib/ftmp-tempfile.t b/t/lib/ftmp-tempfile.t
deleted file mode 100755 (executable)
index ed59765..0000000
--- a/t/lib/ftmp-tempfile.t
+++ /dev/null
@@ -1,145 +0,0 @@
-#!/usr/local/bin/perl -w
-# Test for File::Temp - tempfile function
-
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Test; import Test;
-       plan(tests => 20);
-}
-
-use strict;
-use File::Spec;
-
-# Will need to check that all files were unlinked correctly
-# Set up an END block here to do it
-
-# Arrays containing list of dirs/files to test
-my (@files, @dirs, @still_there);
-
-# And a test for files that should still be around
-# These are tidied up
-END {
-  foreach (@still_there) {
-    ok( -f $_ );
-    ok( unlink( $_ ) );
-    ok( !(-f $_) );
-  }
-}
-
-# Loop over an array hoping that the files dont exist
-END { foreach (@files) { ok( !(-e $_) )} }
-
-# And a test for directories
-END { foreach (@dirs)  { ok( !(-d $_) )} }
-
-# Need to make sure that the END blocks are setup before
-# the ones that File::Temp configures since END blocks are evaluated
-# in revers order and we need to check the files *after* File::Temp
-# removes them
-use File::Temp qw/ tempfile tempdir/;
-
-# Now we start the tests properly
-ok(1);
-
-
-# Tempfile
-# Open tempfile in some directory, unlink at end
-my ($fh, $tempfile) = tempfile(
-                              UNLINK => 1,
-                              SUFFIX => '.txt',
-                             );
-
-ok( (-f $tempfile) );
-# Should still be around after closing
-ok( close( $fh ) ); 
-ok( (-f $tempfile) );
-# Check again at exit
-push(@files, $tempfile);
-
-# TEMPDIR test
-# Create temp directory in current dir
-my $template = 'tmpdirXXXXXX';
-print "# Template: $template\n";
-my $tempdir = tempdir( $template ,
-                      DIR => File::Spec->curdir,
-                      CLEANUP => 1,
-                    );
-
-print "# TEMPDIR: $tempdir\n";
-
-ok( (-d $tempdir) );
-push(@dirs, $tempdir);
-
-# Create file in the temp dir
-($fh, $tempfile) = tempfile(
-                           DIR => $tempdir,
-                           UNLINK => 1,
-                           SUFFIX => '.dat',
-                          );
-
-print "# TEMPFILE: Created $tempfile\n";
-
-ok( (-f $tempfile));
-push(@files, $tempfile);
-
-# Test tempfile
-# ..and again
-($fh, $tempfile) = tempfile(
-                           DIR => $tempdir,
-                          );
-
-
-ok( (-f $tempfile ));
-push(@files, $tempfile);
-
-print "# TEMPFILE: Created $tempfile\n";
-
-# and another (with template)
-
-($fh, $tempfile) = tempfile( 'helloXXXXXXX',
-                           DIR => $tempdir,
-                           UNLINK => 1,
-                           SUFFIX => '.dat',
-                          );
-
-print "# TEMPFILE: Created $tempfile\n";
-
-ok( (-f $tempfile) );
-push(@files, $tempfile);
-
-
-# Create a temporary file that should stay around after
-# it has been closed
-($fh, $tempfile) = tempfile( 'permXXXXXXX', UNLINK => 0 );
-print "# TEMPFILE: Created $tempfile\n";
-ok( -f $tempfile );
-ok( close( $fh ) );
-push( @still_there, $tempfile); # check at END
-
-# Would like to create a temp file and just retrieve the handle
-# but the test is problematic since:
-#  - We dont know the filename so we cant check that it is tidied
-#    correctly
-#  - The unlink0 required on unix for tempfile creation will fail
-#    on NFS
-# Try to do what we can.
-# Tempfile croaks on error so we need an eval
-$fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Spec->tmpdir ) };
-
-if ($fh) {
-
-  # print something to it to make sure something is there
-  ok( print $fh "Test\n" );
-
-  # Close it - can not check it is gone since we dont know the name
-  ok( close($fh) );
-
-} else {
-  skip "Skip Failed probably due to NFS", 1;
-  skip "Skip Failed probably due to NFS", 1;
-}
-
-# Now END block will execute to test the removal of directories
-print "# End of tests. Execute END blocks\n";
-

diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t
deleted file mode 100755 (executable)
index 0f5cfa0..0000000
--- a/t/lib/gdbm.t
+++ /dev/null
@@ -1,427 +0,0 @@
-#!./perl
-
-# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bGDBM_File\b/) {
-       print "1..0 # Skip: GDBM_File was not built\n";
-       exit 0;
-    }
-}
-
-use strict;
-use warnings;
-
-
-use GDBM_File;
-
-print "1..68\n";
-
-unlink <Op.dbmx*>;
-
-umask(0);
-my %h ;
-print (tie(%h,'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640) ? "ok 1\n" : "not ok 1\n");
-
-my $Dfile = "Op.dbmx.pag";
-if (! -e $Dfile) {
-       ($Dfile) = <Op.dbmx*>;
-}
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos') {
-    print "ok 2 # Skipped: different file permission semantics\n";
-}
-else {
-    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-     $blksize,$blocks) = stat($Dfile);
-    print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
-}
-my $i = 0;
-while (my ($key,$value) = each(%h)) {
-    $i++;
-}
-print (!$i ? "ok 3\n" : "not ok 3\n");
-
-$h{'goner1'} = 'snork';
-
-$h{'abc'} = 'ABC';
-$h{'def'} = 'DEF';
-$h{'jkl','mno'} = "JKL\034MNO";
-$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
-$h{'a'} = 'A';
-$h{'b'} = 'B';
-$h{'c'} = 'C';
-$h{'d'} = 'D';
-$h{'e'} = 'E';
-$h{'f'} = 'F';
-$h{'g'} = 'G';
-$h{'h'} = 'H';
-$h{'i'} = 'I';
-
-$h{'goner2'} = 'snork';
-delete $h{'goner2'};
-
-untie(%h);
-print (tie(%h,'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640) ? "ok 4\n" : "not ok 4\n");
-
-$h{'j'} = 'J';
-$h{'k'} = 'K';
-$h{'l'} = 'L';
-$h{'m'} = 'M';
-$h{'n'} = 'N';
-$h{'o'} = 'O';
-$h{'p'} = 'P';
-$h{'q'} = 'Q';
-$h{'r'} = 'R';
-$h{'s'} = 'S';
-$h{'t'} = 'T';
-$h{'u'} = 'U';
-$h{'v'} = 'V';
-$h{'w'} = 'W';
-$h{'x'} = 'X';
-$h{'y'} = 'Y';
-$h{'z'} = 'Z';
-
-$h{'goner3'} = 'snork';
-
-delete $h{'goner1'};
-delete $h{'goner3'};
-
-my @keys = keys(%h);
-my @values = values(%h);
-
-if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
-
-while (my ($key,$value) = each(%h)) {
-    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
-       $key =~ y/a-z/A-Z/;
-       $i++ if $key eq $value;
-    }
-}
-
-if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
-
-@keys = ('blurfl', keys(%h), 'dyick');
-if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
-
-$h{'foo'} = '';
-$h{''} = 'bar';
-
-# check cache overflow and numeric keys and contents
-my $ok = 1;
-for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
-for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
-print ($ok ? "ok 8\n" : "not ok 8\n");
-
-my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-print ($size > 0 ? "ok 9\n" : "not ok 9\n");
-
-@h{0..200} = 200..400;
-my @foo = @h{0..200};
-print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
-
-print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
-print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
-
-untie %h;
-unlink 'Op.dbmx.dir', $Dfile;
-
-sub ok
-{
-    my $no = shift ;
-    my $result = shift ;
-
-    print "not " unless $result ;
-    print "ok $no\n" ;
-}
-
-{
-   # sub-class test
-
-   package Another ;
-
-   use strict ;
-   use warnings ;
-
-   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
-   print FILE <<'EOM' ;
-
-   package SubDB ;
-
-   use strict ;
-   use vars qw(@ISA @EXPORT) ;
-
-   require Exporter ;
-   use GDBM_File;
-   @ISA=qw(GDBM_File);
-   @EXPORT = @GDBM_File::EXPORT ;
-
-   sub STORE { 
-       my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::STORE($key, $value * 2) ;
-   }
-
-   sub FETCH { 
-       my $self = shift ;
-        my $key = shift ;
-        $self->SUPER::FETCH($key) - 1 ;
-   }
-
-   sub A_new_method
-   {
-       my $self = shift ;
-        my $key = shift ;
-        my $value = $self->FETCH($key) ;
-       return "[[$value]]" ;
-   }
-
-   1 ;
-EOM
-
-    close FILE ;
-
-    BEGIN { push @INC, '.'; }
-    unlink <dbhash.tmp*> ;
-
-    eval 'use SubDB ; ';
-    main::ok(13, $@ eq "") ;
-    my %h ;
-    my $X ;
-    eval '
-       $X = tie(%h, "SubDB","dbhash.tmp", &GDBM_WRCREAT, 0640 );
-       ' ;
-
-    main::ok(14, $@ eq "") ;
-
-    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
-    main::ok(15, $@ eq "") ;
-    main::ok(16, $ret == 5) ;
-
-    $ret = eval ' &GDBM_WRCREAT eq &main::GDBM_WRCREAT ' ;
-    main::ok(17, $@ eq "" ) ;
-    main::ok(18, $ret == 1) ;
-
-    $ret = eval '$X->A_new_method("fred") ' ;
-    main::ok(19, $@ eq "") ;
-    main::ok(20, $ret eq "[[5]]") ;
-
-    undef $X;
-    untie(%h);
-    unlink "SubDB.pm", <dbhash.tmp*> ;
-
-}
-
-{
-   # DBM Filter tests
-   use strict ;
-   use warnings ;
-   my (%h, $db) ;
-   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-
-   sub checkOutput
-   {
-       my($fk, $sk, $fv, $sv) = @_ ;
-       return
-           $fetch_key eq $fk && $store_key eq $sk && 
-          $fetch_value eq $fv && $store_value eq $sv &&
-          $_ eq 'original' ;
-   }
-   
-   unlink <Op.dbmx*>;
-   ok(21, $db = tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)) ;
-
-   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
-   $db->filter_store_key   (sub { $store_key = $_ }) ;
-   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
-   $db->filter_store_value (sub { $store_value = $_ }) ;
-
-   $_ = "original" ;
-
-   $h{"fred"} = "joe" ;
-   #                   fk   sk     fv   sv
-   ok(22, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(23, $h{"fred"} eq "joe");
-   #                   fk    sk     fv    sv
-   ok(24, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(25, $db->FIRSTKEY() eq "fred") ;
-   #                    fk     sk  fv  sv
-   ok(26, checkOutput( "fred", "", "", "")) ;
-
-   # replace the filters, but remember the previous set
-   my ($old_fk) = $db->filter_fetch_key   
-                       (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
-   my ($old_sk) = $db->filter_store_key   
-                       (sub { $_ = lc $_ ; $store_key = $_ }) ;
-   my ($old_fv) = $db->filter_fetch_value 
-                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
-   my ($old_sv) = $db->filter_store_value 
-                       (sub { s/o/x/g; $store_value = $_ }) ;
-   
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"Fred"} = "Joe" ;
-   #                   fk   sk     fv    sv
-   ok(27, checkOutput( "", "fred", "", "Jxe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(28, $h{"Fred"} eq "[Jxe]");
-   #                   fk   sk     fv    sv
-   ok(29, checkOutput( "", "fred", "[Jxe]", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(30, $db->FIRSTKEY() eq "FRED") ;
-   #                   fk   sk     fv    sv
-   ok(31, checkOutput( "FRED", "", "", "")) ;
-
-   # put the original filters back
-   $db->filter_fetch_key   ($old_fk);
-   $db->filter_store_key   ($old_sk);
-   $db->filter_fetch_value ($old_fv);
-   $db->filter_store_value ($old_sv);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"fred"} = "joe" ;
-   ok(32, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(33, $h{"fred"} eq "joe");
-   ok(34, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(35, $db->FIRSTKEY() eq "fred") ;
-   ok(36, checkOutput( "fred", "", "", "")) ;
-
-   # delete the filters
-   $db->filter_fetch_key   (undef);
-   $db->filter_store_key   (undef);
-   $db->filter_fetch_value (undef);
-   $db->filter_store_value (undef);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"fred"} = "joe" ;
-   ok(37, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(38, $h{"fred"} eq "joe");
-   ok(39, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(40, $db->FIRSTKEY() eq "fred") ;
-   ok(41, checkOutput( "", "", "", "")) ;
-
-   undef $db ;
-   untie %h;
-   unlink <Op.dbmx*>;
-}
-
-{    
-    # DBM Filter with a closure
-
-    use strict ;
-    use warnings ;
-    my (%h, $db) ;
-
-    unlink <Op.dbmx*>;
-    ok(42, $db = tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)) ;
-
-    my %result = () ;
-
-    sub Closure
-    {
-        my ($name) = @_ ;
-       my $count = 0 ;
-       my @kept = () ;
-
-       return sub { ++$count ; 
-                    push @kept, $_ ; 
-                    $result{$name} = "$name - $count: [@kept]" ;
-                  }
-    }
-
-    $db->filter_store_key(Closure("store key")) ;
-    $db->filter_store_value(Closure("store value")) ;
-    $db->filter_fetch_key(Closure("fetch key")) ;
-    $db->filter_fetch_value(Closure("fetch value")) ;
-
-    $_ = "original" ;
-
-    $h{"fred"} = "joe" ;
-    ok(43, $result{"store key"} eq "store key - 1: [fred]");
-    ok(44, $result{"store value"} eq "store value - 1: [joe]");
-    ok(45, !defined $result{"fetch key"} );
-    ok(46, !defined $result{"fetch value"} );
-    ok(47, $_ eq "original") ;
-
-    ok(48, $db->FIRSTKEY() eq "fred") ;
-    ok(49, $result{"store key"} eq "store key - 1: [fred]");
-    ok(50, $result{"store value"} eq "store value - 1: [joe]");
-    ok(51, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(52, ! defined $result{"fetch value"} );
-    ok(53, $_ eq "original") ;
-
-    $h{"jim"}  = "john" ;
-    ok(54, $result{"store key"} eq "store key - 2: [fred jim]");
-    ok(55, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(56, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(57, ! defined $result{"fetch value"} );
-    ok(58, $_ eq "original") ;
-
-    ok(59, $h{"fred"} eq "joe");
-    ok(60, $result{"store key"} eq "store key - 3: [fred jim fred]");
-    ok(61, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(62, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(63, $result{"fetch value"} eq "fetch value - 1: [joe]");
-    ok(64, $_ eq "original") ;
-
-    undef $db ;
-    untie %h;
-    unlink <Op.dbmx*>;
-}
-
-{
-   # DBM Filter recursion detection
-   use strict ;
-   use warnings ;
-   my (%h, $db) ;
-   unlink <Op.dbmx*>;
-
-   ok(65, $db = tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)) ;
-
-   $db->filter_store_key (sub { $_ = $h{$_} }) ;
-
-   eval '$h{1} = 1234' ;
-   ok(66, $@ =~ /^recursion detected in filter_store_key at/ );
-   
-   undef $db ;
-   untie %h;
-   unlink <Op.dbmx*>;
-}
-
-{
-    # Bug ID 20001013.009
-    #
-    # test that $hash{KEY} = undef doesn't produce the warning
-    #     Use of uninitialized value in null operation 
-    use warnings ;
-    use strict ;
-    use GDBM_File ;
-
-    unlink <Op.dbmx*>;
-    my %h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    ok(67, tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640));
-    $h{ABC} = undef;
-    ok(68, $a eq "") ;
-    untie %h;
-    unlink <Op.dbmx*>;
-}

diff --git a/t/lib/getopt.t b/t/lib/getopt.t
deleted file mode 100755 (executable)
index fb70f10..0000000
--- a/t/lib/getopt.t
+++ /dev/null
@@ -1,73 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-print "1..11\n";
-
-use Getopt::Std;
-
-# First we test the getopt function
-@ARGV = qw(-xo -f foo -y file);
-getopt('f');
-
-print "not " if "@ARGV" ne 'file';
-print "ok 1\n";
-
-print "not " unless $opt_x && $opt_o && opt_y;
-print "ok 2\n";
-
-print "not " unless $opt_f eq 'foo';
-print "ok 3\n";
-
-
-# Then we try the getopts
-$opt_o = $opt_i = $opt_f = undef;
-@ARGV = qw(-foi -i file);
-getopts('oif:') or print "not ";
-print "ok 4\n";
-
-print "not " unless "@ARGV" eq 'file';
-print "ok 5\n";
-
-print "not " unless $opt_i and $opt_f eq 'oi';
-print "ok 6\n";
-
-print "not " if $opt_o;
-print "ok 7\n";
-
-# Try illegal options, but avoid printing of the error message
-
-open(STDERR, ">stderr") || die;
-
-@ARGV = qw(-h help);
-
-!getopts("xf:y") or print "not ";
-print "ok 8\n";
-
-
-# Then try the Getopt::Long module
-
-use Getopt::Long;
-
-@ARGV = qw(--help --file foo --foo --nobar --num=5 -- file);
-
-GetOptions(
-   'help'   => \$HELP,
-   'file:s' => \$FILE,
-   'foo!'   => \$FOO,
-   'bar!'   => \$BAR,
-   'num:i'  => \$NO,
-) || print "not ";
-print "ok 9\n";
-
-print "not " unless $HELP && $FOO && !$BAR && $FILE eq 'foo' && $NO == 5;
-print "ok 10\n";
-
-print "not " unless "@ARGV" eq "file";
-print "ok 11\n";
-
-close STDERR;
-unlink "stderr";

diff --git a/t/lib/glob-basic.t b/t/lib/glob-basic.t
deleted file mode 100755 (executable)
index ef9dd96..0000000
--- a/t/lib/glob-basic.t
+++ /dev/null
@@ -1,175 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    if ($^O eq 'MacOS') { 
-       @INC = qw(: ::lib ::macos:lib); 
-    } else { 
-       @INC = '.'; 
-       push @INC, '../lib'; 
-    }
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
-        print "1..0\n";
-        exit 0;
-    }
-    print "1..11\n";
-}
-END {
-    print "not ok 1\n" unless $loaded;
-}
-use File::Glob ':glob';
-use Cwd ();
-$loaded = 1;
-print "ok 1\n";
-
-sub array {
-    return '(', join(", ", map {defined $_ ? "\"$_\"" : "undef"} @a), ")\n";
-}
-
-# look for the contents of the current directory
-$ENV{PATH} = "/bin";
-delete @ENV{BASH_ENV, CDPATH, ENV, IFS};
-@correct = ();
-if (opendir(D, $^O eq "MacOS" ? ":" : ".")) {
-   @correct = grep { !/^\./ } sort readdir(D);
-   closedir D;
-}
-@a = File::Glob::glob("*", 0);
-@a = sort @a;
-if ("@a" ne "@correct" || GLOB_ERROR) {
-    print "# |@a| ne |@correct|\nnot ";
-}
-print "ok 2\n";
-
-# look up the user's home directory
-# should return a list with one item, and not set ERROR
-if ($^O ne 'MSWin32' && $^O ne 'NetWare' && $^O ne 'VMS') {
-  eval {
-    ($name, $home) = (getpwuid($>))[0,7];
-    1;
-  } and do {
-    @a = bsd_glob("~$name", GLOB_TILDE);
-    if (scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR) {
-       print "not ";
-    }
-  };
-}
-print "ok 3\n";
-
-# check backslashing
-# should return a list with one item, and not set ERROR
-@a = bsd_glob('TEST', GLOB_QUOTE);
-if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) {
-    local $/ = "][";
-    print "# [@a]\n";
-    print "not ";
-}
-print "ok 4\n";
-
-# check nonexistent checks
-# should return an empty list
-# XXX since errfunc is NULL on win32, this test is not valid there
-@a = bsd_glob("asdfasdf", 0);
-if (($^O ne 'MSWin32' && $^O ne 'NetWare') and scalar @a != 0) {
-    print "# |@a|\nnot ";
-}
-print "ok 5\n";
-
-# check bad protections
-# should return an empty list, and set ERROR
-if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'os2' or $^O eq 'VMS'
-    or $^O eq 'cygwin' or Cwd::cwd() =~ m#^$Config{'afsroot'}#s or not $>)
-{
-    print "ok 6 # skipped\n";
-}
-else {
-    $dir = "pteerslt";
-    mkdir $dir, 0;
-    @a = bsd_glob("$dir/*", GLOB_ERR);
-    #print "\@a = ", array(@a);
-    rmdir $dir;
-    if (scalar(@a) != 0 || GLOB_ERROR == 0) {
-       print "not ";
-    }
-    print "ok 6\n";
-}
-
-# check for csh style globbing
-@a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
-unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') {
-    print "not ";
-}
-print "ok 7\n";
-
-@a = bsd_glob(
-    '{TES*,doesntexist*,a,b}',
-    GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0)
-);
-
-# Working on t/TEST often causes this test to fail because it sees Emacs temp
-# and RCS files.  Filter them out, and .pm files too, and patch temp files.
-@a = grep !/(,v$|~$|\.(pm|ori?g|rej)$)/, @a;
-
-print "# @a\n";
-
-unless (@a == 3
-        and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
-        and $a[1] eq 'a'
-        and $a[2] eq 'b')
-{
-    print "not ok 8 # @a";
-} else {
-    print "ok 8\n";
-}
-
-# "~" should expand to $ENV{HOME}
-$ENV{HOME} = "sweet home";
-@a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
-unless ($^O eq "MacOS" || (@a == 1 and $a[0] eq $ENV{HOME})) {
-    print "not ";
-}
-print "ok 9\n";
-
-# GLOB_ALPHASORT (default) should sort alphabetically regardless of case
-mkdir "pteerslt", 0777;
-chdir "pteerslt";
-
-@f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl);
-@f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl);
-if ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER
-    @f_names = sort(@f_names);
-}
-if ($^O eq 'VMS') { # VMS is happily caseignorant
-    @f_alpha = qw(ax.pl ay.pl bx.pl by.pl cx.pl cy.pl);
-    @f_names = @f_alpha;
-}
-
-for (@f_names) {
-    open T, "> $_";
-    close T;
-}
-
-$pat = "*.pl";
-
-$ok = 1;
-@g_names = bsd_glob($pat, 0);
-print "# f_names = @f_names\n";
-print "# g_names = @g_names\n";
-for (@f_names) {
-    $ok = 0 unless $_ eq shift @g_names;
-}
-print $ok ? "ok 10\n" : "not ok 10\n";
-
-$ok = 1;
-@g_alpha = bsd_glob($pat);
-print "# f_alpha = @f_alpha\n";
-print "# g_alpha = @g_alpha\n";
-for (@f_alpha) {
-    $ok = 0 unless $_ eq shift @g_alpha;
-}
-print $ok ? "ok 11\n" : "not ok 11\n";
-
-unlink @f_names;
-chdir "..";
-rmdir "pteerslt";

diff --git a/t/lib/glob-case.t b/t/lib/glob-case.t
deleted file mode 100755 (executable)
index 3c3980c..0000000
--- a/t/lib/glob-case.t
+++ /dev/null
@@ -1,60 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    if ($^O eq 'MacOS') { 
-       @INC = qw(: ::lib ::macos:lib); 
-    } else { 
-       @INC = '.'; 
-       push @INC, '../lib'; 
-    }
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
-        print "1..0\n";
-        exit 0;
-    }
-    print "1..7\n";
-}
-END {
-    print "not ok 1\n" unless $loaded;
-}
-use File::Glob qw(:glob csh_glob);
-$loaded = 1;
-print "ok 1\n";
-
-my $pat = $^O eq "MacOS" ? ":lib:G*.t" : "lib/G*.t";
-
-# Test the actual use of the case sensitivity tags, via csh_glob()
-import File::Glob ':nocase';
-@a = csh_glob($pat); # At least glob-basic.t glob-case.t glob-global.t
-print "not " unless @a >= 3;
-print "ok 2\n";
-
-# This may fail on systems which are not case-PRESERVING
-import File::Glob ':case';
-@a = csh_glob($pat); # None should be uppercase
-print "not " unless @a == 0;
-print "ok 3\n";
-
-# Test the explicit use of the GLOB_NOCASE flag
-@a = bsd_glob($pat, GLOB_NOCASE);
-print "not " unless @a >= 3;
-print "ok 4\n";
-
-# Test Win32 backslash nastiness...
-if ($^O ne 'MSWin32' && $^O ne 'NetWare') {
-    print "ok 5\nok 6\nok 7\n";
-}
-else {
-    @a = File::Glob::glob("lib\\g*.t");
-    print "not " unless @a >= 3;
-    print "ok 5\n";
-    mkdir "[]", 0;
-    @a = File::Glob::glob("\\[\\]", GLOB_QUOTE);
-    rmdir "[]";
-    print "# returned @a\nnot " unless @a == 1;
-    print "ok 6\n";
-    @a = bsd_glob("lib\\*", GLOB_QUOTE);
-    print "not " if @a == 0;
-    print "ok 7\n";
-}

diff --git a/t/lib/glob-global.t b/t/lib/glob-global.t
deleted file mode 100755 (executable)
index 1d79032..0000000
--- a/t/lib/glob-global.t
+++ /dev/null
@@ -1,152 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    if ($^O eq 'MacOS') { 
-       @INC = qw(: ::lib ::macos:lib); 
-    } else { 
-       @INC = '.'; 
-       push @INC, '../lib'; 
-    }
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
-        print "1..0\n";
-        exit 0;
-    }
-    print "1..10\n";
-}
-END {
-    print "not ok 1\n" unless $loaded;
-}
-
-BEGIN {
-    *CORE::GLOBAL::glob = sub { "Just another Perl hacker," };
-}
-
-BEGIN {
-    if ("Just another Perl hacker," ne (<*>)[0]) {
-        die <<EOMessage;
-Your version of perl ($]) doesn't seem to allow extensions to override
-the core glob operator.
-EOMessage
-    }
-}
-
-use File::Glob ':globally';
-$loaded = 1;
-print "ok 1\n";
-
-$_ = $^O eq "MacOS" ? ":lib:*.t" : "lib/*.t";
-my @r = glob;
-print "not " if $_ ne ($^O eq "MacOS" ? ":lib:*.t" : "lib/*.t");
-print "ok 2\n";
-
-# we should have at least basic.t, global.t, taint.t
-print "# |@r|\nnot " if @r < 3;
-print "ok 3\n";
-
-# check if <*/*> works
-if ($^O eq "MacOS") {
-    @r = <:*:*.t>;
-} else {
-    @r = <*/*.t>;
-}
-# at least t/global.t t/basic.t, t/taint.t
-print "not " if @r < 3;
-print "ok 4\n";
-my $r = scalar @r;
-
-# check if scalar context works
-@r = ();
-if ($^O eq "MacOS") {
-    while (defined($_ = <:*:*.t>)) {
-       #print "# $_\n";
-       push @r, $_;
-    }
-} else {
-    while (defined($_ = <*/*.t>)) {
-       #print "# $_\n";
-       push @r, $_;
-    }
-}
-print "not " if @r != $r;
-print "ok 5\n";
-
-# check if list context works
-@r = ();
-if ($^O eq "MacOS") {
-    for (<:*:*.t>) {
-       #print "# $_\n";
-       push @r, $_;
-    }
-} else {
-    for (<*/*.t>) {
-       #print "# $_\n";
-       push @r, $_;
-    }
-}
-print "not " if @r != $r;
-print "ok 6\n";
-
-# test if implicit assign to $_ in while() works
-@r = ();
-if ($^O eq "MacOS") {
-    while (<:*:*.t>) {
-       #print "# $_\n";
-       push @r, $_;
-    }
-} else {
-    while (<*/*.t>) {
-       #print "# $_\n";
-       push @r, $_;
-    }
-}
-print "not " if @r != $r;
-print "ok 7\n";
-
-# test if explicit glob() gets assign magic too
-my @s = ();
-while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
-    #print "# $_\n";
-    push @s, $_;
-}
-print "not " if "@r" ne "@s";
-print "ok 8\n";
-
-# how about in a different package, like?
-package Foo;
-use File::Glob ':globally';
-@s = ();
-while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
-    #print "# $_\n";
-    push @s, $_;
-}
-print "not " if "@r" ne "@s";
-print "ok 9\n";
-
-# test if different glob ops maintain independent contexts
-@s = ();
-my $i = 0;
-if ($^O eq "MacOS") {
-    while (<:*:*.t>) {
-       #print "# $_ <";
-       push @s, $_;
-       while (<:bas*:*.t>) {
-           #print " $_";
-           $i++;
-       }
-       #print " >\n";
-    }
-} else {
-    while (<*/*.t>) {
-       #print "# $_ <";
-       push @s, $_;
-       while (<bas*/*.t>) {
-           #print " $_";
-           $i++;
-       }
-       #print " >\n";
-    }
-}
-print "not " if "@r" ne "@s" or not $i;
-print "ok 10\n";

diff --git a/t/lib/glob-taint.t b/t/lib/glob-taint.t
deleted file mode 100755 (executable)
index 4c09903..0000000
--- a/t/lib/glob-taint.t
+++ /dev/null
@@ -1,31 +0,0 @@
-#!./perl -T
-
-BEGIN {
-    chdir 't' if -d 't';
-    if ($^O eq 'MacOS') { 
-       @INC = qw(: ::lib ::macos:lib); 
-    } else { 
-       @INC = '.'; 
-       push @INC, '../lib'; 
-    }
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
-        print "1..0\n";
-        exit 0;
-    }
-    print "1..2\n";
-}
-END {
-    print "not ok 1\n" unless $loaded;
-}
-use File::Glob;
-$loaded = 1;
-print "ok 1\n";
-
-# all filenames should be tainted
-@a = File::Glob::bsd_glob("*");
-eval { $a = join("",@a), kill 0; 1 };
-unless ($@ =~ /Insecure dependency/) {
-    print "not ";
-}
-print "ok 2\n";

diff --git a/t/lib/gol-basic.t b/t/lib/gol-basic.t
deleted file mode 100755 (executable)
index c5d857d..0000000
--- a/t/lib/gol-basic.t
+++ /dev/null
@@ -1,26 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
-use Getopt::Long qw(:config no_ignore_case);
-die("Getopt::Long version 2.24 required--this is only version ".
-    $Getopt::Long::VERSION)
-  unless $Getopt::Long::VERSION >= 2.24;
-
-print "1..9\n";
-
-@ARGV = qw(-Foo -baR --foo bar);
-undef $opt_baR;
-undef $opt_bar;
-print "ok 1\n" if GetOptions ("foo", "Foo=s");
-print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
-print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
-print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
-print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
-print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
-print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
-print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
-print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");

diff --git a/t/lib/gol-compat.t b/t/lib/gol-compat.t
deleted file mode 100755 (executable)
index 0bbe386..0000000
--- a/t/lib/gol-compat.t
+++ /dev/null
@@ -1,25 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
-require "newgetopt.pl";
-
-print "1..9\n";
-
-@ARGV = qw(-Foo -baR --foo bar);
-$newgetopt::ignorecase = 0;
-$newgetopt::ignorecase = 0;
-undef $opt_baR;
-undef $opt_bar;
-print "ok 1\n" if NGetOpt ("foo", "Foo=s");
-print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
-print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
-print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
-print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
-print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
-print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
-print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
-print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");

diff --git a/t/lib/gol-linkage.t b/t/lib/gol-linkage.t
deleted file mode 100755 (executable)
index 3bd81a3..0000000
--- a/t/lib/gol-linkage.t
+++ /dev/null
@@ -1,37 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
-use Getopt::Long;
-
-print "1..18\n";
-
-@ARGV = qw(-Foo -baR --foo bar);
-Getopt::Long::Configure ("no_ignore_case");
-%lnk = ();
-print "ok 1\n" if GetOptions (\%lnk, "foo", "Foo=s");
-print ((defined $lnk{foo})   ? "" : "not ", "ok 2\n");
-print (($lnk{foo} == 1)      ? "" : "not ", "ok 3\n");
-print ((defined $lnk{Foo})   ? "" : "not ", "ok 4\n");
-print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 5\n");
-print ((@ARGV == 1)          ? "" : "not ", "ok 6\n");
-print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 7\n");
-print (!(exists $lnk{baR})   ? "" : "not ", "ok 8\n");
-
-@ARGV = qw(-Foo -baR --foo bar);
-Getopt::Long::Configure ("default","no_ignore_case");
-%lnk = ();
-my $foo;
-print "ok 9\n" if GetOptions (\%lnk, "foo" => \$foo, "Foo=s");
-print ((defined $foo)        ? "" : "not ", "ok 10\n");
-print (($foo == 1)           ? "" : "not ", "ok 11\n");
-print ((defined $lnk{Foo})   ? "" : "not ", "ok 12\n");
-print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 13\n");
-print ((@ARGV == 1)          ? "" : "not ", "ok 14\n");
-print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 15\n");
-print (!(exists $lnk{foo})   ? "" : "not ", "ok 16\n");
-print (!(exists $lnk{baR})   ? "" : "not ", "ok 17\n");
-print (!(exists $lnk{bar})   ? "" : "not ", "ok 18\n");

diff --git a/t/lib/gol-oo.t b/t/lib/gol-oo.t
deleted file mode 100644 (file)
index 98f3eaa..0000000
--- a/t/lib/gol-oo.t
+++ /dev/null
@@ -1,26 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
-use Getopt::Long;
-die("Getopt::Long version 2.24 required--this is only version ".
-    $Getopt::Long::VERSION)
-  unless $Getopt::Long::VERSION >= 2.24;
-print "1..9\n";
-
-@ARGV = qw(-Foo -baR --foo bar);
-my $p = new Getopt::Long::Parser (config => ["no_ignore_case"]);
-undef $opt_baR;
-undef $opt_bar;
-print "ok 1\n" if $p->getoptions ("foo", "Foo=s");
-print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
-print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
-print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
-print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
-print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
-print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
-print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
-print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");

diff --git a/t/lib/h2ph.t b/t/lib/h2ph.t
deleted file mode 100755 (executable)
index 7b339b3..0000000
--- a/t/lib/h2ph.t
+++ /dev/null
@@ -1,37 +0,0 @@
-#!./perl
-
-# quickie tests to see if h2ph actually runs and does more or less what is
-# expected
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-my $extracted_program = '../utils/h2ph'; # unix, nt, ...
-if ($^O eq 'VMS') { $extracted_program = '[-.utils]h2ph.com'; }
-if (!(-e $extracted_program)) {
-    print "1..0 # Skip: $extracted_program was not built\n";
-    exit 0;
-}
-
-print "1..2\n";
-
-# quickly compare two text files
-sub txt_compare {
-    local ($/, $A, $B);
-    for (($A,$B) = @_) { open(_,"<$_") ? $_ = <_> : die "$_ : $!"; close _ }
-    $A cmp $B;
-}
-
-# does it run?
-$ok = system("$^X \"-I../lib\" $extracted_program -d. \"-Q\" lib/h2ph.h");
-print(($ok == 0 ? "" : "not "), "ok 1\n");
-    
-# does it work? well, does it do what we expect? :-)
-$ok = txt_compare("lib/h2ph.ph", "lib/h2ph.pht");
-print(($ok == 0 ? "" : "not "), "ok 2\n");
-    
-# cleanup - should this be in an END block?
-unlink("lib/h2ph.ph");
-unlink("_h2ph_pre.ph");

diff --git a/t/lib/hostname.t b/t/lib/hostname.t
deleted file mode 100755 (executable)
index 85a04cd..0000000
--- a/t/lib/hostname.t
+++ /dev/null
@@ -1,25 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bSys\/Hostname\b/) {
-      print "1..0 # Skip: Sys::Hostname was not built\n";
-      exit 0;
-    }
-}
-
-use Sys::Hostname;
-
-eval {
-    $host = hostname;
-};
-
-if ($@) {
-    print "1..0\n" if $@ =~ /Cannot get host name/;
-} else {
-    print "1..1\n";
-    print "# \$host = `$host'\n";
-    print "ok 1\n";
-}

diff --git a/t/lib/i18n-collate.t b/t/lib/i18n-collate.t
deleted file mode 100644 (file)
index bf3ba20..0000000
--- a/t/lib/i18n-collate.t
+++ /dev/null
@@ -1,44 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if (!$Config{d_setlocale} || $Config{ccflags} =~ /\bD?NO_LOCALE\b/) {
-       print "1..0\n";
-       exit;
-    }
-}
-
-print "1..7\n";
-
-use I18N::Collate;
-
-print "ok 1\n";
-
-$a = I18N::Collate->new("foo");
-
-print "ok 2\n";
-
-{
-    use warnings;
-    local $SIG{__WARN__} = sub { $@ = $_[0] };
-    $b = I18N::Collate->new("foo");
-    print "not " unless $@ =~ /\bHAS BEEN DEPRECATED\b/;
-    print "ok 3\n";
-    $@ = '';
-}
-
-print "not " unless $a eq $b;
-print "ok 4\n";
-
-$b = I18N::Collate->new("bar");
-print "not " if $@ =~ /\bHAS BEEN DEPRECATED\b/;
-print "ok 5\n";
-
-print "not " if $a eq $b;
-print "ok 6\n";
-
-print "not " if $a lt $b == $a gt $b;
-print "ok 7\n";
-

diff --git a/t/lib/i18n-langtags.t b/t/lib/i18n-langtags.t
deleted file mode 100644 (file)
index 06c178e..0000000
--- a/t/lib/i18n-langtags.t
+++ /dev/null
@@ -1,45 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-######################### We start with some black magic to print on failure.
-require 5;
-
-use strict;
-use Test;
-BEGIN { plan tests => 23 };
-BEGIN { ok 1 }
-use I18N::LangTags qw(is_language_tag same_language_tag
-                     extract_language_tags super_languages
-                     similarity_language_tag is_dialect_of
-                     locale2language_tag alternate_language_tags
-                     encode_language_tag
-                    );
-
-ok !is_language_tag('');
-ok  is_language_tag('fr');
-ok  is_language_tag('fr-ca');
-ok  is_language_tag('fr-CA');
-ok !is_language_tag('fr-CA-');
-ok !is_language_tag('fr_CA');
-ok  is_language_tag('fr-ca-joual');
-ok !is_language_tag('frca');
-ok  is_language_tag('nav');
-ok  is_language_tag('nav-shiprock');
-ok !is_language_tag('nav-ceremonial'); # subtag too long
-ok !is_language_tag('x');
-ok !is_language_tag('i');
-ok  is_language_tag('i-borg'); # NB: fictitious tag
-ok  is_language_tag('x-borg');
-ok  is_language_tag('x-borg-prot5123');
-ok  same_language_tag('x-borg-prot5123', 'i-BORG-Prot5123' );
-ok !same_language_tag('en', 'en-us' );
-
-ok 0 == similarity_language_tag('en-ca', 'fr-ca');
-ok 1 == similarity_language_tag('en-ca', 'en-us');
-ok 2 == similarity_language_tag('en-us-southern', 'en-us-western');
-ok 2 == similarity_language_tag('en-us-southern', 'en-us');
-
-# print "So there!\n";
-

diff --git a/t/lib/io_const.t b/t/lib/io_const.t
deleted file mode 100755 (executable)
index db1a322..0000000
--- a/t/lib/io_const.t
+++ /dev/null
@@ -1,33 +0,0 @@
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-    }
-}
-
-use Config;
-
-BEGIN {
-    if(-d "lib" && -f "TEST") {
-        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
-           print "1..0\n";
-           exit 0;
-        }
-    }
-}
-
-use IO::Handle;
-
-print "1..6\n";
-my $i = 1;
-foreach (qw(SEEK_SET SEEK_CUR SEEK_END     _IOFBF    _IOLBF    _IONBF)) {
-    my $d1 = defined(&{"IO::Handle::" . $_}) ? 1 : 0;
-    my $v1 = $d1 ? &{"IO::Handle::" . $_}() : undef;
-    my $v2 = IO::Handle::constant($_);
-    my $d2 = defined($v2);
-
-    print "not "
-       if($d1 != $d2 || ($d1 && ($v1 != $v2)));
-    print "ok ",$i++,"\n";
-}

diff --git a/t/lib/io_dir.t b/t/lib/io_dir.t
deleted file mode 100755 (executable)
index 6ec4e9f..0000000
--- a/t/lib/io_dir.t
+++ /dev/null
@@ -1,68 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-    }
-    require Config; import Config;
-    if ($] < 5.00326 || not $Config{'d_readdir'}) {
-       print "1..0\n";
-       exit 0;
-    }
-}
-
-select(STDERR); $| = 1;
-select(STDOUT); $| = 1;
-
-use IO::Dir qw(DIR_UNLINK);
-
-print "1..10\n";
-
-my $DIR = $^O eq 'MacOS' ? ":" : ".";
-
-$dot = new IO::Dir $DIR;
-print defined($dot) ? "ok" : "not ok", " 1\n";
-
-@a = sort <*>;
-do { $first = $dot->read } while defined($first) && $first =~ /^\./;
-print +(grep { $_ eq $first } @a) ? "ok" : "not ok", " 2\n";
-
-@b = sort($first, (grep {/^[^.]/} $dot->read));
-print +(join("\0", @a) eq join("\0", @b)) ? "ok" : "not ok", " 3\n";
-
-$dot->rewind;
-@c = sort grep {/^[^.]/} $dot->read;
-print +(join("\0", @b) eq join("\0", @c)) ? "ok" : "not ok", " 4\n";
-
-$dot->close;
-$dot->rewind;
-print defined($dot->read) ? "not ok" : "ok", " 5\n";
-
-open(FH,'>X') || die "Can't create x";
-print FH "X";
-close(FH);
-
-tie %dir, IO::Dir, $DIR;
-my @files = keys %dir;
-
-# I hope we do not have an empty dir :-)
-print @files ? "ok" : "not ok", " 6\n";
-
-my $stat = $dir{'X'};
-print defined($stat) && UNIVERSAL::isa($stat,'File::stat') && $stat->size == 1
-       ? "ok" : "not ok", " 7\n";
-
-delete $dir{'X'};
-
-print -f 'X' ? "ok" : "not ok", " 8\n";
-
-tie %dirx, IO::Dir, $DIR, DIR_UNLINK;
-
-my $statx = $dirx{'X'};
-print defined($statx) && UNIVERSAL::isa($statx,'File::stat') && $statx->size == 1
-       ? "ok" : "not ok", " 9\n";
-
-delete $dirx{'X'};
-
-print -f 'X' ? "not ok" : "ok", " 10\n";

diff --git a/t/lib/io_dup.t b/t/lib/io_dup.t
deleted file mode 100755 (executable)
index 8983a56..0000000
--- a/t/lib/io_dup.t
+++ /dev/null
@@ -1,61 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-    }
-}
-
-use Config;
-
-BEGIN {
-    if(-d "lib" && -f "TEST") {
-        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
-           print "1..0\n";
-           exit 0;
-        }
-    }
-}
-
-use IO::Handle;
-use IO::File;
-
-select(STDERR); $| = 1;
-select(STDOUT); $| = 1;
-
-print "1..6\n";
-
-print "ok 1\n";
-
-$dupout = IO::Handle->new->fdopen( \*STDOUT ,"w");
-$duperr = IO::Handle->new->fdopen( \*STDERR ,"w");
-
-$stdout = \*STDOUT; bless $stdout, "IO::File"; # "IO::Handle";
-$stderr = \*STDERR; bless $stderr, "IO::Handle";
-
-$stdout->open( "Io.dup","w") || die "Can't open stdout";
-$stderr->fdopen($stdout,"w");
-
-print $stdout "ok 2\n";
-print $stderr "ok 3\n";
-if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
-    print `echo ok 4`;
-    print `echo ok 5 1>&2`; # does this *really* work?
-}
-else {
-    system 'echo ok 4';
-    system 'echo ok 5 1>&2';
-}
-
-$stderr->close;
-$stdout->close;
-
-$stdout->fdopen($dupout,"w");
-$stderr->fdopen($duperr,"w");
-
-if ($^O eq 'MSWin32' || $^O eq 'NetWare') { print `type Io.dup` }
-else                  { system 'cat Io.dup' }
-unlink 'Io.dup';
-
-print STDOUT "ok 6\n";

diff --git a/t/lib/io_linenum.t b/t/lib/io_linenum.t
deleted file mode 100755 (executable)
index cf55c98..0000000
--- a/t/lib/io_linenum.t
+++ /dev/null
@@ -1,80 +0,0 @@
-#!./perl
-
-# test added 29th April 1999 by Paul Johnson (pjcj@transeda.com)
-# updated    28th May   1999 by Paul Johnson
-
-my $File;
-
-BEGIN
-{
-  $File = __FILE__;
-  if (-d 't')
-  {
-    chdir 't';
-    $File =~ s/^t\W+//;                                 # Remove first directory
-  }
-  @INC = '../lib';
-  require strict; import strict;
-}
-
-use Test;
-
-BEGIN { plan tests => 12 }
-
-use IO::File;
-
-sub lineno
-{
-  my ($f) = @_;
-  my $l;
-  $l .= "$. ";
-  $l .= $f->input_line_number;
-  $l .= " $.";                     # check $. before and after input_line_number
-  $l;
-}
-
-my $t;
-
-open (F, $File) or die $!;
-my $io = IO::File->new($File) or die $!;
-
-<F> for (1 .. 10);
-ok(lineno($io), "10 0 10");
-
-$io->getline for (1 .. 5);
-ok(lineno($io), "5 5 5");
-
-<F>;
-ok(lineno($io), "11 5 11");
-
-$io->getline;
-ok(lineno($io), "6 6 6");
-
-$t = tell F;                                        # tell F; provokes a warning
-ok(lineno($io), "11 6 11");
-
-<F>;
-ok(lineno($io), "12 6 12");
-
-select F;
-ok(lineno($io), "12 6 12");
-
-<F> for (1 .. 10);
-ok(lineno($io), "22 6 22");
-
-$io->getline for (1 .. 5);
-ok(lineno($io), "11 11 11");
-
-$t = tell F;
-# We used to have problems here before local $. worked.
-# input_line_number() used to use select and tell.  When we did the
-# same, that mechanism broke.  It should work now.
-ok(lineno($io), "22 11 22");
-
-{
-  local $.;
-  $io->getline for (1 .. 5);
-  ok(lineno($io), "16 16 16");
-}
-
-ok(lineno($io), "22 16 22");

diff --git a/t/lib/io_multihomed.t b/t/lib/io_multihomed.t
deleted file mode 100644 (file)
index 62f25bc..0000000
--- a/t/lib/io_multihomed.t
+++ /dev/null
@@ -1,128 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-    }
-}
-
-use Config;
-
-BEGIN {
-    if(-d "lib" && -f "TEST") {
-       my $reason;
-       if (! $Config{'d_fork'}) {
-           $reason = 'no fork';
-       }
-       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
-           $reason = 'Socket extension unavailable';
-       }
-       elsif ($Config{'extensions'} !~ /\bIO\b/) {
-           $reason = 'IO extension unavailable';
-       }
-       if ($reason) {
-           print "1..0 # Skip: $reason\n";
-           exit 0;
-        }
-    }
-}
-
-$| = 1;
-
-print "1..8\n";
-
-eval {
-    $SIG{ALRM} = sub { die; };
-    alarm 60;
-};
-
-package Multi;
-require IO::Socket::INET;
-@ISA=qw(IO::Socket::INET);
-
-use Socket qw(inet_aton inet_ntoa unpack_sockaddr_in);
-
-sub _get_addr
-{
-    my($sock,$addr_str, $multi) = @_;
-    #print "_get_addr($sock, $addr_str, $multi)\n";
-
-    print "not " unless $multi;
-    print "ok 2\n";
-
-    (
-     # private IP-addresses which I hope does not work anywhere :-)
-     inet_aton("10.250.230.10"),
-     inet_aton("10.250.230.12"),
-     inet_aton("127.0.0.1")        # loopback
-    )
-}
-
-sub connect
-{
-    my $self = shift;
-    if (@_ == 1) {
-       my($port, $addr) = unpack_sockaddr_in($_[0]);
-       $addr = inet_ntoa($addr);
-       #print "connect($self, $port, $addr)\n";
-       if($addr eq "10.250.230.10") {
-           print "ok 3\n";
-           return 0;
-       }
-       if($addr eq "10.250.230.12") {
-           print "ok 4\n";
-           return 0;
-       }
-    }
-    $self->SUPER::connect(@_);
-}
-
-
-
-package main;
-
-use IO::Socket;
-
-$listen = IO::Socket::INET->new(Listen => 2,
-                               Proto => 'tcp',
-                               Timeout => 5,
-                              ) or die "$!";
-
-print "ok 1\n";
-
-$port = $listen->sockport;
-
-if($pid = fork()) {
-
-    $sock = $listen->accept() or die "$!";
-    print "ok 5\n";
-
-    print $sock->getline();
-    print $sock "ok 7\n";
-
-    waitpid($pid,0);
-
-    $sock->close;
-
-    print "ok 8\n";
-
-} elsif(defined $pid) {
-
-    $sock = Multi->new(PeerPort => $port,
-                      Proto => 'tcp',
-                      PeerAddr => 'localhost',
-                      MultiHomed => 1,
-                      Timeout => 1,
-                     ) or die "$!";
-
-    print $sock "ok 6\n";
-    sleep(1); # race condition
-    print $sock->getline();
-
-    $sock->close;
-
-    exit;
-} else {
-    die;
-}

diff --git a/t/lib/io_pipe.t b/t/lib/io_pipe.t
deleted file mode 100755 (executable)
index ae18224..0000000
--- a/t/lib/io_pipe.t
+++ /dev/null
@@ -1,123 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-    }
-}
-
-use Config;
-
-BEGIN {
-    if(-d "lib" && -f "TEST") {
-       my $reason;
-       if (! $Config{'d_fork'}) {
-           $reason = 'no fork';
-       }
-       elsif ($Config{'extensions'} !~ /\bIO\b/) {
-           $reason = 'IO extension unavailable';
-       }
-       undef $reason if $^O eq 'VMS';
-       if ($reason) {
-           print "1..0 # Skip: $reason\n";
-           exit 0;
-        }
-    }
-}
-
-use IO::Pipe;
-
-my $perl = './perl';
-
-$| = 1;
-print "1..10\n";
-
-$pipe = new IO::Pipe->reader($perl, '-e', 'print "not ok 1\n"');
-while (<$pipe>) {
-  s/^not //;
-  print;
-}
-$pipe->close or print "# \$!=$!\nnot ";
-print "ok 2\n";
-
-$cmd = 'BEGIN{$SIG{ALRM} = sub {print "not ok 4\n"; exit}; alarm 10} s/not //';
-$pipe = new IO::Pipe->writer($perl, '-pe', $cmd);
-print $pipe "not ok 3\n" ;
-$pipe->close or print "# \$!=$!\nnot ";
-print "ok 4\n";
-
-# Check if can fork with dynamic extensions (bug in CRT):
-if ($^O eq 'os2' and
-    system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
-    print "ok $_ # skipped: broken fork\n" for 5..10;
-    exit 0;
-}
-
-$pipe = new IO::Pipe;
-
-$pid = fork();
-
-if($pid)
- {
-  $pipe->writer;
-  print $pipe "Xk 5\n";
-  print $pipe "oY 6\n";
-  $pipe->close;
-  wait;
- }
-elsif(defined $pid)
- {
-  $pipe->reader;
-  $stdin = bless \*STDIN, "IO::Handle";
-  $stdin->fdopen($pipe,"r");
-  exec 'tr', 'YX', 'ko';
- }
-else
- {
-  die "# error = $!";
- }
-
-$pipe = new IO::Pipe;
-$pid = fork();
-
-if($pid)
- {
-  $pipe->reader;
-  while(<$pipe>) {
-      s/^not //;
-      print;
-  }
-  $pipe->close;
-  wait;
- }
-elsif(defined $pid)
- {
-  $pipe->writer;
-
-  $stdout = bless \*STDOUT, "IO::Handle";
-  $stdout->fdopen($pipe,"w");
-  print STDOUT "not ok 7\n";
-  exec 'echo', 'not ok 8';
- }
-else
- {
-  die;
- }
-
-$pipe = new IO::Pipe;
-$pipe->writer;
-
-$SIG{'PIPE'} = 'broken_pipe';
-
-sub broken_pipe {
-    print "ok 9\n";
-}
-
-print $pipe "not ok 9\n";
-$pipe->close;
-
-sleep 1;
-
-print "ok 10\n";
-

diff --git a/t/lib/io_poll.t b/t/lib/io_poll.t
deleted file mode 100755 (executable)
index d31ea47..0000000
--- a/t/lib/io_poll.t
+++ /dev/null
@@ -1,82 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-    }
-}
-
-if ($^O eq 'mpeix') {
-    print "1..0 # Skip: broken on MPE/iX\n";
-    exit 0;
-}
-
-select(STDERR); $| = 1;
-select(STDOUT); $| = 1;
-
-print "1..9\n";
-
-use IO::Handle;
-use IO::Poll qw(/POLL/);
-
-my $poll = new IO::Poll;
-
-my $stdout = \*STDOUT;
-my $dupout = IO::Handle->new_from_fd(fileno($stdout),"w");
-
-$poll->mask($stdout => POLLOUT);
-
-print "not "
-       unless $poll->mask($stdout) == POLLOUT;
-print "ok 1\n";
-
-$poll->mask($dupout => POLLPRI);
-
-print "not "
-       unless $poll->mask($dupout) == POLLPRI;
-print "ok 2\n";
-
-$poll->poll(0.1);
-
-if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
-print "ok 3 # skipped, doesn't work on non-socket fds\n";
-print "ok 4 # skipped, doesn't work on non-socket fds\n";
-}
-else {
-print "not "
-       unless $poll->events($stdout) == POLLOUT;
-print "ok 3\n";
-
-print "not "
-       if $poll->events($dupout);
-print "ok 4\n";
-}
-
-my @h = $poll->handles;
-print "not "
-       unless @h == 2;
-print "ok 5\n";
-
-$poll->remove($stdout);
-
-@h = $poll->handles;
-
-print "not "
-       unless @h == 1;
-print "ok 6\n";
-
-print "not "
-       if $poll->mask($stdout);
-print "ok 7\n";
-
-$poll->poll(0.1);
-
-print "not "
-       if $poll->events($stdout);
-print "ok 8\n";
-
-$poll->remove($dupout);
-print "not "
-    if $poll->handles;
-print "ok 9\n";

diff --git a/t/lib/io_scalar.t b/t/lib/io_scalar.t
deleted file mode 100644 (file)
index 8368e66..0000000
--- a/t/lib/io_scalar.t
+++ /dev/null
@@ -1,101 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    unless (find PerlIO::Layer 'perlio') {
-       print "1..0 # Skip: not perlio\n";
-       exit 0;
-    }
-}
-
-$| = 1;
-print "1..20\n";
-
-my $fh;
-my $var = "ok 2\n";
-open($fh,"+<",\$var) or print "not ";
-print "ok 1\n";
-print <$fh>;
-print "not " unless eof($fh);
-print "ok 3\n";
-seek($fh,0,0) or print "not ";
-print "not " if eof($fh);
-print "ok 4\n";
-print "ok 5\n";
-print $fh "ok 7\n" or print "not ";
-print "ok 6\n";
-print $var;
-$var = "foo\nbar\n";
-seek($fh,0,0) or print "not ";
-print "not " if eof($fh);
-print "ok 8\n";
-print "not " unless <$fh> eq "foo\n";
-print "ok 9\n";
-my $rv = close $fh;
-if (!$rv) {
-    print "# Close on scalar failed: $!\n";
-    print "not ";
-}
-print "ok 10\n";
-
-# Test that semantics are similar to normal file-based I/O
-# Check that ">" clobbers the scalar
-$var = "Something";
-open $fh, ">", \$var;
-print "# Got [$var], expect []\n";
-print "not " unless $var eq "";
-print "ok 11\n";
-#  Check that file offset set to beginning of scalar
-my $off = tell($fh);
-print "# Got $off, expect 0\n";
-print "not " unless $off == 0;
-print "ok 12\n";
-# Check that writes go where they should and update the offset
-$var = "Something";
-print $fh "Brea";
-$off = tell($fh);
-print "# Got $off, expect 4\n";
-print "not " unless $off == 4;
-print "ok 13\n";
-print "# Got [$var], expect [Breathing]\n";
-print "not " unless $var eq "Breathing";
-print "ok 14\n";
-close $fh;
-
-# Check that ">>" appends to the scalar
-$var = "Something ";
-open $fh, ">>", \$var;
-$off = tell($fh);
-print "# Got $off, expect 10\n";
-print "not " unless $off == 10;
-print "ok 15\n";
-print "# Got [$var], expect [Something ]\n";
-print "not " unless $var eq "Something ";
-print "ok 16\n";
-#  Check that further writes go to the very end of the scalar
-$var .= "else ";
-print "# Got [$var], expect [Something else ]\n";
-print "not " unless $var eq "Something else ";
-print "ok 17\n";
-$off = tell($fh);
-print "# Got $off, expect 10\n";
-print "not " unless $off == 10;
-print "ok 18\n";
-print $fh "is here";
-print "# Got [$var], expect [Something else is here]\n";
-print "not " unless $var eq "Something else is here";
-print "ok 19\n";
-close $fh;
-
-# Check that updates to the scalar from elsewhere do not
-# cause problems
-$var = "line one\nline two\line three\n";
-open $fh, "<", \$var;
-while (<$fh>) {
-    $var = "foo";
-}
-close $fh;
-print "# Got [$var], expect [foo]\n";
-print "not " unless $var eq "foo";
-print "ok 20\n";

diff --git a/t/lib/io_sel.t b/t/lib/io_sel.t
deleted file mode 100755 (executable)
index 84660db..0000000
--- a/t/lib/io_sel.t
+++ /dev/null
@@ -1,132 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-    }
-}
-
-select(STDERR); $| = 1;
-select(STDOUT); $| = 1;
-
-print "1..23\n";
-
-use IO::Select 1.09;
-
-my $sel = new IO::Select(\*STDIN);
-$sel->add(4, 5) == 2 or print "not ";
-print "ok 1\n";
-
-$sel->add([\*STDOUT, 'foo']) == 1 or print "not ";
-print "ok 2\n";
-
-@handles = $sel->handles;
-print "not " unless $sel->count == 4 && @handles == 4;
-print "ok 3\n";
-#print $sel->as_string, "\n";
-
-$sel->remove(\*STDIN) == 1 or print "not ";
-print "ok 4\n",
-;
-$sel->remove(\*STDIN, 5, 6) == 1  # two of there are not present
-  or print "not ";
-print "ok 5\n";
-
-print "not " unless $sel->count == 2;
-print "ok 6\n";
-#print $sel->as_string, "\n";
-
-$sel->remove(1, 4);
-print "not " unless $sel->count == 0 && !defined($sel->bits);
-print "ok 7\n";
-
-$sel = new IO::Select;
-print "not " unless $sel->count == 0 && !defined($sel->bits);
-print "ok 8\n";
-
-$sel->remove([\*STDOUT, 5]);
-print "not " unless $sel->count == 0 && !defined($sel->bits);
-print "ok 9\n";
-
-if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos') {  # 4-arg select is only valid on sockets
-    print "# skipping tests 10..15\n";
-    for (10 .. 15) { print "ok $_\n" }
-    $sel->add(\*STDOUT);  # update
-    goto POST_SOCKET;
-}
-
-@a = $sel->can_read();  # should return imediately
-print "not " unless @a == 0;
-print "ok 10\n";
-
-# we assume that we can write to STDOUT :-)
-$sel->add([\*STDOUT, "ok 12\n"]);
-
-@a = $sel->can_write;
-print "not " unless @a == 1;
-print "ok 11\n";
-
-my($fd, $msg) = @{shift @a};
-print $fd $msg;
-
-$sel->add(\*STDOUT);  # update
-
-@a = IO::Select::select(undef, $sel, undef, 1);
-print "not " unless @a == 3;
-print "ok 13\n";
-
-($r, $w, $e) = @a;
-
-print "not " unless @$r == 0 && @$w == 1 && @$e == 0;
-print "ok 14\n";
-
-$fd = $w->[0];
-print $fd "ok 15\n";
-
-POST_SOCKET:
-# Test new exists() method
-$sel->exists(\*STDIN) and print "not ";
-print "ok 16\n";
-
-($sel->exists(0) || $sel->exists([\*STDERR])) and print "not ";
-print "ok 17\n";
-
-$fd = $sel->exists(\*STDOUT);
-if ($fd) {
-    print $fd "ok 18\n";
-} else {
-    print "not ok 18\n";
-}
-
-$fd = $sel->exists([1, 'foo']);
-if ($fd) {
-    print $fd "ok 19\n";
-} else {
-    print "not ok 19\n";
-}
-
-# Try self clearing
-$sel->add(5,6,7,8,9,10);
-print "not " unless $sel->count == 7;
-print "ok 20\n";
-
-$sel->remove($sel->handles);
-print "not " unless $sel->count == 0 && !defined($sel->bits);
-print "ok 21\n";
-
-# check warnings
-$SIG{__WARN__} = sub { 
-    ++ $w 
-      if $_[0] =~ /^Call to depreciated method 'has_error', use 'has_exception'/ 
-    } ;
-$w = 0 ;
-IO::Select::has_error();
-print "not " unless $w == 0 ;
-$w = 0 ;
-print "ok 22\n" ;
-use warnings 'IO::Select' ;
-IO::Select::has_error();
-print "not " unless $w == 1 ;
-$w = 0 ;
-print "ok 23\n" ;

diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t
deleted file mode 100755 (executable)
index b752fd8..0000000
--- a/t/lib/io_sock.t
+++ /dev/null
@@ -1,338 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-    }
-}
-
-use Config;
-
-BEGIN {
-    if (-d "lib" && -f "TEST") {
-       my $reason;
-       if (! $Config{'d_fork'}) {
-           $reason = 'no fork';
-       }
-       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
-           $reason = 'Socket extension unavailable';
-       }
-       elsif ($Config{'extensions'} !~ /\bIO\b/) {
-           $reason = 'IO extension unavailable';
-       }
-       undef $reason if $^O eq 'VMS' and $Config{d_socket};
-       if ($reason) {
-           print "1..0 # Skip: $reason\n";
-           exit 0;
-        }
-    }
-}
-
-$| = 1;
-print "1..20\n";
-
-eval {
-    $SIG{ALRM} = sub { die; };
-    alarm 120;
-};
-
-use IO::Socket;
-
-$listen = IO::Socket::INET->new(Listen => 2,
-                               Proto => 'tcp',
-                               # some systems seem to need as much as 10,
-                               # so be generous with the timeout
-                               Timeout => 15,
-                              ) or die "$!";
-
-print "ok 1\n";
-
-# Check if can fork with dynamic extensions (bug in CRT):
-if ($^O eq 'os2' and
-    system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
-    print "ok $_ # skipped: broken fork\n" for 2..5;
-    exit 0;
-}
-
-$port = $listen->sockport;
-
-if($pid = fork()) {
-
-    $sock = $listen->accept() or die "accept failed: $!";
-    print "ok 2\n";
-
-    $sock->autoflush(1);
-    print $sock->getline();
-
-    print $sock "ok 4\n";
-
-    $sock->close;
-
-    waitpid($pid,0);
-
-    print "ok 5\n";
-
-} elsif(defined $pid) {
-
-    $sock = IO::Socket::INET->new(PeerPort => $port,
-                                 Proto => 'tcp',
-                                 PeerAddr => 'localhost'
-                                )
-         || IO::Socket::INET->new(PeerPort => $port,
-                                 Proto => 'tcp',
-                                 PeerAddr => '127.0.0.1'
-                                )
-       or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
-
-    $sock->autoflush(1);
-
-    print $sock "ok 3\n";
-
-    print $sock->getline();
-
-    $sock->close;
-
-    exit;
-} else {
- die;
-}
-
-# Test various other ways to create INET sockets that should
-# also work.
-$listen = IO::Socket::INET->new(Listen => '', Timeout => 15) or die "$!";
-$port = $listen->sockport;
-
-if($pid = fork()) {
-  SERVER_LOOP:
-    while (1) {
-       last SERVER_LOOP unless $sock = $listen->accept;
-       while (<$sock>) {
-           last SERVER_LOOP if /^quit/;
-           last if /^done/;
-           print;
-       }
-       $sock = undef;
-    }
-    $listen->close;
-} elsif (defined $pid) {
-    # child, try various ways to connect
-    $sock = IO::Socket::INET->new("localhost:$port")
-         || IO::Socket::INET->new("127.0.0.1:$port");
-    if ($sock) {
-       print "not " unless $sock->connected;
-       print "ok 6\n";
-       $sock->print("ok 7\n");
-       sleep(1);
-       print "ok 8\n";
-       $sock->print("ok 9\n");
-       $sock->print("done\n");
-       $sock->close;
-    }
-    else {
-       print "# $@\n";
-       print "not ok 6\n";
-       print "not ok 7\n";
-       print "not ok 8\n";
-       print "not ok 9\n";
-    }
-
-    # some machines seem to suffer from a race condition here
-    sleep(2);
-
-    $sock = IO::Socket::INET->new("127.0.0.1:$port");
-    if ($sock) {
-       $sock->print("ok 10\n");
-       $sock->print("done\n");
-       $sock->close;
-    }
-    else {
-       print "# $@\n";
-       print "not ok 10\n";
-    }
-
-    # some machines seem to suffer from a race condition here
-    sleep(1);
-
-    $sock = IO::Socket->new(Domain => AF_INET,
-                            PeerAddr => "localhost:$port")
-         || IO::Socket->new(Domain => AF_INET,
-                            PeerAddr => "127.0.0.1:$port");
-    if ($sock) {
-       $sock->print("ok 11\n");
-       $sock->print("quit\n");
-    } else {
-       print "not ok 11\n";
-    }
-    $sock = undef;
-    sleep(1);
-    exit;
-} else {
-    die;
-}
-
-# Then test UDP sockets
-$server = IO::Socket->new(Domain => AF_INET,
-                          Proto  => 'udp',
-                          LocalAddr => 'localhost')
-       || IO::Socket->new(Domain => AF_INET,
-                          Proto  => 'udp',
-                          LocalAddr => '127.0.0.1');
-$port = $server->sockport;
-
-if ($^O eq 'mpeix') {
-    print("ok 12 # skipped\n")
-} else {
-    if ($pid = fork()) {
-        my $buf;
-        $server->recv($buf, 100);
-        print $buf;
-    } elsif (defined($pid)) {
-        #child
-        $sock = IO::Socket::INET->new(Proto => 'udp',
-                                      PeerAddr => "localhost:$port")
-             || IO::Socket::INET->new(Proto => 'udp',
-                                      PeerAddr => "127.0.0.1:$port");
-        $sock->send("ok 12\n");
-        sleep(1);
-        $sock->send("ok 12\n");  # send another one to be sure
-        exit;
-    } else {
-        die;
-    }
-}
-
-print "not " unless $server->blocking;
-print "ok 13\n";
-
-$server->blocking(0);
-print "not " if $server->blocking;
-print "ok 14\n";
-
-### TEST 15
-### Set up some data to be transfered between the server and
-### the client. We'll use own source code ...
-#
-local @data;
-if( !open( SRC, "< $0")) {
-    print "not ok 15 - $!";
-} else {
-    @data = <SRC>;
-    close( SRC);
-}
-print "ok 15\n";
-
-### TEST 16
-### Start the server
-#
-my $listen = IO::Socket::INET->new( Listen => 2, Proto => 'tcp', Timeout => 15) ||
-    print "not ";
-print "ok 16\n";
-die if( !defined( $listen));
-my $serverport = $listen->sockport;
-
-my $server_pid = fork();
-if( $server_pid) {
-
-    ### TEST 17 Client/Server establishment
-    #
-    print "ok 17\n";
-
-    ### TEST 18
-    ### Get data from the server using a single stream
-    #
-    $sock = IO::Socket::INET->new("localhost:$serverport")
-         || IO::Socket::INET->new("127.0.0.1:$serverport");
-
-    if ($sock) {
-       $sock->print("send\n");
-
-       my @array = ();
-       while( <$sock>) {
-           push( @array, $_);
-       }
-
-       $sock->print("done\n");
-       $sock->close;
-
-       print "not " if( @array != @data);
-    } else {
-       print "not ";
-    }
-    print "ok 18\n";
-
-    ### TEST 19
-    ### Get data from the server using a stream, which is
-    ### interrupted by eof calls.
-    ### On perl-5.7.0@7673 this failed in a SOCKS environment, because eof
-    ### did an getc followed by an ungetc in order to check for the streams
-    ### end. getc(3) got replaced by the SOCKS funktion, which ended up in
-    ### a recv(2) call on the socket, while ungetc(3) put back a character
-    ### to an IO buffer, which never again was read.
-    #
-    $sock = IO::Socket::INET->new("localhost:$serverport")
-         || IO::Socket::INET->new("127.0.0.1:$serverport");
-
-    if ($sock) {
-       $sock->print("send\n");
-
-       my @array = ();
-       while( !eof( $sock ) ){
-           while( <$sock>) {
-               push( @array, $_);
-               last;
-           }
-       }
-
-       $sock->print("done\n");
-       $sock->close;
-
-       print "not " if( @array != @data);
-    } else {
-       print "not ";
-    }
-    print "ok 19\n";
-
-    ### TEST 20
-    ### Stop the server
-    #
-    $sock = IO::Socket::INET->new("localhost:$serverport")
-         || IO::Socket::INET->new("127.0.0.1:$serverport");
-
-    if ($sock) {
-       $sock->print("done\n");
-       $sock->close;
-
-       print "not " if( 1 != kill 0, $server_pid);
-    } else {
-       print "not ";
-    }
-    print "ok 20\n";
-
-} elsif( defined( $server_pid)) {
-   
-    ### Child
-    #
-    SERVER_LOOP: while (1) {
-       last SERVER_LOOP unless $sock = $listen->accept;
-       while (<$sock>) {
-           last SERVER_LOOP if /^quit/;
-           last if /^done/;
-           if( /^send/) {
-               print $sock @data;
-               last;
-           }
-           print;
-       }
-       $sock = undef;
-    }
-    $listen->close;
-
-} else {
-
-    ### Fork failed
-    #
-    print "not ok 17\n";
-    die;
-}
-

diff --git a/t/lib/io_taint.t b/t/lib/io_taint.t
deleted file mode 100755 (executable)
index c98d701..0000000
--- a/t/lib/io_taint.t
+++ /dev/null
@@ -1,48 +0,0 @@
-#!./perl -T
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-    }
-}
-
-use Config;
-
-BEGIN {
-    if(-d "lib" && -f "TEST") {
-        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
-           print "1..0\n";
-           exit 0;
-        }
-    }
-}
-
-END { unlink "./__taint__$$" }
-
-print "1..3\n";
-use IO::File;
-$x = new IO::File "> ./__taint__$$" || die("Cannot open ./__taint__$$\n");
-print $x "$$\n";
-$x->close;
-
-$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
-chop($unsafe = <$x>);
-eval { kill 0 * $unsafe };
-print "not " if ((($^O ne 'MSWin32') && ($^O ne 'NetWare')) and ($@ !~ /^Insecure/o));
-print "ok 1\n";
-$x->close;
-
-# We could have just done a seek on $x, but technically we haven't tested
-# seek yet...
-$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
-$x->untaint;
-print "not " if ($?);
-print "ok 2\n"; # Calling the method worked
-chop($unsafe = <$x>);
-eval { kill 0 * $unsafe };
-print "not " if ($@ =~ /^Insecure/o);
-print "ok 3\n"; # No Insecure message from using the data
-$x->close;
-
-exit 0;

diff --git a/t/lib/io_tell.t b/t/lib/io_tell.t
deleted file mode 100755 (executable)
index 65c63bd..0000000
--- a/t/lib/io_tell.t
+++ /dev/null
@@ -1,64 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       $tell_file = "TEST";
-    }
-    else {
-       $tell_file = "Makefile";
-    }
-}
-
-use Config;
-
-BEGIN {
-    if(-d "lib" && -f "TEST") {
-        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
-           print "1..0\n";
-           exit 0;
-        }
-    }
-}
-
-print "1..13\n";
-
-use IO::File;
-
-$tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file");
-binmode $tst; # its a nop unless it matters. Was only if ($^O eq 'MSWin32' or $^O eq 'dos');
-if ($tst->eof) { print "not ok 1\n"; } else { print "ok 1\n"; }
-
-$firstline = <$tst>;
-$secondpos = tell;
-
-$x = 0;
-while (<$tst>) {
-    if (eof) {$x++;}
-}
-if ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; }
-
-$lastpos = tell;
-
-unless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; }
-
-if ($tst->seek(0,0)) { print "ok 4\n"; } else { print "not ok 4\n"; }
-
-if (eof) { print "not ok 5\n"; } else { print "ok 5\n"; }
-
-if ($firstline eq <$tst>) { print "ok 6\n"; } else { print "not ok 6\n"; }
-
-if ($secondpos == tell) { print "ok 7\n"; } else { print "not ok 7\n"; }
-
-if ($tst->seek(0,1)) { print "ok 8\n"; } else { print "not ok 8\n"; }
-
-if ($tst->eof) { print "not ok 9\n"; } else { print "ok 9\n"; }
-
-if ($secondpos == tell) { print "ok 10\n"; } else { print "not ok 10\n"; }
-
-if ($tst->seek(0,2)) { print "ok 11\n"; } else { print "not ok 11\n"; }
-
-if ($lastpos == $tst->tell) { print "ok 12\n"; } else { print "not ok 12\n"; }
-
-unless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; }

diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t
deleted file mode 100755 (executable)
index d63a5dc..0000000
--- a/t/lib/io_udp.t
+++ /dev/null
@@ -1,94 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-    }
-}
-
-use Config;
-
-BEGIN {
-    if(-d "lib" && -f "TEST") {
-       my $reason;
-
-       if ($Config{'extensions'} !~ /\bSocket\b/) {
-         $reason = 'Socket was not built';
-       }
-       elsif ($Config{'extensions'} !~ /\bIO\b/) {
-         $reason = 'IO was not built';
-       }
-       elsif ($^O eq 'apollo') {
-         $reason = "unknown *FIXME*";
-       }
-       undef $reason if $^O eq 'VMS' and $Config{d_socket};
-       if ($reason) {
-           print "1..0 # Skip: $reason\n";
-           exit 0;
-       }
-    }
-}
-
-sub compare_addr {
-    no utf8;
-    my $a = shift;
-    my $b = shift;
-    if (length($a) != length $b) {
-       my $min = (length($a) < length $b) ? length($a) : length $b;
-       if ($min and substr($a, 0, $min) eq substr($b, 0, $min)) {
-           printf "# Apparently: %d bytes junk at the end of %s\n# %s\n",
-               abs(length($a) - length ($b)),
-               $_[length($a) < length ($b) ? 1 : 0],
-               "consider decreasing bufsize of recfrom.";
-           substr($a, $min) = "";
-           substr($b, $min) = "";
-       }
-       return 0;
-    }
-    my @a = unpack_sockaddr_in($a);
-    my @b = unpack_sockaddr_in($b);
-    "$a[0]$a[1]" eq "$b[0]$b[1]";
-}
-
-$| = 1;
-print "1..7\n";
-
-use Socket;
-use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
-
-$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
-     || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
-    or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
-
-print "ok 1\n";
-
-$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
-     || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
-    or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
-
-print "ok 2\n";
-
-$udpa->send("ok 4\n",0,$udpb->sockname);
-
-print "not "
-  unless compare_addr($udpa->peername,$udpb->sockname, 'peername', 'sockname');
-print "ok 3\n";
-
-my $where = $udpb->recv($buf="",5);
-print $buf;
-
-my @xtra = ();
-
-unless(compare_addr($where,$udpa->sockname, 'recv name', 'sockname')) {
-    print "not ";
-    @xtra = (0,$udpa->sockname);
-}
-print "ok 5\n";
-
-$udpb->send("ok 6\n",@xtra);
-$udpa->recv($buf="",5);
-print $buf;
-
-print "not " if $udpa->connected;
-print "ok 7\n";

diff --git a/t/lib/io_unix.t b/t/lib/io_unix.t
deleted file mode 100644 (file)
index 2f6def0..0000000
--- a/t/lib/io_unix.t
+++ /dev/null
@@ -1,89 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-    }
-}
-
-use Config;
-
-BEGIN {
-    if(-d "lib" && -f "TEST") {
-       my $reason;
-       if (! $Config{'d_fork'}) {
-           $reason = 'no fork';
-       }
-       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
-           $reason = 'Socket extension unavailable';
-       }
-       elsif ($Config{'extensions'} !~ /\bIO\b/) {
-           $reason = 'IO extension unavailable';
-       }
-       elsif ($^O eq 'os2') {
-           require IO::Socket;
-
-           eval {IO::Socket::pack_sockaddr_un('/tmp/foo') || 1}
-             or $@ !~ /not implemented/ or
-               $reason = 'compiled without TCP/IP stack v4';
-       } elsif ($^O eq 'qnx') {
-           $reason = 'Not implemented';
-       }
-       undef $reason if $^O eq 'VMS' and $Config{d_socket};
-       if ($reason) {
-           print "1..0 # Skip: $reason\n";
-           exit 0;
-        }
-    }
-}
-
-$PATH = "/tmp/sock-$$";
-
-# Test if we can create the file within the tmp directory
-if (-e $PATH or not open(TEST, ">$PATH") and $^O ne 'os2') {
-    print "1..0 # Skip: cannot open '$PATH' for write\n";
-    exit 0;
-}
-close(TEST);
-unlink($PATH) or $^O eq 'os2' or die "Can't unlink $PATH: $!";
-
-# Start testing
-$| = 1;
-print "1..5\n";
-
-use IO::Socket;
-
-$listen = IO::Socket::UNIX->new(Local=>$PATH, Listen=>0) || die "$!";
-print "ok 1\n";
-
-if($pid = fork()) {
-
-    $sock = $listen->accept();
-    print "ok 2\n";
-
-    print $sock->getline();
-
-    print $sock "ok 4\n";
-
-    $sock->close;
-
-    waitpid($pid,0);
-    unlink($PATH) || $^O eq 'os2' || warn "Can't unlink $PATH: $!";
-
-    print "ok 5\n";
-
-} elsif(defined $pid) {
-
-    $sock = IO::Socket::UNIX->new(Peer => $PATH) or die "$!";
-
-    print $sock "ok 3\n";
-
-    print $sock->getline();
-
-    $sock->close;
-
-    exit;
-} else {
- die;
-}

diff --git a/t/lib/io_xs.t b/t/lib/io_xs.t
deleted file mode 100755 (executable)
index 2449fc4..0000000
--- a/t/lib/io_xs.t
+++ /dev/null
@@ -1,43 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless(grep /blib/, @INC) {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-    }
-}
-
-use Config;
-
-BEGIN {
-    if(-d "lib" && -f "TEST") {
-        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
-           print "1..0\n";
-           exit 0;
-        }
-    }
-}
-
-use IO::File;
-use IO::Seekable;
-
-print "1..4\n";
-
-$x = new_tmpfile IO::File or print "not ";
-print "ok 1\n";
-print $x "ok 2\n";
-$x->seek(0,SEEK_SET);
-print <$x>;
-
-$x->seek(0,SEEK_SET);
-print $x "not ok 3\n";
-$p = $x->getpos;
-print $x "ok 3\n";
-$x->flush;
-$x->setpos($p);
-print scalar <$x>;
-
-$! = 0;
-$x->setpos(undef);
-print $! ? "ok 4 # $!\n" : "not ok 4\n";
-

diff --git a/t/lib/ipc_sysv.t b/t/lib/ipc_sysv.t
deleted file mode 100755 (executable)
index 795ad5d..0000000
--- a/t/lib/ipc_sysv.t
+++ /dev/null
@@ -1,218 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-
-    @INC = '../lib';
-
-    require Config; import Config;
-
-    my $reason;
-
-    if ($Config{'extensions'} !~ /\bIPC\/SysV\b/) {
-      $reason = 'IPC::SysV was not built';
-    } elsif ($Config{'d_sem'} ne 'define') {
-      $reason = '$Config{d_sem} undefined';
-    } elsif ($Config{'d_msg'} ne 'define') {
-      $reason = '$Config{d_msg} undefined';
-    }
-    if ($reason) {
-       print "1..0 # Skip: $reason\n";
-       exit 0;
-    }
-}
-
-# These constants are common to all tests.
-# Later the sem* tests will import more for themselves.
-
-use IPC::SysV qw(IPC_PRIVATE IPC_NOWAIT IPC_STAT IPC_RMID S_IRWXU);
-use strict;
-
-print "1..16\n";
-
-my $msg;
-my $sem;
-
-$SIG{__DIE__} = 'cleanup'; # will cleanup $msg and $sem if needed
-
-# FreeBSD is known to throw this if there's no SysV IPC in the kernel.
-$SIG{SYS} = sub {
-    print STDERR <<EOM;
-SIGSYS caught.
-It may be that your kernel does not have SysV IPC configured.
-
-EOM
-    if ($^O eq 'freebsd') {
-       print STDERR <<EOM;
-You must have following options in your kernel:
-
-options         SYSVSHM
-options         SYSVSEM
-options         SYSVMSG
-
-See config(8).
-EOM
-    }
-    exit(1);
-};
-
-my $perm = S_IRWXU;
-
-if ($Config{'d_msgget'} eq 'define' &&
-    $Config{'d_msgctl'} eq 'define' &&
-    $Config{'d_msgsnd'} eq 'define' &&
-    $Config{'d_msgrcv'} eq 'define') {
-
-    $msg = msgget(IPC_PRIVATE, $perm);
-    # Very first time called after machine is booted value may be 0 
-    die "msgget failed: $!\n" unless defined($msg) && $msg >= 0;
-
-    print "ok 1\n";
-
-    #Putting a message on the queue
-    my $msgtype = 1;
-    my $msgtext = "hello";
-
-    my $test2bad;
-    my $test5bad;
-    my $test6bad;
-
-    unless (msgsnd($msg,pack("L! a*",$msgtype,$msgtext),IPC_NOWAIT)) {
-       print "not ";
-       $test2bad = 1;
-    }
-    print "ok 2\n";
-    if ($test2bad) {
-       print <<EOM;
-#
-# The failure of the subtest #2 may indicate that the message queue
-# resource limits either of the system or of the testing account
-# have been reached.  Error message "Operating would block" is
-# usually indicative of this situation.  The error message was now:
-# "$!"
-#
-# You can check the message queues with the 'ipcs' command and
-# you can remove unneeded queues with the 'ipcrm -q id' command.
-# You may also consider configuring your system or account
-# to have more message queue resources.
-#
-# Because of the subtest #2 failing also the substests #5 and #6 will
-# very probably also fail.
-#
-EOM
-    }
-
-    my $data;
-    msgctl($msg,IPC_STAT,$data) or print "not ";
-    print "ok 3\n";
-
-    print "not " unless length($data);
-    print "ok 4\n";
-
-    my $msgbuf;
-    unless (msgrcv($msg,$msgbuf,256,0,IPC_NOWAIT)) {
-       print "not ";
-       $test5bad = 1;
-    }
-    print "ok 5\n";
-    if ($test5bad && $test2bad) {
-       print <<EOM;
-#
-# This failure was to be expected because the subtest #2 failed.
-#
-EOM
-    }
-
-    my($rmsgtype,$rmsgtext);
-    ($rmsgtype,$rmsgtext) = unpack("L! a*",$msgbuf);
-    unless ($rmsgtype == $msgtype && $rmsgtext eq $msgtext) {
-       print "not ";
-       $test6bad = 1;
-    }
-    print "ok 6\n";
-    if ($test6bad && $test2bad) {
-       print <<EOM;
-#
-# This failure was to be expected because the subtest #2 failed.
-#
-EOM
-     }
-} else {
-    for (1..6) {
-       print "ok $_\n"; # fake it
-    }
-}
-
-if($Config{'d_semget'} eq 'define' &&
-   $Config{'d_semctl'} eq 'define') {
-
-    if ($Config{'d_semctl_semid_ds'} eq 'define' ||
-       $Config{'d_semctl_semun'}    eq 'define') {
-
-       use IPC::SysV qw(IPC_CREAT GETALL SETALL);
-
-       $sem = semget(IPC_PRIVATE, 10, $perm | IPC_CREAT);
-       # Very first time called after machine is booted value may be 0 
-       die "semget: $!\n" unless defined($sem) && $sem >= 0;
-
-       print "ok 7\n";
-
-       my $data;
-       semctl($sem,0,IPC_STAT,$data) or print "not ";
-       print "ok 8\n";
-       
-       print "not " unless length($data);
-       print "ok 9\n";
-
-       my $nsem = 10;
-
-       semctl($sem,0,SETALL,pack("s!*",(0) x $nsem)) or print "not ";
-       print "ok 10\n";
-
-       $data = "";
-       semctl($sem,0,GETALL,$data) or print "not ";
-       print "ok 11\n";
-
-       print "not " unless length($data) == length(pack("s!*",(0) x $nsem));
-       print "ok 12\n";
-
-       my @data = unpack("s!*",$data);
-
-       my $adata = "0" x $nsem;
-
-       print "not " unless @data == $nsem and join("",@data) eq $adata;
-       print "ok 13\n";
-
-       my $poke = 2;
-
-       $data[$poke] = 1;
-       semctl($sem,0,SETALL,pack("s!*",@data)) or print "not ";
-       print "ok 14\n";
-    
-       $data = "";
-       semctl($sem,0,GETALL,$data) or print "not ";
-       print "ok 15\n";
-
-       @data = unpack("s!*",$data);
-
-       my $bdata = "0" x $poke . "1" . "0" x ($nsem-$poke-1);
-
-       print "not " unless join("",@data) eq $bdata;
-       print "ok 16\n";
-    } else {
-       for (7..16) {
-           print "ok $_ # skipped, no semctl possible\n";
-       }
-    }
-} else {
-    for (7..16) {
-       print "ok $_\n"; # fake it
-    }
-}
-
-sub cleanup {
-    msgctl($msg,IPC_RMID,0)       if defined $msg;
-    semctl($sem,0,IPC_RMID,undef) if defined $sem;
-}
-
-cleanup;

diff --git a/t/lib/lc-all.t b/t/lib/lc-all.t
deleted file mode 100644 (file)
index ed93c5a..0000000
--- a/t/lib/lc-all.t
+++ /dev/null
@@ -1,366 +0,0 @@
-#!./perl
-#
-# all.t - tests for all_* routines in
-#      Locale::Country
-#      Locale::Language
-#      Locale::Currency
-#
-# There are four tests. We get a list of all codes, convert to
-# language/country/currency, # convert back to code,
-# and check that they're the same. Then we do the same,
-# starting with list of languages/countries/currencies.
-#
-
-BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-}
-
-use Locale::Country;
-use Locale::Language;
-use Locale::Currency;
-
-print "1..12\n";
-
-my $code;
-my $language;
-my $country;
-my $ok;
-my $reverse;
-my $currency;
-
-
-#-----------------------------------------------------------------------
-# Old API - without codeset specified, default to ALPHA_2
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $code (all_country_codes())
-{
-    $country = code2country($code);
-    if (!defined $country)
-    {
-        $ok = 0;
-        last;
-    }
-    $reverse = country2code($country);
-    if (!defined $reverse)
-    {
-        $ok = 0;
-        last;
-    }
-    if ($reverse ne $code)
-    {
-        $ok = 0;
-        last;
-    }
-}
-print ($ok ? "ok 1\n" : "not ok 1\n");
-
-#-----------------------------------------------------------------------
-# code to country, back to code, for ALPHA2
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $code (all_country_codes(LOCALE_CODE_ALPHA_2))
-{
-    $country = code2country($code, LOCALE_CODE_ALPHA_2);
-    if (!defined $country)
-    {
-        $ok = 0;
-        last;
-    }
-    $reverse = country2code($country, LOCALE_CODE_ALPHA_2);
-    if (!defined $reverse)
-    {
-        $ok = 0;
-        last;
-    }
-    if ($reverse ne $code)
-    {
-        $ok = 0;
-        last;
-    }
-}
-print ($ok ? "ok 2\n" : "not ok 2\n");
-
-#-----------------------------------------------------------------------
-# code to country, back to code, for ALPHA3
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $code (all_country_codes(LOCALE_CODE_ALPHA_3))
-{
-    $country = code2country($code, LOCALE_CODE_ALPHA_3);
-    if (!defined $country)
-    {
-        $ok = 0;
-        last;
-    }
-    $reverse = country2code($country, LOCALE_CODE_ALPHA_3);
-    if (!defined $reverse)
-    {
-        $ok = 0;
-        last;
-    }
-    if ($reverse ne $code)
-    {
-        $ok = 0;
-        last;
-    }
-}
-print ($ok ? "ok 3\n" : "not ok 3\n");
-
-#-----------------------------------------------------------------------
-# code to country, back to code, for NUMERIC
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $code (all_country_codes(LOCALE_CODE_NUMERIC))
-{
-    $country = code2country($code, LOCALE_CODE_NUMERIC);
-    if (!defined $country)
-    {
-        $ok = 0;
-        last;
-    }
-    $reverse = country2code($country, LOCALE_CODE_NUMERIC);
-    if (!defined $reverse)
-    {
-        $ok = 0;
-        last;
-    }
-    if ($reverse ne $code)
-    {
-        $ok = 0;
-        last;
-    }
-}
-print ($ok ? "ok 4\n" : "not ok 4\n");
-
-
-#-----------------------------------------------------------------------
-# Old API - country to code, back to country, using default of ALPHA_2
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $country (all_country_names())
-{
-    $code = country2code($country);
-    if (!defined $code)
-    {
-        $ok = 0;
-        last;
-    }
-    $reverse = code2country($code);
-    if (!defined $reverse)
-    {
-        $ok = 0;
-        last;
-    }
-    if ($reverse ne $country)
-    {
-        $ok = 0;
-        last;
-    }
-}
-print ($ok ? "ok 5\n" : "not ok 5\n");
-
-#-----------------------------------------------------------------------
-# country to code, back to country, using LOCALE_CODE_ALPHA_2
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $country (all_country_names())
-{
-    $code = country2code($country, LOCALE_CODE_ALPHA_2);
-    if (!defined $code)
-    {
-        $ok = 0;
-        last;
-    }
-    $reverse = code2country($code, LOCALE_CODE_ALPHA_2);
-    if (!defined $reverse)
-    {
-        $ok = 0;
-        last;
-    }
-    if ($reverse ne $country)
-    {
-        $ok = 0;
-        last;
-    }
-}
-print ($ok ? "ok 6\n" : "not ok 6\n");
-
-#-----------------------------------------------------------------------
-# country to code, back to country, using LOCALE_CODE_ALPHA_3
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $country (all_country_names())
-{
-    $code = country2code($country, LOCALE_CODE_ALPHA_3);
-    if (!defined $code)
-    {
-       next if ($country eq 'Antarctica'
-                || $country eq 'Bouvet Island'
-                || $country eq 'Cocos (Keeling) Islands'
-                || $country eq 'Christmas Island'
-                || $country eq 'France, Metropolitan'
-                || $country eq 'South Georgia and the South Sandwich Islands'
-                || $country eq 'Heard Island and McDonald Islands'
-                || $country eq 'British Indian Ocean Territory'
-                || $country eq 'French Southern Territories'
-                || $country eq 'United States Minor Outlying Islands'
-                || $country eq 'Mayotte'
-                || $country eq 'Zaire');
-        $ok = 0;
-        last;
-    }
-    $reverse = code2country($code, LOCALE_CODE_ALPHA_3);
-    if (!defined $reverse)
-    {
-        $ok = 0;
-        last;
-    }
-    if ($reverse ne $country)
-    {
-        $ok = 0;
-        last;
-    }
-}
-print ($ok ? "ok 7\n" : "not ok 7\n");
-
-#-----------------------------------------------------------------------
-# country to code, back to country, using LOCALE_CODE_NUMERIC
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $country (all_country_names())
-{
-    $code = country2code($country, LOCALE_CODE_NUMERIC);
-    if (!defined $code)
-    {
-       next if ($country eq 'Antarctica'
-                || $country eq 'Bouvet Island'
-                || $country eq 'Cocos (Keeling) Islands'
-                || $country eq 'Christmas Island'
-                || $country eq 'France, Metropolitan'
-                || $country eq 'South Georgia and the South Sandwich Islands'
-                || $country eq 'Heard Island and McDonald Islands'
-                || $country eq 'British Indian Ocean Territory'
-                || $country eq 'French Southern Territories'
-                || $country eq 'United States Minor Outlying Islands'
-                || $country eq 'Mayotte'
-                || $country eq 'Zaire');
-        $ok = 0;
-        last;
-    }
-    $reverse = code2country($code, LOCALE_CODE_NUMERIC);
-    if (!defined $reverse)
-    {
-        $ok = 0;
-        last;
-    }
-    if ($reverse ne $country)
-    {
-        $ok = 0;
-        last;
-    }
-}
-print ($ok ? "ok 8\n" : "not ok 8\n");
-
-
-$ok = 1;
-foreach $code (all_language_codes())
-{
-    $language = code2language($code);
-    if (!defined $language)
-    {
-        $ok = 0;
-        last;
-    }
-    $reverse = language2code($language);
-    if (!defined $reverse)
-    {
-        $ok = 0;
-        last;
-    }
-    if ($reverse ne $code)
-    {
-        $ok = 0;
-        last;
-    }
-}
-print ($ok ? "ok 9\n" : "not ok 9\n");
-
-
-$ok = 1;
-foreach $language (all_language_names())
-{
-    $code = language2code($language);
-    if (!defined $code)
-    {
-        $ok = 0;
-        last;
-    }
-    $reverse = code2language($code);
-    if (!defined $reverse)
-    {
-        $ok = 0;
-        last;
-    }
-    if ($reverse ne $language)
-    {
-        $ok = 0;
-        last;
-    }
-}
-print ($ok ? "ok 10\n" : "not ok 10\n");
-
-$ok = 1;
-foreach $code (all_currency_codes())
-{
-    $currency = code2currency($code);
-    if (!defined $currency)
-    {
-        $ok = 0;
-        last;
-    }
-    $reverse = currency2code($currency);
-    if (!defined $reverse)
-    {
-        $ok = 0;
-        last;
-    }
-    #
-    # three special cases:
-    #  The Kwacha has two codes - used in Zambia and Malawi
-    #  The Russian Ruble has two codes - rub and rur
-    #  The Belarussian Ruble has two codes - byb and byr
-    if ($reverse ne $code
-       && $code ne 'mwk' && $code ne 'zmk'
-       && $code ne 'byr' && $code ne 'byb'
-       && $code ne 'rub' && $code ne 'rur')
-    {
-        $ok = 0;
-        last;
-    }
-}
-print ($ok ? "ok 11\n" : "not ok 11\n");
-
-$ok = 1;
-foreach $currency (all_currency_names())
-{
-    $code = currency2code($currency);
-    if (!defined $code)
-    {
-        $ok = 0;
-        last;
-    }
-    $reverse = code2currency($code);
-    if (!defined $reverse)
-    {
-        $ok = 0;
-        last;
-    }
-    if ($reverse ne $currency)
-    {
-        $ok = 0;
-        last;
-    }
-}
-print ($ok ? "ok 12\n" : "not ok 12\n");

diff --git a/t/lib/lc-constants.t b/t/lib/lc-constants.t
deleted file mode 100644 (file)
index 359cdfc..0000000
--- a/t/lib/lc-constants.t
+++ /dev/null
@@ -1,49 +0,0 @@
-#!./perl
-#
-# constants.t - tests for Locale::Constants
-#
-
-BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-}
-
-use Locale::Constants;
-
-print "1..3\n";
-
-if (defined LOCALE_CODE_ALPHA_2
-    && defined LOCALE_CODE_ALPHA_3
-    && defined LOCALE_CODE_NUMERIC)
-{
-    print "ok 1\n";
-}
-else
-{
-    print "not ok 1\n";
-}
-
-if (LOCALE_CODE_ALPHA_2 != LOCALE_CODE_ALPHA_3
-    && LOCALE_CODE_ALPHA_2 != LOCALE_CODE_NUMERIC
-    && LOCALE_CODE_ALPHA_3 != LOCALE_CODE_NUMERIC)
-{
-    print "ok 2\n";
-}
-else
-{
-    print "not ok 2\n";
-}
-
-if (defined LOCALE_CODE_DEFAULT
-    && (LOCALE_CODE_DEFAULT == LOCALE_CODE_ALPHA_2
-       || LOCALE_CODE_DEFAULT == LOCALE_CODE_ALPHA_3
-       || LOCALE_CODE_DEFAULT == LOCALE_CODE_NUMERIC))
-{
-    print "ok 3\n";
-}
-else
-{
-    print "not ok 3\n";
-}
-
-exit 0;

diff --git a/t/lib/lc-country.t b/t/lib/lc-country.t
deleted file mode 100644 (file)
index 4234d1e..0000000
--- a/t/lib/lc-country.t
+++ /dev/null
@@ -1,114 +0,0 @@
-#!./perl
-#
-# country.t - tests for Locale::Country
-#
-
-BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-}
-
-use Locale::Country;
-
-#-----------------------------------------------------------------------
-# This is an array of tests specs. Each spec is [TEST, OK_TO_DIE]
-# Each TEST is eval'd as an expression.
-# If it evaluates to FALSE, then "not ok N" is printed for the test,
-# otherwise "ok N". If the eval dies, then the OK_TO_DIE flag is checked.
-# If it is true (1), the test is treated as passing, otherwise it failed.
-#-----------------------------------------------------------------------
-@TESTS =
-(
-       #================================================
-       # TESTS FOR code2country
-       #================================================
-
- #---- selection of examples which should all result in undef -----------
- ['!defined code2country()', 0],                  # no argument
- ['!defined code2country(undef)', 0],             # undef argument
- ['!defined code2country("zz")', 0],              # illegal code
- ['!defined code2country("zz", LOCALE_CODE_ALPHA_2)', 0],        # illegal code
- ['!defined code2country("zz", LOCALE_CODE_ALPHA_3)', 0],        # illegal code
- ['!defined code2country("zz", LOCALE_CODE_NUMERIC)', 0],        # illegal code
- ['!defined code2country("ja")', 0],              # should be jp for country
- ['!defined code2country("uk")', 0],              # should be jp for country
-
- #---- some successful examples -----------------------------------------
- ['code2country("BO") eq "Bolivia"', 0],
- ['code2country("BO", LOCALE_CODE_ALPHA_2) eq "Bolivia"', 0],
- ['code2country("bol", LOCALE_CODE_ALPHA_3) eq "Bolivia"', 0],
- ['code2country("pk") eq "Pakistan"', 0],
- ['code2country("sn") eq "Senegal"', 0],
- ['code2country("us") eq "United States"', 0],
- ['code2country("ad") eq "Andorra"', 0],          # first in DATA segment
- ['code2country("ad", LOCALE_CODE_ALPHA_2) eq "Andorra"', 0],
- ['code2country("and", LOCALE_CODE_ALPHA_3) eq "Andorra"', 0],
- ['code2country("020", LOCALE_CODE_NUMERIC) eq "Andorra"', 0],
- ['code2country(48, LOCALE_CODE_NUMERIC) eq "Bahrain"', 0],
- ['code2country("zw") eq "Zimbabwe"', 0],         # last in DATA segment
- ['code2country("gb") eq "United Kingdom"', 0],   # United Kingdom is "gb", not "uk"
-
-       #================================================
-       # TESTS FOR country2code
-       #================================================
-
- #---- selection of examples which should all result in undef -----------
- ['!defined code2country("BO", LOCALE_CODE_ALPHA_3)', 0],
- ['!defined code2country("BO", LOCALE_CODE_NUMERIC)', 0],
- ['!defined country2code()', 0],                  # no argument
- ['!defined country2code(undef)', 0],             # undef argument
- ['!defined country2code("Banana")', 0],          # illegal country name
-
- #---- some successful examples -----------------------------------------
- ['country2code("japan")          eq "jp"', 0],
- ['country2code("japan")          ne "ja"', 0],
- ['country2code("Japan")          eq "jp"', 0],
- ['country2code("United States")  eq "us"', 0],
- ['country2code("United Kingdom") eq "gb"', 0],
- ['country2code("Andorra")        eq "ad"', 0],    # first in DATA segment
- ['country2code("Zimbabwe")       eq "zw"', 0],    # last in DATA segment
-
-       #================================================
-       # TESTS FOR country_code2code
-       #================================================
-
- #---- selection of examples which should all result in undef -----------
- ['!defined country_code2code("bo", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_3)', 0],
- ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3)', 0],
- ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_3)', 0],
- ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_2)', 1],
- ['!defined country_code2code("bo", LOCALE_CODE_ALPHA_2)', 1],
- ['!defined country_code2code()', 1],                  # no argument
- ['!defined country_code2code(undef)', 1],             # undef argument
-
- #---- some successful examples -----------------------------------------
- ['country_code2code("BO", LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3) eq "bol"', 0],
- ['country_code2code("bol", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2) eq "bo"', 0],
- ['country_code2code("zwe", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2) eq "zw"', 0],
- ['country_code2code("858", LOCALE_CODE_NUMERIC, LOCALE_CODE_ALPHA_3) eq "ury"', 0],
- ['country_code2code(858, LOCALE_CODE_NUMERIC, LOCALE_CODE_ALPHA_3) eq "ury"', 0],
- ['country_code2code("tr", LOCALE_CODE_ALPHA_2, LOCALE_CODE_NUMERIC) eq "792"', 0],
-
-);
-
-print "1..", int(@TESTS), "\n";
-
-$testid = 1;
-foreach $test (@TESTS)
-{
-    eval "print (($test->[0]) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
-    if ($@)
-    {
-       if (!$test->[1])
-       {
-           print "not ok $testid\n";
-       }
-       else
-       {
-           print "ok $testid\n";
-       }
-    }
-    ++$testid;
-}
-
-exit 0;

diff --git a/t/lib/lc-currency.t b/t/lib/lc-currency.t
deleted file mode 100644 (file)
index 55a04db..0000000
--- a/t/lib/lc-currency.t
+++ /dev/null
@@ -1,85 +0,0 @@
-#!./perl
-#
-# currency.t - tests for Locale::Currency
-#
-
-BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-}
-
-use Locale::Currency;
-
-#-----------------------------------------------------------------------
-# This is an array of tests. Each test is eval'd as an expression.
-# If it evaluates to FALSE, then "not ok N" is printed for the test,
-# otherwise "ok N".
-#-----------------------------------------------------------------------
-@TESTS =
-(
-       #================================================
-       # TESTS FOR code2currency
-       #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined code2currency()',                 # no argument => undef returned
- '!defined code2currency(undef)',            # undef arg   => undef returned
- '!defined code2currency("zz")',             # illegal code => undef
- '!defined code2currency("zzzz")',           # illegal code => undef
- '!defined code2currency("zzz")',            # illegal code => undef
- '!defined code2currency("ukp")',            # gbp for sterling, not ukp
-
- #---- misc tests -------------------------------------------------------
- 'code2currency("all") eq "Lek"',
- 'code2currency("ats") eq "Schilling"',
- 'code2currency("bob") eq "Boliviano"',
- 'code2currency("bnd") eq "Brunei Dollar"',
- 'code2currency("cop") eq "Colombian Peso"',
- 'code2currency("dkk") eq "Danish Krone"',
- 'code2currency("fjd") eq "Fiji Dollar"',
- 'code2currency("idr") eq "Rupiah"',
- 'code2currency("chf") eq "Swiss Franc"',
- 'code2currency("mvr") eq "Rufiyaa"',
- 'code2currency("mmk") eq "Kyat"',
- 'code2currency("mwk") eq "Kwacha"',   # two different codes for Kwacha
- 'code2currency("zmk") eq "Kwacha"',    # used in Zambia and Malawi
- 'code2currency("byr") eq "Belarussian Ruble"',        # 2 codes for belarussian ruble
- 'code2currency("byb") eq "Belarussian Ruble"', #
- 'code2currency("rub") eq "Russian Ruble"',    # 2 codes for russian ruble
- 'code2currency("rur") eq "Russian Ruble"',     #
-
- #---- some successful examples -----------------------------------------
- 'code2currency("BOB") eq "Boliviano"',
- 'code2currency("adp") eq "Andorran Peseta"',  # first in DATA segment
- 'code2currency("zwd") eq "Zimbabwe Dollar"',  # last in DATA segment
-
-       #================================================
-       # TESTS FOR currency2code
-       #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined currency2code()',                 # no argument => undef returned
- '!defined currency2code(undef)',            # undef arg   => undef returned
- '!defined currency2code("")',               # empty string => undef returned
- '!defined currency2code("Banana")',         # illegal curr name => undef
-
- #---- some successful examples -----------------------------------------
- 'currency2code("Kroon")           eq "eek"',
- 'currency2code("Markka")         eq "fim"',
- 'currency2code("Riel")            eq "khr"',
- 'currency2code("PULA")            eq "bwp"',
- 'currency2code("Andorran Peseta") eq "adp"',       # first in DATA segment
- 'currency2code("Zimbabwe Dollar") eq "zwd"',       # last in DATA segment
-);
-
-print "1..", int(@TESTS), "\n";
-
-$testid = 1;
-foreach $test (@TESTS)
-{
-    eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
-    print "not ok $testid\n" if $@;
-    ++$testid;
-}
-
-exit 0;

diff --git a/t/lib/lc-language.t b/t/lib/lc-language.t
deleted file mode 100644 (file)
index 9facd35..0000000
--- a/t/lib/lc-language.t
+++ /dev/null
@@ -1,110 +0,0 @@
-#!./perl
-#
-# language.t - tests for Locale::Language
-#
-
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-}
-
-use Locale::Language;
-
-no utf8; # so that the naked 8-bit characters won't gripe under use utf8
-
-#-----------------------------------------------------------------------
-# This is an array of tests. Each test is eval'd as an expression.
-# If it evaluates to FALSE, then "not ok N" is printed for the test,
-# otherwise "ok N".
-#-----------------------------------------------------------------------
-@TESTS =
-(
-       #================================================
-       # TESTS FOR code2language
-       #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined code2language()',                 # no argument => undef returned
- '!defined code2language(undef)',            # undef arg   => undef returned
- '!defined code2language("zz")',             # illegal code => undef
- '!defined code2language("jp")',             # ja for lang, jp for country
-
- #---- test recent changes ----------------------------------------------
- 'code2language("ae") eq "Avestan"',
- 'code2language("bs") eq "Bosnian"',
- 'code2language("ch") eq "Chamorro"',
- 'code2language("ce") eq "Chechen"',
- 'code2language("cu") eq "Church Slavic"',
- 'code2language("cv") eq "Chuvash"',
- 'code2language("hz") eq "Herero"',
- 'code2language("ho") eq "Hiri Motu"',
- 'code2language("ki") eq "Kikuyu"',
- 'code2language("kj") eq "Kuanyama"',
- 'code2language("kv") eq "Komi"',
- 'code2language("mh") eq "Marshall"',
- 'code2language("nv") eq "Navajo"',
- 'code2language("nr") eq "Ndebele, South"',
- 'code2language("nd") eq "Ndebele, North"',
- 'code2language("ng") eq "Ndonga"',
- 'code2language("nn") eq "Norwegian Nynorsk"',
- 'code2language("nb") eq "Norwegian Bokmål"',
- 'code2language("ny") eq "Chichewa; Nyanja"',
- 'code2language("oc") eq "Occitan (post 1500)"',
- 'code2language("os") eq "Ossetian; Ossetic"',
- 'code2language("pi") eq "Pali"',
- '!defined code2language("sh")',             # Serbo-Croatian withdrawn
- 'code2language("se") eq "Sami"',
- 'code2language("sc") eq "Sardinian"',
- 'code2language("kw") eq "Cornish"',
- 'code2language("gv") eq "Manx"',
- 'code2language("lb") eq "Letzeburgesch"',
- 'code2language("he") eq "Hebrew"',
- '!defined code2language("iw")',             # Hebrew withdrawn
- 'code2language("id") eq "Indonesian"',
- '!defined code2language("in")',             # Indonesian withdrawn
- 'code2language("iu") eq "Inuktitut"',
- 'code2language("ug") eq "Uighur"',
- '!defined code2language("ji")',             # Yiddish withdrawn
- 'code2language("yi") eq "Yiddish"',
- 'code2language("za") eq "Zhuang"',
-
- #---- some successful examples -----------------------------------------
- 'code2language("DA") eq "Danish"',
- 'code2language("eo") eq "Esperanto"',
- 'code2language("fi") eq "Finnish"',
- 'code2language("en") eq "English"',
- 'code2language("aa") eq "Afar"',            # first in DATA segment
- 'code2language("zu") eq "Zulu"',            # last in DATA segment
-
-       #================================================
-       # TESTS FOR language2code
-       #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined language2code()',                 # no argument => undef returned
- '!defined language2code(undef)',            # undef arg   => undef returned
- '!defined language2code("Banana")',         # illegal lang name => undef
-
- #---- some successful examples -----------------------------------------
- 'language2code("Japanese")  eq "ja"',
- 'language2code("japanese")  eq "ja"',
- 'language2code("japanese")  ne "jp"',
- 'language2code("French")    eq "fr"',
- 'language2code("Greek")     eq "el"',
- 'language2code("english")   eq "en"',
- 'language2code("ESTONIAN")  eq "et"',
- 'language2code("Afar")      eq "aa"',       # first in DATA segment
- 'language2code("Zulu")      eq "zu"',       # last in DATA segment
-);
-
-print "1..", int(@TESTS), "\n";
-
-$testid = 1;
-foreach $test (@TESTS)
-{
-    eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
-    print "not ok $testid\n" if $@;
-    ++$testid;
-}
-
-exit 0;

diff --git a/t/lib/lc-maketext.t b/t/lib/lc-maketext.t
deleted file mode 100644 (file)
index 743d8ee..0000000
--- a/t/lib/lc-maketext.t
+++ /dev/null
@@ -1,37 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN { $| = 1; print "1..3\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Locale::Maketext 1.01;
-print "# Perl v$], Locale::Maketext v$Locale::Maketext::VERSION\n";
-$loaded = 1;
-print "ok 1\n";
-{
-  package Woozle;
-  @ISA = ('Locale::Maketext');
-  sub dubbil { return $_[1] * 2 }
-}
-{
-  package Woozle::elx;
-  @ISA = ('Woozle');
-  %Lexicon = (
-   'd2' => 'hum [dubbil,_1]',
-  );
-}
-
-$lh = Woozle->get_handle('elx');
-if($lh) {
-  print "ok 2\n";
-  my $x = $lh->maketext('d2', 7);
-  if($x eq "hum 14") {
-    print "ok 3\n";
-  } else {
-    print "not ok 3\n  (got \"$x\")\n";
-  }
-} else {
-  print "not ok 2\n";
-}
-#Shazam!

diff --git a/t/lib/lc-uk.t b/t/lib/lc-uk.t
deleted file mode 100644 (file)
index 948e2d1..0000000
--- a/t/lib/lc-uk.t
+++ /dev/null
@@ -1,70 +0,0 @@
-#!./perl
-#
-# uk.t - tests for Locale::Country with "uk" aliases to "gb"
-#
-
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-}
-
-use Locale::Country;
-
-Locale::Country::_alias_code('uk' => 'gb');
-
-#-----------------------------------------------------------------------
-# This is an array of tests. Each test is eval'd as an expression.
-# If it evaluates to FALSE, then "not ok N" is printed for the test,
-# otherwise "ok N".
-#-----------------------------------------------------------------------
-@TESTS =
-(
-       #================================================
-       # TESTS FOR code2country
-       #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined code2country()',                  # no argument
- '!defined code2country(undef)',             # undef argument
- '!defined code2country("zz")',              # illegal code
- '!defined code2country("ja")',              # should be jp for country
-
- #---- some successful examples -----------------------------------------
- 'code2country("BO") eq "Bolivia"',
- 'code2country("pk") eq "Pakistan"',
- 'code2country("sn") eq "Senegal"',
- 'code2country("us") eq "United States"',
- 'code2country("ad") eq "Andorra"',          # first in DATA segment
- 'code2country("zw") eq "Zimbabwe"',         # last in DATA segment
- 'code2country("uk") eq "United Kingdom"',   # normally "gb"
-
-       #================================================
-       # TESTS FOR country2code
-       #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined country2code()',                  # no argument
- '!defined country2code(undef)',             # undef argument
- '!defined country2code("Banana")',          # illegal country name
-
- #---- some successful examples -----------------------------------------
- 'country2code("japan")          eq "jp"',
- 'country2code("japan")          ne "ja"',
- 'country2code("Japan")          eq "jp"',
- 'country2code("United States")  eq "us"',
- 'country2code("United Kingdom") eq "uk"',
- 'country2code("Andorra")        eq "ad"',    # first in DATA segment
- 'country2code("Zimbabwe")       eq "zw"',    # last in DATA segment
-);
-
-print "1..", int(@TESTS), "\n";
-
-$testid = 1;
-foreach $test (@TESTS)
-{
-    eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
-    print "not ok $testid\n" if $@;
-    ++$testid;
-}
-
-exit 0;

diff --git a/t/lib/mbimbf.t b/t/lib/mbimbf.t
deleted file mode 100644 (file)
index 3948102..0000000
--- a/t/lib/mbimbf.t
+++ /dev/null
@@ -1,214 +0,0 @@
-#!/usr/bin/perl -w
-
-# test accuracy, precicion and fallback, round_mode
-
-use strict;
-use Test;
-
-BEGIN 
-  {
-  $| = 1;
-  # chdir 't' if -d 't';
-  unshift @INC, '../lib'; # for running manually
-  plan tests => 103;
-  }
-
-use Math::BigInt;
-use Math::BigFloat;
-
-my ($x,$y,$z,$u);
-
-###############################################################################
-# test defaults and set/get
-
-ok_undef ($Math::BigInt::accuracy);
-ok_undef ($Math::BigInt::precision);
-ok ($Math::BigInt::div_scale,40);
-ok (Math::BigInt::round_mode(),'even');
-ok ($Math::BigInt::rnd_mode,'even');
-
-ok_undef ($Math::BigFloat::accuracy);
-ok_undef ($Math::BigFloat::precision);
-ok ($Math::BigFloat::div_scale,40);
-ok ($Math::BigFloat::rnd_mode,'even');
-
-# accuracy
-foreach (qw/5 42 -1 0/)
-  {
-  ok ($Math::BigFloat::accuracy = $_,$_);
-  ok ($Math::BigInt::accuracy = $_,$_);
-  }
-ok_undef ($Math::BigFloat::accuracy = undef);
-ok_undef ($Math::BigInt::accuracy = undef);
-
-# precision
-foreach (qw/5 42 -1 0/)
-  {
-  ok ($Math::BigFloat::precision = $_,$_);
-  ok ($Math::BigInt::precision = $_,$_);
-  }
-ok_undef ($Math::BigFloat::precision = undef);
-ok_undef ($Math::BigInt::precision = undef);
-
-# fallback
-foreach (qw/5 42 1/)
-  {
-  ok ($Math::BigFloat::div_scale = $_,$_);
-  ok ($Math::BigInt::div_scale = $_,$_);
-  }
-# illegal values are possible for fallback due to no accessor
-
-# round_mode
-foreach (qw/odd even zero trunc +inf -inf/)
-  {
-  ok ($Math::BigFloat::rnd_mode = $_,$_);
-  ok ($Math::BigInt::rnd_mode = $_,$_);
-  }
-$Math::BigFloat::rnd_mode = 4;
-ok ($Math::BigFloat::rnd_mode,4);
-ok ($Math::BigInt::rnd_mode,'-inf');   # from above
-
-$Math::BigInt::accuracy = undef;
-$Math::BigInt::precision = undef;
-# local copies
-$x = Math::BigFloat->new(123.456);
-ok_undef ($x->accuracy());
-ok ($x->accuracy(5),5);
-ok_undef ($x->accuracy(undef),undef);
-ok_undef ($x->precision());
-ok ($x->precision(5),5);
-ok_undef ($x->precision(undef),undef);
-
-# see if MBF changes MBIs values
-ok ($Math::BigInt::accuracy = 42,42);
-ok ($Math::BigFloat::accuracy = 64,64);
-ok ($Math::BigInt::accuracy,42);               # should be still 42
-ok ($Math::BigFloat::accuracy,64);             # should be still 64
-
-###############################################################################
-# see if creating a number under set A or P will round it
-
-$Math::BigInt::accuracy = 4;
-$Math::BigInt::precision = 3;
-
-ok (Math::BigInt->new(123456),123500); # with A
-$Math::BigInt::accuracy = undef;
-ok (Math::BigInt->new(123456),123000); # with P
-
-$Math::BigFloat::accuracy = 4;
-$Math::BigFloat::precision = -1;
-$Math::BigInt::precision = undef;
-
-ok (Math::BigFloat->new(123.456),123.5);       # with A
-$Math::BigFloat::accuracy = undef;
-ok (Math::BigFloat->new(123.456),123.5);       # with P from MBF, not MBI!
-
-$Math::BigFloat::precision = undef;
-
-###############################################################################
-# see if setting accuracy/precision actually rounds the number
-
-$x = Math::BigFloat->new(123.456); $x->accuracy(4);   ok ($x,123.5);
-$x = Math::BigFloat->new(123.456); $x->precision(-2); ok ($x,123.46);
-
-$x = Math::BigInt->new(123456);    $x->accuracy(4);   ok ($x,123500);
-$x = Math::BigInt->new(123456);    $x->precision(2);  ok ($x,123500);
-
-###############################################################################
-# test actual rounding via round()
-
-$x = Math::BigFloat->new(123.456);
-ok ($x->copy()->round(5,2),123.46);
-ok ($x->copy()->round(4,2),123.5);
-ok ($x->copy()->round(undef,-2),123.46);
-ok ($x->copy()->round(undef,2),100);
-
-$x = Math::BigFloat->new(123.45000);
-ok ($x->copy()->round(undef,-1,'odd'),123.5);
-
-# see if rounding is 'sticky'
-$x = Math::BigFloat->new(123.4567);
-$y = $x->copy()->bround();             # no-op since nowhere A or P defined
-
-ok ($y,123.4567);                      
-$y = $x->copy()->round(5,2);
-ok ($y->accuracy(),5);
-ok_undef ($y->precision());            # A has precedence, so P still unset
-$y = $x->copy()->round(undef,2);
-ok ($y->precision(),2);
-ok_undef ($y->accuracy());             # P has precedence, so A still unset
-
-# does copy work?
-$x = Math::BigFloat->new(123.456); $x->accuracy(4); $x->precision(2);
-$z = $x->copy(); ok ($z->accuracy(),4); ok ($z->precision(),2);
-
-###############################################################################
-# test wether operations round properly afterwards
-# These tests are not complete, since they do not excercise every "return"
-# statement in the op's. But heh, it's better than nothing...
-
-$x = Math::BigFloat->new(123.456);
-$y = Math::BigFloat->new(654.321);
-$x->{_a} = 5;          # $x->accuracy(5) would round $x straightaway
-$y->{_a} = 4;          # $y->accuracy(4) would round $x straightaway
-
-$z = $x + $y;          ok ($z,777.8);
-$z = $y - $x;          ok ($z,530.9);
-$z = $y * $x;          ok ($z,80780);
-$z = $x ** 2;          ok ($z,15241);
-$z = $x * $x;          ok ($z,15241);
-# not yet: $z = -$x;           ok ($z,-123.46); ok ($x,123.456);
-$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62);
-$x = Math::BigFloat->new(123456); $x->{_a} = 4;
-$z = $x->copy; $z++;   ok ($z,123500);
-
-$x = Math::BigInt->new(123456);
-$y = Math::BigInt->new(654321);
-$x->{_a} = 5;          # $x->accuracy(5) would round $x straightaway
-$y->{_a} = 4;          # $y->accuracy(4) would round $x straightaway
-
-$z = $x + $y;          ok ($z,777800);
-$z = $y - $x;          ok ($z,530900);
-$z = $y * $x;          ok ($z,80780000000);
-$z = $x ** 2;          ok ($z,15241000000);
-# not yet: $z = -$x;           ok ($z,-123460); ok ($x,123456);
-$z = $x->copy; $z++;   ok ($z,123460);
-$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62000);
-
-###############################################################################
-# test mixed arguments
-
-$x = Math::BigFloat->new(10);
-$u = Math::BigFloat->new(2.5);
-$y = Math::BigInt->new(2);
-
-$z = $x + $y; ok ($z,12); ok (ref($z),'Math::BigFloat');
-$z = $x / $y; ok ($z,5); ok (ref($z),'Math::BigFloat');
-$z = $u * $y; ok ($z,5); ok (ref($z),'Math::BigFloat');
-
-$y = Math::BigInt->new(12345);
-$z = $u->copy()->bmul($y,2,0,'odd'); ok ($z,31000);
-$z = $u->copy()->bmul($y,3,0,'odd'); ok ($z,30900);
-$z = $u->copy()->bmul($y,undef,0,'odd'); ok ($z,30863);
-$z = $u->copy()->bmul($y,undef,1,'odd'); ok ($z,30860);
-$z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
-
-# breakage:
-# $z = $y->copy()->bmul($u,2,0,'odd'); ok ($z,31000);
-# $z = $y * $u; ok ($z,5); ok (ref($z),'Math::BigInt');
-# $z = $y + $x; ok ($z,12); ok (ref($z),'Math::BigInt');
-# $z = $y / $x; ok ($z,0); ok (ref($z),'Math::BigInt');
-
-# all done
-
-###############################################################################
-# Perl 5.005 does not like ok ($x,undef)
-
-sub ok_undef
-  {
-  my $x = shift;
-
-  ok (1,1) and return if !defined $x;
-  ok ($x,'undef');
-  }
-

diff --git a/t/lib/md5-aaa.t b/t/lib/md5-aaa.t
deleted file mode 100644 (file)
index f3f3202..0000000
--- a/t/lib/md5-aaa.t
+++ /dev/null
@@ -1,552 +0,0 @@
-BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-}
-
-use strict;
-print "1..256\n";
-
-use Digest::MD5 qw(md5_hex);
-
-my $Is_EBCDIC = ord('A') == 193;
-
-my $testno = 0;
-while (<DATA>) {
-    if (!$Is_EBCDIC) {
-       next if /^EBCDIC/;
-    }
-    else {
-       next if !/^EBCDIC/;
-       s/^EBCDIC,\w+#//;
-   }
-   my($hexdigest, $message) = split;
-   $message =~ s/\"//g;
-
-   my $failed;
-   $failed++ unless md5_hex($message) eq $hexdigest;
-   $failed++ unless Digest::MD5->new->add(split(//, $message))->digest
-                                              eq pack("H*", $hexdigest);
-
-   print "not " if $failed;
-   print "ok ", ++$testno, "\n";
-}
-
-
-
-# This data was generated with:
-#
-# perl -e 'for (1..256) { system("md5sum --string=" . ("a" x $_)); }'
-#
-__END__
-0cc175b9c0f1b6a831c399e269772661  "a"
-4124bc0a9335c27f086f24ba207a4912  "aa"
-47bce5c74f589f4867dbd57e9ca9f808  "aaa"
-74b87337454200d4d33f80c4663dc5e5  "aaaa"
-594f803b380a41396ed63dca39503542  "aaaaa"
-0b4e7a0e5fe84ad35fb5f95b9ceeac79  "aaaaaa"
-5d793fc5b00a2348c3fb9ab59e5ca98a  "aaaaaaa"
-3dbe00a167653a1aaee01d93e77e730e  "aaaaaaaa"
-552e6a97297c53e592208cf97fbb3b60  "aaaaaaaaa"
-e09c80c42fda55f9d992e59ca6b3307d  "aaaaaaaaaa"
-d57f21e6a273781dbf8b7657940f3b03  "aaaaaaaaaaa"
-45e4812014d83dde5666ebdf5a8ed1ed  "aaaaaaaaaaaa"
-c162de19c4c3731ca3428769d0cd593d  "aaaaaaaaaaaaa"
-451599a5f9afa91a0f2097040a796f3d  "aaaaaaaaaaaaaa"
-12f9cf6998d52dbe773b06f848bb3608  "aaaaaaaaaaaaaaa"
-23ca472302f49b3ea5592b146a312da0  "aaaaaaaaaaaaaaaa"
-88e42e96cc71151b6e1938a1699b0a27  "aaaaaaaaaaaaaaaaa"
-2c60c24e7087e18e45055a33f9a5be91  "aaaaaaaaaaaaaaaaaa"
-639d76897485360b3147e66e0a8a3d6c  "aaaaaaaaaaaaaaaaaaa"
-22d42eb002cefa81e9ad604ea57bc01d  "aaaaaaaaaaaaaaaaaaaa"
-bd049f221af82804c5a2826809337c9b  "aaaaaaaaaaaaaaaaaaaaa"
-ff49cfac3968dbce26ebe7d4823e58bd  "aaaaaaaaaaaaaaaaaaaaaa"
-d95dbfee231e34cccb8c04444412ed7d  "aaaaaaaaaaaaaaaaaaaaaaa"
-40edae4bad0e5bf6d6c2dc5615a86afb  "aaaaaaaaaaaaaaaaaaaaaaaa"
-a5a8bfa3962f49330227955e24a2e67c  "aaaaaaaaaaaaaaaaaaaaaaaaa"
-ae791f19bdf77357ff10bb6b0e97e121  "aaaaaaaaaaaaaaaaaaaaaaaaaa"
-aaab9c59a88bf0bdfcb170546c5459d6  "aaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b0f0545856af1a340acdedce23c54b97  "aaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-f7ce3d7d44f3342107d884bfa90c966a  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-59e794d45697b360e18ba972bada0123  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-3b0845db57c200be6052466f87b2198a  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-5eca9bd3eb07c006cd43ae48dfde7fd3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b4f13cb081e412f44e99742cb128a1a5  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-4c660346451b8cf91ef50f4634458d41  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-11db24dc3f6c2145701db08625dd6d76  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-80dad3aad8584778352c68ab06250327  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-1227fe415e79db47285cb2689c93963f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-8e084f489f1bdf08c39f98ff6447ce6d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-08b2f2b0864bac1ba1585043362cbec9  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-4697843037d962f62a5a429e611e0f5f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-10c4da18575c092b486f8ab96c01c02f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-af205d729450b663f48b11d839a1c8df  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-0d3f91798fac6ee279ec2485b25f1124  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-4c3c7c067634daec9716a80ea886d123  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-d1e358e6e3b707282cdd06e919f7e08c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-8c6ded4f0af86e0a7e301f8a716c4363  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-4c2d8bcb02d982d7cb77f649c0a2dea8  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-bdb662f765cd310f2a547cab1cfecef6  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-08ff5f7301d30200ab89169f6afdb7af  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-6eb6a030bcce166534b95bc2ab45d9cf  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-1bb77918e5695c944be02c16ae29b25e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b6fe77c19f0f0f4946c761d62585bfea  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-e9e7e260dce84ffa6e0e7eb5fd9d37fc  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-eced9e0b81ef2bba605cbc5e2e76a1d0  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-ef1772b6dff9a122358552954ad0df65  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-3b0c8ac703f828b04c6c197006d17218  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-652b906d60af96844ebd21b674f35e93  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-dc2f2f2462a0d72358b2f99389458606  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-762fc2665994b217c52c3c2eb7d9f406  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-cc7ed669cf88f201c3297c6a91e1d18d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-cced11f7bbbffea2f718903216643648  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-24612f0ce2c9d2cf2b022ef1e027a54f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b06521f39153d618550606be297466d5  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-014842d480b571495a4a0363793f7367  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-c743a45e0d2e6a95cb859adae0248435  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-def5d97e01e1219fb2fc8da6c4d6ba2f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-92cb737f8687ccb93022fdb411a77cca  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-a0d1395c7fb36247bfe2d49376d9d133  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-ab75504250558b788f99d1ebd219abf2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-0f5c6c4e740bfcc08c3c26ccb2673d46  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-cddd19bec7f310d8c87149ef47a1828f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-96b39b8b95e016c79d104d83395b8133  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-f1fc0b14ff8fa674b02344577e23eeb1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-0e8d28a1cafa3ffcff22afd480cce7d8  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-448539ffc17e1e81005b65581855cef4  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-61e39aae7c53e6e77db2e4405d9fb157  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-618a426895ee6133a372bebd1129b63e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-046c90690c9e36578b9d4a7e1d249c75  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-aadab38075c43296ee7e12466ebb03e3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b15af9cdabbaea0516866a33d8fd0f98  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-986e6938ed767a8ae9530eef54bfe5f1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-7ae25a72b71a42ccbc5477fd989cd512  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-98d34e50d4aa7a893cc7919a91acb0e3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-3fc53fc22ea40f1a0afd78fc2cd9aa0f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-923e37c738b9d7b1526f70b65229cc3d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b3966b7a08e5d46fd0774b797ba78dc2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-f50c7286b540bb181db1d6e05a51a296  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-4efd6c8826e65a61f82af954d431b59b  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-ef1031e79e7a15a4470a5e98b23781b5  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-067876bfd0df0f4c5002780ec85e6f8c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-789851dfa4c03563e9cef5f7bc050a7e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-baf934720818ee49477e74fc644faa5e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-9a0ea77ca26d2c121ddcc179edb76308  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-20c825561572e33d026f99ddfd999538  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-464c461455c5a927079a13609c20b637  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-cf37d42f89b6adb0e1a9e99104501b82  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-d266af45e3d06b70d9f52e2df4344186  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-f8b59fa22eb0ba944e2b7aa24d67b681  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-0918d7c2f9062743450a86eae9dde1a3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-36a92cc94a9e0fa21f625f8bfb007adf  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-681d73898dad5685d48b5e8438bc3a66  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-337ccef058459c3c16411381778da0c4  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-6ccdfcc742862036ce07583633c5f77e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-ddfa1adc974649dc5b414be86def7457  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-650ebc28ad85f11aa4b63b6ee565b89d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-e4571793bcaba284017eeabd8df85697  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-4fc040d354ad9ba5e4f62862109d3e17  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-25814274e02aa7cc03d6314eb703e655  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-11378ecaee0089c840d26352704027e3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-86f950bfcd824d5546da01c40576db31  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-089f243d1e831c5879aa375ee364a06e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-9146ef3527c7cfcc66dc615c3986e391  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-d727cfdfc9ed0347e6917a68b982f7bc  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-da8f45e1fdc12deecfe56aeb5288796e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-29cfcf52d8250a253a535cf7989c7bd2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-0f6eb555b8e3c35411eebe9348594193  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-a922439f963e7e59040e4756992c6f1b  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-81f8453cf3f7e5ee5479c777e5a8d80c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-8a7bd0732ed6a28ce75f6dabc90e1613  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-5f61c0ccad4cac44c75ff505e1f1e537  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-f6acfca2d47c87f2b14ca038234d3614  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-269fc62c517f3d55c368152addca57e7  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-50587cb16413da779b35508018721647  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-5e4a3ecfdaa4636b84a39b6a7be7c047  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-c5339dc2af6bf595580281ffb07353f6  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-e51176a47347e167ed0ed766b6de1a0c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-020406e1d05cdc2aa287641f7ae2cc39  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-e510683b3f5ffe4093d021808bc6ff70  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b325dc1c6f5e7a2b7cf465b9feab7948  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-e016e4ccc7fdaea56fc377600b58c4cb  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-3870ec709d2fc64b255d65be3123ad69  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-a92bde1f862c3fe797ecd69510bbd266  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-04daa146f3a2256fdcbf015c0f67e168  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-3d13c8bf627421ccc937aa1c9ac87bf1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-247dc7ffc545e4dda64ae12def481c4e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-2dfd4def392ee9563241b7db7eb7c346  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-d11a18a4743a1a0a699d1704efb74a0d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-55b62fabd9c77d44d86e992eeeb093e6  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-9a72cf7d0bd5ae2907c79f91837e3ced  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-d3828cce1835534475029202ebd799e4  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b0bebbf0015658d4740679f263a3f01f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-02368ebf1f53bc4634211b1693021666  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-04960f7d18960e348372949e4baa9752  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-c6041e7a86d407e9402b175670519260  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-439fd4c056bec1d14acd393746f6ae59  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-81a855120e04494c5a6c874a2360fd57  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-ef57bd47a964dc3aadd959c4131e64ac  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-0b0ab27b16cbba267c141fe0f4ee9189  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-abccd84f340bfe4ba59095cc3d5ca6ad  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-bc620e8c15265f195c8818e2f3e3c58b  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-fdcd84c4143286f6fc70c69208acd18d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-50e05071e773b1e9f3009a4a559ce6b2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-9e69c7a6c1863fbba2532f09ba665bde  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-47a962111aa5187eeef3d17a278d95f2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-c13e57e33526bc713b5a1825f92651bc  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-72b392f15593e42404b38e5c889fa75e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-5327acd3278274265d44e22ccfc4042c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-930dcac6da160b2a4c51879da76d3417  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-41292c326f926f1534ead47fe302f0a0  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-2bdecb5cf6b69a00f7832299ef2fb5a5  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-8bf93e9e8a3e4396de3f211c788e177e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-eea9cb566e19d6a7f55fbae78d94ef2a  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-3b8452700a829dec78397aa5c0458dd3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-7950059f699eaea1e0a1759340d7c153  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-40840c5f1de00f17a8e70d5bd4d00af2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-80f86f6af38be9ca8e40c2dc44491a0a  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-7aab2c2e72c77163e7102412dc332125  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-bfd6869ae2ee2fe2675846d341eaa67d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-7e4d976f6d552d1d5bac7e2693dc8759  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-37d9884c32abfc6f372ee899434e64ad  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-e362cd83a4b49d81ac6788b7839a56fd  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-9203cbb93b25d80b9d1b75e3c6c4b0dc  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-77441eda11554ec5b915d942605f66ed  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-e0fe0c02b5c9c5afe10ab9d6a3769efe  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-cc7682cf11b214e928f3df899772e789  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-ade0901d347afb25ecf9df4955bb8061  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-987379587cbe8e94b7057269232ff826  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-fd44a60101b04b7ddbc2b4e9b509ca1f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-53107a7f1e6f13a2e63239b6f2bf0ef1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-0b82cdd562f26aaa2459610a7ba8cd76  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-79f12de7255e9c8c0ec9a9be45ee6210  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-92338d8de02ed7aa8b3adc9120b94e71  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-8fc48efda580fce85b8705d540e8382e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-63642b027ee89938c922722650f2eb9b  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-fe54daa473502e9cc2c26dd66d564eab  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b90f3d4b7dcd8cdd8d96cb14695f4793  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-3e73392e7a03bca45b67650d79a8fc63  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-7fe51f2642dffbabc33eea2fcc2039ba  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-bc33790e52f99718cf920329961ee753  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-54d1e41ebac5db7886f01ab0afb65b17  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-16e2824f7a3f00ef0028994182071953  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-234c07907df5019d5f40f03936939bce  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-8ea3af1d9476fa0b6c04ce4f3a336c03  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-e95b69eae07d498d484afc771d1c45fc  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-f22a673abbc4372544ba37b51a5f5a91  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-7e6161eb1be7b06928c536fada91b7f1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-4dfe3c301e88fff67822e1cfcfece43f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-edda210ac6645fbf5815eb4c58821f6d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-6a514de2bf1926129b08f9234cd0115e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-887f30b43b2867f4a9accceee7d16e6c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-15936442c22dab9b685de350bfe75971  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-281a39e10bab29f1f2dead149a1f3f87  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-04d5f8a53b0eeda82d3c0ccafd02c98e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-a91e6b80fe9d6db74fac76c7a67f065a  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-30334486fa9841044afb07f2573107a5  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-0183c0cf15a3c2ed97d326f421b6d62c  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-4dc2a01b2161653753019b5228f765f8  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-71ef2dbdec7f78005354abebbfec8d8f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-a1d1cd1446c113726ba50cc86d8b6519  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-ed6da79cfd13ece051c4cb7c88e80c2e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-d2047852ce178d4ddb7978da3883f9c5  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-d75382e07dd096b618faeeac033eefff  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-3fb48e286d462dcc237c3335aa63ba14  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-55b959972677ea06c4d0e32f7fb2f10a  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-0a479c3623cfb9745e54d3376d0b9ae2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-7825ad1ba19db7eec57d88b16936f32f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-833ccf25509cb423a4aa98accb15512d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-cae9609b05a9782610a5a43d7cd4b8ff  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-6c303e1da7f8a3032d13fe995847a722  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-4c47143a568e30ecde86dafe3bcb0558  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-9c48f0592f504b86360cfb6de00203b3  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-e1524f5686f170209366f9723880d9b0  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-a96164a43a192543d40e538b9e9e4ece  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b774a4f788458a60e131d998705e4a06  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-1e97f0a7dfd3fac6ae585acdcf51a549  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b6364c77b6dd495c2a7f6b0211ac6fce  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-5d22315e78df2bc4146aa66f6c405dbb  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-2a773d5b04e910612543a42deeaaaa62  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-0165449ac66b086accdec3051e0b691e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-54884ba571054eae72b2a5271828a1fc  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-520fb61f8625ea916d72a54a37937bc6  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-7717f05d6e424a2c7a20ab7977b21ec8  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b64e4f62e3e14317e3a90f9ff2cde576  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-a49128259cfe50ba3bed80bbd11add7f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b10cb153b79c2e4af6a8431c265aa82d  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-2e50fee6f574241042bdfabfdd46a153  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-5d5656a09b98c24edd01c530d3aad5e2  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-5ac1e1609d82274371c349d5b7875298  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-b7b40d64ffccebd78abcf522376b3aae  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-8619933469d908a2d4a2d890909bea43  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-591a0ee6dccd872b46ae184eb0f9450e  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-8cd256a02c8c5c1676e9220e655d9ac4  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-e48c0e2ed3e4e299a6e62e5416eb6d83  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-f30f75dce71e757ee562218c1efa0645  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-06bd7e90c0410dacb155732cf956f520  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-531a0a821a9304c215f1829b880306f1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-93f4621c0b88499297ec3f8fbb3fb9c4  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-6af3d61e2e3ef8e189cffbea802c7e69  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-df84d21c884f99d6764d9bca4dec26e1  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-1bdbdf1c9087c796394bcda5789f7206  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-21f5b107cda33036590a19419afd7fb6  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-0eae304c738191613302fb6721ea3605  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-abed9cdef66dcec954b87124ba18c1ab  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-dfde09457e2017e31d4ecfaea010db8f  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-46bc249a5a8fc5d622cf12c42c463ae0  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-81109eec5aa1a284fb5327b10e9c16b9  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#cd25041f9f36811b04ab3015805fe816 "a"
-EBCDIC,1047#762b8b87733ee724b8cb751c3b956ea7 "aa"
-EBCDIC,1047#f39105ec557abe624399862897a127ed "aaa"
-EBCDIC,1047#b825cfc3203d45d01156b8e06ae74901 "aaaa"
-EBCDIC,1047#a497a05975af505878aa98b26bd329dd "aaaaa"
-EBCDIC,1047#90420f3fc7d64c6cdd7a3bf218b004b1 "aaaaaa"
-EBCDIC,1047#b3d7a168407b1613f08f186dc3744a72 "aaaaaaa"
-EBCDIC,1047#b7b4ab251d9cc8dc9fc562272a1c7f44 "aaaaaaaa"
-EBCDIC,1047#eb974f5cd9b8100dad8e9b82bbdb4a7a "aaaaaaaaa"
-EBCDIC,1047#cd675880a60d9c2095fe48981959ea5b "aaaaaaaaaa"
-EBCDIC,1047#8396c227248d77e1ebb478b4c44ee8e8 "aaaaaaaaaaa"
-EBCDIC,1047#ae59cf65c1c722b8ea6f6e770b20315f "aaaaaaaaaaaa"
-EBCDIC,1047#d1550adc6c6f2baeb5da9e2acd75eea1 "aaaaaaaaaaaaa"
-EBCDIC,1047#bddd60dbf174785c39827c71ecb29706 "aaaaaaaaaaaaaa"
-EBCDIC,1047#d0ef1bc67b2d761513ad8c1f92ca7a2b "aaaaaaaaaaaaaaa"
-EBCDIC,1047#dd613bdc90e1e71e57e40931cf3803c1 "aaaaaaaaaaaaaaaa"
-EBCDIC,1047#3810ed84a3fabf136b9f5c2de3c802ca "aaaaaaaaaaaaaaaaa"
-EBCDIC,1047#a41d584a36ba74526057338e4240b31d "aaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#e361a7b2e6adb9df91ed794f39c31a8f "aaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#dc089d8d25773e879ce759357394f63b "aaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#096bdd77ddd6393b5ff2878813ebc9c3 "aaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#e457d06769e51e7b34314c1fa885534b "aaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#ae3399b847ef9ce11d958a8926afa2a3 "aaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#be65d5ac6ebe81410cca55c2ad70e672 "aaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#108e4c3887db4178e5ea72782fb105d2 "aaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#d6ccc43d376b6ded51af488d1f56a872 "aaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#e208a35fdf88de1da8ec8411888b807e "aaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#bf09c576c720c32342308fae413347ae "aaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#aac629ca1ec1d5908fe85d6eeb352765 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#845a64111840e9db26e8f5032d59187d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#db38d8cf4f7037e6a150cc35e385972c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#2586f6fcb6ffb1578a94f8c9c2944b40 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#cb63decd219ee21068b330d321061434 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#d98cca1ccf230b2619ae6f452ab18325 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#f99e8a5e800a9c1b78b9c7181fa4113d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c60d314815b0d438fe8cf18a62d8680d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#1256f52d15ab93e69c75d6cc9986fa49 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#7e6b1236d08400ec5723b76f3b883b2a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#bae076b34373156e51196c8170fff549 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#b957a14baa9ab970516e5e3fe30560c5 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#8209c722c9d86984bde35f31e64de4c9 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#ad6abdadefb6809ef9db323939dad44e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#91ae6c863369dbfb13c688b9e5290929 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#770e940a6f11de3a3897031c7040573f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#2d07c71e6709d908992a19ee8fcd70c7 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#e748dc11e3b2984e0888782ecc9fa43f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#99573ce268b1f9e32e18319922380b2b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#68951bca944217c5a17d54d9fe296ee9 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#53addd1728c3fd60ba02e29ff7eac4d8 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#7c4abc37772402388c8d792351ae3163 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#a21011fb1a5c1f06dfc23c1b9b921506 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#5ce00db35364620dc75696426b9c7948 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#50a785cbcd6cb70322f32062bcfc8940 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#92e6ad1aa09ecde0becf66dc9f356549 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#bb769fed437ab5471f0453bdf0de6ca2 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#49d68b22125368b152dd80773b1053cd "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#8c7ce5f0c7ed40ec25df22b68d1725f3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#344d80c1906e9e728e0cc9703fc60803 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#630a45b11cc72d8e36aca0e180241cb4 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#1c9ba16c5be8d48b5d8fe1a8dd1b6999 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#74bb8337e8e9a3d114eb266437302949 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#134ddd06fa362804c9f8cf02111826bd "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#1ffd548f057ed474c0d3b53ee1f8ce1b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#487823e5089b40d8c66a6a7fc613c26c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#a40e0c6392e974bc6e258fb7530b9ec3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#dccf88078dcb7501156e17b6f5b90bd0 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#9012cdfe170301d3c8d11d9dab87bf96 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#046d4f6709367aa9be3452dc5dd03601 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#237b85d7be428836b0835e3f7411d0d0 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#32022ea076ffe7496da0b64b2482b963 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c68b3e8c7c88bf10003deaf652549f1c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#e648925002262503def112984215d21d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#192328de11913688d002f01326071abb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#42f7138b1f7ed2121098f3e418406e7b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#cb64c10607f961b2714a3b104e487838 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#0a8fb4023704d318e53a6047531477f3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#2c9a5487397c8245fe8a52684fa50554 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#26efb364f1da859fbc71744d2c62570e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#3359363d24960feaa2f05ea1b403ddcc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#be9304d0a6297a1a1c7b02cbf177fe0c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#badb0d02141d35349b3b2838cb6450cc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#75261d10ee76bfc016f98a868e535e49 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#d85006031896657b7215ed1f64f002b9 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#2db85d6ffa2287e42c0e55a72900dd4f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#f8ce69fabcf5d5013aaede9c90a7e4c0 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#5749ef4b7f6347c3cf9e8af2dc48093e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#afd1f87f6522f82f7d260909db38f84c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#690a229786930ec741404c83738f0e87 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#a1f02fbe5b1815f5d68ebfa5c5b8cdda "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4e75faba6d50d6f3341b3623f3457c83 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#af0eed7206c2aba4622b15a826b3cf48 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#984236c86e268a506dda56886d4589aa "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#256f33cc0cd5d0d700b959143f8b81fb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#a4f4a73bdf53bd03ec2bf406df8c5bf1 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#bac0c7bb84f581a8ca67e49ecb7eabdc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c1be2bc056a5abfff888f562f7420b8b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#6db1e154a0feeb290d6f9b6ca78b9faa "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#163fa1f68d79b511aa832e4d513c0d75 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#f00e90ba697aa55722c87b51652b515f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#ba925e3f1584bb930da28396334dfb06 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#6a43780f9f36e80e977d31e6ee055ccf "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#f07953ebdb37e911069ab4dc1d11b691 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#0f21a8a924546d121d479c2ae9b22788 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#6c857bf152348cc6a8d63ef4bb3a8b22 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#afc61c11e9730f9221e5b013cb75e36b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#7c762743838df21dbe61883325e4de3e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#a78d17621ef736358cf69909fe1841ae "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#687559a1f8bb2799d3f7e57ceb0f816e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#0a5eb0bcfc8888839b3b4f986e91db7c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#232c4a6355062f36d5b18a18453ba936 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#5ec9bdfb872d07265113dd94eaf7a9ea "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#f3c9f677ab5404ed16b029067a8d632f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#290997df4163f9f37994048b7f750ecb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#9d482b2d64d165eaf1796bddb15ffc43 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#f7e059c707e4156d59bef9c887731b75 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#dec244a8f0d45814f8968492cae063ae "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#a153d558a8bed15abe61d6de1345200c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c4c4155e9855435000915b9028af57ad "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#3bf4740880459875fc6625d3e8b9702b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#b73a90ab965e8254aeb1ed8995ccf551 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#143a255cfc206e135b23ed557c6b8c7d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#1600b994bf10eeb85772e0f5811ed661 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#7becfd6e439108f896d34012bc3c879f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#9fb1155e1c1529943d378bc79ce7248a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#210f27a4c085f4c50b119a9f530dbe64 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c03e534627aec7638f2ef7136a987afb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#056ff6dcf19eff62af1f7eaf68fdb868 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#78ebdbcbd1cf873ac5bc3317bc333d74 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#379ed8c06d6533b0ae397bd9bcc88727 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#68202ec0f97b3d04145ad8143b36bbec "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#f2e8c8f3ab9832adae73d6694b5aa6b5 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4dd0228d79bab138ae330137ceac9547 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#db509dc0a6d9a43323f200c3944fdd47 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#91e5620a3fbe4a7dbddc6328024f57e6 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#cebbeb507c5b8534898b394c3cb6dbab "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#eaa83adae76b4e5a38361a7943b2fc51 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#cf3fe145cdd9d906dff484591bebb099 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#5ee68f513d294e242dfd84066a489ad4 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#1452349d5b61efaf5f86f6c67ae1e67d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4a6d9c83bb7f0418977302f41861c674 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#1c82f764bc22e2b43aa64c86152576c5 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#94046ff34b09f2d5cd1ecc145f8b67f9 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#2f9b4413a963175dbf6c0e79fbafc13f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#fdcfd05667569a819bd43a32f3f0034c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#977ffabd477e827a170211d989121719 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#eb42e9022bad24209923768cd295da59 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#34daced153754389b0a3dd457aaa580f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4d4ac318fd2765150cdd3a1fd9046f76 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#5f3779e31d8b4ecc587ef2aa620990cb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#538a0f0a41a77491368d12d280b67ffc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#2b8bea1be2920657faea5d2f306df93e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#fdb162676ff37cafbb0b37f4a34e1f05 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#79b031eae2e5d593ad9e1765c1b32311 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#9a9d79d611f3f97dac3f1f16aeb95810 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#eca47f4f27f10c6e50bc02e96c1305e0 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c27a036a378a0c37e551623253de6c86 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#846248b2d8ba9a2845a5b5a6160ea043 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#37f6c0bb5c1c76a018bd92d6267d5f52 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c71638a87de7d0b7ff178235d368ca87 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c1769c2dafefeb4400d8aaaad7be13e2 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c2170ff8ba444a468ecc92c68e156876 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#87d372bb84572d2c33e910a8f39a46c3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#e198c2b2ad83adf6d2edb90918afb140 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#dc89c07be1a85973ce4a75fdd70b945f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#8213ffd54a231c594058b572f12ed2ce "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#64a275192c6bbaf330994498212ff235 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#e718b792be6311e0248a537ba6d5e84c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#b7ee2cd790ed748aa3ac632e2c30fe08 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#6a97471085d1e13858f7febbc8762a40 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#d82fa7cf3fe39751e88cc6a4c5ea0a80 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4d3ea68fdfb845be4aa12eef1868ac54 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#b24417be7632f1db1f37c00f2be59372 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#79f7f0088af39859c26e8dd422102e4a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#8e7c80a85e3a76bb83d81e12122d699c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#ffb596a208a1b81b17cf86e809ea9b15 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#a3e78c5e9bd595ea8457b25b7ae5ee7c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#200b9de7d5ebd0a74deb6d501fa9c273 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#75865e9d3111b6e17ba1e1b586c520e0 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#f13640a7b68db8d2bd853a95c371f4e7 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4525f0da220d5e730ad91070c819ca6a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#3f9c9eb19f1fd6aefeb3d736d5f37cbb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#e3344f64ba3436948b3de13081c98eb9 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#18b50889733a1e896e8fd2e460e98d7f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#918a86710bc529f44f022d5f891107a1 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4aaea2b4f2cfcfef3a5f6be8996b2a3e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#af899efcace3138fea64764015e265f6 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#d472112d115b9bfb34a65cc6683109fc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#f2a42d47b187fc7a250f771ebcda779b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#43442e458f65b5dc6b84181fb70f0e36 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#051771335f34ad905c1af28c429e23e2 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c2c23e86aac60a7d8cb2f2d9a011b525 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4276f514d2e9b5cf511a01b16d5bd7ad "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#43011a7d9ad322984e3617859eb37ee7 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#9b7e0d04de1c0121bd261a15cf9bb806 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#bc1e0269ae34e27ed0534a8ab5146324 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#85fa07daa4541779d7c8436a737802cf "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#5d1db871938d1dcc8a72509411dada31 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#e679a912e400a1c078e657be492a672c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#b17718a20096befcee63c2b55bbc5399 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4786015b6aa47e81752f4e2aa59061d5 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#7f3793d46edf449ce5800d568ef6e83f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#8f992f2bc222fdc9ecf86eb0c984948b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#aec900f38434e9fb7ded9d33f9a59b66 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#de3fe519c53310d2a8970a4ed2bcc937 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#02bf7d064c621689246886752ddc08bc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c306bdf0469814bf38b2cadc896489a3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#9f84e151ea29f14871b63454585cbc78 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#cc4fd08ed3768b08646bfa6c332a6156 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#d35126a1dc2ae4b93ac67a442961a752 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4c2ed17f95f823071289b94c7efe53f2 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#63e071ca26135f7e27d76fa57d015dbe "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4e506bd75c0d1391a0dd36adc18b3485 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#b8a9a5bf97ce5fc88a24c128bb75536e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#97e8bb790b164bc3bdb7189630748841 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#3c7a2d742d599f4fac9231c5264967ee "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#0483a8dc4b24d3d26f0d3bf0402486c5 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#86022bc208c5bbded89bbaeae88e6dbf "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c7a3f500cfe98f8c1959922b381b9438 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#bff3067df4cfff43007bea69f2380d6a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#e34a5c41f51ea6d1f1b187e90d940b59 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c8468cae7c8a2a999a0a164f68b759eb "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4bccb2bff1862782004398afff2289b4 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#9710683ca0b5cbf10c3df249bfa85d7a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#5a705ab132807ce9605b98444622abf3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#dd53ab3422160f933f9723cd3cb53b5a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#bad7e8a4aeea40f8642a0ca1cdfcc61b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#4c0df2b1456694b51a5c809f34f959a8 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#f330498cabce39dd03eb02d6c983281f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#915ff5f5c93e0a7833be8cc529108216 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#b8facb5253a2b7e091c0a6c18d48e368 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#8ebdd257c3bc052f9c837f90fb1879cf "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#42d2cf830ee626939580323a824a4099 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#0d364adcb48ee9db07828ce127355a0b "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#14d9170b8f9ead33ec4da94d66b6b74a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#0327eff7ae5d6b5966def78e593ff5f7 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#f08ac509f43f8e34008a65c3f47d29aa "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#7dc9cdc33fb9a0d70e1409357b086783 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#5f079c22e843c3426bcf03efbd0fc54d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#8422781e8a9390246920556090a9559d "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#0cc485a5c828b2cdc895f38b5c3b386e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#2259886c34c2e8adf2b3552bd47a3d6e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c96af44682d38aa7e4b86954c883f8dc "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#85bfdfeff05f7120bd5821ac6668694e "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#b4083c69629ec95f6397cd5844edaf90 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#666550654d7c9e6b8a3118d9dc64bace "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#eef83a6cad3d9a8d963d468cb037ccce "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c2fd346804a8c9c80a08312d7b9d17f3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#6521b944a119cd1f787ff75c1452db74 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#805638adfdb3bf9591fd28dfadba697a "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#e62d07301fd3c0bdb5f7ce0e49e4b5d3 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#49b46e007e0c79c047f655b1b46167c2 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#8811ec9d3b878d168975ed835b3acaa8 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#9b4e8b089d75d1fe3567bcc97b4379d5 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c279605bdcfee9b4976eb57a9eb0d5fd "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#3e362e6f8c5eb3aa7530ef9722dda11c "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-EBCDIC,1047#c54a2d44c8a73ab63d892b8b3d1c336f "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"

diff --git a/t/lib/md5-align.t b/t/lib/md5-align.t
deleted file mode 100644 (file)
index 4176062..0000000
--- a/t/lib/md5-align.t
+++ /dev/null
@@ -1,20 +0,0 @@
-BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-}
-
-# Test that md5 works on unaligned memory blocks
-
-print "1..1\n";
-
-use strict;
-use Digest::MD5 qw(md5_hex);
-
-my $str = "\100" x 20;
-substr($str, 0, 1, "");  # chopping off first char makes the string unaligned
-
-#use Devel::Peek; Dump($str); 
-
-print "not " unless md5_hex($str) eq "c7ebb510e59ee96f404f288d14cc656a";
-print "ok 1\n";
-

diff --git a/t/lib/md5-badf.t b/t/lib/md5-badf.t
deleted file mode 100644 (file)
index 63effdf..0000000
--- a/t/lib/md5-badf.t
+++ /dev/null
@@ -1,26 +0,0 @@
-BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-}
-
-# Digest::MD5 2.07 and older used to trigger a core dump when
-# passed an illegal file handle that failed to open.
-
-print "1..2\n";
-
-use Digest::MD5 ();
-
-$md5 = Digest::MD5->new;
-
-eval {
-   use vars qw(*FOO);
-   $md5->addfile(*FOO);
-};
-print "not " unless $@ =~ /^Bad filehandle: FOO/;
-print "ok 1\n";
-
-open(BAR, "none-existing-file.$$");
-$md5->addfile(*BAR);
-
-print "not " unless $md5->hexdigest eq "d41d8cd98f00b204e9800998ecf8427e";
-print "ok 2\n";

diff --git a/t/lib/md5-file.t b/t/lib/md5-file.t
deleted file mode 100644 (file)
index c786a5f..0000000
--- a/t/lib/md5-file.t
+++ /dev/null
@@ -1,150 +0,0 @@
-BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-}
-
-print "1..2\n";
-
-use strict;
-use Digest::MD5 qw(md5 md5_hex md5_base64);
-
-#
-# This is the output of: 'md5sum MD5.pm MD5.xs'
-#
-my $EXPECT;
-
-if (ord('A') == 193) { # EBCDIC
-$EXPECT = <<EOT;
-95a81f17a8e6c2273aecac12d8c4cb90  ext/Digest/MD5/MD5.pm
-9cecc5dbb27bd64b98f61f558b4db378  ext/Digest/MD5/MD5.xs
-EOT
-} else { # ASCII
-$EXPECT = <<EOT;
-3d0146bf194e4fe68733d00fba02a49e  ext/Digest/MD5/MD5.pm
-5526659171a63f532d990dd73791b60e  ext/Digest/MD5/MD5.xs
-EOT
-}
-
-my $B64 = 1;
-eval { require MIME::Base64; };
-if ($@) {
-    print $@;
-    print "# Will not test base64 methods\n";
-    $B64 = 0;
-}
-
-my $testno = 0;
-
-use File::Spec;
-
-for (split /^/, $EXPECT) {
-     my($md5hex, $file) = split ' ';
-     my @path = split(m:/:, $file);
-     my $last = pop @path;
-     my $path = File::Spec->updir;
-     while (@path) {
-        $path = File::Spec->catdir($path, shift @path);
-     }
-     $file = File::Spec->catfile($path, $last);
-     my $md5bin = pack("H*", $md5hex);
-     my $md5b64;
-     if ($B64) {
-        $md5b64 = MIME::Base64::encode($md5bin, "");
-        chop($md5b64); chop($md5b64);   # remove padding
-     }
-     my $failed;
-
-     if (digest_file($file, 'digest') ne $md5bin) {
-        print "$file: Bad digest\n";
-        $failed++;
-     }
-
-     if (digest_file($file, 'hexdigest') ne $md5hex) {
-        print "$file: Bad hexdigest\n";
-        $failed++;
-     }
-
-     if ($B64 && digest_file($file, 'b64digest') ne $md5b64) {
-        print "$file: Bad b64digest\n";
-        $failed++;
-     }
-
-     my $data = cat_file($file);
-     if (md5($data) ne $md5bin) {
-        print "$file: md5() failed\n";
-        $failed++;
-     }
-     if (md5_hex($data) ne $md5hex) {
-        print "$file: md5_hex() failed\n";
-        $failed++;
-     }
-     if ($B64 && md5_base64($data) ne $md5b64) {
-        print "$file: md5_base64() failed\n";
-        $failed++;
-     }
-
-     if (Digest::MD5->new->add($data)->digest ne $md5bin) {
-        print "$file: MD5->new->add(...)->digest failed\n";
-        $failed++;
-     }
-     if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) {
-        print "$file: MD5->new->add(...)->hexdigest failed\n";
-        $failed++;
-     }
-     if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) {
-        print "$file: MD5->new->add(...)->b64digest failed\n";
-        $failed++;
-     }
-
-     my @data = split //, $data;
-     if (md5(@data) ne $md5bin) {
-        print "$file: md5(\@data) failed\n";
-        $failed++;
-     }
-     if (Digest::MD5->new->add(@data)->digest ne $md5bin) {
-        print "$file: MD5->new->add(\@data)->digest failed\n";
-        $failed++;
-     }
-     my $md5 = Digest::MD5->new;
-     for (@data) {
-        $md5->add($_);
-     }
-     if ($md5->digest ne $md5bin) {
-        print "$file: $md5->add()-loop failed\n";
-        $failed++;
-     }
-
-     print "not " if $failed;
-     print "ok ", ++$testno, "\n";
-}
-
-
-sub digest_file
-{
-    my($file, $method) = @_;
-    $method ||= "digest";
-    #print "$file $method\n";
-
-    open(FILE, $file) or die "Can't open $file: $!";
-# Digests avove are generated on UNIX without CRLF
-# so leave handles in text mode
-#    binmode(FILE);
-    my $digest = Digest::MD5->new->addfile(*FILE)->$method();
-    close(FILE);
-
-    $digest;
-}
-
-sub cat_file
-{
-    my($file) = @_;
-    local $/;  # slurp
-    open(FILE, $file) or die "Can't open $file: $!";
-# Digests avove are generated on UNIX without CRLF
-# so leave handles in text mode
-#    binmode(FILE);
-    my $tmp = <FILE>;
-    close(FILE);
-    $tmp;
-}
-

diff --git a/t/lib/mimeb64.t b/t/lib/mimeb64.t
deleted file mode 100644 (file)
index 7a61fe9..0000000
--- a/t/lib/mimeb64.t
+++ /dev/null
@@ -1,383 +0,0 @@
-BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-}
-
-use MIME::Base64;
-
-print "1..283\n";
-
-print "# Testing MIME::Base64-", $MIME::Base64::VERSION, "\n";
-
-BEGIN {
- if (ord('A') == 41) {
-  *ASCII = sub { return $_[0] };
- }
- else {
-  require Encode;
-  *ASCII = sub { Encode::encode('ascii',$_[0]) };
- }
-}
-
-$testno = 1;
-
-encodeTest();
-decodeTest();
-
-# This used to generate a warning
-print "not " unless decode_base64(encode_base64("foo")) eq "foo";
-print "ok ", $testno++, "\n";
-
-sub encodeTest
-{
-    print "# encode test\n";
-
-    my @encode_tests = (
-       # All values
-       ["\000" => "AA=="],
-       ["\001" => "AQ=="],
-       ["\002" => "Ag=="],
-       ["\003" => "Aw=="],
-       ["\004" => "BA=="],
-       ["\005" => "BQ=="],
-       ["\006" => "Bg=="],
-       ["\007" => "Bw=="],
-       ["\010" => "CA=="],
-       ["\011" => "CQ=="],
-       ["\012" => "Cg=="],
-       ["\013" => "Cw=="],
-       ["\014" => "DA=="],
-       ["\015" => "DQ=="],
-       ["\016" => "Dg=="],
-       ["\017" => "Dw=="],
-       ["\020" => "EA=="],
-       ["\021" => "EQ=="],
-       ["\022" => "Eg=="],
-       ["\023" => "Ew=="],
-       ["\024" => "FA=="],
-       ["\025" => "FQ=="],
-       ["\026" => "Fg=="],
-       ["\027" => "Fw=="],
-       ["\030" => "GA=="],
-       ["\031" => "GQ=="],
-       ["\032" => "Gg=="],
-       ["\033" => "Gw=="],
-       ["\034" => "HA=="],
-       ["\035" => "HQ=="],
-       ["\036" => "Hg=="],
-       ["\037" => "Hw=="],
-       ["\040" => "IA=="],
-       ["\041" => "IQ=="],
-       ["\042" => "Ig=="],
-       ["\043" => "Iw=="],
-       ["\044" => "JA=="],
-       ["\045" => "JQ=="],
-       ["\046" => "Jg=="],
-       ["\047" => "Jw=="],
-       ["\050" => "KA=="],
-       ["\051" => "KQ=="],
-       ["\052" => "Kg=="],
-       ["\053" => "Kw=="],
-       ["\054" => "LA=="],
-       ["\055" => "LQ=="],
-       ["\056" => "Lg=="],
-       ["\057" => "Lw=="],
-       ["\060" => "MA=="],
-       ["\061" => "MQ=="],
-       ["\062" => "Mg=="],
-       ["\063" => "Mw=="],
-       ["\064" => "NA=="],
-       ["\065" => "NQ=="],
-       ["\066" => "Ng=="],
-       ["\067" => "Nw=="],
-       ["\070" => "OA=="],
-       ["\071" => "OQ=="],
-       ["\072" => "Og=="],
-       ["\073" => "Ow=="],
-       ["\074" => "PA=="],
-       ["\075" => "PQ=="],
-       ["\076" => "Pg=="],
-       ["\077" => "Pw=="],
-       ["\100" => "QA=="],
-       ["\101" => "QQ=="],
-       ["\102" => "Qg=="],
-       ["\103" => "Qw=="],
-       ["\104" => "RA=="],
-       ["\105" => "RQ=="],
-       ["\106" => "Rg=="],
-       ["\107" => "Rw=="],
-       ["\110" => "SA=="],
-       ["\111" => "SQ=="],
-       ["\112" => "Sg=="],
-       ["\113" => "Sw=="],
-       ["\114" => "TA=="],
-       ["\115" => "TQ=="],
-       ["\116" => "Tg=="],
-       ["\117" => "Tw=="],
-       ["\120" => "UA=="],
-       ["\121" => "UQ=="],
-       ["\122" => "Ug=="],
-       ["\123" => "Uw=="],
-       ["\124" => "VA=="],
-       ["\125" => "VQ=="],
-       ["\126" => "Vg=="],
-       ["\127" => "Vw=="],
-       ["\130" => "WA=="],
-       ["\131" => "WQ=="],
-       ["\132" => "Wg=="],
-       ["\133" => "Ww=="],
-       ["\134" => "XA=="],
-       ["\135" => "XQ=="],
-       ["\136" => "Xg=="],
-       ["\137" => "Xw=="],
-       ["\140" => "YA=="],
-       ["\141" => "YQ=="],
-       ["\142" => "Yg=="],
-       ["\143" => "Yw=="],
-       ["\144" => "ZA=="],
-       ["\145" => "ZQ=="],
-       ["\146" => "Zg=="],
-       ["\147" => "Zw=="],
-       ["\150" => "aA=="],
-       ["\151" => "aQ=="],
-       ["\152" => "ag=="],
-       ["\153" => "aw=="],
-       ["\154" => "bA=="],
-       ["\155" => "bQ=="],
-       ["\156" => "bg=="],
-       ["\157" => "bw=="],
-       ["\160" => "cA=="],
-       ["\161" => "cQ=="],
-       ["\162" => "cg=="],
-       ["\163" => "cw=="],
-       ["\164" => "dA=="],
-       ["\165" => "dQ=="],
-       ["\166" => "dg=="],
-       ["\167" => "dw=="],
-       ["\170" => "eA=="],
-       ["\171" => "eQ=="],
-       ["\172" => "eg=="],
-       ["\173" => "ew=="],
-       ["\174" => "fA=="],
-       ["\175" => "fQ=="],
-       ["\176" => "fg=="],
-       ["\177" => "fw=="],
-       ["\200" => "gA=="],
-       ["\201" => "gQ=="],
-       ["\202" => "gg=="],
-       ["\203" => "gw=="],
-       ["\204" => "hA=="],
-       ["\205" => "hQ=="],
-       ["\206" => "hg=="],
-       ["\207" => "hw=="],
-       ["\210" => "iA=="],
-       ["\211" => "iQ=="],
-       ["\212" => "ig=="],
-       ["\213" => "iw=="],
-       ["\214" => "jA=="],
-       ["\215" => "jQ=="],
-       ["\216" => "jg=="],
-       ["\217" => "jw=="],
-       ["\220" => "kA=="],
-       ["\221" => "kQ=="],
-       ["\222" => "kg=="],
-       ["\223" => "kw=="],
-       ["\224" => "lA=="],
-       ["\225" => "lQ=="],
-       ["\226" => "lg=="],
-       ["\227" => "lw=="],
-       ["\230" => "mA=="],
-       ["\231" => "mQ=="],
-       ["\232" => "mg=="],
-       ["\233" => "mw=="],
-       ["\234" => "nA=="],
-       ["\235" => "nQ=="],
-       ["\236" => "ng=="],
-       ["\237" => "nw=="],
-       ["\240" => "oA=="],
-       ["\241" => "oQ=="],
-       ["\242" => "og=="],
-       ["\243" => "ow=="],
-       ["\244" => "pA=="],
-       ["\245" => "pQ=="],
-       ["\246" => "pg=="],
-       ["\247" => "pw=="],
-       ["\250" => "qA=="],
-       ["\251" => "qQ=="],
-       ["\252" => "qg=="],
-       ["\253" => "qw=="],
-       ["\254" => "rA=="],
-       ["\255" => "rQ=="],
-       ["\256" => "rg=="],
-       ["\257" => "rw=="],
-       ["\260" => "sA=="],
-       ["\261" => "sQ=="],
-       ["\262" => "sg=="],
-       ["\263" => "sw=="],
-       ["\264" => "tA=="],
-       ["\265" => "tQ=="],
-       ["\266" => "tg=="],
-       ["\267" => "tw=="],
-       ["\270" => "uA=="],
-       ["\271" => "uQ=="],
-       ["\272" => "ug=="],
-       ["\273" => "uw=="],
-       ["\274" => "vA=="],
-       ["\275" => "vQ=="],
-       ["\276" => "vg=="],
-       ["\277" => "vw=="],
-       ["\300" => "wA=="],
-       ["\301" => "wQ=="],
-       ["\302" => "wg=="],
-       ["\303" => "ww=="],
-       ["\304" => "xA=="],
-       ["\305" => "xQ=="],
-       ["\306" => "xg=="],
-       ["\307" => "xw=="],
-       ["\310" => "yA=="],
-       ["\311" => "yQ=="],
-       ["\312" => "yg=="],
-       ["\313" => "yw=="],
-       ["\314" => "zA=="],
-       ["\315" => "zQ=="],
-       ["\316" => "zg=="],
-       ["\317" => "zw=="],
-       ["\320" => "0A=="],
-       ["\321" => "0Q=="],
-       ["\322" => "0g=="],
-       ["\323" => "0w=="],
-       ["\324" => "1A=="],
-       ["\325" => "1Q=="],
-       ["\326" => "1g=="],
-       ["\327" => "1w=="],
-       ["\330" => "2A=="],
-       ["\331" => "2Q=="],
-       ["\332" => "2g=="],
-       ["\333" => "2w=="],
-       ["\334" => "3A=="],
-       ["\335" => "3Q=="],
-       ["\336" => "3g=="],
-       ["\337" => "3w=="],
-       ["\340" => "4A=="],
-       ["\341" => "4Q=="],
-       ["\342" => "4g=="],
-       ["\343" => "4w=="],
-       ["\344" => "5A=="],
-       ["\345" => "5Q=="],
-       ["\346" => "5g=="],
-       ["\347" => "5w=="],
-       ["\350" => "6A=="],
-       ["\351" => "6Q=="],
-       ["\352" => "6g=="],
-       ["\353" => "6w=="],
-       ["\354" => "7A=="],
-       ["\355" => "7Q=="],
-       ["\356" => "7g=="],
-       ["\357" => "7w=="],
-       ["\360" => "8A=="],
-       ["\361" => "8Q=="],
-       ["\362" => "8g=="],
-       ["\363" => "8w=="],
-       ["\364" => "9A=="],
-       ["\365" => "9Q=="],
-       ["\366" => "9g=="],
-       ["\367" => "9w=="],
-       ["\370" => "+A=="],
-       ["\371" => "+Q=="],
-       ["\372" => "+g=="],
-       ["\373" => "+w=="],
-       ["\374" => "/A=="],
-       ["\375" => "/Q=="],
-       ["\376" => "/g=="],
-       ["\377" => "/w=="],
-
-       ["\000\377" => "AP8="],
-       ["\377\000" => "/wA="],
-       ["\000\000\000" => "AAAA"],
-
-        [''    => ''],
-       [ASCII('a')   => 'YQ=='],
-       [ASCII('aa')  => 'YWE='],
-       [ASCII('aaa') => 'YWFh'],
-
-       [ASCII('aaa') => 'YWFh'],
-       [ASCII('aaa') => 'YWFh'],
-       [ASCII('aaa') => 'YWFh'],
-
-
-       # from HTTP spec
-       [ASCII('Aladdin:open sesame') => 'QWxhZGRpbjpvcGVuIHNlc2FtZQ=='],
-
-       [ASCII('a') x 100 => 'YWFh' x 33 . 'YQ=='],
-
-       [ASCII('Multipurpose Internet Mail Extensions: The Base64 Content-Transfer-Encoding is designed to represent sequences of octets in a form that is not humanly readable. ')
-       => "TXVsdGlwdXJwb3NlIEludGVybmV0IE1haWwgRXh0ZW5zaW9uczogVGhlIEJhc2U2NCBDb250ZW50LVRyYW5zZmVyLUVuY29kaW5nIGlzIGRlc2lnbmVkIHRvIHJlcHJlc2VudCBzZXF1ZW5jZXMgb2Ygb2N0ZXRzIGluIGEgZm9ybSB0aGF0IGlzIG5vdCBodW1hbmx5IHJlYWRhYmxlLiA="],
-
-    );
-
-    for $test (@encode_tests) {
-       my($plain, $expected) = ($$test[0], $$test[1]);
-
-       my $encoded = encode_base64($plain, '');
-       if ($encoded ne $expected) {
-           print "test $testno ($plain): expected $expected, got $encoded\n";
-            print "not ";
-       }
-       my $decoded = decode_base64($encoded);
-       if ($decoded ne $plain) {
-           print "test $testno ($encoded): expected $plain, got $decoded\n";
-            print "not ";
-       }
-
-       if (ord('A') != 193) { # perl versions broken on EBCDIC
-       # Try the old Perl versions too
-       if ($encoded ne MIME::Base64::old_encode_base64($plain, '')) {
-           print "old_encode_base64 give different result.\n";
-           print "not ";
-        }
-       if ($plain ne MIME::Base64::old_decode_base64($encoded)) {
-           print "old_decode_base64 give different result.\n";
-           print "not ";
-        }
-       }
-               
-       print "ok $testno\n";
-       $testno++;
-    }
-}
-
-sub decodeTest
-{
-    print "# decode test\n";
-
-    local $SIG{__WARN__} = sub { print $_[0] };  # avoid warnings on stderr
-
-    my @decode_tests = (
-       ['YWE='   => ASCII('aa')],
-       [' YWE='  =>  ASCII('aa')],
-       ['Y WE='  =>  ASCII('aa')],
-       ['YWE= '  =>  ASCII('aa')],
-       ["Y\nW\r\nE=" =>  ASCII('aa')],
-
-       # These will generate some warnings
-        ['YWE=====' =>  ASCII('aa')],    # extra padding
-       ['YWE'      =>  ASCII('aa')],    # missing padding
-        ['YWFh====' =>  ASCII('aaa')],
-        ['YQ'       =>  ASCII('a')],
-        ['Y'        => ''],
-        ['x=='      => ''],
-        [''         => ''],
-        [undef()    => ''],
-    );
-
-    for $test (@decode_tests) {
-       my($encoded, $expected) = ($$test[0], $$test[1]);
-
-       my $decoded = decode_base64($encoded);
-       if ($decoded ne $expected) {
-           die "test $testno ($encoded): expected $expected, got $decoded\n";
-       }
-       print "ok $testno\n";
-       $testno++;
-    }
-}

diff --git a/t/lib/mimeb64u.t b/t/lib/mimeb64u.t
deleted file mode 100644 (file)
index 0b8df1a..0000000
--- a/t/lib/mimeb64u.t
+++ /dev/null
@@ -1,16 +0,0 @@
-BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-}
-
-print "1..1\n";
-
-require MIME::Base64;
-
-eval {
-    MIME::Base64::encode(v300);
-};
-
-print "not " unless $@;
-print "ok 1\n";
-

diff --git a/t/lib/mimeqp.t b/t/lib/mimeqp.t
deleted file mode 100755 (executable)
index 1a7f9e4..0000000
--- a/t/lib/mimeqp.t
+++ /dev/null
@@ -1,113 +0,0 @@
-BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-}
-
-use MIME::QuotedPrint;
-
-$x70 = "x" x 70;
-
-@tests =
-  (
-   # plain ascii should not be encoded
-   ["quoted printable"  =>
-    "quoted printable"],
-
-   # 8-bit chars should be encoded
-   ["v\xe5re kj\xe6re norske tegn b\xf8r \xe6res" =>
-    "v=E5re kj=E6re norske tegn b=F8r =E6res"],
-
-   # trailing space should be encoded
-   ["  " => "=20=20"],
-   ["\tt\t" => "\tt=09"],
-   ["test  \ntest\n\t \t \n" => "test=20=20\ntest\n=09=20=09=20\n"],
-
-   # "=" is special an should be decoded
-   ["=\n" => "=3D\n"],
-   ["\0\xff" => "=00=FF"],
-
-   # Very long lines should be broken (not more than 76 chars
-   ["The Quoted-Printable encoding is intended to represent data that largly consists of octets that correspond to printable characters in the ASCII character set." =>
-    "The Quoted-Printable encoding is intended to represent data that largly con=
-sists of octets that correspond to printable characters in the ASCII charac=
-ter set."
-    ],
-
-   # Long lines after short lines were broken through 2.01.
-   ["short line
-In America, any boy may become president and I suppose that's just one of the risks he takes. -- Adlai Stevenson" =>
-    "short line
-In America, any boy may become president and I suppose that's just one of t=
-he risks he takes. -- Adlai Stevenson"],
-
-   # My (roderick@argon.org) first crack at fixing that bug failed for
-   # multiple long lines.
-   ["College football is a game which would be much more interesting if the faculty played instead of the students, and even more interesting if the
-trustees played.  There would be a great increase in broken arms, legs, and necks, and simultaneously an appreciable diminution in the loss to humanity. -- H. L. Mencken" =>
-    "College football is a game which would be much more interesting if the facu=
-lty played instead of the students, and even more interesting if the
-trustees played.  There would be a great increase in broken arms, legs, and=
- necks, and simultaneously an appreciable diminution in the loss to humanit=
-y. -- H. L. Mencken"],
-
-   # Don't break a line that's near but not over 76 chars.
-   ["$x70!23"          => "$x70!23"],
-   ["$x70!234"         => "$x70!234"],
-   ["$x70!2345"                => "$x70!2345"],
-   ["$x70!23456"       => "$x70!23456"],
-   ["$x70!23\n"                => "$x70!23\n"],
-   ["$x70!234\n"       => "$x70!234\n"],
-   ["$x70!2345\n"      => "$x70!2345\n"],
-   ["$x70!23456\n"     => "$x70!23456\n"],
-
-   # Not allowed to break =XX escapes using soft line break
-   ["$x70===xxxx" => "$x70=3D=\n=3D=3Dxxxx"],
-   ["$x70!===xxx" => "$x70!=3D=\n=3D=3Dxxx"],
-   ["$x70!!===xx" => "$x70!!=3D=\n=3D=3Dxx"],
-   ["$x70!!!===x" => "$x70!!!=\n=3D=3D=3Dx"],
-   #                            ^
-   #                    70123456|
-   #                           max
-   #                        line width
-);
-
-$notests = @tests + 2;
-print "1..$notests\n";
-
-$testno = 0;
-for (@tests) {
-    $testno++;
-    ($plain, $encoded) = @$_;
-    if (ord('A') == 193) {  # EBCDIC 8 bit chars are different
-        if ($testno == 2) { $plain =~ s/\xe5/\x47/; $plain =~ s/\xe6/\x9c/g; $plain =~ s/\xf8/\x70/; }
-        if ($testno == 7) { $plain =~ s/\xff/\xdf/; }
-    }
-    $x = encode_qp($plain);
-    if ($x ne $encoded) {
-       print "Encode test failed\n";
-       print "Got:      '$x'\n";
-       print "Expected: '$encoded'\n";
-       print "not ok $testno\n";
-       next;
-    }
-    $x = decode_qp($encoded);
-    if ($x ne $plain) {
-       print "Decode test failed\n";
-       print "Got:      '$x'\n";
-       print "Expected: '$plain'\n";
-       print "not ok $testno\n";
-       next;
-    }
-    print "ok $testno\n";
-}
-
-# Some extra testing for a case that was wrong until libwww-perl-5.09
-print "not " unless decode_qp("foo  \n\nfoo =\n\nfoo=20\n\n") eq
-                                "foo\n\nfoo \nfoo \n\n";
-$testno++; print "ok $testno\n";
-
-# Same test but with "\r\n" terminated lines
-print "not " unless decode_qp("foo  \r\n\r\nfoo =\r\n\r\nfoo=20\r\n\r\n") eq
-                                "foo\r\n\r\nfoo \r\nfoo \r\n\r\n";
-$testno++; print "ok $testno\n";
-

diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t
deleted file mode 100755 (executable)
index cb975e0..0000000
--- a/t/lib/ndbm.t
+++ /dev/null
@@ -1,420 +0,0 @@
-#!./perl
-
-# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bNDBM_File\b/) {
-       print "1..0 # Skip: NDBM_File was not built\n";
-       exit 0;
-    }
-}
-
-use strict;
-use warnings;
-
-sub ok
-{
-    my $no = shift ;
-    my $result = shift ;
-
-    print "not " unless $result ;
-    print "ok $no\n" ;
-}
-
-require NDBM_File;
-#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
-use Fcntl;
-
-print "1..65\n";
-
-unlink <Op.dbmx*>;
-
-umask(0);
-my %h;
-ok(1, tie(%h,'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640));
-
-my $Dfile = "Op.dbmx.pag";
-if (! -e $Dfile) {
-       ($Dfile) = <Op.dbmx*>;
-}
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare') {
-    print "ok 2 # Skipped: different file permission semantics\n";
-}
-else {
-    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-     $blksize,$blocks) = stat($Dfile);
-    print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
-}
-my $i = 0;
-while (my ($key,$value) = each(%h)) {
-    $i++;
-}
-print (!$i ? "ok 3\n" : "not ok 3\n");
-
-$h{'goner1'} = 'snork';
-
-$h{'abc'} = 'ABC';
-$h{'def'} = 'DEF';
-$h{'jkl','mno'} = "JKL\034MNO";
-$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
-$h{'a'} = 'A';
-$h{'b'} = 'B';
-$h{'c'} = 'C';
-$h{'d'} = 'D';
-$h{'e'} = 'E';
-$h{'f'} = 'F';
-$h{'g'} = 'G';
-$h{'h'} = 'H';
-$h{'i'} = 'I';
-
-$h{'goner2'} = 'snork';
-delete $h{'goner2'};
-
-untie(%h);
-print (tie(%h,'NDBM_File','Op.dbmx', &O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
-
-$h{'j'} = 'J';
-$h{'k'} = 'K';
-$h{'l'} = 'L';
-$h{'m'} = 'M';
-$h{'n'} = 'N';
-$h{'o'} = 'O';
-$h{'p'} = 'P';
-$h{'q'} = 'Q';
-$h{'r'} = 'R';
-$h{'s'} = 'S';
-$h{'t'} = 'T';
-$h{'u'} = 'U';
-$h{'v'} = 'V';
-$h{'w'} = 'W';
-$h{'x'} = 'X';
-$h{'y'} = 'Y';
-$h{'z'} = 'Z';
-
-$h{'goner3'} = 'snork';
-
-delete $h{'goner1'};
-delete $h{'goner3'};
-
-my @keys = keys(%h);
-my @values = values(%h);
-
-if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
-
-while (my ($key,$value) = each(%h)) {
-    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
-       $key =~ y/a-z/A-Z/;
-       $i++ if $key eq $value;
-    }
-}
-
-if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
-
-@keys = ('blurfl', keys(%h), 'dyick');
-if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
-
-$h{'foo'} = '';
-$h{''} = 'bar';
-
-# check cache overflow and numeric keys and contents
-my $ok = 1;
-for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
-for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
-print ($ok ? "ok 8\n" : "not ok 8\n");
-
-my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-print ($size > 0 ? "ok 9\n" : "not ok 9\n");
-
-@h{0..200} = 200..400;
-my @foo = @h{0..200};
-print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
-
-print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
-print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
-
-untie %h;
-unlink 'Op.dbmx.dir', $Dfile;
-
-{
-   # sub-class test
-
-   package Another ;
-
-   use strict ;
-   use warnings ;
-
-   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
-   print FILE <<'EOM' ;
-
-   package SubDB ;
-
-   use strict ;
-   use warnings ;
-   use vars qw(@ISA @EXPORT) ;
-
-   require Exporter ;
-   use NDBM_File;
-   @ISA=qw(NDBM_File);
-   @EXPORT = @NDBM_File::EXPORT if defined @NDBM_File::EXPORT ;
-
-   sub STORE { 
-       my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::STORE($key, $value * 2) ;
-   }
-
-   sub FETCH { 
-       my $self = shift ;
-        my $key = shift ;
-        $self->SUPER::FETCH($key) - 1 ;
-   }
-
-   sub A_new_method
-   {
-       my $self = shift ;
-        my $key = shift ;
-        my $value = $self->FETCH($key) ;
-       return "[[$value]]" ;
-   }
-
-   1 ;
-EOM
-
-    close FILE ;
-
-    BEGIN { push @INC, '.'; }
-
-    eval 'use SubDB ; use Fcntl ; ';
-    main::ok(13, $@ eq "") ;
-    my %h ;
-    my $X ;
-    eval '
-       $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 );
-       ' ;
-
-    main::ok(14, $@ eq "") ;
-
-    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
-    main::ok(15, $@ eq "") ;
-    main::ok(16, $ret == 5) ;
-
-    $ret = eval '$X->A_new_method("fred") ' ;
-    main::ok(17, $@ eq "") ;
-    main::ok(18, $ret eq "[[5]]") ;
-
-    undef $X;
-    untie(%h);
-    unlink "SubDB.pm", <dbhash.tmp*> ;
-
-}
-
-{
-   # DBM Filter tests
-   use strict ;
-   use warnings ;
-   my (%h, $db) ;
-   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-
-   sub checkOutput
-   {
-       my($fk, $sk, $fv, $sv) = @_ ;
-       return
-           $fetch_key eq $fk && $store_key eq $sk && 
-          $fetch_value eq $fv && $store_value eq $sv &&
-          $_ eq 'original' ;
-   }
-   
-   unlink <Op.dbmx*>;
-   ok(19, $db = tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
-
-   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
-   $db->filter_store_key   (sub { $store_key = $_ }) ;
-   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
-   $db->filter_store_value (sub { $store_value = $_ }) ;
-
-   $_ = "original" ;
-
-   $h{"fred"} = "joe" ;
-   #                   fk   sk     fv   sv
-   ok(20, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(21, $h{"fred"} eq "joe");
-   #                   fk    sk     fv    sv
-   ok(22, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(23, $db->FIRSTKEY() eq "fred") ;
-   #                    fk     sk  fv  sv
-   ok(24, checkOutput( "fred", "", "", "")) ;
-
-   # replace the filters, but remember the previous set
-   my ($old_fk) = $db->filter_fetch_key   
-                       (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
-   my ($old_sk) = $db->filter_store_key   
-                       (sub { $_ = lc $_ ; $store_key = $_ }) ;
-   my ($old_fv) = $db->filter_fetch_value 
-                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
-   my ($old_sv) = $db->filter_store_value 
-                       (sub { s/o/x/g; $store_value = $_ }) ;
-   
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"Fred"} = "Joe" ;
-   #                   fk   sk     fv    sv
-   ok(25, checkOutput( "", "fred", "", "Jxe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(26, $h{"Fred"} eq "[Jxe]");
-   #                   fk   sk     fv    sv
-   ok(27, checkOutput( "", "fred", "[Jxe]", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(28, $db->FIRSTKEY() eq "FRED") ;
-   #                   fk   sk     fv    sv
-   ok(29, checkOutput( "FRED", "", "", "")) ;
-
-   # put the original filters back
-   $db->filter_fetch_key   ($old_fk);
-   $db->filter_store_key   ($old_sk);
-   $db->filter_fetch_value ($old_fv);
-   $db->filter_store_value ($old_sv);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"fred"} = "joe" ;
-   ok(30, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(31, $h{"fred"} eq "joe");
-   ok(32, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(33, $db->FIRSTKEY() eq "fred") ;
-   ok(34, checkOutput( "fred", "", "", "")) ;
-
-   # delete the filters
-   $db->filter_fetch_key   (undef);
-   $db->filter_store_key   (undef);
-   $db->filter_fetch_value (undef);
-   $db->filter_store_value (undef);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"fred"} = "joe" ;
-   ok(35, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(36, $h{"fred"} eq "joe");
-   ok(37, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(38, $db->FIRSTKEY() eq "fred") ;
-   ok(39, checkOutput( "", "", "", "")) ;
-
-   undef $db ;
-   untie %h;
-   unlink <Op.dbmx*>;
-}
-
-{    
-    # DBM Filter with a closure
-
-    use strict ;
-    use warnings ;
-    my (%h, $db) ;
-
-    unlink <Op.dbmx*>;
-    ok(40, $db = tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
-
-    my %result = () ;
-
-    sub Closure
-    {
-        my ($name) = @_ ;
-       my $count = 0 ;
-       my @kept = () ;
-
-       return sub { ++$count ; 
-                    push @kept, $_ ; 
-                    $result{$name} = "$name - $count: [@kept]" ;
-                  }
-    }
-
-    $db->filter_store_key(Closure("store key")) ;
-    $db->filter_store_value(Closure("store value")) ;
-    $db->filter_fetch_key(Closure("fetch key")) ;
-    $db->filter_fetch_value(Closure("fetch value")) ;
-
-    $_ = "original" ;
-
-    $h{"fred"} = "joe" ;
-    ok(41, $result{"store key"} eq "store key - 1: [fred]");
-    ok(42, $result{"store value"} eq "store value - 1: [joe]");
-    ok(43, !defined $result{"fetch key"} );
-    ok(44, !defined $result{"fetch value"} );
-    ok(45, $_ eq "original") ;
-
-    ok(46, $db->FIRSTKEY() eq "fred") ;
-    ok(47, $result{"store key"} eq "store key - 1: [fred]");
-    ok(48, $result{"store value"} eq "store value - 1: [joe]");
-    ok(49, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(50, ! defined $result{"fetch value"} );
-    ok(51, $_ eq "original") ;
-
-    $h{"jim"}  = "john" ;
-    ok(52, $result{"store key"} eq "store key - 2: [fred jim]");
-    ok(53, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(54, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(55, ! defined $result{"fetch value"} );
-    ok(56, $_ eq "original") ;
-
-    ok(57, $h{"fred"} eq "joe");
-    ok(58, $result{"store key"} eq "store key - 3: [fred jim fred]");
-    ok(59, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(60, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(61, $result{"fetch value"} eq "fetch value - 1: [joe]");
-    ok(62, $_ eq "original") ;
-
-    undef $db ;
-    untie %h;
-    unlink <Op.dbmx*>;
-}              
-
-{
-   # DBM Filter recursion detection
-   use strict ;
-   use warnings ;
-   my (%h, $db) ;
-   unlink <Op.dbmx*>;
-
-   ok(63, $db = tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
-
-   $db->filter_store_key (sub { $_ = $h{$_} }) ;
-
-   eval '$h{1} = 1234' ;
-   ok(64, $@ =~ /^recursion detected in filter_store_key at/ );
-   
-   undef $db ;
-   untie %h;
-   unlink <Op.dbmx*>;
-}
-
-{
-    # Bug ID 20001013.009
-    #
-    # test that $hash{KEY} = undef doesn't produce the warning
-    #     Use of uninitialized value in null operation 
-    use warnings ;
-    use strict ;
-    use NDBM_File ;
-
-    unlink <Op.dbmx*>;
-    my %h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    ok(65, tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
-}

diff --git a/t/lib/net-hostent.t b/t/lib/net-hostent.t
deleted file mode 100644 (file)
index c3a1219..0000000
--- a/t/lib/net-hostent.t
+++ /dev/null
@@ -1,72 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bSocket\b/ && 
-        !(($^O eq 'VMS') && $Config{d_socket})) {
-       print "1..0 # Test uses Socket, Socket not built\n";
-       exit 0;
-    }
-}
-
-BEGIN { $| = 1; print "1..7\n"; }
-
-END {print "not ok 1\n" unless $loaded;}
-
-use Net::hostent;
-
-$loaded = 1;
-print "ok 1\n";
-
-# test basic resolution of localhost <-> 127.0.0.1
-use Socket;
-
-my $h = gethost('localhost');
-print +(defined $h ? '' : 'not ') . "ok 2\n";
-my $i = gethostbyaddr(inet_aton("127.0.0.1"));
-print +(!defined $i ? 'not ' : '') . "ok 3\n";
-
-print "not " if inet_ntoa($h->addr) ne "127.0.0.1";
-print "ok 4\n";
-
-print "not " if inet_ntoa($i->addr) ne "127.0.0.1";
-print "ok 5\n";
-
-# need to skip the name comparisons on Win32 because windows will
-# return the name of the machine instead of "localhost" when resolving
-# 127.0.0.1 or even "localhost"
-
-# VMS returns "LOCALHOST" under tcp/ip services V4.1 ECO 2, possibly others
-# OS/390 returns localhost.YADDA.YADDA
-
-if ($^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'cygwin') {
-  print "ok $_ # skipped on win32\n" for (6,7);
-} else {
-  my $in_alias;
-  unless ($h->name =~ /^localhost(?:\..+)?$/i) {
-    foreach (@{$h->aliases}) {
-      if (/^localhost(?:\..+)?$/i) {
-       $in_alias = 1;
-       last;
-      }
-    }
-    print "not " unless $in_alias;
-  } # Else we found it as the hostname
-  print "ok 6 # ",$h->name, " ", join (",", @{$h->aliases}), "\n";
-
-  if ($in_alias) {
-    # If we found it in the aliases before, expect to find it there again.
-    foreach (@{$h->aliases}) {
-      if (/^localhost(?:\..+)?$/i) {
-       undef $in_alias; # This time, clear the flag if we see "localhost"
-       last;
-      }
-    }
-    print "not " if $in_alias;
-  } else {
-    print "not " unless $i->name =~ /^localhost(?:\..+)?$/i;
-  }
-  print "ok 7 # ",$h->name, " ", join (",", @{$h->aliases}), "\n";
-}

diff --git a/t/lib/net-nent.t b/t/lib/net-nent.t
deleted file mode 100644 (file)
index e73122c..0000000
--- a/t/lib/net-nent.t
+++ /dev/null
@@ -1,36 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN {
-    our $hasne;
-    eval { my @n = getnetbyname "loopback" };
-    $hasne = 1 unless $@ && $@ =~ /unimplemented/;
-    unless ($hasne) { print "1..0 # Skip: no getnetbyname\n"; exit 0 }
-    use Config;
-    $hasne = 0 unless $Config{'i_netdb'} eq 'define';
-    unless ($hasne) { print "1..0 # Skip: no netdb.h\n"; exit 0 }
-}
-
-BEGIN {
-    our @netent = getnetbyname "loopback"; # This is the function getnetbyname.
-    unless (@netent) { print "1..0 # Skip: no loopback net\n"; exit 0 }
-}
-
-print "1..2\n";
-
-use Net::netent;
-
-print "ok 1\n";
-
-my $netent = getnetbyname "loopback"; # This is the OO getnetbyname.
-
-print "not " unless $netent->name   eq $netent[0];
-print "ok 2\n";
-
-# Testing pretty much anything else is unportable;
-# e.g. the canonical name of the "loopback" net may be "loop".
-

diff --git a/t/lib/net-pent.t b/t/lib/net-pent.t
deleted file mode 100644 (file)
index 6c5a154..0000000
--- a/t/lib/net-pent.t
+++ /dev/null
@@ -1,38 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN {
-    our $haspe;
-    eval { my @n = getprotobyname "tcp" };
-    $haspe = 1 unless $@ && $@ =~ /unimplemented/;
-    unless ($haspe) { print "1..0 # Skip: no getprotobyname\n"; exit 0 }
-    use Config;
-    $haspe = 0 unless $Config{'i_netdb'} eq 'define';
-    unless ($haspe) { print "1..0 # Skip: no netdb.h\n"; exit 0 }
-}
-
-BEGIN {
-    our @protoent = getprotobyname "tcp"; # This is the function getprotobyname.
-    unless (@protoent) { print "1..0 # Skip: no tcp protocol\n"; exit 0 }
-}
-
-print "1..3\n";
-
-use Net::protoent;
-
-print "ok 1\n";
-
-my $protoent = getprotobyname "tcp"; # This is the OO getprotobyname.
-
-print "not " unless $protoent->name   eq $protoent[0];
-print "ok 2\n";
-
-print "not " unless $protoent->proto  == $protoent[2];
-print "ok 3\n";
-
-# Testing pretty much anything else is unportable.
-

diff --git a/t/lib/net-sent.t b/t/lib/net-sent.t
deleted file mode 100644 (file)
index ef4a04d..0000000
--- a/t/lib/net-sent.t
+++ /dev/null
@@ -1,38 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN {
-    our $hasse;
-    eval { my @n = getservbyname "echo", "tcp" };
-    $hasse = 1 unless $@ && $@ =~ /unimplemented/;
-    unless ($hasse) { print "1..0 # Skip: no getservbyname\n"; exit 0 }
-    use Config;
-    $hasse = 0 unless $Config{'i_netdb'} eq 'define';
-    unless ($hasse) { print "1..0 # Skip: no netdb.h\n"; exit 0 }
-}
-
-BEGIN {
-    our @servent = getservbyname "echo", "tcp"; # This is the function getservbyname.
-    unless (@servent) { print "1..0 # Skip: no echo service\n"; exit 0 }
-}
-
-print "1..3\n";
-
-use Net::servent;
-
-print "ok 1\n";
-
-my $servent = getservbyname "echo", "tcp"; # This is the OO getservbyname.
-
-print "not " unless $servent->name   eq $servent[0];
-print "ok 2\n";
-
-print "not " unless $servent->port  == $servent[2];
-print "ok 3\n";
-
-# Testing pretty much anything else is unportable.
-

diff --git a/t/lib/next.t b/t/lib/next.t
deleted file mode 100644 (file)
index 6328fd1..0000000
--- a/t/lib/next.t
+++ /dev/null
@@ -1,99 +0,0 @@
-#! /usr/local/bin/perl -w
-
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN { print "1..20\n"; }
-
-use NEXT;
-
-print "ok 1\n";
-
-package A;
-sub A::method   { return ( 3, $_[0]->NEXT::method() ) }
-sub A::DESTROY  { $_[0]->NEXT::DESTROY() }
-
-package B;
-use base qw( A );
-sub B::AUTOLOAD { return ( 9, $_[0]->NEXT::AUTOLOAD() ) }
-sub B::DESTROY  { $_[0]->NEXT::DESTROY() }
-
-package C;
-sub C::DESTROY  { print "ok 18\n"; $_[0]->NEXT::DESTROY() }
-
-package D;
-@D::ISA = qw( B C E );
-sub D::method   { return ( 2, $_[0]->NEXT::method() ) }
-sub D::AUTOLOAD { return ( 8, $_[0]->NEXT::AUTOLOAD() ) }
-sub D::DESTROY  { print "ok 17\n"; $_[0]->NEXT::DESTROY() }
-sub D::oops     { $_[0]->NEXT::method() }
-
-package E;
-@E::ISA = qw( F G );
-sub E::method   { return ( 4,  $_[0]->NEXT::method(), $_[0]->NEXT::method() ) }
-sub E::AUTOLOAD { return ( 10, $_[0]->NEXT::AUTOLOAD() ) }
-sub E::DESTROY  { print "ok 19\n"; $_[0]->NEXT::DESTROY() }
-
-package F;
-sub F::method   { return ( 5  ) }
-sub F::AUTOLOAD { return ( 11 ) }
-sub F::DESTROY  { print "ok 20\n" }
-
-package G;
-sub G::method   { return ( 6 ) }
-sub G::AUTOLOAD { print "not "; return }
-sub G::DESTROY  { print "not ok 21"; return }
-
-package main;
-
-my $obj = bless {}, "D";
-
-my @vals;
-
-# TEST NORMAL REDISPATCH (ok 2..6)
-@vals = $obj->method();
-print map "ok $_\n", @vals;
-
-# RETEST NORMAL REDISPATCH SHOULD BE THE SAME (ok 7)
-@vals = $obj->method();
-print "not " unless join("", @vals) == "23456";
-print "ok 7\n";
-
-# TEST AUTOLOAD REDISPATCH (ok 8..11)
-@vals = $obj->missing_method();
-print map "ok $_\n", @vals;
-
-# NAMED METHOD CAN'T REDISPATCH TO NAMED METHOD OF DIFFERENT NAME (ok 12)
-eval { $obj->oops() } && print "not ";
-print "ok 12\n";
-
-# AUTOLOAD'ED METHOD CAN'T REDISPATCH TO NAMED METHOD (ok 13)
-eval q{
-       package C;
-       sub AUTOLOAD { $_[0]->NEXT::method() };
-};
-eval { $obj->missing_method(); } && print "not ";
-print "ok 13\n";
-
-# NAMED METHOD CAN'T REDISPATCH TO AUTOLOAD'ED METHOD (ok 14)
-eval q{ 
-       package C;
-       sub method { $_[0]->NEXT::AUTOLOAD() };
-};
-eval { $obj->method(); } && print "not ";
-print "ok 14\n";
-
-# BASE CLASS METHODS ONLY REDISPATCHED WITHIN HIERARCHY (ok 15..16)
-my $ob2 = bless {}, "B";
-@val = $ob2->method();         
-print "not " unless @val==1 && $val[0]==3;
-print "ok 15\n";
-
-@val = $ob2->missing_method(); 
-print "not " unless @val==1 && $val[0]==9;
-print "ok 16\n";
-
-# CAN REDISPATCH DESTRUCTORS (ok 17..20)

diff --git a/t/lib/odbm.t b/t/lib/odbm.t
deleted file mode 100755 (executable)
index a43e70b..0000000
--- a/t/lib/odbm.t
+++ /dev/null
@@ -1,437 +0,0 @@
-#!./perl
-
-# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bODBM_File\b/) {
-       print "1..0 # Skip: ODBM_File was not built\n";
-       exit 0;
-    }
-}
-
-use strict;
-use warnings;
-
-sub ok
-{
-    my $no = shift ;
-    my $result = shift ;
-
-    print "not " unless $result ;
-    print "ok $no\n" ;
-}
-
-require ODBM_File;
-#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
-use Fcntl;
-
-print "1..66\n";
-
-unlink <Op.dbmx*>;
-
-umask(0);
-my %h;
-ok(1, tie(%h,'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640));
-
-my $Dfile = "Op.dbmx.pag";
-if (! -e $Dfile) {
-       ($Dfile) = <Op.dbmx*>;
-}
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare') {
-    print "ok 2 # Skipped: different file permission semantics\n";
-}
-else {
-    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-     $blksize,$blocks) = stat($Dfile);
-    print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
-}
-my $i = 0;
-while (my ($key,$value) = each(%h)) {
-    $i++;
-}
-print (!$i ? "ok 3\n" : "not ok 3\n");
-
-$h{'goner1'} = 'snork';
-
-$h{'abc'} = 'ABC';
-$h{'def'} = 'DEF';
-$h{'jkl','mno'} = "JKL\034MNO";
-$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
-$h{'a'} = 'A';
-$h{'b'} = 'B';
-$h{'c'} = 'C';
-$h{'d'} = 'D';
-$h{'e'} = 'E';
-$h{'f'} = 'F';
-$h{'g'} = 'G';
-$h{'h'} = 'H';
-$h{'i'} = 'I';
-
-$h{'goner2'} = 'snork';
-delete $h{'goner2'};
-
-untie(%h);
-print (tie(%h,'ODBM_File','Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
-
-$h{'j'} = 'J';
-$h{'k'} = 'K';
-$h{'l'} = 'L';
-$h{'m'} = 'M';
-$h{'n'} = 'N';
-$h{'o'} = 'O';
-$h{'p'} = 'P';
-$h{'q'} = 'Q';
-$h{'r'} = 'R';
-$h{'s'} = 'S';
-$h{'t'} = 'T';
-$h{'u'} = 'U';
-$h{'v'} = 'V';
-$h{'w'} = 'W';
-$h{'x'} = 'X';
-$h{'y'} = 'Y';
-$h{'z'} = 'Z';
-
-$h{'goner3'} = 'snork';
-
-delete $h{'goner1'};
-delete $h{'goner3'};
-
-my @keys = keys(%h);
-my @values = values(%h);
-
-if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
-
-while (my ($key,$value) = each(%h)) {
-    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
-       $key =~ y/a-z/A-Z/;
-       $i++ if $key eq $value;
-    }
-}
-
-if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
-
-@keys = ('blurfl', keys(%h), 'dyick');
-if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
-
-$h{'foo'} = '';
-$h{''} = 'bar';
-
-# check cache overflow and numeric keys and contents
-my $ok = 1;
-for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
-for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
-print ($ok ? "ok 8\n" : "not ok 8\n");
-
-my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-print ($size > 0 ? "ok 9\n" : "not ok 9\n");
-
-@h{0..200} = 200..400;
-my @foo = @h{0..200};
-print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
-
-print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
-print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
-
-untie %h;
-unlink 'Op.dbmx.dir', $Dfile;
-
-{
-   # sub-class test
-
-   package Another ;
-
-   use strict ;
-   use warnings ;
-
-   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
-   print FILE <<'EOM' ;
-
-   package SubDB ;
-
-   use strict ;
-   use warnings ;
-   use vars qw(@ISA @EXPORT) ;
-
-   require Exporter ;
-   use ODBM_File;
-   @ISA=qw(ODBM_File);
-   @EXPORT = @ODBM_File::EXPORT ;
-
-   sub STORE { 
-       my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::STORE($key, $value * 2) ;
-   }
-
-   sub FETCH { 
-       my $self = shift ;
-        my $key = shift ;
-        $self->SUPER::FETCH($key) - 1 ;
-   }
-
-   sub A_new_method
-   {
-       my $self = shift ;
-        my $key = shift ;
-        my $value = $self->FETCH($key) ;
-       return "[[$value]]" ;
-   }
-
-   1 ;
-EOM
-
-    close FILE ;
-
-    BEGIN { push @INC, '.'; }
-
-    eval 'use SubDB ; use Fcntl ;';
-    main::ok(13, $@ eq "") ;
-    my %h ;
-    my $X ;
-    eval '
-       $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 );
-       ' ;
-
-    main::ok(14, $@ eq "") ;
-
-    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
-    main::ok(15, $@ eq "") ;
-    main::ok(16, $ret == 5) ;
-
-    $ret = eval '$X->A_new_method("fred") ' ;
-    main::ok(17, $@ eq "") ;
-    main::ok(18, $ret eq "[[5]]") ;
-
-    undef $X;
-    untie(%h);
-    unlink "SubDB.pm", <dbhash.tmp*> ;
-
-}
-
-{
-   # DBM Filter tests
-   use strict ;
-   use warnings ;
-   my (%h, $db) ;
-   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-
-   sub checkOutput
-   {
-       my($fk, $sk, $fv, $sv) = @_ ;
-       print "# ", join('|', $fetch_key, $fk, $store_key, $sk,
-                       $fetch_value, $fv, $store_value, $sv, $_), "\n";
-       return
-           $fetch_key eq $fk && $store_key eq $sk && 
-          $fetch_value eq $fv && $store_value eq $sv &&
-          $_ eq 'original' ;
-   }
-   
-   unlink <Op.dbmx*>;
-   ok(19, $db = tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
-
-   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
-   $db->filter_store_key   (sub { $store_key = $_ }) ;
-   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
-   $db->filter_store_value (sub { $store_value = $_ }) ;
-
-   $_ = "original" ;
-
-   $h{"fred"} = "joe" ;
-   #                   fk   sk     fv   sv
-   ok(20, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(21, $h{"fred"} eq "joe");
-   #                   fk    sk     fv    sv
-   ok(22, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(23, $db->FIRSTKEY() eq "fred") ;
-   #                    fk     sk  fv  sv
-   ok(24, checkOutput( "fred", "", "", "")) ;
-
-   # replace the filters, but remember the previous set
-   my ($old_fk) = $db->filter_fetch_key   
-                       (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
-   my ($old_sk) = $db->filter_store_key   
-                       (sub { $_ = lc $_ ; $store_key = $_ }) ;
-   my ($old_fv) = $db->filter_fetch_value 
-                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
-   my ($old_sv) = $db->filter_store_value 
-                       (sub { s/o/x/g; $store_value = $_ }) ;
-   
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"Fred"} = "Joe" ;
-   #                   fk   sk     fv    sv
-   ok(25, checkOutput( "", "fred", "", "Jxe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(26, $h{"Fred"} eq "[Jxe]");
-   #                   fk   sk     fv    sv
-   ok(27, checkOutput( "", "fred", "[Jxe]", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(28, $db->FIRSTKEY() eq "FRED") ;
-   #                   fk   sk     fv    sv
-   ok(29, checkOutput( "FRED", "", "", "")) ;
-
-   # put the original filters back
-   $db->filter_fetch_key   ($old_fk);
-   $db->filter_store_key   ($old_sk);
-   $db->filter_fetch_value ($old_fv);
-   $db->filter_store_value ($old_sv);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"fred"} = "joe" ;
-   ok(30, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(31, $h{"fred"} eq "joe");
-   ok(32, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(33, $db->FIRSTKEY() eq "fred") ;
-   ok(34, checkOutput( "fred", "", "", "")) ;
-
-   # delete the filters
-   $db->filter_fetch_key   (undef);
-   $db->filter_store_key   (undef);
-   $db->filter_fetch_value (undef);
-   $db->filter_store_value (undef);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"fred"} = "joe" ;
-   ok(35, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(36, $h{"fred"} eq "joe");
-   ok(37, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(38, $db->FIRSTKEY() eq "fred") ;
-   ok(39, checkOutput( "", "", "", "")) ;
-
-   undef $db ;
-   untie %h;
-   unlink <Op.dbmx*>;
-}
-
-{    
-    # DBM Filter with a closure
-
-    use strict ;
-    use warnings ;
-    my (%h, $db) ;
-
-    unlink <Op.dbmx*>;
-    ok(40, $db = tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
-
-    my %result = () ;
-
-    sub Closure
-    {
-        my ($name) = @_ ;
-       my $count = 0 ;
-       my @kept = () ;
-
-       return sub { ++$count ; 
-                    push @kept, $_ ; 
-                    $result{$name} = "$name - $count: [@kept]" ;
-                  }
-    }
-
-    $db->filter_store_key(Closure("store key")) ;
-    $db->filter_store_value(Closure("store value")) ;
-    $db->filter_fetch_key(Closure("fetch key")) ;
-    $db->filter_fetch_value(Closure("fetch value")) ;
-
-    $_ = "original" ;
-
-    $h{"fred"} = "joe" ;
-    ok(41, $result{"store key"} eq "store key - 1: [fred]");
-    ok(42, $result{"store value"} eq "store value - 1: [joe]");
-    ok(43, !defined $result{"fetch key"} );
-    ok(44, !defined $result{"fetch value"} );
-    ok(45, $_ eq "original") ;
-
-    ok(46, $db->FIRSTKEY() eq "fred") ;
-    ok(47, $result{"store key"} eq "store key - 1: [fred]");
-    ok(48, $result{"store value"} eq "store value - 1: [joe]");
-    ok(49, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(50, ! defined $result{"fetch value"} );
-    ok(51, $_ eq "original") ;
-
-    $h{"jim"}  = "john" ;
-    ok(52, $result{"store key"} eq "store key - 2: [fred jim]");
-    ok(53, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(54, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(55, ! defined $result{"fetch value"} );
-    ok(56, $_ eq "original") ;
-
-    ok(57, $h{"fred"} eq "joe");
-    ok(58, $result{"store key"} eq "store key - 3: [fred jim fred]");
-    ok(59, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(60, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(61, $result{"fetch value"} eq "fetch value - 1: [joe]");
-    ok(62, $_ eq "original") ;
-
-    undef $db ;
-    untie %h;
-    unlink <Op.dbmx*>;
-}              
-
-{
-   # DBM Filter recursion detection
-   use strict ;
-   use warnings ;
-   my (%h, $db) ;
-   unlink <Op.dbmx*>;
-
-   ok(63, $db = tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
-
-   $db->filter_store_key (sub { $_ = $h{$_} }) ;
-
-   eval '$h{1} = 1234' ;
-   ok(64, $@ =~ /^recursion detected in filter_store_key at/ );
-   
-   undef $db ;
-   untie %h;
-   unlink <Op.dbmx*>;
-}
-
-{
-    # Bug ID 20001013.009
-    #
-    # test that $hash{KEY} = undef doesn't produce the warning
-    #     Use of uninitialized value in null operation 
-    use warnings ;
-    use strict ;
-    use ODBM_File ;
-
-    unlink <Op.dbmx*>;
-    my %h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    ok(65, tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
-    $h{ABC} = undef;
-    ok(66, $a eq "") ;
-    untie %h;
-    unlink <Op.dbmx*>;
-}
-
-if ($^O eq 'hpux') {
-    print <<EOM;
-#
-# If you experience failures with the odbm test in HP-UX,
-# this is a well-known bug that's unfortunately very hard to fix.
-# The suggested course of action is to avoid using the ODBM_File,
-# but to use instead the NDBM_File extension.
-#
-EOM
-}

diff --git a/t/lib/opcode.t b/t/lib/opcode.t
deleted file mode 100755 (executable)
index a785fce..0000000
--- a/t/lib/opcode.t
+++ /dev/null
@@ -1,115 +0,0 @@
-#!./perl -w
-
-$|=1;
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
-        print "1..0\n";
-        exit 0;
-    }
-}
-
-use Opcode qw(
-       opcodes opdesc opmask verify_opset
-       opset opset_to_ops opset_to_hex invert_opset
-       opmask_add full_opset empty_opset define_optag
-);
-
-use strict;
-
-my $t = 1;
-my $last_test; # initalised at end
-print "1..$last_test\n";
-
-my($s1, $s2, $s3);
-my(@o1, @o2, @o3);
-
-# --- opset_to_ops and opset
-
-my @empty_l = opset_to_ops(empty_opset);
-print @empty_l == 0 ?   "ok $t\n" : "not ok $t\n"; $t++;
-
-my @full_l1  = opset_to_ops(full_opset);
-print @full_l1 == opcodes() ? "ok $t\n" : "not ok $t\n"; $t++;
-my @full_l2 = @full_l1;        # = opcodes();  # XXX to be fixed
-print "@full_l1" eq "@full_l2" ? "ok $t\n" : "not ok $t\n"; $t++;
-
-@empty_l = opset_to_ops(opset(':none'));
-print @empty_l == 0 ?   "ok $t\n" : "not ok $t\n"; $t++;
-
-my @full_l3 = opset_to_ops(opset(':all'));
-print  @full_l1  ==  @full_l3  ? "ok $t\n" : "not ok $t\n"; $t++;
-print "@full_l1" eq "@full_l3" ? "ok $t\n" : "not ok $t\n"; $t++;
-
-die $t unless $t == 7;
-$s1 = opset(      'padsv');
-$s2 = opset($s1,  'padav');
-$s3 = opset($s2, '!padav');
-print $s1 eq $s2 ? "not ok $t\n" : "ok $t\n"; ++$t;
-print $s1 eq $s3 ? "ok $t\n" : "not ok $t\n"; ++$t;
-
-# --- define_optag
-
-print eval { opset(':_tst_') } ? "not ok $t\n" : "ok $t\n"; ++$t;
-define_optag(":_tst_", opset(qw(padsv padav padhv)));
-print eval { opset(':_tst_') } ? "ok $t\n" : "not ok $t\n"; ++$t;
-
-# --- opdesc and opcodes
-
-die $t unless $t == 11;
-print opdesc("gv") eq "glob value" ? "ok $t\n" : "not ok $t\n"; $t++;
-my @desc = opdesc(':_tst_','stub');
-print "@desc" eq "private variable private array private hash stub"
-                                   ? "ok $t\n" : "not ok $t\n#@desc\n"; $t++;
-print opcodes() ? "ok $t\n" : "not ok $t\n"; $t++;
-print "ok $t\n"; ++$t;
-
-# --- invert_opset
-
-$s1 = opset(qw(fileno padsv padav));
-@o2 = opset_to_ops(invert_opset($s1));
-print @o2 == opcodes-3 ? "ok $t\n" : "not ok $t\n"; $t++;
-
-# --- opmask
-
-die $t unless $t == 16;
-print opmask() eq empty_opset() ? "ok $t\n" : "not ok $t\n"; $t++;     # work
-print length opmask() == int((opcodes()+7)/8) ? "ok $t\n" : "not ok $t\n"; $t++;
-
-# --- verify_opset
-
-print verify_opset($s1) && !verify_opset(42) ? "ok $t\n":"not ok $t\n"; $t++;
-
-# --- opmask_add
-
-opmask_add(opset(qw(fileno))); # add to global op_mask
-print eval 'fileno STDOUT' ? "not ok $t\n" : "ok $t\n";        $t++; # fail
-print $@ =~ /fileno trapped/ ? "ok $t\n" : "not ok $t\n# $@\n"; $t++;
-
-# --- check use of bit vector ops on opsets
-
-$s1 = opset('padsv');
-$s2 = opset('padav');
-$s3 = opset('padsv', 'padav', 'padhv');
-
-# Non-negated
-print (($s1 | $s2) eq opset($s1,$s2) ? "ok $t\n":"not ok $t\n"); $t++;
-print (($s2 & $s3) eq opset($s2)     ? "ok $t\n":"not ok $t\n"); $t++;
-print (($s2 ^ $s3) eq opset('padsv','padhv') ? "ok $t\n":"not ok $t\n"); $t++;
-
-# Negated, e.g., with possible extra bits in last byte beyond last op bit.
-# The extra bits mean we can't just say ~mask eq invert_opset(mask).
-
-@o1 = opset_to_ops(           ~ $s3);
-@o2 = opset_to_ops(invert_opset $s3);
-print "@o1" eq "@o2" ? "ok $t\n":"not ok $t\n"; $t++;
-
-# --- finally, check some opname assertions
-
-foreach(@full_l1) { die "bad opname: $_" if /\W/ or /^\d/ }
-
-print "ok $last_test\n";
-BEGIN { $last_test = 25 }

diff --git a/t/lib/open2.t b/t/lib/open2.t
deleted file mode 100755 (executable)
index fe49189..0000000
--- a/t/lib/open2.t
+++ /dev/null
@@ -1,59 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if (!$Config{'d_fork'}
-       # open2/3 supported on win32 (but not Borland due to CRT bugs)
-       && (($^O ne 'MSWin32' && $^O ne 'NetWare') || $Config{'cc'} =~ /^bcc/i))
-    {
-       print "1..0\n";
-       exit 0;
-    }
-    # make warnings fatal
-    $SIG{__WARN__} = sub { die @_ };
-}
-
-use strict;
-use IO::Handle;
-use IPC::Open2;
-#require 'open2.pl'; use subs 'open2';
-
-my $perl = './perl';
-
-sub ok {
-    my ($n, $result, $info) = @_;
-    if ($result) {
-       print "ok $n\n";
-    }
-    else {
-       print "not ok $n\n";
-       print "# $info\n" if $info;
-    }
-}
-
-sub cmd_line {
-       if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
-               return qq/"$_[0]"/;
-       }
-       else {
-               return $_[0];
-       }
-}
-
-my ($pid, $reaped_pid);
-STDOUT->autoflush;
-STDERR->autoflush;
-
-print "1..7\n";
-
-ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e',
-       cmd_line('print scalar <STDIN>');
-ok 2, print WRITE "hi kid\n";
-ok 3, <READ> =~ /^hi kid\r?\n$/;
-ok 4, close(WRITE), $!;
-ok 5, close(READ), $!;
-$reaped_pid = waitpid $pid, 0;
-ok 6, $reaped_pid == $pid, $reaped_pid;
-ok 7, $? == 0, $?;

diff --git a/t/lib/open3.t b/t/lib/open3.t
deleted file mode 100755 (executable)
index 7d2d411..0000000
--- a/t/lib/open3.t
+++ /dev/null
@@ -1,150 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if (!$Config{'d_fork'}
-       # open2/3 supported on win32 (but not Borland due to CRT bugs)
-       && (($^O ne 'MSWin32' && $^O ne 'NetWare') || $Config{'cc'} =~ /^bcc/i))
-    {
-       print "1..0\n";
-       exit 0;
-    }
-    # make warnings fatal
-    $SIG{__WARN__} = sub { die @_ };
-}
-
-use strict;
-use IO::Handle;
-use IPC::Open3;
-#require 'open3.pl'; use subs 'open3';
-
-my $perl = $^X;
-
-sub ok {
-    my ($n, $result, $info) = @_;
-    if ($result) {
-       print "ok $n\n";
-    }
-    else {
-       print "not ok $n\n";
-       print "# $info\n" if $info;
-    }
-}
-
-sub cmd_line {
-       if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
-               my $cmd = shift;
-               $cmd =~ tr/\r\n//d;
-               $cmd =~ s/"/\\"/g;
-               return qq/"$cmd"/;
-       }
-       else {
-               return $_[0];
-       }
-}
-
-my ($pid, $reaped_pid);
-STDOUT->autoflush;
-STDERR->autoflush;
-
-print "1..22\n";
-
-# basic
-ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF');
-    $| = 1;
-    print scalar <STDIN>;
-    print STDERR "hi error\n";
-EOF
-ok 2, print WRITE "hi kid\n";
-ok 3, <READ> =~ /^hi kid\r?\n$/;
-ok 4, <ERROR> =~ /^hi error\r?\n$/;
-ok 5, close(WRITE), $!;
-ok 6, close(READ), $!;
-ok 7, close(ERROR), $!;
-$reaped_pid = waitpid $pid, 0;
-ok 8, $reaped_pid == $pid, $reaped_pid;
-ok 9, $? == 0, $?;
-
-# read and error together, both named
-$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', cmd_line(<<'EOF');
-    $| = 1;
-    print scalar <STDIN>;
-    print STDERR scalar <STDIN>;
-EOF
-print WRITE "ok 10\n";
-print scalar <READ>;
-print WRITE "ok 11\n";
-print scalar <READ>;
-waitpid $pid, 0;
-
-# read and error together, error empty
-$pid = open3 'WRITE', 'READ', '', $perl, '-e', cmd_line(<<'EOF');
-    $| = 1;
-    print scalar <STDIN>;
-    print STDERR scalar <STDIN>;
-EOF
-print WRITE "ok 12\n";
-print scalar <READ>;
-print WRITE "ok 13\n";
-print scalar <READ>;
-waitpid $pid, 0;
-
-# dup writer
-ok 14, pipe PIPE_READ, PIPE_WRITE;
-$pid = open3 '<&PIPE_READ', 'READ', '',
-                   $perl, '-e', cmd_line('print scalar <STDIN>');
-close PIPE_READ;
-print PIPE_WRITE "ok 15\n";
-close PIPE_WRITE;
-print scalar <READ>;
-waitpid $pid, 0;
-
-# dup reader
-$pid = open3 'WRITE', '>&STDOUT', 'ERROR',
-                   $perl, '-e', cmd_line('print scalar <STDIN>');
-print WRITE "ok 16\n";
-waitpid $pid, 0;
-
-# dup error:  This particular case, duping stderr onto the existing
-# stdout but putting stdout somewhere else, is a good case because it
-# used not to work.
-$pid = open3 'WRITE', 'READ', '>&STDOUT',
-                   $perl, '-e', cmd_line('print STDERR scalar <STDIN>');
-print WRITE "ok 17\n";
-waitpid $pid, 0;
-
-# dup reader and error together, both named
-$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', cmd_line(<<'EOF');
-    $| = 1;
-    print STDOUT scalar <STDIN>;
-    print STDERR scalar <STDIN>;
-EOF
-print WRITE "ok 18\n";
-print WRITE "ok 19\n";
-waitpid $pid, 0;
-
-# dup reader and error together, error empty
-$pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', cmd_line(<<'EOF');
-    $| = 1;
-    print STDOUT scalar <STDIN>;
-    print STDERR scalar <STDIN>;
-EOF
-print WRITE "ok 20\n";
-print WRITE "ok 21\n";
-waitpid $pid, 0;
-
-# command line in single parameter variant of open3
-# for understanding of Config{'sh'} test see exec description in camel book
-my $cmd = 'print(scalar(<STDIN>))';
-$cmd = $Config{'sh'} =~ /sh/ ? "'$cmd'" : cmd_line($cmd);
-eval{$pid = open3 'WRITE', '>&STDOUT', 'ERROR', "$perl -e " . $cmd; };
-if ($@) {
-       print "error $@\n";
-       print "not ok 22\n";
-}
-else {
-       print WRITE "ok 22\n";
-       waitpid $pid, 0;
-}        

diff --git a/t/lib/ops.t b/t/lib/ops.t
deleted file mode 100755 (executable)
index 56b1bac..0000000
--- a/t/lib/ops.t
+++ /dev/null
@@ -1,29 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
-        print "1..0\n";
-        exit 0;
-    }
-}
-
-print "1..2\n";
-
-eval <<'EOP';
-       no ops 'fileno';        # equiv to "perl -M-ops=fileno"
-       $a = fileno STDIN;
-EOP
-
-print $@ =~ /trapped/ ? "ok 1\n" : "not ok 1\n# $@\n";
-
-eval <<'EOP';
-       use ops ':default';     # equiv to "perl -M(as above) -Mops=:default"
-       eval 1;
-EOP
-
-print $@ =~ /trapped/ ? "ok 2\n" : "not ok 2\n# $@\n";
-
-1;

diff --git a/t/lib/parsewords.t b/t/lib/parsewords.t
deleted file mode 100755 (executable)
index 261d81f..0000000
--- a/t/lib/parsewords.t
+++ /dev/null
@@ -1,110 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use warnings;
-use Text::ParseWords;
-
-print "1..18\n";
-
-@words = shellwords(qq(foo "bar quiz" zoo));
-print "not " if $words[0] ne 'foo';
-print "ok 1\n";
-print "not " if $words[1] ne 'bar quiz';
-print "ok 2\n";
-print "not " if $words[2] ne 'zoo';
-print "ok 3\n";
-
-{
-  # Gonna get some undefined things back
-  no warnings 'uninitialized' ;
-
-  # Test quotewords() with other parameters and null last field
-  @words = quotewords(':+', 1, 'foo:::"bar:foo":zoo zoo:');
-  print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo;);
-  print "ok 4\n";
-}
-
-# Test $keep eq 'delimiters' and last field zero
-@words = quotewords('\s+', 'delimiters', '4 3 2 1 0');
-print "not " unless join(";", @words) eq qq(4; ;3; ;2; ;1; ;0);
-print "ok 5\n";
-
-# Big ol' nasty test (thanks, Joerk!)
-$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd" eee\\\\\\"ffff" "gg"';
-
-# First with $keep == 1
-$result = join('|', parse_line('\s+', 1, $string));
-print "not " unless $result eq 'aaaa"bbbbb"|cc\\ cc|\\\\\\"dddd" eee\\\\\\"ffff"|"gg"';
-print "ok 6\n";
-
-# Now, $keep == 0
-$result = join('|', parse_line('\s+', 0, $string));
-print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\"ffff|gg';
-print "ok 7\n";
-
-# Now test single quote behavior
-$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd\' eee\\\\\\"ffff\' gg';
-$result = join('|', parse_line('\s+', 0, $string));
-print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\\\\\"ffff|gg';
-print "ok 8\n";
-
-# Make sure @nested_quotewords does the right thing
-@lists = nested_quotewords('\s+', 0, 'a b c', '1 2 3', 'x y z');
-print "not " unless (@lists == 3 && @{$lists[0]} == 3 && @{$lists[1]} == 3 && @{$lists[2]} == 3);
-print "ok 9\n";
-
-# Now test error return
-$string = 'foo bar baz"bach blech boop';
-
-@words = shellwords($string);
-print "not " if (@words);
-print "ok 10\n";
-
-@words = parse_line('s+', 0, $string);
-print "not " if (@words);
-print "ok 11\n";
-
-@words = quotewords('s+', 0, $string);
-print "not " if (@words);
-print "ok 12\n";
-
-{
-  # Gonna get some more undefined things back
-  no warnings 'uninitialized' ;
-
-  @words = nested_quotewords('s+', 0, $string);
-  print "not " if (@words);
-  print "ok 13\n";
-
-  # Now test empty fields
-  $result = join('|', parse_line(':', 0, 'foo::0:"":::'));
-  print "not " unless ($result eq 'foo||0||||');
-  print "ok 14\n";
-
-  # Test for 0 in quotes without $keep
-  $result = join('|', parse_line(':', 0, ':"0":'));
-  print "not " unless ($result eq '|0|');
-  print "ok 15\n";
-
-  # Test for \001 in quoted string
-  $result = join('|', parse_line(':', 0, ':"' . "\001" . '":'));
-  print "not " unless ($result eq "|\1|");
-  print "ok 16\n";
-
-}
-
-# Now test perlish single quote behavior
-$Text::ParseWords::PERL_SINGLE_QUOTE = 1;
-$string = 'aaaa"bbbbb" cc\ cc \\\\\"dddd\' eee\\\\\"\\\'ffff\' gg';
-$result = join('|', parse_line('\s+', 0, $string));
-print "not " unless $result eq 'aaaabbbbb|cc cc|\"dddd eee\\\\"\'ffff|gg';
-print "ok 17\n";
-
-# test whitespace in the delimiters
-@words = quotewords(' ', 1, '4 3 2 1 0');
-print "not " unless join(";", @words) eq qq(4;3;2;1;0);
-print "ok 18\n";

diff --git a/t/lib/peek.t b/t/lib/peek.t
deleted file mode 100644 (file)
index c14dc9b..0000000
--- a/t/lib/peek.t
+++ /dev/null
@@ -1,308 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bPeek\b/) {
-        print "1..0 # Skip: Devel::Peek was not built\n";
-        exit 0;
-    }
-}
-
-use Devel::Peek;
-
-print "1..17\n";
-
-our $DEBUG = 0;
-open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
-
-sub do_test {
-    my $pattern = pop;
-    if (open(OUT,">peek$$")) {
-       open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
-       Dump($_[1]);
-       open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
-       close(OUT);
-       if (open(IN, "peek$$")) {
-           local $/;
-           $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
-           print $pattern, "\n" if $DEBUG;
-           my $dump = <IN>;
-           print $dump, "\n"    if $DEBUG;
-           print "[$dump] vs [$pattern]\nnot " unless $dump =~ /$pattern/ms;
-           print "ok $_[0]\n";
-           close(IN);
-       } else {
-           die "$0: failed to open peek$$: !\n";
-       }
-    } else {
-       die "$0: failed to create peek$$: $!\n";
-    }
-}
-
-our   $a;
-our   $b;
-my    $c;
-local $d = 0;
-
-do_test( 1,
-       $a = "foo",
-'SV = PV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(POK,pPOK\\)
-  PV = $ADDR "foo"\\\0
-  CUR = 3
-  LEN = 4'
-       );
-
-do_test( 2,
-        "bar",
-'SV = PV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(.*POK,READONLY,pPOK\\)
-  PV = $ADDR "bar"\\\0
-  CUR = 3
-  LEN = 4');
-
-do_test( 3,
-        $b = 123,
-'SV = IV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(IOK,pIOK\\)
-  IV = 123');
-
-do_test( 4,
-        456,
-'SV = IV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(.*IOK,READONLY,pIOK\\)
-  IV = 456');
-
-do_test( 5,
-        $c = 456,
-'SV = IV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(PADBUSY,PADMY,IOK,pIOK\\)
-  IV = 456');
-
-do_test( 6,
-        $c + $d,
-'SV = IV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(PADTMP,IOK,pIOK\\)
-  IV = 456');
-
-($d = "789") += 0.1;
-
-do_test( 7,
-       $d,
-'SV = PVNV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(NOK,pNOK\\)
-  IV = 0
-  NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
-  PV = $ADDR "789"\\\0
-  CUR = 3
-  LEN = 4');
-
-do_test( 8,
-        0xabcd,
-'SV = IV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(.*IOK,READONLY,pIOK\\)
-  IV = 43981');
-
-do_test( 9,
-        undef,
-'SV = NULL\\(0x0\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(\\)');
-
-do_test(10,
-        \$a,
-'SV = RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PV\\($ADDR\\) at $ADDR
-    REFCNT = 2
-    FLAGS = \\(POK,pPOK\\)
-    PV = $ADDR "foo"\\\0
-    CUR = 3
-    LEN = 4');
-
-do_test(11,
-       [$b,$c],
-'SV = RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVAV\\($ADDR\\) at $ADDR
-    REFCNT = 2
-    FLAGS = \\(\\)
-    IV = 0
-    NV = 0
-    ARRAY = $ADDR
-    FILL = 1
-    MAX = 1
-    ARYLEN = 0x0
-    FLAGS = \\(REAL\\)
-    Elt No. 0
-    SV = IV\\($ADDR\\) at $ADDR
-      REFCNT = 1
-      FLAGS = \\(IOK,pIOK\\)
-      IV = 123
-    Elt No. 1
-    SV = IV\\($ADDR\\) at $ADDR
-      REFCNT = 1
-      FLAGS = \\(IOK,pIOK\\)
-      IV = 456');
-
-do_test(12,
-       {$b=>$c},
-'SV = RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 2
-    FLAGS = \\(SHAREKEYS\\)
-    IV = 1
-    NV = 0
-    ARRAY = $ADDR  \\(0:7, 1:1\\)
-    hash quality = 100.0%
-    KEYS = 1
-    FILL = 1
-    MAX = 7
-    RITER = -1
-    EITER = 0x0
-    Elt "123" HASH = $ADDR
-    SV = IV\\($ADDR\\) at $ADDR
-      REFCNT = 1
-      FLAGS = \\(IOK,pIOK\\)
-      IV = 456');
-
-do_test(13,
-        sub(){@_},
-'SV = RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVCV\\($ADDR\\) at $ADDR
-    REFCNT = 2
-    FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON\\)
-    IV = 0
-    NV = 0
-    PROTOTYPE = ""
-    COMP_STASH = $ADDR\\t"main"
-    START = $ADDR ===> \\d+
-    ROOT = $ADDR
-    XSUB = 0x0
-    XSUBANY = 0
-    GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
-    FILE = ".*\\b(?i:peek\\.t)"
-    DEPTH = 0
-(?:    MUTEXP = $ADDR
-    OWNER = $ADDR
-)?    FLAGS = 0x4
-    PADLIST = $ADDR
-    OUTSIDE = $ADDR \\(MAIN\\)');
-
-do_test(14,
-        \&do_test,
-'SV = RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVCV\\($ADDR\\) at $ADDR
-    REFCNT = (3|4)
-    FLAGS = \\(\\)
-    IV = 0
-    NV = 0
-    COMP_STASH = $ADDR\\t"main"
-    START = $ADDR ===> \\d+
-    ROOT = $ADDR
-    XSUB = 0x0
-    XSUBANY = 0
-    GVGV::GV = $ADDR\\t"main" :: "do_test"
-    FILE = ".*\\b(?i:peek\\.t)"
-    DEPTH = 1
-(?:    MUTEXP = $ADDR
-    OWNER = $ADDR
-)?    FLAGS = 0x0
-    PADLIST = $ADDR
-      \\d+\\. $ADDR \\("\\$pattern" \\d+-\\d+\\)
-     \\d+\\. $ADDR \\(FAKE "\\$DEBUG" 0-\\d+\\)
-     \\d+\\. $ADDR \\("\\$dump" \\d+-\\d+\\)
-    OUTSIDE = $ADDR \\(MAIN\\)');
-
-do_test(15,
-        qr(tic),
-'SV = RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVMG\\($ADDR\\) at $ADDR
-    REFCNT = 1
-    FLAGS = \\(OBJECT,RMG\\)
-    IV = 0
-    NV = 0
-    PV = 0
-    MAGIC = $ADDR
-      MG_VIRTUAL = $ADDR
-      MG_TYPE = PERL_MAGIC_qr\(r\)
-      MG_OBJ = $ADDR
-    STASH = $ADDR\\t"Regexp"');
-
-do_test(16,
-        (bless {}, "Tac"),
-'SV = RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 2
-    FLAGS = \\(OBJECT,SHAREKEYS\\)
-    IV = 0
-    NV = 0
-    STASH = $ADDR\\t"Tac"
-    ARRAY = 0x0
-    KEYS = 0
-    FILL = 0
-    MAX = 7
-    RITER = -1
-    EITER = 0x0');
-
-do_test(17,
-       *a,
-'SV = PVGV\\($ADDR\\) at $ADDR
-  REFCNT = 5
-  FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
-  IV = 0
-  NV = 0
-  MAGIC = $ADDR
-    MG_VIRTUAL = &PL_vtbl_glob
-    MG_TYPE = PERL_MAGIC_glob\(\*\)
-    MG_OBJ = $ADDR
-  NAME = "a"
-  NAMELEN = 1
-  GvSTASH = $ADDR\\t"main"
-  GP = $ADDR
-    SV = $ADDR
-    REFCNT = 1
-    IO = 0x0
-    FORM = 0x0  
-    AV = 0x0
-    HV = 0x0
-    CV = 0x0
-    CVGEN = 0x0
-    GPFLAGS = 0x0
-    LINE = \\d+
-    FILE = ".*\\b(?i:peek\\.t)"
-    FLAGS = $ADDR
-    EGV = $ADDR\\t"a"');
-
-END {
-  1 while unlink("peek$$");
-}

diff --git a/t/lib/perlio.t b/t/lib/perlio.t
deleted file mode 100644 (file)
index d71ab8e..0000000
--- a/t/lib/perlio.t
+++ /dev/null
@@ -1,90 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{'extensions'} !~ /\bPerlIO\b/) {
-           print "1..0 # Skip: PerlIO was not built\n";
-           exit 0;
-       }
-}
-
-use PerlIO;
-
-print "1..19\n";
-
-print "ok 1\n";
-
-my $txt = "txt$$";
-my $bin = "bin$$";
-my $utf = "utf$$";
-
-my $txtfh;
-my $binfh;
-my $utffh;
-
-print "not " unless open($txtfh, ">:crlf", $txt);
-print "ok 2\n";
-
-print "not " unless open($binfh, ">:raw",  $bin);
-print "ok 3\n";
-
-print "not " unless open($utffh, ">:utf8", $utf);
-print "ok 4\n";
-
-print $txtfh "foo\n";
-print $txtfh "bar\n";
-print "not " unless close($txtfh);
-print "ok 5\n";
-
-print $binfh "foo\n";
-print $binfh "bar\n";
-print "not " unless close($binfh);
-print "ok 6\n";
-
-print $utffh "foo\x{ff}\n";
-print $utffh "bar\x{abcd}\n";
-print "not " unless close($utffh);
-print "ok 7\n";
-
-print "not " unless open($txtfh, "<:crlf", $txt);
-print "ok 8\n";
-
-print "not " unless open($binfh, "<:raw",  $bin);
-print "ok 9\n";
-
-print "not " unless open($utffh, "<:utf8", $utf);
-print "ok 10\n";
-
-print "not " unless <$txtfh> eq "foo\n" && <$txtfh> eq "bar\n";
-print "ok 11\n";
-
-print "not " unless <$binfh> eq "foo\n" && <$binfh> eq "bar\n";
-print "ok 12\n";
-
-print "not " unless <$utffh> eq "foo\x{ff}\n" && <$utffh> eq "bar\x{abcd}\n";
-print "ok 13\n";
-
-print "not " unless eof($txtfh);
-print "ok 14\n";
-
-print "not " unless eof($binfh);
-print "ok 15\n";
-
-print "not " unless eof($utffh);
-print "ok 16\n";
-
-print "not " unless close($txtfh);
-print "ok 17\n";
-
-print "not " unless close($binfh);
-print "ok 18\n";
-
-print "not " unless close($utffh);
-print "ok 19\n";
-
-END {
-    1 while unlink $txt;
-    1 while unlink $bin;
-    1 while unlink $utf;
-}
-

diff --git a/t/lib/ph.t b/t/lib/ph.t
deleted file mode 100755 (executable)
index de27dee..0000000
--- a/t/lib/ph.t
+++ /dev/null
@@ -1,96 +0,0 @@
-#!./perl
-
-# Check for presence and correctness of .ph files; for now,
-# just socket.ph and pals.
-#   -- Kurt Starsinic <kstar@isinet.com>
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# All the constants which Socket.pm tries to make available:
-my @possibly_defined = qw(
-    INADDR_ANY INADDR_LOOPBACK INADDR_NONE AF_802 AF_APPLETALK AF_CCITT
-    AF_CHAOS AF_DATAKIT AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK
-    AF_INET AF_LAT AF_MAX AF_NBS AF_NIT AF_NS AF_OSI AF_OSINET AF_PUP
-    AF_SNA AF_UNIX AF_UNSPEC AF_X25 MSG_DONTROUTE MSG_MAXIOVLEN MSG_OOB
-    MSG_PEEK PF_802 PF_APPLETALK PF_CCITT PF_CHAOS PF_DATAKIT PF_DECnet PF_DLI
-    PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_LAT PF_MAX PF_NBS PF_NIT
-    PF_NS PF_OSI PF_OSINET PF_PUP PF_SNA PF_UNIX PF_UNSPEC PF_X25 SOCK_DGRAM
-    SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM SOL_SOCKET SOMAXCONN
-    SO_ACCEPTCONN SO_BROADCAST SO_DEBUG SO_DONTLINGER SO_DONTROUTE SO_ERROR
-    SO_KEEPALIVE SO_LINGER SO_OOBINLINE SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO
-    SO_REUSEADDR SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_TYPE SO_USELOOPBACK
-);
-
-
-# The libraries which I'm going to require:
-my @libs = qw(Socket "sys/types.ph" "sys/socket.ph" "netinet/in.ph");
-
-
-# These are defined by Socket.pm even if the C header files don't define them:
-my %ok_to_miss = (
-    INADDR_NONE         => 1,
-    INADDR_LOOPBACK     => 1,
-);
-
-
-my $total_tests = scalar @libs + scalar @possibly_defined;
-my $i           = 0;
-
-print "1..$total_tests\n";
-
-
-foreach (@libs) {
-    $i++;
-
-    if (eval "require $_" ) {
-        print "ok $i\n";
-    } else {
-        print "# Skipping tests; $_ may be missing\n";
-        foreach ($i .. $total_tests) { print "ok $_\n" }
-        exit;
-    }
-}
-
-
-foreach (@possibly_defined) {
-    $i++;
-
-    $pm_val = eval "Socket::$_()";
-    $ph_val = eval "main::$_()";
-
-    if (defined $pm_val and !defined $ph_val) {
-        if ($ok_to_miss{$_}) { print "ok $i\n" }
-        else                 { print "not ok $i\n" }
-        next;
-    } elsif (defined $ph_val and !defined $pm_val) {
-        print "not ok $i\n";
-        next;
-    }
-
-    # Socket.pm converts these to network byte order, so we convert the
-    # socket.ph version to match; note that these cases skip the following
-    # `elsif', which is only applied to _numeric_ values, not literal
-    # bitmasks.
-    if ($_ eq 'INADDR_ANY'
-    or  $_ eq 'INADDR_LOOPBACK'
-    or  $_ eq 'INADDR_NONE') {
-        $ph_val = pack("N*", $ph_val);  # htonl(3) equivalent
-    }
-
-    # Since Socket.pm and socket.ph wave their hands over macros differently,
-    # they could return functionally equivalent bitmaps with different numeric
-    # interpretations (due to sign extension).  The only apparent case of this
-    # is SO_DONTLINGER (only on Solaris, and deprecated, at that):
-    elsif ($pm_val != $ph_val) {
-        $pm_val = oct(sprintf "0x%lx", $pm_val);
-        $ph_val = oct(sprintf "0x%lx", $ph_val);
-    }
-
-    if ($pm_val == $ph_val) { print "ok $i\n" }
-    else                    { print "not ok $i\n" }
-}
-
-

diff --git a/t/lib/posix.t b/t/lib/posix.t
deleted file mode 100755 (executable)
index 09bd88c..0000000
--- a/t/lib/posix.t
+++ /dev/null
@@ -1,139 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) {
-       print "1..0\n";
-       exit 0;
-    }
-}
-
-use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write);
-use strict subs;
-
-$| = 1;
-print "1..27\n";
-
-$Is_W32 = $^O eq 'MSWin32';
-$Is_NetWare = $^O eq 'NetWare';
-$Is_Dos = $^O eq 'dos';
-
-$testfd = open("TEST", O_RDONLY, 0) and print "ok 1\n";
-read($testfd, $buffer, 9) if $testfd > 2;
-print $buffer eq "#!./perl\n" ? "ok 2\n" : "not ok 2\n";
-
-write(1,"ok 3\nnot ok 3\n", 5);
-
-if ($Is_Dos) {
-    for (4..5) {
-        print "ok $_ # skipped, no pipe() support on dos\n";
-    }
-} else {
-@fds = POSIX::pipe();
-print $fds[0] > $testfd ? "ok 4\n" : "not ok 4\n";
-CORE::open($reader = \*READER, "<&=".$fds[0]);
-CORE::open($writer = \*WRITER, ">&=".$fds[1]);
-print $writer "ok 5\n";
-close $writer;
-print <$reader>;
-close $reader;
-}
-
-if ($Is_W32 || $Is_Dos) {
-    for (6..11) {
-       print "ok $_ # skipped, no sigaction support on win32/dos\n";
-    }
-}
-else {
-$sigset = new POSIX::SigSet 1,3;
-delset $sigset 1;
-if (!ismember $sigset 1) { print "ok 6\n" }
-if (ismember $sigset 3) { print "ok 7\n" }
-$mask = new POSIX::SigSet &SIGINT;
-$action = new POSIX::SigAction 'main::SigHUP', $mask, 0;
-sigaction(&SIGHUP, $action);
-$SIG{'INT'} = 'SigINT';
-kill 'HUP', $$;
-sleep 1;
-print "ok 11\n";
-
-sub SigHUP {
-    print "ok 8\n";
-    kill 'INT', $$;
-    sleep 2;
-    print "ok 9\n";
-}
-
-sub SigINT {
-    print "ok 10\n";
-}
-}
-
-print &_POSIX_OPEN_MAX > $fds[1] ? "ok 12\n" : "not ok 12\n";
-
-print getcwd() =~ m#/t$# ? "ok 13\n" : "not ok 13\n";
-
-# Check string conversion functions.
-
-if ($Config{d_strtod}) {
-    $lc = &POSIX::setlocale(&POSIX::LC_NUMERIC, 'C') if $Config{d_setlocale};
-    ($n, $x) = &POSIX::strtod('3.14159_OR_SO');
-# Using long double NVs may introduce greater accuracy than wanted.
-    $n =~ s/^3.1415(8999|9000)\d*$/3.14159/
-        if $Config{uselongdouble} eq 'define';
-    print (($n == 3.14159) && ($x == 6) ?
-          "ok 14\n" : "not ok 14\n");
-    &POSIX::setlocale(&POSIX::LC_NUMERIC, $lc) if $Config{d_setlocale};
-} else { print "# strtod not present\n", "ok 14\n"; }
-
-if ($Config{d_strtol}) {
-    ($n, $x) = &POSIX::strtol('21_PENGUINS');
-    print (($n == 21) && ($x == 9) ? "ok 15\n" : "not ok 15\n");
-} else { print "# strtol not present\n", "ok 15\n"; }
-
-if ($Config{d_strtoul}) {
-    ($n, $x) = &POSIX::strtoul('88_TEARS');
-    print (($n == 88) && ($x == 6) ? "ok 16\n" : "not ok 16\n");
-} else { print "# strtoul not present\n", "ok 16\n"; }
-
-# Pick up whether we're really able to dynamically load everything.
-print &POSIX::acos(1.0) == 0.0 ? "ok 17\n" : "not ok 17\n";
-
-# This can coredump if struct tm has a timezone field and we
-# didn't detect it.  If this fails, try adding
-# -DSTRUCT_TM_HASZONE to your cflags when compiling ext/POSIX/POSIX.c.
-# See ext/POSIX/hints/sunos_4.pl and ext/POSIX/hints/linux.pl 
-print POSIX::strftime("ok 18 # %H:%M, on %D\n", localtime());
-
-# If that worked, validate the mini_mktime() routine's normalisation of
-# input fields to strftime().
-sub try_strftime {
-    my $num = shift;
-    my $expect = shift;
-    my $got = POSIX::strftime("%a %b %d %H:%M:%S %Y %j", @_);
-    if ($got eq $expect) {
-       print "ok $num\n";
-    }
-    else {
-       print "# expected: $expect\n# got: $got\nnot ok $num\n";
-    }
-}
-
-$lc = &POSIX::setlocale(&POSIX::LC_TIME, 'C') if $Config{d_setlocale};
-try_strftime(19, "Wed Feb 28 00:00:00 1996 059", 0,0,0, 28,1,96);
-try_strftime(20, "Thu Feb 29 00:00:60 1996 060", 60,0,-24, 30,1,96);
-try_strftime(21, "Fri Mar 01 00:00:00 1996 061", 0,0,-24, 31,1,96);
-try_strftime(22, "Sun Feb 28 00:00:00 1999 059", 0,0,0, 28,1,99);
-try_strftime(23, "Mon Mar 01 00:00:00 1999 060", 0,0,24, 28,1,99);
-try_strftime(24, "Mon Feb 28 00:00:00 2000 059", 0,0,0, 28,1,100);
-try_strftime(25, "Tue Feb 29 00:00:00 2000 060", 0,0,0, 0,2,100);
-try_strftime(26, "Wed Mar 01 00:00:00 2000 061", 0,0,0, 1,2,100);
-try_strftime(27, "Fri Mar 31 00:00:00 2000 091", 0,0,0, 31,2,100);
-&POSIX::setlocale(&POSIX::LC_TIME, $lc) if $Config{d_setlocale};
-
-$| = 0;
-# The following line assumes buffered output, which may be not true with EMX:
-print '@#!*$@(!@#$' unless ($^O eq 'os2' || $^O eq 'uwin' || $^O eq 'os390');
-_exit(0);

diff --git a/t/lib/safe1.t b/t/lib/safe1.t
deleted file mode 100755 (executable)
index 27993d9..0000000
--- a/t/lib/safe1.t
+++ /dev/null
@@ -1,68 +0,0 @@
-#!./perl -w
-$|=1;
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
-        print "1..0\n";
-        exit 0;
-    }
-}
-
-# Tests Todo:
-#      'main' as root
-
-package test;  # test from somewhere other than main
-
-use vars qw($bar);
-
-use Opcode 1.00, qw(opdesc opset opset_to_ops opset_to_hex
-       opmask_add full_opset empty_opset opcodes opmask define_optag);
-
-use Safe 1.00;
-
-my $last_test; # initalised at end
-print "1..$last_test\n";
-
-my $t = 1;
-my $cpt;
-# create and destroy some automatic Safe compartments first
-$cpt = new Safe or die;
-$cpt = new Safe or die;
-$cpt = new Safe or die;
-
-$cpt = new Safe "Root" or die;
-
-foreach(1..3) {
-       $foo = 42;
-
-       $cpt->share(qw($foo));
-
-       print ${$cpt->varglob('foo')}       == 42 ? "ok $t\n" : "not ok $t\n"; $t++;
-
-       ${$cpt->varglob('foo')} = 9;
-
-       print $foo == 9 ? "ok $t\n" : "not ok $t\n"; $t++;
-
-       print $cpt->reval('$foo')       == 9    ? "ok $t\n" : "not ok $t\n"; $t++;
-       # check 'main' has been changed:
-       print $cpt->reval('$::foo')     == 9    ? "ok $t\n" : "not ok $t\n"; $t++;
-       print $cpt->reval('$main::foo') == 9    ? "ok $t\n" : "not ok $t\n"; $t++;
-       # check we can't see our test package:
-       print $cpt->reval('$test::foo')         ? "not ok $t\n" : "ok $t\n"; $t++;
-       print $cpt->reval('${"test::foo"}')             ? "not ok $t\n" : "ok $t\n"; $t++;
-
-       $cpt->erase;    # erase the compartment, e.g., delete all variables
-
-       print $cpt->reval('$foo') ? "not ok $t\n" : "ok $t\n"; $t++;
-
-       # Note that we *must* use $cpt->varglob here because if we used
-       # $Root::foo etc we would still see the original values!
-       # This seems to be because the compiler has created an extra ref.
-
-       print ${$cpt->varglob('foo')} ? "not ok $t\n" : "ok $t\n"; $t++;
-}
-
-print "ok $last_test\n";
-BEGIN { $last_test = 28 }

diff --git a/t/lib/safe2.t b/t/lib/safe2.t
deleted file mode 100755 (executable)
index 4d6c84a..0000000
--- a/t/lib/safe2.t
+++ /dev/null
@@ -1,145 +0,0 @@
-#!./perl -w
-$|=1;
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
-        print "1..0\n";
-        exit 0;
-    }
-    # test 30 rather naughtily expects English error messages
-    $ENV{'LC_ALL'} = 'C';
-    $ENV{LANGUAGE} = 'C'; # GNU locale extension
-}
-
-# Tests Todo:
-#      'main' as root
-
-use vars qw($bar);
-
-use Opcode 1.00, qw(opdesc opset opset_to_ops opset_to_hex
-       opmask_add full_opset empty_opset opcodes opmask define_optag);
-
-use Safe 1.00;
-
-my $last_test; # initalised at end
-print "1..$last_test\n";
-
-# Set up a package namespace of things to be visible to the unsafe code
-$Root::foo = "visible";
-$bar = "invisible";
-
-# Stop perl from moaning about identifies which are apparently only used once
-$Root::foo .= "";
-
-my $cpt;
-# create and destroy a couple of automatic Safe compartments first
-$cpt = new Safe or die;
-$cpt = new Safe or die;
-
-$cpt = new Safe "Root";
-
-$cpt->reval(q{ system("echo not ok 1"); });
-if ($@ =~ /^system trapped by operation mask/) {
-    print "ok 1\n";
-} else {
-    print "#$@" if $@;
-    print "not ok 1\n";
-}
-
-$cpt->reval(q{
-    print $foo eq 'visible'            ? "ok 2\n" : "not ok 2\n";
-    print $main::foo  eq 'visible'     ? "ok 3\n" : "not ok 3\n";
-    print defined($bar)                        ? "not ok 4\n" : "ok 4\n";
-    print defined($::bar)              ? "not ok 5\n" : "ok 5\n";
-    print defined($main::bar)          ? "not ok 6\n" : "ok 6\n";
-});
-print $@ ? "not ok 7\n#$@" : "ok 7\n";
-
-$foo = "ok 8\n";
-%bar = (key => "ok 9\n");
-@baz = (); push(@baz, "o", "10"); $" = 'k ';
-$glob = "ok 11\n";
-@glob = qw(not ok 16);
-
-sub sayok { print "ok @_\n" }
-
-$cpt->share(qw($foo %bar @baz *glob sayok));
-$cpt->share('$"') unless $Config{use5005threads};
-
-$cpt->reval(q{
-    package other;
-    sub other_sayok { print "ok @_\n" }
-    package main;
-    print $foo ? $foo : "not ok 8\n";
-    print $bar{key} ? $bar{key} : "not ok 9\n";
-    (@baz) ? print "@baz\n" : print "not ok 10\n";
-    print $glob;
-    other::other_sayok(12);
-    $foo =~ s/8/14/;
-    $bar{new} = "ok 15\n";
-    @glob = qw(ok 16);
-});
-print $@ ? "not ok 13\n#$@" : "ok 13\n";
-$" = ' ';
-print $foo, $bar{new}, "@glob\n";
-
-$Root::foo = "not ok 17";
-@{$cpt->varglob('bar')} = qw(not ok 18);
-${$cpt->varglob('foo')} = "ok 17";
-@Root::bar = "ok";
-push(@Root::bar, "18"); # Two steps to prevent "Identifier used only once..."
-
-print "$Root::foo\n";
-print "@{$cpt->varglob('bar')}\n";
-
-use strict;
-
-print 1 ? "ok 19\n" : "not ok 19\n";
-print 1 ? "ok 20\n" : "not ok 20\n";
-
-my $m1 = $cpt->mask;
-$cpt->trap("negate");
-my $m2 = $cpt->mask;
-my @masked = opset_to_ops($m1);
-print $m2 eq opset("negate", @masked) ? "ok 21\n" : "not ok 21\n";
-
-print eval { $cpt->mask("a bad mask") } ? "not ok 22\n" : "ok 22\n";
-
-print $cpt->reval("2 + 2") == 4 ? "ok 23\n" : "not ok 23\n";
-
-$cpt->mask(empty_opset);
-my $t_scalar = $cpt->reval('print wantarray ? "not ok 24\n" : "ok 24\n"');
-print $cpt->reval('@ary=(6,7,8);@ary') == 3 ? "ok 25\n" : "not ok 25\n";
-my @t_array  = $cpt->reval('print wantarray ? "ok 26\n" : "not ok 26\n"; (2,3,4)');
-print $t_array[2] == 4 ? "ok 27\n" : "not ok 27\n";
-
-my $t_scalar2 = $cpt->reval('die "foo bar"; 1');
-print defined $t_scalar2 ? "not ok 28\n" : "ok 28\n";
-print $@ =~ /foo bar/ ? "ok 29\n" : "not ok 29\n";
-
-# --- rdo
-  
-my $t = 30;
-$cpt->rdo('/non/existant/file.name');
-# The regexp is getting rather baroque.
-print $! =~ /cannot find|No such file|file specification syntax error|A file or directory in the path name does not exist|Invalid argument|Device not configured|file not found|File or directory doesn't exist/i ? "ok $t\n" : "not ok $t # $!\n"; $t++;
-# test #31 is gone.
-print 1 ? "ok $t\n" : "not ok $t\n#$@/$!\n"; $t++;
-  
-#my $rdo_file = "tmp_rdo.tpl";
-#if (open X,">$rdo_file") {
-#    print X "999\n";
-#    close X;
-#    $cpt->permit_only('const', 'leaveeval');
-#    print  $cpt->rdo($rdo_file) == 999 ? "ok $t\n" : "not ok $t\n"; $t++;
-#    unlink $rdo_file;
-#}
-#else {
-#    print "# test $t skipped, can't open file: $!\nok $t\n"; $t++;
-#}
-
-
-print "ok $last_test\n";
-BEGIN { $last_test = 32 }

diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t
deleted file mode 100755 (executable)
index 57928e0..0000000
--- a/t/lib/sdbm.t
+++ /dev/null
@@ -1,429 +0,0 @@
-#!./perl
-
-# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if (($Config{'extensions'} !~ /\bSDBM_File\b/) && ($^O ne 'VMS')){
-       print "1..0\n";
-       exit 0;
-    }
-}
-
-use strict;
-use warnings;
-
-sub ok
-{
-    my $no = shift ;
-    my $result = shift ;
-
-    print "not " unless $result ;
-    print "ok $no\n" ;
-}
-
-require SDBM_File;
-#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
-use Fcntl;
-
-print "1..68\n";
-
-unlink <Op_dbmx.*>;
-
-umask(0);
-my %h ;
-ok(1, tie %h,'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640);
-
-my $Dfile = "Op_dbmx.pag";
-if (! -e $Dfile) {
-       ($Dfile) = <Op_dbmx.*>;
-}
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos') {
-    print "ok 2 # Skipped: different file permission semantics\n";
-}
-else {
-    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-     $blksize,$blocks) = stat($Dfile);
-    print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
-}
-my $i = 0;
-while (my ($key,$value) = each(%h)) {
-    $i++;
-}
-print (!$i ? "ok 3\n" : "not ok 3\n");
-
-$h{'goner1'} = 'snork';
-
-$h{'abc'} = 'ABC';
-$h{'def'} = 'DEF';
-$h{'jkl','mno'} = "JKL\034MNO";
-$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
-$h{'a'} = 'A';
-$h{'b'} = 'B';
-$h{'c'} = 'C';
-$h{'d'} = 'D';
-$h{'e'} = 'E';
-$h{'f'} = 'F';
-$h{'g'} = 'G';
-$h{'h'} = 'H';
-$h{'i'} = 'I';
-
-$h{'goner2'} = 'snork';
-delete $h{'goner2'};
-
-untie(%h);
-print (tie(%h,'SDBM_File','Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
-
-$h{'j'} = 'J';
-$h{'k'} = 'K';
-$h{'l'} = 'L';
-$h{'m'} = 'M';
-$h{'n'} = 'N';
-$h{'o'} = 'O';
-$h{'p'} = 'P';
-$h{'q'} = 'Q';
-$h{'r'} = 'R';
-$h{'s'} = 'S';
-$h{'t'} = 'T';
-$h{'u'} = 'U';
-$h{'v'} = 'V';
-$h{'w'} = 'W';
-$h{'x'} = 'X';
-$h{'y'} = 'Y';
-$h{'z'} = 'Z';
-
-$h{'goner3'} = 'snork';
-
-delete $h{'goner1'};
-delete $h{'goner3'};
-
-my @keys = keys(%h);
-my @values = values(%h);
-
-if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
-
-while (my ($key,$value) = each(%h)) {
-    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
-       $key =~ y/a-z/A-Z/;
-       $i++ if $key eq $value;
-    }
-}
-
-if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
-
-@keys = ('blurfl', keys(%h), 'dyick');
-if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
-
-$h{'foo'} = '';
-$h{''} = 'bar';
-
-# check cache overflow and numeric keys and contents
-my $ok = 1;
-for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
-for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
-print ($ok ? "ok 8\n" : "not ok 8\n");
-
-my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-print ($size > 0 ? "ok 9\n" : "not ok 9\n");
-
-@h{0..200} = 200..400;
-my @foo = @h{0..200};
-print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
-
-print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
-print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
-
-
-{
-   # sub-class test
-
-   package Another ;
-
-   use strict ;
-   use warnings ;
-
-   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
-   print FILE <<'EOM' ;
-
-   package SubDB ;
-
-   use strict ;
-   use warnings ;
-   use vars qw( @ISA @EXPORT) ;
-
-   require Exporter ;
-   use SDBM_File;
-   @ISA=qw(SDBM_File);
-   @EXPORT = @SDBM_File::EXPORT if defined @SDBM_File::EXPORT ;
-
-   sub STORE { 
-       my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::STORE($key, $value * 2) ;
-   }
-
-   sub FETCH { 
-       my $self = shift ;
-        my $key = shift ;
-        $self->SUPER::FETCH($key) - 1 ;
-   }
-
-   sub A_new_method
-   {
-       my $self = shift ;
-        my $key = shift ;
-        my $value = $self->FETCH($key) ;
-       return "[[$value]]" ;
-   }
-
-   1 ;
-EOM
-
-    close FILE ;
-
-    BEGIN { push @INC, '.'; }
-
-    eval 'use SubDB ; use Fcntl ;';
-    main::ok(13, $@ eq "") ;
-    my %h ;
-    my $X ;
-    eval '
-       $X = tie(%h, "SubDB","dbhash_tmp", O_RDWR|O_CREAT, 0640 );
-       ' ;
-
-    main::ok(14, $@ eq "") ;
-
-    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
-    main::ok(15, $@ eq "") ;
-    main::ok(16, $ret == 5) ;
-
-    $ret = eval '$X->A_new_method("fred") ' ;
-    main::ok(17, $@ eq "") ;
-    main::ok(18, $ret eq "[[5]]") ;
-
-    undef $X;
-    untie(%h);
-    unlink "SubDB.pm", <dbhash_tmp.*> ;
-
-}
-
-ok(19, !exists $h{'goner1'});
-ok(20, exists $h{'foo'});
-
-untie %h;
-unlink <Op_dbmx*>, $Dfile;
-
-{
-   # DBM Filter tests
-   use strict ;
-   use warnings ;
-   my (%h, $db) ;
-   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-
-   sub checkOutput
-   {
-       my($fk, $sk, $fv, $sv) = @_ ;
-       return
-           $fetch_key eq $fk && $store_key eq $sk && 
-          $fetch_value eq $fv && $store_value eq $sv &&
-          $_ eq 'original' ;
-   }
-   
-   unlink <Op_dbmx*>;
-   ok(21, $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ;
-
-   $db->filter_fetch_key   (sub { $fetch_key = $_ }) ;
-   $db->filter_store_key   (sub { $store_key = $_ }) ;
-   $db->filter_fetch_value (sub { $fetch_value = $_}) ;
-   $db->filter_store_value (sub { $store_value = $_ }) ;
-
-   $_ = "original" ;
-
-   $h{"fred"} = "joe" ;
-   #                   fk   sk     fv   sv
-   ok(22, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(23, $h{"fred"} eq "joe");
-   #                   fk    sk     fv    sv
-   ok(24, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(25, $db->FIRSTKEY() eq "fred") ;
-   #                    fk     sk  fv  sv
-   ok(26, checkOutput( "fred", "", "", "")) ;
-
-   # replace the filters, but remember the previous set
-   my ($old_fk) = $db->filter_fetch_key   
-                       (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
-   my ($old_sk) = $db->filter_store_key   
-                       (sub { $_ = lc $_ ; $store_key = $_ }) ;
-   my ($old_fv) = $db->filter_fetch_value 
-                       (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
-   my ($old_sv) = $db->filter_store_value 
-                       (sub { s/o/x/g; $store_value = $_ }) ;
-   
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"Fred"} = "Joe" ;
-   #                   fk   sk     fv    sv
-   ok(27, checkOutput( "", "fred", "", "Jxe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(28, $h{"Fred"} eq "[Jxe]");
-   #                   fk   sk     fv    sv
-   ok(29, checkOutput( "", "fred", "[Jxe]", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(30, $db->FIRSTKEY() eq "FRED") ;
-   #                   fk   sk     fv    sv
-   ok(31, checkOutput( "FRED", "", "", "")) ;
-
-   # put the original filters back
-   $db->filter_fetch_key   ($old_fk);
-   $db->filter_store_key   ($old_sk);
-   $db->filter_fetch_value ($old_fv);
-   $db->filter_store_value ($old_sv);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"fred"} = "joe" ;
-   ok(32, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(33, $h{"fred"} eq "joe");
-   ok(34, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(35, $db->FIRSTKEY() eq "fred") ;
-   ok(36, checkOutput( "fred", "", "", "")) ;
-
-   # delete the filters
-   $db->filter_fetch_key   (undef);
-   $db->filter_store_key   (undef);
-   $db->filter_fetch_value (undef);
-   $db->filter_store_value (undef);
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $h{"fred"} = "joe" ;
-   ok(37, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(38, $h{"fred"} eq "joe");
-   ok(39, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(40, $db->FIRSTKEY() eq "fred") ;
-   ok(41, checkOutput( "", "", "", "")) ;
-
-   undef $db ;
-   untie %h;
-   unlink <Op_dbmx*>;
-}
-
-{    
-    # DBM Filter with a closure
-
-    use strict ;
-     use warnings ;
-    my (%h, $db) ;
-
-    unlink <Op_dbmx*>;
-    ok(42, $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ;
-
-    my %result = () ;
-
-    sub Closure
-    {
-        my ($name) = @_ ;
-       my $count = 0 ;
-       my @kept = () ;
-
-       return sub { ++$count ; 
-                    push @kept, $_ ; 
-                    $result{$name} = "$name - $count: [@kept]" ;
-                  }
-    }
-
-    $db->filter_store_key(Closure("store key")) ;
-    $db->filter_store_value(Closure("store value")) ;
-    $db->filter_fetch_key(Closure("fetch key")) ;
-    $db->filter_fetch_value(Closure("fetch value")) ;
-
-    $_ = "original" ;
-
-    $h{"fred"} = "joe" ;
-    ok(43, $result{"store key"} eq "store key - 1: [fred]");
-    ok(44, $result{"store value"} eq "store value - 1: [joe]");
-    ok(45, !defined $result{"fetch key"} );
-    ok(46, !defined $result{"fetch value"} );
-    ok(47, $_ eq "original") ;
-
-    ok(48, $db->FIRSTKEY() eq "fred") ;
-    ok(49, $result{"store key"} eq "store key - 1: [fred]");
-    ok(50, $result{"store value"} eq "store value - 1: [joe]");
-    ok(51, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(52, ! defined $result{"fetch value"} );
-    ok(53, $_ eq "original") ;
-
-    $h{"jim"}  = "john" ;
-    ok(54, $result{"store key"} eq "store key - 2: [fred jim]");
-    ok(55, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(56, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(57, ! defined $result{"fetch value"} );
-    ok(58, $_ eq "original") ;
-
-    ok(59, $h{"fred"} eq "joe");
-    ok(60, $result{"store key"} eq "store key - 3: [fred jim fred]");
-    ok(61, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(62, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(63, $result{"fetch value"} eq "fetch value - 1: [joe]");
-    ok(64, $_ eq "original") ;
-
-    undef $db ;
-    untie %h;
-    unlink <Op_dbmx*>;
-}              
-
-{
-   # DBM Filter recursion detection
-   use strict ;
-   use warnings ;
-   my (%h, $db) ;
-   unlink <Op_dbmx*>;
-
-   ok(65, $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ;
-
-   $db->filter_store_key (sub { $_ = $h{$_} }) ;
-
-   eval '$h{1} = 1234' ;
-   ok(66, $@ =~ /^recursion detected in filter_store_key at/ );
-   
-   undef $db ;
-   untie %h;
-   unlink <Op_dbmx*>;
-}
-
-{
-    # Bug ID 20001013.009
-    #
-    # test that $hash{KEY} = undef doesn't produce the warning
-    #     Use of uninitialized value in null operation 
-    use warnings ;
-    use strict ;
-    use SDBM_File ;
-
-    unlink <Op_dbmx*>;
-    my %h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    ok(67, tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ;
-    $h{ABC} = undef;
-    ok(68, $a eq "") ;
-
-    untie %h;
-    unlink <Op_dbmx*>;
-}

diff --git a/t/lib/searchdict.t b/t/lib/searchdict.t
deleted file mode 100755 (executable)
index c36fdb8..0000000
--- a/t/lib/searchdict.t
+++ /dev/null
@@ -1,87 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-print "1..4\n";
-
-$DICT = <<EOT;
-Aarhus
-Aaron
-Ababa
-aback
-abaft
-abandon
-abandoned
-abandoning
-abandonment
-abandons
-abase
-abased
-abasement
-abasements
-abases
-abash
-abashed
-abashes
-abashing
-abasing
-abate
-abated
-abatement
-abatements
-abater
-abates
-abating
-Abba
-EOT
-
-use Search::Dict;
-
-open(DICT, "+>dict-$$") or die "Can't create dict-$$: $!";
-binmode DICT;                  # To make length expected one.
-print DICT $DICT;
-
-my $pos = look *DICT, "Ababa";
-chomp($word = <DICT>);
-print "not " if $pos < 0 || $word ne "Ababa";
-print "ok 1\n";
-
-if (ord('a') > ord('A') ) {  # ASCII
-
-    $pos = look *DICT, "foo";
-    chomp($word = <DICT>);
-
-    print "not " if $pos != length($DICT);  # will search to end of file
-    print "ok 2\n";
-
-    my $pos = look *DICT, "abash";
-    chomp($word = <DICT>);
-    print "not " if $pos < 0 || $word ne "abash";
-    print "ok 3\n";
-
-}
-else { # EBCDIC systems e.g. os390
-
-    $pos = look *DICT, "FOO";
-    chomp($word = <DICT>);
-
-    print "not " if $pos != length($DICT);  # will search to end of file
-    print "ok 2\n";
-
-    my $pos = look *DICT, "Abba";
-    chomp($word = <DICT>);
-    print "not " if $pos < 0 || $word ne "Abba";
-    print "ok 3\n";
-}
-
-$pos = look *DICT, "aarhus", 1, 1;
-chomp($word = <DICT>);
-
-print "not " if $pos < 0 || $word ne "Aarhus";
-print "ok 4\n";
-
-close DICT or die "cannot close";
-unlink "dict-$$";

diff --git a/t/lib/selectsaver.t b/t/lib/selectsaver.t
deleted file mode 100755 (executable)
index 3b58d70..0000000
--- a/t/lib/selectsaver.t
+++ /dev/null
@@ -1,28 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-print "1..3\n";
-
-use SelectSaver;
-
-open(FOO, ">foo-$$") || die;
-
-print "ok 1\n";
-{
-    my $saver = new SelectSaver(FOO);
-    print "foo\n";
-}
-
-# Get data written to file
-open(FOO, "foo-$$") || die;
-chomp($foo = <FOO>);
-close FOO;
-unlink "foo-$$";
-
-print "ok 2\n" if $foo eq "foo";
-
-print "ok 3\n";

diff --git a/t/lib/selfloader.t b/t/lib/selfloader.t
deleted file mode 100755 (executable)
index 6987f65..0000000
--- a/t/lib/selfloader.t
+++ /dev/null
@@ -1,208 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    $dir = "self-$$";
-    $sep = "/";
-
-    if ($^O eq 'MacOS') {
-       $dir = ":" . $dir;
-       $sep = ":";
-    }
-
-    @INC = $dir;
-    push @INC, '../lib';
-
-    print "1..19\n";
-
-    # First we must set up some selfloader files
-    mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
-
-    open(FOO, ">$dir${sep}Foo.pm") or die;
-    print FOO <<'EOT';
-package Foo;
-use SelfLoader;
-
-sub new { bless {}, shift }
-sub foo;
-sub bar;
-sub bazmarkhianish;
-sub a;
-sub never;    # declared but definition should never be read
-1;
-__DATA__
-
-sub foo { shift; shift || "foo" };
-
-sub bar { shift; shift || "bar" }
-
-sub bazmarkhianish { shift; shift || "baz" }
-
-package sheep;
-sub bleat { shift; shift || "baa" }
-
-__END__
-sub never { die "D'oh" }
-EOT
-
-    close(FOO);
-
-    open(BAR, ">$dir${sep}Bar.pm") or die;
-    print BAR <<'EOT';
-package Bar;
-use SelfLoader;
-
-@ISA = 'Baz';
-
-sub new { bless {}, shift }
-sub a;
-
-1;
-__DATA__
-
-sub a { 'a Bar'; }
-sub b { 'b Bar' }
-
-__END__ DATA
-sub never { die "D'oh" }
-EOT
-
-    close(BAR);
-};
-
-
-package Baz;
-
-sub a { 'a Baz' }
-sub b { 'b Baz' }
-sub c { 'c Baz' }
-
-
-package main;
-use Foo;
-use Bar;
-
-$foo = new Foo;
-
-print "not " unless $foo->foo eq 'foo';  # selfloaded first time
-print "ok 1\n";
-
-print "not " unless $foo->foo eq 'foo';  # regular call
-print "ok 2\n";
-
-# Try an undefined method
-eval {
-    $foo->will_fail;
-};
-if ($@ =~ /^Undefined subroutine/) {
-    print "ok 3\n";
-} else {
-    print "not ok 3 $@\n";
-}
-
-# Used to be trouble with this
-eval {
-    my $foo = new Foo;
-    die "oops";
-};
-if ($@ =~ /oops/) {
-    print "ok 4\n";
-} else {
-    print "not ok 4 $@\n";
-}
-
-# Pass regular expression variable to autoloaded function.  This used
-# to go wrong in AutoLoader because it used regular expressions to generate
-# autoloaded filename.
-"foo" =~ /(\w+)/;
-print "not " unless $1 eq 'foo';
-print "ok 5\n";
-
-print "not " unless $foo->bar($1) eq 'foo';
-print "ok 6\n";
-
-print "not " unless $foo->bar($1) eq 'foo';
-print "ok 7\n";
-
-print "not " unless $foo->bazmarkhianish($1) eq 'foo';
-print "ok 8\n";
-
-print "not " unless $foo->bazmarkhianish($1) eq 'foo';
-print "ok 9\n";
-
-# Check nested packages inside __DATA__
-print "not " unless sheep::bleat()  eq 'baa';
-print "ok 10\n";
-
-# Now check inheritance:
-
-$bar = new Bar;
-
-# Before anything is SelfLoaded there is no declaration of Foo::b so we should
-# get Baz::b
-print "not " unless $bar->b() eq 'b Baz';
-print "ok 11\n";
-
-# There is no Bar::c so we should get Baz::c
-print "not " unless $bar->c() eq 'c Baz';
-print "ok 12\n";
-
-# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side
-# effect
-print "not " unless $bar->a() eq 'a Bar';
-print "ok 13\n";
-
-print "not " unless $bar->b() eq 'b Bar';
-print "ok 14\n";
-
-print "not " unless $bar->c() eq 'c Baz';
-print "ok 15\n";
-
-
-
-# Check that __END__ is honoured
-# Try an subroutine that should never be noticed by selfloader
-eval {
-    $foo->never;
-};
-if ($@ =~ /^Undefined subroutine/) {
-    print "ok 16\n";
-} else {
-    print "not ok 16 $@\n";
-}
-
-# Try to read from the data file handle
-my $foodata = <Foo::DATA>;
-close Foo::DATA;
-if (defined $foodata) {
-    print "not ok 17 # $foodata\n";
-} else {
-    print "ok 17\n";
-}
-
-# Check that __END__ DATA is honoured
-# Try an subroutine that should never be noticed by selfloader
-eval {
-    $bar->never;
-};
-if ($@ =~ /^Undefined subroutine/) {
-    print "ok 18\n";
-} else {
-    print "not ok 18 $@\n";
-}
-
-# Try to read from the data file handle
-my $bardata = <Bar::DATA>;
-close Bar::DATA;
-if ($bardata ne "sub never { die \"D'oh\" }\n") {
-    print "not ok 19 # $bardata\n";
-} else {
-    print "ok 19\n";
-}
-
-# cleanup
-END {
-return unless $dir && -d $dir;
-unlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm";
-rmdir "$dir";
-}

diff --git a/t/lib/selfstubber.t b/t/lib/selfstubber.t
deleted file mode 100644 (file)
index 2e74a02..0000000
--- a/t/lib/selfstubber.t
+++ /dev/null
@@ -1,285 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use strict;
-use Devel::SelfStubber;
-
-my $runperl = "$^X \"-I../lib\"";
-
-# ensure correct output ordering for system() calls
-
-select STDERR; $| = 1; select STDOUT; $| = 1;
-
-print "1..12\n";
-
-my @cleanup;
-
-END {
-  foreach my $file (reverse @cleanup) {
-    unlink $file or warn "unlink $file failed: $!" while -f $file;
-    rmdir $file or warn "rmdir $file failed: $!" if -d $file;
-  }
-}
-
-my $inlib = "SSI-$$";
-mkdir $inlib, 0777 or die $!;
-push @cleanup, $inlib;
-
-while (<DATA>) {
-  if (/^\#{16,}\s+(.*)/) {
-    my $file = "$inlib/$1";
-    push @cleanup, $file;
-    open FH, ">$file" or die $!;
-  } else {
-    print FH;
-  }
-}
-close FH;
-
-{
-  my $file = "A-$$";
-  push @cleanup, $file;
-  open FH, ">$file" or die $!;
-  select FH;
-  Devel::SelfStubber->stub('Child', $inlib);
-  select STDOUT;
-  print "ok 1\n";
-  close FH or die $!;
-
-  open FH, $file or die $!;
-  my @A = <FH>;
-
-  if (@A == 1 && $A[0] =~ /^\s*sub\s+Child::foo\s*;\s*$/) {
-    print "ok 2\n";
-  } else {
-    print "not ok 2\n";
-    print "# $_" foreach (@A);
-  }
-}
-
-{
-  my $file = "B-$$";
-  push @cleanup, $file;
-  open FH, ">$file" or die $!;
-  select FH;
-  Devel::SelfStubber->stub('Proto', $inlib);
-  select STDOUT;
-  print "ok 3\n"; # Checking that we did not die horribly.
-  close FH or die $!;
-
-  open FH, $file or die $!;
-  my @B = <FH>;
-
-  if (@B == 1 && $B[0] =~ /^\s*sub\s+Proto::bar\s*\(\$\$\);\s*$/) {
-    print "ok 4\n";
-  } else {
-    print "not ok 4\n";
-    print "# $_" foreach (@B);
-  }
-
-  close FH or die $!;
-}
-
-{
-  my $file = "C-$$";
-  push @cleanup, $file;
-  open FH, ">$file" or die $!;
-  select FH;
-  Devel::SelfStubber->stub('Attribs', $inlib);
-  select STDOUT;
-  print "ok 5\n"; # Checking that we did not die horribly.
-  close FH or die $!;
-
-  open FH, $file or die $!;
-  my @C = <FH>;
-
-  if (@C == 2 && $C[0] =~ /^\s*sub\s+Attribs::baz\s+:\s*locked\s*;\s*$/
-      && $C[1] =~ /^\s*sub\s+Attribs::lv\s+:\s*lvalue\s*:\s*method\s*;\s*$/) {
-    print "ok 6\n";
-  } else {
-    print "not ok 6\n";
-    print "# $_" foreach (@C);
-  }
-
-  close FH or die $!;
-}
-
-# "wrong" and "right" may change if SelfLoader is changed.
-my %wrong = ( Parent => 'Parent', Child => 'Parent' );
-my %right = ( Parent => 'Parent', Child => 'Child' );
-if ($^O eq 'VMS') {
-    # extra line feeds for MBX IPC
-    %wrong = ( Parent => "Parent\n", Child => "Parent\n" );
-    %right = ( Parent => "Parent\n", Child => "Child\n" );
-}
-my @module = qw(Parent Child)
-;
-sub fail {
-  my ($left, $right) = @_;
-  while (my ($key, $val) = each %$left) {
-    # warn "$key $val $$right{$key}";
-    return 1
-      unless $val eq $$right{$key};
-  }
-  return;
-}
-
-sub faildump {
-  my ($expect, $got) = @_;
-  foreach (sort keys %$expect) {
-    print "# $_ expect '$$expect{$_}' got '$$got{$_}'\n";
-  }
-}
-
-# Now test that the module tree behaves "wrongly" as expected
-
-foreach my $module (@module) {
-  my $file = "$module--$$";
-  push @cleanup, $file;
-  open FH, ">$file" or die $!;
-  print FH "use $module;
-print ${module}->foo;
-";
-  close FH or die $!;
-}
-
-{
-  my %output;
-  foreach my $module (@module) {
-    print "# $runperl \"-I$inlib\" $module--$$\n";
-    ($output{$module} = `$runperl "-I$inlib" $module--$$`)
-      =~ s/\'s foo//;
-  }
-
-  if (&fail (\%wrong, \%output)) {
-    print "not ok 7\n", &faildump (\%wrong, \%output);
-  } else {
-    print "ok 7\n";
-  }
-}
-
-my $lib="SSO-$$";
-mkdir $lib, 0777 or die $!;
-push @cleanup, $lib;
-$Devel::SelfStubber::JUST_STUBS=0;
-
-undef $/;
-foreach my $module (@module, 'Data', 'End') {
-  my $file = "$lib/$module.pm";
-  open FH, "$inlib/$module.pm" or die $!;
-  my $contents = <FH>;
-  close FH or die $!;
-  push @cleanup, $file;
-  open FH, ">$file" or die $!;
-  select FH;
-  if ($contents =~ /__DATA__/) {
-    # This will die for any module with no  __DATA__
-    Devel::SelfStubber->stub($module, $inlib);
-  } else {
-    print $contents;
-  }
-  select STDOUT;
-  close FH or die $!;
-}
-print "ok 8\n";
-
-{
-  my %output;
-  foreach my $module (@module) {
-    print "# $runperl \"-I$lib\" $module--$$\n";
-    ($output{$module} = `$runperl "-I$lib" $module--$$`)
-      =~ s/\'s foo//;
-  }
-
-  if (&fail (\%right, \%output)) {
-    print "not ok 9\n", &faildump (\%right, \%output);
-  } else {
-    print "ok 9\n";
-  }
-}
-
-# Check that the DATA handle stays open
-system "$runperl -w \"-I$lib\" \"-MData\" -e \"Data::ok\"";
-
-# Possibly a pointless test as this doesn't really verify that it's been
-# stubbed.
-system "$runperl -w \"-I$lib\" \"-MEnd\" -e \"End::lime\"";
-
-# But check that the documentation after the __END__ survived.
-open FH, "$lib/End.pm" or die $!;
-$_ = <FH>;
-close FH or die $!;
-
-if (/Did the documentation here survive\?/) {
-  print "ok 12\n";
-} else {
-  print "not ok 12 # information after an __END__ token seems to be lost\n";
-}
-
-__DATA__
-################ Parent.pm
-package Parent;
-
-sub foo {
-  return __PACKAGE__;
-}
-1;
-__END__
-################ Child.pm
-package Child;
-require Parent;
-@ISA = 'Parent';
-use SelfLoader;
-
-1;
-__DATA__
-sub foo {
-  return __PACKAGE__;
-}
-__END__
-################ Proto.pm
-package Proto;
-use SelfLoader;
-
-1;
-__DATA__
-sub bar ($$) {
-}
-################ Attribs.pm
-package Attribs;
-use SelfLoader;
-
-1;
-__DATA__
-sub baz : locked {
-}
-sub lv : lvalue : method {
-  my $a;
-  \$a;
-}
-################ Data.pm
-package Data;
-use SelfLoader;
-
-1;
-__DATA__
-sub ok {
-  print <DATA>;
-}
-__END__ DATA
-ok 10
-################ End.pm
-package End;
-use SelfLoader;
-
-1;
-__DATA__
-sub lime {
-  print "ok 11\n";
-}
-__END__
-Did the documentation here survive?

diff --git a/t/lib/sigaction.t b/t/lib/sigaction.t
deleted file mode 100644 (file)
index c38b122..0000000
--- a/t/lib/sigaction.t
+++ /dev/null
@@ -1,127 +0,0 @@
-#!./perl
-
-BEGIN {
-       chdir 't' if -d 't';
-       unshift @INC, '../lib';
-}
-
-BEGIN{
-       # Don't do anything if POSIX is missing, or sigaction missing.
-       eval { use POSIX; };
-       if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare') {
-               print "1..0\n";
-               exit 0;
-       }
-}
-
-use strict;
-use vars qw/$bad7 $ok10 $bad18 $ok/;
-
-$^W=1;
-
-print "1..18\n";
-
-sub IGNORE {
-       $bad7=1;
-}
-
-sub DEFAULT {
-       $bad18=1;
-}
-
-sub foo {
-       $ok=1;
-}
-
-my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
-my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0);
-
-{
-       my $bad;
-       local($SIG{__WARN__})=sub { $bad=1; };
-       sigaction(SIGHUP, $newaction, $oldaction);
-       if($bad) { print "not ok 1\n" } else { print "ok 1\n"}
-}
-
-if($oldaction->{HANDLER} eq 'DEFAULT' ||
-   $oldaction->{HANDLER} eq 'IGNORE')
-  { print "ok 2\n" } else { print "not ok 2 # ", $oldaction->{HANDLER}, "\n"}
-print $SIG{HUP} eq '::foo' ? "ok 3\n" : "not ok 3\n";
-
-sigaction(SIGHUP, $newaction, $oldaction);
-if($oldaction->{HANDLER} eq '::foo')
-  { print "ok 4\n" } else { print "not ok 4\n"}
-if($oldaction->{MASK}->ismember(SIGUSR1))
-  { print "ok 5\n" } else { print "not ok 5\n"}
-if($oldaction->{FLAGS}) {
-    if ($^O eq 'linux') {
-       print "ok 6 # Skip: sigaction() broken in $^O\n";
-    } else {
-       print "not ok 6\n";
-    }
-} else {
-    print "ok 6\n";
-}
-
-$newaction=POSIX::SigAction->new('IGNORE');
-sigaction(SIGHUP, $newaction);
-kill 'HUP', $$;
-print $bad7 ? "not ok 7\n" : "ok 7\n";
-
-print $SIG{HUP} eq 'IGNORE' ? "ok 8\n" : "not ok 8\n";
-sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
-print $SIG{HUP} eq 'DEFAULT' ? "ok 9\n" : "not ok 9\n";
-
-$newaction=POSIX::SigAction->new(sub { $ok10=1; });
-sigaction(SIGHUP, $newaction);
-{
-       local($^W)=0;
-       kill 'HUP', $$;
-}
-print $ok10 ? "ok 10\n" : "not ok 10\n";
-
-print ref($SIG{HUP}) eq 'CODE' ? "ok 11\n" : "not ok 11\n";
-
-sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
-# Make sure the signal mask gets restored after sigaction croak()s.
-eval {
-       my $act=POSIX::SigAction->new('::foo');
-       delete $act->{HANDLER};
-       sigaction(SIGINT, $act);
-};
-kill 'HUP', $$;
-print $ok ? "ok 12\n" : "not ok 12\n";
-
-undef $ok;
-# Make sure the signal mask gets restored after sigaction returns early.
-my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
-kill 'HUP', $$;
-print !$x && $ok ? "ok 13\n" : "not ok 13\n";
-
-$SIG{HUP}=sub {};
-sigaction(SIGHUP, $newaction, $oldaction);
-print ref($oldaction->{HANDLER}) eq 'CODE' ? "ok 14\n" : "not ok 14\n";
-
-eval {
-       sigaction(SIGHUP, undef, $oldaction);
-};
-print $@ ? "not ok 15\n" : "ok 15\n";
-
-eval {
-       sigaction(SIGHUP, 0, $oldaction);
-};
-print $@ ? "not ok 16\n" : "ok 16\n";
-
-eval {
-       sigaction(SIGHUP, bless({},'Class'), $oldaction);
-};
-print $@ ? "ok 17\n" : "not ok 17\n";
-
-$newaction=POSIX::SigAction->new(sub { $ok10=1; });
-sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
-{
-       local($^W)=0;
-       kill 'CONT', $$;
-}
-print $bad18 ? "not ok 18\n" : "ok 18\n";
-

diff --git a/t/lib/socket.t b/t/lib/socket.t
deleted file mode 100755 (executable)
index 481fd8f..0000000
--- a/t/lib/socket.t
+++ /dev/null
@@ -1,87 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bSocket\b/ && 
-        !(($^O eq 'VMS') && $Config{d_socket})) {
-       print "1..0\n";
-       exit 0;
-    }
-}
-       
-use Socket;
-
-print "1..8\n";
-
-if (socket(T,PF_INET,SOCK_STREAM,6)) {
-  print "ok 1\n";
-
-  if (connect(T,pack_sockaddr_in(7,inet_aton("localhost")))){
-       print "ok 2\n";
-
-       print "# Connected to " .
-               inet_ntoa((unpack_sockaddr_in(getpeername(T)))[1])."\n";
-
-       syswrite(T,"hello",5);
-       $read = sysread(T,$buff,10);    # Connection may be granted, then closed!
-       while ($read > 0 && length($buff) < 5) {
-           # adjust for fact that TCP doesn't guarantee size of reads/writes
-           $read = sysread(T,$buff,10,length($buff));
-       }
-       print(($read == 0 || $buff eq "hello") ? "ok 3\n" : "not ok 3\n");
-  }
-  else {
-       print "# You're allowed to fail tests 2 and 3 if.\n";
-       print "# The echo service has been disabled.\n";
-       print "# $!\n";
-       print "ok 2\n";
-       print "ok 3\n";
-  }
-}
-else {
-       print "# $!\n";
-       print "not ok 1\n";
-}
-
-if( socket(S,PF_INET,SOCK_STREAM,6) ){
-  print "ok 4\n";
-
-  if (connect(S,pack_sockaddr_in(7,INADDR_LOOPBACK))){
-       print "ok 5\n";
-
-       print "# Connected to " .
-               inet_ntoa((unpack_sockaddr_in(getpeername(S)))[1])."\n";
-
-       syswrite(S,"olleh",5);
-       $read = sysread(S,$buff,10);    # Connection may be granted, then closed!
-       while ($read > 0 && length($buff) < 5) {
-           # adjust for fact that TCP doesn't guarantee size of reads/writes
-           $read = sysread(S,$buff,10,length($buff));
-       }
-       print(($read == 0 || $buff eq "olleh") ? "ok 6\n" : "not ok 6\n");
-  }
-  else {
-       print "# You're allowed to fail tests 5 and 6 if.\n";
-       print "# The echo service has been disabled.\n";
-       print "# $!\n";
-       print "ok 5\n";
-       print "ok 6\n";
-  }
-}
-else {
-       print "# $!\n";
-       print "not ok 4\n";
-}
-
-# warnings
-$SIG{__WARN__} = sub {
-    ++ $w if $_[0] =~ /^6-ARG sockaddr_in call is deprecated/ ;
-} ;
-$w = 0 ;
-sockaddr_in(1,2,3,4,5,6) ;
-print ($w == 1 ? "not ok 7\n" : "ok 7\n") ;
-use warnings 'Socket' ;
-sockaddr_in(1,2,3,4,5,6) ;
-print ($w == 1 ? "ok 8\n" : "not ok 8\n") ;

diff --git a/t/lib/soundex.t b/t/lib/soundex.t
deleted file mode 100755 (executable)
index d35f264..0000000
--- a/t/lib/soundex.t
+++ /dev/null
@@ -1,143 +0,0 @@
-#!./perl
-#
-# $Id: soundex.t,v 1.2 1994/03/24 00:30:27 mike Exp $
-#
-# test module for soundex.pl
-#
-# $Log: soundex.t,v $
-# Revision 1.2  1994/03/24  00:30:27  mike
-# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
-# in the way I handles leasing characters which were different but had
-# the same soundex code.  This showed up comparing it with Oracle's
-# soundex output.
-#
-# Revision 1.1  1994/03/02  13:03:02  mike
-# Initial revision
-#
-#
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use Text::Soundex;
-
-$test = 0;
-print "1..13\n";
-
-while (<DATA>)
-{
-  chop;
-  next if /^\s*;?#/;
-  next if /^\s*$/;
-
-  ++$test;
-  $bad = 0;
-
-  if (/^eval\s+/)
-  {
-    ($try = $_) =~ s/^eval\s+//;
-
-    eval ($try);
-    if ($@)
-    {
-      $bad++;
-      print "not ok $test\n";
-      print "# eval '$try' returned $@";
-    }
-  }
-  elsif (/^\(/)
-  {
-    ($in, $out) = split (':');
-
-    $try = "\@expect = $out; \@got = &soundex $in;";
-    eval ($try);
-
-    if (@expect != @got)
-    {
-      $bad++;
-      print "not ok $test\n";
-      print "# expected ", scalar @expect, " results, got ", scalar @got, "\n";
-      print "# expected (", join (', ', @expect),
-           ") got (", join (', ', @got), ")\n";
-    }
-    else
-    {
-      while (@got)
-      {
-       $expect = shift @expect;
-       $got = shift @got;
-
-       if ($expect ne $got)
-       {
-         $bad++;
-         print "not ok $test\n";
-         print "# expected $expect, got $got\n";
-       }
-      }
-    }
-  }
-  else
-  {
-    ($in, $out) = split (':');
-
-    $try = "\$expect = $out; \$got = &soundex ($in);";
-    eval ($try);
-
-    if ($expect ne $got)
-    {
-      $bad++;
-      print "not ok $test\n";
-      print "# expected $expect, got $got\n";
-    }
-  }
-
-  print "ok $test\n" unless $bad;
-}
-
-__END__
-#
-# 1..6
-#
-# Knuth's test cases, scalar in, scalar out
-#
-'Euler':'E460'
-'Gauss':'G200'
-'Hilbert':'H416'
-'Knuth':'K530'
-'Lloyd':'L300'
-'Lukasiewicz':'L222'
-#
-# 7..8
-#
-# check default bad code
-#
-'2 + 2 = 4':undef
-undef:undef
-#
-# 9
-#
-# check array in, array out
-#
-('Ellery', 'Ghosh', 'Heilbronn', 'Kant', 'Ladd', 'Lissajous'):('E460', 'G200', 'H416', 'K530', 'L300', 'L222')
-#
-# 10
-#
-# check array with explicit undef
-#
-('Mike', undef, 'Stok'):('M200', undef, 'S320')
-#
-# 11..12
-#
-# check setting $Text::Soundex::noCode
-#
-eval $soundex_nocode = 'Z000';
-('Mike', undef, 'Stok'):('M200', 'Z000', 'S320')
-#
-# 13
-#
-# a subtle difference between me & oracle, spotted by Rich Pinder
-# <rpinder@hsc.usc.edu>
-#
-CZARKOWSKA:C622

diff --git a/t/lib/st-06compat.t b/t/lib/st-06compat.t
deleted file mode 100644 (file)
index 1586b18..0000000
--- a/t/lib/st-06compat.t
+++ /dev/null
@@ -1,157 +0,0 @@
-#!./perl
-
-# $Id: compat-0.6.t,v 1.0.1.1 2001/02/17 12:26:21 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#
-# $Log: compat-0.6.t,v $
-# Revision 1.0.1.1  2001/02/17 12:26:21  ram
-# patch8: added EBCDIC version of the test, from Peter Prymmer
-#
-# Revision 1.0  2000/09/01 19:40:41  ram
-# Baseline for first official release.
-#
-
-BEGIN {
-    chdir('t') if -d 't';    
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-    require 'lib/st-dump.pl';
-}
-
-sub ok;
-
-print "1..8\n";
-
-use Storable qw(freeze nfreeze thaw);
-
-package TIED_HASH;
-
-sub TIEHASH {
-       my $self = bless {}, shift;
-       return $self;
-}
-
-sub FETCH {
-       my $self = shift;
-       my ($key) = @_;
-       $main::hash_fetch++;
-       return $self->{$key};
-}
-
-sub STORE {
-       my $self = shift;
-       my ($key, $val) = @_;
-       $self->{$key} = $val;
-}
-
-package SIMPLE;
-
-sub make {
-       my $self = bless [], shift;
-       my ($x) = @_;
-       $self->[0] = $x;
-       return $self;
-}
-
-package ROOT;
-
-sub make {
-       my $self = bless {}, shift;
-       my $h = tie %hash, TIED_HASH;
-       $self->{h} = $h;
-       $self->{ref} = \%hash;
-       my @pool;
-       for (my $i = 0; $i < 5; $i++) {
-               push(@pool, SIMPLE->make($i));
-       }
-       $self->{obj} = \@pool;
-       my @a = ('string', $h, $self);
-       $self->{a} = \@a;
-       $self->{num} = [1, 0, -3, -3.14159, 456, 4.5];
-       $h->{key1} = 'val1';
-       $h->{key2} = 'val2';
-       return $self;
-};
-
-sub num { $_[0]->{num} }
-sub h   { $_[0]->{h} }
-sub ref { $_[0]->{ref} }
-sub obj { $_[0]->{obj} }
-
-package main;
-
-my $is_EBCDIC = (ord('A') == 193) ? 1 : 0;
- 
-my $r = ROOT->make;
-
-my $data = '';
-if (!$is_EBCDIC) {                     # ASCII machine
-       while (<DATA>) {
-               next if /^#/;
-           $data .= unpack("u", $_);
-       }
-} else {
-       while (<DATA>) {
-               next if /^#$/;          # skip comments
-               next if /^#\s+/;        # skip comments
-               next if /^[^#]/;        # skip uuencoding for ASCII machines
-               s/^#//;                         # prepare uuencoded data for EBCDIC machines
-               $data .= unpack("u", $_);
-       }
-}
-
-my $expected_length = $is_EBCDIC ? 217 : 278;
-ok 1, length $data == $expected_length;
-  
-my $y = thaw($data);
-ok 2, 1;
-ok 3, ref $y eq 'ROOT';
-
-$Storable::canonical = 1;              # Prevent "used once" warning
-$Storable::canonical = 1;
-# Allow for long double string conversions.
-$y->{num}->[3] += 0;
-$r->{num}->[3] += 0;
-ok 4, nfreeze($y) eq nfreeze($r);
-
-ok 5, $y->ref->{key1} eq 'val1';
-ok 6, $y->ref->{key2} eq 'val2';
-ok 7, $hash_fetch == 2;
-
-my $num = $r->num;
-my $ok = 1;
-for (my $i = 0; $i < @$num; $i++) {
-       do { $ok = 0; last } unless $num->[$i] == $y->num->[$i];
-}
-ok 8, $ok;
-
-__END__
-#
-# using Storable-0.6@11, output of: print pack("u", nfreeze(ROOT->make));
-# original size: 278 bytes
-#
-M`P,````%!`(````&"(%8"(!8"'U8"@@M,RXQ-#$U.5@)```!R%@*`S0N-5A8
-M6`````-N=6T$`P````(*!'9A;#%8````!&ME>3$*!'9A;#)8````!&ME>3)B
-M"51)141?2$%32%A8`````6@$`@````,*!G-T<FEN9U@$``````I8!```````
-M6%A8`````6$$`@````4$`@````$(@%AB!E-)35!,15A8!`(````!"(%88@93
-M24U03$586`0"`````0B"6&(&4TE-4$Q%6%@$`@````$(@UAB!E-)35!,15A8
-M!`(````!"(188@9324U03$586%A8`````V]B:@0,!``````*6%A8`````W)E
-(9F($4D]/5%@`
-#
-# using Storable-0.6@11, output of: print '#' . pack("u", nfreeze(ROOT->make));
-# on OS/390 (cp 1047) original size: 217 bytes
-#
-#M!0,1!-G6UN,#````!00,!!$)X\G%Q&W(P>+(`P````(*!*6!D_$````$DH6H
-#M\0H$I8&3\@````22A:CR`````YF%A@0"````!@B!"(`(?0H(8/-+\?3Q]?D)
-#M```!R`H#]$OU`````Y6DE`0"````!001!N+)U-?3Q0(````!"(`$$@("````
-#M`0B!!!("`@````$(@@02`@(````!"(,$$@("`````0B$`````Y:"D00`````
-#E!`````&(!`(````#"@:BHYF)E8<$``````0$```````````!@0``

diff --git a/t/lib/st-blessed.t b/t/lib/st-blessed.t
deleted file mode 100644 (file)
index b1a18e6..0000000
--- a/t/lib/st-blessed.t
+++ /dev/null
@@ -1,104 +0,0 @@
-#!./perl
-
-# $Id: blessed.t,v 1.0 2000/09/01 19:40:41 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#
-# $Log: blessed.t,v $
-# Revision 1.0  2000/09/01 19:40:41  ram
-# Baseline for first official release.
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-    require 'lib/st-dump.pl';
-}
-
-sub ok;
-
-use Storable qw(freeze thaw);
-
-print "1..10\n";
-
-package SHORT_NAME;
-
-sub make { bless [], shift }
-
-package SHORT_NAME_WITH_HOOK;
-
-sub make { bless [], shift }
-
-sub STORABLE_freeze {
-       my $self = shift;
-       return ("", $self);
-}
-
-sub STORABLE_thaw {
-       my $self = shift;
-       my $cloning = shift;
-       my ($x, $obj) = @_;
-       die "STORABLE_thaw" unless $obj eq $self;
-}
-
-package main;
-
-# Still less than 256 bytes, so long classname logic not fully exercised
-# Wait until Perl removes the restriction on identifier lengths.
-my $name = "LONG_NAME_" . 'xxxxxxxxxxxxx::' x 14 . "final";
-
-eval <<EOC;
-package $name;
-
-\@ISA = ("SHORT_NAME");
-EOC
-die $@ if $@;
-ok 1, $@ eq '';
-
-eval <<EOC;
-package ${name}_WITH_HOOK;
-
-\@ISA = ("SHORT_NAME_WITH_HOOK");
-EOC
-ok 2, $@ eq '';
-
-# Construct a pool of objects
-my @pool;
-
-for (my $i = 0; $i < 10; $i++) {
-       push(@pool, SHORT_NAME->make);
-       push(@pool, SHORT_NAME_WITH_HOOK->make);
-       push(@pool, $name->make);
-       push(@pool, "${name}_WITH_HOOK"->make);
-}
-
-my $x = freeze \@pool;
-ok 3, 1;
-
-my $y = thaw $x;
-ok 4, ref $y eq 'ARRAY';
-ok 5, @{$y} == @pool;
-
-ok 6, ref $y->[0] eq 'SHORT_NAME';
-ok 7, ref $y->[1] eq 'SHORT_NAME_WITH_HOOK';
-ok 8, ref $y->[2] eq $name;
-ok 9, ref $y->[3] eq "${name}_WITH_HOOK";
-
-my $good = 1;
-for (my $i = 0; $i < 10; $i++) {
-       do { $good = 0; last } unless ref $y->[4*$i]   eq 'SHORT_NAME';
-       do { $good = 0; last } unless ref $y->[4*$i+1] eq 'SHORT_NAME_WITH_HOOK';
-       do { $good = 0; last } unless ref $y->[4*$i+2] eq $name;
-       do { $good = 0; last } unless ref $y->[4*$i+3] eq "${name}_WITH_HOOK";
-}
-ok 10, $good;
-

diff --git a/t/lib/st-canonical.t b/t/lib/st-canonical.t
deleted file mode 100644 (file)
index b55669b..0000000
--- a/t/lib/st-canonical.t
+++ /dev/null
@@ -1,153 +0,0 @@
-#!./perl
-
-# $Id: canonical.t,v 1.0 2000/09/01 19:40:41 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#  
-# $Log: canonical.t,v $
-# Revision 1.0  2000/09/01 19:40:41  ram
-# Baseline for first official release.
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-}
-
-
-use Storable qw(freeze thaw dclone);
-use vars qw($debugging $verbose);
-
-print "1..8\n";
-
-sub ok {
-    my($testno, $ok) = @_;
-    print "not " unless $ok;
-    print "ok $testno\n";
-}
-
-
-# Uncomment the folowing line to get a dump of the constructed data structure
-# (you may want to reduce the size of the hashes too)
-# $debugging = 1;
-
-$hashsize = 100;
-$maxhash2size = 100;
-$maxarraysize = 100;
-
-# Use MD5 if its available to make random string keys
-
-eval { require "MD5.pm" };
-$gotmd5 = !$@;
-
-# Use Data::Dumper if debugging and it is available to create an ASCII dump
-
-if ($debugging) {
-    eval { require "Data/Dumper.pm" };
-    $gotdd  = !$@;
-}
-
-@fixed_strings = ("January", "February", "March", "April", "May", "June",
-                 "July", "August", "September", "October", "November", "December" );
-
-# Build some arbitrarily complex data structure starting with a top level hash
-# (deeper levels contain scalars, references to hashes or references to arrays);
-
-for (my $i = 0; $i < $hashsize; $i++) {
-       my($k) = int(rand(1_000_000));
-       $k = MD5->hexhash($k) if $gotmd5 and int(rand(2));
-       $a1{$k} = { key => "$k", value => $i };
-
-       # A third of the elements are references to further hashes
-
-       if (int(rand(1.5))) {
-               my($hash2) = {};
-               my($hash2size) = int(rand($maxhash2size));
-               while ($hash2size--) {
-                       my($k2) = $k . $i . int(rand(100));
-                       $hash2->{$k2} = $fixed_strings[rand(int(@fixed_strings))];
-               }
-               $a1{$k}->{value} = $hash2;
-       }
-
-       # A further third are references to arrays
-
-       elsif (int(rand(2))) {
-               my($arr_ref) = [];
-               my($arraysize) = int(rand($maxarraysize));
-               while ($arraysize--) {
-                       push(@$arr_ref, $fixed_strings[rand(int(@fixed_strings))]);
-               }
-               $a1{$k}->{value} = $arr_ref;
-       }       
-}
-
-
-print STDERR Data::Dumper::Dumper(\%a1) if ($verbose and $gotdd);
-
-
-# Copy the hash, element by element in order of the keys
-
-foreach $k (sort keys %a1) {
-    $a2{$k} = { key => "$k", value => $a1{$k}->{value} };
-}
-
-# Deep clone the hash
-
-$a3 = dclone(\%a1);
-
-# In canonical mode the frozen representation of each of the hashes
-# should be identical
-
-$Storable::canonical = 1;
-
-$x1 = freeze(\%a1);
-$x2 = freeze(\%a2);
-$x3 = freeze($a3);
-
-ok 1, (length($x1) > $hashsize);       # sanity check
-ok 2, length($x1) == length($x2);      # idem
-ok 3, $x1 eq $x2;
-ok 4, $x1 eq $x3;
-
-# In normal mode it is exceedingly unlikely that the frozen
-# representaions of all the hashes will be the same (normally the hash
-# elements are frozen in the order they are stored internally,
-# i.e. pseudo-randomly).
-
-$Storable::canonical = 0;
-
-$x1 = freeze(\%a1);
-$x2 = freeze(\%a2);
-$x3 = freeze($a3);
-
-
-# Two out of three the same may be a coincidence, all three the same
-# is much, much more unlikely.  Still it could happen, so this test
-# may report a false negative.
-
-ok 5, ($x1 ne $x2) || ($x1 ne $x3);    
-
-
-# Ensure refs to "undef" values are properly shared
-# Same test as in t/dclone.t to ensure the "canonical" code is also correct
-
-my $hash;
-push @{$$hash{''}}, \$$hash{a};
-ok 6, $$hash{''}[0] == \$$hash{a};
-
-my $cloned = dclone(dclone($hash));
-ok 7, $$cloned{''}[0] == \$$cloned{a};
-
-$$cloned{a} = "blah";
-ok 8, $$cloned{''}[0] == \$$cloned{a};
-

diff --git a/t/lib/st-dclone.t b/t/lib/st-dclone.t
deleted file mode 100644 (file)
index 38c82eb..0000000
--- a/t/lib/st-dclone.t
+++ /dev/null
@@ -1,82 +0,0 @@
-#!./perl
-
-# $Id: dclone.t,v 1.0 2000/09/01 19:40:41 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#
-# $Log: dclone.t,v $
-# Revision 1.0  2000/09/01 19:40:41  ram
-# Baseline for first official release.
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-    require 'lib/st-dump.pl';
-}
-
-
-use Storable qw(dclone);
-
-print "1..9\n";
-
-$a = 'toto';
-$b = \$a;
-$c = bless {}, CLASS;
-$c->{attribute} = 'attrval';
-%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
-@a = ('first', undef, 3, -4, -3.14159, 456, 4.5,
-       $b, \$a, $a, $c, \$c, \%a);
-
-print "not " unless defined ($aref = dclone(\@a));
-print "ok 1\n";
-
-$dumped = &dump(\@a);
-print "ok 2\n";
-
-$got = &dump($aref);
-print "ok 3\n";
-
-print "not " unless $got eq $dumped; 
-print "ok 4\n";
-
-package FOO; @ISA = qw(Storable);
-
-sub make {
-       my $self = bless {};
-       $self->{key} = \%main::a;
-       return $self;
-};
-
-package main;
-
-$foo = FOO->make;
-print "not " unless defined($r = $foo->dclone);
-print "ok 5\n";
-
-print "not " unless &dump($foo) eq &dump($r);
-print "ok 6\n";
-
-# Ensure refs to "undef" values are properly shared during cloning
-my $hash;
-push @{$$hash{''}}, \$$hash{a};
-print "not " unless $$hash{''}[0] == \$$hash{a};
-print "ok 7\n";
-
-my $cloned = dclone(dclone($hash));
-print "not " unless $$cloned{''}[0] == \$$cloned{a};
-print "ok 8\n";
-
-$$cloned{a} = "blah";
-print "not " unless $$cloned{''}[0] == \$$cloned{a};
-print "ok 9\n";
-

diff --git a/t/lib/st-forgive.t b/t/lib/st-forgive.t
deleted file mode 100644 (file)
index 5881098..0000000
--- a/t/lib/st-forgive.t
+++ /dev/null
@@ -1,67 +0,0 @@
-#!./perl
-
-# $Id: forgive.t,v 1.0.1.1 2000/09/01 19:40:42 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#
-# Original Author: Ulrich Pfeifer
-# (C) Copyright 1997, Universitat Dortmund, all rights reserved.
-#
-# $Log: forgive.t,v $
-# Revision 1.0.1.1  2000/09/01 19:40:42  ram
-# Baseline for first official release.
-#
-# Revision 1.0  2000/09/01 19:40:41  ram
-# Baseline for first official release.
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-}
-
-use Storable qw(store retrieve);
-use File::Spec;
-
-print "1..8\n";
-
-my $test = 1;
-my $bad = ['foo', sub { 1 },  'bar'];
-my $result;
-
-eval {$result = store ($bad , 'store')};
-print ((!defined $result)?"ok $test\n":"not ok $test\n"); $test++;
-print (($@ ne '')?"ok $test\n":"not ok $test\n"); $test++;
-
-$Storable::forgive_me=1;
-
-my $devnull = File::Spec->devnull;
-
-open(SAVEERR, ">&STDERR");
-open(STDERR, ">$devnull") or 
-  ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
-
-eval {$result = store ($bad , 'store')};
-
-open(STDERR, ">&SAVEERR");
-
-print ((defined $result)?"ok $test\n":"not ok $test\n"); $test++;
-print (($@ eq '')?"ok $test\n":"not ok $test\n"); $test++;
-
-my $ret = retrieve('store');
-print ((defined $ret)?"ok $test\n":"not ok $test\n"); $test++;
-print (($ret->[0] eq 'foo')?"ok $test\n":"not ok $test\n"); $test++;
-print (($ret->[2] eq 'bar')?"ok $test\n":"not ok $test\n"); $test++;
-print ((ref $ret->[1] eq 'SCALAR')?"ok $test\n":"not ok $test\n"); $test++;
-
-
-END { 1 while unlink 'store' }

diff --git a/t/lib/st-freeze.t b/t/lib/st-freeze.t
deleted file mode 100644 (file)
index 37631ed..0000000
--- a/t/lib/st-freeze.t
+++ /dev/null
@@ -1,119 +0,0 @@
-#!./perl
-
-# $Id: freeze.t,v 1.0 2000/09/01 19:40:41 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#
-# $Log: freeze.t,v $
-# Revision 1.0  2000/09/01 19:40:41  ram
-# Baseline for first official release.
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-    require 'lib/st-dump.pl';
-}
-
-
-use Storable qw(freeze nfreeze thaw);
-
-print "1..15\n";
-
-$a = 'toto';
-$b = \$a;
-$c = bless {}, CLASS;
-$c->{attribute} = $b;
-$d = {};
-$e = [];
-$d->{'a'} = $e;
-$e->[0] = $d;
-%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
-@a = ('first', undef, 3, -4, -3.14159, 456, 4.5, $d, \$d, \$e, $e,
-       $b, \$a, $a, $c, \$c, \%a);
-
-print "not " unless defined ($f1 = freeze(\@a));
-print "ok 1\n";
-
-$dumped = &dump(\@a);
-print "ok 2\n";
-
-$root = thaw($f1);
-print "not " unless defined $root;
-print "ok 3\n";
-
-$got = &dump($root);
-print "ok 4\n";
-
-print "not " unless $got eq $dumped; 
-print "ok 5\n";
-
-package FOO; @ISA = qw(Storable);
-
-sub make {
-       my $self = bless {};
-       $self->{key} = \%main::a;
-       return $self;
-};
-
-package main;
-
-$foo = FOO->make;
-print "not " unless $f2 = $foo->freeze;
-print "ok 6\n";
-
-print "not " unless $f3 = $foo->nfreeze;
-print "ok 7\n";
-
-$root3 = thaw($f3);
-print "not " unless defined $root3;
-print "ok 8\n";
-
-print "not " unless &dump($foo) eq &dump($root3);
-print "ok 9\n";
-
-$root = thaw($f2);
-print "not " unless &dump($foo) eq &dump($root);
-print "ok 10\n";
-
-print "not " unless &dump($root3) eq &dump($root);
-print "ok 11\n";
-
-$other = freeze($root);
-print "not " unless length($other) == length($f2);
-print "ok 12\n";
-
-$root2 = thaw($other);
-print "not " unless &dump($root2) eq &dump($root);
-print "ok 13\n";
-
-$VAR1 = [
-       'method',
-       1,
-       'prepare',
-       'SELECT table_name, table_owner, num_rows FROM iitables
-                  where table_owner != \'$ingres\' and table_owner != \'DBA\''
-];
-
-$x = nfreeze($VAR1);
-$VAR2 = thaw($x);
-print "not " unless $VAR2->[3] eq $VAR1->[3];
-print "ok 14\n";
-
-# Test the workaround for LVALUE bug in perl 5.004_04 -- from Gisle Aas
-sub foo { $_[0] = 1 }
-$foo = [];
-foo($foo->[1]);
-eval { freeze($foo) };
-print "not " if $@;
-print "ok 15\n";
-

diff --git a/t/lib/st-lock.t b/t/lib/st-lock.t
deleted file mode 100644 (file)
index 77d73bb..0000000
--- a/t/lib/st-lock.t
+++ /dev/null
@@ -1,61 +0,0 @@
-#!./perl
-
-# $Id: lock.t,v 1.0.1.4 2001/01/03 09:41:00 ram Exp $
-#
-#  @COPYRIGHT@
-#
-# $Log: lock.t,v $
-# Revision 1.0.1.4  2001/01/03 09:41:00  ram
-# patch7: use new CAN_FLOCK routine to determine whether to run tests
-#
-# Revision 1.0.1.3  2000/10/26 17:11:27  ram
-# patch5: just check $^O, there's no need for the whole Config
-#
-# Revision 1.0.1.2  2000/10/23 18:03:07  ram
-# patch4: protected calls to flock() for dos platform
-#
-# Revision 1.0.1.1  2000/09/28 21:44:06  ram
-# patch2: created.
-#
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-
-    require 'lib/st-dump.pl';
-}
-
-sub ok;
-
-use Storable qw(lock_store lock_retrieve);
-
-unless (&Storable::CAN_FLOCK) {
-    print "1..0 # Skip: fcntl/flock emulation broken on this platform\n";
-       exit 0;
-}
-
-print "1..5\n";
-
-@a = ('first', undef, 3, -4, -3.14159, 456, 4.5);
-
-#
-# We're just ensuring things work, we're not validating locking.
-#
-
-ok 1, defined lock_store(\@a, 'store');
-ok 2, $dumped = &dump(\@a);
-
-$root = lock_retrieve('store');
-ok 3, ref $root eq 'ARRAY';
-ok 4, @a == @$root;
-ok 5, &dump($root) eq $dumped; 
-
-unlink 't/store';
-

diff --git a/t/lib/st-overload.t b/t/lib/st-overload.t
deleted file mode 100644 (file)
index 6d1e581..0000000
--- a/t/lib/st-overload.t
+++ /dev/null
@@ -1,97 +0,0 @@
-#!./perl
-
-# $Id: overload.t,v 1.0.1.1 2001/02/17 12:27:22 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#  
-# $Log: overload.t,v $
-# Revision 1.0.1.1  2001/02/17 12:27:22  ram
-# patch8: added test for structures with indirect ref to overloaded
-#
-# Revision 1.0  2000/09/01 19:40:42  ram
-# Baseline for first official release.
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-    require 'lib/st-dump.pl';
-}
-
-sub ok;
-
-use Storable qw(freeze thaw);
-
-print "1..12\n";
-
-package OVERLOADED;
-
-use overload
-       '""' => sub { $_[0][0] };
-
-package main;
-
-$a = bless [77], OVERLOADED;
-
-$b = thaw freeze $a;
-ok 1, ref $b eq 'OVERLOADED';
-ok 2, "$b" eq "77";
-
-$c = thaw freeze \$a;
-ok 3, ref $c eq 'REF';
-ok 4, ref $$c eq 'OVERLOADED';
-ok 5, "$$c" eq "77";
-
-$d = thaw freeze [$a, $a];
-ok 6, "$d->[0]" eq "77";
-$d->[0][0]++;
-ok 7, "$d->[1]" eq "78";
-
-package REF_TO_OVER;
-
-sub make {
-       my $self = bless {}, shift;
-       my ($over) = @_;
-       $self->{over} = $over;
-       return $self;
-}
-
-package OVER;
-
-use overload
-       '+'             => \&plus,
-       '""'    => sub { ref $_[0] };
-
-sub plus {
-       return 314;
-}
-
-sub make {
-       my $self = bless {}, shift;
-       my $ref = REF_TO_OVER->make($self);
-       $self->{ref} = $ref;
-       return $self;
-}
-
-package main;
-
-$a = OVER->make();
-$b = thaw freeze $a;
-
-ok 8, ref $b eq 'OVER';
-ok 9, $a + $a == 314;
-ok 10, ref $b->{ref} eq 'REF_TO_OVER';
-ok 11, "$b->{ref}->{over}" eq "$b";
-ok 12, $b + $b == 314;
-
-1;
-

diff --git a/t/lib/st-recurse.t b/t/lib/st-recurse.t
deleted file mode 100644 (file)
index e3afc9c..0000000
--- a/t/lib/st-recurse.t
+++ /dev/null
@@ -1,300 +0,0 @@
-#!./perl
-
-# $Id: recurse.t,v 1.0.1.3 2001/02/17 12:28:33 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#  
-# $Log: recurse.t,v $
-# Revision 1.0.1.3  2001/02/17 12:28:33  ram
-# patch8: ensure blessing occurs ASAP, specially designed for hooks
-#
-# Revision 1.0.1.2  2000/11/05 17:22:05  ram
-# patch6: stress hook a little more with refs to lexicals
-#
-# $Log: recurse.t,v $
-# Revision 1.0.1.1  2000/09/17 16:48:05  ram
-# patch1: added test case for store hook bug
-#
-# $Log: recurse.t,v $
-# Revision 1.0  2000/09/01 19:40:42  ram
-# Baseline for first official release.
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-    require 'lib/st-dump.pl';
-}
-
-sub ok;
-
-use Storable qw(freeze thaw dclone);
-
-print "1..32\n";
-
-package OBJ_REAL;
-
-use Storable qw(freeze thaw);
-
-@x = ('a', 1);
-
-sub make { bless [], shift }
-
-sub STORABLE_freeze {
-       my $self = shift;
-       my $cloning = shift;
-       die "STORABLE_freeze" unless Storable::is_storing;
-       return (freeze(\@x), $self);
-}
-
-sub STORABLE_thaw {
-       my $self = shift;
-       my $cloning = shift;
-       my ($x, $obj) = @_;
-       die "STORABLE_thaw #1" unless $obj eq $self;
-       my $len = length $x;
-       my $a = thaw $x;
-       die "STORABLE_thaw #2" unless ref $a eq 'ARRAY';
-       die "STORABLE_thaw #3" unless @$a == 2 && $a->[0] eq 'a' && $a->[1] == 1;
-       @$self = @$a;
-       die "STORABLE_thaw #4" unless Storable::is_retrieving;
-}
-
-package OBJ_SYNC;
-
-@x = ('a', 1);
-
-sub make { bless {}, shift }
-
-sub STORABLE_freeze {
-       my $self = shift;
-       my ($cloning) = @_;
-       return if $cloning;
-       return ("", \@x, $self);
-}
-
-sub STORABLE_thaw {
-       my $self = shift;
-       my ($cloning, $undef, $a, $obj) = @_;
-       die "STORABLE_thaw #1" unless $obj eq $self;
-       die "STORABLE_thaw #2" unless ref $a eq 'ARRAY' || @$a != 2;
-       $self->{ok} = $self;
-}
-
-package OBJ_SYNC2;
-
-use Storable qw(dclone);
-
-sub make {
-       my $self = bless {}, shift;
-       my ($ext) = @_;
-       $self->{sync} = OBJ_SYNC->make;
-       $self->{ext} = $ext;
-       return $self;
-}
-
-sub STORABLE_freeze {
-       my $self = shift;
-       my %copy = %$self;
-       my $r = \%copy;
-       my $t = dclone($r->{sync});
-       return ("", [$t, $self->{ext}], $r, $self, $r->{ext});
-}
-
-sub STORABLE_thaw {
-       my $self = shift;
-       my ($cloning, $undef, $a, $r, $obj, $ext) = @_;
-       die "STORABLE_thaw #1" unless $obj eq $self;
-       die "STORABLE_thaw #2" unless ref $a eq 'ARRAY';
-       die "STORABLE_thaw #3" unless ref $r eq 'HASH';
-       die "STORABLE_thaw #4" unless $a->[1] == $r->{ext};
-       $self->{ok} = $self;
-       ($self->{sync}, $self->{ext}) = @$a;
-}
-
-package OBJ_REAL2;
-
-use Storable qw(freeze thaw);
-
-$MAX = 20;
-$recursed = 0;
-$hook_called = 0;
-
-sub make { bless [], shift }
-
-sub STORABLE_freeze {
-       my $self = shift;
-       $hook_called++;
-       return (freeze($self), $self) if ++$recursed < $MAX;
-       return ("no", $self);
-}
-
-sub STORABLE_thaw {
-       my $self = shift;
-       my $cloning = shift;
-       my ($x, $obj) = @_;
-       die "STORABLE_thaw #1" unless $obj eq $self;
-       $self->[0] = thaw($x) if $x ne "no";
-       $recursed--;
-}
-
-package main;
-
-my $real = OBJ_REAL->make;
-my $x = freeze $real;
-ok 1, 1;
-
-my $y = thaw $x;
-ok 2, 1;
-ok 3, $y->[0] eq 'a';
-ok 4, $y->[1] == 1;
-
-my $sync = OBJ_SYNC->make;
-$x = freeze $sync;
-ok 5, 1;
-
-$y = thaw $x;
-ok 6, 1;
-ok 7, $y->{ok} == $y;
-
-my $ext = [1, 2];
-$sync = OBJ_SYNC2->make($ext);
-$x = freeze [$sync, $ext];
-ok 8, 1;
-
-my $z = thaw $x;
-$y = $z->[0];
-ok 9, 1;
-ok 10, $y->{ok} == $y;
-ok 11, ref $y->{sync} eq 'OBJ_SYNC';
-ok 12, $y->{ext} == $z->[1];
-
-$real = OBJ_REAL2->make;
-$x = freeze $real;
-ok 13, 1;
-ok 14, $OBJ_REAL2::recursed == $OBJ_REAL2::MAX;
-ok 15, $OBJ_REAL2::hook_called == $OBJ_REAL2::MAX;
-
-$y = thaw $x;
-ok 16, 1;
-ok 17, $OBJ_REAL2::recursed == 0;
-
-$x = dclone $real;
-ok 18, 1;
-ok 19, ref $x eq 'OBJ_REAL2';
-ok 20, $OBJ_REAL2::recursed == 0;
-ok 21, $OBJ_REAL2::hook_called == 2 * $OBJ_REAL2::MAX;
-
-ok 22, !Storable::is_storing;
-ok 23, !Storable::is_retrieving;
-
-#
-# The following was a test-case that Salvador Ortiz Garcia <sog@msg.com.mx>
-# sent me, along with a proposed fix.
-#
-
-package Foo;
-
-sub new {
-       my $class = shift;
-       my $dat = shift;
-       return bless {dat => $dat}, $class;
-}
-
-package Bar;
-sub new {
-       my $class = shift;
-       return bless {
-               a => 'dummy',
-               b => [ 
-                       Foo->new(1),
-                       Foo->new(2), # Second instance of a Foo 
-               ]
-       }, $class;
-}
-
-sub STORABLE_freeze {
-       my($self,$clonning) = @_;
-       return "$self->{a}", $self->{b};
-}
-
-sub STORABLE_thaw {
-       my($self,$clonning,$dummy,$o) = @_;
-       $self->{a} = $dummy;
-       $self->{b} = $o;
-}
-
-package main;
-
-my $bar = new Bar;
-my $bar2 = thaw freeze $bar;
-
-ok 24, ref($bar2) eq 'Bar';
-ok 25, ref($bar->{b}[0]) eq 'Foo';
-ok 26, ref($bar->{b}[1]) eq 'Foo';
-ok 27, ref($bar2->{b}[0]) eq 'Foo';
-ok 28, ref($bar2->{b}[1]) eq 'Foo';
-
-#
-# The following attempts to make sure blessed objects are blessed ASAP
-# at retrieve time.
-#
-
-package CLASS_1;
-
-sub make {
-       my $self = bless {}, shift;
-       return $self;
-}
-
-package CLASS_2;
-
-sub make {
-       my $self = bless {}, shift;
-       my ($o) = @_;
-       $self->{c1} = CLASS_1->make();
-       $self->{o} = $o;
-       $self->{c3} = bless CLASS_1->make(), "CLASS_3";
-       $o->set_c2($self);
-       return $self;
-}
-
-sub STORABLE_freeze {
-       my($self, $clonning) = @_;
-       return "", $self->{c1}, $self->{c3}, $self->{o};
-}
-
-sub STORABLE_thaw {
-       my($self, $clonning, $frozen, $c1, $c3, $o) = @_;
-       main::ok 29, ref $self eq "CLASS_2";
-       main::ok 30, ref $c1 eq "CLASS_1";
-       main::ok 31, ref $c3 eq "CLASS_3";
-       main::ok 32, ref $o eq "CLASS_OTHER";
-       $self->{c1} = $c1;
-       $self->{c3} = $c3;
-}
-
-package CLASS_OTHER;
-
-sub make {
-       my $self = bless {}, shift;
-       return $self;
-}
-
-sub set_c2 { $_[0]->{c2} = $_[1] }
-
-package main;
-
-my $o = CLASS_OTHER->make();
-my $c2 = CLASS_2->make($o);
-my $so = thaw freeze $o;
-

diff --git a/t/lib/st-retrieve.t b/t/lib/st-retrieve.t
deleted file mode 100644 (file)
index c968485..0000000
--- a/t/lib/st-retrieve.t
+++ /dev/null
@@ -1,78 +0,0 @@
-#!./perl
-
-# $Id: retrieve.t,v 1.0 2000/09/01 19:40:42 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#
-# $Log: retrieve.t,v $
-# Revision 1.0  2000/09/01 19:40:42  ram
-# Baseline for first official release.
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-    require 'lib/st-dump.pl';
-}
-
-
-use Storable qw(store retrieve nstore);
-
-print "1..14\n";
-
-$a = 'toto';
-$b = \$a;
-$c = bless {}, CLASS;
-$c->{attribute} = 'attrval';
-%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
-@a = ('first', '', undef, 3, -4, -3.14159, 456, 4.5,
-       $b, \$a, $a, $c, \$c, \%a);
-
-print "not " unless defined store(\@a, 'store');
-print "ok 1\n";
-print "not " if Storable::last_op_in_netorder();
-print "ok 2\n";
-print "not " unless defined nstore(\@a, 'nstore');
-print "ok 3\n";
-print "not " unless Storable::last_op_in_netorder();
-print "ok 4\n";
-print "not " unless Storable::last_op_in_netorder();
-print "ok 5\n";
-
-$root = retrieve('store');
-print "not " unless defined $root;
-print "ok 6\n";
-print "not " if Storable::last_op_in_netorder();
-print "ok 7\n";
-
-$nroot = retrieve('nstore');
-print "not " unless defined $nroot;
-print "ok 8\n";
-print "not " unless Storable::last_op_in_netorder();
-print "ok 9\n";
-
-$d1 = &dump($root);
-print "ok 10\n";
-$d2 = &dump($nroot);
-print "ok 11\n";
-
-print "not " unless $d1 eq $d2; 
-print "ok 12\n";
-
-# Make sure empty string is defined at retrieval time
-print "not " unless defined $root->[1];
-print "ok 13\n";
-print "not " if length $root->[1];
-print "ok 14\n";
-
-END { 1 while unlink('store', 'nstore') }
-

diff --git a/t/lib/st-store.t b/t/lib/st-store.t
deleted file mode 100644 (file)
index d26755f..0000000
--- a/t/lib/st-store.t
+++ /dev/null
@@ -1,119 +0,0 @@
-#!./perl
-
-# $Id: store.t,v 1.0 2000/09/01 19:40:42 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#
-# $Log: store.t,v $
-# Revision 1.0  2000/09/01 19:40:42  ram
-# Baseline for first official release.
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-    require 'lib/st-dump.pl';
-}
-
-use Storable qw(store retrieve store_fd nstore_fd fd_retrieve);
-
-print "1..20\n";
-
-$a = 'toto';
-$b = \$a;
-$c = bless {}, CLASS;
-$c->{attribute} = 'attrval';
-%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
-@a = ('first', undef, 3, -4, -3.14159, 456, 4.5,
-       $b, \$a, $a, $c, \$c, \%a);
-
-print "not " unless defined store(\@a, 'store');
-print "ok 1\n";
-
-$dumped = &dump(\@a);
-print "ok 2\n";
-
-$root = retrieve('store');
-print "not " unless defined $root;
-print "ok 3\n";
-
-$got = &dump($root);
-print "ok 4\n";
-
-print "not " unless $got eq $dumped; 
-print "ok 5\n";
-
-1 while unlink 'store';
-
-package FOO; @ISA = qw(Storable);
-
-sub make {
-       my $self = bless {};
-       $self->{key} = \%main::a;
-       return $self;
-};
-
-package main;
-
-$foo = FOO->make;
-print "not " unless $foo->store('store');
-print "ok 6\n";
-
-print "not " unless open(OUT, '>>store');
-print "ok 7\n";
-binmode OUT;
-
-print "not " unless defined store_fd(\@a, ::OUT);
-print "ok 8\n";
-print "not " unless defined nstore_fd($foo, ::OUT);
-print "ok 9\n";
-print "not " unless defined nstore_fd(\%a, ::OUT);
-print "ok 10\n";
-
-print "not " unless close(OUT);
-print "ok 11\n";
-
-print "not " unless open(OUT, 'store');
-binmode OUT;
-
-$r = fd_retrieve(::OUT);
-print "not " unless defined $r;
-print "ok 12\n";
-print "not " unless &dump($foo) eq &dump($r);
-print "ok 13\n";
-
-$r = fd_retrieve(::OUT);
-print "not " unless defined $r;
-print "ok 14\n";
-print "not " unless &dump(\@a) eq &dump($r);
-print "ok 15\n";
-
-$r = fd_retrieve(main::OUT);
-print "not " unless defined $r;
-print "ok 16\n";
-print "not " unless &dump($foo) eq &dump($r);
-print "ok 17\n";
-
-$r = fd_retrieve(::OUT);
-print "not " unless defined $r;
-print "ok 18\n";
-print "not " unless &dump(\%a) eq &dump($r);
-print "ok 19\n";
-
-eval { $r = fd_retrieve(::OUT); };
-print "not " unless $@;
-print "ok 20\n";
-
-close OUT;
-END { 1 while unlink 'store' }
-
-

diff --git a/t/lib/st-tied.t b/t/lib/st-tied.t
deleted file mode 100644 (file)
index 88131fe..0000000
--- a/t/lib/st-tied.t
+++ /dev/null
@@ -1,213 +0,0 @@
-#!./perl
-
-# $Id: tied.t,v 1.0 2000/09/01 19:40:42 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#
-# $Log: tied.t,v $
-# Revision 1.0  2000/09/01 19:40:42  ram
-# Baseline for first official release.
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-    require 'lib/st-dump.pl';
-}
-
-sub ok;
-
-use Storable qw(freeze thaw);
-
-print "1..22\n";
-
-($scalar_fetch, $array_fetch, $hash_fetch) = (0, 0, 0);
-
-package TIED_HASH;
-
-sub TIEHASH {
-       my $self = bless {}, shift;
-       return $self;
-}
-
-sub FETCH {
-       my $self = shift;
-       my ($key) = @_;
-       $main::hash_fetch++;
-       return $self->{$key};
-}
-
-sub STORE {
-       my $self = shift;
-       my ($key, $value) = @_;
-       $self->{$key} = $value;
-}
-
-sub FIRSTKEY {
-       my $self = shift;
-       scalar keys %{$self};
-       return each %{$self};
-}
-
-sub NEXTKEY {
-       my $self = shift;
-       return each %{$self};
-}
-
-package TIED_ARRAY;
-
-sub TIEARRAY {
-       my $self = bless [], shift;
-       return $self;
-}
-
-sub FETCH {
-       my $self = shift;
-       my ($idx) = @_;
-       $main::array_fetch++;
-       return $self->[$idx];
-}
-
-sub STORE {
-       my $self = shift;
-       my ($idx, $value) = @_;
-       $self->[$idx] = $value;
-}
-
-sub FETCHSIZE {
-       my $self = shift;
-       return @{$self};
-}
-
-package TIED_SCALAR;
-
-sub TIESCALAR {
-       my $scalar;
-       my $self = bless \$scalar, shift;
-       return $self;
-}
-
-sub FETCH {
-       my $self = shift;
-       $main::scalar_fetch++;
-       return $$self;
-}
-
-sub STORE {
-       my $self = shift;
-       my ($value) = @_;
-       $$self = $value;
-}
-
-package FAULT;
-
-$fault = 0;
-
-sub TIESCALAR {
-       my $pkg = shift;
-       return bless [@_], $pkg;
-}
-
-sub FETCH {
-       my $self = shift;
-       my ($href, $key) = @$self;
-       $fault++;
-       untie $href->{$key};
-       return $href->{$key} = 1;
-}
-
-package main;
-
-$a = 'toto';
-$b = \$a;
-
-$c = tie %hash, TIED_HASH;
-$d = tie @array, TIED_ARRAY;
-tie $scalar, TIED_SCALAR;
-
-#$scalar = 'foo';
-#$hash{'attribute'} = \$d;
-#$array[0] = $c;
-#$array[1] = \$scalar;
-
-### If I say
-###   $hash{'attribute'} = $d;
-### below, then dump() incorectly dumps the hash value as a string the second
-### time it is reached. I have not investigated enough to tell whether it's
-### a bug in my dump() routine or in the Perl tieing mechanism.
-$scalar = 'foo';
-$hash{'attribute'} = 'plain value';
-$array[0] = \$scalar;
-$array[1] = $c;
-$array[2] = \@array;
-
-@tied = (\$scalar, \@array, \%hash);
-%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$a, 'scalarref', \$scalar);
-@a = ('first', 3, -4, -3.14159, 456, 4.5, $d, \$d,
-       $b, \$a, $a, $c, \$c, \%a, \@array, \%hash, \@tied);
-
-ok 1, defined($f = freeze(\@a));
-
-$dumped = &dump(\@a);
-ok 2, 1;
-
-$root = thaw($f);
-ok 3, defined $root;
-
-$got = &dump($root);
-ok 4, 1;
-
-### Used to see the manifestation of the bug documented above.
-### print "original: $dumped";
-### print "--------\n";
-### print "got: $got";
-### print "--------\n";
-
-ok 5, $got eq $dumped; 
-
-$g = freeze($root);
-ok 6, length($f) == length($g);
-
-# Ensure the tied items in the retrieved image work
-@old = ($scalar_fetch, $array_fetch, $hash_fetch);
-@tied = ($tscalar, $tarray, $thash) = @{$root->[$#{$root}]};
-@type = qw(SCALAR  ARRAY  HASH);
-
-ok 7, tied $$tscalar;
-ok 8, tied @{$tarray};
-ok 9, tied %{$thash};
-
-@new = ($$tscalar, $tarray->[0], $thash->{'attribute'});
-@new = ($scalar_fetch, $array_fetch, $hash_fetch);
-
-# Tests 10..15
-for ($i = 0; $i < @new; $i++) {
-       print "not " unless $new[$i] == $old[$i] + 1;
-       printf "ok %d\n", 10 + 2*$i;    # Tests 10,12,14
-       print "not " unless ref $tied[$i] eq $type[$i];
-       printf "ok %d\n", 11 + 2*$i;    # Tests 11,13,15
-}
-
-# Check undef ties
-my $h = {};
-tie $h->{'x'}, 'FAULT', $h, 'x';
-my $hf = freeze($h);
-ok 16, defined $hf;
-ok 17, $FAULT::fault == 0;
-ok 18, $h->{'x'} == 1;
-ok 19, $FAULT::fault == 1;
-
-my $ht = thaw($hf);
-ok 20, defined $ht;
-ok 21, $ht->{'x'} == 1;
-ok 22, $FAULT::fault == 2;
-

diff --git a/t/lib/st-tiedhook.t b/t/lib/st-tiedhook.t
deleted file mode 100644 (file)
index 46805cf..0000000
--- a/t/lib/st-tiedhook.t
+++ /dev/null
@@ -1,254 +0,0 @@
-#!./perl
-
-# $Id: tied_hook.t,v 1.0.1.1 2001/02/17 12:29:01 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#
-# $Log: tied_hook.t,v $
-# Revision 1.0.1.1  2001/02/17 12:29:01  ram
-# patch8: added test for blessed ref to tied hash
-#
-# Revision 1.0  2000/09/01 19:40:42  ram
-# Baseline for first official release.
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-    require 'lib/st-dump.pl';
-}
-
-sub ok;
-
-use Storable qw(freeze thaw);
-
-print "1..25\n";
-
-($scalar_fetch, $array_fetch, $hash_fetch) = (0, 0, 0);
-
-package TIED_HASH;
-
-sub TIEHASH {
-       my $self = bless {}, shift;
-       return $self;
-}
-
-sub FETCH {
-       my $self = shift;
-       my ($key) = @_;
-       $main::hash_fetch++;
-       return $self->{$key};
-}
-
-sub STORE {
-       my $self = shift;
-       my ($key, $value) = @_;
-       $self->{$key} = $value;
-}
-
-sub FIRSTKEY {
-       my $self = shift;
-       scalar keys %{$self};
-       return each %{$self};
-}
-
-sub NEXTKEY {
-       my $self = shift;
-       return each %{$self};
-}
-
-sub STORABLE_freeze {
-       my $self = shift;
-       $main::hash_hook1++;
-       return join(":", keys %$self) . ";" . join(":", values %$self);
-}
-
-sub STORABLE_thaw {
-       my ($self, $cloning, $frozen) = @_;
-       my ($keys, $values) = split(/;/, $frozen);
-       my @keys = split(/:/, $keys);
-       my @values = split(/:/, $values);
-       for (my $i = 0; $i < @keys; $i++) {
-               $self->{$keys[$i]} = $values[$i];
-       }
-       $main::hash_hook2++;
-}
-
-package TIED_ARRAY;
-
-sub TIEARRAY {
-       my $self = bless [], shift;
-       return $self;
-}
-
-sub FETCH {
-       my $self = shift;
-       my ($idx) = @_;
-       $main::array_fetch++;
-       return $self->[$idx];
-}
-
-sub STORE {
-       my $self = shift;
-       my ($idx, $value) = @_;
-       $self->[$idx] = $value;
-}
-
-sub FETCHSIZE {
-       my $self = shift;
-       return @{$self};
-}
-
-sub STORABLE_freeze {
-       my $self = shift;
-       $main::array_hook1++;
-       return join(":", @$self);
-}
-
-sub STORABLE_thaw {
-       my ($self, $cloning, $frozen) = @_;
-       @$self = split(/:/, $frozen);
-       $main::array_hook2++;
-}
-
-package TIED_SCALAR;
-
-sub TIESCALAR {
-       my $scalar;
-       my $self = bless \$scalar, shift;
-       return $self;
-}
-
-sub FETCH {
-       my $self = shift;
-       $main::scalar_fetch++;
-       return $$self;
-}
-
-sub STORE {
-       my $self = shift;
-       my ($value) = @_;
-       $$self = $value;
-}
-
-sub STORABLE_freeze {
-       my $self = shift;
-       $main::scalar_hook1++;
-       return $$self;
-}
-
-sub STORABLE_thaw {
-       my ($self, $cloning, $frozen) = @_;
-       $$self = $frozen;
-       $main::scalar_hook2++;
-}
-
-package main;
-
-$a = 'toto';
-$b = \$a;
-
-$c = tie %hash, TIED_HASH;
-$d = tie @array, TIED_ARRAY;
-tie $scalar, TIED_SCALAR;
-
-$scalar = 'foo';
-$hash{'attribute'} = 'plain value';
-$array[0] = \$scalar;
-$array[1] = $c;
-$array[2] = \@array;
-$array[3] = "plaine scalaire";
-
-@tied = (\$scalar, \@array, \%hash);
-%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$a, 'scalarref', \$scalar);
-@a = ('first', 3, -4, -3.14159, 456, 4.5, $d, \$d,
-       $b, \$a, $a, $c, \$c, \%a, \@array, \%hash, \@tied);
-
-ok 1, defined($f = freeze(\@a));
-
-$dumped = &dump(\@a);
-ok 2, 1;
-
-$root = thaw($f);
-ok 3, defined $root;
-
-$got = &dump($root);
-ok 4, 1;
-
-ok 5, $got ne $dumped;         # our hooks did not handle refs in array
-
-$g = freeze($root);
-ok 6, length($f) == length($g);
-
-# Ensure the tied items in the retrieved image work
-@old = ($scalar_fetch, $array_fetch, $hash_fetch);
-@tied = ($tscalar, $tarray, $thash) = @{$root->[$#{$root}]};
-@type = qw(SCALAR  ARRAY  HASH);
-
-ok 7, tied $$tscalar;
-ok 8, tied @{$tarray};
-ok 9, tied %{$thash};
-
-@new = ($$tscalar, $tarray->[0], $thash->{'attribute'});
-@new = ($scalar_fetch, $array_fetch, $hash_fetch);
-
-# Tests 10..15
-for ($i = 0; $i < @new; $i++) {
-       ok 10 + 2*$i, $new[$i] == $old[$i] + 1;         # Tests 10,12,14
-       ok 11 + 2*$i, ref $tied[$i] eq $type[$i];       # Tests 11,13,15
-}
-
-ok 16, $$tscalar eq 'foo';
-ok 17, $tarray->[3] eq 'plaine scalaire';
-ok 18, $thash->{'attribute'} eq 'plain value';
-
-# Ensure hooks were called
-ok 19, ($scalar_hook1 && $scalar_hook2);
-ok 20, ($array_hook1 && $array_hook2);
-ok 21, ($hash_hook1 && $hash_hook2);
-
-#
-# And now for the "blessed ref to tied hash" with "store hook" test...
-#
-
-my $bc = bless \%hash, 'FOO';          # FOO does not exist -> no hook
-my $bx = thaw freeze $bc;
-
-ok 22, ref $bx eq 'FOO';
-my $old_hash_fetch = $hash_fetch;
-my $v = $bx->{attribute};
-ok 23, $hash_fetch == $old_hash_fetch + 1;     # Still tied
-
-package TIED_HASH_REF;
-
-
-sub STORABLE_freeze {
-        my ($self, $cloning) = @_;
-        return if $cloning;
-        return('ref lost');
-}
-
-sub STORABLE_thaw {
-        my ($self, $cloning, $data) = @_;
-        return if $cloning;
-}
-
-package main;
-
-$bc = bless \%hash, 'TIED_HASH_REF';
-$bx = thaw freeze $bc;
-
-ok 24, ref $bx eq 'TIED_HASH_REF';
-$old_hash_fetch = $hash_fetch;
-$v = $bx->{attribute};
-ok 25, $hash_fetch == $old_hash_fetch + 1;     # Still tied
-

diff --git a/t/lib/st-tieditems.t b/t/lib/st-tieditems.t
deleted file mode 100644 (file)
index 3d0abf7..0000000
--- a/t/lib/st-tieditems.t
+++ /dev/null
@@ -1,68 +0,0 @@
-#!./perl
-
-# $Id: tied_items.t,v 1.0 2000/09/01 19:40:42 ram Exp $
-#
-#  Copyright (c) 1995-2000, Raphael Manfredi
-#  
-#  You may redistribute only under the same terms as Perl 5, as specified
-#  in the README file that comes with the distribution.
-#
-# $Log: tied_items.t,v $
-# Revision 1.0  2000/09/01 19:40:42  ram
-# Baseline for first official release.
-#
-
-#
-# Tests ref to items in tied hash/array structures.
-#
-
-sub BEGIN {
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-    require 'lib/st-dump.pl';
-}
-
-sub ok;
-$^W = 0;
-
-print "1..8\n";
-
-use Storable qw(dclone);
-
-$h_fetches = 0;
-
-sub H::TIEHASH { bless \(my $x), "H" }
-sub H::FETCH { $h_fetches++; $_[1] - 70 }
-
-tie %h, "H";
-
-$ref = \$h{77};
-$ref2 = dclone $ref;
-
-ok 1, $h_fetches == 0;
-ok 2, $$ref2 eq $$ref;
-ok 3, $$ref2 == 7;
-ok 4, $h_fetches == 2;
-
-$a_fetches = 0;
-
-sub A::TIEARRAY { bless \(my $x), "A" }
-sub A::FETCH { $a_fetches++; $_[1] - 70 }
-
-tie @a, "A";
-
-$ref = \$a[78];
-$ref2 = dclone $ref;
-
-ok 5, $a_fetches == 0;
-ok 6, $$ref2 eq $$ref;
-ok 7, $$ref2 == 8;
-# I don't understand why it's 3 and not 2
-ok 8, $a_fetches == 3;
-

diff --git a/t/lib/st-utf8.t b/t/lib/st-utf8.t
deleted file mode 100644 (file)
index 2160308..0000000
--- a/t/lib/st-utf8.t
+++ /dev/null
@@ -1,40 +0,0 @@
-#!./perl
-
-# $Id: utf8.t,v 1.0.1.2 2000/09/28 21:44:17 ram Exp $
-#
-#  @COPYRIGHT@
-#
-# $Log: utf8.t,v $
-# Revision 1.0.1.2  2000/09/28 21:44:17  ram
-# patch2: fixed stupid typo
-#
-# Revision 1.0.1.1  2000/09/17 16:48:12  ram
-# patch1: created.
-#
-#
-
-sub BEGIN {
-    if ($] < 5.006) {
-       print "1..0 # Skip: no utf8 support\n";
-       exit 0;
-    }
-    chdir('t') if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bStorable\b/) {
-        print "1..0 # Skip: Storable was not built\n";
-        exit 0;
-    }
-    require 'lib/st-dump.pl';
-}
-
-sub ok;
-
-use Storable qw(thaw freeze);
-
-print "1..1\n";
-
-$x = chr(1234);
-ok 1, $x eq ${thaw freeze \$x};
-

diff --git a/t/lib/switch.t b/t/lib/switch.t
deleted file mode 100644 (file)
index d1a8af1..0000000
--- a/t/lib/switch.t
+++ /dev/null
@@ -1,277 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use Carp;
-use Switch qw(__ fallthrough);
-
-my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
-END{print"1..$C\n$M"}
-
-# NON-case THINGS;
-
-$case->{case} = { case => "case" };
-
-*case = \&case;
-
-# PREMATURE case
-
-eval { case 1 { ok(0) }; ok(0) } || ok(1);
-
-# H.O. FUNCS
-
-switch (__ > 2) {
-
-       case 1  { ok(0) } else { ok(1) }
-       case 2  { ok(0) } else { ok(1) }
-       case 3  { ok(1) } else { ok(0) }
-}
-
-switch (3) {
-
-       eval { case __ <= 1 || __ > 2   { ok(0) } } || ok(1);
-       case __ <= 2            { ok(0) };
-       case __ <= 3            { ok(1) };
-}
-
-# POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
-
-# 1. NUMERIC SWITCH
-
-for (1..3)
-{
-       switch ($_) {
-               # SELF
-               case ($_) { ok(1) } else { ok(0) }
-
-               # NUMERIC
-               case (1) { ok ($_==1) } else { ok($_!=1) }
-               case  1  { ok ($_==1) } else { ok($_!=1) }
-               case (3) { ok ($_==3) } else { ok($_!=3) }
-               case (4) { ok (0) } else { ok(1) }
-               case (2) { ok ($_==2) } else { ok($_!=2) }
-
-               # STRING
-               case ('a') { ok (0) } else { ok(1) }
-               case  'a'  { ok (0) } else { ok(1) }
-               case ('3') { ok ($_ == 3) } else { ok($_ != 3) }
-               case ('3.0') { ok (0) } else { ok(1) }
-
-               # ARRAY
-               case ([10,5,1]) { ok ($_==1) } else { ok($_!=1) }
-               case  [10,5,1]  { ok ($_==1) } else { ok($_!=1) }
-               case (['a','b']) { ok (0) } else { ok(1) }
-               case (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) }
-               case (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) }
-               case ([]) { ok (0) } else { ok(1) }
-
-               # HASH
-               case ({}) { ok (0) } else { ok (1) }
-               case {} { ok (0) } else { ok (1) }
-               case {1,1} { ok ($_==1) } else { ok($_!=1) }
-               case ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) }
-
-               # SUB/BLOCK
-               case (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) }
-               case {$_[0]==2} { ok ($_==2) } else { ok($_!=2) }
-               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
-               case {1} { ok (1) } else { ok (0) }     # ; -> SUB, NOT HASH
-       }
-}
-
-
-# 2. STRING SWITCH
-
-for ('a'..'c','1')
-{
-       switch ($_) {
-               # SELF
-               case ($_) { ok(1) } else { ok(0) }
-
-               # NUMERIC
-               case (1)  { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
-               case (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
-
-               # STRING
-               case ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') }
-               case ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') }
-               case ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') }
-               case ('1') { ok ($_ eq '1') } else { ok($_ ne '1') }
-               case ('d') { ok (0) } else { ok (1) }
-
-               # ARRAY
-               case (['a','1']) { ok ($_ eq 'a' || $_ eq '1') }
-                       else { ok ($_ ne 'a' && $_ ne '1') }
-               case (['z','2']) { ok (0) } else { ok(1) }
-               case ([]) { ok (0) } else { ok(1) }
-
-               # HASH
-               case ({}) { ok (0) } else { ok (1) }
-               case ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') }
-                       else { ok ($_ ne 'a' && $_ ne '1') }
-
-               # SUB/BLOCK
-               case (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') }
-                       else { ok($_ ne 'a') }
-               case {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') }
-               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
-               case {1} { ok (1) } else { ok (0) }     # ; -> SUB, NOT HASH
-       }
-}
-
-
-# 3. ARRAY SWITCH
-
-my $iteration = 0;
-for ([],[1,'a'],[2,'b'])
-{
-       switch ($_) {
-       $iteration++;
-               # SELF
-               case ($_) { ok(1) }
-
-               # NUMERIC
-               case (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
-               case (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
-
-               # STRING
-               case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
-               case ('b') { ok ($iteration==3) } else { ok ($iteration!=3) }
-               case ('1') { ok ($iteration==2) } else { ok ($iteration!=2) }
-
-               # ARRAY
-               case (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) }
-               case ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) }
-               case ([]) { ok (0) } else { ok(1) }
-               case ([7..100]) { ok (0) } else { ok(1) }
-
-               # HASH
-               case ({}) { ok (0) } else { ok (1) }
-               case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-
-               # SUB/BLOCK
-               case {scalar grep /a/, @_} { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-               case (sub {scalar grep /a/, @_ }) { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
-               case {1} { ok (1) } else { ok (0) }     # ; -> SUB, NOT HASH
-       }
-}
-
-
-# 4. HASH SWITCH
-
-$iteration = 0;
-for ({},{a=>1,b=>0})
-{
-       switch ($_) {
-       $iteration++;
-
-               # SELF
-               case ($_) { ok(1) } else { ok(0) }
-
-               # NUMERIC
-               case (1) { ok (0) } else { ok (1) }
-               case (1.0) { ok (0) } else { ok (1) }
-
-               # STRING
-               case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
-               case ('b') { ok (0) } else { ok (1) }
-               case ('c') { ok (0) } else { ok (1) }
-
-               # ARRAY
-               case (['a',2]) { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-               case (['b','a']) { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-               case (['b','c']) { ok (0) } else { ok (1) }
-               case ([]) { ok (0) } else { ok(1) }
-               case ([7..100]) { ok (0) } else { ok(1) }
-
-               # HASH
-               case ({}) { ok (0) } else { ok (1) }
-               case ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
-
-               # SUB/BLOCK
-               case {$_[0]{a}} { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-               case (sub {$_[0]{a}}) { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
-               case {1} { ok (1) } else { ok (0) }     # ; -> SUB, NOT HASH
-       }
-}
-
-
-# 5. CODE SWITCH
-
-$iteration = 0;
-for ( sub {1},
-      sub { return 0 unless @_;
-           my ($data) = @_;
-           my $type = ref $data;
-           return $type eq 'HASH'   && $data->{a}
-               || $type eq 'Regexp' && 'a' =~ /$data/
-               || $type eq ""       && $data eq '1';
-         },
-      sub {0} )
-{
-       switch ($_) {
-       $iteration++;
-               # SELF
-               case ($_) { ok(1) } else { ok(0) }
-
-               # NUMERIC
-               case (1) { ok ($iteration<=2) } else { ok ($iteration>2) }
-               case (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) }
-               case (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) }
-
-               # STRING
-               case ('a') { ok ($iteration==1) } else { ok ($iteration!=1) }
-               case ('b') { ok ($iteration==1) } else { ok ($iteration!=1) }
-               case ('c') { ok ($iteration==1) } else { ok ($iteration!=1) }
-               case ('1') { ok ($iteration<=2) } else { ok ($iteration>2) }
-
-               # ARRAY
-               case ([1, 'a']) { ok ($iteration<=2) }
-                       else { ok ($iteration>2) }
-               case (['b','a']) { ok ($iteration==1) }
-                       else { ok ($iteration!=1) }
-               case (['b','c']) { ok ($iteration==1) }
-                       else { ok ($iteration!=1) }
-               case ([]) { ok ($iteration==1) } else { ok($iteration!=1) }
-               case ([7..100]) { ok ($iteration==1) }
-                       else { ok($iteration!=1) }
-
-               # HASH
-               case ({}) { ok ($iteration==1) } else { ok ($iteration!=1) }
-               case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) }
-                       else { ok ($iteration>2) }
-
-               # SUB/BLOCK
-               case {$_[0]->{a}} { ok (0) } else { ok (1) }
-               case (sub {$_[0]{a}}) { ok (0) } else { ok (1) }
-               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
-               case {1} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
-       }
-}
-
-
-# NESTED SWITCHES
-
-for my $count (1..3)
-{
-       switch ([9,"a",11]) {
-               case (qr/\d/) {
-                               switch ($count) {
-                                       case (1)     { ok($count==1) }
-                                               else { ok($count!=1) }
-                                       case ([5,6]) { ok(0) } else { ok(1) }
-                               }
-                           }
-               ok(1) case (11);
-       }
-}

diff --git a/t/lib/symbol.t b/t/lib/symbol.t
deleted file mode 100755 (executable)
index 03449a3..0000000
--- a/t/lib/symbol.t
+++ /dev/null
@@ -1,52 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-print "1..8\n";
-
-BEGIN { $_ = 'foo'; }  # because Symbol used to clobber $_
-
-use Symbol;
-
-# First check $_ clobbering
-print "not " if $_ ne 'foo';
-print "ok 1\n";
-
-
-# First test gensym()
-$sym1 = gensym;
-print "not " if ref($sym1) ne 'GLOB';
-print "ok 2\n";
-
-$sym2 = gensym;
-
-print "not " if $sym1 eq $sym2;
-print "ok 3\n";
-
-ungensym $sym1;
-
-$sym1 = $sym2 = undef;
-
-
-# Test qualify()
-package foo;
-
-use Symbol qw(qualify);  # must import into this package too
-
-qualify("x") eq "foo::x"          or print "not ";
-print "ok 4\n";
-
-qualify("x", "FOO") eq "FOO::x"   or print "not ";
-print "ok 5\n";
-
-qualify("BAR::x") eq "BAR::x"     or print "not ";
-print "ok 6\n";
-
-qualify("STDOUT") eq "main::STDOUT" or print "not ";
-print "ok 7\n";
-
-qualify("ARGV", "FOO") eq "main::ARGV" or print "not ";
-print "ok 8\n";

diff --git a/t/lib/syslfs.t b/t/lib/syslfs.t
deleted file mode 100644 (file)
index 8d9769f..0000000
--- a/t/lib/syslfs.t
+++ /dev/null
@@ -1,267 +0,0 @@
-# NOTE: this file tests how large files (>2GB) work with raw system IO.
-# stdio: open(), tell(), seek(), print(), read() is tested in t/op/lfs.t.
-# If you modify/add tests here, remember to update also t/op/lfs.t.
-
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       # Don't bother if there are no quad offsets.
-       if ($Config{lseeksize} < 8) {
-               print "1..0 # Skip: no 64-bit file offsets\n";
-               exit(0);
-       }
-       require Fcntl; import Fcntl qw(/^O_/ /^SEEK_/);
-}
-
-use strict;
-
-$| = 1;
-
-our @s;
-our $fail;
-
-sub zap {
-    close(BIG);
-    unlink("big");
-    unlink("big1");
-    unlink("big2");
-}
-
-sub bye {
-    zap(); 
-    exit(0);
-}
-
-my $explained;
-
-sub explain {
-    unless ($explained++) {
-       print <<EOM;
-#
-# If the lfs (large file support: large meaning larger than two
-# gigabytes) tests are skipped or fail, it may mean either that your
-# process (or process group) is not allowed to write large files
-# (resource limits) or that the file system (the network filesystem?)
-# you are running the tests on doesn't let your user/group have large
-# files (quota) or the filesystem simply doesn't support large files.
-# You may even need to reconfigure your kernel.  (This is all very
-# operating system and site-dependent.)
-#
-# Perl may still be able to support large files, once you have
-# such a process, enough quota, and such a (file) system.
-# It is just that the test failed now.
-#
-EOM
-    }
-    print "1..0 # Skip: @_\n" if @_;
-}
-
-print "# checking whether we have sparse files...\n";
-
-# Known have-nots.
-if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
-    print "1..0 # Skip: no sparse files in $^O\n";
-    bye();
-}
-
-# Known haves that have problems running this test
-# (for example because they do not support sparse files, like UNICOS)
-if ($^O eq 'unicos') {
-    print "1..0 # Skip: no sparse files in $^0, unable to test large files\n";
-    bye();
-}
-
-# Then try heuristically to deduce whether we have sparse files.
-
-# We'll start off by creating a one megabyte file which has
-# only three "true" bytes.  If we have sparseness, we should
-# consume less blocks than one megabyte (assuming nobody has
-# one megabyte blocks...)
-
-sysopen(BIG, "big1", O_WRONLY|O_CREAT|O_TRUNC) or
-    do { warn "sysopen big1 failed: $!\n"; bye };
-sysseek(BIG, 1_000_000, SEEK_SET) or
-    do { warn "sysseek big1 failed: $!\n"; bye };
-syswrite(BIG, "big") or
-    do { warn "syswrite big1 failed; $!\n"; bye };
-close(BIG) or
-    do { warn "close big1 failed: $!\n"; bye };
-
-my @s1 = stat("big1");
-
-print "# s1 = @s1\n";
-
-sysopen(BIG, "big2", O_WRONLY|O_CREAT|O_TRUNC) or
-    do { warn "sysopen big2 failed: $!\n"; bye };
-sysseek(BIG, 2_000_000, SEEK_SET) or
-    do { warn "sysseek big2 failed: $!\n"; bye };
-syswrite(BIG, "big") or
-    do { warn "syswrite big2 failed; $!\n"; bye };
-close(BIG) or
-    do { warn "close big2 failed: $!\n"; bye };
-
-my @s2 = stat("big2");
-
-print "# s2 = @s2\n";
-
-zap();
-
-unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 &&
-       $s1[11] == $s2[11] && $s1[12] == $s2[12]) {
-       print "1..0 # Skip: no sparse files?\n";
-       bye;
-}
-
-print "# we seem to have sparse files...\n";
-
-# By now we better be sure that we do have sparse files:
-# if we are not, the following will hog 5 gigabytes of disk.  Ooops.
-# This may fail by producing some signal; run in a subprocess first for safety
-
-$ENV{LC_ALL} = "C";
-
-my $r = system '../perl', '-I../lib', '-e', <<'EOF';
-use Fcntl qw(/^O_/ /^SEEK_/);
-sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or die $!;
-my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
-my $syswrite = syswrite(BIG, "big");
-exit 0;
-EOF
-
-sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
-       do { warn "sysopen 'big' failed: $!\n"; bye };
-my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
-unless (! $r && defined $sysseek && $sysseek == 5_000_000_000) {
-    $sysseek = 'undef' unless defined $sysseek;
-    explain("seeking past 2GB failed: ",
-           $r ? 'signal '.($r & 0x7f) : "$! (sysseek returned $sysseek)");
-    bye();
-}
-
-# The syswrite will fail if there are are filesize limitations (process or fs).
-my $syswrite = syswrite(BIG, "big");
-print "# syswrite failed: $! (syswrite returned ",
-      defined $syswrite ? $syswrite : 'undef', ")\n"
-    unless defined $syswrite && $syswrite == 3;
-my $close     = close BIG;
-print "# close failed: $!\n" unless $close;
-unless($syswrite && $close) {
-    if ($! =~/too large/i) {
-       explain("writing past 2GB failed: process limits?");
-    } elsif ($! =~ /quota/i) {
-       explain("filesystem quota limits?");
-    } else {
-       explain("error: $!");
-    }
-    bye();
-}
-
-@s = stat("big");
-
-print "# @s\n";
-
-unless ($s[7] == 5_000_000_003) {
-    explain("kernel/fs not configured to use large files?");
-    bye();
-}
-
-sub fail () {
-    print "not ";
-    $fail++;
-}
-
-sub offset ($$) {
-    my ($offset_will_be, $offset_want) = @_;
-    my $offset_is = eval $offset_will_be;
-    unless ($offset_is == $offset_want) {
-        print "# bad offset $offset_is, want $offset_want\n";
-       my ($offset_func) = ($offset_will_be =~ /^(\w+)/);
-       if (unpack("L", pack("L", $offset_want)) == $offset_is) {
-           print "# 32-bit wraparound suspected in $offset_func() since\n";
-           print "# $offset_want cast into 32 bits equals $offset_is.\n";
-       } elsif ($offset_want - unpack("L", pack("L", $offset_want)) - 1
-                == $offset_is) {
-           print "# 32-bit wraparound suspected in $offset_func() since\n";
-           printf "# %s - unpack('L', pack('L', %s)) - 1 equals %s.\n",
-               $offset_want,
-               $offset_want,
-               $offset_is;
-        }
-        fail;
-    }
-}
-
-print "1..17\n";
-
-$fail = 0;
-
-fail unless $s[7] == 5_000_000_003;    # exercizes pp_stat
-print "ok 1\n";
-
-fail unless -s "big" == 5_000_000_003; # exercizes pp_ftsize
-print "ok 2\n";
-
-fail unless -e "big";
-print "ok 3\n";
-
-fail unless -f "big";
-print "ok 4\n";
-
-sysopen(BIG, "big", O_RDONLY) or do { warn "sysopen failed: $!\n"; bye };
-
-offset('sysseek(BIG, 4_500_000_000, SEEK_SET)', 4_500_000_000);
-print "ok 5\n";
-
-offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_000);
-print "ok 6\n";
-
-offset('sysseek(BIG, 1, SEEK_CUR)', 4_500_000_001);
-print "ok 7\n";
-
-offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_001);
-print "ok 8\n";
-
-offset('sysseek(BIG, -1, SEEK_CUR)', 4_500_000_000);
-print "ok 9\n";
-
-offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_000);
-print "ok 10\n";
-
-offset('sysseek(BIG, -3, SEEK_END)', 5_000_000_000);
-print "ok 11\n";
-
-offset('sysseek(BIG, 0, SEEK_CUR)', 5_000_000_000);
-print "ok 12\n";
-
-my $big;
-
-fail unless sysread(BIG, $big, 3) == 3;
-print "ok 13\n";
-
-fail unless $big eq "big";
-print "ok 14\n";
-
-# 705_032_704 = (I32)5_000_000_000
-# See that we don't have "big" in the 705_... spot:
-# that would mean that we have a wraparound.
-fail unless sysseek(BIG, 705_032_704, SEEK_SET);
-print "ok 15\n";
-
-my $zero;
-
-fail unless read(BIG, $zero, 3) == 3;
-print "ok 16\n";
-
-fail unless $zero eq "\0\0\0";
-print "ok 17\n";
-
-explain() if $fail;
-
-bye(); # does the necessary cleanup
-
-END {
-   unlink "big"; # be paranoid about leaving 5 gig files lying around
-}
-
-# eof

diff --git a/t/lib/syslog.t b/t/lib/syslog.t
deleted file mode 100755 (executable)
index 801e882..0000000
--- a/t/lib/syslog.t
+++ /dev/null
@@ -1,72 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bSyslog\b/) {
-       print "1..0 # Skip: Sys::Syslog was not built\n";
-       exit 0;
-    }
-
-    require Socket;
-
-    # This code inspired by Sys::Syslog::connect():
-    require Sys::Hostname;
-    my ($host_uniq) = Sys::Hostname::hostname();
-    my ($host)      = $host_uniq =~ /([A-Za-z0-9_.-]+)/;
-
-    if (! defined Socket::inet_aton($host)) {
-        print "1..0 # Skip: Can't lookup $host\n";
-        exit 0;
-    }
-}
-
-BEGIN {
-  eval {require Sys::Syslog} or do {
-    if ($@ =~ /Your vendor has not/) {
-      print "1..0 # Skipped: missing macros\n";
-      exit 0;
-    }
-  }
-}
-
-use Sys::Syslog qw(:DEFAULT setlogsock);
-
-# Test this to 1 if your syslog accepts udp connections.
-# Most don't (or at least shouldn't)
-my $Test_Syslog_INET = 0;
-
-print "1..6\n";
-
-if (Sys::Syslog::_PATH_LOG()) {
-    if (-e Sys::Syslog::_PATH_LOG()) {
-        print defined(eval { setlogsock('unix') }) ? "ok 1\n" : "not ok 1\n";
-        print defined(eval { openlog('perl', 'ndelay', 'local0') }) ? "ok 2\n" : "not ok 2\n";
-        print defined(eval { syslog('info', 'test') }) ? "ok 3\n" : "not ok 3\n";
-    }
-    else {
-        for (1..3) {
-            print
-                "ok $_ # skipping, file ",
-                Sys::Syslog::_PATH_LOG(),
-                " does not exist\n";
-        }
-    }
-}
-else {
-    for (1..3) { print "ok $_ # skipping, _PATH_LOG unavailable\n" }
-}
-
-if( $Test_Syslog_INET ) {
-    print defined(eval { setlogsock('inet') }) ? "ok 4\n" 
-                                               : "not ok 4\n";
-    print defined(eval { openlog('perl', 'ndelay', 'local0') }) ? "ok 5\n" 
-                                                                : "not ok 5\n";
-    print defined(eval { syslog('info', 'test') }) ? "ok 6\n" 
-                                                   : "not ok 6\n";
-}
-else {
-    print "ok $_ # skipped(assuming syslog doesn't accept inet connections)\n" 
-      foreach (4..6);
-}

diff --git a/t/lib/tb-genxt.t b/t/lib/tb-genxt.t
deleted file mode 100644 (file)
index 6889653..0000000
--- a/t/lib/tb-genxt.t
+++ /dev/null
@@ -1,104 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..35\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Text::Balanced qw ( gen_extract_tagged );
-$loaded = 1;
-print "ok 1\n";
-$count=2;
-use vars qw( $DEBUG );
-sub debug { print "\t>>>",@_ if $DEBUG }
-
-######################### End of black magic.
-
-
-$cmd = "print";
-$neg = 0;
-while (defined($str = <DATA>))
-{
-       chomp $str;
-       $str =~ s/\\n/\n/g;
-       if ($str =~ s/\A# USING://)
-       {
-               $neg = 0;
-               eval{local$^W;*f = eval $str || die};
-               next;
-       }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       $str =~ s/\\n/\n/g;
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
-
-       my @res;
-       $var = eval { @res = f($str) };
-       debug "\t list got: [" . join("|",@res) . "]\n";
-       debug "\t list left: [$str]\n";
-       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-
-       pos $str = 0;
-       $var = eval { scalar f($str) };
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: [$var]\n";
-       debug "\t scalar left: [$str]\n";
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-}
-
-__DATA__
-
-# USING: gen_extract_tagged(qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]});
-       <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
-
-# USING: gen_extract_tagged("BEGIN","END");
-       BEGIN at the BEGIN keyword and END at the END;
-       BEGIN at the beginning and end at the END;
-
-# USING: gen_extract_tagged(undef,undef,undef,{ignore=>["<[^>]*/>"]});
-       <A>aaa<B>bbb<BR/>ccc</B>ddd</A>;
-
-# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"MAX"});
-       ; at the ;-) keyword
-
-# USING: gen_extract_tagged("<[A-Z]+>",undef, undef, {ignore=>["<BR>"]});
-       <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
-
-# THESE SHOULD FAIL
-       BEGIN at the beginning and end at the end;
-       BEGIN at the BEGIN keyword and END at the end;
-
-# TEST EXTRACTION OF TAGGED STRINGS
-# USING: gen_extract_tagged("BEGIN","END",undef,{reject=>["BEGIN","END"]});
-# THESE SHOULD FAIL
-       BEGIN at the BEGIN keyword and END at the end;
-
-# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"PARA"});
-       ; at the ;-) keyword
-
-
-# USING: gen_extract_tagged();
-       <A>some text</A>;
-       <B>some text<A>other text</A></B>;
-       <A>some text<A>other text</A></A>;
-       <A HREF="#section2">some text</A>;
-
-# THESE SHOULD FAIL
-       <A>some text
-       <A>some text<A>other text</A>;
-       <B>some text<A>other text</B>;

diff --git a/t/lib/tb-xbrak.t b/t/lib/tb-xbrak.t
deleted file mode 100644 (file)
index 5a8e524..0000000
--- a/t/lib/tb-xbrak.t
+++ /dev/null
@@ -1,81 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..19\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Text::Balanced qw ( extract_bracketed );
-$loaded = 1;
-print "ok 1\n";
-$count=2;
-use vars qw( $DEBUG );
-sub debug { print "\t>>>",@_ if $DEBUG }
-
-######################### End of black magic.
-
-
-$cmd = "print";
-$neg = 0;
-while (defined($str = <DATA>))
-{
-       chomp $str;
-       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       $str =~ s/\\n/\n/g;
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
-
-       $var = eval "() = $cmd";
-       debug "\t list got: [$var]\n";
-       debug "\t list left: [$str]\n";
-       print "not " if (substr($str,pos($str),1) eq ';')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-
-       pos $str = 0;
-       $var = eval $cmd;
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: [$var]\n";
-       debug "\t scalar left: [$str]\n";
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-}
-
-__DATA__
-
-# USING: extract_bracketed($str);
-{a nested { and } are okay as are () and <> pairs and escaped \}'s };
-{a nested\n{ and } are okay as are\n() and <> pairs and escaped \}'s };
-
-# USING: extract_bracketed($str,'{}');
-{a nested { and } are okay as are unbalanced ( and < pairs and escaped \}'s };
-
-# THESE SHOULD FAIL
-{an unmatched nested { isn't okay, nor are ( and < };
-{an unbalanced nested [ even with } and ] to match them;
-
-
-# USING: extract_bracketed($str,'<"`q>');
-<a q{uoted} ">" unbalanced right bracket of /(q>)/ either sort (`>>>""">>>>`) is okay >;
-
-# USING: extract_bracketed($str,'<">');
-<a quoted ">" unbalanced right bracket is okay >;
-
-# USING: extract_bracketed($str,'<"`>');
-<a quoted ">" unbalanced right bracket of either sort (`>>>""">>>>`) is okay >;
-
-# THIS SHOULD FAIL
-<a misquoted '>' unbalanced right bracket is bad >;

diff --git a/t/lib/tb-xcode.t b/t/lib/tb-xcode.t
deleted file mode 100644 (file)
index 00be51e..0000000
--- a/t/lib/tb-xcode.t
+++ /dev/null
@@ -1,94 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..37\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Text::Balanced qw ( extract_codeblock );
-$loaded = 1;
-print "ok 1\n";
-$count=2;
-use vars qw( $DEBUG );
-sub debug { print "\t>>>",@_ if $DEBUG }
-
-######################### End of black magic.
-
-
-$cmd = "print";
-$neg = 0;
-while (defined($str = <DATA>))
-{
-       chomp $str;
-       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       $str =~ s/\\n/\n/g;
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
-
-       my @res;
-       $var = eval "\@res = $cmd";
-       debug "\t   Failed: $@ at " . $@+0 .")" if $@;
-       debug "\t list got: [" . join("|",@res) . "]\n";
-       debug "\t list left: [$str]\n";
-       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
-       print "ok ", $count++;
-       print "\n";
-
-       pos $str = 0;
-       $var = eval $cmd;
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: [$var]\n";
-       debug "\t scalar left: [$str]\n";
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-}
-
-__DATA__
-
-# USING: extract_codeblock($str,'<>');
-< %x = ( try => "this") >;
-< %x = () >;
-< %x = ( $try->{this}, "too") >;
-< %'x = ( $try->{this}, "too") >;
-< %'x'y = ( $try->{this}, "too") >;
-< %::x::y = ( $try->{this}, "too") >;
-
-# THIS SHOULD FAIL
-< %x = do { $try > 10 } >;
-
-# USING: extract_codeblock($str);
-
-{ $a = /\}/; };
-{ sub { $_[0] /= $_[1] } };  # / here
-{ 1; };
-{ $a = 1; };
-
-
-# USING: extract_codeblock($str,undef,'=*');
-========{$a=1};
-
-# USING: extract_codeblock($str,'{}<>');
-< %x = do { $try > 10 } >;
-
-# USING: extract_codeblock($str,'{}',undef,'<>');
-< %x = do { $try > 10 } >;
-
-# USING: extract_codeblock($str,'{}');
-{ $a = $b; # what's this doing here? \n };'
-{ $a = $b; \n $a =~ /$b/; \n @a = map /\s/ @b };
-
-# THIS SHOULD FAIL
-{ $a = $b; # what's this doing here? };'
-{ $a = $b; # what's this doing here? ;'

diff --git a/t/lib/tb-xdeli.t b/t/lib/tb-xdeli.t
deleted file mode 100644 (file)
index 7e5b06b..0000000
--- a/t/lib/tb-xdeli.t
+++ /dev/null
@@ -1,95 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..45\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Text::Balanced qw ( extract_delimited );
-$loaded = 1;
-print "ok 1\n";
-$count=2;
-use vars qw( $DEBUG );
-sub debug { print "\t>>>",@_ if $DEBUG }
-
-######################### End of black magic.
-
-
-$cmd = "print";
-$neg = 0;
-while (defined($str = <DATA>))
-{
-       chomp $str;
-       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       $str =~ s/\\n/\n/g;
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
-
-       $var = eval "() = $cmd";
-       debug "\t list got: [$var]\n";
-       debug "\t list left: [$str]\n";
-       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-
-       pos $str = 0;
-       $var = eval $cmd;
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: [$var]\n";
-       debug "\t scalar left: [$str]\n";
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-}
-
-__DATA__
-# USING: extract_delimited($str,'/#$',undef,'/#$');
-/a/;
-/a///;
-#b#;
-#b###;
-$c$;
-$c$$$;
-
-# TEST EXTRACTION OF DELIMITED TEXT WITH ESCAPES
-# USING: extract_delimited($str,'/#$',undef,'\\');
-/a/;
-/a\//;
-#b#;
-#b\##;
-$c$;
-$c\$$;
-
-# TEST EXTRACTION OF DELIMITED TEXT
-# USING: extract_delimited($str);
-'a';
-"b";
-`c`;
-'a\'';
-'a\\';
-'\\a';
-"a\\";
-"\\a";
-"b\'\"\'";
-`c '\`abc\`'`;
-
-# TEST EXTRACTION OF DELIMITED TEXT
-# USING: extract_delimited($str,'/#$','-->');
--->/a/;
--->#b#;
--->$c$;
-
-# THIS SHOULD FAIL
-$c$;

diff --git a/t/lib/tb-xmult.t b/t/lib/tb-xmult.t
deleted file mode 100644 (file)
index 31dd7d4..0000000
--- a/t/lib/tb-xmult.t
+++ /dev/null
@@ -1,316 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..85\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Text::Balanced qw ( :ALL );
-$loaded = 1;
-print "ok 1\n";
-$count=2;
-use vars qw( $DEBUG );
-sub debug { print "\t>>>",@_ if $DEBUG }
-
-######################### End of black magic.
-
-sub expect
-{
-       local $^W;
-       my ($l1, $l2) = @_;
-
-       if (@$l1 != @$l2)
-       {
-               print "\@l1: ", join(", ", @$l1), "\n";
-               print "\@l2: ", join(", ", @$l2), "\n";
-               print "not ";
-       }
-       else
-       {
-               for (my $i = 0; $i < @$l1; $i++)
-               {
-                       if ($l1->[$i] ne $l2->[$i])
-                       {
-                               print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n";
-                               print "not ";
-                               last;
-                       }
-               }
-       }
-
-       print "ok $count\n";
-       $count++;
-}
-
-sub divide
-{
-       my ($text, @index) = @_;
-       my @bits = ();
-       unshift @index, 0;
-       push @index, length($text);
-       for ( my $i= 0; $i < $#index; $i++)
-       {
-               push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]);
-       }
-       pop @bits;
-       return @bits;
-
-}
-
-
-$stdtext1 = q{$var = do {"val" && $val;};};
-
-# TESTS 2-4
-$text = $stdtext1;
-expect [ extract_multiple($text,undef,1) ],
-       [ divide $stdtext1 => 4 ];
-
-expect [ pos $text], [ 4 ];
-expect [ $text ], [ $stdtext1 ];
-
-# TESTS 5-7
-$text = $stdtext1;
-expect [ scalar extract_multiple($text,undef,1) ],
-       [ divide $stdtext1 => 4 ];
-
-expect [ pos $text], [ 0 ];
-expect [ $text ], [ substr($stdtext1,4) ];
-
-
-# TESTS 8-10
-$text = $stdtext1;
-expect [ extract_multiple($text,undef,2) ],
-       [ divide($stdtext1 => 4, 10) ];
-
-expect [ pos $text], [ 10 ];
-expect [ $text ], [ $stdtext1 ];
-
-# TESTS 11-13
-$text = $stdtext1;
-expect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ],
-       [ substr($stdtext1,0,4) ];
-
-expect [ pos $text], [ 0 ];
-expect [ $text ], [ substr($stdtext1,4) ];
-
-
-# TESTS 14-16
-$text = $stdtext1;
-expect [ extract_multiple($text,undef,3) ],
-       [ divide($stdtext1 => 4, 10, 26) ];
-
-expect [ pos $text], [ 26 ];
-expect [ $text ], [ $stdtext1 ];
-
-# TESTS 17-19
-$text = $stdtext1;
-expect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ],
-       [ substr($stdtext1,0,4) ];
-
-expect [ pos $text], [ 0 ];
-expect [ $text ], [ substr($stdtext1,4) ];
-
-
-# TESTS 20-22
-$text = $stdtext1;
-expect [ extract_multiple($text,undef,4) ],
-       [ divide($stdtext1 => 4, 10, 26, 27) ];
-
-expect [ pos $text], [ 27 ];
-expect [ $text ], [ $stdtext1 ];
-
-# TESTS 23-25
-$text = $stdtext1;
-expect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ],
-       [ substr($stdtext1,0,4) ];
-
-expect [ pos $text], [ 0 ];
-expect [ $text ], [ substr($stdtext1,4) ];
-
-
-# TESTS 26-28
-$text = $stdtext1;
-expect [ extract_multiple($text,undef,5) ],
-       [ divide($stdtext1 => 4, 10, 26, 27) ];
-
-expect [ pos $text], [ 27 ];
-expect [ $text ], [ $stdtext1 ];
-
-
-# TESTS 29-31
-$text = $stdtext1;
-expect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ],
-       [ substr($stdtext1,0,4) ];
-
-expect [ pos $text], [ 0 ];
-expect [ $text ], [ substr($stdtext1,4) ];
-
-
-
-# TESTS 32-34
-$stdtext2 = q{$var = "val" && (1,2,3);};
-
-$text = $stdtext2;
-expect [ extract_multiple($text) ],
-       [ divide($stdtext2 => 4, 7, 12, 24) ];
-
-expect [ pos $text], [ 24 ];
-expect [ $text ], [ $stdtext2 ];
-
-# TESTS 35-37
-$text = $stdtext2;
-expect [ scalar extract_multiple($text) ],
-       [ substr($stdtext2,0,4) ];
-
-expect [ pos $text], [ 0 ];
-expect [ $text ], [ substr($stdtext2,4) ];
-
-
-# TESTS 38-40
-$text = $stdtext2;
-expect [ extract_multiple($text,[\&extract_bracketed]) ],
-       [ substr($stdtext2,0,15), substr($stdtext2,16,7), substr($stdtext2,23) ];
-
-expect [ pos $text], [ 24 ];
-expect [ $text ], [ $stdtext2 ];
-
-# TESTS 41-43
-$text = $stdtext2;
-expect [ scalar extract_multiple($text,[\&extract_bracketed]) ],
-       [ substr($stdtext2,0,15) ];
-
-expect [ pos $text], [ 0 ];
-expect [ $text ], [ substr($stdtext2,15) ];
-
-
-# TESTS 44-46
-$text = $stdtext2;
-expect [ extract_multiple($text,[\&extract_variable]) ],
-       [ substr($stdtext2,0,4), substr($stdtext2,4) ];
-
-expect [ pos $text], [ length($text) ];
-expect [ $text ], [ $stdtext2 ];
-
-# TESTS 47-49
-$text = $stdtext2;
-expect [ scalar extract_multiple($text,[\&extract_variable]) ],
-       [ substr($stdtext2,0,4) ];
-
-expect [ pos $text], [ 0 ];
-expect [ $text ], [ substr($stdtext2,4) ];
-
-
-# TESTS 50-52
-$text = $stdtext2;
-expect [ extract_multiple($text,[\&extract_quotelike]) ],
-       [ substr($stdtext2,0,6), substr($stdtext2,7,5), substr($stdtext2,12) ];
-
-expect [ pos $text], [ length($text) ];
-expect [ $text ], [ $stdtext2 ];
-
-# TESTS 53-55
-$text = $stdtext2;
-expect [ scalar extract_multiple($text,[\&extract_quotelike]) ],
-       [ substr($stdtext2,0,6) ];
-
-expect [ pos $text], [ 0 ];
-expect [ $text ], [ substr($stdtext2,6) ];
-
-
-# TESTS 56-58
-$text = $stdtext2;
-expect [ extract_multiple($text,[\&extract_quotelike],2,1) ],
-       [ substr($stdtext2,7,5) ];
-
-expect [ pos $text], [ 23 ];
-expect [ $text ], [ $stdtext2 ];
-
-# TESTS 59-61
-$text = $stdtext2;
-expect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ],
-       [ substr($stdtext2,7,5) ];
-
-expect [ pos $text], [ 6 ];
-expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
-
-
-# TESTS 62-64
-$text = $stdtext2;
-expect [ extract_multiple($text,[\&extract_quotelike],1,1) ],
-       [ substr($stdtext2,7,5) ];
-
-expect [ pos $text], [ 12 ];
-expect [ $text ], [ $stdtext2 ];
-
-# TESTS 65-67
-$text = $stdtext2;
-expect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ],
-       [ substr($stdtext2,7,5) ];
-
-expect [ pos $text], [ 6 ];
-expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
-
-# TESTS 68-70
-my $stdtext3 = "a,b,c";
-
-$_ = $stdtext3;
-expect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
-       [ divide($stdtext3 => 1,2,3,4,5) ];
-
-expect [ pos ], [ 5 ];
-expect [ $_ ], [ $stdtext3 ];
-
-# TESTS 71-73
-
-$_ = $stdtext3;
-expect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
-       [ divide($stdtext3 => 1) ];
-
-expect [ pos ], [ 0 ];
-expect [ $_ ], [ substr($stdtext3,1) ];
-
-
-# TESTS 74-76
-
-$_ = $stdtext3;
-expect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
-       [ divide($stdtext3 => 1,2,3,4,5) ];
-
-expect [ pos ], [ 5 ];
-expect [ $_ ], [ $stdtext3 ];
-
-# TESTS 77-79
-
-$_ = $stdtext3;
-expect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
-       [ divide($stdtext3 => 1) ];
-
-expect [ pos ], [ 0 ];
-expect [ $_ ], [ substr($stdtext3,1) ];
-
-
-# TESTS 80-82
-
-$_ = $stdtext3;
-expect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ],
-       [ qw(a b c) ];
-
-expect [ pos ], [ 5 ];
-expect [ $_ ], [ $stdtext3 ];
-
-# TESTS 83-85
-
-$_ = $stdtext3;
-expect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ],
-       [ divide($stdtext3 => 1) ];
-
-expect [ pos ], [ 0 ];
-expect [ $_ ], [ substr($stdtext3,2) ];

diff --git a/t/lib/tb-xquot.t b/t/lib/tb-xquot.t
deleted file mode 100644 (file)
index 567e0a5..0000000
--- a/t/lib/tb-xquot.t
+++ /dev/null
@@ -1,118 +0,0 @@
-#!./perl -ws
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..89\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Text::Balanced qw ( extract_quotelike );
-$loaded = 1;
-print "ok 1\n";
-$count=2;
-use vars qw( $DEBUG );
-# $DEBUG=1;
-sub debug { print "\t>>>",@_ if $DEBUG }
-
-######################### End of black magic.
-
-
-$cmd = "print";
-$neg = 0;
-while (defined($str = <DATA>))
-{
-       chomp $str;
-       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
-       $str =~ s/\\n/\n/g;
-       my $orig = $str;
-
-        my @res;
-       eval qq{\@res = $cmd; };
-       debug "\t  got:\n" . join "", map { $res[$_]=~s/\n/\\n/g; "\t\t\t$_: [$res[$_]]\n"} (0..$#res);
-       debug "\t left: " . (map { s/\n/\\n/g; "[$_]\n" } my $cpy1 = $str)[0];
-       debug "\t  pos: " . (map { s/\n/\\n/g; "[$_]\n" } my $cpy2 = substr($str,pos($str)))[0] . "...]\n";
-       print "not " if (substr($str,pos($str),1) eq ';')==$neg;
-       print "ok ", $count++;
-       print "\n";
-
-       $str = $orig;
-       debug "\tUsing: scalar $cmd\n";
-       debug "\t   on: [$str]\n";
-       $var = eval $cmd;
-       print " ($@)" if $@ && $DEBUG;
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: " . (map { s/\n/\\n/g; "[$_]\n" } $var)[0];
-       debug "\t scalar left: " . (map { s/\n/\\n/g; "[$_]\n" } $str)[0];
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print "\n";
-}
-
-__DATA__
-
-# USING: extract_quotelike($str);
-'';
-"";
-"a";
-'b';
-`cc`;
-
-
-<<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
-     <<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
-<<"EOHERE"; done()\nline1\nline2\nEOHERE\n and next
-<<`EOHERE`; done()\nline1\nline2\nEOHERE\n and next
-<<'EOHERE'; done()\nline1\n'line2'\nEOHERE\n and next
-<<'EOHERE;'; done()\nline1\nline2\nEOHERE;\n and next
-<<"   EOHERE"; done() \nline1\nline2\n   EOHERE\nand next
-<<""; done()\nline1\nline2\n\n and next
-<<; done()\nline1\nline2\n\n and next
-
-
-"this is a nested $var[$x] {";
-/a/gci;
-m/a/gci;
-
-q(d);
-qq(e);
-qx(f);
-qr(g);
-qw(h i j);
-q{d};
-qq{e};
-qx{f};
-qr{g};
-qq{a nested { and } are okay as are () and <> pairs and escaped \}'s };
-q/slash/;
-q # slash #;
-qr qw qx;
-
-s/x/y/;
-s/x/y/cgimsox;
-s{a}{b};
-s{a}\n {b};
-s(a){b};
-s(a)/b/;
-s/'/\\'/g;
-tr/x/y/;
-y/x/y/;
-
-# THESE SHOULD FAIL
-s<$self->{pat}>{$self->{sub}};         # CAN'T HANDLE '>' in '->'
-s-$self->{pap}-$self->{sub}-;          # CAN'T HANDLE '-' in '->'
-<<EOHERE; done();\nline1\nline2\nEOHERE;\n; next;          # RDEL HAS NO ';'
-<<'EOHERE'; done();\nline1\nline2\nEOHERE;\n; next;        # RDEF HAS NO ';'
-     <<    EOTHERE; done();\nline1\nline2\n    EOTHERE\n; next;  # RDEL IS "" (!)

diff --git a/t/lib/tb-xtagg.t b/t/lib/tb-xtagg.t
deleted file mode 100644 (file)
index c883181..0000000
--- a/t/lib/tb-xtagg.t
+++ /dev/null
@@ -1,118 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..53\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Text::Balanced qw ( extract_tagged gen_extract_tagged );
-$loaded = 1;
-print "ok 1\n";
-$count=2;
-use vars qw( $DEBUG );
-sub debug { print "\t>>>",@_ if $DEBUG }
-
-######################### End of black magic.
-
-
-$cmd = "print";
-$neg = 0;
-while (defined($str = <DATA>))
-{
-       chomp $str;
-       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       $str =~ s/\\n/\n/g;
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
-
-       my @res;
-       $var = eval "\@res = $cmd";
-       debug "\t list got: [" . join("|",@res) . "]\n";
-       debug "\t list left: [$str]\n";
-       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-
-       pos $str = 0;
-       $var = eval $cmd;
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: [$var]\n";
-       debug "\t scalar left: [$str]\n";
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-}
-
-__DATA__
-# USING: gen_extract_tagged("BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)")->($str);
-       ignore\n this and then BEGINHERE at the ENDHERE;
-       ignore\n this and then BEGINTHIS at the ENDTHIS;
-
-# USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)");
-       ignore\n this and then BEGINHERE at the ENDHERE;
-       ignore\n this and then BEGINTHIS at the ENDTHIS;
-
-# USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)");
-       ignore\n this and then BEGINHERE at the ENDHERE;
-       ignore\n this and then BEGINTHIS at the ENDTHIS;
-
-# THIS SHOULD FAIL
-       ignore\n this and then BEGINTHIS at the ENDTHAT;
-
-# USING: extract_tagged($str,"BEGIN","END","(?s).*?(?=BEGIN)");
-       ignore\n this and then BEGIN at the END;
-
-# USING: extract_tagged($str);
-       <A-1 HREF="#section2">some text</A-1>;
-
-# USING: extract_tagged($str,qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]});
-       <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
-
-# USING: extract_tagged($str,"BEGIN","END");
-       BEGIN at the BEGIN keyword and END at the END;
-       BEGIN at the beginning and end at the END;
-
-# USING: extract_tagged($str,undef,undef,undef,{ignore=>["<[^>]*/>"]});
-       <A>aaa<B>bbb<BR/>ccc</B>ddd</A>;
-
-# USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"MAX"});
-       ; at the ;-) keyword
-
-# USING: extract_tagged($str,"<[A-Z]+>",undef, undef, {ignore=>["<BR>"]});
-       <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
-
-# THESE SHOULD FAIL
-       BEGIN at the beginning and end at the end;
-       BEGIN at the BEGIN keyword and END at the end;
-
-# TEST EXTRACTION OF TAGGED STRINGS
-# USING: extract_tagged($str,"BEGIN","END",undef,{reject=>["BEGIN","END"]});
-# THESE SHOULD FAIL
-       BEGIN at the BEGIN keyword and END at the end;
-
-# USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"PARA"});
-       ; at the ;-) keyword
-
-
-# USING: extract_tagged($str);
-       <A>some text</A>;
-       <B>some text<A>other text</A></B>;
-       <A>some text<A>other text</A></A>;
-       <A HREF="#section2">some text</A>;
-
-# THESE SHOULD FAIL
-       <A>some text
-       <A>some text<A>other text</A>;
-       <B>some text<A>other text</B>;

diff --git a/t/lib/tb-xvari.t b/t/lib/tb-xvari.t
deleted file mode 100644 (file)
index dd35b9c..0000000
--- a/t/lib/tb-xvari.t
+++ /dev/null
@@ -1,107 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..81\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Text::Balanced qw ( extract_variable );
-$loaded = 1;
-print "ok 1\n";
-$count=2;
-use vars qw( $DEBUG );
-sub debug { print "\t>>>",@_ if $DEBUG }
-
-######################### End of black magic.
-
-
-$cmd = "print";
-$neg = 0;
-while (defined($str = <DATA>))
-{
-       chomp $str;
-       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       $str =~ s/\\n/\n/g;
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
-
-       my @res;
-       $var = eval "\@res = $cmd";
-       debug "\t list got: [" . join("|",@res) . "]\n";
-       debug "\t list left: [$str]\n";
-       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-
-       pos $str = 0;
-       $var = eval $cmd;
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: [$var]\n";
-       debug "\t scalar left: [$str]\n";
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-}
-
-__DATA__
-
-# USING: extract_variable($str);
-# THESE SHOULD FAIL
-$a->;
-$a (1..3) { print $a };
-
-# USING: extract_variable($str);
-*var;
-*$var;
-*{var};
-*{$var};
-*var{cat};
-\&var;
-\&mod::var;
-\&mod'var;
-$a;
-$_;
-$a[1];
-$_[1];
-$a{cat};
-$_{cat};
-$a->[1];
-$a->{"cat"}[1];
-@$listref;
-@{$listref};
-$obj->nextval;
-$obj->_nextval;
-$obj->next_val_;
-@{$obj->nextval};
-@{$obj->nextval($cat,$dog)->{new}};
-@{$obj->nextval($cat?$dog:$fish)->{new}};
-@{$obj->nextval(cat()?$dog:$fish)->{new}};
-$ a {'cat'};
-$a::b::c{d}->{$e->()};
-$a'b'c'd{e}->{$e->()};
-$a'b::c'd{e}->{$e->()};
-$#_;
-$#array;
-$#{array};
-$var[$#var];
-
-# THESE SHOULD FAIL
-$a->;
-@{$;
-$ a :: b :: c
-$ a ' b ' c
-
-# USING: extract_variable($str,'=*');
-========$a;

diff --git a/t/lib/test-harness.t b/t/lib/test-harness.t
deleted file mode 100644 (file)
index a4c423d..0000000
--- a/t/lib/test-harness.t
+++ /dev/null
@@ -1,205 +0,0 @@
-#!perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use strict;
-
-# For shutting up Test::Harness.
-package My::Dev::Null;
-use Tie::Handle;
-@My::Dev::Null::ISA = qw(Tie::StdHandle);
-
-sub WRITE { }
-
-
-package main;
-
-# Utility testing functions.
-my $test_num = 1;
-sub ok ($;$) {
-    my($test, $name) = @_;
-    my $okstring = '';
-    $okstring = "not " unless $test;
-    $okstring .= "ok $test_num";
-    $okstring .= " - $name" if defined $name;
-    print "$okstring\n";
-    $test_num++;
-}
-
-sub eqhash {
-    my($a1, $a2) = @_;
-    return 0 unless keys %$a1 == keys %$a2;
-
-    my $ok = 1;
-    foreach my $k (keys %$a1) {
-        $ok = $a1->{$k} eq $a2->{$k};
-        last unless $ok;
-    }
-
-    return $ok;
-}
-
-use vars qw($Total_tests %samples);
-
-my $loaded;
-BEGIN { $| = 1; $^W = 1; }
-END {print "not ok $test_num\n" unless $loaded;}
-print "1..$Total_tests\n";
-use Test::Harness;
-$loaded = 1;
-ok(1, 'compile');
-######################### End of black magic.
-
-BEGIN {
-    %samples = (
-                simple            => {
-                                      bonus      => 0,
-                                      max        => 5,
-                                      'ok'         => 5,
-                                      files      => 1,
-                                      bad        => 0,
-                                      good       => 1,
-                                      tests      => 1,
-                                      sub_skipped=> 0,
-                                      skipped    => 0,
-                                     },
-                simple_fail      => {
-                                     bonus       => 0,
-                                     max         => 5,
-                                     'ok'          => 3,
-                                     files       => 1,
-                                     bad         => 1,
-                                     good        => 0,
-                                     tests       => 1,
-                                     sub_skipped => 0,
-                                     skipped     => 0,
-                                    },
-                descriptive       => {
-                                      bonus      => 0,
-                                      max        => 5,
-                                      'ok'         => 5,
-                                      files      => 1,
-                                      bad        => 0,
-                                      good       => 1,
-                                      tests      => 1,
-                                      sub_skipped=> 0,
-                                      skipped    => 0,
-                                     },
-                no_nums           => {
-                                      bonus      => 0,
-                                      max        => 5,
-                                      'ok'         => 4,
-                                      files      => 1,
-                                      bad        => 1,
-                                      good       => 0,
-                                      tests      => 1,
-                                      sub_skipped=> 0,
-                                      skipped    => 0,
-                                     },
-                todo              => {
-                                      bonus      => 1,
-                                      max        => 5,
-                                      'ok'         => 5,
-                                      files      => 1,
-                                      bad        => 0,
-                                      good       => 1,
-                                      tests      => 1,
-                                      sub_skipped=> 0,
-                                      skipped    => 0,
-                                     },
-                skip              => {
-                                      bonus      => 0,
-                                      max        => 5,
-                                      'ok'         => 5,
-                                      files      => 1,
-                                      bad        => 0,
-                                      good       => 1,
-                                      tests      => 1,
-                                      sub_skipped=> 1,
-                                      skipped    => 0,
-                                     },
-                bailout           => 0,
-                combined          => {
-                                      bonus      => 1,
-                                      max        => 10,
-                                      'ok'         => 8,
-                                      files      => 1,
-                                      bad        => 1,
-                                      good       => 0,
-                                      tests      => 1,
-                                      sub_skipped=> 1,
-                                      skipped    => 0
-                                     },
-                duplicates        => {
-                                      bonus      => 0,
-                                      max        => 10,
-                                      'ok'         => 11,
-                                      files      => 1,
-                                      bad        => 1,
-                                      good       => 0,
-                                      tests      => 1,
-                                      sub_skipped=> 0,
-                                      skipped    => 0,
-                                     },
-                header_at_end     => {
-                                      bonus      => 0,
-                                      max        => 4,
-                                      'ok'         => 4,
-                                      files      => 1,
-                                      bad        => 0,
-                                      good       => 1,
-                                      tests      => 1,
-                                      sub_skipped=> 0,
-                                      skipped    => 0,
-                                     },
-                skip_all          => {
-                                      bonus      => 0,
-                                      max        => 0,
-                                      'ok'         => 0,
-                                      files      => 1,
-                                      bad        => 0,
-                                      good       => 1,
-                                      tests      => 1,
-                                      sub_skipped=> 0,
-                                      skipped    => 1,
-                                     },
-                with_comments     => {
-                                      bonus      => 2,
-                                      max        => 5,
-                                      'ok'         => 5,
-                                      files      => 1,
-                                      bad        => 0,
-                                      good       => 1,
-                                      tests      => 1,
-                                      sub_skipped=> 0,
-                                      skipped    => 0,
-                                     },
-               );
-
-    $Total_tests = keys(%samples) + 1;
-}
-
-tie *NULL, 'My::Dev::Null' or die $!;
-
-while (my($test, $expect) = each %samples) {
-    # _run_all_tests() runs the tests but skips the formatting.
-    my($totals, $failed);
-    eval {
-        select NULL;    # _run_all_tests() isn't as quiet as it should be.
-        ($totals, $failed) = 
-          Test::Harness::_run_all_tests("lib/sample-tests/$test");
-    };
-    select STDOUT;
-
-    unless( $@ ) {
-        ok( eqhash( $expect, {map { $_=>$totals->{$_} } keys %$expect} ), 
-                                                                      $test );
-    }
-    else {      # special case for bailout
-        ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i),
-            $test );
-    }
-}

diff --git a/t/lib/textfill.t b/t/lib/textfill.t
deleted file mode 100755 (executable)
index 5ff3850..0000000
--- a/t/lib/textfill.t
+++ /dev/null
@@ -1,98 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use Text::Wrap qw(&fill);
-
-@tests = (split(/\nEND\n/s, <<DONE));
-TEST1
-Cyberdog Information
-
-Cyberdog & Netscape in the news
-Important Press Release regarding Cyberdog and Netscape. Check it out! 
-
-Cyberdog Plug-in Support!
-Cyberdog support for Netscape Plug-ins is now available to download! Go
-to the Cyberdog Beta Download page and download it now! 
-
-Cyberdog Book
-Check out Jesse Feiler's way-cool book about Cyberdog. You can find
-details out about the book as well as ordering information at Philmont
-Software Mill site. 
-
-Java!
-Looking to view Java applets in Cyberdog 1.1 Beta 3? Download and install
-the Mac OS Runtime for Java and try it out! 
-
-Cyberdog 1.1 Beta 3
-We hope that Cyberdog and OpenDoc 1.1 will be available within the next
-two weeks. In the meantime, we have released another version of
-Cyberdog, Cyberdog 1.1 Beta 3. This version fixes several bugs that were
-reported to us during out public beta period. You can check out our release
-notes to see what we fixed! 
-END
-    Cyberdog Information
-    Cyberdog & Netscape in the news Important Press Release regarding
- Cyberdog and Netscape. Check it out! 
-    Cyberdog Plug-in Support! Cyberdog support for Netscape Plug-ins is now
- available to download! Go to the Cyberdog Beta Download page and download
- it now! 
-    Cyberdog Book Check out Jesse Feiler's way-cool book about Cyberdog.
- You can find details out about the book as well as ordering information at
- Philmont Software Mill site. 
-    Java! Looking to view Java applets in Cyberdog 1.1 Beta 3? Download and
- install the Mac OS Runtime for Java and try it out! 
-    Cyberdog 1.1 Beta 3 We hope that Cyberdog and OpenDoc 1.1 will be
- available within the next two weeks. In the meantime, we have released
- another version of Cyberdog, Cyberdog 1.1 Beta 3. This version fixes
- several bugs that were reported to us during out public beta period. You
- can check out our release notes to see what we fixed! 
-END
-DONE
-
-
-$| = 1;
-
-print "1..", @tests/2, "\n";
-
-use Text::Wrap;
-
-$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
-
-$tn = 1;
-while (@tests) {
-       my $in = shift(@tests);
-       my $out = shift(@tests);
-
-       $in =~ s/^TEST(\d+)?\n//;
-
-       my $back = fill('    ', ' ', $in);
-
-       if ($back eq $out) {
-               print "ok $tn\n";
-       } elsif ($rerun) {
-               my $oi = $in;
-               open(F,">#o") and do { print F $back; close(F) };
-               open(F,">#e") and do { print F $out;  close(F) };
-               foreach ($in, $back, $out) {
-                       s/\t/^I\t/gs;
-                       s/\n/\$\n/gs;
-               }
-               print "------------ input ------------\n";
-               print $in;
-               print "\n------------ output -----------\n";
-               print $back;
-               print "\n------------ expected ---------\n";
-               print $out;
-               print "\n-------------------------------\n";
-               $Text::Wrap::debug = 1;
-               fill('    ', ' ', $oi);
-               exit(1);
-       } else {
-               print "not ok $tn\n";
-       }
-       $tn++;
-}

diff --git a/t/lib/texttabs.t b/t/lib/texttabs.t
deleted file mode 100755 (executable)
index 2856aff..0000000
--- a/t/lib/texttabs.t
+++ /dev/null
@@ -1,141 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-@tests = (split(/\nEND\n/s, <<DONE));
-TEST 1 u
-                x
-END
-               x
-END
-TEST 2 e
-               x
-END
-                x
-END
-TEST 3 e
-       x
-               y
-                       z
-END
-        x
-                y
-                        z
-END
-TEST 4 u
-        x
-                y
-                        z
-END
-       x
-               y
-                       z
-END
-TEST 5 u
-This    Is      a       test    of      a       line with many embedded tabs
-END
-This   Is      a       test    of      a       line with many embedded tabs
-END
-TEST 6 e
-This   Is      a       test    of      a       line with many embedded tabs
-END
-This    Is      a       test    of      a       line with many embedded tabs
-END
-TEST 7 u
-            x
-END
-           x
-END
-TEST 8 e
-       
-               
-       
-
-           
-END
-        
-                
-        
-
-           
-END
-TEST 9 u
-           
-END
-          
-END
-TEST 10 u
-       
-               
-       
-
-           
-END
-       
-               
-       
-
-          
-END
-TEST 11 u
-foobar                  IN     A               140.174.82.12
-
-END
-foobar                 IN      A               140.174.82.12
-
-END
-DONE
-
-$| = 1;
-
-my $testcount = "1..";
-$testcount .= @tests/2;
-print "$testcount\n";
-
-use Text::Tabs;
-
-$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
-
-$tn = 1;
-while (@tests) {
-       my $in = shift(@tests);
-       my $out = shift(@tests);
-
-       $in =~ s/^TEST\s*(\d+)?\s*(\S+)?\n//;
-
-       if ($2 eq 'e') {
-               $f = \&expand;
-               $fn = 'expand';
-       } else {
-               $f = \&unexpand;
-               $fn = 'unexpand';
-       }
-
-       my $back = &$f($in);
-
-       if ($back eq $out) {
-               print "ok $tn\n";
-       } elsif ($rerun) {
-               my $oi = $in;
-               foreach ($in, $back, $out) {
-                       s/\t/^I\t/gs;
-                       s/\n/\$\n/gs;
-               }
-               print "------------ input ------------\n";
-               print $in;
-               print "\$\n------------ $fn -----------\n";
-               print $back;
-               print "\$\n------------ expected ---------\n";
-               print $out;
-               print "\$\n-------------------------------\n";
-               $Text::Tabs::debug = 1;
-               my $back = &$f($in);
-               exit(1);
-       } else {
-               print "not ok $tn\n";
-       }
-       $tn++;
-}

diff --git a/t/lib/textwrap.t b/t/lib/textwrap.t
deleted file mode 100755 (executable)
index fee6ce0..0000000
--- a/t/lib/textwrap.t
+++ /dev/null
@@ -1,209 +0,0 @@
-#!./perl -w
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-@tests = (split(/\nEND\n/s, <<DONE));
-TEST1
-This 
-is
-a
-test
-END
-   This 
- is
- a
- test
-END
-TEST2
-This is a test of a very long line.  It should be broken up and put onto multiple lines.
-This is a test of a very long line.  It should be broken up and put onto multiple lines.
-
-This is a test of a very long line.  It should be broken up and put onto multiple lines.
-END
-   This is a test of a very long line. It should be broken up and put onto
- multiple lines.
- This is a test of a very long line.  It should be broken up and put onto
- multiple lines.
- 
- This is a test of a very long line.  It should be broken up and put onto
- multiple lines.
-END
-TEST3
-This is a test of a very long line.  It should be broken up and put onto multiple lines.
-END
-   This is a test of a very long line. It should be broken up and put onto
- multiple lines.
-END
-TEST4
-This is a test of a very long line.  It should be broken up and put onto multiple lines.
-
-END
-   This is a test of a very long line. It should be broken up and put onto
- multiple lines.
-
-END
-TEST5
-This is a test of a very long line. It should be broken up and put onto multiple This is a test of a very long line. It should be broken up and put
-END
-   This is a test of a very long line. It should be broken up and put onto
- multiple This is a test of a very long line. It should be broken up and
- put
-END
-TEST6
-11111111 22222222 33333333 44444444 55555555 66666666 77777777 888888888 999999999 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee ffffffff gggggggg hhhhhhhh iiiiiiii jjjjjjjj kkkkkkkk llllllll mmmmmmmmm nnnnnnnnn ooooooooo ppppppppp qqqqqqqqq rrrrrrrrr sssssssss
-END
-   11111111 22222222 33333333 44444444 55555555 66666666 77777777 888888888
- 999999999 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee ffffffff
- gggggggg hhhhhhhh iiiiiiii jjjjjjjj kkkkkkkk llllllll mmmmmmmmm nnnnnnnnn
- ooooooooo ppppppppp qqqqqqqqq rrrrrrrrr sssssssss
-END
-TEST7
-c3t1d0s6 c4t1d0s6 c5t1d0s6 c6t1d0s6 c7t1d0s6 c8t1d0s6 c9t1d0s6 c10t1d0s6 c11t1d0s6 c12t1d0s6 c13t1d0s6 c14t1d0s6 c15t1d0s6 c16t1d0s6 c3t1d0s0 c4t1d0s0 c5t1d0s0 c6t1d0s0 c7t1d0s0 c8t1d0s0 c9t1d0s0 c10t1d0s0 c11t1d0s0 c12t1d0s0 c13t1d0s0 c14t1d0s0 c15t1d0s0 c16t1d0s0
-END
-   c3t1d0s6 c4t1d0s6 c5t1d0s6 c6t1d0s6 c7t1d0s6 c8t1d0s6 c9t1d0s6 c10t1d0s6
- c11t1d0s6 c12t1d0s6 c13t1d0s6 c14t1d0s6 c15t1d0s6 c16t1d0s6 c3t1d0s0
- c4t1d0s0 c5t1d0s0 c6t1d0s0 c7t1d0s0 c8t1d0s0 c9t1d0s0 c10t1d0s0 c11t1d0s0
- c12t1d0s0 c13t1d0s0 c14t1d0s0 c15t1d0s0 c16t1d0s0
-END
-TEST8
-A test of a very very long word.
-a123456789b123456789c123456789d123456789e123456789f123456789g123456789g1234567
-END
-   A test of a very very long word.
- a123456789b123456789c123456789d123456789e123456789f123456789g123456789g123
- 4567
-END
-TEST9
-A test of a very very long word.  a123456789b123456789c123456789d123456789e123456789f123456789g123456789g1234567
-END
-   A test of a very very long word. 
- a123456789b123456789c123456789d123456789e123456789f123456789g123456789g123
- 4567
-END
-TEST10
-my mother once said
-"never eat paste my darling"
-would that I heeded
-END
-   my mother once said
- "never eat paste my darling"
- would that I heeded
-END
-TEST11
-This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_program_does_not_crash_and_burn
-END
-   This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_pr
- ogram_does_not_crash_and_burn
-END
-TEST12
-This
-
-Has
-
-Blank
-
-Lines
-
-END
-   This
- 
- Has
- 
- Blank
- 
- Lines
-
-END
-DONE
-
-
-$| = 1;
-
-print "1..", 1 +@tests, "\n";
-
-use Text::Wrap;
-
-$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
-
-$tn = 1;
-
-@st = @tests;
-while (@st) {
-       my $in = shift(@st);
-       my $out = shift(@st);
-
-       $in =~ s/^TEST(\d+)?\n//;
-
-       my $back = wrap('   ', ' ', $in);
-
-       if ($back eq $out) {
-               print "ok $tn\n";
-       } elsif ($rerun) {
-               my $oi = $in;
-               foreach ($in, $back, $out) {
-                       s/\t/^I\t/gs;
-                       s/\n/\$\n/gs;
-               }
-               print "------------ input ------------\n";
-               print $in;
-               print "\n------------ output -----------\n";
-               print $back;
-               print "\n------------ expected ---------\n";
-               print $out;
-               print "\n-------------------------------\n";
-               $Text::Wrap::debug = 1;
-               wrap('   ', ' ', $oi);
-               exit(1);
-       } else {
-               print "not ok $tn\n";
-       }
-       $tn++;
-
-}
-
-@st = @tests;
-while(@st) {
-       my $in = shift(@st);
-       my $out = shift(@st);
-
-       $in =~ s/^TEST(\d+)?\n//;
-
-       my @in = split("\n", $in, -1);
-       @in = ((map { "$_\n" } @in[0..$#in-1]), $in[-1]);
-       
-       my $back = wrap('   ', ' ', @in);
-
-       if ($back eq $out) {
-               print "ok $tn\n";
-       } elsif ($rerun) {
-               my $oi = $in;
-               foreach ($in, $back, $out) {
-                       s/\t/^I\t/gs;
-                       s/\n/\$\n/gs;
-               }
-               print "------------ input2 ------------\n";
-               print $in;
-               print "\n------------ output2 -----------\n";
-               print $back;
-               print "\n------------ expected2 ---------\n";
-               print $out;
-               print "\n-------------------------------\n";
-               $Text::Wrap::debug = 1;
-               wrap('   ', ' ', $oi);
-               exit(1);
-       } else {
-               print "not ok $tn\n";
-       }
-       $tn++;
-}
-
-$Text::Wrap::huge = 'overflow';
-
-my $tw = 'This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_program_does_not_crash_and_burn';
-my $w = wrap('zzz','yyy',$tw);
-print (($w eq "zzz$tw") ? "ok $tn\n" : "not ok $tn");
-$tn++;
-

diff --git a/t/lib/thr5005.t b/t/lib/thr5005.t
deleted file mode 100755 (executable)
index bc6aed7..0000000
--- a/t/lib/thr5005.t
+++ /dev/null
@@ -1,207 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if (! $Config{'use5005threads'}) {
-       print "1..0 # Skip: not use5005threads\n";
-       exit 0;
-    }
-
-    # XXX known trouble with global destruction
-    $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
-}
-$| = 1;
-print "1..74\n";
-use Thread 'yield';
-print "ok 1\n";
-
-sub content
-{
- print shift;
- return shift;
-}
-
-# create a thread passing args and immedaietly wait for it.
-my $t = new Thread \&content,("ok 2\n","ok 3\n", 1..1000);
-print $t->join;
-
-# check that lock works ...
-{lock $foo;
- $t = new Thread sub { lock $foo; print "ok 5\n" };
- print "ok 4\n";
-}
-$t->join;
-
-sub dorecurse
-{
- my $val = shift;
- my $ret;
- print $val;
- if (@_)
-  {
-   $ret = Thread->new(\&dorecurse, @_);
-   $ret->join;
-  }
-}
-
-$t = new Thread \&dorecurse, map { "ok $_\n" } 6..10;
-$t->join;
-
-# test that sleep lets other thread run
-$t = new Thread \&dorecurse,"ok 11\n";
-sleep 6;
-print "ok 12\n";
-$t->join;
-
-sub islocked : locked {
- my $val = shift;
- my $ret;
- print $val;
- if (@_)
-  {
-   $ret = Thread->new(\&islocked, shift);
-  }
- $ret;
-}
-
-$t = Thread->new(\&islocked, "ok 13\n", "ok 14\n");
-$t->join->join;
-
-{
-    package Loch::Ness;
-    sub new { bless [], shift }
-    sub monster : locked : method {
-       my($s, $m) = @_;
-       print "ok $m\n";
-    }
-    sub gollum { &monster }
-}
-Loch::Ness->monster(15);
-Loch::Ness->new->monster(16);
-Loch::Ness->gollum(17);
-Loch::Ness->new->gollum(18);
-
-my $short = "This is a long string that goes on and on.";
-my $shorte = " a long string that goes on and on.";
-my $long  = "This is short.";
-my $longe  = " short.";
-my $thr1 = new Thread \&threaded, $short, $shorte, "19";
-my $thr2 = new Thread \&threaded, $long, $longe, "20";
-my $thr3 = new Thread \&testsprintf, "21";
-
-sub testsprintf {
-  my $testno = shift;
-  # this may coredump if thread vars are not properly initialised
-  my $same = sprintf "%.0f", $testno;
-  if ($testno eq $same) {
-    print "ok $testno\n";
-  } else {
-    print "not ok $testno\t# '$testno' ne '$same'\n";
-  }
-}
-
-sub threaded {
-  my ($string, $string_end, $testno) = @_;
-
-  # Do the match, saving the output in appropriate variables
-  $string =~ /(.*)(is)(.*)/;
-  # Yield control, allowing the other thread to fill in the match variables
-  yield();
-  # Examine the match variable contents; on broken perls this fails
-  if ($3 eq $string_end) {
-    print "ok $testno\n";
-  }
-  else {
-    warn <<EOT;
-
-#
-# This is a KNOWN FAILURE, and one of the reasons why threading
-# is still an experimental feature.  It is here to stop people
-# from deploying threads in production. ;-)
-#
-EOT
-    print "not ok $testno # other thread filled in match variables\n";
-  }
-}
-$thr1->join;
-$thr2->join;
-$thr3->join;
-print "ok 22\n";
-
-{
-    my $THRf_STATE_MASK = 7;
-    my $THRf_R_JOINABLE = 0;
-    my $THRf_R_JOINED = 1;
-    my $THRf_R_DETACHED = 2;
-    my $THRf_ZOMBIE = 3;
-    my $THRf_DEAD = 4;
-    my $THRf_DID_DIE = 8;
-    sub _test {
-       my($test, $t, $state, $die) = @_;
-       my $flags = $t->flags;
-       if (($flags & $THRf_STATE_MASK) == $state
-               && !($flags & $THRf_DID_DIE) == !$die) {
-           print "ok $test\n";
-       } else {
-           print <<BAD;
-not ok $test\t# got flags $flags not @{[ $state + ($die ? $THRf_DID_DIE : 0) ]}
-BAD
-       }
-    }
-
-    my @t;
-    push @t, (
-       Thread->new(sub { sleep 4; die "thread die\n" }),
-       Thread->new(sub { die "thread die\n" }),
-       Thread->new(sub { sleep 4; 1 }),
-       Thread->new(sub { 1 }),
-    ) for 1, 2;
-    $_->detach for @t[grep $_ & 4, 0..$#t];
-
-    sleep 1;
-    my $test = 23;
-    for (0..7) {
-       my $t = $t[$_];
-       my $flags = ($_ & 1)
-           ? ($_ & 4) ? $THRf_DEAD : $THRf_ZOMBIE
-           : ($_ & 4) ? $THRf_R_DETACHED : $THRf_R_JOINABLE;
-       _test($test++, $t, $flags, (($_ & 3) != 1) ? 0 : $THRf_DID_DIE);
-       printf "%sok %s\n", !$t->done == !($_ & 1) ? "" : "not ", $test++;
-    }
-#   $test = 39;
-    for (grep $_ & 1, 0..$#t) {
-       next if $_ & 4;         # can't join detached threads
-       $t[$_]->eval;
-       my $die = ($_ & 2) ? "" : "thread die\n";
-       printf "%sok %s\n", $@ eq $die ? "" : "not ", $test++;
-    }
-#   $test = 41;
-    for (0..7) {
-       my $t = $t[$_];
-       my $flags = ($_ & 1)
-           ? ($_ & 4) ? $THRf_DEAD : $THRf_DEAD
-           : ($_ & 4) ? $THRf_R_DETACHED : $THRf_R_JOINABLE;
-       _test($test++, $t, $flags, (($_ & 3) != 1) ? 0 : $THRf_DID_DIE);
-       printf "%sok %s\n", !$t->done == !($_ & 1) ? "" : "not ", $test++;
-    }
-#   $test = 57;
-    for (grep !($_ & 1), 0..$#t) {
-       next if $_ & 4;         # can't join detached threads
-       $t[$_]->eval;
-       my $die = ($_ & 2) ? "" : "thread die\n";
-       printf "%sok %s\n", $@ eq $die ? "" : "not ", $test++;
-    }
-    sleep 1;   # make sure even the detached threads are done sleeping
-#   $test = 59;
-    for (0..7) {
-       my $t = $t[$_];
-       my $flags = ($_ & 1)
-           ? ($_ & 4) ? $THRf_DEAD : $THRf_DEAD
-           : ($_ & 4) ? $THRf_DEAD : $THRf_DEAD;
-       _test($test++, $t, $flags, ($_ & 2) ? 0 : $THRf_DID_DIE);
-       printf "%sok %s\n", $t->done ? "" : "not ", $test++;
-    }
-#   $test = 75;
-}

diff --git a/t/lib/tie-push.t b/t/lib/tie-push.t
deleted file mode 100755 (executable)
index b19aa0d..0000000
--- a/t/lib/tie-push.t
+++ /dev/null
@@ -1,25 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-}    
-
-{
- package Basic;
- use Tie::Array;
- @ISA = qw(Tie::Array);
-
- sub TIEARRAY  { return bless [], shift }
- sub FETCH     { $_[0]->[$_[1]] }
- sub STORE     { $_[0]->[$_[1]] = $_[2] }
- sub FETCHSIZE { scalar(@{$_[0]}) }
- sub STORESIZE { $#{$_[0]} = $_[1]-1 }
-}
-
-tie @x,Basic;
-tie @get,Basic;
-tie @got,Basic;
-tie @tests,Basic;
-require "op/push.t"

diff --git a/t/lib/tie-refhash.t b/t/lib/tie-refhash.t
deleted file mode 100644 (file)
index d80b2e1..0000000
--- a/t/lib/tie-refhash.t
+++ /dev/null
@@ -1,305 +0,0 @@
-#!/usr/bin/perl -w
-# 
-# Basic test suite for Tie::RefHash and Tie::RefHash::Nestable.
-# 
-# The testing is in two parts: first, run lots of tests on both a tied
-# hash and an ordinary un-tied hash, and check they give the same
-# answer.  Then there are tests for those cases where the tied hashes
-# should behave differently to normal hashes, that is, when using
-# references as keys.
-# 
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-}    
-
-use strict;
-use Tie::RefHash;
-use Data::Dumper;
-my $numtests = 34;
-my $currtest = 1;
-print "1..$numtests\n";
-
-my $ref = []; my $ref1 = [];
-
-# Test standard hash functionality, by performing the same operations
-# on a tied hash and on a normal hash, and checking that the results
-# are the same.  This does of course assume that Perl hashes are not
-# buggy :-)
-# 
-my @tests = standard_hash_tests();
-
-my @ordinary_results = runtests(\@tests, undef);
-foreach my $class ('Tie::RefHash', 'Tie::RefHash::Nestable') {
-    my @tied_results = runtests(\@tests, $class);
-    my $all_ok = 1;
-
-    die if @ordinary_results != @tied_results;
-    foreach my $i (0 .. $#ordinary_results) {
-        my ($or, $ow, $oe) = @{$ordinary_results[$i]};
-        my ($tr, $tw, $te) = @{$tied_results[$i]};
-        
-        my $ok = 1;
-        local $^W = 0;
-        $ok = 0 if (defined($or) != defined($tr)) or ($or ne $tr);
-        $ok = 0 if (defined($ow) != defined($tw)) or ($ow ne $tw);
-        $ok = 0 if (defined($oe) != defined($te)) or ($oe ne $te);
-        
-        if (not $ok) {
-            print STDERR
-              "failed for $class: $tests[$i]\n",
-              "ordinary hash gave:\n",
-              defined $or ? "\tresult:    $or\n" : "\tundef result\n",
-              defined $ow ? "\twarning:   $ow\n" : "\tno warning\n",
-              defined $oe ? "\texception: $oe\n" : "\tno exception\n",
-              "tied $class hash gave:\n",
-              defined $tr ? "\tresult:    $tr\n" : "\tundef result\n",
-              defined $tw ? "\twarning:   $tw\n" : "\tno warning\n",
-              defined $te ? "\texception: $te\n" : "\tno exception\n",
-              "\n";
-            $all_ok = 0;
-        }
-    }
-    test($all_ok);
-}
-
-# Now test Tie::RefHash's special powers
-my (%h, $h);
-$h = eval { tie %h, 'Tie::RefHash' };
-warn $@ if $@;
-test(not $@);
-test(ref($h) eq 'Tie::RefHash');
-test(defined(tied(%h)) and tied(%h) =~ /^Tie::RefHash/);
-$h{$ref} = 'cholet';
-test($h{$ref} eq 'cholet');
-test(exists $h{$ref});
-test((keys %h) == 1);
-test(ref((keys %h)[0]) eq 'ARRAY');
-test((keys %h)[0] eq $ref);
-test((values %h) == 1);
-test((values %h)[0] eq 'cholet');
-my $count = 0;
-while (my ($k, $v) = each %h) {
-    if ($count++ == 0) {
-        test(ref($k) eq 'ARRAY');
-        test($k eq $ref);
-    }
-}
-test($count == 1);
-delete $h{$ref};
-test(not defined $h{$ref});
-test(not exists($h{$ref}));
-test((keys %h) == 0);
-test((values %h) == 0);
-undef $h;
-untie %h;
-
-# And now Tie::RefHash::Nestable's differences from Tie::RefHash.
-$h = eval { tie %h, 'Tie::RefHash::Nestable' };
-warn $@ if $@;
-test(not $@);
-test(ref($h) eq 'Tie::RefHash::Nestable');
-test(defined(tied(%h)) and tied(%h) =~ /^Tie::RefHash::Nestable/);
-$h{$ref}->{$ref1} = 'bungo';
-test($h{$ref}->{$ref1} eq 'bungo');
-
-# Test that the nested hash is also tied (for current implementation)
-test(defined(tied(%{$h{$ref}}))
-     and tied(%{$h{$ref}}) =~ /^Tie::RefHash::Nestable=/ );
-
-test((keys %h) == 1);
-test((keys %h)[0] eq $ref);
-test((keys %{$h{$ref}}) == 1);
-test((keys %{$h{$ref}})[0] eq $ref1);
-
-
-die "expected to run $numtests tests, but ran ", $currtest - 1
-  if $currtest - 1 != $numtests;
-
-@tests = ();
-undef $ref;
-undef $ref1;
-
-exit();
-
-
-# Print 'ok X' if true, 'not ok X' if false
-# Uses global $currtest.
-# 
-sub test {
-    my $t = shift;
-    print 'not ' if not $t;
-    print 'ok ', $currtest++, "\n";
-}
-
-
-# Wrapper for Data::Dumper to 'dump' a scalar as an EXPR string. 
-sub dumped {
-    my $s = shift;
-    my $d = Dumper($s);
-    $d =~ s/^\$VAR1 =\s*//;
-    $d =~ s/;$//;
-    chomp $d;
-    return $d;
-}
-
-# Crudely dump a hash into a canonical string representation (because
-# hash keys can appear in any order, Data::Dumper may give different
-# strings for the same hash).
-# 
-sub dumph {
-    my $h = shift;
-    my $r = '';
-    foreach (sort keys %$h) {
-        $r = dumped($_) . ' => ' . dumped($h->{$_}) . "\n";
-    }
-    return $r;
-}
-
-# Run the tests and give results.
-# 
-# Parameters: reference to list of tests to run
-#             name of class to use for tied hash, or undef if not tied
-# 
-# Returns: list of [R, W, E] tuples, one for each test.
-# R is the return value from running the test, W any warnings it gave,
-# and E any exception raised with 'die'.  E and W will be tidied up a
-# little to remove irrelevant details like line numbers :-)
-# 
-# Will also run a few of its own 'ok N' tests.
-# 
-sub runtests {
-    my ($tests, $class) = @_;
-    my @r;
-
-    my (%h, $h);
-    if (defined $class) {
-        $h = eval { tie %h, $class };
-        warn $@ if $@;
-        test(not $@);
-        test(ref($h) eq $class);
-        test(defined(tied(%h)) and tied(%h) =~ /^\Q$class\E/);
-    }
-
-    foreach (@$tests) {
-        my ($result, $warning, $exception);
-        local $SIG{__WARN__} = sub { $warning .= $_[0] };
-        $result = scalar(eval $_);
-        if ($@)
-         {
-          die "$@:$_" unless defined $class;
-          $exception = $@;
-         }
-
-        foreach ($warning, $exception) {
-            next if not defined;
-            s/ at .+ line \d+\.$//mg;
-            s/ at .+ line \d+, at .*//mg;
-            s/ at .+ line \d+, near .*//mg;
-        }
-
-        my (@warnings, %seen);
-        foreach (split /\n/, $warning) {
-            push @warnings, $_ unless $seen{$_}++;
-        }
-        $warning = join("\n", @warnings);
-
-        push @r, [ $result, $warning, $exception ];
-    }
-
-    return @r;
-}
-
-
-# Things that should work just the same for an ordinary hash and a
-# Tie::RefHash.
-# 
-# Each test is a code string to be eval'd, it should do something with
-# %h and give a scalar return value.  The global $ref and $ref1 may
-# also be used.
-# 
-# One thing we don't test is that the ordering from 'keys', 'values'
-# and 'each' is the same.  You can't reasonably expect that.
-# 
-sub standard_hash_tests {
-    my @r;
-
-    # Library of standard tests on keys, values and each
-    my $STD_TESTS = <<'END'
-    join $;, sort keys %h;
-    join $;, sort values %h;
-    { my ($v, %tmp); $tmp{$v}++ while (defined($v = each %h)); dumph(\%tmp) }
-    { my ($k, $v, %tmp); $tmp{"$k$;$v"}++ while (($k, $v) = each %h); dumph(\%tmp) }
-END
-  ;
-    
-    # Tests on the existence of the element 'foo'
-    my $FOO_TESTS = <<'END'
-    defined $h{foo};
-    exists $h{foo};
-    $h{foo};    
-END
-  ;
-
-    # Test storing and deleting 'foo'
-    push @r, split /\n/, <<"END"
-    $STD_TESTS;
-    $FOO_TESTS;
-    \$h{foo} = undef;
-    $STD_TESTS;
-    $FOO_TESTS;
-    \$h{foo} = 'hello';
-    $STD_TESTS;
-    $FOO_TESTS;
-    delete  \$h{foo};
-    $STD_TESTS;
-    $FOO_TESTS;
-END
-  ;
-
-    # Test storing and removing under ordinary keys
-    my @things = ('boink', 0, 1, '', undef);
-    foreach my $key (map { dumped($_) } @things) {
-        foreach my $value ((map { dumped($_) } @things), '$ref') {
-            push @r, split /\n/, <<"END"
-            \$h{$key} = $value;
-            $STD_TESTS;
-            defined \$h{$key};
-            exists \$h{$key};
-            \$h{$key};
-            delete \$h{$key};
-            $STD_TESTS;
-            defined \$h{$key};
-            exists \$h{$key};
-            \$h{$key};
-END
-  ;
-        }
-    }
-    
-    # Test hash slices
-    my @slicetests;
-    @slicetests = split /\n/, <<'END'
-    @h{'b'} = ();
-    @h{'c'} = ('d');
-    @h{'e'} = ('f', 'g');
-    @h{'h', 'i'} = ();
-    @h{'j', 'k'} = ('l');
-    @h{'m', 'n'} = ('o', 'p');
-    @h{'q', 'r'} = ('s', 't', 'u');
-END
-  ;
-    my @aaa = @slicetests;
-    foreach (@slicetests) {
-        push @r, $_;
-        push @r, split(/\n/, $STD_TESTS);
-    }
-
-    # Test CLEAR
-    push @r, '%h = ();', split(/\n/, $STD_TESTS);
-
-    return @r;
-}
-

diff --git a/t/lib/tie-splice.t b/t/lib/tie-splice.t
deleted file mode 100644 (file)
index d7ea6cc..0000000
--- a/t/lib/tie-splice.t
+++ /dev/null
@@ -1,17 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-}
-
-# bug id 20001020.002
-# -dlc 20001021
-
-use Tie::Array;
-tie @a,Tie::StdArray;
-undef *Tie::StdArray::SPLICE;
-require "op/splice.t"
-
-# Pre-fix, this failed tests 6-9

diff --git a/t/lib/tie-stdarray.t b/t/lib/tie-stdarray.t
deleted file mode 100755 (executable)
index c4ae071..0000000
--- a/t/lib/tie-stdarray.t
+++ /dev/null
@@ -1,13 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-}
-
-use Tie::Array;
-tie @foo,Tie::StdArray;
-tie @ary,Tie::StdArray;
-tie @bar,Tie::StdArray;
-require "op/array.t"

diff --git a/t/lib/tie-stdhandle.t b/t/lib/tie-stdhandle.t
deleted file mode 100755 (executable)
index f03f5d9..0000000
--- a/t/lib/tie-stdhandle.t
+++ /dev/null
@@ -1,47 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use Tie::Handle;
-tie *tst,Tie::StdHandle;
-
-$f = 'tst';
-
-print "1..13\n";
-
-# my $file tests
-
-unlink("afile.new") if -f "afile";
-print "$!\nnot " unless open($f,"+>afile") && open($f, "+<", "afile");
-print "ok 1\n";
-print "$!\nnot " unless binmode($f);
-print "ok 2\n";
-print "not " unless -f "afile";
-print "ok 3\n";
-print "not " unless print $f "SomeData\n";
-print "ok 4\n";
-print "not " unless tell($f) == 9;
-print "ok 5\n";
-print "not " unless printf $f "Some %d value\n",1234;
-print "ok 6\n";
-print "not " unless seek($f,0,0);
-print "ok 7\n";
-$b = <$f>;
-print "not " unless $b eq "SomeData\n";
-print "ok 8\n";
-print "not " if eof($f);
-print "ok 9\n";
-read($f,($b=''),4);
-print "'$b' not " unless $b eq 'Some';
-print "ok 10\n";
-print "not " unless getc($f) eq ' ';
-print "ok 11\n";
-$b = <$f>;
-print "not " unless eof($f);
-print "ok 12\n";
-print "not " unless close($f);
-print "ok 13\n";
-unlink("afile");

diff --git a/t/lib/tie-stdpush.t b/t/lib/tie-stdpush.t
deleted file mode 100755 (executable)
index 31af30c..0000000
--- a/t/lib/tie-stdpush.t
+++ /dev/null
@@ -1,11 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-}
-
-use Tie::Array;
-tie @x,Tie::StdArray;
-require "op/push.t"

diff --git a/t/lib/tie-substrhash.t b/t/lib/tie-substrhash.t
deleted file mode 100644 (file)
index 8256db7..0000000
--- a/t/lib/tie-substrhash.t
+++ /dev/null
@@ -1,111 +0,0 @@
-#!/usr/bin/perl -w
-# 
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '.'; 
-    push @INC, '../lib';
-}    
-
-print "1..20\n";
-
-use strict;
-
-require Tie::SubstrHash;
-
-my %a;
-
-tie %a, 'Tie::SubstrHash', 3, 3, 3;
-
-$a{abc} = 123;
-$a{bcd} = 234;
-
-print "not " unless $a{abc} == 123;
-print "ok 1\n";
-
-print "not " unless keys %a == 2;
-print "ok 2\n";
-
-delete $a{abc};
-
-print "not " unless $a{bcd} == 234;
-print "ok 3\n";
-
-print "not " unless (values %a)[0] == 234;
-print "ok 4\n";
-
-eval { $a{abcd} = 123 };
-print "not " unless $@ =~ /Key "abcd" is not 3 characters long/;
-print "ok 5\n";
-
-eval { $a{abc} = 1234 };
-print "not " unless $@ =~ /Value "1234" is not 3 characters long/;
-print "ok 6\n";
-
-eval { $a = $a{abcd}; $a++  };
-print "not " unless $@ =~ /Key "abcd" is not 3 characters long/;
-print "ok 7\n";
-
-@a{qw(abc cde)} = qw(123 345); 
-
-print "not " unless $a{cde} == 345;
-print "ok 8\n";
-
-eval { $a{def} = 456 };
-print "not " unless $@ =~ /Table is full \(3 elements\)/;
-print "ok 9\n";
-
-%a = ();
-
-print "not " unless keys %a == 0;
-print "ok 10\n";
-
-# Tests 11..16 by Linc Madison.
-
-my $hashsize = 119;                # arbitrary values from my data
-my %test;
-tie %test, "Tie::SubstrHash", 13, 86, $hashsize;
-
-for (my $i = 1; $i <= $hashsize; $i++) {
-        my $key1 = $i + 100_000;           # fix to uniform 6-digit numbers
-        my $key2 = "abcdefg$key1";
-        $test{$key2} = ("abcdefgh" x 10) . "$key1";
-}
-
-for (my $i = 1; $i <= $hashsize; $i++) {
-        my $key1 = $i + 100_000;
-        my $key2 = "abcdefg$key1";
-       unless ($test{$key2}) {
-               print "not ";
-               last;
-       }
-}
-print "ok 11\n";
-
-print "not " unless Tie::SubstrHash::findgteprime(1) == 2;
-print "ok 12\n";
-
-print "not " unless Tie::SubstrHash::findgteprime(2) == 2;
-print "ok 13\n";
-
-print "not " unless Tie::SubstrHash::findgteprime(5.5) == 7;
-print "ok 14\n";
-
-print "not " unless Tie::SubstrHash::findgteprime(13) == 13;
-print "ok 15\n";
-
-print "not " unless Tie::SubstrHash::findgteprime(13.000001) == 17;
-print "ok 16\n";
-
-print "not " unless Tie::SubstrHash::findgteprime(114) == 127;
-print "ok 17\n";
-
-print "not " unless Tie::SubstrHash::findgteprime(1000) == 1009;
-print "ok 18\n";
-
-print "not " unless Tie::SubstrHash::findgteprime(1024) == 1031;
-print "ok 19\n";
-
-print "not " unless Tie::SubstrHash::findgteprime(10000) == 10007;
-print "ok 20\n";
-

diff --git a/t/lib/time-gmtime.t b/t/lib/time-gmtime.t
deleted file mode 100644 (file)
index 853ec3b..0000000
--- a/t/lib/time-gmtime.t
+++ /dev/null
@@ -1,57 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN {
-    our $hasgm;
-    eval { my $n = gmtime 0 };
-    $hasgm = 1 unless $@ && $@ =~ /unimplemented/;
-    unless ($hasgm) { print "1..0 # Skip: no gmtime\n"; exit 0 }
-}
-
-BEGIN {
-    our @gmtime = gmtime 0; # This is the function gmtime.
-    unless (@gmtime) { print "1..0 # Skip: gmtime failed\n"; exit 0 }
-}
-
-print "1..10\n";
-
-use Time::gmtime;
-
-print "ok 1\n";
-
-my $gmtime = gmtime 0 ; # This is the OO gmtime.
-
-print "not " unless $gmtime->sec   == $gmtime[0];
-print "ok 2\n";
-
-print "not " unless $gmtime->min   == $gmtime[1];
-print "ok 3\n";
-
-print "not " unless $gmtime->hour  == $gmtime[2];
-print "ok 4\n";
-
-print "not " unless $gmtime->mday  == $gmtime[3];
-print "ok 5\n";
-
-print "not " unless $gmtime->mon   == $gmtime[4];
-print "ok 6\n";
-
-print "not " unless $gmtime->year  == $gmtime[5];
-print "ok 7\n";
-
-print "not " unless $gmtime->wday  == $gmtime[6];
-print "ok 8\n";
-
-print "not " unless $gmtime->yday  == $gmtime[7];
-print "ok 9\n";
-
-print "not " unless $gmtime->isdst == $gmtime[8];
-print "ok 10\n";
-
-
-
-

diff --git a/t/lib/time-hires.t b/t/lib/time-hires.t
deleted file mode 100644 (file)
index db35b95..0000000
--- a/t/lib/time-hires.t
+++ /dev/null
@@ -1,216 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN { $| = 1; print "1..19\n"; }
-
-END {print "not ok 1\n" unless $loaded;}
-
-use Time::HiRes qw(tv_interval);
-
-$loaded = 1;
-
-print "ok 1\n";
-
-use strict;
-
-my $have_gettimeofday  = defined &Time::HiRes::gettimeofday;
-my $have_usleep                = defined &Time::HiRes::usleep;
-my $have_ualarm                = defined &Time::HiRes::ualarm;
-
-import Time::HiRes 'gettimeofday'      if $have_gettimeofday;
-import Time::HiRes 'usleep'            if $have_usleep;
-import Time::HiRes 'ualarm'            if $have_ualarm;
-
-use Config;
-
-sub skip {
-    map { print "ok $_ (skipped)\n" } @_;
-}
-
-sub ok {
-    my ($n, $result, @info) = @_;
-    if ($result) {
-       print "ok $n\n";
-    }
-    else {
-       print "not ok $n\n";
-       print "# @info\n" if @info;
-    }
-}
-
-if (!$have_gettimeofday) {
-    skip 2..6;
-}
-else {
-    my @one = gettimeofday();
-    ok 2, @one == 2, 'gettimeofday returned ', 0+@one, ' args';
-    ok 3, $one[0] > 850_000_000, "@one too small";
-
-    sleep 1;
-
-    my @two = gettimeofday();
-    ok 4, ($two[0] > $one[0] || ($two[0] == $one[0] && $two[1] > $one[1])),
-           "@two is not greater than @one";
-
-    my $f = Time::HiRes::time;
-    ok 5, $f > 850_000_000, "$f too small";
-    ok 6, $f - $two[0] < 2, "$f - @two >= 2";
-}
-
-if (!$have_usleep) {
-    skip 7..8;
-}
-else {
-    my $one = time;
-    usleep(10_000);
-    my $two = time;
-    usleep(10_000);
-    my $three = time;
-    ok 7, $one == $two || $two == $three, "slept too long, $one $two $three";
-
-    if (!$have_gettimeofday) {
-       skip 8;
-    }
-    else {
-       my $f = Time::HiRes::time;
-       usleep(500_000);
-        my $f2 = Time::HiRes::time;
-       my $d = $f2 - $f;
-       ok 8, $d > 0.4 && $d < 0.8, "slept $d secs $f to $f2";
-    }
-}
-
-# Two-arg tv_interval() is always available.
-{
-    my $f = tv_interval [5, 100_000], [10, 500_000];
-    ok 9, $f == 5.4, $f;
-}
-
-if (!$have_gettimeofday) {
-    skip 10;
-}
-else {
-    my $r = [gettimeofday()];
-    my $f = tv_interval $r;
-    ok 10, $f < 2, $f;
-}
-
-if (!$have_usleep) {
-    skip 11;
-}
-else {
-    my $r = [gettimeofday()];
-    #jTime::HiRes::sleep 0.5;
-    Time::HiRes::sleep( 0.5 );
-    my $f = tv_interval $r;
-    ok 11, $f > 0.4 && $f < 0.8, "slept $f secs";
-}
-
-if (!$have_ualarm) {
-    skip 12..13;
-}
-else {
-    my $tick = 0;
-    local $SIG{ALRM} = sub { $tick++ };
-
-    my $one = time; $tick = 0; ualarm(10_000); sleep until $tick;
-    my $two = time; $tick = 0; ualarm(10_000); sleep until $tick;
-    my $three = time;
-    ok 12, $one == $two || $two == $three, "slept too long, $one $two $three";
-
-    $tick = 0;
-    ualarm(10_000, 10_000);
-    sleep until $tick >= 3;
-    ok 13, 1;
-    ualarm(0);
-}
-
-# new test: did we even get close?
-
-{
- my $t = time();
- my $tf = Time::HiRes::time();
- ok 14, (abs($tf - $t) <= 1),
-  "time $t differs from Time::HiRes::time $tf";
-}
-
-unless (defined &Time::HiRes::gettimeofday
-       && defined &Time::HiRes::ualarm
-       && defined &Time::HiRes::usleep) {
-    for (15..17) {
-       print "ok $_ # skipped\n";
-    }
-} else {
-    use Time::HiRes qw (time alarm sleep);
-
-    my ($f, $r, $i);
-
-    print "# time...";
-    $f = time; 
-    print "$f\nok 15\n";
-
-    print "# sleep...";
-    $r = [Time::HiRes::gettimeofday];
-    sleep (0.5);
-    print Time::HiRes::tv_interval($r), "\nok 16\n";
-
-    $r = [Time::HiRes::gettimeofday];
-    $i = 5;
-    $SIG{ALRM} = "tick";
-    while ($i)
-    {
-       alarm(0.3);
-       select (undef, undef, undef, 10);
-       print "# Select returned! $i ", Time::HiRes::tv_interval ($r), "\n";
-    }
-
-    sub tick
-    {
-       $i--;
-       print "# Tick! $i ", Time::HiRes::tv_interval ($r), "\n";
-    }
-    $SIG{ALRM} = 'DEFAULT';
-
-    print "ok 17\n";
-}
-
-unless (defined &Time::HiRes::setitimer
-       && defined &Time::HiRes::getitimer
-       && exists &Time::HiRes::ITIMER_VIRTUAL
-       && $Config{d_select}) {
-    for (18..19) {
-       print "ok $_ # Skip: no virtual interval timers\n";
-    }
-} else {
-    use Time::HiRes qw (setitimer getitimer ITIMER_VIRTUAL);
-
-    my $i = 3;
-    my $r = [Time::HiRes::gettimeofday];
-
-    $SIG{VTALRM} = sub {
-       $i ? $i-- : setitimer(ITIMER_VIRTUAL, 0);
-       print "# Tick! $i ", Time::HiRes::tv_interval($r), "\n";
-    }; 
-
-    print "# setitimer: ", join(" ", setitimer(ITIMER_VIRTUAL, 0.5, 0.4)), "\n";
-
-    # Assume interval timer granularity of 0.05 seconds.  Too bold?
-    print "not " unless abs(getitimer(ITIMER_VIRTUAL) / 0.5) - 1 < 0.1;
-    print "ok 18\n";
-
-    print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
-
-    while (getitimer(ITIMER_VIRTUAL)) {
-       my $j; $j++ for 1..1000; # Can't be unbreakable, must test getitimer().
-    }
-
-    print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
-
-    print "not " unless getitimer(ITIMER_VIRTUAL) == 0;
-    print "ok 19\n";
-
-    $SIG{VTALRM} = 'DEFAULT';
-}
-

diff --git a/t/lib/time-localtime.t b/t/lib/time-localtime.t
deleted file mode 100644 (file)
index 357615c..0000000
--- a/t/lib/time-localtime.t
+++ /dev/null
@@ -1,57 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN {
-    our $haslocal;
-    eval { my $n = localtime 0 };
-    $haslocal = 1 unless $@ && $@ =~ /unimplemented/;
-    unless ($haslocal) { print "1..0 # Skip: no localtime\n"; exit 0 }
-}
-
-BEGIN {
-    our @localtime = localtime 0; # This is the function localtime.
-    unless (@localtime) { print "1..0 # Skip: localtime failed\n"; exit 0 }
-}
-
-print "1..10\n";
-
-use Time::localtime;
-
-print "ok 1\n";
-
-my $localtime = localtime 0 ; # This is the OO localtime.
-
-print "not " unless $localtime->sec   == $localtime[0];
-print "ok 2\n";
-
-print "not " unless $localtime->min   == $localtime[1];
-print "ok 3\n";
-
-print "not " unless $localtime->hour  == $localtime[2];
-print "ok 4\n";
-
-print "not " unless $localtime->mday  == $localtime[3];
-print "ok 5\n";
-
-print "not " unless $localtime->mon   == $localtime[4];
-print "ok 6\n";
-
-print "not " unless $localtime->year  == $localtime[5];
-print "ok 7\n";
-
-print "not " unless $localtime->wday  == $localtime[6];
-print "ok 8\n";
-
-print "not " unless $localtime->yday  == $localtime[7];
-print "ok 9\n";
-
-print "not " unless $localtime->isdst == $localtime[8];
-print "ok 10\n";
-
-
-
-

diff --git a/t/lib/time-piece.t b/t/lib/time-piece.t
deleted file mode 100644 (file)
index c62e36d..0000000
--- a/t/lib/time-piece.t
+++ /dev/null
@@ -1,323 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN {
-    require Config; import Config;
-
-    if ($Config{extensions} !~ m!\bTime/Piece\b!) {
-       print "1..0 # Time::Piece not built\n";
-       exit 0;
-    }
-}
-
-print "1..86\n";
-
-use Time::Piece;
-
-print "ok 1\n";
-
-my $t = gmtime(951827696); # 2001-02-29T12:34:56
-
-print "not " unless $t->sec == 56;
-print "ok 2\n";
-
-print "not " unless $t->second == 56;
-print "ok 3\n";
-
-print "not " unless $t->min == 34;
-print "ok 4\n";
-
-print "not " unless $t->minute == 34;
-print "ok 5\n";
-
-print "not " unless $t->hour == 12;
-print "ok 6\n";
-
-print "not " unless $t->mday == 29;
-print "ok 7\n";
-
-print "not " unless $t->day_of_month == 29;
-print "ok 8\n";
-
-print "not " unless $t->mon == 2;
-print "ok 9\n";
-
-print "not " unless $t->_mon == 1;
-print "ok 10\n";
-
-print "not " unless $t->monname eq 'Feb';
-print "ok 11\n";
-
-print "not " unless $t->month eq 'February';
-print "ok 12\n";
-
-print "not " unless $t->year == 2000;
-print "ok 13\n";
-
-print "not " unless $t->_year == 100;
-print "ok 14\n";
-
-print "not " unless $t->wday == 3;
-print "ok 15\n";
-
-print "not " unless $t->_wday == 2;
-print "ok 16\n";
-
-print "not " unless $t->day_of_week == 2;
-print "ok 17\n";
-
-print "not " unless $t->wdayname eq 'Tue';
-print "ok 18\n";
-
-print "not " unless $t->weekday eq 'Tuesday';
-print "ok 19\n";
-
-print "not " unless $t->yday == 59;
-print "ok 20\n";
-
-print "not " unless $t->day_of_year == 59;
-print "ok 21\n";
-
-# In GMT there should be no daylight savings ever.
-
-print "not " unless $t->isdst == 0;
-print "ok 22\n";
-
-print "not " unless $t->daylight_savings == 0;
-print "ok 23\n";
-
-print "not " unless $t->hms eq '12:34:56';
-print "ok 24\n";
-
-print "not " unless $t->time eq '12:34:56';
-print "ok 25\n";
-
-print "not " unless $t->ymd eq '2000-02-29';
-print "ok 26\n";
-
-print "not " unless $t->date eq '2000-02-29';
-print "ok 27\n";
-
-print "not " unless $t->mdy eq '02-29-2000';
-print "ok 28\n";
-
-print "not " unless $t->dmy eq '29-02-2000';
-print "ok 29\n";
-
-print "not " unless $t->cdate eq 'Tue Feb 29 12:34:56 2000';
-print "ok 30\n";
-
-print "not " unless "$t" eq 'Tue Feb 29 12:34:56 2000';
-print "ok 31\n";
-
-print "not " unless $t->datetime eq '2000-02-29T12:34:56';
-print "ok 32\n";
-
-print "not " unless $t->epoch == 951827696;
-print "ok 33\n";
-
-# ->tzoffset?
-
-print "not " unless ($t->julian_day / 2451604.0075) - 1 < 0.001;
-print "ok 34\n";
-
-print "not " unless ($t->mjd        /   51603.5075) - 1 < 0.001;
-print "ok 35\n";
-
-print "not " unless $t->week == 9;
-print "ok 36\n";
-
-if ($Config{d_strftime}) {
-
-    print "not " unless $t->strftime('%a') eq 'Tue';
-    print "ok 37\n";
-
-    print "not " unless $t->strftime('%A') eq 'Tuesday';
-    print "ok 38\n";
-
-    print "not " unless $t->strftime('%b') eq 'Feb';
-    print "ok 39\n";
-
-    print "not " unless $t->strftime('%B') eq 'February';
-    print "ok 40\n";
-
-    print "not " unless $t->strftime('%c') eq 'Tue Feb 29 12:34:56 2000';
-    print "ok 41\n";
-
-    print "not " unless $t->strftime('%C') == 20;
-    print "ok 42\n";
-
-    print "not " unless $t->strftime('%d') == 29;
-    print "ok 43\n";
-
-    print "not " unless $t->strftime('%D') eq '02/29/00'; # Yech!
-    print "ok 44\n";
-
-    print "not " unless $t->strftime('%e') eq '29'; # should test with < 10
-    print "ok 45\n";
-
-    print "not " unless $t->strftime('%H') eq '12'; # should test with < 10
-    print "ok 46\n";
-
-    print "not " unless $t->strftime('%b') eq 'Feb';
-    print "ok 47\n";
-
-    print "not " unless $t->strftime('%I') eq '12'; # should test with < 10
-    print "ok 48\n";
-
-    print "not " unless $t->strftime('%j') eq '059';
-    print "ok 49\n";
-
-    print "not " unless $t->strftime('%M') eq '34'; # should test with < 10
-    print "ok 50\n";
-
-    print "not " unless $t->strftime('%p') eq 'am';
-    print "ok 51\n";
-
-    print "not " unless $t->strftime('%r') eq '12:34:56 am';
-    print "ok 52\n";
-
-    print "not " unless $t->strftime('%R') eq '12:34'; # should test with > 12
-    print "ok 53\n";
-
-    print "not " unless $t->strftime('%S') eq '56'; # should test with < 10
-    print "ok 54\n";
-
-    print "not " unless $t->strftime('%T') eq '12:34:56'; # < 12 and > 12
-    print "ok 55\n";
-
-    print "not " unless $t->strftime('%u') == 2;
-    print "ok 56\n";
-
-    print "not " unless $t->strftime('%U') eq '09'; # Sun cmp Mon
-    print "ok 57\n";
-
-    print "not " unless $t->strftime('%V') eq '09'; # Sun cmp Mon
-    print "ok 58\n";
-
-    print "not " unless $t->strftime('%w') == 2;
-    print "ok 59\n";
-
-    print "not " unless $t->strftime('%W') eq '09'; # Sun cmp Mon
-    print "ok 60\n";
-
-    print "not " unless $t->strftime('%x') eq '02/29/00'; # Yech!
-    print "ok 61\n";
-
-    print "not " unless $t->strftime('%y') == 0; # should test with 1999
-    print "ok 62\n";
-
-    print "not " unless $t->strftime('%Y') eq '2000';
-    print "ok 63\n";
-
-    # %Z can't be tested, too unportable
-
-} else {
-    for (38...63) {
-       print "ok $_ # Skip: no strftime\n";
-    }
-}
-
-print "not " unless $t->ymd("") eq '20000229';
-print "ok 64\n";
-
-print "not " unless $t->mdy("/") eq '02/29/2000';
-print "ok 65\n";
-
-print "not " unless $t->dmy(".") eq '29.02.2000';
-print "ok 66\n";
-
-print "not " unless $t->date_separator() eq '-';
-print "ok 67\n";
-
-$t->date_separator("/");
-
-print "not " unless $t->ymd eq '2000/02/29';
-print "ok 68\n";
-
-print "not " unless $t->date_separator() eq '/';
-print "ok 69\n";
-
-$t->date_separator("-");
-
-print "not " unless $t->hms(".") eq '12.34.56';
-print "ok 70\n";
-
-print "not " unless $t->time_separator() eq ':';
-print "ok 71\n";
-
-$t->time_separator(".");
-
-print "not " unless $t->hms eq '12.34.56';
-print "ok 72\n";
-
-print "not " unless $t->time_separator() eq '.';
-print "ok 73\n";
-
-$t->time_separator(":");
-
-my @fidays = qw( sunnuntai maanantai tiistai keskiviikko torstai
-                perjantai lauantai );
-my @frdays = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi );
-
-print "not " unless $t->weekday(@fidays) eq "tiistai";
-print "ok 74\n";
-
-my @days = $t->weekday_names();
-
-Time::Piece::weekday_names(@frdays);
-
-print "not " unless $t->weekday eq "Merdi";
-print "ok 75\n";
-
-Time::Piece::weekday_names(@days);
-
-print "not " unless $t->weekday eq "Tuesday";
-print "ok 76\n";
-
-my @months = $t->mon_names();
-
-my @dumonths = qw(januari februari maart april mei juni
-                 juli augustus september oktober november december);
-
-print "not " unless $t->month(@dumonths) eq "februari";
-print "ok 77\n";
-
-Time::Piece::month_names(@dumonths);
-
-print "not " unless $t->month eq "februari";
-print "ok 78\n";
-
-Time::Piece::mon_names(@months);
-
-print "not " unless $t->monname eq "Feb";
-print "ok 79\n";
-
-print "not " unless
-    $t->datetime(date => '/', T => ' ', time => '-') eq "2000/02/29 12-34-56";
-print "ok 80\n";
-
-print "not " unless $t->is_leap_year;
-print "ok 81\n";
-
-print "not " unless $t->month_last_day == 29; # test more
-print "ok 82\n";
-
-print "not " if Time::Piece::_is_leap_year(1900);
-print "ok 83\n";
-
-print "not " if Time::Piece::_is_leap_year(1901);
-print "ok 84\n";
-
-print "not " unless Time::Piece::_is_leap_year(1904);
-print "ok 85\n";
-
-use Time::Piece 'strptime';
-
-my %T = strptime("%T", "12:34:56");
-
-print "not " unless keys %T == 3 && $T{H} == 12 && $T{M} == 34 && $T{S} == 56;
-print "ok 86\n";
-

diff --git a/t/lib/timelocal.t b/t/lib/timelocal.t
deleted file mode 100755 (executable)
index 100e076..0000000
--- a/t/lib/timelocal.t
+++ /dev/null
@@ -1,90 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use Time::Local;
-
-# Set up time values to test
-@time =
-  (
-   #year,mon,day,hour,min,sec 
-   [1970,  1,  2, 00, 00, 00],
-   [1980,  2, 28, 12, 00, 00],
-   [1980,  2, 29, 12, 00, 00],
-   [1999, 12, 31, 23, 59, 59],
-   [2000,  1,  1, 00, 00, 00],
-   [2010, 10, 12, 14, 13, 12],
-  );
-
-# use vmsish 'time' makes for oddness around the Unix epoch
-if ($^O eq 'VMS') { $time[0][2]++ }
-
-print "1..", @time * 2 + 5, "\n";
-
-$count = 1;
-for (@time) {
-    my($year, $mon, $mday, $hour, $min, $sec) = @$_;
-    $year -= 1900;
-    $mon --;
-    my $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
-    # print scalar(localtime($time)), "\n";
-    my($s,$m,$h,$D,$M,$Y) = localtime($time);
-
-    if ($s == $sec &&
-       $m == $min &&
-       $h == $hour &&
-       $D == $mday &&
-       $M == $mon &&
-       $Y == $year
-       ) {
-       print "ok $count\n";
-    } else {
-       print "not ok $count\n";
-    }
-    $count++;
-
-    # Test gmtime function
-    $time = timegm($sec,$min,$hour,$mday,$mon,$year);
-    ($s,$m,$h,$D,$M,$Y) = gmtime($time);
-
-    if ($s == $sec &&
-       $m == $min &&
-       $h == $hour &&
-       $D == $mday &&
-       $M == $mon &&
-       $Y == $year
-       ) {
-       print "ok $count\n";
-    } else {
-       print "not ok $count\n";
-    }
-    $count++;
-}
-
-#print "Testing that the differences between a few dates makes sence...\n";
-
-timelocal(0,0,1,1,0,90) - timelocal(0,0,0,1,0,90) == 3600
-  or print "not ";
-print "ok ", $count++, "\n";
-
-timelocal(1,2,3,1,0,100) - timelocal(1,2,3,31,11,99) == 24 * 3600 
-  or print "not ";
-print "ok ", $count++, "\n";
-
-# Diff beween Jan 1, 1970 and Mar 1, 1970 = (31 + 28 = 59 days)
-timegm(0,0,0, 1, 2, 70) - timegm(0,0,0, 1, 0, 70) == 59 * 24 * 3600
-  or print "not ";
-print "ok ", $count++, "\n";
-
-
-#print "Testing timelocal.pl module too...\n";
-package test;
-require 'timelocal.pl';
-timegm(0,0,0,1,0,70) == main::timegm(0,0,0,1,0,70) or print "not ";
-print "ok ", $main::count++, "\n";
-
-timelocal(1,2,3,4,5,78) == main::timelocal(1,2,3,4,5,78) or print "not ";
-print "ok ", $main::count++, "\n";

diff --git a/t/lib/trig.t b/t/lib/trig.t
deleted file mode 100755 (executable)
index 4246a47..0000000
--- a/t/lib/trig.t
+++ /dev/null
@@ -1,200 +0,0 @@
-#!./perl 
-
-#
-# Regression tests for the Math::Trig package
-#
-# The tests are quite modest as the Math::Complex tests exercise
-# these quite vigorously.
-# 
-# -- Jarkko Hietaniemi, April 1997
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use Math::Trig;
-
-use strict;
-
-use vars qw($x $y $z);
-
-my $eps = 1e-11;
-
-if ($^O eq 'unicos') { # See lib/Math/Complex.pm and t/lib/complex.t.
-    $eps = 1e-10;
-}
-
-sub near ($$;$) {
-    my $e = defined $_[2] ? $_[2] : $eps;
-    $_[1] ? (abs($_[0]/$_[1] - 1) < $e) : abs($_[0]) < $e;
-}
-
-print "1..26\n";
-
-$x = 0.9;
-print 'not ' unless (near(tan($x), sin($x) / cos($x)));
-print "ok 1\n";
-
-print 'not ' unless (near(sinh(2), 3.62686040784702));
-print "ok 2\n";
-
-print 'not ' unless (near(acsch(0.1), 2.99822295029797));
-print "ok 3\n";
-
-$x = asin(2);
-print 'not ' unless (ref $x eq 'Math::Complex');
-print "ok 4\n";
-
-# avoid using Math::Complex here
-$x =~ /^([^-]+)(-[^i]+)i$/;
-($y, $z) = ($1, $2);
-print 'not ' unless (near($y,  1.5707963267949) and
-                    near($z, -1.31695789692482));
-print "ok 5\n";
-
-print 'not ' unless (near(deg2rad(90), pi/2));
-print "ok 6\n";
-
-print 'not ' unless (near(rad2deg(pi), 180));
-print "ok 7\n";
-
-use Math::Trig ':radial';
-
-{
-    my ($r,$t,$z) = cartesian_to_cylindrical(1,1,1);
-
-    print 'not ' unless (near($r, sqrt(2)))     and
-                       (near($t, deg2rad(45))) and
-                       (near($z, 1));
-    print "ok 8\n";
-
-    ($x,$y,$z) = cylindrical_to_cartesian($r, $t, $z);
-
-    print 'not ' unless (near($x, 1)) and
-                       (near($y, 1)) and
-                       (near($z, 1));
-    print "ok 9\n";
-
-    ($r,$t,$z) = cartesian_to_cylindrical(1,1,0);
-
-    print 'not ' unless (near($r, sqrt(2)))     and
-                       (near($t, deg2rad(45))) and
-                       (near($z, 0));
-    print "ok 10\n";
-
-    ($x,$y,$z) = cylindrical_to_cartesian($r, $t, $z);
-
-    print 'not ' unless (near($x, 1)) and
-                       (near($y, 1)) and
-                       (near($z, 0));
-    print "ok 11\n";
-}
-
-{
-    my ($r,$t,$f) = cartesian_to_spherical(1,1,1);
-
-    print 'not ' unless (near($r, sqrt(3)))     and
-                       (near($t, deg2rad(45))) and
-                       (near($f, atan2(sqrt(2), 1)));
-    print "ok 12\n";
-
-    ($x,$y,$z) = spherical_to_cartesian($r, $t, $f);
-
-    print 'not ' unless (near($x, 1)) and
-                       (near($y, 1)) and
-                       (near($z, 1));
-    print "ok 13\n";
-
-    ($r,$t,$f) = cartesian_to_spherical(1,1,0);
-
-    print 'not ' unless (near($r, sqrt(2)))     and
-                       (near($t, deg2rad(45))) and
-                       (near($f, deg2rad(90)));
-    print "ok 14\n";
-
-    ($x,$y,$z) = spherical_to_cartesian($r, $t, $f);
-
-    print 'not ' unless (near($x, 1)) and
-                       (near($y, 1)) and
-                       (near($z, 0));
-    print "ok 15\n";
-}
-
-{
-    my ($r,$t,$z) = cylindrical_to_spherical(spherical_to_cylindrical(1,1,1));
-
-    print 'not ' unless (near($r, 1)) and
-                       (near($t, 1)) and
-                       (near($z, 1));
-    print "ok 16\n";
-
-    ($r,$t,$z) = spherical_to_cylindrical(cylindrical_to_spherical(1,1,1));
-
-    print 'not ' unless (near($r, 1)) and
-                       (near($t, 1)) and
-                       (near($z, 1));
-    print "ok 17\n";
-}
-
-{
-    use Math::Trig 'great_circle_distance';
-
-    print 'not '
-       unless (near(great_circle_distance(0, 0, 0, pi/2), pi/2));
-    print "ok 18\n";
-
-    print 'not '
-       unless (near(great_circle_distance(0, 0, pi, pi), pi));
-    print "ok 19\n";
-
-    # London to Tokyo.
-    my @L = (deg2rad(-0.5), deg2rad(90 - 51.3));
-    my @T = (deg2rad(139.8),deg2rad(90 - 35.7));
-
-    my $km = great_circle_distance(@L, @T, 6378);
-
-    print 'not ' unless (near($km, 9605.26637021388));
-    print "ok 20\n";
-}
-
-{
-    my $R2D = 57.295779513082320876798154814169;
-
-    sub frac { $_[0] - int($_[0]) }
-
-    my $lotta_radians = deg2rad(1E+20, 1);
-    print "not " unless near($lotta_radians,  1E+20/$R2D);
-    print "ok 21\n";
-
-    my $negat_degrees = rad2deg(-1E20, 1);
-    print "not " unless near($negat_degrees, -1E+20*$R2D);
-    print "ok 22\n";
-
-    my $posit_degrees = rad2deg(-10000, 1);
-    print "not " unless near($posit_degrees, -10000*$R2D);
-    print "ok 23\n";
-}
-
-{
-    use Math::Trig 'great_circle_direction';
-
-    print 'not '
-       unless (near(great_circle_direction(0, 0, 0, pi/2), pi));
-    print "ok 24\n";
-
-    print 'not '
-       unless (near(great_circle_direction(0, 0, pi, pi), -pi()/2));
-    print "ok 25\n";
-
-    # London to Tokyo.
-    my @L = (deg2rad(-0.5), deg2rad(90 - 51.3));
-    my @T = (deg2rad(139.8),deg2rad(90 - 35.7));
-
-    my $rad = great_circle_direction(@L, @T);
-
-    print 'not ' unless (near($rad, -0.546644569997376));
-    print "ok 26\n";
-}
-
-# eof

diff --git a/t/lib/u-blessed.t b/t/lib/u-blessed.t
deleted file mode 100755 (executable)
index 89a740a..0000000
--- a/t/lib/u-blessed.t
+++ /dev/null
@@ -1,39 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-use Scalar::Util qw(blessed);
-use vars qw($t $y $x);
-
-print "1..7\n";
-
-print "not " if blessed(1);
-print "ok 1\n";
-
-print "not " if blessed('A');
-print "ok 2\n";
-
-print "not " if blessed({});
-print "ok 3\n";
-
-print "not " if blessed([]);
-print "ok 4\n";
-
-$y = \$t;
-
-print "not " if blessed($y);
-print "ok 5\n";
-
-$x = bless [], "ABC";
-
-print "not " unless blessed($x);
-print "ok 6\n";
-
-print "not " unless blessed($x) eq 'ABC';
-print "ok 7\n";

diff --git a/t/lib/u-dualvar.t b/t/lib/u-dualvar.t
deleted file mode 100755 (executable)
index 5bf4fe9..0000000
--- a/t/lib/u-dualvar.t
+++ /dev/null
@@ -1,46 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-BEGIN {
-  require Scalar::Util;
-
-  if (grep { /dualvar/ } @Scalar::Util::EXPORT_FAIL) {
-    print "1..0\n";
-    exit;
-  }
-}
-
-use Scalar::Util qw(dualvar);
-
-print "1..6\n";
-
-$var = dualvar 2.2,"string";
-
-print "not " unless $var == 2.2;
-print "ok 1\n";
-
-print "not " unless $var eq "string";
-print "ok 2\n";
-
-$var2 = $var;
-
-$var++;
-
-print "not " unless $var == 3.2;
-print "ok 3\n";
-
-print "not " unless $var ne "string";
-print "ok 4\n";
-
-print "not " unless $var2 == 2.2;
-print "ok 5\n";
-
-print "not " unless $var2 eq "string";
-print "ok 6\n";

diff --git a/t/lib/u-first.t b/t/lib/u-first.t
deleted file mode 100755 (executable)
index 6a35948..0000000
--- a/t/lib/u-first.t
+++ /dev/null
@@ -1,25 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-use List::Util qw(first);
-
-print "1..4\n";
-
-print "not " unless defined &first;
-print "ok 1\n";
-
-print "not " unless 9 == first { 8 == ($_ - 1) } 9,4,5,6;
-print "ok 2\n";
-
-print "not " if defined(first { 0 } 1,2,3,4);
-print "ok 3\n";
-
-print "not " if defined(first { 0 });
-print "ok 4\n";

diff --git a/t/lib/u-max.t b/t/lib/u-max.t
deleted file mode 100755 (executable)
index 911003b..0000000
--- a/t/lib/u-max.t
+++ /dev/null
@@ -1,30 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-use List::Util qw(max);
-
-print "1..5\n";
-
-print "not " unless defined &max;
-print "ok 1\n";
-
-print "not " unless max(1) == 1;
-print "ok 2\n";
-
-print "not " unless max(1,2) == 2;
-print "ok 3\n";
-
-print "not " unless max(2,1) == 2;
-print "ok 4\n";
-
-my @a = map { rand() } 1 .. 20;
-my @b = sort { $a <=> $b } @a;
-print "not " unless max(@a) == $b[-1];
-print "ok 5\n";

diff --git a/t/lib/u-maxstr.t b/t/lib/u-maxstr.t
deleted file mode 100755 (executable)
index 0ec35ca..0000000
--- a/t/lib/u-maxstr.t
+++ /dev/null
@@ -1,30 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-use List::Util qw(maxstr);
-
-print "1..5\n";
-
-print "not " unless defined &maxstr;
-print "ok 1\n";
-
-print "not " unless maxstr('a') eq 'a';
-print "ok 2\n";
-
-print "not " unless maxstr('a','b') eq 'b';
-print "ok 3\n";
-
-print "not " unless maxstr('B','A') eq 'B';
-print "ok 4\n";
-
-my @a = map { pack("u", pack("C*",map { int(rand(256))} (0..int(rand(10) + 2)))) } 0 .. 20;
-my @b = sort { $a cmp $b } @a;
-print "not " unless maxstr(@a) eq $b[-1];
-print "ok 5\n";

diff --git a/t/lib/u-min.t b/t/lib/u-min.t
deleted file mode 100755 (executable)
index a51ced4..0000000
--- a/t/lib/u-min.t
+++ /dev/null
@@ -1,30 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-use List::Util qw(min);
-
-print "1..5\n";
-
-print "not " unless defined &min;
-print "ok 1\n";
-
-print "not " unless min(9) == 9;
-print "ok 2\n";
-
-print "not " unless min(1,2) == 1;
-print "ok 3\n";
-
-print "not " unless min(2,1) == 1;
-print "ok 4\n";
-
-my @a = map { rand() } 1 .. 20;
-my @b = sort { $a <=> $b } @a;
-print "not " unless min(@a) == $b[0];
-print "ok 5\n";

diff --git a/t/lib/u-minstr.t b/t/lib/u-minstr.t
deleted file mode 100755 (executable)
index c000e78..0000000
--- a/t/lib/u-minstr.t
+++ /dev/null
@@ -1,30 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-use List::Util qw(minstr);
-
-print "1..5\n";
-
-print "not " unless defined &minstr;
-print "ok 1\n";
-
-print "not " unless minstr('a') eq 'a';
-print "ok 2\n";
-
-print "not " unless minstr('a','b') eq 'a';
-print "ok 3\n";
-
-print "not " unless minstr('B','A') eq 'A';
-print "ok 4\n";
-
-my @a = map { pack("u", pack("C*",map { int(rand(256))} (0..int(rand(10) + 2)))) } 0 .. 20;
-my @b = sort { $a cmp $b } @a;
-print "not " unless minstr(@a) eq $b[0];
-print "ok 5\n";

diff --git a/t/lib/u-readonly.t b/t/lib/u-readonly.t
deleted file mode 100644 (file)
index 864e1f1..0000000
--- a/t/lib/u-readonly.t
+++ /dev/null
@@ -1,46 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-use Scalar::Util qw(readonly);
-
-print "1..9\n";
-
-print "not " unless readonly(1);
-print "ok 1\n";
-
-my $var = 2;
-
-print "not " if readonly($var);
-print "ok 2\n";
-
-print "not " unless $var == 2;
-print "ok 3\n";
-
-print "not " unless readonly("fred");
-print "ok 4\n";
-
-$var = "fred";
-
-print "not " if readonly($var);
-print "ok 5\n";
-
-print "not " unless $var eq "fred";
-print "ok 6\n";
-
-$var = \2;
-
-print "not " if readonly($var);
-print "ok 7\n";
-
-print "not " unless readonly($$var);
-print "ok 8\n";
-
-print "not " if readonly(*STDOUT);
-print "ok 9\n";

diff --git a/t/lib/u-reduce.t b/t/lib/u-reduce.t
deleted file mode 100755 (executable)
index 063e0b7..0000000
--- a/t/lib/u-reduce.t
+++ /dev/null
@@ -1,30 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-use List::Util qw(reduce min);
-
-print "1..5\n";
-
-print "not " if defined reduce {};
-print "ok 1\n";
-
-print "not " unless 9 == reduce { $a / $b } 756,3,7,4;
-print "ok 2\n";
-
-print "not " unless 9 == reduce { $a / $b } 9;
-print "ok 3\n";
-
-@a = map { rand } 0 .. 20;
-print "not " unless min(@a) == reduce { $a < $b ? $a : $b } @a;
-print "ok 4\n";
-
-@a = map { pack("C", int(rand(256))) } 0 .. 20;
-print "not " unless join("",@a) eq reduce { $a . $b } @a;
-print "ok 5\n";

diff --git a/t/lib/u-reftype.t b/t/lib/u-reftype.t
deleted file mode 100755 (executable)
index ea7ea7b..0000000
--- a/t/lib/u-reftype.t
+++ /dev/null
@@ -1,55 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-use Scalar::Util qw(reftype);
-use vars qw($t $y $x *F);
-use Symbol qw(gensym);
-
-# Ensure we do not trigger and tied methods
-tie *F, 'MyTie';
-
-@test = (
- [ undef, 1],
- [ undef, 'A'],
- [ HASH => {} ],
- [ ARRAY => [] ],
- [ SCALAR => \$t ],
- [ REF    => \(\$t) ],
- [ GLOB   => \*F ],
- [ GLOB   => gensym ],
- [ CODE   => sub {} ],
-# [ IO => *STDIN{IO} ] the internal sv_reftype returns UNKNOWN
-);
-
-print "1..", @test*4, "\n";
-
-my $i = 1;
-foreach $test (@test) {
-  my($type,$what) = @$test;
-  my $pack;
-  foreach $pack (undef,"ABC","0",undef) {
-    print "# $what\n";
-    my $res = reftype($what);
-    printf "# %s - %s\n", map { defined($_) ? $_ : 'undef' } $type,$res;
-    print "not " if $type ? $res ne $type : defined($res);
-    bless $what, $pack if $type && defined $pack;
-    print "ok ",$i++,"\n";
-  }
-}
-
-package MyTie;
-
-sub TIEHANDLE { bless {} }
-sub DESTROY {}
-
-sub AUTOLOAD {
-  warn "$AUTOLOAD called";
-  exit 1; # May be in an eval
-}

diff --git a/t/lib/u-sum.t b/t/lib/u-sum.t
deleted file mode 100755 (executable)
index 34fb690..0000000
--- a/t/lib/u-sum.t
+++ /dev/null
@@ -1,23 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-use List::Util qw(sum);
-
-print "1..3\n";
-
-print "not " if defined sum;
-print "ok 1\n";
-
-print "not " unless sum(9) == 9;
-print "ok 2\n";
-
-print "not " unless sum(1,2,3,4) == 10;
-print "ok 3\n";
-

diff --git a/t/lib/u-tainted.t b/t/lib/u-tainted.t
deleted file mode 100644 (file)
index 5587bb7..0000000
--- a/t/lib/u-tainted.t
+++ /dev/null
@@ -1,38 +0,0 @@
-#!./perl -T
-
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-use lib qw(blib/lib blib/arch);
-use Scalar::Util qw(tainted);
-use Config;
-
-print "1..5\n";
-
-print "not " if tainted(1);
-print "ok 1\n";
-
-my $var = 2;
-
-print "not " if tainted($var);
-print "ok 2\n";
-
-my $key = (keys %ENV)[0];
-
-$var = $ENV{$key};
-
-print "not " unless tainted($var);
-print "ok 3\n";
-
-print "not " unless tainted($ENV{$key});
-print "ok 4\n";
-
-print "not " if @ARGV and not tainted($ARGV[0]);
-print "ok 5\n";

diff --git a/t/lib/u-weak.t b/t/lib/u-weak.t
deleted file mode 100755 (executable)
index 6c7bea7..0000000
--- a/t/lib/u-weak.t
+++ /dev/null
@@ -1,206 +0,0 @@
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-}
-
-BEGIN {
-  $|=1;
-  require Scalar::Util;
-  if (grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) {
-    print("1..0\n");
-    exit;
-  }
-
-  $DEBUG = 0;
-
-  if ($DEBUG && eval { require Devel::Peek } ) {
-    Devel::Peek->import('Dump');
-  }
-  else {
-    *Dump = sub {};
-  }
-}
-
-use Scalar::Util qw(weaken isweak);
-print "1..17\n";
-
-######################### End of black magic.
-
-$cnt = 0;
-
-sub ok {
-       ++$cnt;
-       if($_[0]) { print "ok $cnt\n"; } else {print "not ok $cnt\n"; }
-}
-
-$| = 1;
-
-if(1) {
-
-my ($y,$z);
-
-#
-# Case 1: two references, one is weakened, the other is then undef'ed.
-#
-
-{
-       my $x = "foo";
-       $y = \$x;
-       $z = \$x;
-}
-print "# START:\n";
-Dump($y); Dump($z);
-
-ok( $y ne "" and $z ne "" );
-weaken($y);
-
-print "# WEAK:\n";
-Dump($y); Dump($z);
-
-ok( $y ne "" and $z ne "" );
-undef($z);
-
-print "# UNDZ:\n";
-Dump($y); Dump($z);
-
-ok( not (defined($y) and defined($z)) );
-undef($y);
-
-print "# UNDY:\n";
-Dump($y); Dump($z);
-
-ok( not (defined($y) and defined($z)) );
-
-print "# FIN:\n";
-Dump($y); Dump($z);
-
-# exit(0);
-
-# }
-# {
-
-# 
-# Case 2: one reference, which is weakened
-#
-
-# kill 5,$$;
-
-print "# CASE 2:\n";
-
-{
-       my $x = "foo";
-       $y = \$x;
-}
-
-ok( $y ne "" );
-print "# BW: \n";
-Dump($y);
-weaken($y);
-print "# AW: \n";
-Dump($y);
-ok( not defined $y  );
-
-print "# EXITBLOCK\n";
-}
-
-# exit(0);
-
-# 
-# Case 3: a circular structure
-#
-
-# kill 5, $$;
-
-$flag = 0;
-{
-       my $y = bless {}, Dest;
-       Dump($y);
-       print "# 1: $y\n";
-       $y->{Self} = $y;
-       Dump($y);
-       print "# 2: $y\n";
-       $y->{Flag} = \$flag;
-       print "# 3: $y\n";
-       weaken($y->{Self});
-       print "# WKED\n";
-       ok( $y ne "" );
-       print "# VALS: HASH ",$y,"   SELF ",\$y->{Self},"  Y ",\$y, 
-               "    FLAG: ",\$y->{Flag},"\n";
-       print "# VPRINT\n";
-}
-print "# OUT $flag\n";
-ok( $flag == 1 );
-
-print "# AFTER\n";
-
-undef $flag;
-
-print "# FLAGU\n";
-
-#
-# Case 4: a more complicated circular structure
-#
-
-$flag = 0;
-{
-       my $y = bless {}, Dest;
-       my $x = bless {}, Dest;
-       $x->{Ref} = $y;
-       $y->{Ref} = $x;
-       $x->{Flag} = \$flag;
-       $y->{Flag} = \$flag;
-       weaken($x->{Ref});
-}
-ok( $flag == 2 );
-
-#
-# Case 5: deleting a weakref before the other one
-#
-
-{
-       my $x = "foo";
-       $y = \$x;
-       $z = \$x;
-}
-
-print "# CASE5\n";
-Dump($y);
-
-weaken($y);
-Dump($y);
-undef($y);
-
-ok( not defined $y);
-ok($z ne "");
-
-
-#
-# Case 6: test isweakref
-#
-
-$a = 5;
-ok(!isweak($a));
-$b = \$a;
-ok(!isweak($b));
-weaken($b);
-ok(isweak($b));
-$b = \$a;
-ok(!isweak($b));
-
-$x = {};
-weaken($x->{Y} = \$a);
-ok(isweak($x->{Y}));
-ok(!isweak($x->{Z}));
-
-
-package Dest;
-
-sub DESTROY {
-       print "# INCFLAG\n";
-       ${$_[0]{Flag}} ++;
-}

diff --git a/t/lib/user-grent.t b/t/lib/user-grent.t
deleted file mode 100644 (file)
index 760b814..0000000
--- a/t/lib/user-grent.t
+++ /dev/null
@@ -1,44 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN {
-    our $hasgr;
-    eval { my @n = getgrgid 0 };
-    $hasgr = 1 unless $@ && $@ =~ /unimplemented/;
-    unless ($hasgr) { print "1..0 # Skip: no getgrgid\n"; exit 0 }
-    use Config;
-    $hasgr = 0 unless $Config{'i_grp'} eq 'define';
-    unless ($hasgr) { print "1..0 # Skip: no grp.h\n"; exit 0 }
-}
-
-BEGIN {
-    our @grent = getgrgid 0; # This is the function getgrgid.
-    unless (@grent) { print "1..0 # Skip: no gid 0\n"; exit 0 }
-}
-
-print "1..5\n";
-
-use User::grent;
-
-print "ok 1\n";
-
-my $grent = getgrgid 0; # This is the OO getgrgid.
-
-print "not " unless $grent->gid    == 0;
-print "ok 2\n";
-
-print "not " unless $grent->name   == $grent[0];
-print "ok 3\n";
-
-print "not " unless $grent->passwd eq $grent[1];
-print "ok 4\n";
-
-print "not " unless $grent->gid    == $grent[2];
-print "ok 5\n";
-
-# Testing pretty much anything else is unportable.
-

diff --git a/t/lib/user-pwent.t b/t/lib/user-pwent.t
deleted file mode 100644 (file)
index e274265..0000000
--- a/t/lib/user-pwent.t
+++ /dev/null
@@ -1,63 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN {
-    our $haspw;
-    eval { my @n = getpwuid 0 };
-    $haspw = 1 unless $@ && $@ =~ /unimplemented/;
-    unless ($haspw) { print "1..0 # Skip: no getpwuid\n"; exit 0 }
-    use Config;
-    $haspw = 0 unless $Config{'i_pwd'} eq 'define';
-    unless ($haspw) { print "1..0 # Skip: no pwd.h\n"; exit 0 }
-}
-
-BEGIN {
-    our @pwent = getpwuid 0; # This is the function getpwuid.
-    unless (@pwent) { print "1..0 # Skip: no uid 0\n"; exit 0 }
-}
-
-print "1..9\n";
-
-use User::pwent;
-
-print "ok 1\n";
-
-my $pwent = getpwuid 0; # This is the OO getpwuid.
-
-print "not " unless $pwent->uid    == 0;
-print "ok 2\n";
-
-print "not " unless $pwent->name   == $pwent[0];
-print "ok 3\n";
-
-print "not " unless $pwent->passwd eq $pwent[1];
-print "ok 4\n";
-
-print "not " unless $pwent->uid    == $pwent[2];
-print "ok 5\n";
-
-print "not " unless $pwent->gid    == $pwent[3];
-print "ok 6\n";
-
-# The quota and comment fields are unportable.
-
-print "not " unless $pwent->gecos  eq $pwent[6];
-print "ok 7\n";
-
-print "not " unless $pwent->dir    eq $pwent[7];
-print "ok 8\n";
-
-print "not " unless $pwent->shell  eq $pwent[8];
-print "ok 9\n";
-
-# The expire field is unportable.
-
-# Testing pretty much anything else is unportable:
-# there maybe more than one username with uid 0;
-# uid 0's home directory may be "/" or "/root' or something else,
-# and so on.
-

diff --git a/t/lib/xs-typemap.t b/t/lib/xs-typemap.t
deleted file mode 100644 (file)
index 0cf1ab3..0000000
--- a/t/lib/xs-typemap.t
+++ /dev/null
@@ -1,339 +0,0 @@
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bXS\/Typemap\b/) {
-        print "1..0 # Skip: XS::Typemap was not built\n";
-        exit 0;
-    }
-}
-
-use Test;
-BEGIN { plan tests => 84 }
-
-use strict;
-use warnings;
-use XS::Typemap;
-
-ok(1);
-
-# Some inheritance trees to check ISA relationships
-BEGIN {
-  package intObjPtr::SubClass;
-  use base qw/ intObjPtr /;
-  sub xxx { 1; }
-}
-
-BEGIN {
-  package intRefIvPtr::SubClass;
-  use base qw/ intRefIvPtr /;
-  sub xxx { 1 }
-}
-
-# T_SV - standard perl scalar value
-print "# T_SV\n";
-
-my $sv = "Testing T_SV";
-ok( T_SV($sv), $sv);
-
-# T_SVREF - reference to Scalar
-print "# T_SVREF\n";
-
-$sv .= "REF";
-my $svref = \$sv;
-ok( T_SVREF($svref), $svref );
-
-# Now test that a non reference is rejected
-# the typemaps croak
-eval { T_SVREF( "fail - not ref" ) };
-ok( $@ );
-
-# T_AVREF - reference to a perl Array
-print "# T_AVREF\n";
-
-my @array;
-ok( T_AVREF(\@array), \@array);
-
-# Now test that a non array ref is rejected
-eval { T_AVREF( \$sv ) };
-ok( $@ );
-
-# T_HVREF - reference to a perl Hash
-print "# T_HVREF\n";
-
-my %hash;
-ok( T_HVREF(\%hash), \%hash);
-
-# Now test that a non hash ref is rejected
-eval { T_HVREF( \@array ) };
-ok( $@ );
-
-
-# T_CVREF - reference to perl subroutine
-print "# T_CVREF\n";
-my $sub = sub { 1 };
-ok( T_CVREF($sub), $sub );
-
-# Now test that a non code ref is rejected
-eval { T_CVREF( \@array ) };
-ok( $@ );
-
-# T_SYSRET - system return values
-print "# T_SYSRET\n";
-
-# first check success
-ok( T_SYSRET_pass );
-
-# ... now failure
-ok( T_SYSRET_fail, undef);
-
-# T_UV - unsigned integer
-print "# T_UV\n";
-
-ok( T_UV(5), 5 );    # pass
-ok( T_UV(-4) != -4); # fail
-
-# T_IV - signed integer
-print "# T_IV\n";
-
-ok( T_IV(5), 5);
-ok( T_IV(-4), -4);
-ok( T_IV(4.1), int(4.1));
-ok( T_IV("52"), "52");
-ok( T_IV(4.5) != 4.5); # failure
-
-
-# Skip T_INT
-
-# T_ENUM - enum list
-print "# T_ENUM\n";
-
-ok( T_ENUM() ); # just hope for a true value
-
-# T_BOOL - boolean
-print "# T_BOOL\n";
-
-ok( T_BOOL(52) );
-ok( ! T_BOOL(0) );
-ok( ! T_BOOL('') );
-ok( ! T_BOOL(undef) );
-
-# Skip T_U_INT
-
-# Skip T_SHORT
-
-# T_U_SHORT aka U16
-
-print "# T_U_SHORT\n";
-
-ok( T_U_SHORT(32000), 32000);
-if ($Config{shortsize} == 2) {
-  ok( T_U_SHORT(65536) != 65536); # probably dont want to test edge cases
-} else {
-  ok(1); # e.g. Crays have shortsize 4 (T3X) or 8 (CXX and SVX)
-}
-
-# T_U_LONG aka U32
-
-print "# T_U_LONG\n";
-
-ok( T_U_LONG(65536), 65536);
-ok( T_U_LONG(-1) != -1);
-
-# T_CHAR
-
-print "# T_CHAR\n";
-
-ok( T_CHAR("a"), "a");
-ok( T_CHAR("-"), "-");
-ok( T_CHAR(chr(128)),chr(128));
-ok( T_CHAR(chr(256)) ne chr(256));
-
-# T_U_CHAR
-
-print "# T_U_CHAR\n";
-
-ok( T_U_CHAR(127), 127);
-ok( T_U_CHAR(128), 128);
-ok( T_U_CHAR(-1) != -1);
-ok( T_U_CHAR(300) != 300);
-
-# T_FLOAT
-print "# T_FLOAT\n";
-
-# limited precision
-ok( sprintf("%6.3f",T_FLOAT(52.345)), sprintf("%6.3f",52.345));
-
-# T_NV
-print "# T_NV\n";
-
-ok( T_NV(52.345), 52.345);
-
-# T_DOUBLE
-print "# T_DOUBLE\n";
-
-ok( sprintf("%6.3f",T_DOUBLE(52.345)), sprintf("%6.3f",52.345));
-
-# T_PV
-print "# T_PV\n";
-
-ok( T_PV("a string"), "a string");
-ok( T_PV(52), 52);
-
-# T_PTR
-print "# T_PTR\n";
-
-my $t = 5;
-my $ptr = T_PTR_OUT($t);
-ok( T_PTR_IN( $ptr ), $t );
-
-# T_PTRREF
-print "# T_PTRREF\n";
-
-$t = -52;
-$ptr = T_PTRREF_OUT( $t );
-ok( ref($ptr), "SCALAR");
-ok( T_PTRREF_IN( $ptr ), $t );
-
-# test that a non-scalar ref is rejected
-eval { T_PTRREF_IN( $t ); };
-ok( $@ );
-
-# T_PTROBJ
-print "# T_PTROBJ\n";
-
-$t = 256;
-$ptr = T_PTROBJ_OUT( $t );
-ok( ref($ptr), "intObjPtr");
-ok( $ptr->T_PTROBJ_IN, $t );
-
-# check that normal scalar refs fail
-eval {intObjPtr::T_PTROBJ_IN( \$t );};
-ok( $@ );
-
-# check that inheritance works
-bless $ptr, "intObjPtr::SubClass";
-ok( ref($ptr), "intObjPtr::SubClass");
-ok( $ptr->T_PTROBJ_IN, $t );
-
-# Skip T_REF_IV_REF
-
-# T_REF_IV_PTR
-print "# T_REF_IV_PTR\n";
-
-$t = -365;
-$ptr = T_REF_IV_PTR_OUT( $t );
-ok( ref($ptr), "intRefIvPtr");
-ok( $ptr->T_REF_IV_PTR_IN(), $t);
-
-# inheritance should not work
-bless $ptr, "intRefIvPtr::SubClass";
-eval { $ptr->T_REF_IV_PTR_IN };
-ok( $@ );
-
-# Skip T_PTRDESC
-
-# Skip T_REFREF
-
-# Skip T_REFOBJ
-
-# T_OPAQUEPTR
-print "# T_OPAQUEPTR\n";
-
-$t = 22;
-my $p = T_OPAQUEPTR_IN( $t );
-ok( T_OPAQUEPTR_OUT($p), $t);
-
-# T_OPAQUEPTR with a struct
-print "# T_OPAQUEPTR with a struct\n";
-
-my @test = (5,6,7);
-$p = T_OPAQUEPTR_IN_struct(@test);
-my @result = T_OPAQUEPTR_OUT_struct($p);
-ok(scalar(@result),scalar(@test));
-for (0..$#test) {
-  ok($result[$_], $test[$_]);
-}
-
-# T_OPAQUE
-print "# T_OPAQUE\n";
-
-$t = 48;
-$p = T_OPAQUE_IN( $t );
-ok(T_OPAQUEPTR_OUT_short( $p ), $t); # Test using T_OPAQUEPTR
-ok(T_OPAQUE_OUT( $p ), $t );         # Test using T_OPQAQUE
-
-# T_OPAQUE_array
-print "# A packed  array\n";
-
-my @opq = (2,4,8);
-my $packed = T_OPAQUE_array(@opq);
-my @uopq = unpack("i*",$packed);
-ok(scalar(@uopq), scalar(@opq));
-for (0..$#opq) {
-  ok( $uopq[$_], $opq[$_]);
-}
-
-# Skip T_PACKED
-
-# Skip T_PACKEDARRAY
-
-# Skip T_DATAUNIT
-
-# Skip T_CALLBACK
-
-# T_ARRAY
-print "# T_ARRAY\n";
-my @inarr = (1,2,3,4,5,6,7,8,9,10);
-my @outarr = T_ARRAY( 5, @inarr );
-ok(scalar(@outarr), scalar(@inarr));
-
-for (0..$#inarr) {
-  ok($outarr[$_], $inarr[$_]);
-}
-
-
-
-# T_STDIO
-print "# T_STDIO\n";
-
-# open a file in XS for write
-my $testfile= "stdio.tmp";
-my $fh = T_STDIO_open( $testfile );
-ok( $fh );
-
-# write to it using perl
-if (defined $fh) {
-
-  my @lines = ("NormalSTDIO\n", "PerlIO\n");
-
-  # print to it using FILE* through XS
-  ok( T_STDIO_print($fh, $lines[0]), length($lines[0]));
-
-  # print to it using normal perl
-  ok(print $fh "$lines[1]");
-
-  # close it using XS
-  # This works fine but causes a segmentation fault during global
-  # destruction when the glob associated with this filehandle is
-  # tidied up.
-#  ok( T_STDIO_close( $fh ) );
-  ok(close($fh)); # using perlio to close the glob works fine
-
-  # open from perl, and check contents
-  open($fh, "< $testfile");
-  ok($fh);
-  my $line = <$fh>;
-  ok($line,$lines[0]);
-  $line = <$fh>;
-  ok($line,$lines[1]);
-
-  ok(close($fh));
-  ok(unlink($testfile));
-
-} else {
-  for (1..8) {
-    skip("Skip Test not relevant since file was not opened correctly",0);
-  }
-}
-

diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
new file mode 100755 (executable)
index 0000000..e101f97
--- /dev/null
+++ b/t/op/sub_lval.t
@@ -0,0 +1,533 @@
+print "1..64\n";
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
+sub b : lvalue { ${\shift} }
+
+my $out = a(b());              # Check that temporaries are allowed.
+print "# `$out'\nnot " unless ref $out eq 'main'; # Not reached if error.
+print "ok 1\n";
+
+my @out = grep /main/, a(b()); # Check that temporaries are allowed.
+print "# `@out'\nnot " unless @out==1; # Not reached if error.
+print "ok 2\n";
+
+my $in;
+
+# Check that we can return localized values from subroutines:
+
+sub in : lvalue { $in = shift; }
+sub neg : lvalue {  #(num_str) return num_str
+    local $_ = shift;
+    s/^\+/-/;
+    $_;
+}
+in(neg("+2"));
+
+
+print "# `$in'\nnot " unless $in eq '-2';
+print "ok 3\n";
+
+sub get_lex : lvalue { $in }
+sub get_st : lvalue { $blah }
+sub id : lvalue { ${\shift} }
+sub id1 : lvalue { $_[0] }
+sub inc : lvalue { ${\++$_[0]} }
+
+$in = 5;
+$blah = 3;
+
+get_st = 7;
+
+print "# `$blah' ne 7\nnot " unless $blah eq 7;
+print "ok 4\n";
+
+get_lex = 7;
+
+print "# `$in' ne 7\nnot " unless $in eq 7;
+print "ok 5\n";
+
+++get_st;
+
+print "# `$blah' ne 8\nnot " unless $blah eq 8;
+print "ok 6\n";
+
+++get_lex;
+
+print "# `$in' ne 8\nnot " unless $in eq 8;
+print "ok 7\n";
+
+id(get_st) = 10;
+
+print "# `$blah' ne 10\nnot " unless $blah eq 10;
+print "ok 8\n";
+
+id(get_lex) = 10;
+
+print "# `$in' ne 10\nnot " unless $in eq 10;
+print "ok 9\n";
+
+++id(get_st);
+
+print "# `$blah' ne 11\nnot " unless $blah eq 11;
+print "ok 10\n";
+
+++id(get_lex);
+
+print "# `$in' ne 11\nnot " unless $in eq 11;
+print "ok 11\n";
+
+id1(get_st) = 20;
+
+print "# `$blah' ne 20\nnot " unless $blah eq 20;
+print "ok 12\n";
+
+id1(get_lex) = 20;
+
+print "# `$in' ne 20\nnot " unless $in eq 20;
+print "ok 13\n";
+
+++id1(get_st);
+
+print "# `$blah' ne 21\nnot " unless $blah eq 21;
+print "ok 14\n";
+
+++id1(get_lex);
+
+print "# `$in' ne 21\nnot " unless $in eq 21;
+print "ok 15\n";
+
+inc(get_st);
+
+print "# `$blah' ne 22\nnot " unless $blah eq 22;
+print "ok 16\n";
+
+inc(get_lex);
+
+print "# `$in' ne 22\nnot " unless $in eq 22;
+print "ok 17\n";
+
+inc(id(get_st));
+
+print "# `$blah' ne 23\nnot " unless $blah eq 23;
+print "ok 18\n";
+
+inc(id(get_lex));
+
+print "# `$in' ne 23\nnot " unless $in eq 23;
+print "ok 19\n";
+
+++inc(id1(id(get_st)));
+
+print "# `$blah' ne 25\nnot " unless $blah eq 25;
+print "ok 20\n";
+
+++inc(id1(id(get_lex)));
+
+print "# `$in' ne 25\nnot " unless $in eq 25;
+print "ok 21\n";
+
+@a = (1) x 3;
+@b = (undef) x 2;
+$#c = 3;                       # These slots are not fillable.
+
+# Explanation: empty slots contain &sv_undef.
+
+=for disabled constructs
+
+sub a3 :lvalue {@a}
+sub b2 : lvalue {@b}
+sub c4: lvalue {@c}
+
+$_ = '';
+
+eval <<'EOE' or $_ = $@;
+  ($x, a3, $y, b2, $z, c4, $t) = (34 .. 78);
+  1;
+EOE
+
+#@out = ($x, a3, $y, b2, $z, c4, $t);
+#@in = (34 .. 41, (undef) x 4, 46);
+#print "# `@out' ne `@in'\nnot " unless "@out" eq "@in";
+
+print "# '$_'.\nnot "
+  unless /Can\'t return an uninitialized value from lvalue subroutine/;
+=cut
+
+print "ok 22\n";
+
+my $var;
+
+sub a::var : lvalue { $var }
+
+"a"->var = 45;
+
+print "# `$var' ne 45\nnot " unless $var eq 45;
+print "ok 23\n";
+
+my $oo;
+$o = bless \$oo, "a";
+
+$o->var = 47;
+
+print "# `$var' ne 47\nnot " unless $var eq 47;
+print "ok 24\n";
+
+sub o : lvalue { $o }
+
+o->var = 49;
+
+print "# `$var' ne 49\nnot " unless $var eq 49;
+print "ok 25\n";
+
+sub nolv () { $x0, $x1 } # Not lvalue
+
+$_ = '';
+
+eval <<'EOE' or $_ = $@;
+  nolv = (2,3);
+  1;
+EOE
+
+print "not "
+  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
+print "ok 26\n";
+
+$_ = '';
+
+eval <<'EOE' or $_ = $@;
+  nolv = (2,3) if $_;
+  1;
+EOE
+
+print "not "
+  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
+print "ok 27\n";
+
+$_ = '';
+
+eval <<'EOE' or $_ = $@;
+  &nolv = (2,3) if $_;
+  1;
+EOE
+
+print "not "
+  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
+print "ok 28\n";
+
+$x0 = $x1 = $_ = undef;
+$nolv = \&nolv;
+
+eval <<'EOE' or $_ = $@;
+  $nolv->() = (2,3) if $_;
+  1;
+EOE
+
+print "# '$_', '$x0', '$x1'.\nnot " if defined $_;
+print "ok 29\n";
+
+$x0 = $x1 = $_ = undef;
+$nolv = \&nolv;
+
+eval <<'EOE' or $_ = $@;
+  $nolv->() = (2,3);
+  1;
+EOE
+
+print "# '$_', '$x0', '$x1'.\nnot "
+  unless /Can\'t modify non-lvalue subroutine call/;
+print "ok 30\n";
+
+sub lv0 : lvalue { }           # Converted to lv10 in scalar context
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv0 = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 31\n";
+
+sub lv10 : lvalue {}
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv0) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot " if defined $_;
+print "ok 32\n";
+
+sub lv1u :lvalue { undef }
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1u = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 33\n";
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1u) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return an uninitialized value from lvalue subroutine/;
+print "ok 34\n";
+
+$x = '1234567';
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  sub lv1t : lvalue { index $x, 2 }
+  lv1t = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t modify index in lvalue subroutine return/;
+print "ok 35\n";
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  sub lv2t : lvalue { shift }
+  (lv2t) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t modify shift in lvalue subroutine return/;
+print "ok 36\n";
+
+$xxx = 'xxx';
+sub xxx () { $xxx }  # Not lvalue
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  sub lv1tmp : lvalue { xxx }                  # is it a TEMP?
+  lv1tmp = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t modify non-lvalue subroutine call in lvalue subroutine return/;
+print "ok 37\n";
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1tmp) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a temporary from lvalue subroutine/;
+print "ok 38\n";
+
+sub yyy () { 'yyy' } # Const, not lvalue
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  sub lv1tmpr : lvalue { yyy }                 # is it read-only?
+  lv1tmpr = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t modify constant item in lvalue subroutine return/;
+print "ok 39\n";
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1tmpr) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 40\n";
+
+sub lva : lvalue {@a}
+
+$_ = undef;
+@a = ();
+$a[1] = 12;
+eval <<'EOE' or $_ = $@;
+  (lva) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
+print "ok 41\n";
+
+$_ = undef;
+@a = ();
+$a[0] = undef;
+$a[1] = 12;
+eval <<'EOE' or $_ = $@;
+  (lva) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
+print "ok 42\n";
+
+$_ = undef;
+@a = ();
+$a[0] = undef;
+$a[1] = 12;
+eval <<'EOE' or $_ = $@;
+  (lva) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
+print "ok 43\n";
+
+sub lv1n : lvalue { $newvar }
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1n = (3,4);
+  1;
+EOE
+
+print "# '$_', '$newvar'.\nnot " unless "'$newvar' $_" eq "'4' ";
+print "ok 44\n";
+
+sub lv1nn : lvalue { $nnewvar }
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1nn) = (3,4);
+  1;
+EOE
+
+print "# '$_'.\nnot " unless "'$nnewvar' $_" eq "'3' ";
+print "ok 45\n";
+
+$a = \&lv1nn;
+$a->() = 8;
+print "# '$nnewvar'.\nnot " unless $nnewvar eq '8';
+print "ok 46\n";
+
+# This must happen at run time
+eval {
+    sub AUTOLOAD : lvalue { $newvar };
+};
+foobar() = 12;
+print "# '$newvar'.\nnot " unless $newvar eq "12";
+print "ok 47\n";
+
+print "ok 48 # Skip: removed test\n";
+
+print "ok 49 # Skip: removed test\n";
+
+{
+my %hash; my @array;
+sub alv : lvalue { $array[1] }
+sub alv2 : lvalue { $array[$_[0]] }
+sub hlv : lvalue { $hash{"foo"} }
+sub hlv2 : lvalue { $hash{$_[0]} }
+$array[1] = "not ok 51\n";
+alv() = "ok 50\n";
+print alv();
+
+alv2(20) = "ok 51\n";
+print $array[20];
+
+$hash{"foo"} = "not ok 52\n";
+hlv() = "ok 52\n";
+print $hash{foo};
+
+$hash{bar} = "not ok 53\n";
+hlv("bar") = "ok 53\n";
+print hlv("bar");
+
+sub array : lvalue  { @array  }
+sub array2 : lvalue { @array2 } # This is a global.
+sub hash : lvalue   { %hash   }
+sub hash2 : lvalue  { %hash2  } # So's this.
+@array2 = qw(foo bar);
+%hash2 = qw(foo bar);
+
+(array()) = qw(ok 54);
+print "not " unless "@array" eq "ok 54";
+print "ok 54\n";
+
+(array2()) = qw(ok 55);
+print "not " unless "@array2" eq "ok 55";
+print "ok 55\n";
+
+(hash()) = qw(ok 56);
+print "not " unless $hash{ok} == 56;
+print "ok 56\n";
+
+(hash2()) = qw(ok 57);
+print "not " unless $hash2{ok} == 57;
+print "ok 57\n";
+
+@array = qw(a b c d);
+sub aslice1 : lvalue { @array[0,2] };
+(aslice1()) = ("ok", "already");
+print "# @array\nnot " unless "@array" eq "ok b already d";
+print "ok 58\n";
+
+@array2 = qw(a B c d);
+sub aslice2 : lvalue { @array2[0,2] };
+(aslice2()) = ("ok", "already");
+print "not " unless "@array2" eq "ok B already d";
+print "ok 59\n";
+
+%hash = qw(a Alpha b Beta c Gamma);
+sub hslice : lvalue { @hash{"c", "b"} }
+(hslice()) = ("CISC", "BogoMIPS");
+print "not " unless join("/",@hash{"c","a","b"}) eq "CISC/Alpha/BogoMIPS";
+print "ok 60\n";
+}
+
+$str = "Hello, world!";
+sub sstr : lvalue { substr($str, 1, 4) }
+sstr() = "i";
+print "not " unless $str eq "Hi, world!";
+print "ok 61\n";
+
+$str = "Made w/ JavaScript";
+sub veclv : lvalue { vec($str, 2, 32) }
+if (ord('A') != 193) {
+    veclv() = 0x5065726C;
+}
+else { # EBCDIC?
+    veclv() = 0xD7859993;
+}
+print "# $str\nnot " unless $str eq "Made w/ PerlScript";
+print "ok 62\n";
+
+sub position : lvalue { pos }
+@p = ();
+$_ = "fee fi fo fum";
+while (/f/g) {
+    push @p, position;
+    position() += 6;
+}
+print "# @p\nnot " unless "@p" eq "1 8";
+print "ok 63\n";
+
+# Bug 20001223.002: split thought that the list had only one element
+@ary = qw(4 5 6);
+sub lval1 : lvalue { $ary[0]; }
+sub lval2 : lvalue { $ary[1]; }
+(lval1(), lval2()) = split ' ', "1 2 3 4";
+print "not " unless join(':', @ary) eq "1:2:6";
+print "ok 64\n";

diff --git a/t/pragma/autouse.t b/t/pragma/autouse.t
deleted file mode 100644 (file)
index 0a2d680..0000000
--- a/t/pragma/autouse.t
+++ /dev/null
@@ -1,57 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use Test;
-BEGIN { plan tests => 10; }
-
-BEGIN {
-    require autouse;
-    eval {
-        "autouse"->import('List::Util' => 'List::Util::first(&@)');
-    };
-    ok( !$@ );
-
-    eval {
-        "autouse"->import('List::Util' => 'Foo::min');
-    };
-    ok( $@, qr/^autouse into different package attempted/ );
-
-    "autouse"->import('List::Util' => qw(max first(&@)));
-}
-
-my @a = (1,2,3,4,5.5);
-ok( max(@a), 5.5);
-
-
-# first() has a prototype of &@.  Make sure that's preserved.
-ok( (first { $_ > 3 } @a), 4);
-
-
-# Example from the docs.
-use autouse 'Carp' => qw(carp croak);
-
-{
-    my @warning;
-    local $SIG{__WARN__} = sub { push @warning, @_ };
-    carp "this carp was predeclared and autoused\n";
-    ok( scalar @warning, 1 );
-    ok( $warning[0], "this carp was predeclared and autoused\n" );
-
-    eval { croak "It is but a scratch!" };
-    ok( $@, qr/^It is but a scratch!/);
-}
-
-
-# Test that autouse's lazy module loading works.  We assume that nothing
-# involved in this test uses Text::Soundex, which is pretty safe.
-use autouse 'Text::Soundex' => qw(soundex);
-
-my $mod_file = 'Text/Soundex.pm'; # just fine and portable for %INC
-ok( !exists $INC{$mod_file} );
-ok( soundex('Basset'), 'B230' );
-ok( exists $INC{$mod_file} );
-

diff --git a/t/pragma/constant.t b/t/pragma/constant.t
deleted file mode 100755 (executable)
index f932976..0000000
--- a/t/pragma/constant.t
+++ /dev/null
@@ -1,251 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-use warnings;
-use vars qw{ @warnings };
-BEGIN {                                # ...and save 'em for later
-    $SIG{'__WARN__'} = sub { push @warnings, @_ }
-}
-END { print @warnings }
-
-######################### We start with some black magic to print on failure.
-
-BEGIN { $| = 1; print "1..82\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use constant 1.01;
-$loaded = 1;
-#print "# Version: $constant::VERSION\n";
-print "ok 1\n";
-
-######################### End of black magic.
-
-use strict;
-
-sub test ($$;$) {
-    my($num, $bool, $diag) = @_;
-    if ($bool) {
-       print "ok $num\n";
-       return;
-    }
-    print "not ok $num\n";
-    return unless defined $diag;
-    $diag =~ s/\Z\n?/\n/;                      # unchomp
-    print map "# $num : $_", split m/^/m, $diag;
-}
-
-use constant PI                => 4 * atan2 1, 1;
-
-test 2, substr(PI, 0, 7) eq '3.14159';
-test 3, defined PI;
-
-sub deg2rad { PI * $_[0] / 180 }
-
-my $ninety = deg2rad 90;
-
-test 4, $ninety > 1.5707;
-test 5, $ninety < 1.5708;
-
-use constant UNDEF1    => undef;       # the right way
-use constant UNDEF2    =>      ;       # the weird way
-use constant 'UNDEF3'          ;       # the 'short' way
-use constant EMPTY     => ( )  ;       # the right way for lists
-
-test 6, not defined UNDEF1;
-test 7, not defined UNDEF2;
-test 8, not defined UNDEF3;
-my @undef = UNDEF1;
-test 9, @undef == 1;
-test 10, not defined $undef[0];
-@undef = UNDEF2;
-test 11, @undef == 0;
-@undef = UNDEF3;
-test 12, @undef == 0;
-@undef = EMPTY;
-test 13, @undef == 0;
-
-use constant COUNTDOWN => scalar reverse 1, 2, 3, 4, 5;
-use constant COUNTLIST => reverse 1, 2, 3, 4, 5;
-use constant COUNTLAST => (COUNTLIST)[-1];
-
-test 14, COUNTDOWN eq '54321';
-my @cl = COUNTLIST;
-test 15, @cl == 5;
-test 16, COUNTDOWN eq join '', @cl;
-test 17, COUNTLAST == 1;
-test 18, (COUNTLIST)[1] == 4;
-
-use constant ABC       => 'ABC';
-test 19, "abc${\( ABC )}abc" eq "abcABCabc";
-
-use constant DEF       => 'D', 'E', chr ord 'F';
-test 20, "d e f @{[ DEF ]} d e f" eq "d e f D E F d e f";
-
-use constant SINGLE    => "'";
-use constant DOUBLE    => '"';
-use constant BACK      => '\\';
-my $tt = BACK . SINGLE . DOUBLE ;
-test 21, $tt eq q(\\'");
-
-use constant MESS      => q('"'\\"'"\\);
-test 22, MESS eq q('"'\\"'"\\);
-test 23, length(MESS) == 8;
-
-use constant TRAILING  => '12 cats';
-{
-    no warnings 'numeric';
-    test 24, TRAILING == 12;
-}
-test 25, TRAILING eq '12 cats';
-
-use constant LEADING   => " \t1234";
-test 26, LEADING == 1234;
-test 27, LEADING eq " \t1234";
-
-use constant ZERO1     => 0;
-use constant ZERO2     => 0.0;
-use constant ZERO3     => '0.0';
-test 28, ZERO1 eq '0';
-test 29, ZERO2 eq '0';
-test 30, ZERO3 eq '0.0';
-
-{
-    package Other;
-    use constant PI    => 3.141;
-}
-
-test 31, (PI > 3.1415 and PI < 3.1416);
-test 32, Other::PI == 3.141;
-
-use constant E2BIG => $! = 7;
-test 33, E2BIG == 7;
-# This is something like "Arg list too long", but the actual message
-# text may vary, so we can't test much better than this.
-test 34, length(E2BIG) > 6;
-test 35, index(E2BIG, " ") > 0;
-
-test 36, @warnings == 0, join "\n", "unexpected warning", @warnings;
-@warnings = ();                # just in case
-undef &PI;
-test 37, @warnings &&
-    ($warnings[0] =~ /Constant sub.* undefined/),
-    shift @warnings;
-
-test 38, @warnings == 0, "unexpected warning";
-test 39, 1;
-
-use constant CSCALAR   => \"ok 40\n";
-use constant CHASH     => { foo => "ok 41\n" };
-use constant CARRAY    => [ undef, "ok 42\n" ];
-use constant CPHASH    => [ { foo => 1 }, "ok 43\n" ];
-use constant CCODE     => sub { "ok $_[0]\n" };
-
-print ${+CSCALAR};
-print CHASH->{foo};
-print CARRAY->[1];
-print CPHASH->{foo};
-eval q{ CPHASH->{bar} };
-test 44, scalar($@ =~ /^No such pseudo-hash field/);
-print CCODE->(45);
-eval q{ CCODE->{foo} };
-test 46, scalar($@ =~ /^Constant is not a HASH/);
-
-# Allow leading underscore
-use constant _PRIVATE => 47;
-test 47, _PRIVATE == 47;
-
-# Disallow doubled leading underscore
-eval q{
-    use constant __DISALLOWED => "Oops";
-};
-test 48, $@ =~ /begins with '__'/;
-
-# Check on declared() and %declared. This sub should be EXACTLY the
-# same as the one quoted in the docs!
-sub declared ($) {
-    use constant 1.01;              # don't omit this!
-    my $name = shift;
-    $name =~ s/^::/main::/;
-    my $pkg = caller;
-    my $full_name = $name =~ /::/ ? $name : "${pkg}::$name";
-    $constant::declared{$full_name};
-}
-
-test 49, declared 'PI';
-test 50, $constant::declared{'main::PI'};
-
-test 51, !declared 'PIE';
-test 52, !$constant::declared{'main::PIE'};
-
-{
-    package Other;
-    use constant IN_OTHER_PACK => 42;
-    ::test 53, ::declared 'IN_OTHER_PACK';
-    ::test 54, $constant::declared{'Other::IN_OTHER_PACK'};
-    ::test 55, ::declared 'main::PI';
-    ::test 56, $constant::declared{'main::PI'};
-}
-
-test 57, declared 'Other::IN_OTHER_PACK';
-test 58, $constant::declared{'Other::IN_OTHER_PACK'};
-
-@warnings = ();
-eval q{
-    no warnings;
-    use warnings 'constant';
-    use constant 'BEGIN' => 1 ;
-    use constant 'INIT' => 1 ;
-    use constant 'CHECK' => 1 ;
-    use constant 'END' => 1 ;
-    use constant 'DESTROY' => 1 ;
-    use constant 'AUTOLOAD' => 1 ;
-    use constant 'STDIN' => 1 ;
-    use constant 'STDOUT' => 1 ;
-    use constant 'STDERR' => 1 ;
-    use constant 'ARGV' => 1 ;
-    use constant 'ARGVOUT' => 1 ;
-    use constant 'ENV' => 1 ;
-    use constant 'INC' => 1 ;
-    use constant 'SIG' => 1 ;
-};
-
-test 59, @warnings == 15 ;
-test 60, (shift @warnings) =~ /^Constant name 'BEGIN' is a Perl keyword at/;
-shift @warnings; #Constant subroutine BEGIN redefined at
-test 61, (shift @warnings) =~ /^Constant name 'INIT' is a Perl keyword at/;
-test 62, (shift @warnings) =~ /^Constant name 'CHECK' is a Perl keyword at/;
-test 63, (shift @warnings) =~ /^Constant name 'END' is a Perl keyword at/;
-test 64, (shift @warnings) =~ /^Constant name 'DESTROY' is a Perl keyword at/;
-test 65, (shift @warnings) =~ /^Constant name 'AUTOLOAD' is a Perl keyword at/;
-test 66, (shift @warnings) =~ /^Constant name 'STDIN' is forced into package main:: a/;
-test 67, (shift @warnings) =~ /^Constant name 'STDOUT' is forced into package main:: at/;
-test 68, (shift @warnings) =~ /^Constant name 'STDERR' is forced into package main:: at/;
-test 69, (shift @warnings) =~ /^Constant name 'ARGV' is forced into package main:: at/;
-test 70, (shift @warnings) =~ /^Constant name 'ARGVOUT' is forced into package main:: at/;
-test 71, (shift @warnings) =~ /^Constant name 'ENV' is forced into package main:: at/;
-test 72, (shift @warnings) =~ /^Constant name 'INC' is forced into package main:: at/;
-test 73, (shift @warnings) =~ /^Constant name 'SIG' is forced into package main:: at/;
-@warnings = ();
-
-
-use constant {
-       THREE  => 3,
-       FAMILY => [ qw( John Jane Sally ) ],
-       AGES   => { John => 33, Jane => 28, Sally => 3 },
-       RFAM   => [ [ qw( John Jane Sally ) ] ],
-       SPIT   => sub { shift },
-       PHFAM  => [ { John => 1, Jane => 2, Sally => 3 }, 33, 28, 3 ],
-};
-
-test 74, @{+FAMILY} == THREE;
-test 75, @{+FAMILY} == @{RFAM->[0]};
-test 76, FAMILY->[2] eq RFAM->[0]->[2];
-test 77, AGES->{FAMILY->[1]} == 28;
-test 78, PHFAM->{John} == AGES->{John};
-test 79, PHFAM->[3] == AGES->{FAMILY->[2]};
-test 80, @{+PHFAM} == SPIT->(THREE+1);
-test 81, THREE**3 eq SPIT->(@{+FAMILY}**3);
-test 82, AGES->{FAMILY->[THREE-1]} == PHFAM->[THREE];

diff --git a/t/pragma/diagnostics.t b/t/pragma/diagnostics.t
deleted file mode 100755 (executable)
index 14014f6..0000000
--- a/t/pragma/diagnostics.t
+++ /dev/null
@@ -1,38 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir '..' if -d '../pod' && -d '../t';
-    @INC = 'lib';
-}
-
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-use strict;
-use warnings;
-
-use vars qw($Test_Num $Total_tests);
-
-my $loaded;
-BEGIN { $| = 1; $Test_Num = 1 }
-END {print "not ok $Test_Num\n" unless $loaded;}
-print "1..$Total_tests\n";
-BEGIN { require diagnostics; } # Don't want diagnostics' noise yet.
-$loaded = 1;
-ok($loaded, 'compile');
-######################### End of black magic.
-
-sub ok {
-       my($test, $name) = shift;
-       print "not " unless $test;
-       print "ok $Test_Num";
-       print " - $name" if defined $name;
-       print "\n";
-       $Test_Num++;
-}
-
-
-# Change this to your # of ok() calls + 1
-BEGIN { $Total_tests = 1 }

diff --git a/t/pragma/locale.t b/t/pragma/locale.t
deleted file mode 100755 (executable)
index e58616c..0000000
--- a/t/pragma/locale.t
+++ /dev/null
@@ -1,839 +0,0 @@
-#!./perl -wT
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    unshift @INC, '.';
-    require Config; import Config;
-    if (!$Config{d_setlocale} || $Config{ccflags} =~ /\bD?NO_LOCALE\b/) {
-       print "1..0\n";
-       exit;
-    }
-    $| = 1;
-}
-
-use strict;
-
-my $debug = 1;
-
-use Dumpvalue;
-
-my $dumper = Dumpvalue->new(
-                            tick => qq{"},
-                            quoteHighBit => 0,
-                            unctrl => "quote"
-                           );
-sub debug {
-  return unless $debug;
-  my($mess) = join "", @_;
-  chop $mess;
-  print $dumper->stringify($mess,1), "\n";
-}
-
-sub debugf {
-    printf @_ if $debug;
-}
-
-my $have_setlocale = 0;
-eval {
-    require POSIX;
-    import POSIX ':locale_h';
-    $have_setlocale++;
-};
-
-# Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
-# and mingw32 uses said silly CRT
-$have_setlocale = 0 if (($^O eq 'MSWin32' || $^O eq 'NetWare') && $Config{cc} =~ /^(cl|gcc)/i);
-
-my $last = $have_setlocale ? &last : &last_without_setlocale;
-
-print "1..$last\n";
-
-use vars qw(&LC_ALL);
-
-$a = 'abc %';
-
-sub ok {
-    my ($n, $result) = @_;
-
-    print 'not ' unless ($result);
-    print "ok $n\n";
-}
-
-# First we'll do a lot of taint checking for locales.
-# This is the easiest to test, actually, as any locale,
-# even the default locale will taint under 'use locale'.
-
-sub is_tainted { # hello, camel two.
-    no warnings 'uninitialized' ;
-    my $dummy;
-    not eval { $dummy = join("", @_), kill 0; 1 }
-}
-
-sub check_taint ($$) {
-    ok $_[0], is_tainted($_[1]);
-}
-
-sub check_taint_not ($$) {
-    ok $_[0], not is_tainted($_[1]);
-}
-
-use locale;    # engage locale and therefore locale taint.
-
-check_taint_not   1, $a;
-
-check_taint       2, uc($a);
-check_taint       3, "\U$a";
-check_taint       4, ucfirst($a);
-check_taint       5, "\u$a";
-check_taint       6, lc($a);
-check_taint       7, "\L$a";
-check_taint       8, lcfirst($a);
-check_taint       9, "\l$a";
-
-check_taint_not  10, sprintf('%e', 123.456);
-check_taint_not  11, sprintf('%f', 123.456);
-check_taint_not  12, sprintf('%g', 123.456);
-check_taint_not  13, sprintf('%d', 123.456);
-check_taint_not  14, sprintf('%x', 123.456);
-
-$_ = $a;       # untaint $_
-
-$_ = uc($a);   # taint $_
-
-check_taint      15, $_;
-
-/(\w)/;        # taint $&, $`, $', $+, $1.
-check_taint      16, $&;
-check_taint      17, $`;
-check_taint      18, $';
-check_taint      19, $+;
-check_taint      20, $1;
-check_taint_not  21, $2;
-
-/(.)/; # untaint $&, $`, $', $+, $1.
-check_taint_not  22, $&;
-check_taint_not  23, $`;
-check_taint_not  24, $';
-check_taint_not  25, $+;
-check_taint_not  26, $1;
-check_taint_not  27, $2;
-
-/(\W)/;        # taint $&, $`, $', $+, $1.
-check_taint      28, $&;
-check_taint      29, $`;
-check_taint      30, $';
-check_taint      31, $+;
-check_taint      32, $1;
-check_taint_not  33, $2;
-
-/(\s)/;        # taint $&, $`, $', $+, $1.
-check_taint      34, $&;
-check_taint      35, $`;
-check_taint      36, $';
-check_taint      37, $+;
-check_taint      38, $1;
-check_taint_not  39, $2;
-
-/(\S)/;        # taint $&, $`, $', $+, $1.
-check_taint      40, $&;
-check_taint      41, $`;
-check_taint      42, $';
-check_taint      43, $+;
-check_taint      44, $1;
-check_taint_not  45, $2;
-
-$_ = $a;       # untaint $_
-
-check_taint_not  46, $_;
-
-/(b)/;         # this must not taint
-check_taint_not  47, $&;
-check_taint_not  48, $`;
-check_taint_not  49, $';
-check_taint_not  50, $+;
-check_taint_not  51, $1;
-check_taint_not  52, $2;
-
-$_ = $a;       # untaint $_
-
-check_taint_not  53, $_;
-
-$b = uc($a);   # taint $b
-s/(.+)/$b/;    # this must taint only the $_
-
-check_taint      54, $_;
-check_taint_not  55, $&;
-check_taint_not  56, $`;
-check_taint_not  57, $';
-check_taint_not  58, $+;
-check_taint_not  59, $1;
-check_taint_not  60, $2;
-
-$_ = $a;       # untaint $_
-
-s/(.+)/b/;     # this must not taint
-check_taint_not  61, $_;
-check_taint_not  62, $&;
-check_taint_not  63, $`;
-check_taint_not  64, $';
-check_taint_not  65, $+;
-check_taint_not  66, $1;
-check_taint_not  67, $2;
-
-$b = $a;       # untaint $b
-
-($b = $a) =~ s/\w/$&/;
-check_taint      68, $b;       # $b should be tainted.
-check_taint_not  69, $a;       # $a should be not.
-
-$_ = $a;       # untaint $_
-
-s/(\w)/\l$1/;  # this must taint
-check_taint      70, $_;
-check_taint      71, $&;
-check_taint      72, $`;
-check_taint      73, $';
-check_taint      74, $+;
-check_taint      75, $1;
-check_taint_not  76, $2;
-
-$_ = $a;       # untaint $_
-
-s/(\w)/\L$1/;  # this must taint
-check_taint      77, $_;
-check_taint      78, $&;
-check_taint      79, $`;
-check_taint      80, $';
-check_taint      81, $+;
-check_taint      82, $1;
-check_taint_not  83, $2;
-
-$_ = $a;       # untaint $_
-
-s/(\w)/\u$1/;  # this must taint
-check_taint      84, $_;
-check_taint      85, $&;
-check_taint      86, $`;
-check_taint      87, $';
-check_taint      88, $+;
-check_taint      89, $1;
-check_taint_not  90, $2;
-
-$_ = $a;       # untaint $_
-
-s/(\w)/\U$1/;  # this must taint
-check_taint      91, $_;
-check_taint      92, $&;
-check_taint      93, $`;
-check_taint      94, $';
-check_taint      95, $+;
-check_taint      96, $1;
-check_taint_not  97, $2;
-
-# After all this tainting $a should be cool.
-
-check_taint_not  98, $a;
-
-sub last_without_setlocale { 98 }
-
-# I think we've seen quite enough of taint.
-# Let us do some *real* locale work now,
-# unless setlocale() is missing (i.e. minitest).
-
-exit unless $have_setlocale;
-
-# Find locales.
-
-debug "# Scanning for locales...\n";
-
-# Note that it's okay that some languages have their native names
-# capitalized here even though that's not "right".  They are lowercased
-# anyway later during the scanning process (and besides, some clueless
-# vendor might have them capitalized errorneously anyway).
-
-my $locales = <<EOF;
-Afrikaans:af:za:1 15
-Arabic:ar:dz eg sa:6 arabic8
-Brezhoneg Breton:br:fr:1 15
-Bulgarski Bulgarian:bg:bg:5
-Chinese:zh:cn tw:cn.EUC eucCN eucTW euc.CN euc.TW Big5 GB2312 tw.EUC
-Hrvatski Croatian:hr:hr:2
-Cymraeg Welsh:cy:cy:1 14 15
-Czech:cs:cz:2
-Dansk Danish:dk:da:1 15
-Nederlands Dutch:nl:be nl:1 15
-English American British:en:au ca gb ie nz us uk zw:1 15 cp850
-Esperanto:eo:eo:3
-Eesti Estonian:et:ee:4 6 13
-Suomi Finnish:fi:fi:1 15
-Flamish::fl:1 15
-Deutsch German:de:at be ch de lu:1 15
-Euskaraz Basque:eu:es fr:1 15
-Galego Galician:gl:es:1 15
-Ellada Greek:el:gr:7 g8
-Frysk:fy:nl:1 15
-Greenlandic:kl:gl:4 6
-Hebrew:iw:il:8 hebrew8
-Hungarian:hu:hu:2
-Indonesian:in:id:1 15
-Gaeilge Irish:ga:IE:1 14 15
-Italiano Italian:it:ch it:1 15
-Nihongo Japanese:ja:jp:euc eucJP jp.EUC sjis
-Korean:ko:kr:
-Latine Latin:la:va:1 15
-Latvian:lv:lv:4 6 13
-Lithuanian:lt:lt:4 6 13
-Macedonian:mk:mk:1 15
-Maltese:mt:mt:3
-Moldovan:mo:mo:2
-Norsk Norwegian:no no\@nynorsk:no:1 15
-Occitan:oc:es:1 15
-Polski Polish:pl:pl:2
-Rumanian:ro:ro:2
-Russki Russian:ru:ru su ua:5 koi8 koi8r KOI8-R koi8u cp1251 cp866
-Serbski Serbian:sr:yu:5
-Slovak:sk:sk:2
-Slovene Slovenian:sl:si:2
-Sqhip Albanian:sq:sq:1 15
-Svenska Swedish:sv:fi se:1 15
-Thai:th:th:11 tis620
-Turkish:tr:tr:9 turkish8
-Yiddish:yi::1 15
-EOF
-
-if ($^O eq 'os390') {
-    # These cause heartburn.  Broken locales?
-    $locales =~ s/Svenska Swedish:sv:fi se:1 15\n//;
-    $locales =~ s/Thai:th:th:11 tis620\n//;
-}
-
-sub in_utf8 () { $^H & 0x08 }
-
-if (in_utf8) {
-    require "pragma/locale/utf8";
-} else {
-    require "pragma/locale/latin1";
-}
-
-my @Locale;
-my $Locale;
-my @Alnum_;
-
-my @utf8locale;
-my %utf8skip;
-
-sub getalnum_ {
-    sort grep /\w/, map { chr } 0..255
-}
-
-sub trylocale {
-    my $locale = shift;
-    if (setlocale(LC_ALL, $locale)) {
-       push @Locale, $locale;
-    }
-}
-
-sub decode_encodings {
-    my @enc;
-
-    foreach (split(/ /, shift)) {
-       if (/^(\d+)$/) {
-           push @enc, "ISO8859-$1";
-           push @enc, "iso8859$1";     # HP
-           if ($1 eq '1') {
-                push @enc, "roman8";   # HP
-           }
-       } else {
-           push @enc, $_;
-           push @enc, "$_.UTF-8";
-       }
-    }
-    if ($^O eq 'os390') {
-       push @enc, qw(IBM-037 IBM-819 IBM-1047);
-    }
-
-    return @enc;
-}
-
-trylocale("C");
-trylocale("POSIX");
-foreach (0..15) {
-    trylocale("ISO8859-$_");
-    trylocale("iso8859$_");
-    trylocale("iso8859-$_");
-    trylocale("iso_8859_$_");
-    trylocale("isolatin$_");
-    trylocale("isolatin-$_");
-    trylocale("iso_latin_$_");
-}
-
-# Sanitize the environment so that we can run the external 'locale'
-# program without the taint mode getting grumpy.
-
-# $ENV{PATH} is special in VMS.
-delete $ENV{PATH} if $^O ne 'VMS' or $Config{d_setenv};
-
-# Other subversive stuff.
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
-
-if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) {
-    while (<LOCALES>) {
-        chomp;
-       trylocale($_);
-    }
-    close(LOCALES);
-} elsif ($^O eq 'VMS' && defined($ENV{'SYS$I18N_LOCALE'}) && -d 'SYS$I18N_LOCALE') {
-# The SYS$I18N_LOCALE logical name search list was not present on 
-# VAX VMS V5.5-12, but was on AXP && VAX VMS V6.2 as well as later versions.
-    opendir(LOCALES, "SYS\$I18N_LOCALE:");
-    while ($_ = readdir(LOCALES)) {
-        chomp;
-        trylocale($_);
-    }
-    close(LOCALES);
-} else {
-
-    # This is going to be slow.
-
-    foreach my $locale (split(/\n/, $locales)) {
-       my ($locale_name, $language_codes, $country_codes, $encodings) =
-           split(/:/, $locale);
-       my @enc = decode_encodings($encodings);
-       foreach my $loc (split(/ /, $locale_name)) {
-           trylocale($loc);
-           foreach my $enc (@enc) {
-               trylocale("$loc.$enc");
-           }
-           $loc = lc $loc;
-           foreach my $enc (@enc) {
-               trylocale("$loc.$enc");
-           }
-       }
-       foreach my $lang (split(/ /, $language_codes)) {
-           trylocale($lang);
-           foreach my $country (split(/ /, $country_codes)) {
-               my $lc = "${lang}_${country}";
-               trylocale($lc);
-               foreach my $enc (@enc) {
-                   trylocale("$lc.$enc");
-               }
-               my $lC = "${lang}_\U${country}";
-               trylocale($lC);
-               foreach my $enc (@enc) {
-                   trylocale("$lC.$enc");
-               }
-           }
-       }
-    }
-}
-
-setlocale(LC_ALL, "C");
-
-sub utf8locale { $_[0] =~ /utf-?8/i }
-
-@Locale = sort @Locale;
-
-debug "# Locales = @Locale\n";
-
-my %Problem;
-my %Okay;
-my %Testing;
-my @Neoalpha;
-my %Neoalpha;
-
-sub tryneoalpha {
-    my ($Locale, $i, $test) = @_;
-    unless ($test) {
-       $Problem{$i}{$Locale} = 1;
-       debug "# failed $i with locale '$Locale'\n";
-    } else {
-       push @{$Okay{$i}}, $Locale;
-    }
-}
-
-foreach $Locale (@Locale) {
-    debug "# Locale = $Locale\n";
-    @Alnum_ = getalnum_();
-    debug "# w = ", join("",@Alnum_), "\n";
-
-    unless (setlocale(LC_ALL, $Locale)) {
-       foreach (99..103) {
-           $Problem{$_}{$Locale} = -1;
-       }
-       next;
-    }
-
-    # Sieve the uppercase and the lowercase.
-    
-    my %UPPER = ();
-    my %lower = ();
-    my %BoThCaSe = ();
-    for (@Alnum_) {
-       if (/[^\d_]/) { # skip digits and the _
-           if (uc($_) eq $_) {
-               $UPPER{$_} = $_;
-           }
-           if (lc($_) eq $_) {
-               $lower{$_} = $_;
-           }
-       }
-    }
-    foreach (keys %UPPER) {
-       $BoThCaSe{$_}++ if exists $lower{$_};
-    }
-    foreach (keys %lower) {
-       $BoThCaSe{$_}++ if exists $UPPER{$_};
-    }
-    foreach (keys %BoThCaSe) {
-       delete $UPPER{$_};
-       delete $lower{$_};
-    }
-
-    debug "# UPPER    = ", join("", sort keys %UPPER   ), "\n";
-    debug "# lower    = ", join("", sort keys %lower   ), "\n";
-    debug "# BoThCaSe = ", join("", sort keys %BoThCaSe), "\n";
-
-    # Find the alphabets that are not alphabets in the default locale.
-
-    {
-       no locale;
-    
-       @Neoalpha = ();
-       for (keys %UPPER, keys %lower) {
-           push(@Neoalpha, $_) if (/\W/);
-           $Neoalpha{$_} = $_;
-       }
-    }
-
-    @Neoalpha = sort @Neoalpha;
-
-    debug "# Neoalpha = ", join("",@Neoalpha), "\n";
-
-    if (@Neoalpha == 0) {
-       # If we have no Neoalphas the remaining tests are no-ops.
-       debug "# no Neoalpha, skipping tests 99..102 for locale '$Locale'\n";
-       foreach (99..102) {
-           push @{$Okay{$_}}, $Locale;
-       }
-    } else {
-
-       # Test \w.
-    
-       if (utf8locale($Locale)) {
-           # utf8 and locales do not mix.
-           debug "# skipping UTF-8 locale '$Locale'\n";
-           push @utf8locale, $Locale;
-            @utf8skip{99..102} = ();
-       } else {
-           my $word = join('', @Neoalpha);
-
-           $word =~ /^(\w+)$/;
- 
-           tryneoalpha($Locale, 99, $1 eq $word);
-       }
-       # Cross-check the whole 8-bit character set.
-
-       for (map { chr } 0..255) {
-           tryneoalpha($Locale, 100,
-                       (/\w/ xor /\W/) ||
-                       (/\d/ xor /\D/) ||
-                       (/\s/ xor /\S/));
-       }
-
-       # Test for read-only scalars' locale vs non-locale comparisons.
-
-       {
-           no locale;
-           $a = "qwerty";
-           {
-               use locale;
-               tryneoalpha($Locale, 101, ($a cmp "qwerty") == 0);
-           }
-       }
-
-       {
-           my ($from, $to, $lesser, $greater,
-               @test, %test, $test, $yes, $no, $sign);
-
-           for (0..9) {
-               # Select a slice.
-               $from = int(($_*@Alnum_)/10);
-               $to = $from + int(@Alnum_/10);
-               $to = $#Alnum_ if ($to > $#Alnum_);
-               $lesser  = join('', @Alnum_[$from..$to]);
-               # Select a slice one character on.
-               $from++; $to++;
-               $to = $#Alnum_ if ($to > $#Alnum_);
-               $greater = join('', @Alnum_[$from..$to]);
-               ($yes, $no, $sign) = ($lesser lt $greater
-                                     ? ("    ", "not ", 1)
-                                     : ("not ", "    ", -1));
-               # all these tests should FAIL (return 0).
-               # Exact lt or gt cannot be tested because
-               # in some locales, say, eacute and E may test equal.
-               @test = 
-                   (
-                    $no.'    ($lesser  le $greater)',  # 1
-                    'not      ($lesser  ne $greater)', # 2
-                    '         ($lesser  eq $greater)', # 3
-                    $yes.'    ($lesser  ge $greater)', # 4
-                    $yes.'    ($lesser  ge $greater)', # 5
-                    $yes.'    ($greater le $lesser )', # 7
-                    'not      ($greater ne $lesser )', # 8
-                    '         ($greater eq $lesser )', # 9
-                    $no.'     ($greater ge $lesser )', # 10
-                    'not (($lesser cmp $greater) == -($sign))' # 11
-                    );
-               @test{@test} = 0 x @test;
-               $test = 0;
-               for my $ti (@test) {
-                   $test{$ti} = eval $ti;
-                   $test ||= $test{$ti}
-               }
-               tryneoalpha($Locale, 102, $test == 0);
-               if ($test) {
-                   debug "# lesser  = '$lesser'\n";
-                   debug "# greater = '$greater'\n";
-                   debug "# lesser cmp greater = ",
-                         $lesser cmp $greater, "\n";
-                   debug "# greater cmp lesser = ",
-                         $greater cmp $lesser, "\n";
-                   debug "# (greater) from = $from, to = $to\n";
-                   for my $ti (@test) {
-                       debugf("# %-40s %-4s", $ti,
-                              $test{$ti} ? 'FAIL' : 'ok');
-                       if ($ti =~ /\(\.*(\$.+ +cmp +\$[^\)]+)\.*\)/) {
-                           debugf("(%s == %4d)", $1, eval $1);
-                       }
-                       debug "\n#";
-                   }
-
-                   last;
-               }
-           }
-       }
-    }
-
-    use locale;
-
-    my ($x, $y) = (1.23, 1.23);
-
-    $a = "$x";
-    printf ''; # printf used to reset locale to "C"
-    $b = "$y";
-
-    debug "# 103..107: a = $a, b = $b, Locale = $Locale\n";
-
-    tryneoalpha($Locale, 103, $a eq $b);
-
-    my $c = "$x";
-    my $z = sprintf ''; # sprintf used to reset locale to "C"
-    my $d = "$y";
-
-    debug "# 104..107: c = $c, d = $d, Locale = $Locale\n";
-
-    tryneoalpha($Locale, 104, $c eq $d); 
-
-    {
-       use warnings;
-       my $w = 0;
-       local $SIG{__WARN__} =
-           sub {
-               print "# @_\n";
-               $w++;
-           };
-
-       # The == (among other ops) used to warn for locales
-       # that had something else than "." as the radix character.
-
-       tryneoalpha($Locale, 105, $c == 1.23);
-
-       tryneoalpha($Locale, 106, $c == $x);
-
-       tryneoalpha($Locale, 107, $c == $d);
-
-       {
-#          no locale; # XXX did this ever work correctly?
-       
-           my $e = "$x";
-
-           debug "# 108..110: e = $e, Locale = $Locale\n";
-
-           tryneoalpha($Locale, 108, $e == 1.23);
-
-           tryneoalpha($Locale, 109, $e == $x);
-           
-           tryneoalpha($Locale, 110, $e == $c);
-       }
-       
-       my $f = "1.23";
-       my $g = 2.34;
-
-       debug "# 111..115: f = $f, g = $g, locale = $Locale\n";
-
-       tryneoalpha($Locale, 111, $f == 1.23);
-
-       tryneoalpha($Locale, 112, $f == $x);
-       
-       tryneoalpha($Locale, 113, $f == $c);
-
-       tryneoalpha($Locale, 114, abs(($f + $g) - 3.57) < 0.01);
-
-       tryneoalpha($Locale, 115, $w == 0);
-    }
-
-    # Does taking lc separately differ from taking
-    # the lc "in-line"?  (This was the bug 19990704.002, change #3568.)
-    # The bug was in the caching of the 'o'-magic.
-    {
-       use locale;
-
-       sub lcA {
-           my $lc0 = lc $_[0];
-           my $lc1 = lc $_[1];
-           return $lc0 cmp $lc1;
-       }
-
-        sub lcB {
-           return lc($_[0]) cmp lc($_[1]);
-       }
-
-        my $x = "ab";
-        my $y = "aa";
-        my $z = "AB";
-
-        tryneoalpha($Locale, 116,
-                   lcA($x, $y) == 1 && lcB($x, $y) == 1 ||
-                   lcA($x, $z) == 0 && lcB($x, $z) == 0);
-    }
-
-    # Does lc of an UPPER (if different from the UPPER) match
-    # case-insensitively the UPPER, and does the UPPER match
-    # case-insensitively the lc of the UPPER.  And vice versa.
-    {
-        if (utf8locale($Locale)) {
-           # utf8 and locales do not mix.
-           debug "# skipping UTF-8 locale '$Locale'\n";
-           push @utf8locale, $Locale;
-            $utf8skip{117}++;
-       } else {
-           use locale;
-           use locale;
-           no utf8; # so that the native 8-bit characters work
-
-           my @f = ();
-           foreach my $x (keys %UPPER) {
-               my $y = lc $x;
-               next unless uc $y eq $x;
-               push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
-           }
-           foreach my $x (keys %lower) {
-               my $y = uc $x;
-               next unless lc $y eq $x;
-               push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
-           }
-           tryneoalpha($Locale, 117, @f == 0);
-           if (@f) {
-               print "# failed 117 locale '$Locale' characters @f\n"
-           }
-        }
-    }
-}
-
-# Recount the errors.
-
-foreach (&last_without_setlocale()+1..$last) {
-    if ($Problem{$_} || !defined $Okay{$_} || !@{$Okay{$_}}) {
-       if ($_ == 102) {
-           print "# The failure of test 102 is not necessarily fatal.\n";
-           print "# It usually indicates a problem in the enviroment,\n";
-           print "# not in Perl itself.\n";
-       }
-       print "not ";
-    }
-    print "ok $_\n";
-}
-
-# Give final advice.
-
-my $didwarn = 0;
-
-foreach (99..$last) {
-    if ($Problem{$_}) {
-       my @f = sort keys %{ $Problem{$_} };
-       my $f = join(" ", @f);
-       $f =~ s/(.{50,60}) /$1\n#\t/g;
-       print
-           "#\n",
-            "# The locale ", (@f == 1 ? "definition" : "definitions"), "\n#\n",
-           "#\t", $f, "\n#\n",
-           "# on your system may have errors because the locale test $_\n",
-            "# failed in ", (@f == 1 ? "that locale" : "those locales"),
-            ".\n";
-       print <<EOW;
-#
-# If your users are not using these locales you are safe for the moment,
-# but please report this failure first to perlbug\@perl.com using the
-# perlbug script (as described in the INSTALL file) so that the exact
-# details of the failures can be sorted out first and then your operating
-# system supplier can be alerted about these anomalies.
-#
-EOW
-       $didwarn = 1;
-    }
-}
-
-# Tell which locales were okay and which were not.
-
-if ($didwarn) {
-    my (@s, @F);
-    
-    foreach my $l (@Locale) {
-       my $p = 0;
-       foreach my $t (102..$last) {
-           $p++ if $Problem{$t}{$l};
-       }
-       push @s, $l if $p == 0;
-      push @F, $l unless $p == 0;
-    }
-    
-    if (@s) {
-        my $s = join(" ", @s);
-        $s =~ s/(.{50,60}) /$1\n#\t/g;
-
-        warn
-           "# The following locales\n#\n",
-            "#\t", $s, "\n#\n",
-           "# tested okay.\n#\n",
-    } else {
-        warn "# None of your locales were fully okay.\n";
-    }
-
-    if (@F) {
-        my $F = join(" ", @F);
-        $F =~ s/(.{50,60}) /$1\n#\t/g;
-
-        warn
-          "# The following locales\n#\n",
-          "#\t", $F, "\n#\n",
-          "# had problems.\n#\n",
-    } else {
-        warn "# None of your locales were broken.\n";
-    }
-
-    if (@utf8locale) {
-        my $S = join(" ", @utf8locale);
-        $S =~ s/(.{50,60}) /$1\n#\t/g;
-    
-        warn "#\n# The following locales\n#\n",
-             "#\t", $S, "\n#\n",
-             "# were skipped for the tests ",
-             join(" ", sort {$a<=>$b} keys %utf8skip), "\n",
-            "# because UTF-8 and locales do not work together in Perl.\n#\n";
-    }
-}
-
-sub last { 117 }
-
-# eof

diff --git a/t/pragma/locale/latin1 b/t/pragma/locale/latin1
deleted file mode 100644 (file)
index f40f732..0000000
--- a/t/pragma/locale/latin1
+++ /dev/null
@@ -1,10 +0,0 @@
-$locales .= <<EOF;
-Català Catalan:ca:es:1 15
-Français French:fr:be ca ch fr lu:1 15
-Gáidhlig Gaelic:gd:gb uk:1 14 15
-Føroyskt Faroese:fo:fo:1 15
-Íslensku Icelandic:is:is:1 15
-Sámi Lappish:::4 6 13
-Português Portuguese:po:po br:1 15
-Espanõl Spanish:es:ar bo cl co cr do ec es gt hn mx ni pa pe py sv uy ve:1 15
-EOF

diff --git a/t/pragma/locale/utf8 b/t/pragma/locale/utf8
deleted file mode 100644 (file)
index fbbe94f..0000000
--- a/t/pragma/locale/utf8
+++ /dev/null
@@ -1,10 +0,0 @@
-$locales .= <<EOF;
-Català Catalan:ca:es:1 15
-Français French:fr:be ca ch fr lu:1 15
-Gáidhlig Gaelic:gd:gb uk:1 14 15
-Føroyskt Faroese:fo:fo:1 15
-Íslensku Icelandic:is:is:1 15
-Sámi Lappish:::4 6 13
-Português Portuguese:po:po br:1 15
-Espanõl Spanish:es:ar bo cl co cr do ec es gt hn mx ni pa pe py sv uy ve:1 15
-EOF

diff --git a/t/pragma/overload.t b/t/pragma/overload.t
deleted file mode 100755 (executable)
index d075062..0000000
--- a/t/pragma/overload.t
+++ /dev/null
@@ -1,1050 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-package Oscalar;
-use overload ( 
-                               # Anonymous subroutines:
-'+'    =>      sub {new Oscalar $ {$_[0]}+$_[1]},
-'-'    =>      sub {new Oscalar
-                      $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]},
-'<=>'  =>      sub {new Oscalar
-                      $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]},
-'cmp'  =>      sub {new Oscalar
-                      $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])},
-'*'    =>      sub {new Oscalar ${$_[0]}*$_[1]},
-'/'    =>      sub {new Oscalar 
-                      $_[2]? $_[1]/${$_[0]} :
-                        ${$_[0]}/$_[1]},
-'%'    =>      sub {new Oscalar
-                      $_[2]? $_[1]%${$_[0]} : ${$_[0]}%$_[1]},
-'**'   =>      sub {new Oscalar
-                      $_[2]? $_[1]**${$_[0]} : ${$_[0]}-$_[1]},
-
-qw(
-""     stringify
-0+     numify)                 # Order of arguments unsignificant
-);
-
-sub new {
-  my $foo = $_[1];
-  bless \$foo, $_[0];
-}
-
-sub stringify { "${$_[0]}" }
-sub numify { 0 + "${$_[0]}" }  # Not needed, additional overhead
-                               # comparing to direct compilation based on
-                               # stringify
-
-package main;
-
-$test = 0;
-$| = 1;
-print "1..",&last,"\n";
-
-sub test {
-  $test++; 
-  if (@_ > 1) {
-    if ($_[0] eq $_[1]) {
-      print "ok $test\n";
-    } else {
-      print "not ok $test: '$_[0]' ne '$_[1]'\n";
-    }
-  } else {
-    if (shift) {
-      print "ok $test\n";
-    } else {
-      print "not ok $test\n";
-    } 
-  }
-}
-
-$a = new Oscalar "087";
-$b= "$a";
-
-# All test numbers in comments are off by 1.
-# So much for hard-wiring them in :-) To fix this:
-test(1);                       # 1
-
-test ($b eq $a);               # 2
-test ($b eq "087");            # 3
-test (ref $a eq "Oscalar");    # 4
-test ($a eq $a);               # 5
-test ($a eq "087");            # 6
-
-$c = $a + 7;
-
-test (ref $c eq "Oscalar");    # 7
-test (!($c eq $a));            # 8
-test ($c eq "94");             # 9
-
-$b=$a;
-
-test (ref $a eq "Oscalar");    # 10
-
-$b++;
-
-test (ref $b eq "Oscalar");    # 11
-test ( $a eq "087");           # 12
-test ( $b eq "88");            # 13
-test (ref $a eq "Oscalar");    # 14
-
-$c=$b;
-$c-=$a;
-
-test (ref $c eq "Oscalar");    # 15
-test ( $a eq "087");           # 16
-test ( $c eq "1");             # 17
-test (ref $a eq "Oscalar");    # 18
-
-$b=1;
-$b+=$a;
-
-test (ref $b eq "Oscalar");    # 19
-test ( $a eq "087");           # 20
-test ( $b eq "88");            # 21
-test (ref $a eq "Oscalar");    # 22
-
-eval q[ package Oscalar; use overload ('++' => sub { $ {$_[0]}++;$_[0] } ) ];
-
-$b=$a;
-
-test (ref $a eq "Oscalar");    # 23
-
-$b++;
-
-test (ref $b eq "Oscalar");    # 24
-test ( $a eq "087");           # 25
-test ( $b eq "88");            # 26
-test (ref $a eq "Oscalar");    # 27
-
-package Oscalar;
-$dummy=bless \$dummy;          # Now cache of method should be reloaded
-package main;
-
-$b=$a;
-$b++;                          
-
-test (ref $b eq "Oscalar");    # 28
-test ( $a eq "087");           # 29
-test ( $b eq "88");            # 30
-test (ref $a eq "Oscalar");    # 31
-
-undef $b;                      # Destroying updates tables too...
-
-eval q[package Oscalar; use overload ('++' => sub { $ {$_[0]} += 2; $_[0] } ) ];
-
-$b=$a;
-
-test (ref $a eq "Oscalar");    # 32
-
-$b++;
-
-test (ref $b eq "Oscalar");    # 33
-test ( $a eq "087");           # 34
-test ( $b eq "88");            # 35
-test (ref $a eq "Oscalar");    # 36
-
-package Oscalar;
-$dummy=bless \$dummy;          # Now cache of method should be reloaded
-package main;
-
-$b++;                          
-
-test (ref $b eq "Oscalar");    # 37
-test ( $a eq "087");           # 38
-test ( $b eq "90");            # 39
-test (ref $a eq "Oscalar");    # 40
-
-$b=$a;
-$b++;
-
-test (ref $b eq "Oscalar");    # 41
-test ( $a eq "087");           # 42
-test ( $b eq "89");            # 43
-test (ref $a eq "Oscalar");    # 44
-
-
-test ($b? 1:0);                        # 45
-
-eval q[ package Oscalar; use overload ('=' => sub {$main::copies++; 
-                                                  package Oscalar;
-                                                  local $new=$ {$_[0]};
-                                                  bless \$new } ) ];
-
-$b=new Oscalar "$a";
-
-test (ref $b eq "Oscalar");    # 46
-test ( $a eq "087");           # 47
-test ( $b eq "087");           # 48
-test (ref $a eq "Oscalar");    # 49
-
-$b++;
-
-test (ref $b eq "Oscalar");    # 50
-test ( $a eq "087");           # 51
-test ( $b eq "89");            # 52
-test (ref $a eq "Oscalar");    # 53
-test ($copies == 0);           # 54
-
-$b+=1;
-
-test (ref $b eq "Oscalar");    # 55
-test ( $a eq "087");           # 56
-test ( $b eq "90");            # 57
-test (ref $a eq "Oscalar");    # 58
-test ($copies == 0);           # 59
-
-$b=$a;
-$b+=1;
-
-test (ref $b eq "Oscalar");    # 60
-test ( $a eq "087");           # 61
-test ( $b eq "88");            # 62
-test (ref $a eq "Oscalar");    # 63
-test ($copies == 0);           # 64
-
-$b=$a;
-$b++;
-
-test (ref $b eq "Oscalar") || print ref $b,"=ref(b)\n";        # 65
-test ( $a eq "087");           # 66
-test ( $b eq "89");            # 67
-test (ref $a eq "Oscalar");    # 68
-test ($copies == 1);           # 69
-
-eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
-                                                  $_[0] } ) ];
-$c=new Oscalar;                        # Cause rehash
-
-$b=$a;
-$b+=1;
-
-test (ref $b eq "Oscalar");    # 70
-test ( $a eq "087");           # 71
-test ( $b eq "90");            # 72
-test (ref $a eq "Oscalar");    # 73
-test ($copies == 2);           # 74
-
-$b+=$b;
-
-test (ref $b eq "Oscalar");    # 75
-test ( $b eq "360");           # 76
-test ($copies == 2);           # 77
-$b=-$b;
-
-test (ref $b eq "Oscalar");    # 78
-test ( $b eq "-360");          # 79
-test ($copies == 2);           # 80
-
-$b=abs($b);
-
-test (ref $b eq "Oscalar");    # 81
-test ( $b eq "360");           # 82
-test ($copies == 2);           # 83
-
-$b=abs($b);
-
-test (ref $b eq "Oscalar");    # 84
-test ( $b eq "360");           # 85
-test ($copies == 2);           # 86
-
-eval q[package Oscalar; 
-       use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]}
-                                             : "_.${$_[0]}._" x $_[1])}) ];
-
-$a=new Oscalar "yy";
-$a x= 3;
-test ($a eq "_.yy.__.yy.__.yy._"); # 87
-
-eval q[package Oscalar; 
-       use overload ('.' => sub {new Oscalar ( $_[2] ? 
-                                             "_.$_[1].__.$ {$_[0]}._"
-                                             : "_.$ {$_[0]}.__.$_[1]._")}) ];
-
-$a=new Oscalar "xx";
-
-test ("b${a}c" eq "_._.b.__.xx._.__.c._"); # 88
-
-# Check inheritance of overloading;
-{
-  package OscalarI;
-  @ISA = 'Oscalar';
-}
-
-$aI = new OscalarI "$a";
-test (ref $aI eq "OscalarI");  # 89
-test ("$aI" eq "xx");          # 90
-test ($aI eq "xx");            # 91
-test ("b${aI}c" eq "_._.b.__.xx._.__.c._");            # 92
-
-# Here we test blessing to a package updates hash
-
-eval "package Oscalar; no overload '.'";
-
-test ("b${a}" eq "_.b.__.xx._"); # 93
-$x="1";
-bless \$x, Oscalar;
-test ("b${a}c" eq "bxxc");     # 94
-new Oscalar 1;
-test ("b${a}c" eq "bxxc");     # 95
-
-# Negative overloading:
-
-$na = eval { ~$a };
-test($@ =~ /no method found/); # 96
-
-# Check AUTOLOADING:
-
-*Oscalar::AUTOLOAD = 
-  sub { *{"Oscalar::$AUTOLOAD"} = sub {"_!_" . shift() . "_!_"} ;
-       goto &{"Oscalar::$AUTOLOAD"}};
-
-eval "package Oscalar; sub comple; use overload '~' => 'comple'";
-
-$na = eval { ~$a };            # Hash was not updated
-test($@ =~ /no method found/); # 97
-
-bless \$x, Oscalar;
-
-$na = eval { ~$a };            # Hash updated
-warn "`$na', $@" if $@;
-test !$@;                      # 98
-test($na eq '_!_xx_!_');       # 99
-
-$na = 0;
-
-$na = eval { ~$aI };           # Hash was not updated
-test($@ =~ /no method found/); # 100
-
-bless \$x, OscalarI;
-
-$na = eval { ~$aI };
-print $@;
-
-test !$@;                      # 101
-test($na eq '_!_xx_!_');       # 102
-
-eval "package Oscalar; sub rshft; use overload '>>' => 'rshft'";
-
-$na = eval { $aI >> 1 };       # Hash was not updated
-test($@ =~ /no method found/); # 103
-
-bless \$x, OscalarI;
-
-$na = 0;
-
-$na = eval { $aI >> 1 };
-print $@;
-
-test !$@;                      # 104
-test($na eq '_!_xx_!_');       # 105
-
-# warn overload::Method($a, '0+'), "\n";
-test (overload::Method($a, '0+') eq \&Oscalar::numify); # 106
-test (overload::Method($aI,'0+') eq \&Oscalar::numify); # 107
-test (overload::Overloaded($aI)); # 108
-test (!overload::Overloaded('overload')); # 109
-
-test (! defined overload::Method($aI, '<<')); # 110
-test (! defined overload::Method($a, '<')); # 111
-
-test (overload::StrVal($aI) =~ /^OscalarI=SCALAR\(0x[\da-fA-F]+\)$/); # 112
-test (overload::StrVal(\$aI) eq "@{[\$aI]}"); # 113
-
-# Check overloading by methods (specified deep in the ISA tree).
-{
-  package OscalarII;
-  @ISA = 'OscalarI';
-  sub Oscalar::lshft {"_<<_" . shift() . "_<<_"}
-  eval "package OscalarI; use overload '<<' => 'lshft', '|' => 'lshft'";
-}
-
-$aaII = "087";
-$aII = \$aaII;
-bless $aII, 'OscalarII';
-bless \$fake, 'OscalarI';              # update the hash
-test(($aI | 3) eq '_<<_xx_<<_');       # 114
-# warn $aII << 3;
-test(($aII << 3) eq '_<<_087_<<_');    # 115
-
-{
-  BEGIN { $int = 7; overload::constant 'integer' => sub {$int++; shift}; }
-  $out = 2**10;
-}
-test($int, 9);         # 116
-test($out, 1024);              # 117
-
-$foo = 'foo';
-$foo1 = 'f\'o\\o';
-{
-  BEGIN { $q = $qr = 7; 
-         overload::constant 'q' => sub {$q++; push @q, shift, ($_[1] || 'none'); shift},
-                            'qr' => sub {$qr++; push @qr, shift, ($_[1] || 'none'); shift}; }
-  $out = 'foo';
-  $out1 = 'f\'o\\o';
-  $out2 = "a\a$foo,\,";
-  /b\b$foo.\./;
-}
-
-test($out, 'foo');             # 118
-test($out, $foo);              # 119
-test($out1, 'f\'o\\o');                # 120
-test($out1, $foo1);            # 121
-test($out2, "a\afoo,\,");      # 122
-test("@q", "foo q f'o\\\\o q a\\a qq ,\\, qq");        # 123
-test($q, 11);                  # 124
-test("@qr", "b\\b qq .\\. qq");        # 125
-test($qr, 9);                  # 126
-
-{
-  $_ = '!<b>!foo!<-.>!';
-  BEGIN { overload::constant 'q' => sub {push @q1, shift, ($_[1] || 'none'); "_<" . (shift) . ">_"},
-                            'qr' => sub {push @qr1, shift, ($_[1] || 'none'); "!<" . (shift) . ">!"}; }
-  $out = 'foo';
-  $out1 = 'f\'o\\o';
-  $out2 = "a\a$foo,\,";
-  $res = /b\b$foo.\./;
-  $a = <<EOF;
-oups
-EOF
-  $b = <<'EOF';
-oups1
-EOF
-  $c = bareword;
-  m'try it';
-  s'first part'second part';
-  s/yet another/tail here/;
-  tr/A-Z/a-z/;
-}
-
-test($out, '_<foo>_');         # 117
-test($out1, '_<f\'o\\o>_');            # 128
-test($out2, "_<a\a>_foo_<,\,>_");      # 129
-test("@q1", "foo q f'o\\\\o q a\\a qq ,\\, qq oups
- qq oups1
- q second part q tail here s A-Z tr a-z tr");  # 130
-test("@qr1", "b\\b qq .\\. qq try it q first part q yet another qq");  # 131
-test($res, 1);                 # 132
-test($a, "_<oups
->_");  # 133
-test($b, "_<oups1
->_");  # 134
-test($c, "bareword");  # 135
-
-{
-  package symbolic;            # Primitive symbolic calculator
-  use overload nomethod => \&wrap, '""' => \&str, '0+' => \&num,
-      '=' => \&cpy, '++' => \&inc, '--' => \&dec;
-
-  sub new { shift; bless ['n', @_] }
-  sub cpy {
-    my $self = shift;
-    bless [@$self], ref $self;
-  }
-  sub inc { $_[0] = bless ['++', $_[0], 1]; }
-  sub dec { $_[0] = bless ['--', $_[0], 1]; }
-  sub wrap {
-    my ($obj, $other, $inv, $meth) = @_;
-    if ($meth eq '++' or $meth eq '--') {
-      @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
-      return $obj;
-    }
-    ($obj, $other) = ($other, $obj) if $inv;
-    bless [$meth, $obj, $other];
-  }
-  sub str {
-    my ($meth, $a, $b) = @{+shift};
-    $a = 'u' unless defined $a;
-    if (defined $b) {
-      "[$meth $a $b]";
-    } else {
-      "[$meth $a]";
-    }
-  } 
-  my %subr = ( 'n' => sub {$_[0]} );
-  foreach my $op (split " ", $overload::ops{with_assign}) {
-    $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
-  }
-  my @bins = qw(binary 3way_comparison num_comparison str_comparison);
-  foreach my $op (split " ", "@overload::ops{ @bins }") {
-    $subr{$op} = eval "sub {shift() $op shift()}";
-  }
-  foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
-    $subr{$op} = eval "sub {$op shift()}";
-  }
-  $subr{'++'} = $subr{'+'};
-  $subr{'--'} = $subr{'-'};
-  
-  sub num {
-    my ($meth, $a, $b) = @{+shift};
-    my $subr = $subr{$meth} 
-      or die "Do not know how to ($meth) in symbolic";
-    $a = $a->num if ref $a eq __PACKAGE__;
-    $b = $b->num if ref $b eq __PACKAGE__;
-    $subr->($a,$b);
-  }
-  sub TIESCALAR { my $pack = shift; $pack->new(@_) }
-  sub FETCH { shift }
-  sub nop {  }         # Around a bug
-  sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
-  sub STORE { 
-    my $obj = shift; 
-    $#$obj = 1; 
-    $obj->[1] = shift;
-  }
-}
-
-{
-  my $foo = new symbolic 11;
-  my $baz = $foo++;
-  test( (sprintf "%d", $foo), '12');
-  test( (sprintf "%d", $baz), '11');
-  my $bar = $foo;
-  $baz = ++$foo;
-  test( (sprintf "%d", $foo), '13');
-  test( (sprintf "%d", $bar), '12');
-  test( (sprintf "%d", $baz), '13');
-  my $ban = $foo;
-  $baz = ($foo += 1);
-  test( (sprintf "%d", $foo), '14');
-  test( (sprintf "%d", $bar), '12');
-  test( (sprintf "%d", $baz), '14');
-  test( (sprintf "%d", $ban), '13');
-  $baz = 0;
-  $baz = $foo++;
-  test( (sprintf "%d", $foo), '15');
-  test( (sprintf "%d", $baz), '14');
-  test( "$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
-}
-
-{
-  my $iter = new symbolic 2;
-  my $side = new symbolic 1;
-  my $cnt = $iter;
-  
-  while ($cnt) {
-    $cnt = $cnt - 1;           # The "simple" way
-    $side = (sqrt(1 + $side**2) - 1)/$side;
-  }
-  my $pi = $side*(2**($iter+2));
-  test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
-  test( (sprintf "%f", $pi), '3.182598');
-}
-
-{
-  my $iter = new symbolic 2;
-  my $side = new symbolic 1;
-  my $cnt = $iter;
-  
-  while ($cnt--) {
-    $side = (sqrt(1 + $side**2) - 1)/$side;
-  }
-  my $pi = $side*(2**($iter+2));
-  test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
-  test( (sprintf "%f", $pi), '3.182598');
-}
-
-{
-  my ($a, $b);
-  symbolic->vars($a, $b);
-  my $c = sqrt($a**2 + $b**2);
-  $a = 3; $b = 4;
-  test( (sprintf "%d", $c), '5');
-  $a = 12; $b = 5;
-  test( (sprintf "%d", $c), '13');
-}
-
-{
-  package symbolic1;           # Primitive symbolic calculator
-  # Mutator inc/dec
-  use overload nomethod => \&wrap, '""' => \&str, '0+' => \&num, '=' => \&cpy;
-
-  sub new { shift; bless ['n', @_] }
-  sub cpy {
-    my $self = shift;
-    bless [@$self], ref $self;
-  }
-  sub wrap {
-    my ($obj, $other, $inv, $meth) = @_;
-    if ($meth eq '++' or $meth eq '--') {
-      @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
-      return $obj;
-    }
-    ($obj, $other) = ($other, $obj) if $inv;
-    bless [$meth, $obj, $other];
-  }
-  sub str {
-    my ($meth, $a, $b) = @{+shift};
-    $a = 'u' unless defined $a;
-    if (defined $b) {
-      "[$meth $a $b]";
-    } else {
-      "[$meth $a]";
-    }
-  } 
-  my %subr = ( 'n' => sub {$_[0]} );
-  foreach my $op (split " ", $overload::ops{with_assign}) {
-    $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
-  }
-  my @bins = qw(binary 3way_comparison num_comparison str_comparison);
-  foreach my $op (split " ", "@overload::ops{ @bins }") {
-    $subr{$op} = eval "sub {shift() $op shift()}";
-  }
-  foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
-    $subr{$op} = eval "sub {$op shift()}";
-  }
-  $subr{'++'} = $subr{'+'};
-  $subr{'--'} = $subr{'-'};
-  
-  sub num {
-    my ($meth, $a, $b) = @{+shift};
-    my $subr = $subr{$meth} 
-      or die "Do not know how to ($meth) in symbolic";
-    $a = $a->num if ref $a eq __PACKAGE__;
-    $b = $b->num if ref $b eq __PACKAGE__;
-    $subr->($a,$b);
-  }
-  sub TIESCALAR { my $pack = shift; $pack->new(@_) }
-  sub FETCH { shift }
-  sub nop {  }         # Around a bug
-  sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
-  sub STORE { 
-    my $obj = shift; 
-    $#$obj = 1; 
-    $obj->[1] = shift;
-  }
-}
-
-{
-  my $foo = new symbolic1 11;
-  my $baz = $foo++;
-  test( (sprintf "%d", $foo), '12');
-  test( (sprintf "%d", $baz), '11');
-  my $bar = $foo;
-  $baz = ++$foo;
-  test( (sprintf "%d", $foo), '13');
-  test( (sprintf "%d", $bar), '12');
-  test( (sprintf "%d", $baz), '13');
-  my $ban = $foo;
-  $baz = ($foo += 1);
-  test( (sprintf "%d", $foo), '14');
-  test( (sprintf "%d", $bar), '12');
-  test( (sprintf "%d", $baz), '14');
-  test( (sprintf "%d", $ban), '13');
-  $baz = 0;
-  $baz = $foo++;
-  test( (sprintf "%d", $foo), '15');
-  test( (sprintf "%d", $baz), '14');
-  test( "$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
-}
-
-{
-  my $iter = new symbolic1 2;
-  my $side = new symbolic1 1;
-  my $cnt = $iter;
-  
-  while ($cnt) {
-    $cnt = $cnt - 1;           # The "simple" way
-    $side = (sqrt(1 + $side**2) - 1)/$side;
-  }
-  my $pi = $side*(2**($iter+2));
-  test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
-  test( (sprintf "%f", $pi), '3.182598');
-}
-
-{
-  my $iter = new symbolic1 2;
-  my $side = new symbolic1 1;
-  my $cnt = $iter;
-  
-  while ($cnt--) {
-    $side = (sqrt(1 + $side**2) - 1)/$side;
-  }
-  my $pi = $side*(2**($iter+2));
-  test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
-  test( (sprintf "%f", $pi), '3.182598');
-}
-
-{
-  my ($a, $b);
-  symbolic1->vars($a, $b);
-  my $c = sqrt($a**2 + $b**2);
-  $a = 3; $b = 4;
-  test( (sprintf "%d", $c), '5');
-  $a = 12; $b = 5;
-  test( (sprintf "%d", $c), '13');
-}
-
-{
-  package two_face;            # Scalars with separate string and
-                                # numeric values.
-  sub new { my $p = shift; bless [@_], $p }
-  use overload '""' => \&str, '0+' => \&num, fallback => 1;
-  sub num {shift->[1]}
-  sub str {shift->[0]}
-}
-
-{
-  my $seven = new two_face ("vii", 7);
-  test( (sprintf "seven=$seven, seven=%d, eight=%d", $seven, $seven+1),
-       'seven=vii, seven=7, eight=8');
-  test( scalar ($seven =~ /i/), '1')
-}
-
-{
-  package sorting;
-  use overload 'cmp' => \&comp;
-  sub new { my ($p, $v) = @_; bless \$v, $p }
-  sub comp { my ($x,$y) = @_; ($$x * 3 % 10) <=> ($$y * 3 % 10) or $$x cmp $$y }
-}
-{
-  my @arr = map sorting->new($_), 0..12;
-  my @sorted1 = sort @arr;
-  my @sorted2 = map $$_, @sorted1;
-  test "@sorted2", '0 10 7 4 1 11 8 5 12 2 9 6 3';
-}
-{
-  package iterator;
-  use overload '<>' => \&iter;
-  sub new { my ($p, $v) = @_; bless \$v, $p }
-  sub iter { my ($x) = @_; return undef if $$x < 0; return $$x--; }
-}
-
-# XXX iterator overload not intended to work with CORE::GLOBAL?
-if (defined &CORE::GLOBAL::glob) {
-  test '1', '1';       # 175
-  test '1', '1';       # 176
-  test '1', '1';       # 177
-}
-else {
-  my $iter = iterator->new(5);
-  my $acc = '';
-  my $out;
-  $acc .= " $out" while $out = <${iter}>;
-  test $acc, ' 5 4 3 2 1 0';   # 175
-  $iter = iterator->new(5);
-  test scalar <${iter}>, '5';  # 176
-  $acc = '';
-  $acc .= " $out" while $out = <$iter>;
-  test $acc, ' 4 3 2 1 0';     # 177
-}
-{
-  package deref;
-  use overload '%{}' => \&hderef, '&{}' => \&cderef, 
-    '*{}' => \&gderef, '${}' => \&sderef, '@{}' => \&aderef;
-  sub new { my ($p, $v) = @_; bless \$v, $p }
-  sub deref {
-    my ($self, $key) = (shift, shift);
-    my $class = ref $self;
-    bless $self, 'deref::dummy'; # Disable overloading of %{} 
-    my $out = $self->{$key};
-    bless $self, $class;       # Restore overloading
-    $out;
-  }
-  sub hderef {shift->deref('h')}
-  sub aderef {shift->deref('a')}
-  sub cderef {shift->deref('c')}
-  sub gderef {shift->deref('g')}
-  sub sderef {shift->deref('s')}
-}
-{
-  my $deref = bless { h => { foo => 5 , fake => 23 },
-                     c => sub {return shift() + 34},
-                     's' => \123,
-                     a => [11..13],
-                     g => \*srt,
-                   }, 'deref';
-  # Hash:
-  my @cont = sort %$deref;
-  if ("\t" eq "\011") { # ascii
-      test "@cont", '23 5 fake foo';   # 178
-  } 
-  else {                # ebcdic alpha-numeric sort order
-      test "@cont", 'fake foo 23 5';   # 178
-  }
-  my @keys = sort keys %$deref;
-  test "@keys", 'fake foo';    # 179
-  my @val = sort values %$deref;
-  test "@val", '23 5';         # 180
-  test $deref->{foo}, 5;       # 181
-  test defined $deref->{bar}, ''; # 182
-  my $key;
-  @keys = ();
-  push @keys, $key while $key = each %$deref;
-  @keys = sort @keys;
-  test "@keys", 'fake foo';    # 183  
-  test exists $deref->{bar}, ''; # 184
-  test exists $deref->{foo}, 1; # 185
-  # Code:
-  test $deref->(5), 39;                # 186
-  test &$deref(6), 40;         # 187
-  sub xxx_goto { goto &$deref }
-  test xxx_goto(7), 41;                # 188
-  my $srt = bless { c => sub {$b <=> $a}
-                 }, 'deref';
-  *srt = \&$srt;
-  my @sorted = sort srt 11, 2, 5, 1, 22;
-  test "@sorted", '22 11 5 2 1'; # 189
-  # Scalar
-  test $$deref, 123;           # 190
-  # Code
-  @sorted = sort $srt 11, 2, 5, 1, 22;
-  test "@sorted", '22 11 5 2 1'; # 191
-  # Array
-  test "@$deref", '11 12 13';  # 192
-  test $#$deref, '2';          # 193
-  my $l = @$deref;
-  test $l, 3;                  # 194
-  test $deref->[2], '13';              # 195
-  $l = pop @$deref;
-  test $l, 13;                 # 196
-  $l = 1;
-  test $deref->[$l], '12';     # 197
-  # Repeated dereference
-  my $double = bless { h => $deref,
-                    }, 'deref';
-  test $double->{foo}, 5;      # 198
-}
-
-{
-  package two_refs;
-  use overload '%{}' => \&gethash, '@{}' => sub { ${shift()} };
-  sub new { 
-    my $p = shift; 
-    bless \ [@_], $p;
-  }
-  sub gethash {
-    my %h;
-    my $self = shift;
-    tie %h, ref $self, $self;
-    \%h;
-  }
-
-  sub TIEHASH { my $p = shift; bless \ shift, $p }
-  my %fields;
-  my $i = 0;
-  $fields{$_} = $i++ foreach qw{zero one two three};
-  sub STORE { 
-    my $self = ${shift()};
-    my $key = $fields{shift()};
-    defined $key or die "Out of band access";
-    $$self->[$key] = shift;
-  }
-  sub FETCH { 
-    my $self = ${shift()};
-    my $key = $fields{shift()};
-    defined $key or die "Out of band access";
-    $$self->[$key];
-  }
-}
-
-my $bar = new two_refs 3,4,5,6;
-$bar->[2] = 11;
-test $bar->{two}, 11;          # 199
-$bar->{three} = 13;
-test $bar->[3], 13;            # 200
-
-{
-  package two_refs_o;
-  @ISA = ('two_refs');
-}
-
-$bar = new two_refs_o 3,4,5,6;
-$bar->[2] = 11;
-test $bar->{two}, 11;          # 201
-$bar->{three} = 13;
-test $bar->[3], 13;            # 202
-
-{
-  package two_refs1;
-  use overload '%{}' => sub { ${shift()}->[1] },
-               '@{}' => sub { ${shift()}->[0] };
-  sub new { 
-    my $p = shift; 
-    my $a = [@_];
-    my %h;
-    tie %h, $p, $a;
-    bless \ [$a, \%h], $p;
-  }
-  sub gethash {
-    my %h;
-    my $self = shift;
-    tie %h, ref $self, $self;
-    \%h;
-  }
-
-  sub TIEHASH { my $p = shift; bless \ shift, $p }
-  my %fields;
-  my $i = 0;
-  $fields{$_} = $i++ foreach qw{zero one two three};
-  sub STORE { 
-    my $a = ${shift()};
-    my $key = $fields{shift()};
-    defined $key or die "Out of band access";
-    $a->[$key] = shift;
-  }
-  sub FETCH { 
-    my $a = ${shift()};
-    my $key = $fields{shift()};
-    defined $key or die "Out of band access";
-    $a->[$key];
-  }
-}
-
-$bar = new two_refs_o 3,4,5,6;
-$bar->[2] = 11;
-test $bar->{two}, 11;          # 203
-$bar->{three} = 13;
-test $bar->[3], 13;            # 204
-
-{
-  package two_refs1_o;
-  @ISA = ('two_refs1');
-}
-
-$bar = new two_refs1_o 3,4,5,6;
-$bar->[2] = 11;
-test $bar->{two}, 11;          # 205
-$bar->{three} = 13;
-test $bar->[3], 13;            # 206
-
-{
-  package B;
-  use overload bool => sub { ${+shift} };
-}
-
-my $aaa;
-{ my $bbbb = 0; $aaa = bless \$bbbb, B }
-
-test !$aaa, 1;                 # 207
-
-unless ($aaa) {
-  test 'ok', 'ok';             # 208
-} else {
-  test 'is not', 'ok';         # 208
-}
-
-# check that overload isn't done twice by join
-{ my $c = 0;
-  package Join;
-  use overload '""' => sub { $c++ };
-  my $x = join '', bless([]), 'pq', bless([]);
-  main::test $x, '0pq1';               # 209
-};
-
-# Test module-specific warning
-{
-    # check the Odd number of arguments for overload::constant warning
-    my $a = "" ;
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    $x = eval ' overload::constant "integer" ; ' ;
-    test($a eq "") ; # 210
-    use warnings 'overload' ;
-    $x = eval ' overload::constant "integer" ; ' ;
-    test($a =~ /^Odd number of arguments for overload::constant at/) ; # 211
-}
-
-{
-    # check the `$_[0]' is not an overloadable type warning
-    my $a = "" ;
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    $x = eval ' overload::constant "fred" => sub {} ; ' ;
-    test($a eq "") ; # 212
-    use warnings 'overload' ;
-    $x = eval ' overload::constant "fred" => sub {} ; ' ;
-    test($a =~ /^`fred' is not an overloadable type at/); # 213
-}
-
-{
-    # check the `$_[1]' is not a code reference warning
-    my $a = "" ;
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    $x = eval ' overload::constant "integer" => 1; ' ;
-    test($a eq "") ; # 214
-    use warnings 'overload' ;
-    $x = eval ' overload::constant "integer" => 1; ' ;
-    test($a =~ /^`1' is not a code reference at/); # 215
-}
-
-{
-  my $c = 0;
-  package ov_int1;
-  use overload '""'    => sub { 3+shift->[0] },
-               '0+'    => sub { 10+shift->[0] },
-               'int'   => sub { 100+shift->[0] };
-  sub new {my $p = shift; bless [shift], $p}
-
-  package ov_int2;
-  use overload '""'    => sub { 5+shift->[0] },
-               '0+'    => sub { 30+shift->[0] },
-               'int'   => sub { 'ov_int1'->new(1000+shift->[0]) };
-  sub new {my $p = shift; bless [shift], $p}
-
-  package noov_int;
-  use overload '""'    => sub { 2+shift->[0] },
-               '0+'    => sub { 9+shift->[0] };
-  sub new {my $p = shift; bless [shift], $p}
-
-  package main;
-
-  my $x = new noov_int 11;
-  my $int_x = int $x;
-  main::test("$int_x" eq 20);                  # 216
-  $x = new ov_int1 31;
-  $int_x = int $x;
-  main::test("$int_x" eq 131);                 # 217
-  $x = new ov_int2 51;
-  $int_x = int $x;
-  main::test("$int_x" eq 1054);                        # 218
-}
-
-# make sure that we don't inifinitely recurse
-{
-  my $c = 0;
-  package Recurse;
-  use overload '""'    => sub { shift },
-               '0+'    => sub { shift },
-               'bool'  => sub { shift },
-               fallback => 1;
-  my $x = bless([]);
-  main::test("$x" =~ /Recurse=ARRAY/);         # 219
-  main::test($x);                               # 220
-  main::test($x+0 =~ /Recurse=ARRAY/);         # 221
-}
-
-# BugID 20010422.003
-package Foo;
-
-use overload
-  'bool' => sub { return !$_[0]->is_zero() || undef; }
-;
- 
-sub is_zero
-  {
-  my $self = shift;
-  return $self->{var} == 0;
-  }
-
-sub new
-  {
-  my $class = shift;
-  my $self =  {};
-  $self->{var} = shift;
-  bless $self,$class;
-  }
-
-package main;
-
-use strict;
-
-my $r = Foo->new(8);
-$r = Foo->new(0);
-
-test(($r || 0) == 0); # 222
-
-# Last test is:
-sub last {222}

diff --git a/t/pragma/strict-refs b/t/pragma/strict-refs
deleted file mode 100644 (file)
index 10599b0..0000000
--- a/t/pragma/strict-refs
+++ /dev/null
@@ -1,297 +0,0 @@
-Check strict refs functionality
-
-__END__
-
-# no strict, should build & run ok.
-my $fred ;
-$b = "fred" ;
-$a = $$b ;
-$c = ${"def"} ;
-$c = @{"def"} ;
-$c = %{"def"} ;
-$c = *{"def"} ;
-$c = \&{"def"} ;
-$c = def->[0];
-$c = def->{xyz};
-EXPECT
-
-########
-
-# strict refs - error
-use strict ;
-my $fred ;
-my $a = ${"fred"} ;
-EXPECT
-Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 5.
-########
-
-# strict refs - error
-use strict 'refs' ;
-my $fred ;
-my $a = ${"fred"} ;
-EXPECT
-Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 5.
-########
-
-# strict refs - error
-use strict 'refs' ;
-my $fred ;
-my $b = "fred" ;
-my $a = $$b ;
-EXPECT
-Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 6.
-########
-
-# strict refs - error
-use strict 'refs' ;
-my $b ;
-my $a = $$b ;
-EXPECT
-Can't use an undefined value as a SCALAR reference at - line 5.
-########
-
-# strict refs - error
-use strict 'refs' ;
-my $b ;
-my $a = @$b ;
-EXPECT
-Can't use an undefined value as an ARRAY reference at - line 5.
-########
-
-# strict refs - error
-use strict 'refs' ;
-my $b ;
-my $a = %$b ;
-EXPECT
-Can't use an undefined value as a HASH reference at - line 5.
-########
-
-# strict refs - error
-use strict 'refs' ;
-my $b ;
-my $a = *$b ;
-EXPECT
-Can't use an undefined value as a symbol reference at - line 5.
-########
-
-# strict refs - error
-use strict 'refs' ;
-my $a = fred->[0] ;
-EXPECT
-Can't use bareword ("fred") as an ARRAY ref while "strict refs" in use at - line 4.
-########
-
-# strict refs - error
-use strict 'refs' ;
-my $a = fred->{barney} ;
-EXPECT
-Can't use bareword ("fred") as a HASH ref while "strict refs" in use at - line 4.
-########
-
-# strict refs - no error
-use strict ;
-no strict 'refs' ;
-my $fred ;
-my $b = "fred" ;
-my $a = $$b ;
-use strict 'refs' ;
-EXPECT
-
-########
-
-# strict refs - no error
-use strict qw(subs vars) ;
-my $fred ;
-my $b = "fred" ;
-my $a = $$b ;
-use strict 'refs' ;
-EXPECT
-
-########
-
-# strict refs - no error
-my $fred ;
-my $b = "fred" ;
-my $a = $$b ;
-use strict 'refs' ;
-EXPECT
-
-########
-
-# strict refs - no error
-use strict 'refs' ;
-my $fred ;
-my $b = \$fred ;
-my $a = $$b ;
-EXPECT
-
-########
-
-# Check runtime scope of strict refs pragma
-use strict 'refs';
-my $fred ;
-my $b = "fred" ;
-{
-    no strict ;
-    my $a = $$b ;
-}
-my $a = $$b ;
-EXPECT
-Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 10.
-########
-
-# Check runtime scope of strict refs pragma
-no strict ;
-my $fred ;
-my $b = "fred" ;
-{
-    use strict 'refs' ;
-    my $a = $$b ;
-}
-my $a = $$b ;
-EXPECT
-Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
-########
-
-# Check runtime scope of strict refs pragma
-no strict ;
-my $fred ;
-my $b = "fred" ;
-{
-    use strict 'refs' ;
-    $a = sub { my $c = $$b ; }
-}
-&$a ;
-EXPECT
-Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
-########
-
-
---FILE-- abc
-my $a = ${"Fred"} ;
-1;
---FILE-- 
-use strict 'refs' ;
-require "./abc";
-EXPECT
-
-########
-
---FILE-- abc
-use strict 'refs' ;
-1;
---FILE-- 
-require "./abc";
-my $a = ${"Fred"} ;
-EXPECT
-
-########
-
---FILE-- abc
-use strict 'refs' ;
-my $a = ${"Fred"} ;
-1;
---FILE-- 
-${"Fred"} ;
-require "./abc";
-EXPECT
-Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at ./abc line 2.
-Compilation failed in require at - line 2.
-########
-
---FILE-- abc.pm
-use strict 'refs' ;
-my $a = ${"Fred"} ;
-1;
---FILE-- 
-my $a = ${"Fred"} ;
-use abc;
-EXPECT
-Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at abc.pm line 2.
-Compilation failed in require at - line 2.
-BEGIN failed--compilation aborted at - line 2.
-########
-
-# Check scope of pragma with eval
-no strict ;
-eval {
-    my $a = ${"Fred"} ;
-};
-print STDERR $@ ;
-my $a = ${"Fred"} ;
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-no strict ;
-eval {
-    use strict 'refs' ;
-    my $a = ${"Fred"} ;
-};
-print STDERR $@ ;
-my $a = ${"Fred"} ;
-EXPECT
-Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 6.
-########
-
-# Check scope of pragma with eval
-use strict 'refs' ;
-eval {
-    my $a = ${"Fred"} ;
-};
-print STDERR $@ ;
-EXPECT
-Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 5.
-########
-
-# Check scope of pragma with eval
-use strict 'refs' ;
-eval {
-    no strict ;
-    my $a = ${"Fred"} ;
-};
-print STDERR $@ ;
-my $a = ${"Fred"} ;
-EXPECT
-Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 9.
-########
-
-# Check scope of pragma with eval
-no strict ;
-eval '
-    my $a = ${"Fred"} ;
-'; print STDERR $@ ;
-my $a = ${"Fred"} ;
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-no strict ;
-eval q[ 
-    use strict 'refs' ;
-    my $a = ${"Fred"} ;
-]; print STDERR $@;
-EXPECT
-Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at (eval 1) line 3.
-########
-
-# Check scope of pragma with eval
-use strict 'refs' ;
-eval '
-    my $a = ${"Fred"} ;
-'; print STDERR $@ ;
-EXPECT
-Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at (eval 1) line 2.
-########
-
-# Check scope of pragma with eval
-use strict 'refs' ;
-eval '
-    no strict ;
-    my $a = ${"Fred"} ;
-'; print STDERR $@;
-my $a = ${"Fred"} ;
-EXPECT
-Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 8.

diff --git a/t/pragma/strict-subs b/t/pragma/strict-subs
deleted file mode 100644 (file)
index ed4fe7a..0000000
--- a/t/pragma/strict-subs
+++ /dev/null
@@ -1,319 +0,0 @@
-Check strict subs functionality
-
-__END__
-
-# no strict, should build & run ok.
-Fred ;
-my $fred ;
-$b = "fred" ;
-$a = $$b ;
-EXPECT
-
-########
-
-use strict qw(refs vars);
-Fred ;
-EXPECT
-
-########
-
-use strict ;
-no strict 'subs' ;
-Fred ;
-EXPECT
-
-########
-
-# strict subs - error
-use strict 'subs' ;
-Fred ;
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at - line 4.
-Execution of - aborted due to compilation errors.
-########
-
-# strict subs - error
-use strict 'subs' ;
-my @a = (A..Z);
-EXPECT
-Bareword "Z" not allowed while "strict subs" in use at - line 4.
-Bareword "A" not allowed while "strict subs" in use at - line 4.
-Execution of - aborted due to compilation errors.
-########
-
-# strict subs - error
-use strict 'subs' ;
-my $a = (B..Y);
-EXPECT
-Bareword "Y" not allowed while "strict subs" in use at - line 4.
-Bareword "B" not allowed while "strict subs" in use at - line 4.
-Execution of - aborted due to compilation errors.
-########
-
-# strict subs - error
-use strict ;
-Fred ;
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at - line 4.
-Execution of - aborted due to compilation errors.
-########
-
-# strict subs - no error
-use strict 'subs' ;
-sub Fred {}
-Fred ;
-EXPECT
-
-########
-
-# Check compile time scope of strict subs pragma
-use strict 'subs' ;
-{
-    no strict ;
-    my $a = Fred ;
-}
-my $a = Fred ;
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at - line 8.
-Execution of - aborted due to compilation errors.
-########
-
-# Check compile time scope of strict subs pragma
-no strict;
-{
-    use strict 'subs' ;
-    my $a = Fred ;
-}
-my $a = Fred ;
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at - line 6.
-Execution of - aborted due to compilation errors.
-########
-
-# Check compile time scope of strict vars pragma
-use strict 'vars' ;
-{
-    no strict ;
-    $joe = 1 ;
-}
-$joe = 1 ;
-EXPECT
-Variable "$joe" is not imported at - line 8.
-Global symbol "$joe" requires explicit package name at - line 8.
-Execution of - aborted due to compilation errors.
-########
-
-# Check compile time scope of strict vars pragma
-no strict;
-{
-    use strict 'vars' ;
-    $joe = 1 ;
-}
-$joe = 1 ;
-EXPECT
-Global symbol "$joe" requires explicit package name at - line 6.
-Execution of - aborted due to compilation errors.
-########
-
-# Check runtime scope of strict refs pragma
-use strict 'refs';
-my $fred ;
-my $b = "fred" ;
-{
-    no strict ;
-    my $a = $$b ;
-}
-my $a = $$b ;
-EXPECT
-Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 10.
-########
-
-# Check runtime scope of strict refs pragma
-no strict ;
-my $fred ;
-my $b = "fred" ;
-{
-    use strict 'refs' ;
-    my $a = $$b ;
-}
-my $a = $$b ;
-EXPECT
-Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
-########
-
-# Check runtime scope of strict refs pragma
-no strict ;
-my $fred ;
-my $b = "fred" ;
-{
-    use strict 'refs' ;
-    $a = sub { my $c = $$b ; }
-}
-&$a ;
-EXPECT
-Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
-########
-
-use strict 'subs' ;
-my $a = Fred ;
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at - line 3.
-Execution of - aborted due to compilation errors.
-########
-
---FILE-- abc
-my $a = Fred ;
-1;
---FILE-- 
-use strict 'subs' ;
-require "./abc";
-EXPECT
-
-########
-
---FILE-- abc
-use strict 'subs' ;
-1;
---FILE-- 
-require "./abc";
-my $a = Fred ;
-EXPECT
-
-########
-
---FILE-- abc
-use strict 'subs' ;
-my $a = Fred ;
-1;
---FILE-- 
-Fred ;
-require "./abc";
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at ./abc line 2.
-Compilation failed in require at - line 2.
-########
-
---FILE-- abc.pm
-use strict 'subs' ;
-my $a = Fred ;
-1;
---FILE-- 
-Fred ;
-use abc;
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at abc.pm line 2.
-Compilation failed in require at - line 2.
-BEGIN failed--compilation aborted at - line 2.
-########
-
-# Check scope of pragma with eval
-no strict ;
-eval {
-    my $a = Fred ;
-};
-print STDERR $@;
-my $a = Fred ;
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-no strict ;
-eval {
-    use strict 'subs' ;
-    my $a = Fred ;
-};
-print STDERR $@;
-my $a = Fred ;
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at - line 6.
-Execution of - aborted due to compilation errors.
-########
-
-# Check scope of pragma with eval
-use strict 'subs' ;
-eval {
-    my $a = Fred ;
-};
-print STDERR $@;
-my $a = Fred ;
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at - line 5.
-Bareword "Fred" not allowed while "strict subs" in use at - line 8.
-Execution of - aborted due to compilation errors.
-########
-
-# Check scope of pragma with eval
-use strict 'subs' ;
-eval {
-    no strict ;
-    my $a = Fred ;
-};
-print STDERR $@;
-my $a = Fred ;
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at - line 9.
-Execution of - aborted due to compilation errors.
-########
-
-# Check scope of pragma with eval
-no strict ;
-eval '
-    Fred ;
-'; print STDERR $@ ;
-Fred ;
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-no strict ;
-eval q[ 
-    use strict 'subs' ;
-    Fred ;
-]; print STDERR $@;
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at (eval 1) line 3.
-########
-
-# Check scope of pragma with eval
-use strict 'subs' ;
-eval '
-    Fred ;
-'; print STDERR $@ ;
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at (eval 1) line 2.
-########
-
-# Check scope of pragma with eval
-use strict 'subs' ;
-eval '
-    no strict ;
-    my $a = Fred ;
-'; print STDERR $@;
-my $a = Fred ;
-EXPECT
-Bareword "Fred" not allowed while "strict subs" in use at - line 8.
-Execution of - aborted due to compilation errors.
-########
-
-# see if Foo->Bar(...) etc work under strictures
-use strict;
-package Foo; sub Bar { print "@_\n" }
-Foo->Bar('a',1);
-Bar Foo ('b',2);
-Foo->Bar(qw/c 3/);
-Bar Foo (qw/d 4/);
-Foo::->Bar('A',1);
-Bar Foo:: ('B',2);
-Foo::->Bar(qw/C 3/);
-Bar Foo:: (qw/D 4/);
-EXPECT
-Foo a 1
-Foo b 2
-Foo c 3
-Foo d 4
-Foo A 1
-Foo B 2
-Foo C 3
-Foo D 4

diff --git a/t/pragma/strict-vars b/t/pragma/strict-vars
deleted file mode 100644 (file)
index 40b5557..0000000
--- a/t/pragma/strict-vars
+++ /dev/null
@@ -1,410 +0,0 @@
-Check strict vars functionality
-
-__END__
-
-# no strict, should build & run ok.
-Fred ;
-my $fred ;
-$b = "fred" ;
-$a = $$b ;
-EXPECT
-
-########
-
-use strict qw(subs refs) ;
-$fred ;
-EXPECT
-
-########
-
-use strict ;
-no strict 'vars' ;
-$fred ;
-EXPECT
-
-########
-
-# strict vars - no error
-use strict 'vars' ;
-use vars qw( $freddy) ;
-BEGIN { *freddy = \$joe::shmoe; }
-$freddy = 2 ;
-EXPECT
-
-########
-
-# strict vars - no error
-use strict 'vars' ;
-use vars qw( $freddy) ;
-local $abc::joe ;
-my $fred ;
-my $b = \$fred ;
-$Fred::ABC = 1 ;
-$freddy = 2 ;
-EXPECT
-
-########
-
-# strict vars - error
-use strict ;
-$fred ;
-EXPECT
-Global symbol "$fred" requires explicit package name at - line 4.
-Execution of - aborted due to compilation errors.
-########
-
-# strict vars - error
-use strict 'vars' ;
-<$fred> ;
-EXPECT
-Global symbol "$fred" requires explicit package name at - line 4.
-Execution of - aborted due to compilation errors.
-########
-
-# strict vars - error
-use strict 'vars' ;
-local $fred ;
-EXPECT
-Global symbol "$fred" requires explicit package name at - line 4.
-Execution of - aborted due to compilation errors.
-########
-
-# Check compile time scope of strict vars pragma
-use strict 'vars' ;
-{
-    no strict ;
-    $joe = 1 ;
-}
-$joe = 1 ;
-EXPECT
-Variable "$joe" is not imported at - line 8.
-Global symbol "$joe" requires explicit package name at - line 8.
-Execution of - aborted due to compilation errors.
-########
-
-# Check compile time scope of strict vars pragma
-no strict;
-{
-    use strict 'vars' ;
-    $joe = 1 ;
-}
-$joe = 1 ;
-EXPECT
-Global symbol "$joe" requires explicit package name at - line 6.
-Execution of - aborted due to compilation errors.
-########
-
---FILE-- abc
-$joe = 1 ;
-1;
---FILE-- 
-use strict 'vars' ;
-require "./abc";
-EXPECT
-
-########
-
---FILE-- abc
-use strict 'vars' ;
-1;
---FILE-- 
-require "./abc";
-$joe = 1 ;
-EXPECT
-
-########
-
---FILE-- abc
-use strict 'vars' ;
-$joe = 1 ;
-1;
---FILE-- 
-$joe = 1 ;
-require "./abc";
-EXPECT
-Variable "$joe" is not imported at ./abc line 2.
-Global symbol "$joe" requires explicit package name at ./abc line 2.
-Compilation failed in require at - line 2.
-########
-
---FILE-- abc.pm
-use strict 'vars' ;
-$joe = 1 ;
-1;
---FILE-- 
-$joe = 1 ;
-use abc;
-EXPECT
-Variable "$joe" is not imported at abc.pm line 2.
-Global symbol "$joe" requires explicit package name at abc.pm line 2.
-Compilation failed in require at - line 2.
-BEGIN failed--compilation aborted at - line 2.
-########
-
---FILE-- abc.pm
-package Burp;
-use strict;
-$a = 1;$f = 1;$k = 1; # just to get beyond the limit...
-$b = 1;$g = 1;$l = 1;
-$c = 1;$h = 1;$m = 1;
-$d = 1;$i = 1;$n = 1;
-$e = 1;$j = 1;$o = 1;
-$p = 0b12;
---FILE-- 
-use abc;
-EXPECT
-Global symbol "$f" requires explicit package name at abc.pm line 3.
-Global symbol "$k" requires explicit package name at abc.pm line 3.
-Global symbol "$g" requires explicit package name at abc.pm line 4.
-Global symbol "$l" requires explicit package name at abc.pm line 4.
-Global symbol "$c" requires explicit package name at abc.pm line 5.
-Global symbol "$h" requires explicit package name at abc.pm line 5.
-Global symbol "$m" requires explicit package name at abc.pm line 5.
-Global symbol "$d" requires explicit package name at abc.pm line 6.
-Global symbol "$i" requires explicit package name at abc.pm line 6.
-Global symbol "$n" requires explicit package name at abc.pm line 6.
-Global symbol "$e" requires explicit package name at abc.pm line 7.
-Global symbol "$j" requires explicit package name at abc.pm line 7.
-Global symbol "$o" requires explicit package name at abc.pm line 7.
-Global symbol "$p" requires explicit package name at abc.pm line 8.
-Illegal binary digit '2' at abc.pm line 8, at end of line
-abc.pm has too many errors.
-Compilation failed in require at - line 1.
-BEGIN failed--compilation aborted at - line 1.
-########
-
-# Check scope of pragma with eval
-no strict ;
-eval {
-    $joe = 1 ;
-};
-print STDERR $@;
-$joe = 1 ;
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-no strict ;
-eval {
-    use strict 'vars' ;
-    $joe = 1 ;
-};
-print STDERR $@;
-$joe = 1 ;
-EXPECT
-Global symbol "$joe" requires explicit package name at - line 6.
-Execution of - aborted due to compilation errors.
-########
-
-# Check scope of pragma with eval
-use strict 'vars' ;
-eval {
-    $joe = 1 ;
-};
-print STDERR $@;
-$joe = 1 ;
-EXPECT
-Global symbol "$joe" requires explicit package name at - line 5.
-Global symbol "$joe" requires explicit package name at - line 8.
-Execution of - aborted due to compilation errors.
-########
-
-# Check scope of pragma with eval
-use strict 'vars' ;
-eval {
-    no strict ;
-    $joe = 1 ;
-};
-print STDERR $@;
-$joe = 1 ;
-EXPECT
-Variable "$joe" is not imported at - line 9.
-Global symbol "$joe" requires explicit package name at - line 9.
-Execution of - aborted due to compilation errors.
-########
-
-# Check scope of pragma with eval
-no strict ;
-eval '
-    $joe = 1 ;
-'; print STDERR $@ ;
-$joe = 1 ;
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-no strict ;
-eval q[ 
-    use strict 'vars' ;
-    $joe = 1 ;
-]; print STDERR $@;
-EXPECT
-Global symbol "$joe" requires explicit package name at (eval 1) line 3.
-########
-
-# Check scope of pragma with eval
-use strict 'vars' ;
-eval '
-    $joe = 1 ;
-'; print STDERR $@ ;
-EXPECT
-Global symbol "$joe" requires explicit package name at (eval 1) line 2.
-########
-
-# Check scope of pragma with eval
-use strict 'vars' ;
-eval '
-    no strict ;
-    $joe = 1 ;
-'; print STDERR $@;
-$joe = 1 ;
-EXPECT
-Global symbol "$joe" requires explicit package name at - line 8.
-Execution of - aborted due to compilation errors.
-########
-
-# Check if multiple evals produce same errors
-use strict 'vars';
-my $ret = eval q{ print $x; };
-print $@;
-print "ok 1\n" unless defined $ret;
-$ret = eval q{ print $x; };
-print $@;
-print "ok 2\n" unless defined $ret;
-EXPECT
-Global symbol "$x" requires explicit package name at (eval 1) line 1.
-ok 1
-Global symbol "$x" requires explicit package name at (eval 2) line 1.
-ok 2
-########
-
-# strict vars with outer our - no error
-use strict 'vars' ;
-our $freddy;
-local $abc::joe ;
-my $fred ;
-my $b = \$fred ;
-$Fred::ABC = 1 ;
-$freddy = 2 ;
-EXPECT
-
-########
-
-# strict vars with inner our - no error
-use strict 'vars' ;
-sub foo {
-    our $fred;
-    $fred;
-}
-EXPECT
-
-########
-
-# strict vars with outer our, inner use - no error
-use strict 'vars' ;
-our $fred;
-sub foo {
-    $fred;
-}
-EXPECT
-
-########
-
-# strict vars with nested our - no error
-use strict 'vars' ;
-our $fred;
-sub foo {
-    our $fred;
-    $fred;
-}
-$fred ;
-EXPECT
-
-########
-
-# strict vars with elapsed our - error
-use strict 'vars' ;
-sub foo {
-    our $fred;
-    $fred;
-}
-$fred ;
-EXPECT
-Variable "$fred" is not imported at - line 8.
-Global symbol "$fred" requires explicit package name at - line 8.
-Execution of - aborted due to compilation errors.
-########
-
-# nested our with local - no error
-$fred = 1;
-use strict 'vars';
-{
-    local our $fred = 2;
-    print $fred,"\n";
-}
-print our $fred,"\n";
-EXPECT
-2
-1
-########
-
-# "nailed" our declaration visibility across package boundaries
-use strict 'vars';
-our $foo;
-$foo = 20;
-package Foo;
-print $foo, "\n";
-EXPECT
-20
-########
-
-# multiple our declarations in same scope, different packages, no warning
-use strict 'vars';
-use warnings;
-our $foo;
-${foo} = 10;
-package Foo;
-our $foo = 20;
-print $foo, "\n";
-EXPECT
-20
-########
-
-# multiple our declarations in same scope, same package, warning
-use strict 'vars';
-use warnings;
-our $foo;
-${foo} = 10;
-our $foo;
-EXPECT
-"our" variable $foo masks earlier declaration in same scope at - line 7.
-########
-
-# multiple our declarations in same scope, same package, warning
-use strict 'vars';
-use warnings;
-{ our $x = 1 }
-{ our $x = 0 }
-our $foo;
-{
-    our $foo;
-    package Foo;
-    our $foo;
-}
-EXPECT
-"our" variable $foo redeclared at - line 9.
-       (Did you mean "local" instead of "our"?)
-Name "Foo::foo" used only once: possible typo at - line 11.
-########
-
-# Make sure the strict vars failure still occurs
-# now that the `@i should be written as \@i' failure does not occur
-# 20000522 mjd@plover.com (MJD)
-use strict 'vars';
-no warnings;
-"@i_like_crackers";
-EXPECT
-Global symbol "@i_like_crackers" requires explicit package name at - line 7.
-Execution of - aborted due to compilation errors.

diff --git a/t/pragma/strict.t b/t/pragma/strict.t
deleted file mode 100755 (executable)
index 8b9083f..0000000
--- a/t/pragma/strict.t
+++ /dev/null
@@ -1,100 +0,0 @@
-#!./perl 
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    $ENV{PERL5LIB} = '../lib';
-}
-
-$| = 1;
-
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MSWin32 = $^O eq 'MSWin32';
-my $Is_NetWare = $^O eq 'NetWare';
-my $tmpfile = "tmp0000";
-my $i = 0 ;
-1 while -f ++$tmpfile;
-END { if ($tmpfile) { 1 while unlink $tmpfile; } }
-
-my @prgs = () ;
-
-foreach (sort glob($^O eq 'MacOS' ? ":pragma:strict-*" : "pragma/strict-*")) {
-
-    next if /(~|\.orig|,v)$/;
-
-    open F, "<$_" or die "Cannot open $_: $!\n" ;
-    while (<F>) {
-       last if /^__END__/ ;
-    }
-
-    {
-        local $/ = undef;
-        @prgs = (@prgs, split "\n########\n", <F>) ;
-    }
-    close F ;
-}
-
-undef $/;
-
-print "1..", scalar @prgs, "\n";
- 
- 
-for (@prgs){
-    my $switch = "";
-    my @temps = () ;
-    if (s/^\s*-\w+//){
-        $switch = $&;
-    }
-    my($prog,$expected) = split(/\nEXPECT\n/, $_);
-    if ( $prog =~ /--FILE--/) {
-        my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
-       shift @files ;
-       die "Internal error test $i didn't split into pairs, got " . 
-               scalar(@files) . "[" . join("%%%%", @files) ."]\n"
-           if @files % 2 ;
-       while (@files > 2) {
-           my $filename = shift @files ;
-           my $code = shift @files ;
-           $code =~ s|\./abc|:abc|g if $^O eq 'MacOS';
-           push @temps, $filename ;
-           open F, ">$filename" or die "Cannot open $filename: $!\n" ;
-           print F $code ;
-           close F ;
-       }
-       shift @files ;
-       $prog = shift @files ;
-       $prog =~ s|\./abc|:abc|g if $^O eq 'MacOS';
-    }
-    open TEST, ">$tmpfile";
-    print TEST $prog,"\n";
-    close TEST;
-    my $results = $Is_MSWin32 ?
-                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
-                  $^O eq 'MacOS' ?
-                  `$^X -I::lib $switch $tmpfile` :
-                  $^O eq 'NetWare' ?
-                  `perl -I../lib $switch $tmpfile 2>&1` :
-                  `./perl $switch $tmpfile 2>&1`;
-    my $status = $?;
-    $results =~ s/\n+$//;
-    # allow expected output to be written as if $prog is on STDIN
-    $results =~ s/tmp\d+/-/g;
-    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
-    $expected =~ s/\n+$//;
-    $expected =~ s|(\./)?abc\.pm|:abc.pm|g if $^O eq 'MacOS';
-    $expected =~ s|./abc|:abc|g if $^O eq 'MacOS';
-    my $prefix = ($results =~ s/^PREFIX\n//) ;
-    if ( $results =~ s/^SKIPPED\n//) {
-       print "$results\n" ;
-    }
-    elsif (($prefix and $results !~ /^\Q$expected/) or
-          (!$prefix and $results ne $expected)){
-        print STDERR "PROG: $switch\n$prog\n";
-        print STDERR "EXPECTED:\n$expected\n";
-        print STDERR "GOT:\n$results\n";
-        print "not ";
-    }
-    print "ok ", ++$i, "\n";
-    foreach (@temps) 
-       { unlink $_ if $_ } 
-}

diff --git a/t/pragma/sub_lval.t b/t/pragma/sub_lval.t
deleted file mode 100755 (executable)
index e101f97..0000000
--- a/t/pragma/sub_lval.t
+++ /dev/null
@@ -1,533 +0,0 @@
-print "1..64\n";
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
-sub b : lvalue { ${\shift} }
-
-my $out = a(b());              # Check that temporaries are allowed.
-print "# `$out'\nnot " unless ref $out eq 'main'; # Not reached if error.
-print "ok 1\n";
-
-my @out = grep /main/, a(b()); # Check that temporaries are allowed.
-print "# `@out'\nnot " unless @out==1; # Not reached if error.
-print "ok 2\n";
-
-my $in;
-
-# Check that we can return localized values from subroutines:
-
-sub in : lvalue { $in = shift; }
-sub neg : lvalue {  #(num_str) return num_str
-    local $_ = shift;
-    s/^\+/-/;
-    $_;
-}
-in(neg("+2"));
-
-
-print "# `$in'\nnot " unless $in eq '-2';
-print "ok 3\n";
-
-sub get_lex : lvalue { $in }
-sub get_st : lvalue { $blah }
-sub id : lvalue { ${\shift} }
-sub id1 : lvalue { $_[0] }
-sub inc : lvalue { ${\++$_[0]} }
-
-$in = 5;
-$blah = 3;
-
-get_st = 7;
-
-print "# `$blah' ne 7\nnot " unless $blah eq 7;
-print "ok 4\n";
-
-get_lex = 7;
-
-print "# `$in' ne 7\nnot " unless $in eq 7;
-print "ok 5\n";
-
-++get_st;
-
-print "# `$blah' ne 8\nnot " unless $blah eq 8;
-print "ok 6\n";
-
-++get_lex;
-
-print "# `$in' ne 8\nnot " unless $in eq 8;
-print "ok 7\n";
-
-id(get_st) = 10;
-
-print "# `$blah' ne 10\nnot " unless $blah eq 10;
-print "ok 8\n";
-
-id(get_lex) = 10;
-
-print "# `$in' ne 10\nnot " unless $in eq 10;
-print "ok 9\n";
-
-++id(get_st);
-
-print "# `$blah' ne 11\nnot " unless $blah eq 11;
-print "ok 10\n";
-
-++id(get_lex);
-
-print "# `$in' ne 11\nnot " unless $in eq 11;
-print "ok 11\n";
-
-id1(get_st) = 20;
-
-print "# `$blah' ne 20\nnot " unless $blah eq 20;
-print "ok 12\n";
-
-id1(get_lex) = 20;
-
-print "# `$in' ne 20\nnot " unless $in eq 20;
-print "ok 13\n";
-
-++id1(get_st);
-
-print "# `$blah' ne 21\nnot " unless $blah eq 21;
-print "ok 14\n";
-
-++id1(get_lex);
-
-print "# `$in' ne 21\nnot " unless $in eq 21;
-print "ok 15\n";
-
-inc(get_st);
-
-print "# `$blah' ne 22\nnot " unless $blah eq 22;
-print "ok 16\n";
-
-inc(get_lex);
-
-print "# `$in' ne 22\nnot " unless $in eq 22;
-print "ok 17\n";
-
-inc(id(get_st));
-
-print "# `$blah' ne 23\nnot " unless $blah eq 23;
-print "ok 18\n";
-
-inc(id(get_lex));
-
-print "# `$in' ne 23\nnot " unless $in eq 23;
-print "ok 19\n";
-
-++inc(id1(id(get_st)));
-
-print "# `$blah' ne 25\nnot " unless $blah eq 25;
-print "ok 20\n";
-
-++inc(id1(id(get_lex)));
-
-print "# `$in' ne 25\nnot " unless $in eq 25;
-print "ok 21\n";
-
-@a = (1) x 3;
-@b = (undef) x 2;
-$#c = 3;                       # These slots are not fillable.
-
-# Explanation: empty slots contain &sv_undef.
-
-=for disabled constructs
-
-sub a3 :lvalue {@a}
-sub b2 : lvalue {@b}
-sub c4: lvalue {@c}
-
-$_ = '';
-
-eval <<'EOE' or $_ = $@;
-  ($x, a3, $y, b2, $z, c4, $t) = (34 .. 78);
-  1;
-EOE
-
-#@out = ($x, a3, $y, b2, $z, c4, $t);
-#@in = (34 .. 41, (undef) x 4, 46);
-#print "# `@out' ne `@in'\nnot " unless "@out" eq "@in";
-
-print "# '$_'.\nnot "
-  unless /Can\'t return an uninitialized value from lvalue subroutine/;
-=cut
-
-print "ok 22\n";
-
-my $var;
-
-sub a::var : lvalue { $var }
-
-"a"->var = 45;
-
-print "# `$var' ne 45\nnot " unless $var eq 45;
-print "ok 23\n";
-
-my $oo;
-$o = bless \$oo, "a";
-
-$o->var = 47;
-
-print "# `$var' ne 47\nnot " unless $var eq 47;
-print "ok 24\n";
-
-sub o : lvalue { $o }
-
-o->var = 49;
-
-print "# `$var' ne 49\nnot " unless $var eq 49;
-print "ok 25\n";
-
-sub nolv () { $x0, $x1 } # Not lvalue
-
-$_ = '';
-
-eval <<'EOE' or $_ = $@;
-  nolv = (2,3);
-  1;
-EOE
-
-print "not "
-  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
-print "ok 26\n";
-
-$_ = '';
-
-eval <<'EOE' or $_ = $@;
-  nolv = (2,3) if $_;
-  1;
-EOE
-
-print "not "
-  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
-print "ok 27\n";
-
-$_ = '';
-
-eval <<'EOE' or $_ = $@;
-  &nolv = (2,3) if $_;
-  1;
-EOE
-
-print "not "
-  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
-print "ok 28\n";
-
-$x0 = $x1 = $_ = undef;
-$nolv = \&nolv;
-
-eval <<'EOE' or $_ = $@;
-  $nolv->() = (2,3) if $_;
-  1;
-EOE
-
-print "# '$_', '$x0', '$x1'.\nnot " if defined $_;
-print "ok 29\n";
-
-$x0 = $x1 = $_ = undef;
-$nolv = \&nolv;
-
-eval <<'EOE' or $_ = $@;
-  $nolv->() = (2,3);
-  1;
-EOE
-
-print "# '$_', '$x0', '$x1'.\nnot "
-  unless /Can\'t modify non-lvalue subroutine call/;
-print "ok 30\n";
-
-sub lv0 : lvalue { }           # Converted to lv10 in scalar context
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  lv0 = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot "
-  unless /Can\'t return a readonly value from lvalue subroutine/;
-print "ok 31\n";
-
-sub lv10 : lvalue {}
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  (lv0) = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot " if defined $_;
-print "ok 32\n";
-
-sub lv1u :lvalue { undef }
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  lv1u = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot "
-  unless /Can\'t return a readonly value from lvalue subroutine/;
-print "ok 33\n";
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  (lv1u) = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot "
-  unless /Can\'t return an uninitialized value from lvalue subroutine/;
-print "ok 34\n";
-
-$x = '1234567';
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  sub lv1t : lvalue { index $x, 2 }
-  lv1t = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot "
-  unless /Can\'t modify index in lvalue subroutine return/;
-print "ok 35\n";
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  sub lv2t : lvalue { shift }
-  (lv2t) = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot "
-  unless /Can\'t modify shift in lvalue subroutine return/;
-print "ok 36\n";
-
-$xxx = 'xxx';
-sub xxx () { $xxx }  # Not lvalue
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  sub lv1tmp : lvalue { xxx }                  # is it a TEMP?
-  lv1tmp = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot "
-  unless /Can\'t modify non-lvalue subroutine call in lvalue subroutine return/;
-print "ok 37\n";
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  (lv1tmp) = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot "
-  unless /Can\'t return a temporary from lvalue subroutine/;
-print "ok 38\n";
-
-sub yyy () { 'yyy' } # Const, not lvalue
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  sub lv1tmpr : lvalue { yyy }                 # is it read-only?
-  lv1tmpr = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot "
-  unless /Can\'t modify constant item in lvalue subroutine return/;
-print "ok 39\n";
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  (lv1tmpr) = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot "
-  unless /Can\'t return a readonly value from lvalue subroutine/;
-print "ok 40\n";
-
-sub lva : lvalue {@a}
-
-$_ = undef;
-@a = ();
-$a[1] = 12;
-eval <<'EOE' or $_ = $@;
-  (lva) = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
-print "ok 41\n";
-
-$_ = undef;
-@a = ();
-$a[0] = undef;
-$a[1] = 12;
-eval <<'EOE' or $_ = $@;
-  (lva) = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
-print "ok 42\n";
-
-$_ = undef;
-@a = ();
-$a[0] = undef;
-$a[1] = 12;
-eval <<'EOE' or $_ = $@;
-  (lva) = (2,3);
-  1;
-EOE
-
-print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
-print "ok 43\n";
-
-sub lv1n : lvalue { $newvar }
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  lv1n = (3,4);
-  1;
-EOE
-
-print "# '$_', '$newvar'.\nnot " unless "'$newvar' $_" eq "'4' ";
-print "ok 44\n";
-
-sub lv1nn : lvalue { $nnewvar }
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  (lv1nn) = (3,4);
-  1;
-EOE
-
-print "# '$_'.\nnot " unless "'$nnewvar' $_" eq "'3' ";
-print "ok 45\n";
-
-$a = \&lv1nn;
-$a->() = 8;
-print "# '$nnewvar'.\nnot " unless $nnewvar eq '8';
-print "ok 46\n";
-
-# This must happen at run time
-eval {
-    sub AUTOLOAD : lvalue { $newvar };
-};
-foobar() = 12;
-print "# '$newvar'.\nnot " unless $newvar eq "12";
-print "ok 47\n";
-
-print "ok 48 # Skip: removed test\n";
-
-print "ok 49 # Skip: removed test\n";
-
-{
-my %hash; my @array;
-sub alv : lvalue { $array[1] }
-sub alv2 : lvalue { $array[$_[0]] }
-sub hlv : lvalue { $hash{"foo"} }
-sub hlv2 : lvalue { $hash{$_[0]} }
-$array[1] = "not ok 51\n";
-alv() = "ok 50\n";
-print alv();
-
-alv2(20) = "ok 51\n";
-print $array[20];
-
-$hash{"foo"} = "not ok 52\n";
-hlv() = "ok 52\n";
-print $hash{foo};
-
-$hash{bar} = "not ok 53\n";
-hlv("bar") = "ok 53\n";
-print hlv("bar");
-
-sub array : lvalue  { @array  }
-sub array2 : lvalue { @array2 } # This is a global.
-sub hash : lvalue   { %hash   }
-sub hash2 : lvalue  { %hash2  } # So's this.
-@array2 = qw(foo bar);
-%hash2 = qw(foo bar);
-
-(array()) = qw(ok 54);
-print "not " unless "@array" eq "ok 54";
-print "ok 54\n";
-
-(array2()) = qw(ok 55);
-print "not " unless "@array2" eq "ok 55";
-print "ok 55\n";
-
-(hash()) = qw(ok 56);
-print "not " unless $hash{ok} == 56;
-print "ok 56\n";
-
-(hash2()) = qw(ok 57);
-print "not " unless $hash2{ok} == 57;
-print "ok 57\n";
-
-@array = qw(a b c d);
-sub aslice1 : lvalue { @array[0,2] };
-(aslice1()) = ("ok", "already");
-print "# @array\nnot " unless "@array" eq "ok b already d";
-print "ok 58\n";
-
-@array2 = qw(a B c d);
-sub aslice2 : lvalue { @array2[0,2] };
-(aslice2()) = ("ok", "already");
-print "not " unless "@array2" eq "ok B already d";
-print "ok 59\n";
-
-%hash = qw(a Alpha b Beta c Gamma);
-sub hslice : lvalue { @hash{"c", "b"} }
-(hslice()) = ("CISC", "BogoMIPS");
-print "not " unless join("/",@hash{"c","a","b"}) eq "CISC/Alpha/BogoMIPS";
-print "ok 60\n";
-}
-
-$str = "Hello, world!";
-sub sstr : lvalue { substr($str, 1, 4) }
-sstr() = "i";
-print "not " unless $str eq "Hi, world!";
-print "ok 61\n";
-
-$str = "Made w/ JavaScript";
-sub veclv : lvalue { vec($str, 2, 32) }
-if (ord('A') != 193) {
-    veclv() = 0x5065726C;
-}
-else { # EBCDIC?
-    veclv() = 0xD7859993;
-}
-print "# $str\nnot " unless $str eq "Made w/ PerlScript";
-print "ok 62\n";
-
-sub position : lvalue { pos }
-@p = ();
-$_ = "fee fi fo fum";
-while (/f/g) {
-    push @p, position;
-    position() += 6;
-}
-print "# @p\nnot " unless "@p" eq "1 8";
-print "ok 63\n";
-
-# Bug 20001223.002: split thought that the list had only one element
-@ary = qw(4 5 6);
-sub lval1 : lvalue { $ary[0]; }
-sub lval2 : lvalue { $ary[1]; }
-(lval1(), lval2()) = split ' ', "1 2 3 4";
-print "not " unless join(':', @ary) eq "1:2:6";
-print "ok 64\n";

diff --git a/t/pragma/subs.t b/t/pragma/subs.t
deleted file mode 100755 (executable)
index 2f684b4..0000000
--- a/t/pragma/subs.t
+++ /dev/null
@@ -1,162 +0,0 @@
-#!./perl 
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    $ENV{PERL5LIB} = '../lib';
-}
-
-$| = 1;
-undef $/;
-my @prgs = split "\n########\n", <DATA>;
-print "1..", scalar @prgs, "\n";
-
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MSWin32 = $^O eq 'MSWin32';
-my $Is_NetWare = $^O eq 'NetWare';
-my $tmpfile = "tmp0000";
-my $i = 0 ;
-1 while -f ++$tmpfile;
-END {  if ($tmpfile) { 1 while unlink $tmpfile} }
-
-for (@prgs){
-    my $switch = "";
-    my @temps = () ;
-    if (s/^\s*-\w+//){
-        $switch = $&;
-    }
-    my($prog,$expected) = split(/\nEXPECT\n/, $_);
-    if ( $prog =~ /--FILE--/) {
-        my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
-       shift @files ;
-       die "Internal error test $i didn't split into pairs, got " . 
-               scalar(@files) . "[" . join("%%%%", @files) ."]\n"
-           if @files % 2 ;
-       while (@files > 2) {
-           my $filename = shift @files ;
-           my $code = shift @files ;
-           push @temps, $filename ;
-           open F, ">$filename" or die "Cannot open $filename: $!\n" ;
-           print F $code ;
-           close F ;
-       }
-       shift @files ;
-       $prog = shift @files ;
-    }
-    open TEST, ">$tmpfile";
-    print TEST $prog,"\n";
-    close TEST;
-    my $results = $Is_VMS ?
-                  `./perl $switch $tmpfile 2>&1` :
-                 $Is_MSWin32 ?
-                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
-                 $Is_NetWare ?
-                  `perl -I../lib $switch $tmpfile 2>&1` :
-                  `./perl $switch $tmpfile 2>&1`;
-    my $status = $?;
-    $results =~ s/\n+$//;
-    # allow expected output to be written as if $prog is on STDIN
-    $results =~ s/tmp\d+/-/g;
-    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
-# bison says 'parse error' instead of 'syntax error',
-# various yaccs may or may not capitalize 'syntax'.
-    $results =~ s/^(syntax|parse) error/syntax error/mig;
-    $expected =~ s/\n+$//;
-    my $prefix = ($results =~ s/^PREFIX\n//) ;
-    if ( $results =~ s/^SKIPPED\n//) {
-       print "$results\n" ;
-    }
-    elsif (($prefix and $results !~ /^\Q$expected/) or
-          (!$prefix and $results ne $expected)){
-        print STDERR "PROG: $switch\n$prog\n";
-        print STDERR "EXPECTED:\n$expected\n";
-        print STDERR "GOT:\n$results\n";
-        print "not ";
-    }
-    print "ok ", ++$i, "\n";
-    foreach (@temps) 
-       { unlink $_ if $_ } 
-}
-
-__END__
-
-# Error - not predeclaring a sub
-Fred 1,2 ;
-sub Fred {}
-EXPECT
-Number found where operator expected at - line 3, near "Fred 1"
-       (Do you need to predeclare Fred?)
-syntax error at - line 3, near "Fred 1"
-Execution of - aborted due to compilation errors.
-########
-
-# Error - not predeclaring a sub in time
-Fred 1,2 ;
-use subs qw( Fred ) ;
-sub Fred {}
-EXPECT
-Number found where operator expected at - line 3, near "Fred 1"
-       (Do you need to predeclare Fred?)
-syntax error at - line 3, near "Fred 1"
-BEGIN not safe after errors--compilation aborted at - line 4.
-########
-
-# AOK
-use subs qw( Fred) ;
-Fred 1,2 ;
-sub Fred { print $_[0] + $_[1], "\n" }
-EXPECT
-3
-########
-
-# override a built-in function
-use subs qw( open ) ;
-open 1,2 ;
-sub open { print $_[0] + $_[1], "\n" }
-EXPECT
-3
-########
-
-# override a built-in function, call after definition
-use subs qw( open ) ;
-sub open { print $_[0] + $_[1], "\n" }
-open 1,2 ;
-EXPECT
-3
-########
-
-# override a built-in function, call with ()
-use subs qw( open ) ;
-open (1,2) ;
-sub open { print $_[0] + $_[1], "\n" }
-EXPECT
-3
-########
-
-# override a built-in function, call with () after definition
-use subs qw( open ) ;
-sub open { print $_[0] + $_[1], "\n" }
-open (1,2) ;
-EXPECT
-3
-########
-
---FILE-- abc
-Fred 1,2 ;
-1;
---FILE--
-use subs qw( Fred ) ;
-require "./abc" ;
-sub Fred { print $_[0] + $_[1], "\n" }
-EXPECT
-3
-########
-
-# check that it isn't affected by block scope
-{
-    use subs qw( Fred ) ;
-}
-Fred 1, 2;
-sub Fred { print $_[0] + $_[1], "\n" }
-EXPECT
-3

diff --git a/t/pragma/utf8.t b/t/pragma/utf8.t
deleted file mode 100755 (executable)
index 850470e..0000000
--- a/t/pragma/utf8.t
+++ /dev/null
@@ -1,103 +0,0 @@
-#!./perl 
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-# NOTE!
-#
-# Think carefully before adding tests here.  In general this should be
-# used only for about three categories of tests:
-#
-# (1) tests that absolutely require 'use utf8', and since that in general
-#     shouldn't be needed as the utf8 is being obsoleted, this should
-#     have rather few tests.  If you want to test Unicode and regexes,
-#     you probably want to go to op/regexp or op/pat; if you want to test
-#     split, go to op/split; pack, op/pack; appending or joining,
-#     op/append or op/join, and so forth
-#
-# (2) tests that have to do with Unicode tokenizing (though it's likely
-#     that all the other Unicode tests sprinkled around the t/**/*.t are
-#     going to catch that)
-#
-# (3) complicated tests that simultaneously stress so many Unicode features
-#     that deciding into which other test script the tests should go to
-#     is hard -- maybe consider breaking up the complicated test
-#
-#
-
-use Test;
-plan tests => 15;
-
-{
-    # bug id 20001009.001
-
-    my ($a, $b);
-
-    { use bytes; $a = "\xc3\xa4" }
-    { use utf8;  $b = "\xe4"     }
-
-    my $test = 68;
-
-    ok($a ne $b);
-
-    { use utf8; ok($a ne $b) }
-}
-
-
-{
-    # bug id 20000730.004
-
-    my $smiley = "\x{263a}";
-
-    for my $s ("\x{263a}",
-              $smiley,
-               
-              "" . $smiley,
-              "" . "\x{263a}",
-
-              $smiley    . "",
-              "\x{263a}" . "",
-              ) {
-       my $length_chars = length($s);
-       my $length_bytes;
-       { use bytes; $length_bytes = length($s) }
-       my @regex_chars = $s =~ m/(.)/g;
-       my $regex_chars = @regex_chars;
-       my @split_chars = split //, $s;
-       my $split_chars = @split_chars;
-       ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
-          "1/1/1/3");
-    }
-
-    for my $s ("\x{263a}" . "\x{263a}",
-              $smiley    . $smiley,
-
-              "\x{263a}\x{263a}",
-              "$smiley$smiley",
-              
-              "\x{263a}" x 2,
-              $smiley    x 2,
-              ) {
-       my $length_chars = length($s);
-       my $length_bytes;
-       { use bytes; $length_bytes = length($s) }
-       my @regex_chars = $s =~ m/(.)/g;
-       my $regex_chars = @regex_chars;
-       my @split_chars = split //, $s;
-       my $split_chars = @split_chars;
-       ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
-          "2/2/2/6");
-    }
-}
-
-
-{
-    my $w = 0;
-    local $SIG{__WARN__} = sub { print "#($_[0])\n"; $w++ };
-    my $x = eval q/"\\/ . "\x{100}" . q/"/;;
-   
-    ok($w == 0 && $x eq "\x{100}");
-}
-

diff --git a/t/pragma/vars.t b/t/pragma/vars.t
deleted file mode 100644 (file)
index 3075f8e..0000000
--- a/t/pragma/vars.t
+++ /dev/null
@@ -1,105 +0,0 @@
-#!./perl 
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    $ENV{PERL5LIB} = '../lib';
-}
-
-$| = 1;
-
-print "1..27\n";
-
-# catch "used once" warnings
-my @warns;
-BEGIN { $SIG{__WARN__} = sub { push @warns, @_ }; $^W = 1 };
-
-%x = ();
-$y = 3;
-@z = ();
-$X::x = 13;
-
-use vars qw($p @q %r *s &t $X::p);
-
-my $e = !(grep /^Name "X::x" used only once: possible typo/, @warns) && 'not ';
-print "${e}ok 1\n";
-$e = !(grep /^Name "main::x" used only once: possible typo/, @warns) && 'not ';
-print "${e}ok 2\n";
-$e = !(grep /^Name "main::y" used only once: possible typo/, @warns) && 'not ';
-print "${e}ok 3\n";
-$e = !(grep /^Name "main::z" used only once: possible typo/, @warns) && 'not ';
-print "${e}ok 4\n";
-($e, @warns) = @warns != 4 && 'not ';
-print "${e}ok 5\n";
-
-# this is inside eval() to avoid creation of symbol table entries and
-# to avoid "used once" warnings
-eval <<'EOE';
-$e = ! $main::{p} && 'not ';
-print "${e}ok 6\n";
-$e = ! *q{ARRAY} && 'not ';
-print "${e}ok 7\n";
-$e = ! *r{HASH} && 'not ';
-print "${e}ok 8\n";
-$e = ! $main::{s} && 'not ';
-print "${e}ok 9\n";
-$e = ! *t{CODE} && 'not ';
-print "${e}ok 10\n";
-$e = defined $X::{q} && 'not ';
-print "${e}ok 11\n";
-$e = ! $X::{p} && 'not ';
-print "${e}ok 12\n";
-EOE
-$e = $@ && 'not ';
-print "${e}ok 13\n";
-
-eval q{use vars qw(@X::y !abc); $e = ! *X::y{ARRAY} && 'not '};
-print "${e}ok 14\n";
-$e = $@ !~ /^'!abc' is not a valid variable name/ && 'not ';
-print "${e}ok 15\n";
-
-eval 'use vars qw($x[3])';
-$e = $@ !~ /^Can't declare individual elements of hash or array/ && 'not ';
-print "${e}ok 16\n";
-
-{ local $^W;
-  eval 'use vars qw($!)';
-  ($e, @warns) = ($@ || @warns) ? 'not ' : '';
-  print "${e}ok 17\n";
-};
-
-# NB the next test only works because vars.pm has already been loaded
-eval 'use warnings "vars"; use vars qw($!)';
-$e = ($@ || (shift(@warns)||'') !~ /^No need to declare built-in vars/)
-                       && 'not ';
-print "${e}ok 18\n";
-
-no strict 'vars';
-eval 'use vars qw(@x%%)';
-$e = $@ && 'not ';
-print "${e}ok 19\n";
-$e = ! *{'x%%'}{ARRAY} && 'not ';
-print "${e}ok 20\n";
-eval '$u = 3; @v = (); %w = ()';
-$e = $@ && 'not ';
-print "${e}ok 21\n";
-
-use strict 'vars';
-eval 'use vars qw(@y%%)';
-$e = $@ !~ /^'\@y%%' is not a valid variable name under strict vars/ && 'not ';
-print "${e}ok 22\n";
-$e = *{'y%%'}{ARRAY} && 'not ';
-print "${e}ok 23\n";
-eval '$u = 3; @v = (); %w = ()';
-my @errs = split /\n/, $@;
-$e = @errs != 3 && 'not ';
-print "${e}ok 24\n";
-$e = !(grep(/^Global symbol "\$u" requires explicit package name/, @errs))
-                       && 'not ';
-print "${e}ok 25\n";
-$e = !(grep(/^Global symbol "\@v" requires explicit package name/, @errs))
-                       && 'not ';
-print "${e}ok 26\n";
-$e = !(grep(/^Global symbol "\%w" requires explicit package name/, @errs))
-                       && 'not ';
-print "${e}ok 27\n";

diff --git a/t/pragma/warn/1global b/t/pragma/warn/1global
deleted file mode 100644 (file)
index 0af8022..0000000
--- a/t/pragma/warn/1global
+++ /dev/null
@@ -1,189 +0,0 @@
-Check existing $^W functionality
-
-
-__END__
-
-# warnable code, warnings disabled
-$a =+ 3 ;
-EXPECT
-
-########
--w
-# warnable code, warnings enabled via command line switch
-$a =+ 3 ;
-EXPECT
-Reversed += operator at - line 3.
-Name "main::a" used only once: possible typo at - line 3.
-########
-#! perl -w
-# warnable code, warnings enabled via #! line
-$a =+ 3 ;
-EXPECT
-Reversed += operator at - line 3.
-Name "main::a" used only once: possible typo at - line 3.
-########
-
-# warnable code, warnings enabled via compile time $^W
-BEGIN { $^W = 1 }
-$a =+ 3 ;
-EXPECT
-Reversed += operator at - line 4.
-Name "main::a" used only once: possible typo at - line 4.
-########
-
-# compile-time warnable code, warnings enabled via runtime $^W
-# so no warning printed.
-$^W = 1 ;
-$a =+ 3 ;
-EXPECT
-
-########
-
-# warnable code, warnings enabled via runtime $^W
-$^W = 1 ;
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 4.
-########
-
-# warnings enabled at compile time, disabled at run time
-BEGIN { $^W = 1 }
-$^W = 0 ;
-my $b ; chop $b ;
-EXPECT
-
-########
-
-# warnings disabled at compile time, enabled at run time
-BEGIN { $^W = 0 }
-$^W = 1 ;
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 5.
-########
--w
---FILE-- abcd
-my $b ; chop $b ;
-1 ;
---FILE-- 
-require "./abcd";
-EXPECT
-Use of uninitialized value in scalar chop at ./abcd line 1.
-########
-
---FILE-- abcd
-my $b ; chop $b ;
-1 ;
---FILE-- 
-#! perl -w
-require "./abcd";
-EXPECT
-Use of uninitialized value in scalar chop at ./abcd line 1.
-########
-
---FILE-- abcd
-my $b ; chop $b ;
-1 ;
---FILE-- 
-$^W =1 ;
-require "./abcd";
-EXPECT
-Use of uninitialized value in scalar chop at ./abcd line 1.
-########
-
---FILE-- abcd
-$^W = 0;
-my $b ; chop $b ;
-1 ;
---FILE-- 
-$^W =1 ;
-require "./abcd";
-EXPECT
-
-########
-
---FILE-- abcd
-$^W = 1;
-1 ;
---FILE-- 
-$^W =0 ;
-require "./abcd";
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 3.
-########
-
-$^W = 1;
-eval 'my $b ; chop $b ;' ;
-print $@ ;
-EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 1.
-########
-
-eval '$^W = 1;' ;
-print $@ ;
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 4.
-########
-
-eval {$^W = 1;} ;
-print $@ ;
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 4.
-########
-
-{
-    local ($^W) = 1;
-}
-my $b ; chop $b ;
-EXPECT
-
-########
-
-my $a ; chop $a ;
-{
-    local ($^W) = 1;
-    my $b ; chop $b ;
-}
-my $c ; chop $c ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 5.
-########
--w
--e undef
-EXPECT
-Use of uninitialized value in -e at - line 2.
-########
-
-$^W = 1 + 2 ;
-EXPECT
-
-########
-
-$^W = $a ;
-EXPECT
-
-########
-
-sub fred {}
-$^W = fred() ;
-EXPECT
-
-########
-
-sub fred { my $b ; chop $b ;}
-{ local $^W = 0 ;
-  fred() ;
-}
-EXPECT
-
-########
-
-sub fred { my $b ; chop $b ;}
-{ local $^W = 1 ;
-  fred() ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at - line 2.

diff --git a/t/pragma/warn/2use b/t/pragma/warn/2use
deleted file mode 100644 (file)
index e25d43a..0000000
--- a/t/pragma/warn/2use
+++ /dev/null
@@ -1,354 +0,0 @@
-Check lexical warnings functionality
-
-TODO
-  check that the warning hierarchy works.
-
-__END__
-
-#  check illegal category is caught
-use warnings 'this-should-never-be-a-warning-category' ;
-EXPECT
-unknown warnings category 'this-should-never-be-a-warning-category' at - line 3
-BEGIN failed--compilation aborted at - line 3.
-########
-
-# Check compile time scope of pragma
-use warnings 'syntax' ;
-{
-    no warnings ;
-    my $a =+ 1 ;
-}
-my $a =+ 1 ;
-EXPECT
-Reversed += operator at - line 8.
-########
-
-# Check compile time scope of pragma
-no warnings;
-{
-    use warnings 'syntax' ;
-    my $a =+ 1 ;
-}
-my $a =+ 1 ;
-EXPECT
-Reversed += operator at - line 6.
-########
-
-# Check runtime scope of pragma
-use warnings 'uninitialized' ;
-{
-    no warnings ;
-    my $b ; chop $b ;
-}
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 8.
-########
-
-# Check runtime scope of pragma
-no warnings ;
-{
-    use warnings 'uninitialized' ;
-    my $b ; chop $b ;
-}
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 6.
-########
-
-# Check runtime scope of pragma
-no warnings ;
-{
-    use warnings 'uninitialized' ;
-    $a = sub { my $b ; chop $b ; }
-}
-&$a ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 6.
-########
-
-use warnings 'syntax' ;
-my $a =+ 1 ;
-EXPECT
-Reversed += operator at - line 3.
-########
-
---FILE-- abc
-my $a =+ 1 ;
-1;
---FILE-- 
-use warnings 'syntax' ;
-require "./abc";
-EXPECT
-
-########
-
---FILE-- abc
-use warnings 'syntax' ;
-1;
---FILE-- 
-require "./abc";
-my $a =+ 1 ;
-EXPECT
-
-########
-
---FILE-- abc
-use warnings 'syntax' ;
-my $a =+ 1 ;
-1;
---FILE-- 
-use warnings 'uninitialized' ;
-require "./abc";
-my $a ; chop $a ;
-EXPECT
-Reversed += operator at ./abc line 2.
-Use of uninitialized value in scalar chop at - line 3.
-########
-
---FILE-- abc.pm
-use warnings 'syntax' ;
-my $a =+ 1 ;
-1;
---FILE-- 
-use warnings 'uninitialized' ;
-use abc;
-my $a ; chop $a ;
-EXPECT
-Reversed += operator at abc.pm line 2.
-Use of uninitialized value in scalar chop at - line 3.
-########
-
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval {
-        my $b ; chop $b ;
-    }; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval {
-        use warnings 'uninitialized' ;
-        my $b ; chop $b ;
-    }; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at - line 8.
-########
-
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'uninitialized' ;
-    eval {
-        my $b ; chop $b ;
-    }; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at - line 7.
-Use of uninitialized value in scalar chop at - line 9.
-########
-
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'uninitialized' ;
-    eval {
-        no warnings ;
-        my $b ; chop $b ;
-    }; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at - line 10.
-########
-
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval {
-        my $a =+ 1 ;
-    }; print STDERR $@ ;
-    my $a =+ 1 ;
-}
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval {
-        use warnings 'syntax' ;
-        my $a =+ 1 ;
-    }; print STDERR $@ ;
-    my $a =+ 1 ;
-}
-EXPECT
-Reversed += operator at - line 8.
-########
-
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'syntax' ;
-    eval {
-        my $a =+ 1 ;
-    }; print STDERR $@ ;
-    my $a =+ 1 ;
-}
-EXPECT
-Reversed += operator at - line 7.
-Reversed += operator at - line 9.
-########
-
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'syntax' ;
-    eval {
-        no warnings ;
-        my $a =+ 1 ;
-    }; print STDERR $@ ;
-    my $a =+ 1 ;
-}
-EXPECT
-Reversed += operator at - line 10.
-########
-
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval '
-        my $b ; chop $b ;
-    '; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval q[ 
-        use warnings 'uninitialized' ;
-        my $b ; chop $b ;
-    ]; print STDERR $@;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 3.
-########
-
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'uninitialized' ;
-    eval '
-        my $b ; chop $b ;
-    '; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 2.
-Use of uninitialized value in scalar chop at - line 9.
-########
-
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'uninitialized' ;
-    eval '
-        no warnings ;
-        my $b ; chop $b ;
-    '; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at - line 10.
-########
-
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval '
-        my $a =+ 1 ;
-    '; print STDERR $@ ;
-    my $a =+ 1 ;
-}
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval q[ 
-        use warnings 'syntax' ;
-        my $a =+ 1 ;
-    ]; print STDERR $@;
-    my $a =+ 1 ;
-}
-EXPECT
-Reversed += operator at (eval 1) line 3.
-########
-
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'syntax' ;
-    eval '
-        my $a =+ 1 ;
-    '; print STDERR $@;
-    my $a =+ 1 ;
-}
-EXPECT
-Reversed += operator at - line 9.
-Reversed += operator at (eval 1) line 2.
-########
-
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'syntax' ;
-    eval '
-        no warnings ;
-        my $a =+ 1 ;
-    '; print STDERR $@;
-    my $a =+ 1 ;
-}
-EXPECT
-Reversed += operator at - line 10.
-########
-
-# Check the additive nature of the pragma
-my $a =+ 1 ;
-my $a ; chop $a ;
-use warnings 'syntax' ;
-$a =+ 1 ;
-my $b ; chop $b ;
-use warnings 'uninitialized' ;
-my $c ; chop $c ;
-no warnings 'syntax' ;
-$a =+ 1 ;
-EXPECT
-Reversed += operator at - line 6.
-Use of uninitialized value in scalar chop at - line 9.

diff --git a/t/pragma/warn/3both b/t/pragma/warn/3both
deleted file mode 100644 (file)
index a4d9ba8..0000000
--- a/t/pragma/warn/3both
+++ /dev/null
@@ -1,266 +0,0 @@
-Check interaction of $^W and lexical
-
-__END__
-
-# Check interaction of $^W and use warnings
-sub fred { 
-    use warnings ;
-    my $b ; 
-    chop $b ;
-}
-{ local $^W = 0 ;
-  fred() ;
-}
-
-EXPECT
-Use of uninitialized value in scalar chop at - line 6.
-########
-
-# Check interaction of $^W and use warnings
-sub fred { 
-    use warnings ;
-    my $b ; 
-    chop $b ;
-}
-{ $^W = 0 ;
-  fred() ;
-}
-
-EXPECT
-Use of uninitialized value in scalar chop at - line 6.
-########
-
-# Check interaction of $^W and use warnings
-sub fred { 
-    no warnings ;
-    my $b ; 
-    chop $b ;
-}
-{ local $^W = 1 ;
-  fred() ;
-}
-
-EXPECT
-
-########
-
-# Check interaction of $^W and use warnings
-sub fred { 
-    no warnings ;
-    my $b ; 
-    chop $b ;
-}
-{ $^W = 1 ;
-  fred() ;
-}
-
-EXPECT
-
-########
-
-# Check interaction of $^W and use warnings
-use warnings ;
-$^W = 1 ;
-my $b ; 
-chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 6.
-########
-
-# Check interaction of $^W and use warnings
-$^W = 1 ;
-use warnings ;
-my $b ; 
-chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 6.
-########
-
-# Check interaction of $^W and use warnings
-$^W = 1 ;
-no warnings ;
-my $b ; 
-chop $b ;
-EXPECT
-
-########
-
-# Check interaction of $^W and use warnings
-no warnings ;
-$^W = 1 ;
-my $b ; 
-chop $b ;
-EXPECT
-
-########
--w
-# Check interaction of $^W and use warnings
-no warnings ;
-my $b ; 
-chop $b ;
-EXPECT
-
-########
--w
-# Check interaction of $^W and use warnings
-use warnings ;
-my $b ; 
-chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 5.
-########
-
-# Check interaction of $^W and use warnings
-sub fred { 
-    use warnings ;
-    my $b ; 
-    chop $b ;
-}
-BEGIN {  $^W = 0 }
-fred() ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 6.
-########
-
-# Check interaction of $^W and use warnings
-sub fred { 
-    no warnings ;
-    my $b ; 
-    chop $b ;
-}
-BEGIN {  $^W = 1 }
-fred() ;
-
-EXPECT
-
-########
-
-# Check interaction of $^W and use warnings
-use warnings ;
-BEGIN {  $^W = 1 }
-my $b ; 
-chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 6.
-########
-
-# Check interaction of $^W and use warnings
-BEGIN {  $^W = 1 }
-use warnings ;
-my $b ; 
-chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 6.
-########
-
-# Check interaction of $^W and use warnings
-BEGIN {  $^W = 1 }
-no warnings ;
-my $b ; 
-chop $b ;
-EXPECT
-
-########
-
-# Check interaction of $^W and use warnings
-no warnings ;
-BEGIN {  $^W = 1 }
-my $b ; 
-chop $b ;
-EXPECT
-
-########
-
-# Check interaction of $^W and use warnings
-BEGIN {  $^W = 1 }
-{
-    no warnings ;
-    my $b ; 
-    chop $b ;
-}
-my $b ;
-chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 10.
-########
-
-# Check interaction of $^W and use warnings
-BEGIN {  $^W = 0 }
-{
-    use warnings ;
-    my $b ; 
-    chop $b ;
-}
-my $b ;
-chop $b ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 7.
-########
-
-# Check scope of pragma with eval
-BEGIN {  $^W = 1 }
-{
-    no warnings ;
-    eval '
-        my $b ; chop $b ;
-    '; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-BEGIN {  $^W = 1 }
-use warnings;
-{
-    no warnings ;
-    eval q[ 
-        use warnings 'uninitialized' ;
-        my $b ; chop $b ;
-    ]; print STDERR $@;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 3.
-########
-
-# Check scope of pragma with eval
-BEGIN {  $^W = 0 }
-{
-    use warnings 'uninitialized' ;
-    eval '
-        my $b ; chop $b ;
-    '; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 2.
-Use of uninitialized value in scalar chop at - line 9.
-########
-
-# Check scope of pragma with eval
-BEGIN {  $^W = 0 }
-{
-    use warnings 'uninitialized' ;
-    eval '
-        no warnings ;
-        my $b ; chop $b ;
-    '; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at - line 10.
-########
-
-# Check scope of pragma with eval
-BEGIN {  $^W = 1 }
-{
-    no warnings ;
-    eval '
-        my $a =+ 1 ;
-    '; print STDERR $@ ;
-    my $a =+ 1 ;
-}
-EXPECT
-

diff --git a/t/pragma/warn/4lint b/t/pragma/warn/4lint
deleted file mode 100644 (file)
index 848822d..0000000
--- a/t/pragma/warn/4lint
+++ /dev/null
@@ -1,216 +0,0 @@
-Check lint
-
-__END__
--W
-# lint: check compile time $^W is zapped
-BEGIN { $^W = 0 ;}
-$a = 1 ;
-$a =+ 1 ;
-close STDIN ; print STDIN "abc" ;
-EXPECT
-Reversed += operator at - line 5.
-print() on closed filehandle STDIN at - line 6.
-########
--W
-# lint: check runtime $^W is zapped
-$^W = 0 ;
-close STDIN ; print STDIN "abc" ;
-EXPECT
-print() on closed filehandle STDIN at - line 4.
-########
--W
-# lint: check runtime $^W is zapped
-{
-  $^W = 0 ;
-  close STDIN ; print STDIN "abc" ;
-}
-EXPECT
-print() on closed filehandle STDIN at - line 5.
-########
--W
-# lint: check "no warnings" is zapped
-no warnings ;
-$a = 1 ;
-$a =+ 1 ;
-close STDIN ; print STDIN "abc" ;
-EXPECT
-Reversed += operator at - line 5.
-print() on closed filehandle STDIN at - line 6.
-########
--W
-# lint: check "no warnings" is zapped
-{
-  no warnings ;
-  close STDIN ; print STDIN "abc" ;
-}
-EXPECT
-print() on closed filehandle STDIN at - line 5.
-########
--Ww
-# lint: check combination of -w and -W
-{
-  $^W = 0 ;
-  close STDIN ; print STDIN "abc" ;
-}
-EXPECT
-print() on closed filehandle STDIN at - line 5.
-########
--W
---FILE-- abc.pm
-no warnings 'syntax' ;
-my $a = 0;
-$a =+ 1 ;
-1;
---FILE-- 
-no warnings 'uninitialized' ;
-use abc;
-my $a ; chop $a ;
-EXPECT
-Reversed += operator at abc.pm line 3.
-Use of uninitialized value in scalar chop at - line 3.
-########
--W
---FILE-- abc
-no warnings 'syntax' ;
-my $a = 0;
-$a =+ 1 ;
-1;
---FILE-- 
-no warnings 'uninitialized' ;
-require "./abc";
-my $a ; chop $a ;
-EXPECT
-Reversed += operator at ./abc line 3.
-Use of uninitialized value in scalar chop at - line 3.
-########
--W
---FILE-- abc.pm
-BEGIN {$^W = 0}
-my $a = 0 ;
-$a =+ 1 ;
-1;
---FILE-- 
-$^W = 0 ;
-use abc;
-my $a ; chop $a ;
-EXPECT
-Reversed += operator at abc.pm line 3.
-Use of uninitialized value in scalar chop at - line 3.
-########
--W
---FILE-- abc
-BEGIN {$^W = 0}
-my $a = 0 ;
-$a =+ 1 ;
-1;
---FILE-- 
-$^W = 0 ;
-require "./abc";
-my $a ; chop $a ;
-EXPECT
-Reversed += operator at ./abc line 3.
-Use of uninitialized value in scalar chop at - line 3.
-########
--W
-# Check scope of pragma with eval
-{
-    no warnings ;
-    eval '
-        my $b ; chop $b ;
-    '; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 2.
-Use of uninitialized value in scalar chop at - line 8.
-########
--W
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval q[ 
-        use warnings 'uninitialized' ;
-        my $b ; chop $b ;
-    ]; print STDERR $@;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 3.
-Use of uninitialized value in scalar chop at - line 10.
-########
--W
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'uninitialized' ;
-    eval '
-        my $b ; chop $b ;
-    '; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 2.
-Use of uninitialized value in scalar chop at - line 9.
-########
--W
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'uninitialized' ;
-    eval '
-        no warnings ;
-        my $b ; chop $b ;
-    '; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-Use of uninitialized value in scalar chop at (eval 1) line 3.
-Use of uninitialized value in scalar chop at - line 10.
-########
--W
-# Check scope of pragma with eval
-use warnings;
-{
-    my $a = "1"; my $b = "2";
-    no warnings ;
-    eval q[ 
-        use warnings 'syntax' ;
-        $a =+ 1 ;
-    ]; print STDERR $@;
-    $a =+ 1 ;
-}
-EXPECT
-Reversed += operator at - line 11.
-Reversed += operator at (eval 1) line 3.
-########
--W
-# Check scope of pragma with eval
-no warnings;
-{
-    my $a = "1"; my $b = "2";
-    use warnings 'syntax' ;
-    eval '
-        $a =+ 1 ;
-    '; print STDERR $@;
-    $a =+ 1 ;
-}
-EXPECT
-Reversed += operator at - line 10.
-Reversed += operator at (eval 1) line 2.
-########
--W
-# Check scope of pragma with eval
-no warnings;
-{
-    my $a = "1"; my $b = "2";
-    use warnings 'syntax' ;
-    eval '
-        no warnings ;
-        $a =+ 1 ;
-    '; print STDERR $@;
-    $a =+ 1 ;
-}
-EXPECT
-Reversed += operator at - line 11.
-Reversed += operator at (eval 1) line 3.

diff --git a/t/pragma/warn/5nolint b/t/pragma/warn/5nolint
deleted file mode 100644 (file)
index 56158a2..0000000
--- a/t/pragma/warn/5nolint
+++ /dev/null
@@ -1,204 +0,0 @@
-syntax anti-lint
-
-__END__
--X
-# nolint: check compile time $^W is zapped
-BEGIN { $^W = 1 ;}
-$a = $b = 1 ;
-$a =+ 1 ;
-close STDIN ; print STDIN "abc" ;
-EXPECT
-########
--X
-# nolint: check runtime $^W is zapped
-$^W = 1 ;
-close STDIN ; print STDIN "abc" ;
-EXPECT
-########
--X
-# nolint: check runtime $^W is zapped
-{
-  $^W = 1 ;
-  close STDIN ; print STDIN "abc" ;
-}
-EXPECT
-########
--X
-# nolint: check "no warnings" is zapped
-use warnings ;
-$a = $b = 1 ;
-$a =+ 1 ;
-close STDIN ; print STDIN "abc" ;
-EXPECT
-########
--X
-# nolint: check "no warnings" is zapped
-{
-  use warnings ;
-  close STDIN ; print STDIN "abc" ;
-}
-EXPECT
-########
--Xw
-# nolint: check combination of -w and -X
-{
-  $^W = 1 ;
-  close STDIN ; print STDIN "abc" ;
-}
-EXPECT
-########
--X
---FILE-- abc.pm
-use warnings 'syntax' ;
-my $a = 0;
-$a =+ 1 ;
-1;
---FILE-- 
-use warnings 'uninitialized' ;
-use abc;
-my $a ; chop $a ;
-EXPECT
-########
--X
---FILE-- abc
-use warnings 'syntax' ;
-my $a = 0;
-$a =+ 1 ;
-1;
---FILE-- 
-use warnings 'uninitialized' ;
-require "./abc";
-my $a ; chop $a ;
-EXPECT
-########
--X
---FILE-- abc.pm
-BEGIN {$^W = 1}
-my ($a, $b) = (0,0);
-$a =+ 1 ;
-1;
---FILE-- 
-$^W = 1 ;
-use abc;
-my $a ; chop $a ;
-EXPECT
-########
--X
---FILE-- abc
-BEGIN {$^W = 1}
-my ($a, $b) = (0,0);
-$a =+ 1 ;
-1;
---FILE-- 
-$^W = 1 ;
-require "./abc";
-my $a ; chop $a ;
-EXPECT
-########
--X
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval '
-        my $b ; chop $b ;
-    '; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-
-########
--X
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval q[ 
-        use warnings 'uninitialized' ;
-        my $b ; chop $b ;
-    ]; print STDERR $@;
-    my $b ; chop $b ;
-}
-EXPECT
-
-########
--X
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'uninitialized' ;
-    eval '
-        my $b ; chop $b ;
-    '; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-
-########
--X
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'uninitialized' ;
-    eval '
-        no warnings ;
-        my $b ; chop $b ;
-    '; print STDERR $@ ;
-    my $b ; chop $b ;
-}
-EXPECT
-
-########
--X
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval '
-        my $a =+ 1 ;
-    '; print STDERR $@ ;
-    my $a =+ 1 ;
-}
-EXPECT
-
-########
--X
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval q[ 
-        use warnings 'syntax' ;
-        my $a =+ 1 ;
-    ]; print STDERR $@;
-    my $a =+ 1 ;
-}
-EXPECT
-
-########
--X
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'syntax' ;
-    eval '
-        my $a =+ 1 ;
-    '; print STDERR $@;
-    my $a =+ 1 ;
-}
-EXPECT
-
-########
--X
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'syntax' ;
-    eval '
-        no warnings ;
-        my $a =+ 1 ;
-    '; print STDERR $@;
-    my $a =+ 1 ;
-}
-EXPECT
-

diff --git a/t/pragma/warn/6default b/t/pragma/warn/6default
deleted file mode 100644 (file)
index a8aafee..0000000
--- a/t/pragma/warn/6default
+++ /dev/null
@@ -1,121 +0,0 @@
-Check default warnings
-
-__END__
-# default warnings should be displayed if you don't add anything
-# optional shouldn't
-my $a = oct "7777777777777777777777777777777777779" ;
-EXPECT
-Integer overflow in octal number at - line 3.
-########
-# no warnings should be displayed 
-no warnings ;
-my $a = oct "7777777777777777777777777777777777778" ;
-EXPECT
-########
-# all warnings should be displayed 
-use warnings ;
-my $a = oct "7777777777777777777777777777777777778" ;
-EXPECT
-Integer overflow in octal number at - line 3.
-Illegal octal digit '8' ignored at - line 3.
-Octal number > 037777777777 non-portable at - line 3.
-########
-# check scope
-use warnings ;
-my $a = oct "7777777777777777777777777777777777778" ;
-{
-    no warnings ;
-    my $a = oct "7777777777777777777777777777777777778" ;
-}    
-my $c = oct "7777777777777777777777777777777777778" ;
-EXPECT
-Integer overflow in octal number at - line 3.
-Illegal octal digit '8' ignored at - line 3.
-Octal number > 037777777777 non-portable at - line 3.
-Integer overflow in octal number at - line 8.
-Illegal octal digit '8' ignored at - line 8.
-Octal number > 037777777777 non-portable at - line 8.
-########
-# all warnings should be displayed 
-use warnings ;
-my $a = oct "0xfffffffffffffffffg" ;
-EXPECT
-Integer overflow in hexadecimal number at - line 3.
-Illegal hexadecimal digit 'g' ignored at - line 3.
-Hexadecimal number > 0xffffffff non-portable at - line 3.
-########
-# all warnings should be displayed 
-use warnings ;
-my $a = oct "0b111111111111111111111111111111111111111111111111111111111111111112";
-EXPECT
-Integer overflow in binary number at - line 3.
-Illegal binary digit '2' ignored at - line 3.
-Binary number > 0b11111111111111111111111111111111 non-portable at - line 3.
-########
-
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval '
-       my $a = oct "0xfffffffffffffffffg" ;
-    '; print STDERR $@ ;
-    my $a = oct "0xfffffffffffffffffg" ;
-}
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-use warnings;
-{
-    no warnings ;
-    eval q[ 
-        use warnings ;
-       my $a = oct "0xfffffffffffffffffg" ;
-    ]; print STDERR $@;
-    my $a = oct "0xfffffffffffffffffg" ;
-}
-EXPECT
-Integer overflow in hexadecimal number at (eval 1) line 3.
-Illegal hexadecimal digit 'g' ignored at (eval 1) line 3.
-Hexadecimal number > 0xffffffff non-portable at (eval 1) line 3.
-########
-
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings ;
-    eval '
-       my $a = oct "0xfffffffffffffffffg" ;
-    '; print STDERR $@ ;
-}
-EXPECT
-Integer overflow in hexadecimal number at (eval 1) line 2.
-Illegal hexadecimal digit 'g' ignored at (eval 1) line 2.
-Hexadecimal number > 0xffffffff non-portable at (eval 1) line 2.
-########
-
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings;
-    eval '
-        no warnings ;
-       my $a = oct "0xfffffffffffffffffg" ;
-    '; print STDERR $@ ;
-}
-EXPECT
-
-########
-
-# Check scope of pragma with eval
-no warnings;
-{
-    use warnings 'deprecated' ;
-    eval '
-       my $a = oct "0xfffffffffffffffffg" ;
-    '; print STDERR $@;
-}
-EXPECT
-

diff --git a/t/pragma/warn/7fatal b/t/pragma/warn/7fatal
deleted file mode 100644 (file)
index a25fa2c..0000000
--- a/t/pragma/warn/7fatal
+++ /dev/null
@@ -1,312 +0,0 @@
-Check FATAL functionality
-
-__END__
-
-# Check compile time warning
-use warnings FATAL => 'syntax' ;
-{
-    no warnings ;
-    $a =+ 1 ;
-}
-$a =+ 1 ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at - line 8.
-########
-
-# Check compile time warning
-use warnings FATAL => 'all' ;
-{
-    no warnings ;
-    my $a =+ 1 ;
-}
-my $a =+ 1 ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at - line 8.
-########
-
-# Check runtime scope of pragma
-use warnings FATAL => 'uninitialized' ;
-{
-    no warnings ;
-    my $b ; chop $b ;
-}
-my $b ; chop $b ;
-print STDERR "The End.\n" ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 8.
-########
-
-# Check runtime scope of pragma
-use warnings FATAL => 'all' ;
-{
-    no warnings ;
-    my $b ; chop $b ;
-}
-my $b ; chop $b ;
-print STDERR "The End.\n" ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 8.
-########
-
-# Check runtime scope of pragma
-no warnings ;
-{
-    use warnings FATAL => 'uninitialized' ;
-    $a = sub { my $b ; chop $b ; }
-}
-&$a ;
-print STDERR "The End.\n" ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 6.
-########
-
-# Check runtime scope of pragma
-no warnings ;
-{
-    use warnings FATAL => 'all' ;
-    $a = sub { my $b ; chop $b ; }
-}
-&$a ;
-print STDERR "The End.\n" ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 6.
-########
-
---FILE-- abc
-$a =+ 1 ;
-1;
---FILE-- 
-use warnings FATAL => 'syntax' ;
-require "./abc";
-EXPECT
-
-########
-
---FILE-- abc
-use warnings FATAL => 'syntax' ;
-1;
---FILE-- 
-require "./abc";
-$a =+ 1 ;
-EXPECT
-
-########
-
---FILE-- abc
-use warnings 'syntax' ;
-$a =+ 1 ;
-1;
---FILE-- 
-use warnings FATAL => 'uninitialized' ;
-require "./abc";
-my $a ; chop $a ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at ./abc line 2.
-Use of uninitialized value in scalar chop at - line 3.
-########
-
---FILE-- abc.pm
-use warnings 'syntax' ;
-$a =+ 1 ;
-1;
---FILE-- 
-use warnings FATAL => 'uninitialized' ;
-use abc;
-my $a ; chop $a ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at abc.pm line 2.
-Use of uninitialized value in scalar chop at - line 3.
-########
-
-# Check scope of pragma with eval
-no warnings ;
-eval {
-    use warnings FATAL => 'uninitialized' ;
-    my $b ; chop $b ;
-}; print STDERR "-- $@" ;
-my $b ; chop $b ;
-print STDERR "The End.\n" ;
-EXPECT
--- Use of uninitialized value in scalar chop at - line 6.
-The End.
-########
-
-# Check scope of pragma with eval
-use warnings FATAL => 'uninitialized' ;
-eval {
-    my $b ; chop $b ;
-}; print STDERR "-- $@" ;
-my $b ; chop $b ;
-print STDERR "The End.\n" ;
-EXPECT
--- Use of uninitialized value in scalar chop at - line 5.
-Use of uninitialized value in scalar chop at - line 7.
-########
-
-# Check scope of pragma with eval
-use warnings FATAL => 'uninitialized' ;
-eval {
-    no warnings ;
-    my $b ; chop $b ;
-}; print STDERR $@ ;
-my $b ; chop $b ;
-print STDERR "The End.\n" ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 8.
-########
-
-# Check scope of pragma with eval
-no warnings ;
-eval {
-    use warnings FATAL => 'syntax' ;
-    $a =+ 1 ;
-}; print STDERR "-- $@" ;
-$a =+ 1 ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at - line 6.
-########
-
-# Check scope of pragma with eval
-use warnings FATAL => 'syntax' ;
-eval {
-    $a =+ 1 ;
-}; print STDERR "-- $@" ;
-$a =+ 1 ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at - line 5.
-########
-
-# Check scope of pragma with eval
-use warnings FATAL => 'syntax' ;
-eval {
-    no warnings ;
-    $a =+ 1 ;
-}; print STDERR $@ ;
-$a =+ 1 ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at - line 8.
-########
-
-# Check scope of pragma with eval
-no warnings ;
-eval {
-    use warnings FATAL => 'syntax' ;
-}; print STDERR $@ ;
-$a =+ 1 ;
-print STDERR "The End.\n" ;
-EXPECT
-The End.
-########
-
-# Check scope of pragma with eval
-no warnings ;
-eval q[ 
-    use warnings FATAL => 'uninitialized' ;
-    my $b ; chop $b ;
-]; print STDERR "-- $@";
-my $b ; chop $b ;
-print STDERR "The End.\n" ;
-EXPECT
--- Use of uninitialized value in scalar chop at (eval 1) line 3.
-The End.
-########
-
-# Check scope of pragma with eval
-use warnings FATAL => 'uninitialized' ;
-eval '
-    my $b ; chop $b ;
-'; print STDERR "-- $@" ;
-my $b ; chop $b ;
-print STDERR "The End.\n" ;
-EXPECT
--- Use of uninitialized value in scalar chop at (eval 1) line 2.
-Use of uninitialized value in scalar chop at - line 7.
-########
-
-# Check scope of pragma with eval
-use warnings FATAL => 'uninitialized' ;
-eval '
-    no warnings ;
-    my $b ; chop $b ;
-'; print STDERR $@ ;
-my $b ; chop $b ;
-print STDERR "The End.\n" ;
-EXPECT
-Use of uninitialized value in scalar chop at - line 8.
-########
-
-# Check scope of pragma with eval
-no warnings ;
-eval q[ 
-    use warnings FATAL => 'syntax' ;
-    $a =+ 1 ;
-]; print STDERR "-- $@";
-$a =+ 1 ;
-print STDERR "The End.\n" ;
-EXPECT
--- Reversed += operator at (eval 1) line 3.
-The End.
-########
-
-# Check scope of pragma with eval
-use warnings FATAL => 'syntax' ;
-eval '
-    $a =+ 1 ;
-'; print STDERR "-- $@";
-print STDERR "The End.\n" ;
-EXPECT
--- Reversed += operator at (eval 1) line 2.
-The End.
-########
-
-# Check scope of pragma with eval
-use warnings FATAL => 'syntax' ;
-eval '
-    no warnings ;
-    $a =+ 1 ;
-'; print STDERR "-- $@";
-$a =+ 1 ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at - line 8.
-########
-
-use warnings 'void' ;
-
-time ;
-
-{
-    use warnings FATAL => qw(void) ;
-    length "abc" ;
-}
-
-join "", 1,2,3 ;
-
-print "done\n" ;
-EXPECT
-Useless use of time in void context at - line 4.
-Useless use of length in void context at - line 8.
-########
-
-use warnings ;
-
-time ;
-
-{
-    use warnings FATAL => qw(void) ;
-    length "abc" ;
-}
-
-join "", 1,2,3 ;
-
-print "done\n" ;
-EXPECT
-Useless use of time in void context at - line 4.
-Useless use of length in void context at - line 8.

diff --git a/t/pragma/warn/8signal b/t/pragma/warn/8signal
deleted file mode 100644 (file)
index cc1b9d9..0000000
--- a/t/pragma/warn/8signal
+++ /dev/null
@@ -1,18 +0,0 @@
-Check interaction of __WARN__, __DIE__ & lexical Warnings
-
-TODO
-
-__END__
-# 8signal
-BEGIN { $| = 1; $SIG{__WARN__} = sub { print "WARN -- @_" } }
-BEGIN { $SIG{__DIE__}  = sub { print "DIE -- @_" } }
-$a =+ 1 ;
-use warnings qw(syntax) ;
-$a =+ 1 ;
-use warnings FATAL => qw(syntax) ;
-$a =+ 1 ;
-print "The End.\n" ;
-EXPECT
-WARN -- Reversed += operator at - line 6.
-DIE -- Reversed += operator at - line 8.
-Reversed += operator at - line 8.

diff --git a/t/pragma/warn/9enabled b/t/pragma/warn/9enabled
deleted file mode 100755 (executable)
index f5579b2..0000000
--- a/t/pragma/warn/9enabled
+++ /dev/null
@@ -1,1162 +0,0 @@
-Check warnings::enabled & warnings::warn
-
-__END__
-
---FILE-- abc.pm
-package abc ;
-use warnings "io" ;
-print "ok1\n" if ! warnings::enabled('all') ;
-print "ok2\n" if ! warnings::enabled("io") ;
-1;
---FILE-- 
-no warnings;
-use abc ;
-EXPECT
-ok1
-ok2
-########
-
---FILE-- abc.pm
-package abc ;
-no warnings ;
-print "ok1\n" if !warnings::enabled('all') ;
-print "ok2\n" if warnings::enabled("syntax") ;
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-EXPECT
-ok1
-ok2
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'syntax' ;
-print "ok1\n" if   warnings::enabled('io') ;
-print "ok2\n" if ! warnings::enabled("syntax") ;
-1;
---FILE-- 
-use warnings 'io' ;
-use abc ;
-EXPECT
-ok1
-ok2
-########
-
---FILE-- abc
-no warnings ;
-print "ok1\n" if !warnings::enabled('all') ;
-print "ok2\n" if warnings::enabled("syntax") ;
-1;
---FILE-- 
-use warnings 'syntax' ;
-require "abc" ;
-EXPECT
-ok1
-ok2
-########
-
---FILE-- abc
-use warnings 'syntax' ;
-print "ok1\n" if ! warnings::enabled('all') ;
-print "ok2\n" if ! warnings::enabled("syntax") ;
-print "ok3\n" if   warnings::enabled("io") ;
-1;
---FILE-- 
-use warnings 'io' ;
-require "abc" ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-no warnings ;
-sub check {
-  print "ok1\n" if !warnings::enabled('all') ;
-  print "ok2\n" if warnings::enabled("syntax") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'io' ;
-sub check {
-  print "ok1\n" if ! warnings::enabled('all') ;
-  print "ok2\n" if   warnings::enabled("syntax") ;
-  print "ok3\n" if ! warnings::enabled("io") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc
-package abc ;
-no warnings ;
-sub check {
-  print "ok1\n" if !warnings::enabled('all') ;
-  print "ok2\n" if warnings::enabled("syntax") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-require "abc" ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-########
-
---FILE-- abc
-package abc ;
-use warnings 'io' ;
-sub check {
-  print "ok1\n" if ! warnings::enabled('all') ;
-  print "ok2\n" if   warnings::enabled("syntax") ;
-  print "ok3\n" if ! warnings::enabled("io") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-require "abc" ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings "io" ;
-print "ok1\n" if ! warnings::enabled('all') ;
-print "ok2\n" if ! warnings::enabled("io") ;
-1;
---FILE-- def.pm
-no warnings;
-use abc ;
-1;
---FILE-- 
-use warnings;
-use def ;
-EXPECT
-ok1
-ok2
-########
-
---FILE-- abc.pm
-package abc ;
-no warnings ;
-print "ok1\n" if ! warnings::enabled('all') ;
-print "ok2\n" if warnings::enabled("syntax") ;
-print "ok3\n" if !warnings::enabled("io") ;
-1;
---FILE-- def.pm
-use warnings 'syntax' ;
-print "ok4\n" if !warnings::enabled('all') ;
-print "ok5\n" if warnings::enabled("io") ;
-use abc ;
-1;
---FILE--
-use warnings 'io' ;
-use def ;
-EXPECT
-ok1
-ok2
-ok3
-ok4
-ok5
-########
-
---FILE-- abc.pm
-package abc ;
-no warnings ;
-sub check {
-  print "ok1\n" if !warnings::enabled('all') ;
-  print "ok2\n" if warnings::enabled("syntax") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-eval { abc::check() ; };
-print $@ ;
-EXPECT
-ok1
-ok2
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'io' ;
-sub check {
-  print "ok1\n" if ! warnings::enabled('all') ;
-  print "ok2\n" if   warnings::enabled("syntax") ;
-  print "ok3\n" if ! warnings::enabled("io") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-eval { abc::check() ; } ;
-print $@ ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc
-package abc ;
-no warnings ;
-sub check {
-  print "ok1\n" if !warnings::enabled('all') ;
-  print "ok2\n" if warnings::enabled("syntax") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-require "abc" ;
-eval { abc::check() ; } ;
-print $@ ;
-EXPECT
-ok1
-ok2
-########
-
---FILE-- abc
-package abc ;
-use warnings 'io' ;
-sub check {
-  print "ok1\n" if !warnings::enabled('all') ;
-  print "ok2\n" if warnings::enabled("syntax") ;
-  print "ok3\n" if warnings::enabled("io") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-require "abc" ;
-eval { use warnings 'io' ; abc::check() ; };
-abc::check() ; 
-print $@ ;
-EXPECT
-ok1
-ok2
-ok3
-ok1
-ok2
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'io' ;
-sub check {
-  print "ok1\n" if ! warnings::enabled('all') ;
-  print "ok2\n" if  warnings::enabled("syntax") ;
-  print "ok3\n" if ! warnings::enabled("io") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-sub fred { abc::check() }
-fred() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'io' ;
-sub check {
-  print "ok1\n" if  ! warnings::enabled('all') ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-sub fred { no warnings ; abc::check() }
-fred() ;
-EXPECT
-ok1
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'misc' ;
-sub check {
-  print "ok1\n" if  ! warnings::enabled('all') ;
-  print "ok2\n" if  warnings::enabled("syntax") ;
-  print "ok3\n" if  warnings::enabled("io") ;
-  print "ok4\n" if  ! warnings::enabled("misc") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-sub fred { use warnings 'io'  ; abc::check() }
-fred() ;
-EXPECT
-ok1
-ok2
-ok3
-ok4
-########
-
-# check warnings::warn
-use warnings ;
-eval { warnings::warn() } ;
-print $@ ;
-eval { warnings::warn("fred", "joe") } ;
-print $@ ;
-EXPECT
-Usage: warnings::warn([category,] 'message') at - line 4
-unknown warnings category 'fred' at - line 6
-########
-
-# check warnings::warnif
-use warnings ;
-eval { warnings::warnif() } ;
-print $@ ;
-eval { warnings::warnif("fred", "joe") } ;
-print $@ ;
-EXPECT
-Usage: warnings::warnif([category,] 'message') at - line 4
-unknown warnings category 'fred' at - line 6
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'misc' ;
-sub check { warnings::warn("io", "hello") }
-1;
---FILE--
-use warnings "io" ;
-use abc;
-abc::check() ;
-EXPECT
-hello at - line 3
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'misc' ;
-sub check { warnings::warn("misc", "hello") }
-1;
---FILE--
-use warnings "io" ;
-use abc;
-abc::check() ;
-EXPECT
-hello at - line 3
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'misc' ;
-sub check { warnings::warn("io", "hello") }
-1;
---FILE--
-use warnings qw( FATAL deprecated ) ;
-use abc;
-eval { abc::check() ; } ;
-print "[[$@]]\n";
-EXPECT
-hello at - line 3
-       eval {...} called at - line 3
-[[]]
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'misc' ;
-sub check { warnings::warn("io", "hello") }
-1;
---FILE--
-use warnings qw( FATAL io ) ;
-use abc;
-eval { abc::check() ; } ;
-print "[[$@]]\n";
-EXPECT
-[[hello at - line 3
-       eval {...} called at - line 3
-]]
-########
--W
---FILE-- abc.pm
-package abc ;
-use warnings "io" ;
-print "ok1\n" if warnings::enabled("io") ;
-print "ok2\n" if warnings::enabled("all") ;
-1;
---FILE-- 
-no warnings;
-use abc ;
-EXPECT
-ok1
-ok2
-########
--X
---FILE-- abc.pm
-package abc ;
-use warnings "io" ;
-print "ok1\n" if !warnings::enabled("io") ;
-print "ok2\n" if !warnings::enabled("all") ;
-1;
---FILE-- 
-use warnings;
-use abc ;
-EXPECT
-ok1
-ok2
-########
-
---FILE-- abc.pm
-package abc ;
-no warnings ;
-sub check {
-  print "ok\n" if ! warnings::enabled() ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-abc::check() ;
-EXPECT
-package 'abc' not registered for warnings at abc.pm line 4
-########
-
---FILE-- abc.pm
-package abc ;
-no warnings ;
-sub check {
-  warnings::warn("fred") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-abc::check() ;
-EXPECT
-package 'abc' not registered for warnings at abc.pm line 4
-########
-
---FILE-- abc.pm
-package abc ;
-no warnings ;
-sub check {
-  warnings::warnif("fred") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-abc::check() ;
-EXPECT
-package 'abc' not registered for warnings at abc.pm line 4
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'io' ;
-use warnings::register ;
-sub check {
-  print "ok1\n" if  warnings::enabled ;
-  print "ok2\n" if  warnings::enabled("syntax") ;
-  print "ok3\n" if !warnings::enabled("io") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-use warnings 'abc' ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'io' ;
-use warnings::register ;
-sub check {
-  print "ok1\n" if !warnings::enabled ;
-  print "ok2\n" if  warnings::enabled("syntax") ;
-  print "ok3\n" if !warnings::enabled("io") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-no warnings ;
-use warnings::register ;
-sub check {
-  print "ok1\n" if warnings::enabled ;
-  print "ok2\n" if warnings::enabled("syntax") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-use warnings 'abc' ;
-eval { abc::check() ; };
-print $@ ;
-EXPECT
-ok1
-ok2
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'io' ;
-use warnings::register ;
-sub check {
-  print "ok1\n" if !warnings::enabled ;
-  print "ok2\n" if  warnings::enabled("syntax") ;
-  print "ok3\n" if !warnings::enabled("io") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-eval { abc::check() ; } ;
-print $@ ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'io' ;
-use warnings::register ;
-sub check {
-  print "ok1\n" if  warnings::enabled ;
-  print "ok2\n" if  warnings::enabled("syntax") ;
-  print "ok3\n" if !warnings::enabled("io") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-use warnings 'abc' ;
-sub fred { abc::check() }
-fred() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'io' ;
-use warnings::register ;
-sub check {
-  print "ok1\n" if  ! warnings::enabled ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-sub fred { no warnings ; abc::check() }
-fred() ;
-EXPECT
-ok1
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'misc' ;
-use warnings::register;
-sub check {
-  print "ok1\n" if  warnings::enabled ;
-  print "ok2\n" if  warnings::enabled("syntax") ;
-  print "ok3\n" if  warnings::enabled("io") ;
-  print "ok4\n" if  ! warnings::enabled("misc") ;
-}
-1;
---FILE-- 
-use warnings 'syntax' ;
-use abc ;
-use warnings 'abc' ;
-sub fred { use warnings 'io'  ; abc::check() }
-fred() ;
-EXPECT
-ok1
-ok2
-ok3
-ok4
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings 'misc' ;
-use warnings::register;
-sub check { warnings::warn("hello") }
-1;
---FILE--
-use abc;
-use warnings "abc" ;
-abc::check() ;
-EXPECT
-hello at - line 3
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings::register;
-sub check { warnings::warn("hello") }
-1;
---FILE--
-use abc;
-abc::check() ;
-EXPECT
-hello at - line 2
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings::register ;
-sub check { warnings::warn("hello") }
-1;
---FILE--
-use abc;
-use warnings qw( FATAL deprecated ) ;
-eval { abc::check() ; } ;
-print "[[$@]]\n";
-EXPECT
-hello at - line 3
-       eval {...} called at - line 3
-[[]]
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings::register ;
-sub check { warnings::warn("hello") }
-1;
---FILE--
-use abc;
-use warnings qw( FATAL abc ) ;
-eval { abc::check() ; } ;
-print "[[$@]]\n";
-EXPECT
-[[hello at - line 3
-       eval {...} called at - line 3
-]]
-########
--W
---FILE-- abc.pm
-package abc ;
-use warnings "io" ;
-use warnings::register ;
-sub check { 
-  print "ok1\n" if warnings::enabled() ;
-  print "ok2\n" if warnings::enabled("io") ;
-  print "ok3\n" if warnings::enabled("all") ;
-}
-1;
---FILE-- 
-no warnings;
-use abc ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
--X
---FILE-- abc.pm
-package abc ;
-use warnings "io" ;
-use warnings::register ;
-sub check { 
-  print "ok1\n" if !warnings::enabled() ;
-  print "ok2\n" if !warnings::enabled("io") ;
-  print "ok3\n" if !warnings::enabled("all") ;
-}
-1;
---FILE-- 
-no warnings;
-use abc ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings "io" ;
-use warnings::register ;
-sub check { 
-  print "ok1\n" if warnings::enabled() ;
-  print "ok2\n" if warnings::enabled("io") ;
-  print "ok3\n" if warnings::enabled("all") ;
-}
-1;
---FILE-- 
-use warnings 'all';
-use abc ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings "io" ;
-use warnings::register ;
-sub check { 
-  print "ok1\n" if !warnings::enabled() ;
-  print "ok2\n" if !warnings::enabled("io") ;
-  print "ok3\n" if !warnings::enabled("all") ;
-}
-1;
---FILE-- 
-use abc ;
-no warnings ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings "io" ;
-use warnings::register ;
-sub check { 
-  print "ok1\n" if !warnings::enabled() ;
-  print "ok2\n" if !warnings::enabled("io") ;
-  print "ok3\n" if !warnings::enabled("all") ;
-  warnings::warnif("my message 1") ;
-  warnings::warnif('abc', "my message 2") ;
-  warnings::warnif('io', "my message 3") ;
-  warnings::warnif('all', "my message 4") ;
-}
-1;
---FILE-- 
-use abc ;
-use warnings 'abc';
-no warnings ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-use warnings "io" ;
-use warnings::register ;
-sub check { 
-  print "abc self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
-  print "abc def"  . (warnings::enabled('def') ? "" : " not") . " enabled\n" ;
-  print "abc all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
-}
-1;
---FILE-- def.pm
-package def ;
-use warnings "io" ;
-use warnings::register ;
-sub check { 
-  print "def self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
-  print "def abc"  . (warnings::enabled('abc') ? "" : " not") . " enabled\n" ;
-  print "def all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
-}
-1;
---FILE-- 
-use abc ;
-use def ;
-use warnings 'abc';
-abc::check() ;
-def::check() ;
-no warnings 'abc'  ;
-use warnings 'def'  ;
-abc::check() ;
-def::check() ;
-use warnings 'abc'  ;
-use warnings 'def'  ;
-abc::check() ;
-def::check() ;
-no warnings 'abc'  ;
-no warnings 'def'  ;
-abc::check() ;
-def::check() ;
-use warnings;
-abc::check() ;
-def::check() ;
-no warnings 'abc' ;
-abc::check() ;
-def::check() ;
-EXPECT
-abc self enabled
-abc def not enabled
-abc all not enabled
-def self not enabled
-def abc enabled
-def all not enabled
-abc self not enabled
-abc def enabled
-abc all not enabled
-def self enabled
-def abc not enabled
-def all not enabled
-abc self enabled
-abc def enabled
-abc all not enabled
-def self enabled
-def abc enabled
-def all not enabled
-abc self not enabled
-abc def not enabled
-abc all not enabled
-def self not enabled
-def abc not enabled
-def all not enabled
-abc self enabled
-abc def enabled
-abc all enabled
-def self enabled
-def abc enabled
-def all enabled
-abc self not enabled
-abc def enabled
-abc all not enabled
-def self enabled
-def abc not enabled
-def all not enabled
-########
--w
---FILE-- abc.pm
-package abc ;
-no warnings ;
-use warnings::register ;
-sub check { 
-  print "ok1\n" if warnings::enabled() ;
-  print "ok2\n" if warnings::enabled("io") ;
-  print "ok3\n" if warnings::enabled("all") ;
-}
-1;
---FILE-- 
-use abc ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
--w
---FILE-- abc.pm
-package abc ;
-no warnings ;
-use warnings::register ;
-sub check { 
-  print "ok1\n" if !warnings::enabled() ;
-  print "ok2\n" if !warnings::enabled("io") ;
-  print "ok3\n" if !warnings::enabled("all") ;
-}
-1;
---FILE-- 
-use abc ;
-use warnings 'abc';
-no warnings ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-no warnings ;
-use warnings::register ;
-sub check { 
-  print "ok1\n" if !warnings::enabled() ;
-  print "ok2\n" if !warnings::enabled("io") ;
-  print "ok3\n" if !warnings::enabled("all") ;
-  warnings::warnif("my message 1") ;
-  warnings::warnif('abc', "my message 2") ;
-  warnings::warnif('io', "my message 3") ;
-  warnings::warnif('all', "my message 4") ;
-}
-1;
---FILE-- 
-use abc ;
-use warnings 'abc';
-no warnings ;
-BEGIN { $^W = 1 ; }
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-package abc ;
-no warnings ;
-use warnings::register ;
-sub check { 
-  print "ok1\n" if !warnings::enabled() ;
-  print "ok2\n" if !warnings::enabled("io") ;
-  print "ok3\n" if !warnings::enabled("all") ;
-}
-1;
---FILE-- 
-use abc ;
-use warnings 'abc';
-no warnings ;
-$^W = 1 ;
-abc::check() ;
-EXPECT
-ok1
-ok2
-ok3
-########
-
---FILE-- abc.pm
-$| = 1;
-package abc ;
-no warnings ;
-use warnings::register ;
-sub check { 
-  print "ok1\n" if  warnings::enabled() ;
-  print "ok2\n" if !warnings::enabled("io") ;
-  print "ok3\n" if !warnings::enabled("all") ;
-  print "ok4\n" if  warnings::enabled("abc") ;
-  warnings::warn("my message 1") ;
-  warnings::warnif("my message 2") ;
-  warnings::warnif('abc', "my message 3") ;
-  warnings::warnif('io', "my message 4") ;
-  warnings::warnif('all', "my message 5") ;
-}
-sub in2 { no warnings ; check() }
-sub in1 { no warnings ; in2() }
-1;
---FILE-- 
-use abc ;
-use warnings 'abc';
-abc::in1() ;
-EXPECT
-ok1
-ok2
-ok3
-ok4
-my message 1 at - line 3
-my message 2 at - line 3
-my message 3 at - line 3
-########
-
---FILE-- def.pm
-package def ;
-no warnings ;
-use warnings::register ;
-sub check { 
-  print "ok1\n" if  warnings::enabled() ;
-  print "ok2\n" if !warnings::enabled("io") ;
-  print "ok3\n" if !warnings::enabled("all") ;
-  print "ok4\n" if  warnings::enabled("def") ;
-  warnings::warn("my message 1") ;
-  warnings::warnif("my message 2") ;
-  warnings::warnif('def', "my message 3") ;
-  warnings::warnif('io', "my message 4") ;
-  warnings::warnif('all', "my message 5") ;
-}
-sub in2 { no warnings ; check() }
-sub in1 { no warnings ; in2() }
-1;
---FILE-- abc.pm
-$| = 1;
-package abc ;
-use def ;
-use warnings 'def';
-sub in1 { def::in1() ; }
-1;
---FILE-- 
-use abc ;
-no warnings;
-abc::in1() ;
-EXPECT
-ok1
-ok2
-ok3
-ok4
-my message 1 at abc.pm line 5
-       abc::in1() called at - line 3
-my message 2 at abc.pm line 5
-       abc::in1() called at - line 3
-my message 3 at abc.pm line 5
-       abc::in1() called at - line 3
-########
-
---FILE-- def.pm
-$| = 1;
-package def ;
-no warnings ;
-use warnings::register ;
-require Exporter;
-@ISA = qw( Exporter ) ;
-@EXPORT = qw( in1 ) ;
-sub check { 
-  print "ok1\n" if  warnings::enabled() ;
-  print "ok2\n" if !warnings::enabled("io") ;
-  print "ok3\n" if !warnings::enabled("all") ;
-  print "ok4\n" if  warnings::enabled("abc") ;
-  print "ok5\n" if !warnings::enabled("def") ;
-  warnings::warn("my message 1") ;
-  warnings::warnif("my message 2") ;
-  warnings::warnif('abc', "my message 3") ;
-  warnings::warnif('def', "my message 4") ;
-  warnings::warnif('io', "my message 5") ;
-  warnings::warnif('all', "my message 6") ;
-}
-sub in2 { no warnings ; check() }
-sub in1 { no warnings ; in2() }
-1;
---FILE-- abc.pm
-package abc ;
-use warnings::register ;
-use def ;
-#@ISA = qw(def) ;
-1;
---FILE-- 
-use abc ;
-no warnings;
-use warnings 'abc';
-abc::in1() ;
-EXPECT
-ok2
-ok3
-ok4
-ok5
-my message 1 at - line 4
-my message 3 at - line 4
-########
-
---FILE-- def.pm
-package def ;
-no warnings ;
-use warnings::register ;
-
-sub new
-{
-    my $class = shift ;
-    bless [], $class ;
-}
-
-sub check 
-{ 
-  my $self = shift ;
-  print "ok1\n" if !warnings::enabled() ;
-  print "ok2\n" if !warnings::enabled("io") ;
-  print "ok3\n" if !warnings::enabled("all") ;
-  print "ok4\n" if  warnings::enabled("abc") ;
-  print "ok5\n" if !warnings::enabled("def") ;
-  print "ok6\n" if  warnings::enabled($self) ;
-
-  warnings::warn("my message 1") ;
-  warnings::warn($self, "my message 2") ;
-
-  warnings::warnif("my message 3") ;
-  warnings::warnif('abc', "my message 4") ;
-  warnings::warnif('def', "my message 5") ;
-  warnings::warnif('io', "my message 6") ;
-  warnings::warnif('all', "my message 7") ;
-  warnings::warnif($self, "my message 8") ;
-}
-sub in2 
-{
-  no warnings ; 
-  my $self = shift ;
-  $self->check() ;
-}
-sub in1 
-{ 
-  no warnings ;
-  my $self = shift ;
-  $self->in2();
-}
-1;
---FILE-- abc.pm
-$| = 1;
-package abc ;
-use warnings::register ;
-use def ;
-@ISA = qw(def) ;
-sub new
-{
-    my $class = shift ;
-    bless [], $class ;
-}
-
-1;
---FILE-- 
-use abc ;
-no warnings;
-use warnings 'abc';
-$a = new abc ;
-$a->in1() ;
-print "**\n";
-$b = new def ;
-$b->in1() ;
-EXPECT
-ok1
-ok2
-ok3
-ok4
-ok5
-ok6
-my message 1 at - line 5
-my message 2 at - line 5
-my message 4 at - line 5
-my message 8 at - line 5
-**
-ok1
-ok2
-ok3
-ok4
-ok5
-my message 1 at - line 8
-my message 2 at - line 8
-my message 4 at - line 8

diff --git a/t/pragma/warn/av b/t/pragma/warn/av
deleted file mode 100644 (file)
index 79bd3b7..0000000
--- a/t/pragma/warn/av
+++ /dev/null
@@ -1,9 +0,0 @@
-  av.c 
-
-  Mandatory Warnings ALL TODO
-  ------------------
-  av_reify called on tied array                [av_reify]
-
-  Attempt to clear deleted array       [av_clear]
-  
-__END__

diff --git a/t/pragma/warn/doio b/t/pragma/warn/doio
deleted file mode 100644 (file)
index 2a357e2..0000000
--- a/t/pragma/warn/doio
+++ /dev/null
@@ -1,209 +0,0 @@
-  doio.c       
-
-  Can't open bidirectional pipe                [Perl_do_open9]
-    open(F, "| true |");
-
-  Missing command in piped open                [Perl_do_open9]
-    open(F, "| ");
-
-  Missing command in piped open                [Perl_do_open9]
-    open(F, " |");
-
-  warn(warn_nl, "open");               [Perl_do_open9]
-    open(F, "true\ncd")
-
-  close() on unopened filehandle %s    [Perl_do_close]
-    $a = "fred";close("$a")
-
-  tell() on closed filehandle          [Perl_do_tell]
-    $a = "fred";$a = tell($a)
-
-  seek() on closed filehandle          [Perl_do_seek]
-    $a = "fred";$a = seek($a,1,1)
-
-  sysseek() on closed filehandle       [Perl_do_sysseek]
-    $a = "fred";$a = seek($a,1,1)
-
-  warn(warn_uninit);                   [Perl_do_print]
-    print $a ;
-
-  -x on closed filehandle %s           [Perl_my_stat]
-    close STDIN ; -x STDIN ;
-
-  warn(warn_nl, "stat");               [Perl_my_stat]
-    stat "ab\ncd"
-
-  warn(warn_nl, "lstat");              [Perl_my_lstat]
-    lstat "ab\ncd"
-
-  Can't exec \"%s\": %s                [Perl_do_aexec5]
-
-  Can't exec \"%s\": %s                [Perl_do_exec3]
-
-  Filehandle %s opened only for output [Perl_do_eof]
-       my $a = eof STDOUT
-
-  Mandatory Warnings ALL TODO
-  ------------------
-  Can't do inplace edit: %s is not a regular file      [Perl_nextargv]
-     edit a directory
-
-  Can't do inplace edit: %s would not be unique                [Perl_nextargv]
-  Can't rename %s to %s: %s, skipping file             [Perl_nextargv]
-  Can't rename %s to %s: %s, skipping file             [Perl_nextargv]
-  Can't remove %s: %s, skipping file                   [Perl_nextargv]
-  Can't do inplace edit on %s: %s                      [Perl_nextargv]
-  
-
-__END__
-# doio.c [Perl_do_open9]
-use warnings 'io' ;
-open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
-close(F);
-no warnings 'io' ;
-open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
-close(G);
-EXPECT
-Can't open bidirectional pipe at - line 3.
-########
-# doio.c [Perl_do_open9]
-use warnings 'io' ;
-open(F, "|      ");
-no warnings 'io' ;
-open(G, "|      ");
-EXPECT
-Missing command in piped open at - line 3.
-########
-# doio.c [Perl_do_open9]
-use warnings 'io' ;
-open(F, "      |");
-no warnings 'io' ;
-open(G, "      |");
-EXPECT
-Missing command in piped open at - line 3.
-########
-# doio.c [Perl_do_open9]
-use warnings 'io' ;
-open(F, "<true\ncd");
-no warnings 'io' ;
-open(G, "<true\ncd");
-EXPECT
-Unsuccessful open on filename containing newline at - line 3.
-########
-# doio.c [Perl_do_close] <<TODO
-use warnings 'unopened' ;
-close "fred" ;
-no warnings 'unopened' ;
-close "joe" ;
-EXPECT
-close() on unopened filehandle fred at - line 3.
-########
-# doio.c [Perl_do_tell Perl_do_seek Perl_do_sysseek Perl_my_stat]
-use warnings 'io' ;
-close STDIN ;
-tell(STDIN);
-$a = seek(STDIN,1,1);
-$a = sysseek(STDIN,1,1);
--x STDIN ;
-stat(STDIN) ;
-$a = "fred";
-tell($a);
-seek($a,1,1);
-sysseek($a,1,1);
--x $a; # ok
-stat($a); # ok
-no warnings 'io' ;
-close STDIN ;
-tell(STDIN);
-$a = seek(STDIN,1,1);
-$a = sysseek(STDIN,1,1);
--x STDIN ;
-stat(STDIN) ;
-$a = "fred";
-tell($a);
-seek($a,1,1);
-sysseek($a,1,1);
--x $a;
-stat($a);
-EXPECT
-tell() on closed filehandle STDIN at - line 4.
-seek() on closed filehandle STDIN at - line 5.
-sysseek() on closed filehandle STDIN at - line 6.
--x on closed filehandle STDIN at - line 7.
-stat() on closed filehandle STDIN at - line 8.
-tell() on unopened filehandle at - line 10.
-seek() on unopened filehandle at - line 11.
-sysseek() on unopened filehandle at - line 12.
-########
-# doio.c [Perl_do_print]
-use warnings 'uninitialized' ;
-print $a ;
-no warnings 'uninitialized' ;
-print $b ;
-EXPECT
-Use of uninitialized value in print at - line 3.
-########
-# doio.c [Perl_my_stat Perl_my_lstat]
-use warnings 'io' ;
-stat "ab\ncd";
-lstat "ab\ncd";
-no warnings 'io' ;
-stat "ab\ncd";
-lstat "ab\ncd";
-EXPECT
-Unsuccessful stat on filename containing newline at - line 3.
-Unsuccessful stat on filename containing newline at - line 4.
-########
-# doio.c [Perl_do_aexec5]
-use warnings 'io' ;
-exec "lskdjfalksdjfdjfkls","" ;
-no warnings 'io' ;
-exec "lskdjfalksdjfdjfkls","" ;
-EXPECT
-OPTION regex
-Can't exec "lskdjfalksdjfdjfkls": .+
-########
-# doio.c [Perl_do_exec3]
-use warnings 'io' ;
-exec "lskdjfalksdjfdjfkls", "abc" ;
-no warnings 'io' ;
-exec "lskdjfalksdjfdjfkls", "abc" ;
-EXPECT
-OPTION regex
-Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+
-########
-# doio.c [Perl_nextargv]
-$^W = 0 ;
-my $filename = "./temp.dir" ;
-mkdir $filename, 0777 
-  or die "Cannot create directory $filename: $!\n" ;
-{
-    local (@ARGV) = ($filename) ;
-    local ($^I) = "" ;
-    my $x = <> ;
-}
-{
-    no warnings 'inplace' ;
-    local (@ARGV) = ($filename) ;
-    local ($^I) = "" ;
-    my $x = <> ;
-}
-{
-    use warnings 'inplace' ;
-    local (@ARGV) = ($filename) ;
-    local ($^I) = "" ;
-    my $x = <> ;
-}
-rmdir $filename ;
-EXPECT
-Can't do inplace edit: ./temp.dir is not a regular file at - line 9.
-Can't do inplace edit: ./temp.dir is not a regular file at - line 21.
-
-########
-# doio.c [Perl_do_eof]
-use warnings 'io' ;
-my $a = eof STDOUT ;
-no warnings 'io' ;
-$a = eof STDOUT ;
-EXPECT
-Filehandle STDOUT opened only for output at - line 3.

diff --git a/t/pragma/warn/doop b/t/pragma/warn/doop
deleted file mode 100644 (file)
index 5803b44..0000000
--- a/t/pragma/warn/doop
+++ /dev/null
@@ -1,6 +0,0 @@
-# doop.c
-use utf8 ;
-$_ = "\x80  \xff" ;
-chop ;
-EXPECT
-########

diff --git a/t/pragma/warn/gv b/t/pragma/warn/gv
deleted file mode 100644 (file)
index 5ed4eca..0000000
--- a/t/pragma/warn/gv
+++ /dev/null
@@ -1,54 +0,0 @@
-  gv.c AOK
-
-     Can't locate package %s for @%s::ISA
-       @ISA = qw(Fred); joe()
-
-     Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated
-       sub Other::AUTOLOAD { 1 } sub Other::fred {}
-       @ISA = qw(Other) ;
-       fred() ;
-
-     Use of $# is deprecated
-     Use of $* is deprecated
-
-       $a = ${"#"} ;
-       $a = ${"*"} ;
-
-  Mandatory Warnings ALL TODO
-  ------------------
-
-    Had to create %s unexpectedly              [gv_fetchpv]
-    Attempt to free unreferenced glob pointers [gp_free]
-    
-__END__
-# gv.c
-use warnings 'misc' ;
-@ISA = qw(Fred); joe()
-EXPECT
-Can't locate package Fred for @main::ISA at - line 3.
-Undefined subroutine &main::joe called at - line 3.
-########
-# gv.c
-no warnings 'misc' ;
-@ISA = qw(Fred); joe()
-EXPECT
-Undefined subroutine &main::joe called at - line 3.
-########
-# gv.c
-sub Other::AUTOLOAD { 1 } sub Other::fred {}
-@ISA = qw(Other) ;
-use warnings 'deprecated' ;
-fred() ;
-EXPECT
-Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5.
-########
-# gv.c
-use warnings 'deprecated' ;
-$a = ${"#"};
-$a = ${"*"};
-no warnings 'deprecated' ;
-$a = ${"#"};
-$a = ${"*"};
-EXPECT
-Use of $# is deprecated at - line 3.
-Use of $* is deprecated at - line 4.

diff --git a/t/pragma/warn/hv b/t/pragma/warn/hv
deleted file mode 100644 (file)
index c9eec02..0000000
--- a/t/pragma/warn/hv
+++ /dev/null
@@ -1,8 +0,0 @@
-  hv.c 
-
-
-  Mandatory Warnings ALL TODO
-  ------------------
-    Attempt to free non-existent shared string [unsharepvn]
-
-__END__

diff --git a/t/pragma/warn/malloc b/t/pragma/warn/malloc
deleted file mode 100644 (file)
index 2f8b096..0000000
--- a/t/pragma/warn/malloc
+++ /dev/null
@@ -1,9 +0,0 @@
-  malloc.c 
-
-
-  Mandatory Warnings ALL TODO
-  ------------------
-    %s free() ignored          [Perl_mfree]
-    %s", "Bad free() ignored   [Perl_mfree]
-
-__END__

diff --git a/t/pragma/warn/mg b/t/pragma/warn/mg
deleted file mode 100644 (file)
index f224335..0000000
--- a/t/pragma/warn/mg
+++ /dev/null
@@ -1,44 +0,0 @@
-  mg.c AOK
-
-  No such signal: SIG%s
-    $SIG{FRED} = sub {}
-
-  SIG%s handler \"%s\" not defined.
-    $SIG{"INT"} = "ok3"; kill "INT",$$;
-
-  Mandatory Warnings TODO
-  ------------------
-  Can't break at that line     [magic_setdbline]
-
-__END__
-# mg.c
-use warnings 'signal' ;
-$SIG{FRED} = sub {};
-EXPECT
-No such signal: SIGFRED at - line 3.
-########
-# mg.c
-no warnings 'signal' ;
-$SIG{FRED} = sub {};
-EXPECT
-
-########
-# mg.c
-use warnings 'signal' ;
-if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
-    print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
-}
-$|=1;
-$SIG{"INT"} = "fred"; kill "INT",$$;
-EXPECT
-SIGINT handler "fred" not defined.
-########
-# mg.c
-no warnings 'signal' ;
-if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
-    print "SKIPPED\n# win32, can't kill() to raise()\n"; exit;
-}
-$|=1;
-$SIG{"INT"} = "fred"; kill "INT",$$;
-EXPECT
-

diff --git a/t/pragma/warn/op b/t/pragma/warn/op
deleted file mode 100644 (file)
index 2f847ad..0000000
--- a/t/pragma/warn/op
+++ /dev/null
@@ -1,928 +0,0 @@
-  op.c         AOK
-
-     "my" variable %s masks earlier declaration in same scope
-       my $x;
-       my $x ;
-
-     Variable "%s" may be unavailable 
-       sub x {
-           my $x;
-           sub y {
-               $x
-           }
-       }
-
-     Variable "%s" will not stay shared 
-       sub x {
-           my $x;
-           sub y {
-               sub { $x }
-           }
-       }
-
-     Found = in conditional, should be ==
-       1 if $a = 1 ;
-
-     Use of implicit split to @_ is deprecated
-       split ;
-
-     Use of implicit split to @_ is deprecated
-       $a = split ;
-
-     Useless use of time in void context
-     Useless use of a variable in void context
-     Useless use of a constant in void context
-       time ;
-       $a ;
-       "abc"
-
-     Applying %s to %s will act on scalar(%s)
-       my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
-       @a =~ /abc/ ;
-       @a =~ s/a/b/ ;
-       @a =~ tr/a/b/ ;
-       @$b =~ /abc/ ;
-       @$b =~ s/a/b/ ;
-       @$b =~ tr/a/b/ ;
-       %a =~ /abc/ ;
-       %a =~ s/a/b/ ;
-       %a =~ tr/a/b/ ;
-       %$c =~ /abc/ ;
-       %$c =~ s/a/b/ ;
-       %$c =~ tr/a/b/ ;
-
-
-     Parentheses missing around "my" list at -e line 1.
-       my $a, $b = (1,2);
- 
-     Parentheses missing around "local" list at -e line 1.
-       local $a, $b = (1,2);
- 
-     Bareword found in conditional at -e line 1.
-       use warnings 'bareword'; my $x = print(ABC || 1);
- 
-     Value of %s may be \"0\"; use \"defined\" 
-       $x = 1 if $x = <FH> ;
-       $x = 1 while $x = <FH> ;
-
-     Subroutine fred redefined at -e line 1.
-       sub fred{1;} sub fred{1;}
- 
-     Constant subroutine %s redefined 
-        sub fred() {1;} sub fred() {1;}
- 
-     Format FRED redefined at /tmp/x line 5.
-       format FRED =
-       .
-       format FRED =
-       .
- 
-     Array @%s missing the @ in argument %d of %s() 
-       push fred ;
- 
-     Hash %%%s missing the %% in argument %d of %s() 
-       keys joe ;
- 
-     Statement unlikely to be reached
-       (Maybe you meant system() when you said exec()?
-       exec "true" ; my $a
-
-     defined(@array) is deprecated
-       (Maybe you should just omit the defined()?)
-       my @a ; defined @a ;
-       defined (@a = (1,2,3)) ;
-
-     defined(%hash) is deprecated
-       (Maybe you should just omit the defined()?)
-       my %h ; defined %h ;
-    
-     /---/ should probably be written as "---"
-        join(/---/, @foo);
-
-    %s() called too early to check prototype           [Perl_peep]
-        fred() ; sub fred ($$) {}
-
-
-    Mandatory Warnings 
-    ------------------
-    Prototype mismatch:                [cv_ckproto]
-        sub fred() ;
-        sub fred($) {}
-
-    %s never introduced                [pad_leavemy]   TODO
-    Runaway prototype          [newSUB]        TODO
-    oops: oopsAV               [oopsAV]        TODO
-    oops: oopsHV               [oopsHV]        TODO
-    
-
-__END__
-# op.c
-use warnings 'misc' ;
-my $x ;
-my $x ;
-no warnings 'misc' ;
-my $x ;
-EXPECT
-"my" variable $x masks earlier declaration in same scope at - line 4.
-########
-# op.c
-use warnings 'closure' ;
-sub x {
-      my $x;
-      sub y {
-         $x
-      }
-   }
-EXPECT
-Variable "$x" will not stay shared at - line 7.
-########
-# op.c
-no warnings 'closure' ;
-sub x {
-      my $x;
-      sub y {
-         $x
-      }
-   }
-EXPECT
-
-########
-# op.c
-use warnings 'closure' ;
-sub x {
-      our $x;
-      sub y {
-         $x
-      }
-   }
-EXPECT
-
-########
-# op.c
-use warnings 'closure' ;
-sub x {
-      my $x;
-      sub y {
-         sub { $x }
-      }
-   }
-EXPECT
-Variable "$x" may be unavailable at - line 6.
-########
-# op.c
-no warnings 'closure' ;
-sub x {
-      my $x;
-      sub y {
-         sub { $x }
-      }
-   }
-EXPECT
-
-########
-# op.c
-use warnings 'syntax' ;
-1 if $a = 1 ;
-no warnings 'syntax' ;
-1 if $a = 1 ;
-EXPECT
-Found = in conditional, should be == at - line 3.
-########
-# op.c
-use warnings 'deprecated' ;
-split ;
-no warnings 'deprecated' ;
-split ;
-EXPECT
-Use of implicit split to @_ is deprecated at - line 3.
-########
-# op.c
-use warnings 'deprecated' ;
-$a = split ;
-no warnings 'deprecated' ;
-$a = split ;
-EXPECT
-Use of implicit split to @_ is deprecated at - line 3.
-########
-# op.c
-use warnings 'deprecated';
-my (@foo, %foo);
-%main::foo->{"bar"};
-%foo->{"bar"};
-@main::foo->[23];
-@foo->[23];
-$main::foo = {}; %$main::foo->{"bar"};
-$foo = {}; %$foo->{"bar"};
-$main::foo = []; @$main::foo->[34];
-$foo = []; @$foo->[34];
-no warnings 'deprecated';
-%main::foo->{"bar"};
-%foo->{"bar"};
-@main::foo->[23];
-@foo->[23];
-$main::foo = {}; %$main::foo->{"bar"};
-$foo = {}; %$foo->{"bar"};
-$main::foo = []; @$main::foo->[34];
-$foo = []; @$foo->[34];
-EXPECT
-Using a hash as a reference is deprecated at - line 4.
-Using a hash as a reference is deprecated at - line 5.
-Using an array as a reference is deprecated at - line 6.
-Using an array as a reference is deprecated at - line 7.
-Using a hash as a reference is deprecated at - line 8.
-Using a hash as a reference is deprecated at - line 9.
-Using an array as a reference is deprecated at - line 10.
-Using an array as a reference is deprecated at - line 11.
-########
-# op.c
-use warnings 'void' ; close STDIN ;
-1 x 3 ;                        # OP_REPEAT
-                       # OP_GVSV
-wantarray ;            # OP_WANTARRAY
-                       # OP_GV
-                       # OP_PADSV
-                       # OP_PADAV
-                       # OP_PADHV
-                       # OP_PADANY
-                       # OP_AV2ARYLEN
-ref ;                  # OP_REF
-\@a ;                  # OP_REFGEN
-\$a ;                  # OP_SREFGEN
-defined $a ;           # OP_DEFINED
-hex $a ;               # OP_HEX
-oct $a ;               # OP_OCT
-length $a ;            # OP_LENGTH
-substr $a,1 ;          # OP_SUBSTR
-vec $a,1,2 ;           # OP_VEC
-index $a,1,2 ;         # OP_INDEX
-rindex $a,1,2 ;                # OP_RINDEX
-sprintf $a ;           # OP_SPRINTF
-$a[0] ;                        # OP_AELEM
-                       # OP_AELEMFAST
-@a[0] ;                        # OP_ASLICE
-#values %a ;           # OP_VALUES
-#keys %a ;             # OP_KEYS
-$a{0} ;                        # OP_HELEM
-@a{0} ;                        # OP_HSLICE
-unpack "a", "a" ;      # OP_UNPACK
-pack $a,"" ;           # OP_PACK
-join "" ;              # OP_JOIN
-(@a)[0,1] ;            # OP_LSLICE
-                       # OP_ANONLIST
-                       # OP_ANONHASH
-sort(1,2) ;            # OP_SORT
-reverse(1,2) ;         # OP_REVERSE
-                       # OP_RANGE
-                       # OP_FLIP
-(1 ..2) ;              # OP_FLOP
-caller ;               # OP_CALLER
-fileno STDIN ;         # OP_FILENO
-eof STDIN ;            # OP_EOF
-tell STDIN ;           # OP_TELL
-readlink 1;            # OP_READLINK
-time ;                 # OP_TIME
-localtime ;            # OP_LOCALTIME
-gmtime ;               # OP_GMTIME
-eval { getgrnam 1 };   # OP_GGRNAM
-eval { getgrgid 1 };   # OP_GGRGID
-eval { getpwnam 1 };   # OP_GPWNAM
-eval { getpwuid 1 };   # OP_GPWUID
-EXPECT
-Useless use of repeat (x) in void context at - line 3.
-Useless use of wantarray in void context at - line 5.
-Useless use of reference-type operator in void context at - line 12.
-Useless use of reference constructor in void context at - line 13.
-Useless use of single ref constructor in void context at - line 14.
-Useless use of defined operator in void context at - line 15.
-Useless use of hex in void context at - line 16.
-Useless use of oct in void context at - line 17.
-Useless use of length in void context at - line 18.
-Useless use of substr in void context at - line 19.
-Useless use of vec in void context at - line 20.
-Useless use of index in void context at - line 21.
-Useless use of rindex in void context at - line 22.
-Useless use of sprintf in void context at - line 23.
-Useless use of array element in void context at - line 24.
-Useless use of array slice in void context at - line 26.
-Useless use of hash element in void context at - line 29.
-Useless use of hash slice in void context at - line 30.
-Useless use of unpack in void context at - line 31.
-Useless use of pack in void context at - line 32.
-Useless use of join or string in void context at - line 33.
-Useless use of list slice in void context at - line 34.
-Useless use of sort in void context at - line 37.
-Useless use of reverse in void context at - line 38.
-Useless use of range (or flop) in void context at - line 41.
-Useless use of caller in void context at - line 42.
-Useless use of fileno in void context at - line 43.
-Useless use of eof in void context at - line 44.
-Useless use of tell in void context at - line 45.
-Useless use of readlink in void context at - line 46.
-Useless use of time in void context at - line 47.
-Useless use of localtime in void context at - line 48.
-Useless use of gmtime in void context at - line 49.
-Useless use of getgrnam in void context at - line 50.
-Useless use of getgrgid in void context at - line 51.
-Useless use of getpwnam in void context at - line 52.
-Useless use of getpwuid in void context at - line 53.
-########
-# op.c
-no warnings 'void' ; close STDIN ;
-1 x 3 ;                        # OP_REPEAT
-                       # OP_GVSV
-wantarray ;            # OP_WANTARRAY
-                       # OP_GV
-                       # OP_PADSV
-                       # OP_PADAV
-                       # OP_PADHV
-                       # OP_PADANY
-                       # OP_AV2ARYLEN
-ref ;                  # OP_REF
-\@a ;                  # OP_REFGEN
-\$a ;                  # OP_SREFGEN
-defined $a ;           # OP_DEFINED
-hex $a ;               # OP_HEX
-oct $a ;               # OP_OCT
-length $a ;            # OP_LENGTH
-substr $a,1 ;          # OP_SUBSTR
-vec $a,1,2 ;           # OP_VEC
-index $a,1,2 ;         # OP_INDEX
-rindex $a,1,2 ;                # OP_RINDEX
-sprintf $a ;           # OP_SPRINTF
-$a[0] ;                        # OP_AELEM
-                       # OP_AELEMFAST
-@a[0] ;                        # OP_ASLICE
-#values %a ;           # OP_VALUES
-#keys %a ;             # OP_KEYS
-$a{0} ;                        # OP_HELEM
-@a{0} ;                        # OP_HSLICE
-unpack "a", "a" ;      # OP_UNPACK
-pack $a,"" ;           # OP_PACK
-join "" ;              # OP_JOIN
-(@a)[0,1] ;            # OP_LSLICE
-                       # OP_ANONLIST
-                       # OP_ANONHASH
-sort(1,2) ;            # OP_SORT
-reverse(1,2) ;         # OP_REVERSE
-                       # OP_RANGE
-                       # OP_FLIP
-(1 ..2) ;              # OP_FLOP
-caller ;               # OP_CALLER
-fileno STDIN ;         # OP_FILENO
-eof STDIN ;            # OP_EOF
-tell STDIN ;           # OP_TELL
-readlink 1;            # OP_READLINK
-time ;                 # OP_TIME
-localtime ;            # OP_LOCALTIME
-gmtime ;               # OP_GMTIME
-eval { getgrnam 1 };   # OP_GGRNAM
-eval { getgrgid 1 };   # OP_GGRGID
-eval { getpwnam 1 };   # OP_GPWNAM
-eval { getpwuid 1 };   # OP_GPWUID
-EXPECT
-########
-# op.c
-use warnings 'void' ;
-for (@{[0]}) { "$_" }          # check warning isn't duplicated
-no warnings 'void' ;
-for (@{[0]}) { "$_" }          # check warning isn't duplicated
-EXPECT
-Useless use of string in void context at - line 3.
-########
-# op.c
-use warnings 'void' ;
-use Config ;
-BEGIN {
-    if ( ! $Config{d_telldir}) {
-        print <<EOM ;
-SKIPPED
-# telldir not present
-EOM
-        exit 
-    }
-}
-telldir 1 ;            # OP_TELLDIR
-no warnings 'void' ;
-telldir 1 ;            # OP_TELLDIR
-EXPECT
-Useless use of telldir in void context at - line 13.
-########
-# op.c
-use warnings 'void' ;
-use Config ;
-BEGIN {
-    if ( ! $Config{d_getppid}) {
-        print <<EOM ;
-SKIPPED
-# getppid not present
-EOM
-        exit 
-    }
-}
-getppid ;              # OP_GETPPID
-no warnings 'void' ;
-getppid ;              # OP_GETPPID
-EXPECT
-Useless use of getppid in void context at - line 13.
-########
-# op.c
-use warnings 'void' ;
-use Config ;
-BEGIN {
-    if ( ! $Config{d_getpgrp}) {
-        print <<EOM ;
-SKIPPED
-# getpgrp not present
-EOM
-        exit 
-    }
-}
-getpgrp ;              # OP_GETPGRP
-no warnings 'void' ;
-getpgrp ;              # OP_GETPGRP
-EXPECT
-Useless use of getpgrp in void context at - line 13.
-########
-# op.c
-use warnings 'void' ;
-use Config ;
-BEGIN {
-    if ( ! $Config{d_times}) {
-        print <<EOM ;
-SKIPPED
-# times not present
-EOM
-        exit 
-    }
-}
-times ;                        # OP_TMS
-no warnings 'void' ;
-times ;                        # OP_TMS
-EXPECT
-Useless use of times in void context at - line 13.
-########
-# op.c
-use warnings 'void' ;
-use Config ;
-BEGIN {
-    if ( ! $Config{d_getprior} or $^O eq 'os2') { # Locks before fixpak22
-        print <<EOM ;
-SKIPPED
-# getpriority not present
-EOM
-        exit 
-    }
-}
-getpriority 1,2;       # OP_GETPRIORITY
-no warnings 'void' ;
-getpriority 1,2;       # OP_GETPRIORITY
-EXPECT
-Useless use of getpriority in void context at - line 13.
-########
-# op.c
-use warnings 'void' ;
-use Config ;
-BEGIN {
-    if ( ! $Config{d_getlogin}) {
-        print <<EOM ;
-SKIPPED
-# getlogin not present
-EOM
-        exit 
-    }
-}
-getlogin ;                     # OP_GETLOGIN
-no warnings 'void' ;
-getlogin ;                     # OP_GETLOGIN
-EXPECT
-Useless use of getlogin in void context at - line 13.
-########
-# op.c
-use warnings 'void' ;
-use Config ; BEGIN {
-if ( ! $Config{d_socket}) {
-    print <<EOM ;
-SKIPPED
-# getsockname not present
-# getpeername not present
-# gethostbyname not present
-# gethostbyaddr not present
-# gethostent not present
-# getnetbyname not present
-# getnetbyaddr not present
-# getnetent not present
-# getprotobyname not present
-# getprotobynumber not present
-# getprotoent not present
-# getservbyname not present
-# getservbyport not present
-# getservent not present
-EOM
-    exit 
-} }
-getsockname STDIN ;    # OP_GETSOCKNAME
-getpeername STDIN ;    # OP_GETPEERNAME
-gethostbyname 1 ;      # OP_GHBYNAME
-gethostbyaddr 1,2;     # OP_GHBYADDR
-gethostent ;           # OP_GHOSTENT
-getnetbyname 1 ;       # OP_GNBYNAME
-getnetbyaddr 1,2 ;     # OP_GNBYADDR
-getnetent ;            # OP_GNETENT
-getprotobyname 1;      # OP_GPBYNAME
-getprotobynumber 1;    # OP_GPBYNUMBER
-getprotoent ;          # OP_GPROTOENT
-getservbyname 1,2;     # OP_GSBYNAME
-getservbyport 1,2;     # OP_GSBYPORT
-getservent ;           # OP_GSERVENT
-
-no warnings 'void' ;
-getsockname STDIN ;    # OP_GETSOCKNAME
-getpeername STDIN ;    # OP_GETPEERNAME
-gethostbyname 1 ;      # OP_GHBYNAME
-gethostbyaddr 1,2;     # OP_GHBYADDR
-gethostent ;           # OP_GHOSTENT
-getnetbyname 1 ;       # OP_GNBYNAME
-getnetbyaddr 1,2 ;     # OP_GNBYADDR
-getnetent ;            # OP_GNETENT
-getprotobyname 1;      # OP_GPBYNAME
-getprotobynumber 1;    # OP_GPBYNUMBER
-getprotoent ;          # OP_GPROTOENT
-getservbyname 1,2;     # OP_GSBYNAME
-getservbyport 1,2;     # OP_GSBYPORT
-getservent ;           # OP_GSERVENT
-INIT {
-   # some functions may not be there, so we exit without running
-   exit;
-}
-EXPECT
-Useless use of getsockname in void context at - line 24.
-Useless use of getpeername in void context at - line 25.
-Useless use of gethostbyname in void context at - line 26.
-Useless use of gethostbyaddr in void context at - line 27.
-Useless use of gethostent in void context at - line 28.
-Useless use of getnetbyname in void context at - line 29.
-Useless use of getnetbyaddr in void context at - line 30.
-Useless use of getnetent in void context at - line 31.
-Useless use of getprotobyname in void context at - line 32.
-Useless use of getprotobynumber in void context at - line 33.
-Useless use of getprotoent in void context at - line 34.
-Useless use of getservbyname in void context at - line 35.
-Useless use of getservbyport in void context at - line 36.
-Useless use of getservent in void context at - line 37.
-########
-# op.c
-use warnings 'void' ;
-*a ; # OP_RV2GV
-$a ; # OP_RV2SV
-@a ; # OP_RV2AV
-%a ; # OP_RV2HV
-no warnings 'void' ;
-*a ; # OP_RV2GV
-$a ; # OP_RV2SV
-@a ; # OP_RV2AV
-%a ; # OP_RV2HV
-EXPECT
-Useless use of a variable in void context at - line 3.
-Useless use of a variable in void context at - line 4.
-Useless use of a variable in void context at - line 5.
-Useless use of a variable in void context at - line 6.
-########
-# op.c
-use warnings 'void' ;
-"abc"; # OP_CONST
-7 ; # OP_CONST
-no warnings 'void' ;
-"abc"; # OP_CONST
-7 ; # OP_CONST
-EXPECT
-Useless use of a constant in void context at - line 3.
-Useless use of a constant in void context at - line 4.
-########
-# op.c
-#
-use warnings 'misc' ;
-my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
-@a =~ /abc/ ;
-@a =~ s/a/b/ ;
-@a =~ tr/a/b/ ;
-@$b =~ /abc/ ;
-@$b =~ s/a/b/ ;
-@$b =~ tr/a/b/ ;
-%a =~ /abc/ ;
-%a =~ s/a/b/ ;
-%a =~ tr/a/b/ ;
-%$c =~ /abc/ ;
-%$c =~ s/a/b/ ;
-%$c =~ tr/a/b/ ;
-{
-no warnings 'misc' ;
-my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
-@a =~ /abc/ ;
-@a =~ s/a/b/ ;
-@a =~ tr/a/b/ ;
-@$b =~ /abc/ ;
-@$b =~ s/a/b/ ;
-@$b =~ tr/a/b/ ;
-%a =~ /abc/ ;
-%a =~ s/a/b/ ;
-%a =~ tr/a/b/ ;
-%$c =~ /abc/ ;
-%$c =~ s/a/b/ ;
-%$c =~ tr/a/b/ ;
-}
-EXPECT
-Applying pattern match (m//) to @array will act on scalar(@array) at - line 5.
-Applying substitution (s///) to @array will act on scalar(@array) at - line 6.
-Applying transliteration (tr///) to @array will act on scalar(@array) at - line 7.
-Applying pattern match (m//) to @array will act on scalar(@array) at - line 8.
-Applying substitution (s///) to @array will act on scalar(@array) at - line 9.
-Applying transliteration (tr///) to @array will act on scalar(@array) at - line 10.
-Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 11.
-Applying substitution (s///) to %hash will act on scalar(%hash) at - line 12.
-Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 13.
-Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 14.
-Applying substitution (s///) to %hash will act on scalar(%hash) at - line 15.
-Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16.
-Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;"
-BEGIN not safe after errors--compilation aborted at - line 18.
-########
-# op.c
-use warnings 'syntax' ;
-my $a, $b = (1,2);
-no warnings 'syntax' ;
-my $c, $d = (1,2);
-EXPECT
-Parentheses missing around "my" list at - line 3.
-########
-# op.c
-use warnings 'syntax' ;
-local $a, $b = (1,2);
-no warnings 'syntax' ;
-local $c, $d = (1,2);
-EXPECT
-Parentheses missing around "local" list at - line 3.
-########
-# op.c
-use warnings 'bareword' ;
-print (ABC || 1) ;
-no warnings 'bareword' ;
-print (ABC || 1) ;
-EXPECT
-Bareword found in conditional at - line 3.
-########
---FILE-- abc
-
---FILE--
-# op.c
-use warnings 'misc' ;
-open FH, "<abc" ;
-$x = 1 if $x = <FH> ;
-no warnings 'misc' ;
-$x = 1 if $x = <FH> ;
-EXPECT
-Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
-########
-# op.c
-use warnings 'misc' ;
-opendir FH, "." ;
-$x = 1 if $x = readdir FH ;
-no warnings 'misc' ;
-$x = 1 if $x = readdir FH ;
-closedir FH ;
-EXPECT
-Value of readdir() operator can be "0"; test with defined() at - line 4.
-########
-# op.c
-use warnings 'misc' ;
-$x = 1 if $x = <*> ;
-no warnings 'misc' ;
-$x = 1 if $x = <*> ;
-EXPECT
-Value of glob construct can be "0"; test with defined() at - line 3.
-########
-# op.c
-use warnings 'misc' ;
-%a = (1,2,3,4) ;
-$x = 1 if $x = each %a ;
-no warnings 'misc' ;
-$x = 1 if $x = each %a ;
-EXPECT
-Value of each() operator can be "0"; test with defined() at - line 4.
-########
-# op.c
-use warnings 'misc' ;
-$x = 1 while $x = <*> and 0 ;
-no warnings 'misc' ;
-$x = 1 while $x = <*> and 0 ;
-EXPECT
-Value of glob construct can be "0"; test with defined() at - line 3.
-########
-# op.c
-use warnings 'misc' ;
-opendir FH, "." ;
-$x = 1 while $x = readdir FH and 0 ;
-no warnings 'misc' ;
-$x = 1 while $x = readdir FH and 0 ;
-closedir FH ;
-EXPECT
-Value of readdir() operator can be "0"; test with defined() at - line 4.
-########
-# op.c
-use warnings 'redefine' ;
-sub fred {}
-sub fred {}
-no warnings 'redefine' ;
-sub fred {}
-EXPECT
-Subroutine fred redefined at - line 4.
-########
-# op.c
-use warnings 'redefine' ;
-sub fred () { 1 }
-sub fred () { 1 }
-no warnings 'redefine' ;
-sub fred () { 1 }
-EXPECT
-Constant subroutine fred redefined at - line 4.
-########
-# op.c
-no warnings 'redefine' ;
-sub fred () { 1 }
-sub fred () { 2 }
-EXPECT
-Constant subroutine fred redefined at - line 4.
-########
-# op.c
-no warnings 'redefine' ;
-sub fred () { 1 }
-*fred = sub () { 2 };
-EXPECT
-Constant subroutine fred redefined at - line 4.
-########
-# op.c
-use warnings 'redefine' ;
-format FRED =
-.
-format FRED =
-.
-no warnings 'redefine' ;
-format FRED =
-.
-EXPECT
-Format FRED redefined at - line 5.
-########
-# op.c
-use warnings 'deprecated' ;
-push FRED;
-no warnings 'deprecated' ;
-push FRED;
-EXPECT
-Array @FRED missing the @ in argument 1 of push() at - line 3.
-########
-# op.c
-use warnings 'deprecated' ;
-@a = keys FRED ;
-no warnings 'deprecated' ;
-@a = keys FRED ;
-EXPECT
-Hash %FRED missing the % in argument 1 of keys() at - line 3.
-########
-# op.c
-use warnings 'syntax' ;
-exec "$^X -e 1" ; 
-my $a
-EXPECT
-Statement unlikely to be reached at - line 4.
-       (Maybe you meant system() when you said exec()?)
-########
-# op.c
-use warnings 'deprecated' ;
-my @a; defined(@a);
-EXPECT
-defined(@array) is deprecated at - line 3.
-       (Maybe you should just omit the defined()?)
-########
-# op.c
-use warnings 'deprecated' ;
-defined(@a = (1,2,3));
-EXPECT
-defined(@array) is deprecated at - line 3.
-       (Maybe you should just omit the defined()?)
-########
-# op.c
-use warnings 'deprecated' ;
-my %h; defined(%h);
-EXPECT
-defined(%hash) is deprecated at - line 3.
-       (Maybe you should just omit the defined()?)
-########
-# op.c
-no warnings 'syntax' ;
-exec "$^X -e 1" ; 
-my $a
-EXPECT
-
-########
-# op.c
-sub fred();
-sub fred($) {}
-EXPECT
-Prototype mismatch: sub main::fred () vs ($) at - line 3.
-########
-# op.c
-$^W = 0 ;
-sub fred() ;
-sub fred($) {}
-{
-    no warnings 'prototype' ;
-    sub Fred() ;
-    sub Fred($) {}
-    use warnings 'prototype' ;
-    sub freD() ;
-    sub freD($) {}
-}
-sub FRED() ;
-sub FRED($) {}
-EXPECT
-Prototype mismatch: sub main::fred () vs ($) at - line 4.
-Prototype mismatch: sub main::freD () vs ($) at - line 11.
-Prototype mismatch: sub main::FRED () vs ($) at - line 14.
-########
-# op.c
-use warnings 'syntax' ;
-join /---/, 'x', 'y', 'z';
-EXPECT
-/---/ should probably be written as "---" at - line 3.
-########
-# op.c [Perl_peep]
-use warnings 'prototype' ;
-fred() ; 
-sub fred ($$) {}
-no warnings 'prototype' ;
-joe() ; 
-sub joe ($$) {}
-EXPECT
-main::fred() called too early to check prototype at - line 3.
-########
-# op.c [Perl_newATTRSUB]
---FILE-- abc.pm
-use warnings 'void' ;
-BEGIN { $| = 1; print "in begin\n"; }
-CHECK { print "in check\n"; }
-INIT { print "in init\n"; }
-END { print "in end\n"; }
-print "in mainline\n";
-1;
---FILE--
-use abc;
-delete $INC{"abc.pm"};
-require abc;
-do "abc.pm";
-EXPECT
-in begin
-in mainline
-in check
-in init
-in begin
-Too late to run CHECK block at abc.pm line 3.
-Too late to run INIT block at abc.pm line 4.
-in mainline
-in begin
-Too late to run CHECK block at abc.pm line 3.
-Too late to run INIT block at abc.pm line 4.
-in mainline
-in end
-in end
-in end
-########
-# op.c [Perl_newATTRSUB]
---FILE-- abc.pm
-no warnings 'void' ;
-BEGIN { $| = 1; print "in begin\n"; }
-CHECK { print "in check\n"; }
-INIT { print "in init\n"; }
-END { print "in end\n"; }
-print "in mainline\n";
-1;
---FILE--
-require abc;
-do "abc.pm";
-EXPECT
-in begin
-in mainline
-in begin
-in mainline
-in end
-in end
-########
-# op.c
-my @x;
-use warnings 'syntax' ;
-push(@x);
-unshift(@x);
-no warnings 'syntax' ;
-push(@x);
-unshift(@x);
-EXPECT
-Useless use of push with no values at - line 4.
-Useless use of unshift with no values at - line 5.

diff --git a/t/pragma/warn/perl b/t/pragma/warn/perl
deleted file mode 100644 (file)
index 512ee7f..0000000
--- a/t/pragma/warn/perl
+++ /dev/null
@@ -1,72 +0,0 @@
-  perl.c       AOK
-
-  gv_check(defstash)
-       Name \"%s::%s\" used only once: possible typo 
-
-  Mandatory Warnings All TODO
-  ------------------
-  Recompile perl with -DDEBUGGING to use -D switch     [moreswitches]
-  Unbalanced scopes: %ld more ENTERs than LEAVEs       [perl_destruct]
-  Unbalanced saves: %ld more saves than restores       [perl_destruct]
-  Unbalanced tmps: %ld more allocs than frees          [perl_destruct]
-  Unbalanced context: %ld more PUSHes than POPs                [perl_destruct]
-  Unbalanced string table refcount: (%d) for \"%s\"    [perl_destruct]
-  Scalars leaked: %ld                                  [perl_destruct]
-
-
-__END__
-# perl.c
-no warnings 'once' ;
-$x = 3 ;
-use warnings 'once' ;
-$z = 3 ;
-EXPECT
-Name "main::z" used only once: possible typo at - line 5.
-########
--w
-# perl.c
-$x = 3 ;
-no warnings 'once' ;
-$z = 3 
-EXPECT
-Name "main::x" used only once: possible typo at - line 3.
-########
-# perl.c
-BEGIN { $^W =1 ; }
-$x = 3 ;
-no warnings 'once' ;
-$z = 3 
-EXPECT
-Name "main::x" used only once: possible typo at - line 3.
-########
--W
-# perl.c
-no warnings 'once' ;
-$x = 3 ;
-use warnings 'once' ;
-$z = 3 ;
-EXPECT
-Name "main::z" used only once: possible typo at - line 6.
-Name "main::x" used only once: possible typo at - line 4.
-########
--X
-# perl.c
-use warnings 'once' ;
-$x = 3 ;
-EXPECT
-########
-
-# perl.c
-{ use warnings 'once' ; $x = 3 ; }
-$y = 3 ;
-EXPECT
-Name "main::x" used only once: possible typo at - line 3.
-########
-
-# perl.c
-$z = 3 ;
-BEGIN { $^W = 1 }
-{ no warnings 'once' ; $x = 3 ; }
-$y = 3 ;
-EXPECT
-Name "main::y" used only once: possible typo at - line 6.

diff --git a/t/pragma/warn/perlio b/t/pragma/warn/perlio
deleted file mode 100644 (file)
index 18c0dfa..0000000
--- a/t/pragma/warn/perlio
+++ /dev/null
@@ -1,10 +0,0 @@
-  perlio.c 
-
-
-  Mandatory Warnings ALL TODO
-  ------------------
-    Setting cnt to %d
-    Setting ptr %p > end+1 %p
-    Setting cnt to %d, ptr implies %d
-
-__END__

diff --git a/t/pragma/warn/perly b/t/pragma/warn/perly
deleted file mode 100644 (file)
index afc5dcc..0000000
--- a/t/pragma/warn/perly
+++ /dev/null
@@ -1,31 +0,0 @@
-  perly.y      AOK
-
-  dep() => deprecate("\"do\" to call subroutines") 
-  Use of "do" to call subroutines is deprecated
-
-       sub fred {} do fred()
-       sub fred {} do fred(1)
-       sub fred {} $a = "fred" ; do $a()
-       sub fred {} $a = "fred" ; do $a(1)
-
-
-__END__
-# perly.y
-use warnings 'deprecated' ;
-sub fred {} 
-do fred() ;
-do fred(1) ;
-$a = "fred" ; 
-do $a() ;
-do $a(1) ;
-no warnings 'deprecated' ;
-do fred() ;
-do fred(1) ;
-$a = "fred" ; 
-do $a() ;
-do $a(1) ;
-EXPECT
-Use of "do" to call subroutines is deprecated at - line 4.
-Use of "do" to call subroutines is deprecated at - line 5.
-Use of "do" to call subroutines is deprecated at - line 7.
-Use of "do" to call subroutines is deprecated at - line 8.

diff --git a/t/pragma/warn/pp b/t/pragma/warn/pp
deleted file mode 100644 (file)
index 62f054a..0000000
--- a/t/pragma/warn/pp
+++ /dev/null
@@ -1,150 +0,0 @@
-  pp.c TODO
-
-  substr outside of string
-    $a = "ab" ; $b = substr($a, 4,5) ;
-
-  Attempt to use reference as lvalue in substr 
-    $a = "ab" ; $b = \$a ;  substr($b, 1,1) = $b
-
-  uninitialized        in pp_rv2gv()
-       my *b = *{ undef()}
-
-  uninitialized        in pp_rv2sv()
-       my $a = undef ; my $b = $$a
-
-  Odd number of elements in hash list
-       my $a = { 1,2,3 } ;
-
-  Invalid type in unpack: '%c
-       my $A = pack ("A,A", 1,2) ;
-       my @A = unpack ("A,A", "22") ;
-
-  Attempt to pack pointer to temporary value
-       pack("p", "abc") ;
-
-  Explicit blessing to '' (assuming package main)
-       bless \[], "";
-
-  Constant subroutine %s undefined                     <<<TODO
-  Constant subroutine (anonymous) undefined            <<<TODO
-
-__END__
-# pp.c
-use warnings 'substr' ;
-$a = "ab" ; 
-$b = substr($a, 4,5) ;
-no warnings 'substr' ;
-$a = "ab" ; 
-$b = substr($a, 4,5)  ;
-EXPECT
-substr outside of string at - line 4.
-########
-# pp.c
-use warnings 'substr' ;
-$a = "ab" ; 
-$b = \$a ;  
-substr($b, 1,1) = "ab" ;
-no warnings 'substr' ;
-substr($b, 1,1) = "ab" ;
-EXPECT
-Attempt to use reference as lvalue in substr at - line 5.
-########
-# pp.c
-use warnings 'uninitialized' ;
-# TODO
-EXPECT
-
-########
-# pp.c
-use warnings 'misc' ;
-my $a = { 1,2,3};
-no warnings 'misc' ;
-my $b = { 1,2,3};
-EXPECT
-Odd number of elements in hash assignment at - line 3.
-########
-# pp.c
-use warnings 'pack' ;
-use warnings 'unpack' ;
-my @a = unpack ("A,A", "22") ;
-my $a = pack ("A,A", 1,2) ;
-no warnings 'pack' ;
-no warnings 'unpack' ;
-my @b = unpack ("A,A", "22") ;
-my $b = pack ("A,A", 1,2) ;
-EXPECT
-Invalid type in unpack: ',' at - line 4.
-Invalid type in pack: ',' at - line 5.
-########
-# pp.c
-use warnings 'uninitialized' ;
-my $a = undef ; 
-my $b = $$a;
-no warnings 'uninitialized' ;
-my $c = $$a;
-EXPECT
-Use of uninitialized value in scalar dereference at - line 4.
-########
-# pp.c
-use warnings 'pack' ;
-sub foo { my $a = "a"; return $a . $a++ . $a++ }
-my $a = pack("p", &foo) ;
-no warnings 'pack' ;
-my $b = pack("p", &foo) ;
-EXPECT
-Attempt to pack pointer to temporary value at - line 4.
-########
-# pp.c
-use warnings 'misc' ;
-bless \[], "" ;
-no warnings 'misc' ;
-bless \[], "" ;
-EXPECT
-Explicit blessing to '' (assuming package main) at - line 3.
-########
-# pp.c
-use utf8 ;
-$_ = "\x80  \xff" ;
-reverse ;
-EXPECT
-########
-# pp.c
-use warnings 'pack' ;
-print unpack("C", pack("C",   -1)), "\n";
-print unpack("C", pack("C",    0)), "\n";
-print unpack("C", pack("C",  255)), "\n";
-print unpack("C", pack("C",  256)), "\n";
-print unpack("c", pack("c", -129)), "\n";
-print unpack("c", pack("c", -128)), "\n";
-print unpack("c", pack("c",  127)), "\n";
-print unpack("c", pack("c",  128)), "\n";
-no warnings 'pack' ;
-print unpack("C", pack("C",   -1)), "\n";
-print unpack("C", pack("C",    0)), "\n";
-print unpack("C", pack("C",  255)), "\n";
-print unpack("C", pack("C",  256)), "\n";
-print unpack("c", pack("c", -129)), "\n";
-print unpack("c", pack("c", -128)), "\n";
-print unpack("c", pack("c",  127)), "\n";
-print unpack("c", pack("c",  128)), "\n";
-EXPECT
-Character in "C" format wrapped at - line 3.
-Character in "C" format wrapped at - line 6.
-Character in "c" format wrapped at - line 7.
-Character in "c" format wrapped at - line 10.
-255
-0
-255
-0
-127
--128
-127
--128
-255
-0
-255
-0
-127
--128
-127
--128

diff --git a/t/pragma/warn/pp_ctl b/t/pragma/warn/pp_ctl
deleted file mode 100644 (file)
index ac01f27..0000000
--- a/t/pragma/warn/pp_ctl
+++ /dev/null
@@ -1,230 +0,0 @@
-  pp_ctl.c     AOK
- 
-     Not enough format arguments       
-       format STDOUT =
-       @<<< @<<<
-       $a
-       .
-       write;
-     
-
-    Exiting substitution via %s
-       $_ = "abc" ;
-       while ($i ++ == 0)
-       {
-           s/ab/last/e ;
-       }
-
-    Exiting subroutine via %s          
-       sub fred { last }
-       { fred() }
-
-    Exiting eval via %s        
-       { eval "last" }
-
-    Exiting pseudo-block via %s 
-       @a = (1,2) ; @b = sort { last } @a ;
-
-    Exiting substitution via %s
-       $_ = "abc" ;
-       last fred:
-       while ($i ++ == 0)
-       {
-           s/ab/last fred/e ;
-       }
-
-
-    Exiting subroutine via %s
-       sub fred { last joe }
-       joe: { fred() }
-
-    Exiting eval via %s
-       fred: { eval "last fred" }
-
-    Exiting pseudo-block via %s 
-       @a = (1,2) ; fred: @b = sort { last fred } @a ;
-
-
-    Deep recursion on subroutine \"%s\"
-       sub fred
-       {
-         fred() if $a++ < 200
-       }
-        
-       fred()
-
-      (in cleanup) foo bar
-       package Foo;
-       DESTROY { die "foo bar" }
-       { bless [], 'Foo' for 1..10 }
-
-__END__
-# pp_ctl.c
-use warnings 'syntax' ;
-format STDOUT =
-@<<< @<<<
-1
-.
-write;
-EXPECT
-Not enough format arguments at - line 5.
-1
-########
-# pp_ctl.c
-no warnings 'syntax' ;
-format =
-@<<< @<<<
-1
-.
-write ;
-EXPECT
-1
-########
-# pp_ctl.c
-use warnings 'exiting' ;
-$_ = "abc" ;
- 
-while ($i ++ == 0)
-{
-    s/ab/last/e ;
-}
-no warnings 'exiting' ;
-while ($i ++ == 0)
-{
-    s/ab/last/e ;
-}
-EXPECT
-Exiting substitution via last at - line 7.
-########
-# pp_ctl.c
-use warnings 'exiting' ;
-sub fred { last }
-{ fred() }
-no warnings 'exiting' ;
-sub joe { last }
-{ joe() }
-EXPECT
-Exiting subroutine via last at - line 3.
-########
-# pp_ctl.c
-{
-  eval "use warnings 'exiting' ; last;" 
-}
-print STDERR $@ ;
-{
-  eval "no warnings 'exiting' ;last;" 
-} 
-print STDERR $@ ;
-EXPECT
-Exiting eval via last at (eval 1) line 1.
-########
-# pp_ctl.c
-use warnings 'exiting' ;
-@a = (1,2) ;
-@b = sort { last } @a ;
-no warnings 'exiting' ;
-@b = sort { last } @a ;
-EXPECT
-Exiting pseudo-block via last at - line 4.
-Can't "last" outside a loop block at - line 4.
-########
-# pp_ctl.c
-use warnings 'exiting' ;
-$_ = "abc" ;
-fred: 
-while ($i ++ == 0)
-{
-    s/ab/last fred/e ;
-}
-no warnings 'exiting' ;
-while ($i ++ == 0)
-{
-    s/ab/last fred/e ;
-}
-EXPECT
-Exiting substitution via last at - line 7.
-########
-# pp_ctl.c
-use warnings 'exiting' ;
-sub fred { last joe }
-joe: { fred() }
-no warnings 'exiting' ;
-sub Fred { last Joe }
-Joe: { Fred() }
-EXPECT
-Exiting subroutine via last at - line 3.
-########
-# pp_ctl.c
-joe:
-{ eval "use warnings 'exiting' ; last joe;" }
-print STDERR $@ ;
-Joe:
-{ eval "no warnings 'exiting' ; last Joe;" }
-print STDERR $@ ;
-EXPECT
-Exiting eval via last at (eval 1) line 1.
-########
-# pp_ctl.c
-use warnings 'exiting' ;
-@a = (1,2) ;
-fred: @b = sort { last fred } @a ;
-no warnings 'exiting' ;
-Fred: @b = sort { last Fred } @a ;
-EXPECT
-Exiting pseudo-block via last at - line 4.
-Label not found for "last fred" at - line 4.
-########
-# pp_ctl.c
-use warnings 'recursion' ;
-BEGIN { warn "PREFIX\n" ;}
-sub fred
-{
-    fred() if $a++ < 200
-}
- 
-fred()
-EXPECT
-Deep recursion on subroutine "main::fred" at - line 6.
-########
-# pp_ctl.c
-no warnings 'recursion' ;
-BEGIN { warn "PREFIX\n" ;}
-sub fred
-{
-    fred() if $a++ < 200
-}
- 
-fred()
-EXPECT
-########
-# pp_ctl.c
-use warnings 'misc' ;
-package Foo;
-DESTROY { die "@{$_[0]} foo bar" }
-{ bless ['A'], 'Foo' for 1..10 }
-{ bless ['B'], 'Foo' for 1..10 }
-EXPECT
-       (in cleanup) A foo bar at - line 4.
-       (in cleanup) B foo bar at - line 4.
-########
-# pp_ctl.c
-no warnings 'misc' ;
-package Foo;
-DESTROY { die "@{$_[0]} foo bar" }
-{ bless ['A'], 'Foo' for 1..10 }
-{ bless ['B'], 'Foo' for 1..10 }
-EXPECT
-########
-# pp_ctl.c
-use warnings;
-eval 'print $foo';
-EXPECT
-Use of uninitialized value in print at (eval 1) line 1.
-########
-# pp_ctl.c
-use warnings;
-{
-    no warnings;
-    eval 'print $foo';
-}
-EXPECT

diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot
deleted file mode 100644 (file)
index c5a3790..0000000
--- a/t/pragma/warn/pp_hot
+++ /dev/null
@@ -1,284 +0,0 @@
-  pp_hot.c     
-
-  print() on unopened filehandle abc           [pp_print]
-    $f = $a = "abc" ; print $f $a
-
-  Filehandle %s opened only for input          [pp_print]
-    print STDIN "abc" ;
-
-  Filehandle %s opened only for output         [pp_print]
-    print <STDOUT> ;
-
-  print() on closed filehandle %s              [pp_print]
-    close STDIN ; print STDIN "abc" ;
-
-  uninitialized                                        [pp_rv2av]
-       my $a = undef ; my @b = @$a
-
-  uninitialized                                        [pp_rv2hv]
-       my $a = undef ; my %b = %$a
-
-  Odd number of elements in hash list          [pp_aassign]
-       %X = (1,2,3) ;
-
-  Reference found where even-sized list expected [pp_aassign]
-       $X = [ 1 ..3 ];
-
-  Filehandle %s opened only for output         [Perl_do_readline] 
-       open (FH, ">./xcv") ;
-       my $a = <FH> ;
-
-  glob failed (can't start child: %s)          [Perl_do_readline] <<TODO
-
-  readline() on closed filehandle %s           [Perl_do_readline]
-    close STDIN ; $a = <STDIN>;
-
-  readline() on closed filehandle %s           [Perl_do_readline]
-    readline(NONESUCH);
-
-  glob failed (child exited with status %d%s)  [Perl_do_readline] <<TODO
-
-  Deep recursion on subroutine \"%s\"          [Perl_sub_crush_depth]
-    sub fred { fred() if $a++ < 200} fred()
-
-  Deep recursion on anonymous subroutine       [Perl_sub_crush_depth]
-    $a = sub { &$a if $a++ < 200} &$a
-
-  Possible Y2K bug: about to append an integer to '19' [pp_concat]
-    $x     = "19$yy\n";
-
-  Use of reference "%s" as array index [pp_aelem]
-    $x[\1]
-
-__END__
-# pp_hot.c [pp_print]
-use warnings 'unopened' ;
-$f = $a = "abc" ; 
-print $f $a;
-no warnings 'unopened' ;
-print $f $a;
-EXPECT
-print() on unopened filehandle abc at - line 4.
-########
-# pp_hot.c [pp_print]
-use warnings 'io' ;
-print STDIN "anc";
-print <STDOUT>;
-print <STDERR>;
-open(FOO, ">&STDOUT") and print <FOO>;
-print getc(STDERR);
-print getc(FOO);
-####################################################################
-# The next test is known to fail on some systems (Linux+old glibc, #
-# some *BSDs (including Mac OS X and NeXT), among others.          #
-# We skip it for now (on the grounds that it is "just" a warning). #
-####################################################################
-#read(FOO,$_,1);
-no warnings 'io' ;
-print STDIN "anc";
-EXPECT
-Filehandle STDIN opened only for input at - line 3.
-Filehandle STDOUT opened only for output at - line 4.
-Filehandle STDERR opened only for output at - line 5.
-Filehandle FOO opened only for output at - line 6.
-Filehandle STDERR opened only for output at - line 7.
-Filehandle FOO opened only for output at - line 8.
-########
-# pp_hot.c [pp_print]
-use warnings 'closed' ;
-close STDIN ;
-print STDIN "anc";
-opendir STDIN, ".";
-print STDIN "anc";
-closedir STDIN;
-no warnings 'closed' ;
-print STDIN "anc";
-opendir STDIN, ".";
-print STDIN "anc";
-EXPECT
-print() on closed filehandle STDIN at - line 4.
-print() on closed filehandle STDIN at - line 6.
-       (Are you trying to call print() on dirhandle STDIN?)
-########
-# pp_hot.c [pp_rv2av]
-use warnings 'uninitialized' ;
-my $a = undef ;
-my @b = @$a;
-no warnings 'uninitialized' ;
-my @c = @$a;
-EXPECT
-Use of uninitialized value in array dereference at - line 4.
-########
-# pp_hot.c [pp_rv2hv]
-use warnings 'uninitialized' ;
-my $a = undef ;
-my %b = %$a;
-no warnings 'uninitialized' ;
-my %c = %$a;
-EXPECT
-Use of uninitialized value in hash dereference at - line 4.
-########
-# pp_hot.c [pp_aassign]
-use warnings 'misc' ;
-my %X ; %X = (1,2,3) ;
-no warnings 'misc' ;
-my %Y ; %Y = (1,2,3) ;
-EXPECT
-Odd number of elements in hash assignment at - line 3.
-########
-# pp_hot.c [pp_aassign]
-use warnings 'misc' ;
-my %X ; %X = [1 .. 3] ;
-no warnings 'misc' ;
-my %Y ; %Y = [1 .. 3] ;
-EXPECT
-Reference found where even-sized list expected at - line 3.
-########
-# pp_hot.c [Perl_do_readline]
-use warnings 'closed' ;
-close STDIN        ; $a = <STDIN> ;
-opendir STDIN, "." ; $a = <STDIN> ;
-closedir STDIN;
-no warnings 'closed' ;
-opendir STDIN, "." ; $a = <STDIN> ;
-$a = <STDIN> ;
-EXPECT
-readline() on closed filehandle STDIN at - line 3.
-readline() on closed filehandle STDIN at - line 4.
-       (Are you trying to call readline() on dirhandle STDIN?)
-########
-# pp_hot.c [Perl_do_readline]
-use warnings 'io' ;
-my $file = "./xcv" ; unlink $file ;
-open (FH, ">./xcv") ;
-my $a = <FH> ;
-no warnings 'io' ;
-$a = <FH> ;
-close (FH) ;
-unlink $file ;
-EXPECT
-Filehandle FH opened only for output at - line 5.
-########
-# pp_hot.c [Perl_sub_crush_depth]
-use warnings 'recursion' ;
-sub fred 
-{ 
-    fred() if $a++ < 200
-} 
-{
-  local $SIG{__WARN__} = sub {
-    die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
-  };
-  fred();
-}
-EXPECT
-ok
-########
-# pp_hot.c [Perl_sub_crush_depth]
-no warnings 'recursion' ;
-sub fred 
-{ 
-    fred() if $a++ < 200
-} 
-{
-  local $SIG{__WARN__} = sub {
-    die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
-  };
-  fred();
-}
-EXPECT
-
-########
-# pp_hot.c [Perl_sub_crush_depth]
-use warnings 'recursion' ;
-$b = sub 
-{ 
-    &$b if $a++ < 200
-}  ;
-
-&$b ;
-EXPECT
-Deep recursion on anonymous subroutine at - line 5.
-########
-# pp_hot.c [Perl_sub_crush_depth]
-no warnings 'recursion' ;
-$b = sub 
-{ 
-    &$b if $a++ < 200
-}  ;
-
-&$b ;
-EXPECT
-########
-# pp_hot.c [pp_concat]
-use warnings 'uninitialized';
-my($x, $y);
-sub a { shift }
-a($x . "x");   # should warn once
-a($x . $y);    # should warn twice
-$x .= $y;      # should warn once
-$y .= $y;      # should warn once
-EXPECT
-Use of uninitialized value in concatenation (.) or string at - line 5.
-Use of uninitialized value in concatenation (.) or string at - line 6.
-Use of uninitialized value in concatenation (.) or string at - line 6.
-Use of uninitialized value in concatenation (.) or string at - line 7.
-Use of uninitialized value in concatenation (.) or string at - line 8.
-########
-# pp_hot.c [pp_concat]
-use warnings 'y2k';
-use Config;
-BEGIN {
-    unless ($Config{ccflags} =~ /Y2KWARN/) {
-       print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
-       exit 0;
-    }
-}
-my $x;
-my $yy = 78;
-$x     = "19$yy\n";
-$x     = "19" . $yy . "\n";
-$x     = "319$yy\n";
-$x     = "319" . $yy . "\n";
-$yy = 19;
-$x     = "ok $yy\n";
-$yy = 9;
-$x     = 1 . $yy;
-no warnings 'y2k';
-$x     = "19$yy\n";
-$x     = "19" . $yy . "\n";
-EXPECT
-Possible Y2K bug: about to append an integer to '19' at - line 12.
-Possible Y2K bug: about to append an integer to '19' at - line 13.
-########
-# pp_hot.c [pp_aelem]
-{
-use warnings 'misc';
-print $x[\1];
-}
-{
-no warnings 'misc';
-print $x[\1];
-}
-
-EXPECT
-OPTION regex
-Use of reference ".*" as array index at - line 4.
-########
-# pp_hot.c [pp_aelem]
-package Foo;use overload q("") => sub {};package main;$a = bless {}, "Foo";
-$b = {};
-{
-use warnings 'misc';
-print $x[$a];
-print $x[$b];
-}
-{
-no warnings 'misc';
-print $x[$a];
-print $x[$b];
-}
-
-EXPECT
-OPTION regex
-Use of reference ".*" as array index at - line 7.

diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys
deleted file mode 100644 (file)
index e30637b..0000000
--- a/t/pragma/warn/pp_sys
+++ /dev/null
@@ -1,419 +0,0 @@
-  pp_sys.c     AOK
-
-  untie attempted while %d inner references still exist        [pp_untie]
-    sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
-
-  fileno() on unopened filehandle abc          [pp_fileno]
-    $a = "abc"; fileno($a)
-
-  binmode() on unopened filehandle abc         [pp_binmode]
-    $a = "abc"; fileno($a)
-
-  printf() on unopened filehandle abc          [pp_prtf]
-    $a = "abc"; printf $a "fred"
-
-  Filehandle %s opened only for input          [pp_leavewrite]
-    format STDIN =
-    .
-    write STDIN;
-
-  write() on closed filehandle %s              [pp_leavewrite]
-    format STDIN =
-    .
-    close STDIN;
-    write STDIN ;
-
-  page overflow                                        [pp_leavewrite]
-
-  printf() on unopened filehandle abc          [pp_prtf]
-    $a = "abc"; printf $a "fred"
-
-  Filehandle %s opened only for input          [pp_prtf]
-    $a = "abc"; 
-    printf $a "fred"
-
-  printf() on closed filehandle %s             [pp_prtf]
-    close STDIN ;
-    printf STDIN "fred"
-
-  syswrite() on closed filehandle %s           [pp_send]
-    close STDIN; 
-    syswrite STDIN, "fred", 1;
-
-  send() on closed socket %s                   [pp_send]
-    close STDIN; 
-    send STDIN, "fred", 1
-
-  bind() on closed socket %s                   [pp_bind]
-    close STDIN; 
-    bind STDIN, "fred" ;
-
-
-  connect() on closed socket %s                        [pp_connect]
-    close STDIN; 
-    connect STDIN, "fred" ;
-
-  listen() on closed socket %s                 [pp_listen]
-    close STDIN; 
-    listen STDIN, 2;
-
-  accept() on closed socket %s                 [pp_accept]
-    close STDIN; 
-    accept "fred", STDIN ;
-
-  shutdown() on closed socket %s               [pp_shutdown]
-    close STDIN; 
-    shutdown STDIN, 0;
-
-  setsockopt() on closed socket %s             [pp_ssockopt]
-  getsockopt() on closed socket        %s              [pp_ssockopt]
-    close STDIN; 
-    setsockopt STDIN, 1,2,3;
-    getsockopt STDIN, 1,2;
-
-  getsockname() on closed socket %s            [pp_getpeername]
-  getpeername() on closed socket %s            [pp_getpeername]
-    close STDIN; 
-    getsockname STDIN;
-    getpeername STDIN;
-
-  flock() on closed socket %s                  [pp_flock]
-  flock() on closed socket                     [pp_flock]
-    close STDIN;
-    flock STDIN, 8;
-    flock $a, 8;
-
-  The stat preceding lstat() wasn't an lstat %s        [pp_stat]
-    lstat(STDIN);
-
-  warn(warn_nl, "stat");                       [pp_stat]
-
-  -T on closed filehandle %s
-  stat() on closed filehandle %s
-       close STDIN ; -T STDIN ; stat(STDIN) ;
-
-  warn(warn_nl, "open");                       [pp_fttext]
-    -T "abc\ndef" ;
-
-  Filehandle %s opened only for output         [pp_sysread]
-       my $file = "./xcv" ;
-       open(F, ">$file") ; 
-       my $a = sysread(F, $a,10) ;
-  
-  
-
-__END__
-# pp_sys.c [pp_untie]
-use warnings 'untie' ;
-sub TIESCALAR { bless [] } ; 
-$b = tie $a, 'main'; 
-untie $a ;
-no warnings 'untie' ;
-$c = tie $d, 'main'; 
-untie $d ;
-EXPECT
-untie attempted while 1 inner references still exist at - line 5.
-########
-# pp_sys.c [pp_leavewrite]
-use warnings 'io' ;
-format STDIN =
-.
-write STDIN;
-no warnings 'io' ;
-write STDIN;
-EXPECT
-Filehandle STDIN opened only for input at - line 5.
-########
-# pp_sys.c [pp_leavewrite]
-use warnings 'closed' ;
-format STDIN =
-.
-close STDIN;
-write STDIN;
-opendir STDIN, ".";
-write STDIN;
-closedir STDIN;
-no warnings 'closed' ;
-write STDIN;
-opendir STDIN, ".";
-write STDIN;
-EXPECT
-write() on closed filehandle STDIN at - line 6.
-write() on closed filehandle STDIN at - line 8.
-       (Are you trying to call write() on dirhandle STDIN?)
-########
-# pp_sys.c [pp_leavewrite]
-use warnings 'io' ;
-format STDOUT_TOP =
-abc
-.
-format STDOUT =
-def
-ghi
-.
-$= = 1 ;
-$- =1 ;
-open STDOUT, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
-write ;
-no warnings 'io' ;
-write ;
-EXPECT
-page overflow at - line 13.
-########
-# pp_sys.c [pp_prtf]
-use warnings 'unopened' ;
-$a = "abc"; 
-printf $a "fred";
-no warnings 'unopened' ;
-printf $a "fred";
-EXPECT
-printf() on unopened filehandle abc at - line 4.
-########
-# pp_sys.c [pp_prtf]
-use warnings 'closed' ;
-close STDIN ;
-printf STDIN "fred";
-opendir STDIN, ".";
-printf STDIN "fred";
-closedir STDIN;
-no warnings 'closed' ;
-printf STDIN "fred";
-opendir STDIN, ".";
-printf STDIN "fred";
-EXPECT
-printf() on closed filehandle STDIN at - line 4.
-printf() on closed filehandle STDIN at - line 6.
-       (Are you trying to call printf() on dirhandle STDIN?)
-########
-# pp_sys.c [pp_prtf]
-use warnings 'io' ;
-printf STDIN "fred";
-no warnings 'io' ;
-printf STDIN "fred";
-EXPECT
-Filehandle STDIN opened only for input at - line 3.
-########
-# pp_sys.c [pp_send]
-use warnings 'closed' ;
-close STDIN; 
-syswrite STDIN, "fred", 1;
-opendir STDIN, ".";
-syswrite STDIN, "fred", 1;
-closedir STDIN;
-no warnings 'closed' ;
-syswrite STDIN, "fred", 1;
-opendir STDIN, ".";
-syswrite STDIN, "fred", 1;
-EXPECT
-syswrite() on closed filehandle STDIN at - line 4.
-syswrite() on closed filehandle STDIN at - line 6.
-       (Are you trying to call syswrite() on dirhandle STDIN?)
-########
-# pp_sys.c [pp_flock]
-use Config; 
-BEGIN { 
-  if ( !$Config{d_flock} &&
-       !$Config{d_fcntl_can_lock} &&
-       !$Config{d_lockf} ) {
-    print <<EOM ;
-SKIPPED
-# flock not present
-EOM
-    exit ;
-  } 
-}
-use warnings qw(unopened closed);
-close STDIN;
-flock STDIN, 8;
-opendir STDIN, ".";
-flock STDIN, 8;
-flock FOO, 8;
-flock $a, 8;
-no warnings qw(unopened closed);
-flock STDIN, 8;
-opendir STDIN, ".";
-flock STDIN, 8;
-flock FOO, 8;
-flock $a, 8;
-EXPECT
-flock() on closed filehandle STDIN at - line 16.
-flock() on closed filehandle STDIN at - line 18.
-       (Are you trying to call flock() on dirhandle STDIN?)
-flock() on unopened filehandle FOO at - line 19.
-flock() on unopened filehandle at - line 20.
-########
-# pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
-use warnings 'io' ;
-use Config; 
-BEGIN { 
-  if ( $^O ne 'VMS' and ! $Config{d_socket}) {
-    print <<EOM ;
-SKIPPED
-# send not present
-# bind not present
-# connect not present
-# accept not present
-# shutdown not present
-# setsockopt not present
-# getsockopt not present
-# getsockname not present
-# getpeername not present
-EOM
-    exit ;
-  } 
-}
-close STDIN; 
-send STDIN, "fred", 1;
-bind STDIN, "fred" ;
-connect STDIN, "fred" ;
-listen STDIN, 2;
-accept "fred", STDIN;
-shutdown STDIN, 0;
-setsockopt STDIN, 1,2,3;
-getsockopt STDIN, 1,2;
-getsockname STDIN;
-getpeername STDIN;
-opendir STDIN, ".";
-send STDIN, "fred", 1;
-bind STDIN, "fred" ;
-connect STDIN, "fred" ;
-listen STDIN, 2;
-accept "fred", STDIN;
-shutdown STDIN, 0;
-setsockopt STDIN, 1,2,3;
-getsockopt STDIN, 1,2;
-getsockname STDIN;
-getpeername STDIN;
-closedir STDIN;
-no warnings 'io' ;
-send STDIN, "fred", 1;
-bind STDIN, "fred" ;
-connect STDIN, "fred" ;
-listen STDIN, 2;
-accept STDIN, "fred" ;
-shutdown STDIN, 0;
-setsockopt STDIN, 1,2,3;
-getsockopt STDIN, 1,2;
-getsockname STDIN;
-getpeername STDIN;
-opendir STDIN, ".";
-send STDIN, "fred", 1;
-bind STDIN, "fred" ;
-connect STDIN, "fred" ;
-listen STDIN, 2;
-accept "fred", STDIN;
-shutdown STDIN, 0;
-setsockopt STDIN, 1,2,3;
-getsockopt STDIN, 1,2;
-getsockname STDIN;
-getpeername STDIN;
-EXPECT
-send() on closed socket STDIN at - line 22.
-bind() on closed socket STDIN at - line 23.
-connect() on closed socket STDIN at - line 24.
-listen() on closed socket STDIN at - line 25.
-accept() on closed socket STDIN at - line 26.
-shutdown() on closed socket STDIN at - line 27.
-setsockopt() on closed socket STDIN at - line 28.
-getsockopt() on closed socket STDIN at - line 29.
-getsockname() on closed socket STDIN at - line 30.
-getpeername() on closed socket STDIN at - line 31.
-send() on closed socket STDIN at - line 33.
-       (Are you trying to call send() on dirhandle STDIN?)
-bind() on closed socket STDIN at - line 34.
-       (Are you trying to call bind() on dirhandle STDIN?)
-connect() on closed socket STDIN at - line 35.
-       (Are you trying to call connect() on dirhandle STDIN?)
-listen() on closed socket STDIN at - line 36.
-       (Are you trying to call listen() on dirhandle STDIN?)
-accept() on closed socket STDIN at - line 37.
-       (Are you trying to call accept() on dirhandle STDIN?)
-shutdown() on closed socket STDIN at - line 38.
-       (Are you trying to call shutdown() on dirhandle STDIN?)
-setsockopt() on closed socket STDIN at - line 39.
-       (Are you trying to call setsockopt() on dirhandle STDIN?)
-getsockopt() on closed socket STDIN at - line 40.
-       (Are you trying to call getsockopt() on dirhandle STDIN?)
-getsockname() on closed socket STDIN at - line 41.
-       (Are you trying to call getsockname() on dirhandle STDIN?)
-getpeername() on closed socket STDIN at - line 42.
-       (Are you trying to call getpeername() on dirhandle STDIN?)
-########
-# pp_sys.c [pp_stat]
-use warnings 'newline' ;
-stat "abc\ndef";
-no warnings 'newline' ;
-stat "abc\ndef";
-EXPECT
-Unsuccessful stat on filename containing newline at - line 3.
-########
-# pp_sys.c [pp_stat]
-use Config; 
-BEGIN { 
-  if ($^O eq 'd_lstat') {
-    print <<EOM ;
-SKIPPED
-# lstat not present
-EOM
-    exit ;
-  } 
-}
-use warnings 'io' ;
-lstat(STDIN) ;
-no warnings 'io' ;
-lstat(STDIN) ;
-EXPECT
-The stat preceding lstat() wasn't an lstat at - line 13.
-########
-# pp_sys.c [pp_fttext]
-use warnings qw(unopened closed) ;
-close STDIN ; 
--T STDIN ;
-stat(STDIN) ;
--T HOCUS;
-stat(POCUS);
-no warnings qw(unopened closed) ;
--T STDIN ;
-stat(STDIN);
--T HOCUS;
-stat(POCUS);
-EXPECT
--T on closed filehandle STDIN at - line 4.
-stat() on closed filehandle STDIN at - line 5.
--T on unopened filehandle HOCUS at - line 6.
-stat() on unopened filehandle POCUS at - line 7.
-########
-# pp_sys.c [pp_fttext]
-use warnings 'newline' ;
--T "abc\ndef" ;
-no warnings 'newline' ;
--T "abc\ndef" ;
-EXPECT
-Unsuccessful open on filename containing newline at - line 3.
-########
-# pp_sys.c [pp_sysread]
-use warnings 'io' ;
-if ($^O eq 'dos') {
-    print <<EOM ;
-SKIPPED
-# skipped on dos
-EOM
-    exit ;
-}
-my $file = "./xcv" ;
-open(F, ">$file") ; 
-my $a = sysread(F, $a,10) ;
-no warnings 'io' ;
-my $a = sysread(F, $a,10) ;
-close F ;
-unlink $file ;
-EXPECT
-Filehandle F opened only for output at - line 12.
-########
-# pp_sys.c [pp_binmode]
-use warnings 'unopened' ;
-binmode(BLARG);
-$a = "BLERG";binmode($a);
-EXPECT
-binmode() on unopened filehandle BLARG at - line 3.
-binmode() on unopened filehandle at - line 4.

diff --git a/t/pragma/warn/regcomp b/t/pragma/warn/regcomp
deleted file mode 100644 (file)
index ceca441..0000000
--- a/t/pragma/warn/regcomp
+++ /dev/null
@@ -1,239 +0,0 @@
-  regcomp.c    AOK
-
-  Quantifier unexpected on zero-length expression [S_study_chunk] 
-
-  (?p{}) is deprecated - use (??{})  [S_reg]
-    $a =~ /(?p{'x'})/ ;
-    
-
-  Useless (%s%c) - %suse /%c modifier [S_reg] 
-  Useless (%sc) - %suse /gc modifier [S_reg] 
-
-
-
-  Strange *+?{} on zero-length expression      [S_study_chunk]
-       /(?=a)?/
-
-  %.*s matches null string many times          [S_regpiece]
-       $a = "ABC123" ; $a =~ /(?=a)*/'
-
-  /%.127s/: Unrecognized escape \\%c passed through    [S_regatom] 
-       $x = '\m' ; /$x/
-
-  POSIX syntax [%c %c] is reserved for future extensions [S_checkposixcc] 
-
-
-  Character class [:%.*s:] unknown     [S_regpposixcc]
-
-  Character class syntax [%c %c] belongs inside character classes [S_checkposixcc] 
-  
-  /%.127s/: false [] range \"%*.*s\" in regexp [S_regclass]
-
-  /%.127s/: false [] range \"%*.*s\" in regexp [S_regclassutf8]
-
-  /%.127s/: Unrecognized escape \\%c in character class passed through"        [S_regclass] 
-
-  /%.127s/: Unrecognized escape \\%c in character class passed through"        [S_regclassutf8] 
-
-  False [] range \"%*.*s\" [S_regclass]
-
-__END__
-# regcomp.c [S_regpiece]
-use warnings 'regexp' ;
-my $a = "ABC123" ; 
-$a =~ /(?=a)*/ ;
-no warnings 'regexp' ;
-$a =~ /(?=a)*/ ;
-EXPECT
-(?=a)* matches null string many times in regex; marked by <-- HERE in m/(?=a)* <-- HERE / at - line 4.
-########
-# regcomp.c [S_study_chunk]
-use warnings 'regexp' ;
-$_ = "" ;
-/(?=a)?/;
-no warnings 'regexp' ;
-/(?=a)?/;
-EXPECT
-Quantifier unexpected on zero-length expression in regex; marked by <-- HERE in m/(?=a)? <-- HERE / at - line 4.
-########
-# regcomp.c [S_regatom]
-$x = '\m' ;
-use warnings 'regexp' ;
-$a =~ /a$x/ ;
-no warnings 'regexp' ;
-$a =~ /a$x/ ;
-EXPECT
-Unrecognized escape \m passed through in regex; marked by <-- HERE in m/a\m <-- HERE / at - line 4.
-########
-# regcomp.c [S_regpposixcc S_checkposixcc]
-#
-use warnings 'regexp' ;
-$_ = "" ;
-/[:alpha:]/;
-/[:zog:]/;
-/[[:zog:]]/;
-no warnings 'regexp' ;
-/[:alpha:]/;
-/[:zog:]/;
-/[[:zog:]]/;
-EXPECT
-POSIX syntax [: :] belongs inside character classes in regex; marked by <-- HERE in m/[:alpha:] <-- HERE / at - line 5.
-POSIX syntax [: :] belongs inside character classes in regex; marked by <-- HERE in m/[:zog:] <-- HERE / at - line 6.
-POSIX class [:zog:] unknown in regex; marked by <-- HERE in m/[[:zog:] <-- HERE ]/
-########
-# regcomp.c [S_checkposixcc]
-#
-use warnings 'regexp' ;
-$_ = "" ;
-/[.zog.]/;
-no warnings 'regexp' ;
-/[.zog.]/;
-EXPECT
-POSIX syntax [. .] belongs inside character classes in regex; marked by <-- HERE in m/[.zog.] <-- HERE / at - line 5.
-POSIX syntax [. .] is reserved for future extensions in regex; marked by <-- HERE in m/[.zog.] <-- HERE /
-########
-# regcomp.c [S_checkposixcc]
-#
-use warnings 'regexp' ;
-$_ = "" ;
-/[[.zog.]]/;
-no warnings 'regexp' ;
-/[[.zog.]]/;
-EXPECT
-POSIX syntax [. .] is reserved for future extensions in regex; marked by <-- HERE in m/[[.zog.] <-- HERE ]/
-########
-# regcomp.c [S_regclass]
-$_ = "";
-use warnings 'regexp' ;
-/[a-b]/;
-/[a-\d]/;
-/[\d-b]/;
-/[\s-\d]/;
-/[\d-\s]/;
-/[a-[:digit:]]/;
-/[[:digit:]-b]/;
-/[[:alpha:]-[:digit:]]/;
-/[[:digit:]-[:alpha:]]/;
-no warnings 'regexp' ;
-/[a-b]/;
-/[a-\d]/;
-/[\d-b]/;
-/[\s-\d]/;
-/[\d-\s]/;
-/[a-[:digit:]]/;
-/[[:digit:]-b]/;
-/[[:alpha:]-[:digit:]]/;
-/[[:digit:]-[:alpha:]]/;
-EXPECT
-False [] range "a-\d" in regex; marked by <-- HERE in m/[a-\d <-- HERE ]/ at - line 5.
-False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE b]/ at - line 6.
-False [] range "\s-" in regex; marked by <-- HERE in m/[\s- <-- HERE \d]/ at - line 7.
-False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE \s]/ at - line 8.
-False [] range "a-[:digit:]" in regex; marked by <-- HERE in m/[a-[:digit:] <-- HERE ]/ at - line 9.
-False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE b]/ at - line 10.
-False [] range "[:alpha:]-" in regex; marked by <-- HERE in m/[[:alpha:]- <-- HERE [:digit:]]/ at - line 11.
-False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE [:alpha:]]/ at - line 12.
-########
-# regcomp.c [S_regclassutf8]
-BEGIN {
-    if (ord("\t") == 5) {
-        print "SKIPPED\n# ebcdic regular expression ranges differ.";
-        exit 0;
-    }
-}
-use utf8;
-$_ = "";
-use warnings 'regexp' ;
-/[a-b]/;
-/[a-\d]/;
-/[\d-b]/;
-/[\s-\d]/;
-/[\d-\s]/;
-/[a-[:digit:]]/;
-/[[:digit:]-b]/;
-/[[:alpha:]-[:digit:]]/;
-/[[:digit:]-[:alpha:]]/;
-no warnings 'regexp' ;
-/[a-b]/;
-/[a-\d]/;
-/[\d-b]/;
-/[\s-\d]/;
-/[\d-\s]/;
-/[a-[:digit:]]/;
-/[[:digit:]-b]/;
-/[[:alpha:]-[:digit:]]/;
-/[[:digit:]-[:alpha:]]/;
-EXPECT
-False [] range "a-\d" in regex; marked by <-- HERE in m/[a-\d <-- HERE ]/ at - line 12.
-False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE b]/ at - line 13.
-False [] range "\s-" in regex; marked by <-- HERE in m/[\s- <-- HERE \d]/ at - line 14.
-False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE \s]/ at - line 15.
-False [] range "a-[:digit:]" in regex; marked by <-- HERE in m/[a-[:digit:] <-- HERE ]/ at - line 16.
-False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE b]/ at - line 17.
-False [] range "[:alpha:]-" in regex; marked by <-- HERE in m/[[:alpha:]- <-- HERE [:digit:]]/ at - line 18.
-False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE [:alpha:]]/ at - line 19.
-########
-# regcomp.c [S_regclass S_regclassutf8]
-use warnings 'regexp' ;
-$a =~ /[a\zb]/ ;
-no warnings 'regexp' ;
-$a =~ /[a\zb]/ ;
-EXPECT
-Unrecognized escape \z in character class passed through in regex; marked by <-- HERE in m/[a\z <-- HERE b]/ at - line 3.
-
-########
-# regcomp.c [S_study_chunk]
-use warnings 'deprecated' ;
-$a = "xx" ;
-$a =~ /(?p{'x'})/ ;
-no warnings ;
-use warnings 'regexp' ;
-$a =~ /(?p{'x'})/ ;
-use warnings;
-no warnings 'deprecated' ;
-no warnings 'regexp' ;
-$a =~ /(?p{'x'})/ ;
-EXPECT
-(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 4.
-(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 7.
-########
-# regcomp.c [S_reg]
-use warnings 'regexp' ;
-$a = qr/(?c)/;
-$a = qr/(?-c)/;
-$a = qr/(?g)/;
-$a = qr/(?-g)/;
-$a = qr/(?o)/;
-$a = qr/(?-o)/;
-$a = qr/(?g-o)/;
-$a = qr/(?g-c)/;
-$a = qr/(?o-cg)/;  # (?c) means (?g) error won't be thrown
-$a = qr/(?ogc)/;
-no warnings 'regexp' ;
-$a = qr/(?c)/;
-$a = qr/(?-c)/;
-$a = qr/(?g)/;
-$a = qr/(?-g)/;
-$a = qr/(?o)/;
-$a = qr/(?-o)/;
-$a = qr/(?g-o)/;
-$a = qr/(?g-c)/;
-$a = qr/(?o-cg)/;  # (?c) means (?g) error won't be thrown
-$a = qr/(?ogc)/;
-#EXPECT
-EXPECT
-Useless (?c) - use /gc modifier in regex; marked by <-- HERE in m/(?c <-- HERE )/ at - line 3.
-Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?-c <-- HERE )/ at - line 4.
-Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE )/ at - line 5.
-Useless (?-g) - don't use /g modifier in regex; marked by <-- HERE in m/(?-g <-- HERE )/ at - line 6.
-Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE )/ at - line 7.
-Useless (?-o) - don't use /o modifier in regex; marked by <-- HERE in m/(?-o <-- HERE )/ at - line 8.
-Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE -o)/ at - line 9.
-Useless (?-o) - don't use /o modifier in regex; marked by <-- HERE in m/(?g-o <-- HERE )/ at - line 9.
-Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE -c)/ at - line 10.
-Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?g-c <-- HERE )/ at - line 10.
-Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE -cg)/ at - line 11.
-Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?o-c <-- HERE g)/ at - line 11.
-Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE gc)/ at - line 12.
-Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?og <-- HERE c)/ at - line 12.
-Useless (?c) - use /gc modifier in regex; marked by <-- HERE in m/(?ogc <-- HERE )/ at - line 12.

diff --git a/t/pragma/warn/regexec b/t/pragma/warn/regexec
deleted file mode 100644 (file)
index 73696df..0000000
--- a/t/pragma/warn/regexec
+++ /dev/null
@@ -1,119 +0,0 @@
-  regexec.c    
-
-  This test generates "bad free" warnings when run under
-  PERL_DESTRUCT_LEVEL.  This file merely serves as a placeholder
-  for investigation.
-
-  Complex regular subexpression recursion limit (%d) exceeded
-
-        $_ = 'a' x (2**15+1); /^()(a\1)*$/ ;
-  Complex regular subexpression recursion limit (%d) exceeded
-
-        $_ = 'a' x (2**15+1); /^()(a\1)*?$/ ;
-
-  (The actual value substituted for %d is masked in the tests so that
-  REG_INFTY configuration variable value does not affect outcome.)
-__END__
-# regexec.c
-print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
-use warnings 'regexp' ;
-$SIG{__WARN__} = sub{local ($m) = shift;
-                 $m =~ s/\(\d+\)/(*MASKED*)/;
-                 print STDERR $m};
-$_ = 'a' x (2**15+1); 
-/^()(a\1)*$/ ;
-#
-# If this test fails with a segmentation violation or similar,
-# you may have to increase the default stacksize limit in your
-# shell.  You may need superuser privileges.
-#
-# Under the sh, ksh, zsh:
-#    $ ulimit -s
-#    8192
-#    $ ulimit -s 16000
-#
-# Under the csh:
-#    % limit stacksize
-#    stacksize        8192 kbytes
-#    % limit stacksize 16000
-#
-EXPECT
-Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9.
-########
-# regexec.c
-print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
-no warnings 'regexp' ;
-$SIG{__WARN__} = sub{local ($m) = shift;
-                 $m =~ s/\(\d+\)/(*MASKED*)/;
-                 print STDERR $m};
-$_ = 'a' x (2**15+1); 
-/^()(a\1)*$/ ;
-#
-# If this test fails with a segmentation violation or similar,
-# you may have to increase the default stacksize limit in your
-# shell.  You may need superuser privileges.
-#
-# Under the sh, ksh, zsh:
-#    $ ulimit -s
-#    8192
-#    $ ulimit -s 16000
-#
-# Under the csh:
-#    % limit stacksize
-#    stacksize        8192 kbytes
-#    % limit stacksize 16000
-#
-EXPECT
-
-########
-# regexec.c
-print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
-use warnings 'regexp' ;
-$SIG{__WARN__} = sub{local ($m) = shift;
-                 $m =~ s/\(\d+\)/(*MASKED*)/;
-                 print STDERR $m};
-$_ = 'a' x (2**15+1);
-/^()(a\1)*?$/ ;
-#
-# If this test fails with a segmentation violation or similar,
-# you may have to increase the default stacksize limit in your
-# shell.  You may need superuser privileges.
-#
-# Under the sh, ksh, zsh:
-#    $ ulimit -s
-#    8192
-#    $ ulimit -s 16000
-#
-# Under the csh:
-#    % limit stacksize
-#    stacksize        8192 kbytes
-#    % limit stacksize 16000
-#
-EXPECT
-Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9.
-########
-# regexec.c
-print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
-no warnings 'regexp' ;
-$SIG{__WARN__} = sub{local ($m) = shift;
-                 $m =~ s/\(\d+\)/(*MASKED*)/;
-                 print STDERR $m};
-$_ = 'a' x (2**15+1);
-/^()(a\1)*?$/ ;
-#
-# If this test fails with a segmentation violation or similar,
-# you may have to increase the default stacksize limit in your
-# shell.  You may need superuser privileges.
-#
-# Under the sh, ksh, zsh:
-#    $ ulimit -s
-#    8192
-#    $ ulimit -s 16000
-#
-# Under the csh:
-#    % limit stacksize
-#    stacksize        8192 kbytes
-#    % limit stacksize 16000
-#
-EXPECT
-

diff --git a/t/pragma/warn/run b/t/pragma/warn/run
deleted file mode 100644 (file)
index 7a4be20..0000000
--- a/t/pragma/warn/run
+++ /dev/null
@@ -1,8 +0,0 @@
-  run.c 
-
-
-  Mandatory Warnings ALL TODO
-  ------------------
-        NULL OP IN RUN
-
-__END__

diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv
deleted file mode 100644 (file)
index b3929e2..0000000
--- a/t/pragma/warn/sv
+++ /dev/null
@@ -1,320 +0,0 @@
-  sv.c 
-
-  warn(warn_uninit);
-
-  warn(warn_uninit);
-
-  warn(warn_uninit);
-
-  warn(warn_uninit);
-
-  not_a_number(sv);
-
-  not_a_number(sv);
-
-  warn(warn_uninit);
-
-  not_a_number(sv);
-
-  warn(warn_uninit);
-
-  not_a_number(sv);
-
-  not_a_number(sv);
-
-  warn(warn_uninit);
-
-  warn(warn_uninit);
-
-  Subroutine %s redefined      
-
-  Invalid conversion in %s:
-
-  Undefined value assigned to typeglob
-
-  Possible Y2K bug: %d format string following '19'
-
-  Reference is already weak                    [Perl_sv_rvweaken] <<TODO
-
-  Mandatory Warnings
-  ------------------
-  Malformed UTF-8 character [sv_pos_b2u] (not tested: difficult to produce
-                                          with perl now)
-
-  Mandatory Warnings TODO
-  ------------------
-    Attempt to free non-arena SV: 0x%lx                [del_sv]
-    Reference miscount in sv_replace()         [sv_replace]
-    Attempt to free unreferenced scalar                [sv_free]
-    Attempt to free temp prematurely: SV 0x%lx [sv_free]
-    semi-panic: attempt to dup freed string    [newSVsv]
-    
-
-__END__
-# sv.c
-use integer ;
-use warnings 'uninitialized' ;
-$x = 1 + $a[0] ; # a
-no warnings 'uninitialized' ;
-$x = 1 + $b[0] ; # a
-EXPECT
-Use of uninitialized value in integer addition (+) at - line 4.
-########
-# sv.c (sv_2iv)
-package fred ;
-sub TIESCALAR { my $x ; bless \$x}
-sub FETCH { return undef }
-sub STORE { return 1 }
-package main ;
-tie $A, 'fred' ;
-use integer ;
-use warnings 'uninitialized' ;
-$A *= 2 ;
-no warnings 'uninitialized' ;
-$A *= 2 ;
-EXPECT
-Use of uninitialized value in integer multiplication (*) at - line 10.
-########
-# sv.c
-use integer ;
-use warnings 'uninitialized' ;
-my $x *= 2 ; #b 
-no warnings 'uninitialized' ;
-my $y *= 2 ; #b 
-EXPECT
-Use of uninitialized value in integer multiplication (*) at - line 4.
-########
-# sv.c (sv_2uv)
-package fred ;
-sub TIESCALAR { my $x ; bless \$x}
-sub FETCH { return undef }
-sub STORE { return 1 }
-package main ;
-tie $A, 'fred' ;
-use warnings 'uninitialized' ;
-$B = 0 ;
-$B |= $A ;
-no warnings 'uninitialized' ;
-$B = 0 ;
-$B |= $A ;
-EXPECT
-Use of uninitialized value in bitwise or (|) at - line 10.
-########
-# sv.c
-use warnings 'uninitialized' ;
-my $Y = 1 ; 
-my $x = 1 | $a[$Y] ;
-no warnings 'uninitialized' ;
-my $Y = 1 ; 
-$x = 1 | $b[$Y] ;
-EXPECT
-Use of uninitialized value in bitwise or (|) at - line 4.
-########
-# sv.c
-use warnings 'uninitialized' ;
-my $x *= 1 ; # d
-no warnings 'uninitialized' ;
-my $y *= 1 ; # d
-EXPECT
-Use of uninitialized value in multiplication (*) at - line 3.
-########
-# sv.c
-use warnings 'uninitialized' ;
-$x = 1 + $a[0] ; # e
-no warnings 'uninitialized' ;
-$x = 1 + $b[0] ; # e
-EXPECT
-Use of uninitialized value in addition (+) at - line 3.
-########
-# sv.c (sv_2nv)
-package fred ;
-sub TIESCALAR { my $x ; bless \$x}
-sub FETCH { return undef }
-sub STORE { return 1 }
-package main ;
-tie $A, 'fred' ;
-use warnings 'uninitialized' ;
-$A *= 2 ;
-no warnings 'uninitialized' ;
-$A *= 2 ;
-EXPECT
-Use of uninitialized value in multiplication (*) at - line 9.
-########
-# sv.c
-use warnings 'uninitialized' ;
-$x = $y + 1 ; # f
-no warnings 'uninitialized' ;
-$x = $z + 1 ; # f
-EXPECT
-Use of uninitialized value in addition (+) at - line 3.
-########
-# sv.c
-use warnings 'uninitialized' ;
-$x = chop undef ; # g
-no warnings 'uninitialized' ;
-$x = chop undef ; # g
-EXPECT
-Modification of a read-only value attempted at - line 3.
-########
-# sv.c
-use warnings 'uninitialized' ;
-$x = chop $y ; # h
-no warnings 'uninitialized' ;
-$x = chop $z ; # h
-EXPECT
-Use of uninitialized value in scalar chop at - line 3.
-########
-# sv.c (sv_2pv)
-package fred ;
-sub TIESCALAR { my $x ; bless \$x}
-sub FETCH { return undef }
-sub STORE { return 1 }
-package main ;
-tie $A, 'fred' ;
-use warnings 'uninitialized' ;
-$B = "" ;
-$B .= $A ;
-no warnings 'uninitialized' ;
-$C = "" ;
-$C .= $A ;
-EXPECT
-Use of uninitialized value in concatenation (.) or string at - line 10.
-########
-# sv.c 
-use warnings 'numeric' ;
-sub TIESCALAR{bless[]} ; 
-sub FETCH {"def"} ; 
-tie $a,"main" ; 
-my $b = 1 + $a;
-no warnings 'numeric' ;
-my $c = 1 + $a;
-EXPECT
-Argument "def" isn't numeric in addition (+) at - line 6.
-########
-# sv.c
-use warnings 'numeric' ;
-my $x = 1 + "def" ;
-no warnings 'numeric' ;
-my $z = 1 + "def" ;
-EXPECT
-Argument "def" isn't numeric in addition (+) at - line 3.
-########
-# sv.c
-use warnings 'numeric' ;
-my $a = "def" ;
-my $x = 1 + $a ;
-no warnings 'numeric' ;
-my $y = 1 + $a ;
-EXPECT
-Argument "def" isn't numeric in addition (+) at - line 4.
-########
-# sv.c
-use warnings 'numeric' ; use integer ;
-my $a = "def" ;
-my $x = 1 + $a ;
-no warnings 'numeric' ;
-my $z = 1 + $a ;
-EXPECT
-Argument "def" isn't numeric in integer addition (+) at - line 4.
-########
-# sv.c
-use warnings 'numeric' ;
-my $x = 1 & "def" ;
-no warnings 'numeric' ;
-my $z = 1 & "def" ;
-EXPECT
-Argument "def" isn't numeric in bitwise and (&) at - line 3.
-########
-# sv.c
-use warnings 'numeric' ;
-my $x = pack i => "def" ;
-no warnings 'numeric' ;
-my $z = pack i => "def" ;
-EXPECT
-Argument "def" isn't numeric in pack at - line 3.
-########
-# sv.c
-use warnings 'numeric' ; 
-my $a = "d\0f" ;
-my $x = 1 + $a ;
-no warnings 'numeric' ;
-my $z = 1 + $a ;
-EXPECT
-Argument "d\0f" isn't numeric in addition (+) at - line 4.
-########
-# sv.c
-use warnings 'redefine' ;
-sub fred {}  
-sub joe {} 
-*fred = \&joe ;
-no warnings 'redefine' ;
-sub jim {} 
-*jim = \&joe ;
-EXPECT
-Subroutine fred redefined at - line 5.
-########
-# sv.c
-use warnings 'printf' ;
-open F, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
-printf F "%z\n" ;
-my $a = sprintf "%z" ;
-printf F "%" ;
-$a = sprintf "%" ;
-printf F "%\x02" ;
-$a = sprintf "%\x02" ;
-no warnings 'printf' ;
-printf F "%z\n" ;
-$a = sprintf "%z" ;
-printf F "%" ;
-$a = sprintf "%" ;
-printf F "%\x02" ;
-$a = sprintf "%\x02" ;
-EXPECT
-Invalid conversion in sprintf: "%z" at - line 5.
-Invalid conversion in sprintf: end of string at - line 7.
-Invalid conversion in sprintf: "%\002" at - line 9.
-Invalid conversion in printf: "%z" at - line 4.
-Invalid conversion in printf: end of string at - line 6.
-Invalid conversion in printf: "%\002" at - line 8.
-########
-# sv.c
-use warnings 'misc' ;
-*a = undef ;
-no warnings 'misc' ;
-*b = undef ;
-EXPECT
-Undefined value assigned to typeglob at - line 3.
-########
-# sv.c
-use warnings 'y2k';
-use Config;
-BEGIN {
-    unless ($Config{ccflags} =~ /Y2KWARN/) {
-       print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
-       exit 0;
-    }
-    $|=1;
-}
-my $x;
-my $yy = 78;
-$x     = printf  "19%02d\n", $yy;
-$x     = sprintf "#19%02d\n", $yy;
-$x     = printf  " 19%02d\n", 78;
-$x     = sprintf "19%02d\n", 78;
-$x     = printf  "319%02d\n", $yy;
-$x     = sprintf "319%02d\n", $yy;
-no warnings 'y2k';
-$x     = printf  "19%02d\n", $yy;
-$x     = sprintf "19%02d\n", $yy;
-$x     = printf  "19%02d\n", 78;
-$x     = sprintf "19%02d\n", 78;
-EXPECT
-Possible Y2K bug: %d format string following '19' at - line 16.
-Possible Y2K bug: %d format string following '19' at - line 13.
-1978
-Possible Y2K bug: %d format string following '19' at - line 14.
-Possible Y2K bug: %d format string following '19' at - line 15.
- 1978
-31978
-1978
-1978

diff --git a/t/pragma/warn/taint b/t/pragma/warn/taint
deleted file mode 100644 (file)
index fd6deed..0000000
--- a/t/pragma/warn/taint
+++ /dev/null
@@ -1,49 +0,0 @@
-  taint.c AOK
-
-  Insecure %s%s while running with -T switch
-
-__END__
--T
---FILE-- abc
-def
---FILE--
-# taint.c
-open(FH, "<abc") ;
-$a = <FH> ;
-close FH ;
-chdir $a ;
-print "xxx\n" ;
-EXPECT
-Insecure dependency in chdir while running with -T switch at - line 5.
-########
--TU
---FILE-- abc
-def
---FILE--
-# taint.c
-open(FH, "<abc") ;
-$a = <FH> ;
-close FH ;
-chdir $a ;
-print "xxx\n" ;
-EXPECT
-xxx
-########
--TU
---FILE-- abc
-def
---FILE--
-# taint.c
-open(FH, "<abc") ;
-$a = <FH> ;
-close FH ;
-use warnings 'taint' ;
-chdir $a ;
-print "xxx\n" ;
-no warnings 'taint' ;
-chdir $a ;
-print "yyy\n" ;
-EXPECT
-Insecure dependency in chdir while running with -T switch at - line 6.
-xxx
-yyy

diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke
deleted file mode 100644 (file)
index 242b005..0000000
--- a/t/pragma/warn/toke
+++ /dev/null
@@ -1,732 +0,0 @@
-toke.c AOK
-
-    we seem to have lost a few ambiguous warnings!!
-
- 
-               $a = <<;
-               Use of comma-less variable list is deprecated 
-               (called 3 times via depcom)
-
-     \1 better written as $1 
-       use warnings 'syntax' ;
-       s/(abc)/\1/;
- 
-     warn(warn_nosemi) 
-     Semicolon seems to be missing
-       $a = 1
-       &time ;
-
-
-     Reversed %c= operator 
-       my $a =+ 2 ;
-       $a =- 2 ;
-       $a =* 2 ;
-       $a =% 2 ;
-       $a =& 2 ;
-       $a =. 2 ;
-       $a =^ 2 ;
-       $a =| 2 ;
-       $a =< 2 ;
-       $a =/ 2 ;
-
-     Multidimensional syntax %.*s not supported 
-       my $a = $a[1,2] ;
-
-     You need to quote \"%s\"" 
-       sub fred {} ; $SIG{TERM} = fred;
-
-     Scalar value %.*s better written as $%.*s" 
-       @a[3] = 2;
-       @a{3} = 2;
-
-     Can't use \\%c to mean $%c in expression 
-       $_ = "ab" ; s/(ab)/\1/e;
-
-     Unquoted string "abc" may clash with future reserved word at - line 3.
-     warn(warn_reserved        
-       $a = abc;
-
-     chmod() mode argument is missing initial 0 
-       chmod 3;
-
-     Possible attempt to separate words with commas 
-       @a = qw(a, b, c) ;
-
-     Possible attempt to put comments in qw() list 
-       @a = qw(a b # c) ;
-
-     umask: argument is missing initial 0 
-       umask 3;
-
-     %s (...) interpreted as function 
-       print ("")
-       printf ("")
-       sort ("")
-
-     Ambiguous use of %c{%s%s} resolved to %c%s%s 
-       $a = ${time[2]}
-       $a = ${time{2}}
-
-
-     Ambiguous use of %c{%s} resolved to %c%s
-       $a = ${time}
-       sub fred {} $a = ${fred}
-
-     Misplaced _ in number 
-       $a = 1_2;
-       $a = 1_2345_6;
-
-    Bareword \"%s\" refers to nonexistent package
-       $a = FRED:: ;
-
-    Ambiguous call resolved as CORE::%s(), qualify as such or use &
-       sub time {} 
-       my $a = time()
-
-    Unrecognized escape \\%c passed through
-        $a = "\m" ;
-
-    %s number > %s non-portable
-        my $a =  0b011111111111111111111111111111110 ;
-        $a =  0b011111111111111111111111111111111 ;
-        $a =  0b111111111111111111111111111111111 ;
-        $a =  0x0fffffffe ;
-        $a =  0x0ffffffff ;
-        $a =  0x1ffffffff ;
-        $a =  0037777777776 ;
-        $a =  0037777777777 ;
-        $a =  0047777777777 ;
-
-    Integer overflow in binary number
-        my $a =  0b011111111111111111111111111111110 ;
-        $a =  0b011111111111111111111111111111111 ;
-        $a =  0b111111111111111111111111111111111 ;
-        $a =  0x0fffffffe ;
-        $a =  0x0ffffffff ;
-        $a =  0x1ffffffff ;
-        $a =  0037777777776 ;
-        $a =  0037777777777 ;
-        $a =  0047777777777 ;
-     
-    Mandatory Warnings
-    ------------------
-    Use of "%s" without parentheses is ambiguous       [check_uni]
-        rand + 4 
-
-    Ambiguous use of -%s resolved as -&%s()            [yylex]
-        sub fred {} ; - fred ;
-
-    Precedence problem: open %.*s should be open(%.*s) [yylex]
-       open FOO || die;
-
-    Operator or semicolon missing before %c%s          [yylex]
-    Ambiguous use of %c resolved as operator %c
-        *foo *foo
-
-__END__
-# toke.c 
-use warnings 'deprecated' ;
-format STDOUT =
-@<<<  @|||  @>>>  @>>>
-$a    $b    "abc" 'def'
-.
-no warnings 'deprecated' ;
-format STDOUT =
-@<<<  @|||  @>>>  @>>>
-$a    $b    "abc" 'def'
-.
-EXPECT
-Use of comma-less variable list is deprecated at - line 5.
-Use of comma-less variable list is deprecated at - line 5.
-Use of comma-less variable list is deprecated at - line 5.
-########
-# toke.c
-use warnings 'deprecated' ;
-$a = <<;
-
-no warnings 'deprecated' ;
-$a = <<;
-
-EXPECT
-Use of bare << to mean <<"" is deprecated at - line 3.
-########
-# toke.c
-use warnings 'syntax' ;
-s/(abc)/\1/;
-no warnings 'syntax' ;
-s/(abc)/\1/;
-EXPECT
-\1 better written as $1 at - line 3.
-########
-# toke.c
-use warnings 'semicolon' ;
-$a = 1
-&time ;
-no warnings 'semicolon' ;
-$a = 1
-&time ;
-EXPECT
-Semicolon seems to be missing at - line 3.
-########
-# toke.c
-use warnings 'syntax' ;
-my $a =+ 2 ;
-$a =- 2 ;
-$a =* 2 ;
-$a =% 2 ;
-$a =& 2 ;
-$a =. 2 ;
-$a =^ 2 ;
-$a =| 2 ;
-$a =< 2 ;
-$a =/ 2 ;
-EXPECT
-Reversed += operator at - line 3.
-Reversed -= operator at - line 4.
-Reversed *= operator at - line 5.
-Reversed %= operator at - line 6.
-Reversed &= operator at - line 7.
-Reversed .= operator at - line 8.
-Reversed ^= operator at - line 9.
-Reversed |= operator at - line 10.
-Reversed <= operator at - line 11.
-syntax error at - line 8, near "=."
-syntax error at - line 9, near "=^"
-syntax error at - line 10, near "=|"
-Unterminated <> operator at - line 11.
-########
-# toke.c
-no warnings 'syntax' ;
-my $a =+ 2 ;
-$a =- 2 ;
-$a =* 2 ;
-$a =% 2 ;
-$a =& 2 ;
-$a =. 2 ;
-$a =^ 2 ;
-$a =| 2 ;
-$a =< 2 ;
-$a =/ 2 ;
-EXPECT
-syntax error at - line 8, near "=."
-syntax error at - line 9, near "=^"
-syntax error at - line 10, near "=|"
-Unterminated <> operator at - line 11.
-########
-# toke.c
-use warnings 'syntax' ;
-my $a = $a[1,2] ;
-no warnings 'syntax' ;
-my $a = $a[1,2] ;
-EXPECT
-Multidimensional syntax $a[1,2] not supported at - line 3.
-########
-# toke.c
-use warnings 'syntax' ;
-sub fred {} ; $SIG{TERM} = fred;
-no warnings 'syntax' ;
-$SIG{TERM} = fred;
-EXPECT
-You need to quote "fred" at - line 3.
-########
-# toke.c
-use warnings 'syntax' ;
-@a[3] = 2;
-@a{3} = 2;
-no warnings 'syntax' ;
-@a[3] = 2;
-@a{3} = 2;
-EXPECT
-Scalar value @a[3] better written as $a[3] at - line 3.
-Scalar value @a{3} better written as $a{3} at - line 4.
-########
-# toke.c
-use warnings 'syntax' ;
-$_ = "ab" ; 
-s/(ab)/\1/e;
-no warnings 'syntax' ;
-$_ = "ab" ; 
-s/(ab)/\1/e;
-EXPECT
-Can't use \1 to mean $1 in expression at - line 4.
-########
-# toke.c
-use warnings 'reserved' ;
-$a = abc;
-$a = { def
-
-=> 1 };
-no warnings 'reserved' ;
-$a = abc;
-EXPECT
-Unquoted string "abc" may clash with future reserved word at - line 3.
-########
-# toke.c
-use warnings 'chmod' ;
-chmod 3;
-no warnings 'chmod' ;
-chmod 3;
-EXPECT
-chmod() mode argument is missing initial 0 at - line 3.
-########
-# toke.c
-use warnings 'qw' ;
-@a = qw(a, b, c) ;
-no warnings 'qw' ;
-@a = qw(a, b, c) ;
-EXPECT
-Possible attempt to separate words with commas at - line 3.
-########
-# toke.c
-use warnings 'qw' ;
-@a = qw(a b #) ;
-no warnings 'qw' ;
-@a = qw(a b #) ;
-EXPECT
-Possible attempt to put comments in qw() list at - line 3.
-########
-# toke.c
-use warnings 'umask' ;
-umask 3;
-no warnings 'umask' ;
-umask 3;
-EXPECT
-umask: argument is missing initial 0 at - line 3.
-########
-# toke.c
-use warnings 'syntax' ;
-print ("")
-EXPECT
-print (...) interpreted as function at - line 3.
-########
-# toke.c
-no warnings 'syntax' ;
-print ("")
-EXPECT
-
-########
-# toke.c
-use warnings 'syntax' ;
-printf ("")
-EXPECT
-printf (...) interpreted as function at - line 3.
-########
-# toke.c
-no warnings 'syntax' ;
-printf ("")
-EXPECT
-
-########
-# toke.c
-use warnings 'syntax' ;
-sort ("")
-EXPECT
-sort (...) interpreted as function at - line 3.
-########
-# toke.c
-no warnings 'syntax' ;
-sort ("")
-EXPECT
-
-########
-# toke.c
-use warnings 'ambiguous' ;
-$a = ${time[2]};
-no warnings 'ambiguous' ;
-$a = ${time[2]};
-EXPECT
-Ambiguous use of ${time[...]} resolved to $time[...] at - line 3.
-########
-# toke.c
-use warnings 'ambiguous' ;
-$a = ${time{2}};
-EXPECT
-Ambiguous use of ${time{...}} resolved to $time{...} at - line 3.
-########
-# toke.c
-no warnings 'ambiguous' ;
-$a = ${time{2}};
-EXPECT
-
-########
-# toke.c
-use warnings 'ambiguous' ;
-$a = ${time} ;
-no warnings 'ambiguous' ;
-$a = ${time} ;
-EXPECT
-Ambiguous use of ${time} resolved to $time at - line 3.
-########
-# toke.c
-use warnings 'ambiguous' ;
-sub fred {}
-$a = ${fred} ;
-no warnings 'ambiguous' ;
-$a = ${fred} ;
-EXPECT
-Ambiguous use of ${fred} resolved to $fred at - line 4.
-########
-# toke.c
-use warnings 'syntax' ;
-$a = _123; print "$a\n";               #( 3    string)
-$a = 1_23; print "$a\n";
-$a = 12_3; print "$a\n";
-$a = 123_; print "$a\n";               #  6
-$a = _+123; print "$a\n";              #  7    string)
-$a = +_123; print "$a\n";              #( 8    string)
-$a = +1_23; print "$a\n";
-$a = +12_3; print "$a\n";
-$a = +123_; print "$a\n";              # 11
-$a = _-123; print "$a\n";              #(12    string)
-$a = -_123; print "$a\n";              #(13    string)
-$a = -1_23; print "$a\n";
-$a = -12_3; print "$a\n";
-$a = -123_; print "$a\n";              # 16
-$a = 123._456; print "$a\n";           # 17
-$a = 123.4_56; print "$a\n";
-$a = 123.45_6; print "$a\n";
-$a = 123.456_; print "$a\n";           # 20
-$a = +123._456; print "$a\n";          # 21
-$a = +123.4_56; print "$a\n";  
-$a = +123.45_6; print "$a\n";  
-$a = +123.456_; print "$a\n";          # 24
-$a = -123._456; print "$a\n";          # 25
-$a = -123.4_56; print "$a\n";  
-$a = -123.45_6; print "$a\n";
-$a = -123.456_; print "$a\n";          # 28
-$a = 123.456E_12; print "$a\n";                # 29
-$a = 123.456E1_2; print "$a\n";
-$a = 123.456E12_; print "$a\n";                # 31
-$a = 123.456E_+12; print "$a\n";       # 32
-$a = 123.456E+_12; print "$a\n";       # 33
-$a = 123.456E+1_2; print "$a\n";
-$a = 123.456E+12_; print "$a\n";       # 35
-$a = 123.456E_-12; print "$a\n";       # 36
-$a = 123.456E-_12; print "$a\n";       # 37
-$a = 123.456E-1_2; print "$a\n";
-$a = 123.456E-12_; print "$a\n";       # 39
-$a = 1__23; print "$a\n";              # 40
-$a = 12.3__4; print "$a\n";            # 41
-$a = 12.34e1__2; print "$a\n";         # 42
-no warnings 'syntax' ;
-$a = _123; print "$a\n";
-$a = 1_23; print "$a\n";
-$a = 12_3; print "$a\n";
-$a = 123_; print "$a\n";
-$a = _+123; print "$a\n";
-$a = +_123; print "$a\n";
-$a = +1_23; print "$a\n";
-$a = +12_3; print "$a\n";
-$a = +123_; print "$a\n";
-$a = _-123; print "$a\n";
-$a = -_123; print "$a\n";
-$a = -1_23; print "$a\n";
-$a = -12_3; print "$a\n";
-$a = -123_; print "$a\n";
-$a = 123._456; print "$a\n";
-$a = 123.4_56; print "$a\n";
-$a = 123.45_6; print "$a\n";
-$a = 123.456_; print "$a\n";
-$a = +123._456; print "$a\n";
-$a = +123.4_56; print "$a\n";
-$a = +123.45_6; print "$a\n";
-$a = +123.456_; print "$a\n";
-$a = -123._456; print "$a\n";
-$a = -123.4_56; print "$a\n";
-$a = -123.45_6; print "$a\n";
-$a = -123.456_; print "$a\n";
-$a = 123.456E_12; print "$a\n";
-$a = 123.456E1_2; print "$a\n";
-$a = 123.456E12_; print "$a\n";
-$a = 123.456E_+12; print "$a\n";
-$a = 123.456E+_12; print "$a\n";
-$a = 123.456E+1_2; print "$a\n";
-$a = 123.456E+12_; print "$a\n";
-$a = 123.456E_-12; print "$a\n";
-$a = 123.456E-_12; print "$a\n";
-$a = 123.456E-1_2; print "$a\n";
-$a = 123.456E-12_; print "$a\n";
-$a = 1__23; print "$a\n";
-$a = 12.3__4; print "$a\n";
-$a = 12.34e1__2; print "$a\n";
-EXPECT
-OPTIONS regex
-Misplaced _ in number at - line 6.
-Misplaced _ in number at - line 11.
-Misplaced _ in number at - line 16.
-Misplaced _ in number at - line 17.
-Misplaced _ in number at - line 20.
-Misplaced _ in number at - line 21.
-Misplaced _ in number at - line 24.
-Misplaced _ in number at - line 25.
-Misplaced _ in number at - line 28.
-Misplaced _ in number at - line 29.
-Misplaced _ in number at - line 31.
-Misplaced _ in number at - line 32.
-Misplaced _ in number at - line 33.
-Misplaced _ in number at - line 35.
-Misplaced _ in number at - line 36.
-Misplaced _ in number at - line 37.
-Misplaced _ in number at - line 39.
-Misplaced _ in number at - line 40.
-Misplaced _ in number at - line 41.
-Misplaced _ in number at - line 42.
-_123
-123
-123
-123
-123
-_123
-123
-123
-123
--123
--_123
--123
--123
--123
-123.456
-123.456
-123.456
-123.456
-123.456
-123.456
-123.456
-123.456
--123.456
--123.456
--123.456
--123.456
-123456000000000
-123456000000000
-123456000000000
-123456000000000
-123456000000000
-123456000000000
-123456000000000
-1.23456e-0?10
-1.23456e-0?10
-1.23456e-0?10
-1.23456e-0?10
-123
-12.34
-12340000000000
-_123
-123
-123
-123
-123
-_123
-123
-123
-123
--123
--_123
--123
--123
--123
-123.456
-123.456
-123.456
-123.456
-123.456
-123.456
-123.456
-123.456
--123.456
--123.456
--123.456
--123.456
-123456000000000
-123456000000000
-123456000000000
-123456000000000
-123456000000000
-123456000000000
-123456000000000
-1.23456e-0?10
-1.23456e-0?10
-1.23456e-0?10
-1.23456e-0?10
-123
-12.34
-12340000000000
-########
-# toke.c
-use warnings 'bareword' ;
-#line 25 "bar"
-$a = FRED:: ;
-no warnings 'bareword' ;
-#line 25 "bar"
-$a = FRED:: ;
-EXPECT
-Bareword "FRED::" refers to nonexistent package at bar line 25.
-########
-# toke.c
-use warnings 'ambiguous' ;
-sub time {}
-my $a = time() ;
-no warnings 'ambiguous' ;
-my $b = time() ;
-EXPECT
-Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4.
-########
-# toke.c
-use warnings ;
-eval <<'EOE';
-#  line 30 "foo"
-warn "yelp";
-{
-  $_ = " \x{123} " ;
-}
-EOE
-EXPECT
-yelp at foo line 30.
-########
-# toke.c
-my $a = rand + 4 ;
-EXPECT
-Warning: Use of "rand" without parens is ambiguous at - line 2.
-########
-# toke.c
-$^W = 0 ;
-my $a = rand + 4 ;
-{
-    no warnings 'ambiguous' ;
-    $a = rand + 4 ;
-    use warnings 'ambiguous' ;
-    $a = rand + 4 ;
-}
-$a = rand + 4 ;
-EXPECT
-Warning: Use of "rand" without parens is ambiguous at - line 3.
-Warning: Use of "rand" without parens is ambiguous at - line 8.
-Warning: Use of "rand" without parens is ambiguous at - line 10.
-########
-# toke.c
-sub fred {};
--fred ;
-EXPECT
-Ambiguous use of -fred resolved as -&fred() at - line 3.
-########
-# toke.c
-$^W = 0 ;
-sub fred {} ;
--fred ;
-{
-    no warnings 'ambiguous' ;
-    -fred ;
-    use warnings 'ambiguous' ;
-    -fred ;
-}
--fred ;
-EXPECT
-Ambiguous use of -fred resolved as -&fred() at - line 4.
-Ambiguous use of -fred resolved as -&fred() at - line 9.
-Ambiguous use of -fred resolved as -&fred() at - line 11.
-########
-# toke.c
-open FOO || time;
-EXPECT
-Precedence problem: open FOO should be open(FOO) at - line 2.
-########
-# toke.c
-$^W = 0 ;
-open FOO || time;
-{
-    no warnings 'precedence' ;
-    open FOO || time;
-    use warnings 'precedence' ;
-    open FOO || time;
-}
-open FOO || time;
-EXPECT
-Precedence problem: open FOO should be open(FOO) at - line 3.
-Precedence problem: open FOO should be open(FOO) at - line 8.
-Precedence problem: open FOO should be open(FOO) at - line 10.
-########
-# toke.c
-$^W = 0 ;
-*foo *foo ;
-{
-    no warnings 'ambiguous' ;
-    *foo *foo ;
-    use warnings 'ambiguous' ;
-    *foo *foo ;
-}
-*foo *foo ;
-EXPECT
-Operator or semicolon missing before *foo at - line 3.
-Ambiguous use of * resolved as operator * at - line 3.
-Operator or semicolon missing before *foo at - line 8.
-Ambiguous use of * resolved as operator * at - line 8.
-Operator or semicolon missing before *foo at - line 10.
-Ambiguous use of * resolved as operator * at - line 10.
-########
-# toke.c
-use warnings 'misc' ;
-my $a = "\m" ;
-no warnings 'misc' ;
-$a = "\m" ;
-EXPECT
-Unrecognized escape \m passed through at - line 3.
-########
-# toke.c
-use warnings 'portable' ;
-my $a =  0b011111111111111111111111111111110 ;
-   $a =  0b011111111111111111111111111111111 ;
-   $a =  0b111111111111111111111111111111111 ;
-   $a =  0x0fffffffe ;
-   $a =  0x0ffffffff ;
-   $a =  0x1ffffffff ;
-   $a =  0037777777776 ;
-   $a =  0037777777777 ;
-   $a =  0047777777777 ;
-no warnings 'portable' ;
-   $a =  0b011111111111111111111111111111110 ;
-   $a =  0b011111111111111111111111111111111 ;
-   $a =  0b111111111111111111111111111111111 ;
-   $a =  0x0fffffffe ;
-   $a =  0x0ffffffff ;
-   $a =  0x1ffffffff ;
-   $a =  0037777777776 ;
-   $a =  0037777777777 ;
-   $a =  0047777777777 ;
-EXPECT
-Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
-Hexadecimal number > 0xffffffff non-portable at - line 8.
-Octal number > 037777777777 non-portable at - line 11.
-########
-# toke.c
-use warnings 'overflow' ;
-my $a =  0b011111111111111111111111111111110 ;
-   $a =  0b011111111111111111111111111111111 ;
-   $a =  0b10000000000000000000000000000000000000000000000000000000000000000 ;
-   $a =  0x0fffffffe ;
-   $a =  0x0ffffffff ;
-   $a =  0x10000000000000000 ;
-   $a =  0037777777776 ;
-   $a =  0037777777777 ;
-   $a =  002000000000000000000000;
-no warnings 'overflow' ;
-   $a =  0b011111111111111111111111111111110 ;
-   $a =  0b011111111111111111111111111111111 ;
-   $a =  0b10000000000000000000000000000000000000000000000000000000000000000 ;
-   $a =  0x0fffffffe ;
-   $a =  0x0ffffffff ;
-   $a =  0x10000000000000000 ;
-   $a =  0037777777776 ;
-   $a =  0037777777777 ;
-   $a =  002000000000000000000000;
-EXPECT
-Integer overflow in binary number at - line 5.
-Integer overflow in hexadecimal number at - line 8.
-Integer overflow in octal number at - line 11.
-########
-# toke.c
-use warnings 'ambiguous';
-"@mjd_previously_unused_array";        
-no warnings 'ambiguous';
-"@mjd_previously_unused_array";        
-EXPECT
-Possible unintended interpolation of @mjd_previously_unused_array in string at - line 3.

diff --git a/t/pragma/warn/universal b/t/pragma/warn/universal
deleted file mode 100644 (file)
index d9b1883..0000000
--- a/t/pragma/warn/universal
+++ /dev/null
@@ -1,14 +0,0 @@
-  universal.c AOK
-
-  Can't locate package %s for @%s::ISA [S_isa_lookup]
-      
-
-
-__END__
-# universal.c [S_isa_lookup]
-use warnings 'misc' ;
-@ISA = qw(Joe) ;
-my $a = bless [] ;
-UNIVERSAL::isa $a, Jim ;
-EXPECT
-Can't locate package Joe for @main::ISA at - line 5.

diff --git a/t/pragma/warn/utf8 b/t/pragma/warn/utf8
deleted file mode 100644 (file)
index 9a7dbaf..0000000
--- a/t/pragma/warn/utf8
+++ /dev/null
@@ -1,35 +0,0 @@
-
-  utf8.c AOK
-
-     [utf8_to_uv]
-     Malformed UTF-8 character
-       my $a = ord "\x80" ;
-
-     Malformed UTF-8 character
-       my $a = ord "\xf080" ;
-     <<<<<< this warning can't be easily triggered from perl anymore
-
-     [utf16_to_utf8]
-     Malformed UTF-16 surrogate                
-     <<<<<< Add a test when somethig actually calls utf16_to_utf8
-
-__END__
-# utf8.c [utf8_to_uv] -W
-BEGIN {
-    if (ord('A') == 193) {
-        print "SKIPPED\n# ebcdic platforms do not generate Malformed UTF-8 warnings.";
-        exit 0;
-    }
-}
-use utf8 ;
-my $a = "snøstorm" ;
-{
-    no warnings 'utf8' ;
-    my $a = "snøstorm";
-    use warnings 'utf8' ;
-    my $a = "snøstorm";
-}
-EXPECT
-Malformed UTF-8 character (unexpected non-continuation byte 0x73 after start byte 0xf8) at - line 9.
-Malformed UTF-8 character (unexpected non-continuation byte 0x73 after start byte 0xf8) at - line 14.
-########

diff --git a/t/pragma/warn/util b/t/pragma/warn/util
deleted file mode 100644 (file)
index e82d6a6..0000000
--- a/t/pragma/warn/util
+++ /dev/null
@@ -1,108 +0,0 @@
-  util.c AOK
- 
-     Illegal octal digit ignored 
-       my $a = oct "029" ;
-
-     Illegal hex digit ignored 
-       my $a = hex "0xv9" ;
-
-     Illegal binary digit ignored
-      my $a = oct "0b9" ;
-     
-     Integer overflow in binary number
-       my $a =  oct "0b111111111111111111111111111111111111111111" ;
-     Binary number > 0b11111111111111111111111111111111 non-portable
-       $a =  oct "0b111111111111111111111111111111111" ;
-     Integer overflow in octal number
-       my $a =  oct "077777777777777777777777777777" ;
-     Octal number > 037777777777 non-portable
-       $a =  oct "0047777777777" ;
-     Integer overflow in hexadecimal number
-       my $a =  hex "0xffffffffffffffffffff" ;
-     Hexadecimal number > 0xffffffff non-portable
-       $a =  hex "0x1ffffffff" ;
-
-__END__
-# util.c
-use warnings 'digit' ;
-my $a = oct "029" ;
-no warnings 'digit' ;
-$a = oct "029" ;
-EXPECT
-Illegal octal digit '9' ignored at - line 3.
-########
-# util.c
-use warnings 'digit' ;
-my $a =  hex "0xv9" ;
-no warnings 'digit' ;
-$a =  hex "0xv9" ;
-EXPECT
-Illegal hexadecimal digit 'v' ignored at - line 3.
-########
-# util.c
-use warnings 'digit' ;
-my $a =  oct "0b9" ;
-no warnings 'digit' ;
-$a =  oct "0b9" ;
-EXPECT
-Illegal binary digit '9' ignored at - line 3.
-########
-# util.c
-use warnings 'overflow' ;
-my $a =  oct "0b11111111111111111111111111111111111111111111111111111111111111111";
-no warnings 'overflow' ;
-$a =  oct "0b11111111111111111111111111111111111111111111111111111111111111111";
-EXPECT
-Integer overflow in binary number at - line 3.
-########
-# util.c
-use warnings 'overflow' ;
-my $a =  hex "0xffffffffffffffffffff" ;
-no warnings 'overflow' ;
-$a =  hex "0xffffffffffffffffffff" ;
-EXPECT
-Integer overflow in hexadecimal number at - line 3.
-########
-# util.c
-use warnings 'overflow' ;
-my $a =  oct "077777777777777777777777777777" ;
-no warnings 'overflow' ;
-$a =  oct "077777777777777777777777777777" ;
-EXPECT
-Integer overflow in octal number at - line 3.
-########
-# util.c
-use warnings 'portable' ;
-my $a =  oct "0b011111111111111111111111111111110" ;
-   $a =  oct "0b011111111111111111111111111111111" ;
-   $a =  oct "0b111111111111111111111111111111111" ;
-no warnings 'portable' ;
-   $a =  oct "0b011111111111111111111111111111110" ;
-   $a =  oct "0b011111111111111111111111111111111" ;
-   $a =  oct "0b111111111111111111111111111111111" ;
-EXPECT
-Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
-########
-# util.c
-use warnings 'portable' ;
-my $a =  hex "0x0fffffffe" ;
-   $a =  hex "0x0ffffffff" ;
-   $a =  hex "0x1ffffffff" ;
-no warnings 'portable' ;
-   $a =  hex "0x0fffffffe" ;
-   $a =  hex "0x0ffffffff" ;
-   $a =  hex "0x1ffffffff" ;
-EXPECT
-Hexadecimal number > 0xffffffff non-portable at - line 5.
-########
-# util.c
-use warnings 'portable' ;
-my $a =  oct "0037777777776" ;
-   $a =  oct "0037777777777" ;
-   $a =  oct "0047777777777" ;
-no warnings 'portable' ;
-   $a =  oct "0037777777776" ;
-   $a =  oct "0037777777777" ;
-   $a =  oct "0047777777777" ;
-EXPECT
-Octal number > 037777777777 non-portable at - line 5.

diff --git a/t/pragma/warnings.t b/t/pragma/warnings.t
deleted file mode 100644 (file)
index 09b41fb..0000000
--- a/t/pragma/warnings.t
+++ /dev/null
@@ -1,131 +0,0 @@
-#!./perl 
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    $ENV{PERL5LIB} = '../lib';
-    require Config; import Config;
-}
-
-$| = 1;
-
-my $Is_VMS     = $^O eq 'VMS';
-my $Is_MSWin32 = $^O eq 'MSWin32';
-my $Is_NetWare = $^O eq 'NetWare';
-my $tmpfile = "tmp0000";
-my $i = 0 ;
-1 while -f ++$tmpfile;
-END {  if ($tmpfile) { 1 while unlink $tmpfile} }
-
-my @prgs = () ;
-my @w_files = () ;
-
-if (@ARGV)
-  { print "ARGV = [@ARGV]\n" ; @w_files = map { s#^#./pragma/warn/#; $_ } @ARGV }
-else
-  { @w_files = sort glob("pragma/warn/*") }
-
-my $files = 0;
-foreach my $file (@w_files) {
-
-    next if $file =~ /(~|\.orig|,v)$/;
-
-    open F, "<$file" or die "Cannot open $file: $!\n" ;
-    my $line = 0;
-    while (<F>) {
-        $line++; 
-       last if /^__END__/ ;
-    }
-
-    {
-        local $/ = undef;
-        $files++; 
-        @prgs = (@prgs, $file, split "\n########\n", <F>) ;
-    }
-    close F ;
-}
-
-undef $/;
-
-print "1..", scalar(@prgs)-$files, "\n";
- 
- 
-for (@prgs){
-    unless (/\n/)
-     {
-      print "# From $_\n"; 
-      next; 
-     }
-    my $switch = "";
-    my @temps = () ;
-    if (s/^\s*-\w+//){
-        $switch = $&;
-        $switch =~ s/(-\S*[A-Z]\S*)/"$1"/ if $Is_VMS; # protect uc switches
-    }
-    my($prog,$expected) = split(/\nEXPECT\n/, $_);
-    if ( $prog =~ /--FILE--/) {
-        my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
-       shift @files ;
-       die "Internal error test $i didn't split into pairs, got " . 
-               scalar(@files) . "[" . join("%%%%", @files) ."]\n"
-           if @files % 2 ;
-       while (@files > 2) {
-           my $filename = shift @files ;
-           my $code = shift @files ;
-           push @temps, $filename ;
-           open F, ">$filename" or die "Cannot open $filename: $!\n" ;
-           print F $code ;
-           close F ;
-       }
-       shift @files ;
-       $prog = shift @files ;
-    }
-    open TEST, ">$tmpfile";
-    print TEST $prog,"\n";
-    close TEST;
-    my $results = $Is_VMS ?
-                  `./perl "-I../lib" $switch $tmpfile 2>&1` :
-                 $Is_MSWin32 ?
-                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
-                 $Is_NetWare ?
-                  `perl -I../lib $switch $tmpfile 2>&1` :
-                  `./perl -I../lib $switch $tmpfile 2>&1`;
-    my $status = $?;
-    $results =~ s/\n+$//;
-    # allow expected output to be written as if $prog is on STDIN
-    $results =~ s/tmp\d+/-/g;
-    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
-# bison says 'parse error' instead of 'syntax error',
-# various yaccs may or may not capitalize 'syntax'.
-    $results =~ s/^(syntax|parse) error/syntax error/mig;
-    # allow all tests to run when there are leaks
-    $results =~ s/Scalars leaked: \d+\n//g;
-    $expected =~ s/\n+$//;
-    my $prefix = ($results =~ s#^PREFIX(\n|$)##) ;
-    # any special options? (OPTIONS foo bar zap)
-    my $option_regex = 0;
-    if ($expected =~ s/^OPTIONS? (.+)\n//) {
-       foreach my $option (split(' ', $1)) {
-           if ($option eq 'regex') { # allow regular expressions
-               $option_regex = 1;
-           } else {
-               die "$0: Unknown OPTION '$option'\n";
-           }
-       }
-    }
-    if ( $results =~ s/^SKIPPED\n//) {
-       print "$results\n" ;
-    }
-    elsif (($prefix  && (( $option_regex && $results !~ /^$expected/) ||
-                        (!$option_regex && $results !~ /^\Q$expected/))) or
-          (!$prefix && (( $option_regex && $results !~ /^$expected/) ||
-                        (!$option_regex && $results ne $expected)))) {
-        print STDERR "PROG: $switch\n$prog\n";
-        print STDERR "EXPECTED:\n$expected\n";
-        print STDERR "GOT:\n$results\n";
-        print "not ";
-    }
-    print "ok ", ++$i, "\n";
-    foreach (@temps) 
-       { unlink $_ if $_ } 
-}