summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2001-06-18 04:17:15 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2001-06-18 04:17:15 +0000
commitb695f709e8a342e35e482b0437eb6cdacdc58b6b (patch)
tree2d16192636e6ba806ff7a907f682c74f7705a920 /ext
parentd780cd7a0195e946e636d3ee546f6ef4f21d6acc (diff)
downloadperl-b695f709e8a342e35e482b0437eb6cdacdc58b6b.tar.gz
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
Diffstat (limited to 'ext')
-rwxr-xr-xext/B/B.t63
-rw-r--r--ext/B/Debug.t70
-rw-r--r--ext/B/Deparse.t176
-rw-r--r--ext/B/Showlex.t39
-rw-r--r--ext/B/Stash.t60
-rw-r--r--ext/Cwd/Cwd.t134
-rwxr-xr-xext/DB_File/t/db-btree.t1296
-rwxr-xr-xext/DB_File/t/db-hash.t743
-rwxr-xr-xext/DB_File/t/db-recno.t889
-rwxr-xr-xext/Data/Dumper/t/dumper.t810
-rwxr-xr-xext/Data/Dumper/t/overload.t35
-rw-r--r--ext/Devel/Peek/Peek.t308
-rw-r--r--ext/Digest/MD5/t/aaa.t552
-rw-r--r--ext/Digest/MD5/t/align.t20
-rw-r--r--ext/Digest/MD5/t/badfile.t26
-rw-r--r--ext/Digest/MD5/t/files.t150
-rw-r--r--ext/Encode.t122
-rwxr-xr-xext/Errno/Errno.t54
-rw-r--r--ext/Fcntl/Fcntl.t46
-rw-r--r--ext/Fcntl/syslfs.t267
-rw-r--r--ext/Filter/t/call.t795
-rwxr-xr-xext/GDBM_File/gdbm.t427
-rwxr-xr-xext/IO/lib/IO/t/io_const.t33
-rwxr-xr-xext/IO/lib/IO/t/io_dir.t68
-rwxr-xr-xext/IO/lib/IO/t/io_dup.t61
-rwxr-xr-xext/IO/lib/IO/t/io_linenum.t80
-rw-r--r--ext/IO/lib/IO/t/io_multihomed.t128
-rwxr-xr-xext/IO/lib/IO/t/io_pipe.t123
-rwxr-xr-xext/IO/lib/IO/t/io_poll.t82
-rwxr-xr-xext/IO/lib/IO/t/io_sel.t132
-rwxr-xr-xext/IO/lib/IO/t/io_sock.t338
-rwxr-xr-xext/IO/lib/IO/t/io_taint.t48
-rwxr-xr-xext/IO/lib/IO/t/io_tell.t64
-rwxr-xr-xext/IO/lib/IO/t/io_udp.t94
-rw-r--r--ext/IO/lib/IO/t/io_unix.t89
-rw-r--r--ext/IO/lib/IO/t/io_xs.t43
-rwxr-xr-xext/List/Util/t/blessed.t39
-rwxr-xr-xext/List/Util/t/dualvar.t46
-rwxr-xr-xext/List/Util/t/first.t25
-rwxr-xr-xext/List/Util/t/max.t30
-rwxr-xr-xext/List/Util/t/maxstr.t30
-rwxr-xr-xext/List/Util/t/min.t30
-rwxr-xr-xext/List/Util/t/minstr.t30
-rw-r--r--ext/List/Util/t/readonly.t46
-rwxr-xr-xext/List/Util/t/reduce.t30
-rwxr-xr-xext/List/Util/t/reftype.t55
-rwxr-xr-xext/List/Util/t/sum.t23
-rw-r--r--ext/List/Util/t/tainted.t38
-rwxr-xr-xext/List/Util/t/weak.t206
-rw-r--r--ext/MIME/Base64/t/base64.t383
-rw-r--r--ext/MIME/Base64/t/qp.t113
-rw-r--r--ext/MIME/Base64/t/unicode.t16
-rwxr-xr-xext/NDBM_File/ndbm.t420
-rwxr-xr-xext/ODBM_File/odbm.t437
-rwxr-xr-xext/ODBM_File/sdbm.t429
-rwxr-xr-xext/Opcode/Opcode.t115
-rwxr-xr-xext/Opcode/ops.t29
-rwxr-xr-xext/POSIX/POSIX.t139
-rw-r--r--ext/POSIX/sigaction.t127
-rw-r--r--ext/PerlIO/PerlIO.t90
-rw-r--r--ext/PerlIO/t/scalar.t101
-rwxr-xr-xext/Safe/safe1.t68
-rwxr-xr-xext/Safe/safe2.t145
-rwxr-xr-xext/Socket/Socket.t87
-rw-r--r--ext/Storable/t/blessed.t104
-rw-r--r--ext/Storable/t/canonical.t153
-rw-r--r--ext/Storable/t/compat06.t157
-rw-r--r--ext/Storable/t/dclone.t82
-rw-r--r--ext/Storable/t/forgive.t67
-rw-r--r--ext/Storable/t/freeze.t119
-rw-r--r--ext/Storable/t/lock.t61
-rw-r--r--ext/Storable/t/overload.t97
-rw-r--r--ext/Storable/t/recurse.t300
-rw-r--r--ext/Storable/t/retrieve.t78
-rw-r--r--ext/Storable/t/store.t119
-rw-r--r--ext/Storable/t/tied.t213
-rw-r--r--ext/Storable/t/tied_hook.t254
-rw-r--r--ext/Storable/t/tied_items.t68
-rw-r--r--ext/Storable/t/utf8.t40
-rwxr-xr-xext/Sys/Hostname/Hostname.t25
-rwxr-xr-xext/Sys/Syslog/syslog.t72
-rwxr-xr-xext/Thread/thr5005.t207
-rw-r--r--ext/Time/HiRes/HiRes.t216
-rw-r--r--ext/Time/Piece/Piece.t323
-rw-r--r--ext/XS/Typemap/Typemap.t339
-rw-r--r--ext/attrs.t141
86 files changed, 15027 insertions, 0 deletions
diff --git a/ext/B/B.t b/ext/B/B.t
new file mode 100755
index 0000000000..f21f4891e4
--- /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
index 0000000000..286dac3574
--- /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
index 0000000000..048ce31eef
--- /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
index 0000000000..a21f03bb15
--- /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
index 0000000000..bc9d896927
--- /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
index 0000000000..09b45d6004
--- /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
index 0000000000..4b4a7967ee
--- /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
index 0000000000..6f2ef37b61
--- /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
index 0000000000..6dd913cfc2
--- /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
index 0000000000..10add1cedb
--- /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
index 0000000000..d4b3a924ae
--- /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
index 0000000000..c14dc9bdad
--- /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
index 0000000000..f3f3202cb9
--- /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
index 0000000000..4176062415
--- /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
index 0000000000..63effdfc21
--- /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
index 0000000000..c786a5f4e5
--- /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
index 0000000000..ceeb422672
--- /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
index 0000000000..02f5ce2ca6
--- /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
index 0000000000..24ade27c92
--- /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
index 0000000000..8d9769fded
--- /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
index 0000000000..dc667c98ee
--- /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
index 0000000000..0f5cfa0186
--- /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
index 0000000000..db1a322453
--- /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
index 0000000000..6ec4e9f232
--- /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
index 0000000000..8983a56f36
--- /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
index 0000000000..cf55c980ea
--- /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
index 0000000000..62f25bc39e
--- /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
index 0000000000..ae18224b12
--- /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
index 0000000000..d31ea47f53
--- /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
index 0000000000..84660db183
--- /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
index 0000000000..b752fd89ba
--- /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
index 0000000000..c98d70151f
--- /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
index 0000000000..65c63bdfc9
--- /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
index 0000000000..d63a5dcf7b
--- /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
index 0000000000..2f6def0af7
--- /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
index 0000000000..2449fc45c1
--- /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
index 0000000000..89a740a8cb
--- /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
index 0000000000..5bf4fe95f7
--- /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
index 0000000000..6a35948e95
--- /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
index 0000000000..911003b92a
--- /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
index 0000000000..0ec35cab30
--- /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
index 0000000000..a51ced4e3d
--- /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
index 0000000000..c000e7856d
--- /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
index 0000000000..864e1f12f2
--- /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
index 0000000000..063e0b791b
--- /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
index 0000000000..ea7ea7bbc1
--- /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
index 0000000000..34fb69076a
--- /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
index 0000000000..5587bb7bf9
--- /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
index 0000000000..6c7bea7f4d
--- /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
index 0000000000..7a61fe9576
--- /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
index 0000000000..1a7f9e4550
--- /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
index 0000000000..0b8df1ae7c
--- /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
index 0000000000..cb975e0047
--- /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
index 0000000000..a43e70bd99
--- /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
index 0000000000..57928e0e51
--- /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
index 0000000000..a785fce48b
--- /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
index 0000000000..56b1bacabb
--- /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
index 0000000000..09bd88c2a9
--- /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
index 0000000000..c38b122775
--- /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
index 0000000000..d71ab8ec4f
--- /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
index 0000000000..8368e666b9
--- /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
index 0000000000..27993d95c9
--- /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
index 0000000000..4d6c84a692
--- /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
index 0000000000..481fd8f3e0
--- /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
index 0000000000..b1a18e62c3
--- /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
index 0000000000..b55669b653
--- /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
index 0000000000..1586b18a81
--- /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
index 0000000000..38c82ebcc1
--- /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
index 0000000000..58810983c5
--- /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
index 0000000000..37631edc7e
--- /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
index 0000000000..77d73bbb79
--- /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
index 0000000000..6d1e5816d1
--- /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
index 0000000000..e3afc9cf2f
--- /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
index 0000000000..c968485ab2
--- /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
index 0000000000..d26755f129
--- /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
index 0000000000..88131fea03
--- /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
index 0000000000..46805cf510
--- /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
index 0000000000..3d0abf796f
--- /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
index 0000000000..2160308a28
--- /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
index 0000000000..85a04cd488
--- /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
index 0000000000..801e882508
--- /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
index 0000000000..6650683e16
--- /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
index 0000000000..db35b955a5
--- /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
index 0000000000..c62e36d95e
--- /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
index 0000000000..0cf1ab3481
--- /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
index 0000000000..18a02aba84
--- /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;