Change 33111 by [EMAIL PROTECTED] on 2008/01/29 19:03:04
Integrate:
[ 32651]
Upgrade to B-Lint-1.11
[ 32654]
Upgrade to Sys-Syslog-0.23
[ 32656]
Add new Sys::Syslog file to MANIFEST
[ 32658]
Subject: [PATCH] threads::shared 1.15
From: "Jerry D. Hedden" <[EMAIL PROTECTED]>
Date: Wed, 19 Dec 2007 10:17:46 -0500
Message-ID: <[EMAIL PROTECTED]>
[ 32799]
Upgrade to Sys-Syslog-0.24
[ 33093]
In Safe, load Carp::Heavy only if it exists (to remain
compatible with older perls)
[ 33096]
Bump the version of Safe
[ 33102]
Make this test pass with the Test::More that comes with perl 5.6.2
[ 33105]
Document why ok() is being used instead of like(), to stop someone
undoing it.
Affected files ...
... //depot/maint-5.10/perl/MANIFEST#5 integrate
... //depot/maint-5.10/perl/ext/B/B/Lint.pm#2 integrate
... //depot/maint-5.10/perl/ext/B/B/Lint/Debug.pm#1 branch
... //depot/maint-5.10/perl/ext/Sys/Syslog/Makefile.PL#2 integrate
... //depot/maint-5.10/perl/ext/Sys/Syslog/Syslog.pm#2 integrate
... //depot/maint-5.10/perl/ext/Sys/Syslog/fallback/syslog.h#1 branch
... //depot/maint-5.10/perl/ext/Sys/Syslog/t/syslog.t#2 integrate
... //depot/maint-5.10/perl/ext/threads/shared/shared.pm#2 integrate
... //depot/maint-5.10/perl/ext/threads/shared/shared.xs#2 integrate
... //depot/maint-5.10/perl/ext/threads/shared/t/object.t#1 branch
... //depot/maint-5.8/perl/ext/Opcode/Safe.pm#8 integrate
... //depot/maint-5.8/perl/ext/Safe/t/safe3.t#2 integrate
Differences ...
==== //depot/maint-5.10/perl/MANIFEST#5 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#4~33108~ 2008-01-29 09:37:50.000000000 -0800
+++ perl/MANIFEST 2008-01-29 11:03:04.000000000 -0800
@@ -76,6 +76,7 @@
ext/B/B/Debug.pm Compiler Debug backend
ext/B/B/Deparse.pm Compiler Deparse backend
ext/B/B/Lint.pm Compiler Lint backend
+ext/B/B/Lint/Debug.pm Adds debugging stringification to B::
ext/B/B.pm Compiler backend support functions and methods
ext/B/B/Showlex.pm Compiler Showlex backend
ext/B/B/Terse.pm Compiler Terse backend
@@ -1082,6 +1083,7 @@
ext/Sys/Syslog/Changes Changlog for Sys::Syslog
ext/Sys/Syslog/fallback/const-c.inc Sys::Syslog constants fallback file
ext/Sys/Syslog/fallback/const-xs.inc Sys::Syslog constants fallback file
+ext/Sys/Syslog/fallback/syslog.h Sys::Syslog header fallback file
ext/Sys/Syslog/Makefile.PL Sys::Syslog extension makefile writer
ext/Sys/Syslog/README README for Sys::Syslog
ext/Sys/Syslog/README.win32 README for Sys::Syslog on Windows
@@ -1117,6 +1119,7 @@
ext/threads/shared/t/hv_refs.t Test shared hashes containing references
ext/threads/shared/t/hv_simple.t Tests for basic shared hash
functionality.
ext/threads/shared/t/no_share.t Tests for disabled share on variables.
+ext/threads/shared/t/object.t Shared objects tests
ext/threads/shared/t/shared_attr.t Test :shared attribute
ext/threads/shared/t/stress.t Stress test
ext/threads/shared/t/sv_refs.t thread shared variables
==== //depot/maint-5.10/perl/ext/B/B/Lint.pm#2 (text) ====
Index: perl/ext/B/B/Lint.pm
--- perl/ext/B/B/Lint.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/B/B/Lint.pm 2008-01-29 11:03:04.000000000 -0800
@@ -1,6 +1,6 @@
package B::Lint;
-our $VERSION = '1.09'; ## no critic
+our $VERSION = '1.11'; ## no critic
=head1 NAME
@@ -185,6 +185,10 @@
Malcolm Beattie, [EMAIL PROTECTED]
+=head1 ACKNOWLEDGEMENTS
+
+Sebastien Aperghis-Tramoni - bug fixes
+
=cut
use strict;
@@ -347,8 +351,8 @@
my @elts = map +( $_->ARRAY )[$ix], @entire_pad;
($elt) = first {
eval { $_->isa('B::SV') } ? $_ : ();
- }
- @elts[ 0, reverse 1 .. $#elts ];
+ }
+ @elts[ 0, reverse 1 .. $#elts ];
return $elt;
};
}
@@ -511,7 +515,7 @@
# scratchpad to find things. I suppose this is so a optree can be
# shared between threads and all symbol table muckery will just get
# written to a scratchpad.
-*B::PADOP::lint = \&B::SVOP::lint;
+*B::PADOP::lint = *B::PADOP::lint = \&B::SVOP::lint;
sub B::SVOP::lint {
my ($op) = @_;
==== //depot/maint-5.10/perl/ext/B/B/Lint/Debug.pm#1 (text) ====
Index: perl/ext/B/B/Lint/Debug.pm
--- /dev/null 2008-01-25 10:48:57.533235220 -0800
+++ perl/ext/B/B/Lint/Debug.pm 2008-01-29 11:03:04.000000000 -0800
@@ -0,0 +1,65 @@
+package B::Lint::Debug;
+
+=head1 NAME
+
+B::Lint::Debug - Adds debugging stringification to B::
+
+=head1 DESCRIPTION
+
+This module injects stringification to a B::OP*/B::SPECIAL. This
+should not be loaded unless you're debugging.
+
+=cut
+
+package B::SPECIAL;
+use overload '""' => sub {
+ my $self = shift @_;
+ "SPECIAL($$self)";
+};
+
+package B::OP;
+use overload '""' => sub {
+ my $self = shift @_;
+ my $class = ref $self;
+ $class =~ s/\AB:://xms;
+ my $name = $self->name;
+ "$class($name)";
+};
+
+package B::SVOP;
+use overload '""' => sub {
+ my $self = shift @_;
+ my $class = ref $self;
+ $class =~ s/\AB:://xms;
+ my $name = $self->name;
+ "$class($name," . $self->sv . "," . $self->gv . ")";
+};
+
+package B::SPECIAL;
+sub DESTROY { }
+our $AUTOLOAD;
+
+sub AUTOLOAD {
+ my $cx = 0;
+ print "AUTOLOAD $AUTOLOAD\n";
+
+ package DB;
+ while ( my @stuff = caller $cx ) {
+
+ print "$cx: [EMAIL PROTECTED]::args] [EMAIL PROTECTED]";
+ if ( ref $DB::args[0] ) {
+ if ( $DB::args[0]->can('padix') ) {
+ print " PADIX: " . $DB::args[0]->padix . "\n";
+ }
+ if ( $DB::args[0]->can('targ') ) {
+ print " TARG: " . $DB::args[0]->targ . "\n";
+ for ( B::Lint::cv()->PADLIST->ARRAY ) {
+ print +( $_->ARRAY )[ $DB::args[0]->targ ] . "\n";
+ }
+ }
+ }
+ ++$cx;
+ }
+}
+
+1;
==== //depot/maint-5.10/perl/ext/Sys/Syslog/Makefile.PL#2 (text) ====
Index: perl/ext/Sys/Syslog/Makefile.PL
--- perl/ext/Sys/Syslog/Makefile.PL#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Sys/Syslog/Makefile.PL 2008-01-29 11:03:04.000000000 -0800
@@ -70,6 +70,9 @@
DEFINE => '-DUSE_PPPORT_H';
}
+# on pre-5.6 Perls, add warnings::compat to the prereq modules
+push @extra_prereqs, "warnings::compat" if $] < 5.006;
+
WriteMakefile(
NAME => 'Sys::Syslog',
LICENSE => 'perl',
==== //depot/maint-5.10/perl/ext/Sys/Syslog/Syslog.pm#2 (text) ====
Index: perl/ext/Sys/Syslog/Syslog.pm
--- perl/ext/Sys/Syslog/Syslog.pm#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Sys/Syslog/Syslog.pm 2008-01-29 11:03:04.000000000 -0800
@@ -10,7 +10,7 @@
require Exporter;
{ no strict 'vars';
- $VERSION = '0.22';
+ $VERSION = '0.24';
@ISA = qw(Exporter);
%EXPORT_TAGS = (
@@ -221,7 +221,7 @@
} elsif (lc $setsock eq 'pipe') {
for my $path ($syslog_path, &_PATH_LOG, "/dev/log") {
- next unless defined $path and length $path and -w $path;
+ next unless defined $path and length $path and -p $path and -w _;
$syslog_path = $path;
last
}
@@ -771,7 +771,7 @@
=head1 VERSION
-Version 0.22
+Version 0.24
=head1 SYNOPSIS
==== //depot/maint-5.10/perl/ext/Sys/Syslog/fallback/syslog.h#1 (text) ====
Index: perl/ext/Sys/Syslog/fallback/syslog.h
--- /dev/null 2008-01-25 10:48:57.533235220 -0800
+++ perl/ext/Sys/Syslog/fallback/syslog.h 2008-01-29 11:03:04.000000000
-0800
@@ -0,0 +1,111 @@
+/*
+ * Copyright (c) 1982, 1986, 1988, 1993
+ * The Regents of the University of California. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 4. Neither the name of the University nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ * @(#)syslog.h 8.1 (Berkeley) 6/2/93
+ */
+
+#ifndef _SYS_SYSLOG_H
+#define _SYS_SYSLOG_H 1
+
+#define _PATH_LOG ""
+
+/*
+ * priorities/facilities are encoded into a single 32-bit quantity, where the
+ * bottom 3 bits are the priority (0-7) and the top 28 bits are the facility
+ * (0-big number). Both the priorities and the facilities map roughly
+ * one-to-one to strings in the syslogd(8) source code. This mapping is
+ * included in this file.
+ *
+ * priorities (these are ordered)
+ */
+#define LOG_EMERG 0 /* system is unusable */
+#define LOG_ALERT 1 /* action must be taken immediately */
+#define LOG_CRIT 2 /* critical conditions */
+#define LOG_ERR 3 /* error conditions */
+#define LOG_WARNING 4 /* warning conditions */
+#define LOG_NOTICE 5 /* normal but significant condition */
+#define LOG_INFO 6 /* informational */
+#define LOG_DEBUG 7 /* debug-level messages */
+
+#define LOG_PRIMASK 0x07 /* mask to extract priority part
(internal) */
+ /* extract priority */
+#define LOG_PRI(p) ((p) & LOG_PRIMASK)
+#define LOG_MAKEPRI(fac, pri) (((fac) << 3) | (pri))
+
+/* facility codes */
+#define LOG_KERN (0<<3) /* kernel messages */
+#define LOG_USER (1<<3) /* random user-level messages */
+#define LOG_MAIL (2<<3) /* mail system */
+#define LOG_DAEMON (3<<3) /* system daemons */
+#define LOG_AUTH (4<<3) /* security/authorization messages */
+#define LOG_SYSLOG (5<<3) /* messages generated internally by
syslogd */
+#define LOG_LPR (6<<3) /* line printer subsystem */
+#define LOG_NEWS (7<<3) /* network news subsystem */
+#define LOG_UUCP (8<<3) /* UUCP subsystem */
+#define LOG_CRON (9<<3) /* clock daemon */
+#define LOG_AUTHPRIV (10<<3) /* security/authorization messages
(private) */
+#define LOG_FTP (11<<3) /* ftp daemon */
+#define LOG_NETINFO (12<<3) /* NetInfo */
+#define LOG_REMOTEAUTH (13<<3) /* remote authentication/authorization
*/
+#define LOG_INSTALL (14<<3) /* installer subsystem */
+#define LOG_RAS (15<<3) /* Remote Access Service (VPN / PPP) */
+#define LOG_LOCAL0 (16<<3) /* reserved for local use */
+#define LOG_LOCAL1 (17<<3) /* reserved for local use */
+#define LOG_LOCAL2 (18<<3) /* reserved for local use */
+#define LOG_LOCAL3 (19<<3) /* reserved for local use */
+#define LOG_LOCAL4 (20<<3) /* reserved for local use */
+#define LOG_LOCAL5 (21<<3) /* reserved for local use */
+#define LOG_LOCAL6 (22<<3) /* reserved for local use */
+#define LOG_LOCAL7 (23<<3) /* reserved for local use */
+#define LOG_LAUNCHD (24<<3) /* launchd - general bootstrap daemon */
+
+#define LOG_NFACILITIES 25 /* current number of facilities */
+#define LOG_FACMASK 0x03f8 /* mask to extract facility part */
+ /* facility of pri */
+#define LOG_FAC(p) (((p) & LOG_FACMASK) >> 3)
+
+/*
+ * arguments to setlogmask.
+ */
+#define LOG_MASK(pri) (1 << (pri)) /* mask for one
priority */
+#define LOG_UPTO(pri) ((1 << ((pri)+1)) - 1) /* all priorities
through pri */
+
+/*
+ * Option flags for openlog.
+ *
+ * LOG_ODELAY no longer does anything.
+ * LOG_NDELAY is the inverse of what it used to be.
+ */
+#define LOG_PID 0x01 /* log the pid with each message */
+#define LOG_CONS 0x02 /* log on the console if errors in
sending */
+#define LOG_ODELAY 0x04 /* delay open until first syslog()
(default) */
+#define LOG_NDELAY 0x08 /* don't delay open */
+#define LOG_NOWAIT 0x10 /* don't wait for console forks:
DEPRECATED */
+#define LOG_PERROR 0x20 /* log to stderr as well */
+
+#endif /* sys/syslog.h */
==== //depot/maint-5.10/perl/ext/Sys/Syslog/t/syslog.t#2 (xtext) ====
Index: perl/ext/Sys/Syslog/t/syslog.t
--- perl/ext/Sys/Syslog/t/syslog.t#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Sys/Syslog/t/syslog.t 2008-01-29 11:03:04.000000000 -0800
@@ -19,6 +19,10 @@
pack portable recursion redefine regexp severe signal substr
syntax taint uninitialized unpack untie utf8 void);
+# if someone is using warnings::compat, the previous trick won't work, so we
+# must manually disable warnings
+$^W = 0 if $] < 5.006;
+
my $is_Win32 = $^O =~ /win32/i;
my $is_Cygwin = $^O =~ /cygwin/i;
@@ -189,6 +193,9 @@
skip "the 'unix' mechanism works, so the tests will likely fail with the
'stream' mechanism", 10
if grep {/unix/} @passed;
+ skip "not testing setlogsock('stream'): _PATH_LOG unavailable", 10
+ unless -e Sys::Syslog::_PATH_LOG();
+
# setlogsock() with "stream" and an undef path
$r = eval { setlogsock("stream", undef ) } || '';
is( $@, '', "setlogsock() called, with 'stream' and an undef path" );
==== //depot/maint-5.10/perl/ext/threads/shared/shared.pm#2 (text) ====
Index: perl/ext/threads/shared/shared.pm
--- perl/ext/threads/shared/shared.pm#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/threads/shared/shared.pm 2008-01-29 11:03:04.000000000 -0800
@@ -5,7 +5,7 @@
use strict;
use warnings;
-our $VERSION = '1.14';
+our $VERSION = '1.15';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -73,7 +73,7 @@
=head1 VERSION
-This document describes threads::shared version 1.14
+This document describes threads::shared version 1.15
=head1 SYNOPSIS
@@ -360,7 +360,7 @@
C<< lock($hasref->{key}) >>.
View existing bug reports at, and submit any new bugs, problems, patches, etc.
-to: L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=threads-shared>
+to: L<http://rt.cpan.org/Public/Dist/Display.html?Name=threads-shared>
=head1 SEE ALSO
@@ -368,7 +368,7 @@
L<http://www.cpanforum.com/dist/threads-shared>
Annotated POD for L<threads::shared>:
-L<http://annocpan.org/~JDHEDDEN/threads-shared-1.14/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-shared-1.15/shared.pm>
Source repository:
L<http://code.google.com/p/threads-shared/>
==== //depot/maint-5.10/perl/ext/threads/shared/shared.xs#2 (text) ====
Index: perl/ext/threads/shared/shared.xs
--- perl/ext/threads/shared/shared.xs#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/threads/shared/shared.xs 2008-01-29 11:03:04.000000000 -0800
@@ -1108,6 +1108,24 @@
}
+/* Can a shared object be destroyed?
+ * True if not a shared,
+ * or if detroying last proxy on a shared object
+ */
+#ifdef PL_destroyhook
+bool
+Perl_shared_object_destroy(pTHX_ SV *sv)
+{
+ SV *ssv;
+
+ if (SvROK(sv))
+ sv = SvRV(sv);
+ ssv = Perl_sharedsv_find(aTHX_ sv);
+ return (!ssv || (SvREFCNT(ssv) <= 1));
+}
+#endif
+
+
/* Saves a space for keeping SVs wider than an interpreter. */
void
@@ -1121,6 +1139,9 @@
recursive_lock_init(aTHX_ &PL_sharedsv_lock);
PL_lockhook = &Perl_sharedsv_locksv;
PL_sharehook = &Perl_sharedsv_share;
+#ifdef PL_destroyhook
+ PL_destroyhook = &Perl_shared_object_destroy;
+#endif
}
#endif /* USE_ITHREADS */
==== //depot/maint-5.10/perl/ext/threads/shared/t/object.t#1 (text) ====
Index: perl/ext/threads/shared/t/object.t
--- /dev/null 2008-01-25 10:48:57.533235220 -0800
+++ perl/ext/threads/shared/t/object.t 2008-01-29 11:03:04.000000000 -0800
@@ -0,0 +1,151 @@
+use strict;
+use warnings;
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}){
+ chdir 't';
+ unshift @INC, '../lib';
+ }
+ use Config;
+ if (! $Config{'useithreads'}) {
+ print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
+ exit(0);
+ }
+ if ($] < 5.010) {
+ print("1..0 # Skip: Needs Perl 5.10.0 or later\n");
+ exit(0);
+ }
+}
+
+use ExtUtils::testlib;
+
+BEGIN {
+ $| = 1;
+ print("1..23\n"); ### Number of tests that will be run ###
+};
+
+use threads;
+use threads::shared;
+
+my $TEST;
+BEGIN {
+ share($TEST);
+ $TEST = 1;
+}
+
+sub ok {
+ my ($ok, $name) = @_;
+
+ lock($TEST);
+ my $id = $TEST++;
+
+ # You have to do it this way or VMS will get confused.
+ if ($ok) {
+ print("ok $id - $name\n");
+ } else {
+ print("not ok $id - $name\n");
+ printf("# Failed test at line %d\n", (caller)[2]);
+ }
+
+ return ($ok);
+}
+
+ok(1, 'Loaded');
+
+### Start of Testing ###
+
+{ package Jar;
+ my @jar :shared;
+
+ sub new
+ {
+ bless(&threads::shared::share({}), shift);
+ }
+
+ sub store
+ {
+ my ($self, $cookie) = @_;
+ push(@jar, $cookie);
+ return $jar[-1]; # Results in destruction of proxy object
+ }
+
+ sub peek
+ {
+ return $jar[-1];
+ }
+
+ sub fetch
+ {
+ pop(@jar);
+ }
+}
+
+{ package Cookie;
+
+ sub new
+ {
+ my $self = bless(&threads::shared::share({}), shift);
+ $self->{'type'} = shift;
+ return $self;
+ }
+
+ sub DESTROY
+ {
+ delete(shift->{'type'});
+ }
+}
+
+my $C1 = 'chocolate chip';
+my $C2 = 'oatmeal raisin';
+my $C3 = 'vanilla wafer';
+
+my $cookie = Cookie->new($C1);
+ok($cookie->{'type'} eq $C1, 'Have cookie');
+
+my $jar = Jar->new();
+$jar->store($cookie);
+
+ok($cookie->{'type'} eq $C1, 'Still have cookie');
+ok($jar->peek()->{'type'} eq $C1, 'Still have cookie');
+ok($cookie->{'type'} eq $C1, 'Still have cookie');
+
+threads->create(sub {
+ ok($cookie->{'type'} eq $C1, 'Have cookie in thread');
+ ok($jar->peek()->{'type'} eq $C1, 'Still have cookie in thread');
+ ok($cookie->{'type'} eq $C1, 'Still have cookie in thread');
+
+ $jar->store(Cookie->new($C2));
+ ok($jar->peek()->{'type'} eq $C2, 'Added cookie in thread');
+})->join();
+
+ok($cookie->{'type'} eq $C1, 'Still have original cookie after thread');
+ok($jar->peek()->{'type'} eq $C2, 'Still have added cookie after thread');
+
+$cookie = $jar->fetch();
+ok($cookie->{'type'} eq $C2, 'Fetched cookie from jar');
+ok($jar->peek()->{'type'} eq $C1, 'Cookie still in jar');
+
+$cookie = $jar->fetch();
+ok($cookie->{'type'} eq $C1, 'Fetched cookie from jar');
+undef($cookie);
+
+share($cookie);
+$cookie = $jar->store(Cookie->new($C3));
+ok($jar->peek()->{'type'} eq $C3, 'New cookie in jar');
+ok($cookie->{'type'} eq $C3, 'Have cookie');
+
+threads->create(sub {
+ ok($cookie->{'type'} eq $C3, 'Have cookie in thread');
+ $cookie = Cookie->new($C1);
+ ok($cookie->{'type'} eq $C1, 'Change cookie in thread');
+ ok($jar->peek()->{'type'} eq $C3, 'Still have cookie in jar');
+})->join();
+
+ok($cookie->{'type'} eq $C1, 'Have changed cookie after thread');
+ok($jar->peek()->{'type'} eq $C3, 'Still have cookie in jar');
+undef($cookie);
+ok($jar->peek()->{'type'} eq $C3, 'Still have cookie in jar');
+$cookie = $jar->fetch();
+ok($cookie->{'type'} eq $C3, 'Fetched cookie from jar');
+
+# EOF
==== //depot/maint-5.8/perl/ext/Opcode/Safe.pm#8 (text) ====
Index: perl/ext/Opcode/Safe.pm
--- perl/ext/Opcode/Safe.pm#7~26822~ 2006-01-13 08:47:13.000000000 -0800
+++ perl/ext/Opcode/Safe.pm 2008-01-29 11:03:04.000000000 -0800
@@ -3,7 +3,7 @@
use 5.003_11;
use strict;
-$Safe::VERSION = "2.12";
+$Safe::VERSION = "2.13";
# *** Don't declare any lexicals above this point ***
#
@@ -26,7 +26,9 @@
}
use Carp;
-use Carp::Heavy;
+BEGIN { eval q{
+ use Carp::Heavy;
+} }
use Opcode 1.01, qw(
opset opset_to_ops opmask_add
==== //depot/maint-5.8/perl/ext/Safe/t/safe3.t#2 (text) ====
Index: perl/ext/Safe/t/safe3.t
--- perl/ext/Safe/t/safe3.t#1~20271~ 2003-07-28 08:18:57.000000000 -0700
+++ perl/ext/Safe/t/safe3.t 2008-01-29 11:03:04.000000000 -0800
@@ -1,4 +1,4 @@
-#!perl
+#!perl -w
BEGIN {
if ($ENV{PERL_CORE}) {
@@ -30,7 +30,8 @@
# Check that it didn't work
$safe->reval( q{$x + $y} );
-like( $@, qr/^'?addition \(\+\)'? trapped by operation mask/,
+# Written this way to keep the Test::More that comes with perl 5.6.2 happy
+ok( $@ =~ /^'?addition \(\+\)'? trapped by operation mask/,
'opmask still in place with reval' );
my $safe2 = new Safe;
@@ -43,6 +44,7 @@
close $fh;
$safe2->rdo('nasty.pl');
$safe2->reval( q{$x + $y} );
-like( $@, qr/^'?addition \(\+\)'? trapped by operation mask/,
+# Written this way to keep the Test::More that comes with perl 5.6.2 happy
+ok( $@ =~ /^'?addition \(\+\)'? trapped by operation mask/,
'opmask still in place with rdo' );
END { unlink 'nasty.pl' }
End of Patch.
