ext/DynaLoader/README Dynamic Loader notes and intro
ext/DynaLoader/XSLoader_pm.PL Simple XS Loader perl module
ext/Encode/AUTHORS List of authors
+ext/Encode/bin/enc2xs Encode module generator
+ext/Encode/bin/piconv iconv by perl
+ext/Encode/bin/ucm2table Table Generator for testing
+ext/Encode/bin/ucmlint A UCM Lint utility
+ext/Encode/bin/unidump Unicode Dump like hexdump(1)
ext/Encode/Byte/Byte.pm Encode extension
ext/Encode/Byte/Makefile.PL Encode extension
+ext/Encode/Changes Change Log
ext/Encode/CN/CN.pm Encode extension
ext/Encode/CN/Makefile.PL Encode extension
-ext/Encode/Changes Change Log
ext/Encode/EBCDIC/EBCDIC.pm Encode extension
ext/Encode/EBCDIC/Makefile.PL Encode extension
+ext/Encode/encengine.c Encode extension
ext/Encode/Encode.pm Mother of all Encode extensions
ext/Encode/Encode.xs Encode extension
ext/Encode/Encode/Changes.e2x Skeleton file for enc2xs
ext/Encode/Encode/ConfigLocal_PM.e2x Skeleton file for enc2xs
+ext/Encode/Encode/encode.h Encode extension header file
ext/Encode/Encode/Makefile_PL.e2x Skeleton file for enc2xs
ext/Encode/Encode/README.e2x Skeleton file for enc2xs
ext/Encode/Encode/_PM.e2x Skeleton file for enc2xs
ext/Encode/Encode/_T.e2x Skeleton file for enc2xs
-ext/Encode/Encode/encode.h Encode extension header file
+ext/Encode/encoding.pm Perl Pragmactic Module
ext/Encode/JP/JP.pm Encode extension
ext/Encode/JP/Makefile.PL Encode extension
ext/Encode/KR/KR.pm Encode extension
ext/Encode/KR/Makefile.PL Encode extension
-ext/Encode/MANIFEST Encode extension
-ext/Encode/Makefile.PL Encode extension makefile writer
-ext/Encode/README Encode extension
-ext/Encode/Symbol/Makefile.PL Encode extension
-ext/Encode/Symbol/Symbol.pm Encode extension
-ext/Encode/TW/Makefile.PL Encode extension
-ext/Encode/TW/TW.pm Encode extension
-ext/Encode/Unicode/Makefile.PL Encode extension
-ext/Encode/Unicode/Unicode.pm Encode extension
-ext/Encode/Unicode/Unicode.xs Encode extension
-ext/Encode/bin/enc2xs Encode module generator
-ext/Encode/bin/piconv iconv by perl
-ext/Encode/bin/ucm2table Table Generator for testing
-ext/Encode/bin/ucmlint A UCM Lint utility
-ext/Encode/bin/unidump Unicode Dump like hexdump(1)
-ext/Encode/encengine.c Encode extension
-ext/Encode/encoding.pm Perl Pragmactic Module
ext/Encode/lib/Encode/Alias.pm Encode extension
ext/Encode/lib/Encode/CJKConstants.pm Encode extension
ext/Encode/lib/Encode/CN/HZ.pm Encode extension
ext/Encode/lib/Encode/MIME/Header.pm Encode extension
ext/Encode/lib/Encode/PerlIO.pod Documents for Encode & PerlIO
ext/Encode/lib/Encode/Supported.pod Documents for supported encodings
+ext/Encode/Makefile.PL Encode extension makefile writer
+ext/Encode/MANIFEST Encode extension
+ext/Encode/README Encode extension
+ext/Encode/Symbol/Makefile.PL Encode extension
+ext/Encode/Symbol/Symbol.pm Encode extension
ext/Encode/t/Aliases.t test script
-ext/Encode/t/CJKT.t test script
-ext/Encode/t/Encode.t test script
-ext/Encode/t/Encoder.t test script
-ext/Encode/t/Unicode.t test script
ext/Encode/t/at-cn.t test script
ext/Encode/t/at-tw.t test script
ext/Encode/t/big5-eten.enc test data
ext/Encode/t/big5-eten.utf test data
ext/Encode/t/big5-hkscs.enc test data
ext/Encode/t/big5-hkscs.utf test data
+ext/Encode/t/CJKT.t test script
+ext/Encode/t/Encode.t test script
+ext/Encode/t/Encoder.t test script
ext/Encode/t/encoding.t test script
ext/Encode/t/fallback.t test script
ext/Encode/t/gb2312.enc test data
ext/Encode/t/mime-header.t test script
ext/Encode/t/perlio.t test script
ext/Encode/t/unibench.pl benchmark script
+ext/Encode/t/Unicode.t test script
+ext/Encode/TW/Makefile.PL Encode extension
+ext/Encode/TW/TW.pm Encode extension
ext/Encode/ucm/8859-1.ucm Unicode Character Map
ext/Encode/ucm/8859-10.ucm Unicode Character Map
ext/Encode/ucm/8859-11.ucm Unicode Character Map
ext/Encode/ucm/macIceland.ucm Unicode Character Map
ext/Encode/ucm/macJapanese.ucm Unicode Character Map
ext/Encode/ucm/macKorean.ucm Unicode Character Map
+ext/Encode/ucm/macRoman.ucm Unicode Character Map
ext/Encode/ucm/macROMnn.ucm Unicode Character Map
ext/Encode/ucm/macRUMnn.ucm Unicode Character Map
-ext/Encode/ucm/macRoman.ucm Unicode Character Map
ext/Encode/ucm/macSami.ucm Unicode Character Map
ext/Encode/ucm/macSymbol.ucm Unicode Character Map
ext/Encode/ucm/macThai.ucm Unicode Character Map
ext/Encode/ucm/shiftjis.ucm Unicode Character Map
ext/Encode/ucm/symbol.ucm Unicode Character Map
ext/Encode/ucm/viscii.ucm Unicode Character Map
+ext/Encode/Unicode/Makefile.PL Encode extension
+ext/Encode/Unicode/Unicode.pm Encode extension
+ext/Encode/Unicode/Unicode.xs Encode extension
ext/Errno/ChangeLog See if Errno works
ext/Errno/Errno.t See if Errno works
ext/Errno/Errno_pm.PL Errno perl module create script
ext/Storable/t/blessed.t See if Storable works
ext/Storable/t/canonical.t See if Storable works
ext/Storable/t/compat06.t See if Storable works
+ext/Storable/t/croak.t See if Storable works
ext/Storable/t/dclone.t See if Storable works
+ext/Storable/t/downgrade.t See if Storable works
ext/Storable/t/forgive.t See if Storable works
ext/Storable/t/freeze.t See if Storable works
ext/Storable/t/lock.t See if Storable works
+ext/Storable/t/make_downgrade.pl See if Storable works
ext/Storable/t/malice.t See if Storable copes with corrupt files
ext/Storable/t/overload.t See if Storable works
ext/Storable/t/recurse.t See if Storable works
eval "use Log::Agent";
-unless (defined @Log::Agent::EXPORT) {
- eval q{
- sub logcroak {
- require Carp;
- Carp::croak(@_);
- }
- sub logcarp {
- require Carp;
- Carp::carp(@_);
- }
- };
-}
+require Carp;
#
# They might miss :flock in Fcntl
}
}
-sub logcroak;
-sub logcarp;
-
# Can't Autoload cleanly as this clashes 8.3 with &retrieve
sub retrieve_fd { &fd_retrieve } # Backward compatibility
+# By default restricted hashes are downgraded on earlier perls.
+
+$Storable::downgrade_restricted = 1;
bootstrap Storable;
1;
__END__
+#
+# Use of Log::Agent is optional. If it hasn't imported these subs then
+# Autoloader will kindly supply our fallback implementation.
+#
+
+sub logcroak {
+ Carp::croak(@_);
+}
+
+sub logcarp {
+ Carp::carp(@_);
+}
#
# Determine whether locking is possible, but only when needed.
#
-sub CAN_FLOCK {
- my $CAN_FLOCK if 0;
+sub CAN_FLOCK; my $CAN_FLOCK; sub CAN_FLOCK {
return $CAN_FLOCK if defined $CAN_FLOCK;
require Config; import Config;
return $CAN_FLOCK =
#include <patchlevel.h> /* Perl's one, needed since 5.6 */
#include <XSUB.h>
-#if 0
+#if 1
#define DEBUGME /* Debug mode, turns assertions on as well */
#define DASSERT /* Assertion mode */
#endif
#define MY_VERSION "Storable(" XS_VERSION ")"
+
+/*
+ * Conditional UTF8 support.
+ *
+ */
+#ifdef SvUTF8_on
+#define STORE_UTF8STR(pv, len) STORE_PV_LEN(pv, len, SX_UTF8STR, SX_LUTF8STR)
+#define HAS_UTF8_SCALARS
+#ifdef HeKUTF8
+#define HAS_UTF8_HASHES
+#define HAS_UTF8_ALL
+#else
+/* 5.6 perl has utf8 scalars but not hashes */
+#endif
+#else
+#define SvUTF8(sv) 0
+#define STORE_UTF8STR(pv, len) CROAK(("panic: storing UTF8 in non-UTF8 perl"))
+#endif
+#ifndef HAS_UTF8_ALL
+#define UTF8_CROAK() CROAK(("Cannot retrieve UTF8 data in non-UTF8 perl"))
+#endif
+
+#ifdef HvPLACEHOLDERS
+#define HAS_RESTRICTED_HASHES
+#else
+#define HVhek_PLACEHOLD 0x200
+#define RESTRICTED_HASH_CROAK() CROAK(("Cannot retrieve restricted hash"))
+#endif
+
+#ifdef HvHASKFLAGS
+#define HAS_HASH_KEY_FLAGS
+#endif
+
/*
* Fields s_tainted and s_dirty are prefixed with s_ because Perl's include
* files remap tainted and dirty when threading is enabled. That's bad for
int s_tainted; /* true if input source is tainted, at retrieve time */
int forgive_me; /* whether to be forgiving... */
int canonical; /* whether to store hashes sorted by key */
+#ifndef HAS_RESTRICTED_HASHES
+ int derestrict; /* whether to downgrade restrcted hashes */
+#endif
+#ifndef HAS_UTF8_ALL
+ int use_bytes; /* whether to bytes-ify utf8 */
+#endif
int s_dirty; /* context is dirty due to CROAK() -- can be cleaned */
int membuf_ro; /* true means membuf is read-only and msaved is rw */
struct extendable keybuf; /* for hash key retrieval */
static char old_magicstr[] = "perl-store"; /* Magic number before 0.6 */
static char magicstr[] = "pst0"; /* Used as a magic number */
+
#define STORABLE_BIN_MAJOR 2 /* Binary major "version" */
+#define STORABLE_BIN_MINOR 5 /* Binary minor "version" */
+
+/* If we aren't 5.7.3 or later, we won't be writing out files that use the
+ * new flagged hash introdued in 2.5, so put 2.4 in the binary header to
+ * maximise ease of interoperation with older Storables.
+ * Could we write 2.3s if we're on 5.005_03? NWC
+ */
#if (PATCHLEVEL <= 6)
-#define STORABLE_BIN_MINOR 4 /* Binary minor "version" */
+#define STORABLE_BIN_WRITE_MINOR 4
#else
/*
* As of perl 5.7.3, utf8 hash key is introduced.
* So this must change -- dankogai
*/
-#define STORABLE_BIN_MINOR 5 /* Binary minor "version" */
+#define STORABLE_BIN_WRITE_MINOR 5
#endif /* (PATCHLEVEL <= 6) */
/*
#define STORE_SCALAR(pv, len) STORE_PV_LEN(pv, len, SX_SCALAR, SX_LSCALAR)
/*
- * Conditional UTF8 support.
- * On non-UTF8 perls, UTF8 strings are returned as normal strings.
- *
- */
-#ifdef SvUTF8_on
-#define STORE_UTF8STR(pv, len) STORE_PV_LEN(pv, len, SX_UTF8STR, SX_LUTF8STR)
-#else
-#define SvUTF8(sv) 0
-#define STORE_UTF8STR(pv, len) CROAK(("panic: storing UTF8 in non-UTF8 perl"))
-#define SvUTF8_on(sv) CROAK(("Cannot retrieve UTF8 data in non-UTF8 perl"))
-#endif
-
-/*
* Store undef in arrays and hashes without recursing through store().
*/
#define STORE_UNDEF() do { \
cxt->optype = optype;
cxt->s_tainted = is_tainted;
cxt->entry = 1; /* No recursion yet */
+#ifndef HAS_RESTRICTED_HASHES
+ cxt->derestrict = -1; /* Fetched from perl if needed */
+#endif
+#ifndef HAS_UTF8_ALL
+ cxt->use_bytes = -1; /* Fetched from perl if needed */
+#endif
}
/*
*/
static int store_hash(stcxt_t *cxt, HV *hv)
{
- I32 len = HvTOTALKEYS(hv);
+ I32 len =
+#ifdef HAS_RESTRICTED_HASHES
+ HvTOTALKEYS(hv);
+#else
+ HvKEYS(hv);
+#endif
I32 i;
int ret = 0;
I32 riter;
HE *eiter;
- int flagged_hash = ((SvREADONLY(hv) || HvHASKFLAGS(hv)) ? 1 : 0);
+ int flagged_hash = ((SvREADONLY(hv)
+#ifdef HAS_HASH_KEY_FLAGS
+ || HvHASKFLAGS(hv)
+#endif
+ ) ? 1 : 0);
unsigned char hash_flags = (SvREADONLY(hv) ? SHV_RESTRICTED : 0);
if (flagged_hash) {
TRACEME(("using canonical order"));
for (i = 0; i < len; i++) {
+#ifdef HAS_RESTRICTED_HASHES
HE *he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS);
+#else
+ HE *he = hv_iternext(hv);
+#endif
SV *key = hv_iterkeysv(he);
av_store(av, AvFILLp(av)+1, key); /* av_push(), really */
}
keyval = SvPV(key, keylen_tmp);
keylen = keylen_tmp;
+#ifdef HAS_UTF8_HASHES
+ /* If you build without optimisation on pre 5.6
+ then nothing spots that SvUTF8(key) is always 0,
+ so the block isn't optimised away, at which point
+ the linker dislikes the reference to
+ bytes_from_utf8. */
if (SvUTF8(key)) {
const char *keysave = keyval;
bool is_utf8 = TRUE;
flags |= SHV_K_UTF8;
}
}
+#endif
if (flagged_hash) {
PUTMARK(flags);
char *key;
I32 len;
unsigned char flags;
+#ifdef HV_ITERNEXT_WANTPLACEHOLDERS
HE *he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS);
+#else
+ HE *he = hv_iternext(hv);
+#endif
SV *val = (he ? hv_iterval(hv, he) : 0);
SV *key_sv = NULL;
HEK *hek;
flags |= SHV_K_ISSV;
} else {
/* Regular string key. */
+#ifdef HAS_HASH_KEY_FLAGS
if (HEK_UTF8(hek))
flags |= SHV_K_UTF8;
if (HEK_WASUTF8(hek))
flags |= SHV_K_WASUTF8;
+#endif
key = HEK_KEY(hek);
}
/*
* introduced, for instance, but when backward compatibility is preserved.
*/
- PUTMARK((unsigned char) STORABLE_BIN_MINOR);
+ PUTMARK((unsigned char) STORABLE_BIN_WRITE_MINOR);
if (use_network_order)
return 0; /* Don't bother with byte ordering */
*/
static SV *retrieve_utf8str(stcxt_t *cxt, char *cname)
{
- SV *sv;
+ SV *sv;
- TRACEME(("retrieve_utf8str"));
+ TRACEME(("retrieve_utf8str"));
- sv = retrieve_scalar(cxt, cname);
- if (sv)
- SvUTF8_on(sv);
+ sv = retrieve_scalar(cxt, cname);
+ if (sv) {
+#ifdef HAS_UTF8_SCALARS
+ SvUTF8_on(sv);
+#else
+ if (cxt->use_bytes < 0)
+ cxt->use_bytes
+ = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+ ? 1 : 0);
+ if (cxt->use_bytes == 0)
+ UTF8_CROAK();
+#endif
+ }
- return sv;
+ return sv;
}
/*
*/
static SV *retrieve_lutf8str(stcxt_t *cxt, char *cname)
{
- SV *sv;
-
- TRACEME(("retrieve_lutf8str"));
+ SV *sv;
- sv = retrieve_lscalar(cxt, cname);
- if (sv)
- SvUTF8_on(sv);
+ TRACEME(("retrieve_lutf8str"));
- return sv;
+ sv = retrieve_lscalar(cxt, cname);
+ if (sv) {
+#ifdef HAS_UTF8_SCALARS
+ SvUTF8_on(sv);
+#else
+ if (cxt->use_bytes < 0)
+ cxt->use_bytes
+ = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+ ? 1 : 0);
+ if (cxt->use_bytes == 0)
+ UTF8_CROAK();
+#endif
+ }
+ return sv;
}
/*
int hash_flags;
GETMARK(hash_flags);
- TRACEME(("retrieve_flag_hash (#%d)", cxt->tagnum));
+ TRACEME(("retrieve_flag_hash (#%d)", cxt->tagnum));
/*
* Read length, allocate table.
*/
+#ifndef HAS_RESTRICTED_HASHES
+ if (hash_flags & SHV_RESTRICTED) {
+ if (cxt->derestrict < 0)
+ cxt->derestrict
+ = (SvTRUE(perl_get_sv("Storable::downgrade_restricted", TRUE))
+ ? 1 : 0);
+ if (cxt->derestrict == 0)
+ RESTRICTED_HASH_CROAK();
+ }
+#endif
+
RLEN(len);
TRACEME(("size = %d, flags = %d", len, hash_flags));
hv = newHV();
return (SV *) 0;
GETMARK(flags);
+#ifdef HAS_RESTRICTED_HASHES
if ((hash_flags & SHV_RESTRICTED) && (flags & SHV_K_LOCKED))
SvREADONLY_on(sv);
+#endif
if (flags & SHV_K_ISSV) {
/* XXX you can't set a placeholder with an SV key.
sv = &PL_sv_undef;
store_flags |= HVhek_PLACEHOLD;
}
- if (flags & SHV_K_UTF8)
+ if (flags & SHV_K_UTF8) {
+#ifdef HAS_UTF8_HASHES
store_flags |= HVhek_UTF8;
+#else
+ if (cxt->use_bytes < 0)
+ cxt->use_bytes
+ = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+ ? 1 : 0);
+ if (cxt->use_bytes == 0)
+ UTF8_CROAK();
+#endif
+ }
+#ifdef HAS_UTF8_HASHES
if (flags & SHV_K_WASUTF8)
store_flags |= HVhek_WASUTF8;
+#endif
RLEN(size); /* Get key size */
KBUFCHK(size); /* Grow hash key read pool if needed */
* Enter key/value pair into hash table.
*/
+#ifdef HAS_RESTRICTED_HASHES
if (hv_store_flags(hv, kbuf, size, sv, 0, flags) == 0)
return (SV *) 0;
+#else
+ if (!(store_flags & HVhek_PLACEHOLD))
+ if (hv_store(hv, kbuf, size, sv, 0) == 0)
+ return (SV *) 0;
+#endif
}
}
+#ifdef HAS_RESTRICTED_HASHES
if (hash_flags & SHV_RESTRICTED)
SvREADONLY_on(hv);
+#endif
TRACEME(("ok (retrieve_hash at 0x%"UVxf")", PTR2UV(hv)));
version_major > STORABLE_BIN_MAJOR ||
(version_major == STORABLE_BIN_MAJOR &&
version_minor > STORABLE_BIN_MINOR)
- )
+ ) {
+ TRACEME(("but I am version is %d.%d", STORABLE_BIN_MAJOR,
+ STORABLE_BIN_MINOR));
+
CROAK(("Storable binary image v%d.%d more recent than I am (v%d.%d)",
version_major, version_minor,
STORABLE_BIN_MAJOR, STORABLE_BIN_MINOR));
+ }
/*
* If they stored using network order, there's no byte ordering
READ(buf, c); /* Not null-terminated */
buf[c] = '\0'; /* Is now */
+ TRACEME(("byte order '%s'", buf));
+
if (strcmp(buf, byteorder))
CROAK(("Byte order is not compatible"));
--- /dev/null
+#!./perl -w
+
+# Please keep this test this simple. (ie just one test.)
+# There's some sort of not-croaking properly problem in Storable when built
+# with 5.005_03. This test shows it up, whereas malice.t does not.
+# In particular, don't use Test; as this covers up the problem.
+
+sub BEGIN {
+ if ($ENV{PERL_CORE}){
+ chdir('t') if -d 't';
+ @INC = '.';
+ push @INC, '../lib';
+ }
+ require Config; import Config;
+ if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
+ print "1..0 # Skip: Storable was not built\n";
+ exit 0;
+ }
+ # require 'lib/st-dump.pl';
+}
+
+use strict;
+
+BEGIN {
+ die "Oi! No! Don't change this test so that Carp is used before Storable"
+ if defined &Carp::carp;
+}
+use Storable qw(freeze thaw);
+
+print "1..2\n";
+
+for my $test (1,2) {
+ eval {thaw "\xFF\xFF"};
+ if ($@ =~ /Storable binary image v127.255 more recent than I am \(v2\.\d+\)/)
+ {
+ print "ok $test\n";
+ } else {
+ chomp $@;
+ print "not ok $test # Expected a meaningful croak. Got '$@'\n";
+ }
+}
--- /dev/null
+#!./perl -w
+
+#
+# Copyright 2002, Larry Wall.
+#
+# You may redistribute only under the same terms as Perl 5, as specified
+# in the README file that comes with the distribution.
+#
+
+# I ought to keep this test easily backwards compatible to 5.004, so no
+# qr//;
+
+# This test checks downgrade behaviour on pre-5.8 perls when new 5.8 features
+# are encountered.
+
+sub BEGIN {
+ if ($ENV{PERL_CORE}){
+ chdir('t') if -d 't';
+ @INC = '.';
+ push @INC, '../lib';
+ }
+ require Config; import Config;
+ if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
+ print "1..0 # Skip: Storable was not built\n";
+ exit 0;
+ }
+ # require 'lib/st-dump.pl';
+}
+
+BEGIN {
+ if (ord 'A' != 65) {
+ die <<'EBCDIC';
+This test doesn't have EBCDIC data yet. Please run t/make_downgrade.pl using
+perl 5.8 (or later) and append its output to the end of the test.
+Please also mail the output to perlbug@perl.org so that the CPAN copy of
+Storable can be updated.
+EBCDIC
+ }
+}
+use Test::More;
+use Storable 'thaw';
+
+use strict;
+use vars qw(@RESTRICT_TESTS %R_HASH %U_HASH $UTF8_CROAK $RESTRICTED_CROAK);
+
+@RESTRICT_TESTS = ('Locked hash', 'Locked hash placeholder',
+ 'Locked keys', 'Locked keys placeholder',
+ );
+%R_HASH = (perl => 'rules');
+
+if ($] >= 5.007003) {
+ my $utf8 = "Schlo\xdf" . chr 256;
+ chop $utf8;
+
+ %U_HASH = (map {$_, $_} 'castle', "ch\xe5teau", $utf8, chr 0x57CE);
+ plan tests => 169;
+} elsif ($] >= 5.006) {
+ plan tests => 59;
+} else {
+ plan tests => 67;
+}
+
+$UTF8_CROAK = qr/^Cannot retrieve UTF8 data in non-UTF8 perl/;
+$RESTRICTED_CROAK = qr/^Cannot retrieve restricted hash/;
+
+my %tests;
+{
+ local $/ = "\n\nend\n";
+ while (<DATA>) {
+ next unless /\S/s;
+ unless (/begin ([0-7]{3}) ([^\n]*)\n(.*)$/s) {
+ s/\n.*//s;
+ warn "Dodgy data in section starting '$_'";
+ next;
+ }
+ next unless oct $1 == ord 'A'; # Skip ASCII on EBCDIC, and vice versa
+ my $data = unpack 'u', $3;
+ $tests{$2} = $data;
+ }
+}
+
+# use Data::Dumper; $Data::Dumper::Useqq = 1; print Dumper \%tests;
+sub thaw_hash {
+ my ($name, $expected) = @_;
+ my $hash = eval {thaw $tests{$name}};
+ is ($@, '', "Thawed $name without error?");
+ isa_ok ($hash, 'HASH');
+ ok (defined $hash && eq_hash($hash, $expected),
+ "And it is the hash we expected?");
+ $hash;
+}
+
+sub thaw_scalar {
+ my ($name, $expected) = @_;
+ my $scalar = eval {thaw $tests{$name}};
+ is ($@, '', "Thawed $name without error?");
+ isa_ok ($scalar, 'SCALAR', "Thawed $name?");
+ is ($$scalar, $expected, "And it is the data we expected?");
+ $scalar;
+}
+
+sub thaw_fail {
+ my ($name, $expected) = @_;
+ my $thing = eval {thaw $tests{$name}};
+ is ($thing, undef, "Thawed $name failed as expected?");
+ like ($@, $expected, "Error as predicted?");
+}
+
+sub test_locked_hash {
+ my $hash = shift;
+ my @keys = keys %$hash;
+ my ($key, $value) = each %$hash;
+ eval {$hash->{$key} = reverse $value};
+ like( $@, qr/^Modification of a read-only value attempted/,
+ 'trying to change a locked key' );
+ is ($hash->{$key}, $value, "hash should not change?");
+ eval {$hash->{use} = 'perl'};
+ like( $@, qr/^Attempt to access disallowed key 'use' in a restricted hash/,
+ 'trying to add another key' );
+ ok (eq_array([keys %$hash], \@keys), "Still the same keys?");
+}
+
+sub test_restricted_hash {
+ my $hash = shift;
+ my @keys = keys %$hash;
+ my ($key, $value) = each %$hash;
+ eval {$hash->{$key} = reverse $value};
+ is( $@, '',
+ 'trying to change a restricted key' );
+ is ($hash->{$key}, reverse ($value), "hash should change");
+ eval {$hash->{use} = 'perl'};
+ like( $@, qr/^Attempt to access disallowed key 'use' in a restricted hash/,
+ 'trying to add another key' );
+ ok (eq_array([keys %$hash], \@keys), "Still the same keys?");
+}
+
+sub test_placeholder {
+ my $hash = shift;
+ eval {$hash->{rules} = 42};
+ is ($@, '', 'No errors');
+ is ($hash->{rules}, 42, "New value added");
+}
+
+sub test_newkey {
+ my $hash = shift;
+ eval {$hash->{nms} = "http://nms-cgi.sourceforge.net/"};
+ is ($@, '', 'No errors');
+ is ($hash->{nms}, "http://nms-cgi.sourceforge.net/", "New value added");
+}
+
+# $Storable::DEBUGME = 1;
+thaw_hash ('Hash with utf8 flag but no utf8 keys', \%R_HASH);
+
+if (eval "use Hash::Util; 1") {
+ print "# We have Hash::Util, so test that the restricted hashes in <DATA> are valid\n";
+ for $Storable::downgrade_restricted (0, 1, undef, "cheese") {
+ my $hash = thaw_hash ('Locked hash', \%R_HASH);
+ test_locked_hash ($hash);
+ $hash = thaw_hash ('Locked hash placeholder', \%R_HASH);
+ test_locked_hash ($hash);
+ test_placeholder ($hash);
+
+ $hash = thaw_hash ('Locked keys', \%R_HASH);
+ test_restricted_hash ($hash);
+ $hash = thaw_hash ('Locked keys placeholder', \%R_HASH);
+ test_restricted_hash ($hash);
+ test_placeholder ($hash);
+ }
+} else {
+ print "# We don't have Hash::Util, so test that the restricted hashes downgrade\n";
+ my $hash = thaw_hash ('Locked hash', \%R_HASH);
+ test_newkey ($hash);
+ $hash = thaw_hash ('Locked hash placeholder', \%R_HASH);
+ test_newkey ($hash);
+ $hash = thaw_hash ('Locked keys', \%R_HASH);
+ test_newkey ($hash);
+ $hash = thaw_hash ('Locked keys placeholder', \%R_HASH);
+ test_newkey ($hash);
+ local $Storable::downgrade_restricted = 0;
+ thaw_fail ('Locked hash', $RESTRICTED_CROAK);
+ thaw_fail ('Locked hash placeholder', $RESTRICTED_CROAK);
+ thaw_fail ('Locked keys', $RESTRICTED_CROAK);
+ thaw_fail ('Locked keys placeholder', $RESTRICTED_CROAK);
+}
+
+if ($] >= 5.006) {
+ print "# We have utf8 scalars, so test that the utf8 scalars in <DATA> are valid\n";
+ print "# These seem to fail on 5.6 - you should seriously consider upgrading to 5.6.1\n" if $] == 5.006;
+ thaw_scalar ('Short 8 bit utf8 data', "\xDF");
+ thaw_scalar ('Long 8 bit utf8 data', "\xDF" x 256);
+ thaw_scalar ('Short 24 bit utf8 data', chr 0xC0FFEE);
+ thaw_scalar ('Long 24 bit utf8 data', chr (0xC0FFEE) x 256);
+} else {
+ print "# We don't have utf8 scalars, so test that the utf8 scalars downgrade\n";
+ thaw_fail ('Short 8 bit utf8 data', $UTF8_CROAK);
+ thaw_fail ('Long 8 bit utf8 data', $UTF8_CROAK);
+ thaw_fail ('Short 24 bit utf8 data', $UTF8_CROAK);
+ thaw_fail ('Long 24 bit utf8 data', $UTF8_CROAK);
+ local $Storable::drop_utf8 = 1;
+ my $bytes = thaw $tests{'Short 8 bit utf8 data as bytes'};
+ thaw_scalar ('Short 8 bit utf8 data', $$bytes);
+ thaw_scalar ('Long 8 bit utf8 data', $$bytes x 256);
+ $bytes = thaw $tests{'Short 24 bit utf8 data as bytes'};
+ thaw_scalar ('Short 24 bit utf8 data', $$bytes);
+ thaw_scalar ('Long 24 bit utf8 data', $$bytes x 256);
+}
+
+if ($] >= 5.007003) {
+ print "# We have utf8 hashes, so test that the utf8 hashes in <DATA> are valid\n";
+ my $hash = thaw_hash ('Hash with utf8 keys', \%U_HASH);
+ for (keys %$hash) {
+ my $l = 0 + /^\w+$/;
+ my $r = 0 + $hash->{$_} =~ /^\w+$/;
+ cmp_ok ($l, '==', $r, sprintf "key length %d", length $_);
+ cmp_ok ($l, '==', $_ eq "ch\xe5teau" ? 0 : 1);
+ }
+ if (eval "use Hash::Util; 1") {
+ print "# We have Hash::Util, so test that the restricted utf8 hash is valid\n";
+ my $hash = thaw_hash ('Locked hash with utf8 keys', \%U_HASH);
+ for (keys %$hash) {
+ my $l = 0 + /^\w+$/;
+ my $r = 0 + $hash->{$_} =~ /^\w+$/;
+ cmp_ok ($l, '==', $r, sprintf "key length %d", length $_);
+ cmp_ok ($l, '==', $_ eq "ch\xe5teau" ? 0 : 1);
+ }
+ test_locked_hash ($hash);
+ } else {
+ print "# We don't have Hash::Util, so test that the utf8 hash downgrades\n";
+ fail ("You can't get here [perl version $]]. This is a bug in the test.
+# Please send the output of perl -V to perlbug\@perl.org");
+ }
+} else {
+ print "# We don't have utf8 hashes, so test that the utf8 hashes downgrade\n";
+ thaw_fail ('Hash with utf8 keys', $UTF8_CROAK);
+ thaw_fail ('Locked hash with utf8 keys', $UTF8_CROAK);
+ local $Storable::drop_utf8 = 1;
+ my $what = $] < 5.006 ? 'pre 5.6' : '5.6';
+ my $expect = thaw $tests{"Hash with utf8 keys for $what"};
+ thaw_hash ('Hash with utf8 keys', $expect);
+ #foreach (keys %$expect) { print "'$_':\t'$expect->{$_}'\n"; }
+ #foreach (keys %$got) { print "'$_':\t'$got->{$_}'\n"; }
+ if (eval "use Hash::Util; 1") {
+ print "# We have Hash::Util, so test that the restricted hashes in <DATA> are valid\n";
+ fail ("You can't get here [perl version $]]. This is a bug in the test.
+# Please send the output of perl -V to perlbug\@perl.org");
+ } else {
+ print "# We don't have Hash::Util, so test that the restricted hashes downgrade\n";
+ my $hash = thaw_hash ('Locked hash with utf8 keys', $expect);
+ test_newkey ($hash);
+ local $Storable::downgrade_restricted = 0;
+ thaw_fail ('Locked hash with utf8 keys', $RESTRICTED_CROAK);
+ # Which croak comes first is a bit of an implementation issue :-)
+ local $Storable::drop_utf8 = 0;
+ thaw_fail ('Locked hash with utf8 keys', $RESTRICTED_CROAK);
+ }
+}
+__END__
+# A whole run of 2.x nfreeze data, uuencoded. The "mode bits" are the octal
+# value of 'A', the "file name" is the test name. Use make_downgrade.pl to
+# generate these.
+begin 101 Locked hash
+8!049`0````$*!7)U;&5S!`````1P97)L
+
+end
+
+begin 101 Locked hash placeholder
+C!049`0````(*!7)U;&5S!`````1P97)L#A0````%<G5L97,`
+
+end
+
+begin 101 Locked keys
+8!049`0````$*!7)U;&5S``````1P97)L
+
+end
+
+begin 101 Locked keys placeholder
+C!049`0````(*!7)U;&5S``````1P97)L#A0````%<G5L97,`
+
+end
+
+begin 101 Short 8 bit utf8 data
+&!047`L.?
+
+end
+
+begin 101 Short 8 bit utf8 data as bytes
+&!04*`L.?
+
+end
+
+begin 101 Long 8 bit utf8 data
+M!048```"`,.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?
+MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#
+MG\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?
+MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#
+MG\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?
+MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#
+MG\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?
+MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#
+MG\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?
+MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#
+MG\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?
+8PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?
+
+end
+
+begin 101 Short 24 bit utf8 data
+)!047!?BPC[^N
+
+end
+
+begin 101 Short 24 bit utf8 data as bytes
+)!04*!?BPC[^N
+
+end
+
+begin 101 Long 24 bit utf8 data
+M!048```%`/BPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/
+;OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N
+
+end
+
+begin 101 Hash with utf8 flag but no utf8 keys
+8!049``````$*!7)U;&5S``````1P97)L
+
+end
+
+begin 101 Hash with utf8 keys
+M!049``````0*!F-A<W1L90`````&8V%S=&QE"@=C:.5T96%U``````=C:.5T
+D96%U%P/EGXX!`````^6?CA<'4V-H;&_#GP(````&4V-H;&_?
+
+end
+
+begin 101 Locked hash with utf8 keys
+M!049`0````0*!F-A<W1L900````&8V%S=&QE"@=C:.5T96%U!`````=C:.5T
+D96%U%P/EGXX%`````^6?CA<'4V-H;&_#GP8````&4V-H;&_?
+
+end
+
+begin 101 Hash with utf8 keys for pre 5.6
+M!049``````0*!F-A<W1L90`````&8V%S=&QE"@=C:.5T96%U``````=C:.5T
+D96%U"@/EGXX``````^6?C@H'4V-H;&_#GP(````&4V-H;&_?
+
+end
+
+begin 101 Hash with utf8 keys for 5.6
+M!049``````0*!F-A<W1L90`````&8V%S=&QE"@=C:.5T96%U``````=C:.5T
+D96%U%P/EGXX``````^6?CA<'4V-H;&_#GP(````&4V-H;&_?
+
+end
+
--- /dev/null
+#!/usr/local/bin/perl -w
+use strict;
+
+use 5.007003;
+use Hash::Util qw(lock_hash unlock_hash lock_keys);
+use Storable qw(nfreeze);
+
+# If this looks like a hack, it's probably because it is :-)
+sub uuencode_it {
+ my ($data, $name) = @_;
+ my $frozen = nfreeze $data;
+
+ my $uu = pack 'u', $frozen;
+
+ printf "begin %3o $name\n", ord 'A';
+ print $uu;
+ print "\nend\n\n";
+}
+
+
+my %hash = (perl=>"rules");
+
+lock_hash %hash;
+
+uuencode_it (\%hash, "Locked hash");
+
+unlock_hash %hash;
+
+lock_keys %hash, 'perl', 'rules';
+lock_hash %hash;
+
+uuencode_it (\%hash, "Locked hash placeholder");
+
+unlock_hash %hash;
+
+lock_keys %hash, 'perl';
+
+uuencode_it (\%hash, "Locked keys");
+
+unlock_hash %hash;
+
+lock_keys %hash, 'perl', 'rules';
+
+uuencode_it (\%hash, "Locked keys placeholder");
+
+unlock_hash %hash;
+
+my $utf8 = "\x{DF}\x{100}";
+chop $utf8;
+
+uuencode_it (\$utf8, "Short 8 bit utf8 data");
+
+utf8::encode ($utf8);
+
+uuencode_it (\$utf8, "Short 8 bit utf8 data as bytes");
+
+$utf8 x= 256;
+
+uuencode_it (\$utf8, "Long 8 bit utf8 data");
+
+$utf8 = "\x{C0FFEE}";
+
+uuencode_it (\$utf8, "Short 24 bit utf8 data");
+
+utf8::encode ($utf8);
+
+uuencode_it (\$utf8, "Short 24 bit utf8 data as bytes");
+
+$utf8 x= 256;
+
+uuencode_it (\$utf8, "Long 24 bit utf8 data");
+
+# Hash which has the utf8 bit set, but no longer has any utf8 keys
+my %uhash = ("\x{100}", "gone", "perl", "rules");
+delete $uhash{"\x{100}"};
+
+# use Devel::Peek; Dump \%uhash;
+uuencode_it (\%uhash, "Hash with utf8 flag but no utf8 keys");
+
+$utf8 = "Schlo\xdf" . chr 256;
+chop $utf8;
+%uhash = (map {$_, $_} 'castle', "ch\xe5teau", $utf8, "\x{57CE}");
+
+uuencode_it (\%uhash, "Hash with utf8 keys");
+
+lock_hash %uhash;
+
+uuencode_it (\%uhash, "Locked hash with utf8 keys");
+
+my (%pre56, %pre58);
+
+while (my ($key, $val) = each %uhash) {
+ # hash keys are always stored downgraded to bytes if possible, with a flag
+ # to say "promote back to utf8"
+ # Whereas scalars are stored as is.
+ utf8::encode ($key) if ord $key > 256;
+ $pre58{$key} = $val;
+ utf8::encode ($val) unless $val eq "ch\xe5teau";
+ $pre56{$key} = $val;
+
+}
+uuencode_it (\%pre56, "Hash with utf8 keys for pre 5.6");
+uuencode_it (\%pre58, "Hash with utf8 keys for 5.6");
}
use strict;
-use vars qw($file_magic_str $other_magic $network_magic $major $minor);
-
-# header size depends on the size of the byteorder string
+use vars qw($file_magic_str $other_magic $network_magic $major $minor
+ $minor_write);
$file_magic_str = 'pst0';
$other_magic = 7 + length($Config{byteorder});
$network_magic = 2;
$major = 2;
$minor = 5;
+$minor_write = $] > 5.007 ? 5 : 4;
use Test;
BEGIN { plan tests => 334 + length($Config{byteorder}) * 4}
my ($header, $isfile, $isnetorder) = @_;
ok (!!$header->{file}, !!$isfile, "is file");
ok ($header->{major}, $major, "major number");
- ok ($header->{minor}, $minor, "minor number");
+ ok ($header->{minor}, $minor_write, "minor number");
ok (!!$header->{netorder}, !!$isnetorder, "is network order");
if ($isnetorder) {
# Skip these
}
$copy = $contents;
- my $minor1 = $header->{minor} + 1;
- substr ($copy, $file_magic + 1, 1) = chr $minor1;
+ # Needs to be more than 1, as we're already coding a spread of 1 minor version
+ # number on writes (2.5, 2.4). May increase to 2 if we figure we can do 2.3
+ # on 5.005_03 (No utf8).
+ # 4 allows for a small safety margin
+ # (Joke:
+ # Question: What is the value of pi?
+ # Mathematician answers "It's pi, isn't it"
+ # Physicist answers "3.1, within experimental error"
+ # Engineer answers "Well, allowing for a small safety margin, 18"
+ # )
+ my $minor4 = $header->{minor} + 4;
+ substr ($copy, $file_magic + 1, 1) = chr $minor4;
test_corrupt ($copy, $sub,
- "/^Storable binary image v$header->{major}\.$minor1 more recent than I am \\(v$header->{major}\.$header->{minor}\\)/",
+ "/^Storable binary image v$header->{major}\.$minor4 more recent than I am \\(v$header->{major}\.$minor\\)/",
"higher minor");
$copy = $contents;
my $major1 = $header->{major} + 1;
substr ($copy, $file_magic, 1) = chr 2*$major1;
test_corrupt ($copy, $sub,
- "/^Storable binary image v$major1\.$header->{minor} more recent than I am \\(v$header->{major}\.$header->{minor}\\)/",
+ "/^Storable binary image v$major1\.$header->{minor} more recent than I am \\(v$header->{major}\.$minor\\)/",
"higher major");
# Continue messing with the previous copy
- $minor1 = $header->{minor} - 1;
+ my $minor1 = $header->{minor} - 1;
substr ($copy, $file_magic + 1, 1) = chr $minor1;
test_corrupt ($copy, $sub,
- "/^Storable binary image v$major1\.$minor1 more recent than I am \\(v$header->{major}\.$header->{minor}\\)/",
+ "/^Storable binary image v$major1\.$minor1 more recent than I am \\(v$header->{major}\.$minor\\)/",
"higher major, lower minor");
my $where;
-#!./perl
+#!./perl -w
#
# Copyright 2002, Larry Wall.
#
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;
+ if ($ENV{PERL_CORE}){
+ chdir('t') if -d 't';
+ @INC = '.';
+ push @INC, '../lib';
+ require Config;
+ if ($Config::Config{'extensions'} !~ /\bStorable\b/) {
+ print "1..0 # Skip: Storable was not built\n";
+ exit 0;
+ }
+ } else {
+ unless (eval "require Hash::Util") {
+ if ($@ =~ /Can\'t locate Hash\/Util\.pm in \@INC/) {
+ print "1..0 # Skip: No Hash::Util\n";
+ exit 0;
+ } else {
+ die;
+ }
+ }
}
require 'lib/st-dump.pl';
}
unless (ok ++$test, !$@, "Can assign to reserved key 'extra'?") {
my $diag = $@;
$diag =~ s/\n.*\z//s;
- print "# \$@: $diag\n";
+ print "# \$\@: $diag\n";
}
eval { $copy->{nono} = 7 } ;
use Encode qw(is_utf8);
my %utf8hash;
+$Storable::canonical = $Storable::canonical; # Shut up a used only once warning.
+
for $Storable::canonical (0, 1) {
# first we generate a nasty hash which keys include both utf8
projects / p5sagit/p5-mst-13.2.git / commitdiff