[perl.git] branch maint-5.10, updated. GitLive-maint-5.10-1379-g8ef7ab0

David Mitchell

2009-06-23 22:33:05 UTC

In perl.git, the branch maint-5.10 has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/8ef7ab02574b3ad1086cb7dbfbde9285b155b723?hp=ced57a7b6cbbe6d521fffd3924b633ff920c2c9d>

- Log -----------------------------------------------------------------
commit 8ef7ab02574b3ad1086cb7dbfbde9285b155b723
Author: Steffen Mueller <***@cpan.org>
Date: Fri Jun 19 16:16:51 2009 +0200

Fix API docs:SvGAMAGIC returns a U32, not a char*

(cherry picked from commit 458b44e7bc48569051e0eb9b5630ba87d7e5eed4)

M sv.h

commit 29cf5fea5e94c9df7b8b570e98afa7d4ad95d6dc
Author: Jim Cromie <***@gmail.com>
Date: Wed Jun 17 11:32:03 2009 -0600

make_patchnum.pl now works in -Dmksymlink target dirs

this fixes script to work when run from a target/build dir
created by Configure -Dmksymlinks.. It works properly when
building in the srcdir too.

Several git commands fail for me, I added $opt_v=1 to see,
and left them; they add ~15 lines of output to a build.

(A bit amended by rgs: made $opt_v dependent on a -v flag on
the command-line)

(cherry picked from commit 3f1788e11f2685299067ac0f8d3e4fd141a5b5cd)

M make_patchnum.pl

commit 7c9856fac8043ebcaf7ffcaf6817f96ac4c2b969
Author: Nicholas Clark <***@ccl4.org>
Date: Thu Jun 18 20:37:28 2009 +0100

Allow expand-macro.pl to expand macros in perl.h without pre-processor warnings.

(cherry picked from commit 4784c5e80ccedd3734ce162e02ed1c7e25e60c01)

M Porting/expand-macro.pl

commit 8a14d253a3dd383528854eb881773c3db00238a9
Author: Nicholas Clark <***@ccl4.org>
Date: Thu Jun 18 20:33:09 2009 +0100

Make expand-macro.pl scan config.h, if it exists.

(cherry picked from commit ed690650a4d3639a6ac1ace13598aa3f1c99d7dc)

M Porting/expand-macro.pl

commit 1929e4d731486fd656a688996622effb085b29fd
Author: Craig A. Berry <***@mac.com>
Date: Wed Jun 17 21:23:49 2009 -0500

Handle the rare but legal angle bracket in unixify.

We have been getting:

$ perl -e "print VMS::Filespec::unixify('foo:<bar>');"
/foo/<bar/

but should be (and now are) getting:

$ perl -e "print VMS::Filespec::unixify('foo:<bar>');"
/foo/bar/

(cherry picked from commit 5ad5b34cb2af84d4f37219a5dee752fca0459151)

M vms/ext/filespec.t
M vms/vms.c

commit f4861c9517f894b5afc1c0d51adf526c1686b697
Author: David Mitchell <***@iabyn.com>
Date: Fri Jun 19 16:00:29 2009 +0100

add Porting/core-cpan-diff

(cherry picked from commit cb097e7a7eb1098f10246724baff2d8189ac41c5)

M MANIFEST
A Porting/core-cpan-diff

commit 495646e1ce970acf1fdfcfceb3beee216d0c865e
Author: David Mitchell <***@iabyn.com>
Date: Fri Jun 19 15:57:27 2009 +0100

Maintainers.pl: add @IGNORABLE and document EXCLUDED, MAP fields

(cherry picked from commit 2c95b6e4c4a0372d018a26686c0b0af74cf6592c)

M Porting/Maintainers.pl

commit e076be27d00f971e10e4b48c6ebc0e6448e85308
Author: David Golden <***@cpan.org>
Date: Mon Jun 15 23:13:48 2009 -0400

add-package.pl lib exclude fixed

Was deleting from lib, but should delete from perl/lib

(cherry picked from commit a51040a0e9b5994cdc27784703fe3dec6a58bbfd)

M Porting/add-package.pl

commit 2ac2c9cf9d530f6c0a7ba38dc02dfabdb93c3324
Author: Jerry D. Hedden <***@cpan.org>
Date: Fri Jun 19 13:00:40 2009 -0400

Upgrade to threads::shared 1.29

(cherry picked from commit 63790022394e4278430e337fa8d8576711061741)

M ext/threads-shared/Makefile.PL
M ext/threads-shared/shared.pm
M ext/threads-shared/t/0nothread.t
M ext/threads-shared/t/av_refs.t
M ext/threads-shared/t/av_simple.t
M ext/threads-shared/t/blessed.t
M ext/threads-shared/t/clone.t
M ext/threads-shared/t/cond.t
M ext/threads-shared/t/disabled.t
M ext/threads-shared/t/hv_refs.t
M ext/threads-shared/t/hv_simple.t
M ext/threads-shared/t/no_share.t
M ext/threads-shared/t/object.t
M ext/threads-shared/t/shared_attr.t
M ext/threads-shared/t/stress.t
M ext/threads-shared/t/sv_refs.t
M ext/threads-shared/t/sv_simple.t
M ext/threads-shared/t/utf8.t
M ext/threads-shared/t/wait.t
M ext/threads-shared/t/waithires.t
-----------------------------------------------------------------------

Summary of changes:
MANIFEST | 1 +
Porting/Maintainers.pl | 46 +++
Porting/add-package.pl | 2 +-
Porting/core-cpan-diff | 591 ++++++++++++++++++++++++++++++++++++
Porting/expand-macro.pl | 8 +-
ext/threads-shared/Makefile.PL | 2 +-
ext/threads-shared/shared.pm | 8 +-
ext/threads-shared/t/0nothread.t | 9 +-
ext/threads-shared/t/av_refs.t | 4 -
ext/threads-shared/t/av_simple.t | 4 -
ext/threads-shared/t/blessed.t | 4 -
ext/threads-shared/t/clone.t | 4 -
ext/threads-shared/t/cond.t | 4 -
ext/threads-shared/t/disabled.t | 7 -
ext/threads-shared/t/hv_refs.t | 4 -
ext/threads-shared/t/hv_simple.t | 4 -
ext/threads-shared/t/no_share.t | 4 -
ext/threads-shared/t/object.t | 4 -
ext/threads-shared/t/shared_attr.t | 4 -
ext/threads-shared/t/stress.t | 4 -
ext/threads-shared/t/sv_refs.t | 4 -
ext/threads-shared/t/sv_simple.t | 4 -
ext/threads-shared/t/utf8.t | 4 -
ext/threads-shared/t/wait.t | 5 -
ext/threads-shared/t/waithires.t | 5 -
make_patchnum.pl | 40 ++-
sv.h | 2 +-
vms/ext/filespec.t | 1 +
vms/vms.c | 2 +-
29 files changed, 687 insertions(+), 98 deletions(-)
create mode 100755 Porting/core-cpan-diff

diff --git a/MANIFEST b/MANIFEST
index 19928a6..54f78d8 100755
--- a/MANIFEST
+++ b/MANIFEST
@@ -3704,6 +3704,7 @@ Porting/config_H Sample config.h
Porting/config_h.pl Reorder config_h.SH after metaconfig
Porting/config.sh Sample config.sh
Porting/Contract Social contract for contributed modules in Perl core
+Porting/core-cpan-diff Compare core distros with their CPAN equivalents
Porting/corecpan.pl Reports outdated dual-lived modules
Porting/corelist.pl Generates data for Module::CoreList
Porting/curliff.pl Curliff or liff your curliffable files.
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 0d553da..1f8df4a 100644
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -88,6 +88,21 @@ package Maintainers;
'zefram' => 'Andrew Main <***@cpan.org>',
);

+
+# IGNORABLE: files which, if they appear in the root of a CPAN
+# distribution, need not appear in core (i.e. core-cpan-diff won't
+# complain if it can't find them)
+
+@IGNORABLE = qw(
+ .cvsignore .dualLivedDiffConfig .gitignore
+ ANNOUNCE Announce Artistic AUTHORS BENCHMARK BUGS Build.PL
+ CHANGELOG ChangeLog CHANGES Changes COPYING Copying CREDITS
+ GOALS HISTORY INSTALL INSTALL.SKIP LICENSE Makefile.PL
+ MANIFEST MANIFEST.SKIP META.yml NEW NOTES ppport.h README
+ SIGNATURE THANKS TODO Todo VERSION WHATSNEW
+);
+
+
# Each entry in the %Modules hash roughly represents a distribution,
# except in the case of CPAN=1, where it *exactly* represents a single
# CPAN distribution.
@@ -119,6 +134,37 @@ package Maintainers;
# included in core are derived from. Note that the file's version may not
# necessarily match the newest version on CPAN.

+# EXCLUDED is a list of files to be excluded from a CPAN tarball before
+# comparing the remaining contents with core. Each item can either be a
+# full pathname (eg 't/foo.t') or a pattern (e.g. qr{^t/}).
+# It defaults to the empty list.
+
+# MAP is a hash that maps CPAN paths to their core equivalents.
+# Each key reprepresents a string prefix, with longest prefixes checked
+# first. The first match causes that prefix to be replaced with the
+# corresponding key. For example, with the following MAP:
+# {
+# 'lib/' => 'lib/',
+# '' => 'lib/Foo/',
+# },
+#
+# these files are mapped as shown:
+#
+# README becomes lib/Foo/README
+# lib/Foo.pm becomes lib/Foo.pm
+#
+# The default is dependent on the type of module.
+# For distributions which appear to be stored under ext/, it defaults to:
+#
+# { '' => 'ext/Foo-Bar/' }
+#
+# otherwise, it's
+#
+# {
+# 'lib/' => 'lib/',
+# '' => 'lib/Foo/Bar/',
+# }
+
%Modules = (

'Archive::Extract' =>
diff --git a/Porting/add-package.pl b/Porting/add-package.pl
index d91c3d5..20947c0 100644
--- a/Porting/add-package.pl
+++ b/Porting/add-package.pl
@@ -80,7 +80,7 @@ my @LibFiles;
undef
}
: 1
- } `find lib -type f`
+ } `find $Repo/lib -type f`
or die "Could not detect library files\n";

print "done\n" if $Verbose;
diff --git a/Porting/core-cpan-diff b/Porting/core-cpan-diff
new file mode 100755
index 0000000..80d6b7d
--- /dev/null
+++ b/Porting/core-cpan-diff
@@ -0,0 +1,591 @@
+#!/usr/bin/env perl
+
+# core-cpan-diff: Compare CPAN modules with their equivalent in core
+
+# Originally based on App::DualLivedDiff by Steffen Mueller.
+
+use strict;
+use warnings;
+
+use 5.010;
+
+use Getopt::Long;
+use File::Temp ();
+use File::Path ();
+use File::Spec;
+use Archive::Extract;
+use IO::Uncompress::Gunzip ();
+use File::Compare ();
+use ExtUtils::Manifest;
+
+BEGIN { die "Must be run from root of perl source tree\n" unless -d 'Porting' }
+use lib 'Porting';
+use Maintainers ();
+
+# if running from blead, we may be doing -Ilib, which means when we
+# 'chdir /tmp/foo', Archive::Extract may not find Archive::Tar etc.
+# So preload the things we need, and tell it to check %INC first:
+
+use Archive::Tar;
+use IPC::Open3;
+use IO::Select;
+$Module::Load::Conditional::CHECK_INC_HASH = 1;
+# stop Archive::Extract whinging about lack of Archive::Zip
+$Archive::Extract::WARN = 0;
+
+
+# Files, which if they exist in CPAN but not in perl, will not generate
+# an 'Only in CPAN' listing
+#
+our %IGNORABLE = map { ($_ => 1) }
+ qw(.cvsignore .dualLivedDiffConfig .gitignore
+ ANNOUNCE Announce Artistic AUTHORS BENCHMARK BUGS Build.PL
+ CHANGELOG ChangeLog CHANGES Changes COPYING Copying CREDITS
+ GOALS HISTORY INSTALL INSTALL.SKIP LICENSE Makefile.PL
+ MANIFEST MANIFEST.SKIP META.yml NEW NOTES ppport.h README
+ SIGNATURE THANKS TODO Todo VERSION WHATSNEW);
+
+# where, under the cache dir, to untar stuff to
+
+use constant UNTAR_DIR => 'untarred';
+
+use constant DIFF_CMD => 'diff';
+use constant WGET_CMD => 'wget';
+
+sub usage {
+ print STDERR "\***@_\n\n" if @_;
+ print STDERR <<HERE;
+Usage: $0 [opts] [ -d | -v | -x ] [ -a | module ... ]
+
+-a/--all Scan all dual-life modules.
+
+-c/--cachedir Where to save downloaded CPAN tarball files
+ (defaults to /tmp/something/ with deletion after each run).
+
+-d/--diff Display file differences using diff(1), rather than just
+ listing which files have changed.
+ The diff(1) command is assumed to be in your PATH.
+
+--diffopts Options to pass to the diff command. Defaults to '-u'.
+
+-f|force Force download from CPAN of new 02packages.details.txt file
+ (with --crosscheck only).
+
+-o/--output File name to write output to (defaults to STDOUT).
+
+-r/--reverse Reverses the diff (perl to CPAN).
+
+-v/--verbose List the fate of *all* files in the tarball, not just those
+ that differ or are missing.
+
+-x|crosscheck List the distributions whose current CPAN version differs from
+ that in blead (i.e. the DISTRIBUTION field in Maintainers.pl).
+
+By default (i.e. without the --crosscheck option), for each listed module
+(or with -a, all CPAN modules listed in Maintainers.pl), grab the tarball
+from CPAN associated with that module, and compare the files in it with
+those in the perl source tree.
+
+Must be run from the root of the perl source tree.
+Module names must match the keys of %Modules in Maintainers.pl.
+HERE
+ exit(1);
+}
+
+
+sub run {
+ my $scan_all;
+ my $diff_opts;
+ my $reverse = 0;
+ my $cache_dir;
+ my $use_diff;
+ my $output_file;
+ my $verbose;
+ my $force;
+ my $do_crosscheck;
+
+ GetOptions(
+ 'a|all' => \$scan_all,
+ 'c|cachedir=s' => \$cache_dir,
+ 'd|diff' => \$use_diff,
+ 'diffopts:s' => \$diff_opts,
+ 'f|force' => \$force,
+ 'h|help' => \&usage,
+ 'o|output=s' => \$output_file,
+ 'r|reverse' => \$reverse,
+ 'v|verbose' => \$verbose,
+ 'x|crosscheck' => \$do_crosscheck,
+ ) or usage;
+
+
+ my @modules;
+
+ usage("Cannot mix -a with module list") if $scan_all && @ARGV;
+
+ if ($do_crosscheck) {
+ usage("can't use -r, -d, --diffopts, -v with --crosscheck")
+ if ($reverse || $use_diff || $diff_opts || $verbose);
+ }
+ else {
+ $diff_opts = '-u' unless defined $diff_opts;
+ usage("can't use -f without --crosscheck") if $force;
+ }
+
+ @modules = $scan_all
+ ? grep $Maintainers::Modules{$_}{CPAN},
+ (sort {lc $a cmp lc $b } keys %Maintainers::Modules)
+ : @ARGV;
+ usage("No modules specified") unless @modules;
+
+
+ my $outfh;
+ if (defined $output_file) {
+ open $outfh, '>', $output_file
+ or die "ERROR: could not open file '$output_file' for writing: $!";
+ }
+ else {
+ open $outfh, ">&STDOUT"
+ or die "ERROR: can't dup STDOUT: $!";
+ }
+
+ if (defined $cache_dir) {
+ die "ERROR: no such directory: '$cache_dir'\n" unless -d $cache_dir;
+ }
+
+ if ($do_crosscheck) {
+ do_crosscheck($outfh, $cache_dir, $force, \@modules);
+ }
+ else {
+ do_compare(\@modules, $outfh, $cache_dir, $verbose, $use_diff,
+ $reverse, $diff_opts);
+ }
+}
+
+
+
+# compare a list of modules against their CPAN equivalents
+
+sub do_compare {
+ my ($modules, $outfh, $cache_dir, $verbose,
+ $use_diff, $reverse, $diff_opts) = @_;
+
+
+ # first, make sure we have a directory where they can all be untarred,
+ # and if its a permanent directory, clear any previous content
+ my $untar_dir;
+ if ($cache_dir) {
+ $untar_dir = File::Spec->catdir($cache_dir, UNTAR_DIR);
+ if (-d $untar_dir) {
+ File::Path::rmtree($untar_dir)
+ or die "failed to remove $untar_dir\n";
+ }
+ mkdir $untar_dir
+ or die "mkdir $untar_dir: $!\n";
+ }
+ else {
+ $untar_dir = File::Temp::tempdir( CLEANUP => 1 );
+ }
+
+ my %ignorable = map { ($_ => 1) } @Maintainers::IGNORABLE;
+
+ my %seen_dist;
+ for my $module (@$modules) {
+ print $outfh "\n$module\n" unless $use_diff;
+
+ my $m = $Maintainers::Modules{$module}
+ or die "ERROR: No such module in Maintainers.pl: '$module'\n";
+
+ unless ($m->{CPAN}) {
+ print $outfh "WARNING: $module is not dual-life; skipping\n";
+ next;
+ }
+
+ my $dist = $m->{DISTRIBUTION};
+ die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $dist;
+
+ if ($seen_dist{$dist}) {
+ warn "WARNING: duplicate entry for $dist in $module\n"
+ }
+ $seen_dist{$dist}++;
+
+ my $cpan_dir = get_distribution($cache_dir, $untar_dir, $module, $dist);
+
+
+ my @perl_files = Maintainers::get_module_files($module);
+
+ my $manifest = File::Spec->catfile($cpan_dir, 'MANIFEST');
+ die "ERROR: no such file: $manifest\n" unless -f $manifest;
+
+ my $cpan_files = ExtUtils::Manifest::maniread($manifest);
+ my @cpan_files = sort keys %$cpan_files;
+
+ my ($excluded, $map) = get_map($m, $module, \@perl_files);
+
+ my %perl_unseen;
+ @perl_unseen{@perl_files} = ();
+ my %perl_files = %perl_unseen;
+
+ foreach my $cpan_file (@cpan_files) {
+ my $mapped_file = cpan_to_perl($excluded, $map, $cpan_file);
+ unless (defined $mapped_file) {
+ print $outfh " Excluded: $cpan_file\n" if $verbose;
+ next;
+ }
+
+ if (exists $perl_files{$mapped_file}) {
+ delete $perl_unseen{$mapped_file};
+ }
+ else {
+ # some CPAN files foo are stored in core as foo.packed,
+ # which are then unpacked by 'make test_prep'
+ my $packed_file = "$mapped_file.packed";
+ if (exists $perl_files{$packed_file} ) {
+ if (! -f $mapped_file and -f $packed_file) {
+ print $outfh <<EOF;
+WARNING: $mapped_file not found, but .packed variant exists.
+Perhaps you need to run 'make test_prep'?
+EOF
+ next;
+ }
+ delete $perl_unseen{$packed_file};
+ }
+ else {
+ if ($ignorable{$cpan_file}) {
+ print $outfh " Ignored: $cpan_file\n" if $verbose;
+ next;
+ }
+
+ unless ($use_diff) {
+ print $outfh " CPAN only: $cpan_file",
+ ($cpan_file eq $mapped_file) ? "\n"
+ : " (expected $mapped_file)\n";
+ }
+ next;
+ }
+ }
+
+
+ my $abs_cpan_file = File::Spec->catfile($cpan_dir, $cpan_file);
+
+ # should never happen
+ die "ERROR: can't find file $abs_cpan_file\n" unless -f $abs_cpan_file;
+
+ # might happen if the FILES entry in Maintainers.pl is wrong
+ unless (-f $mapped_file) {
+ print $outfh "WARNING: perl file not found: $mapped_file\n";
+ next;
+ }
+
+
+ if (File::Compare::compare($abs_cpan_file, $mapped_file)) {
+ if ($use_diff) {
+ file_diff($outfh, $abs_cpan_file, $mapped_file,
+ $reverse, $diff_opts);
+ }
+ else {
+ if ($cpan_file eq $mapped_file) {
+ print $outfh " Modified: $cpan_file\n";
+ }
+ else {
+ print $outfh " Modified: $cpan_file $mapped_file\n";
+ }
+ }
+ }
+ elsif ($verbose) {
+ if ($cpan_file eq $mapped_file) {
+ print $outfh " Unchanged: $cpan_file\n";
+ }
+ else {
+ print $outfh " Unchanged: $cpan_file $mapped_file\n";
+ }
+ }
+ }
+ for (sort keys %perl_unseen) {
+ print $outfh " Perl only: $_\n" unless $use_diff;
+ }
+ }
+}
+
+# given FooBar-1.23_45.tar.gz, return FooBar
+
+sub distro_base {
+ my $d = shift;
+ $d =~ s/\.tar\.gz$//;
+ $d =~ s/\.gip$//;
+ $d =~ s/[\d\-_\.]+$//;
+ return $d;
+}
+
+# process --crosscheck action:
+# ie list all distributions whose CPAN versions differ from that listed in
+# Maintainers.pl
+
+sub do_crosscheck {
+ my ($outfh, $cache_dir, $force, $modules) = @_;
+
+ my $file = '02packages.details.txt';
+ my $download_dir = $cache_dir || File::Temp::tempdir( CLEANUP => 1 );
+ my $path = File::Spec->catfile($download_dir, $file);
+ my $gzfile = "$path.gz";
+
+ # grab 02packages.details.txt
+
+ my $url = 'http://www.cpan.org/modules/02packages.details.txt.gz';
+
+ if (! -f $gzfile or $force) {
+ unlink $gzfile;
+ my_getstore($url, $gzfile);
+ }
+ unlink $path;
+ IO::Uncompress::Gunzip::gunzip($gzfile, $path)
+ or die "ERROR: failed to ungzip $gzfile: $IO::Uncompress::Gunzip::GunzipError\n";
+
+ # suck in the data from it
+
+ open my $fh, '<', $path
+ or die "ERROR: open: $file: $!\n";
+
+ my %distros;
+ my %modules;
+
+ while (<$fh>) {
+ next if 1../^$/;
+ chomp;
+ my @f = split ' ', $_;
+ if (@f != 3) {
+ warn "WARNING: $file:$.: line doesn't have three fields (skipping)\n";
+ next;
+ }
+ $modules{$f[0]} = $f[2];
+
+ my $distro = $f[2];
+ $distro =~ s{^.*/}{};
+
+ $distros{distro_base($distro)}{$distro} = 1;
+ }
+
+ for my $module (@$modules) {
+ my $m = $Maintainers::Modules{$module}
+ or die "ERROR: No such module in Maintainers.pl: '$module'\n";
+
+ unless ($m->{CPAN}) {
+ print $outfh "\nWARNING: $module is not dual-life; skipping\n";
+ next;
+ }
+
+
+ # given an try like
+ # Foo::Bar 1.23 foo-bar-1.23.tar.gz,
+ # first compare the module name against Foo::Bar, and failing that,
+ # against foo-bar
+
+ my $pdist = $m->{DISTRIBUTION};
+ die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $pdist;
+ $pdist =~ s{^.*/}{};
+
+ my $cdist = $modules{$module};
+
+ if (defined $cdist) {
+ $cdist =~ s{^.*/}{};
+ }
+ else {
+ my $d = $distros{distro_base($pdist)};
+ unless (defined $d) {
+ print $outfh "\n$module: Can't determine current CPAN entry\n";
+ next;
+ }
+ if (keys %$d > 1) {
+ print $outfh "\n$module: (found more than one CPAN candidate):\n";
+ print $outfh " perl: $pdist\n";
+ print $outfh " CPAN: $_\n" for sort keys %$d;
+ next;
+ }
+ $cdist = (keys %$d)[0];
+ }
+
+ if ($cdist ne $pdist) {
+ print $outfh "\n$module:\n Perl: $pdist\n CPAN: $cdist\n";
+ }
+ }
+}
+
+
+
+# get the EXCLUDED and MAP entries for this module, or
+# make up defauts if they don't exist
+
+sub get_map {
+ my ($m, $module_name, $perl_files) = @_;
+
+ my ($excluded, $map) = @$m{qw(EXCLUDED MAP)};
+
+ $excluded ||= [];
+
+ return $excluded, $map if $map;
+
+ # all files under ext/foo-bar (plus maybe some under t/lib)???
+
+ my $ext;
+ for (@$perl_files) {
+ if (m{^(ext/[^/]+/)}) {
+ if (defined $ext and $ext ne $1) {
+ # more than one ext/$ext/
+ undef $ext;
+ last;
+ }
+ $ext = $1;
+ }
+ elsif (m{^t/lib/}) {
+ next;
+ }
+ else {
+ undef $ext;
+ last;
+ }
+ }
+
+ if (defined $ext) {
+ $map = { '' => $ext },
+ }
+ else {
+ (my $base = $module_name) =~ s{::}{/}g;
+ $base ="lib/$base";
+ $map = {
+ 'lib/' => 'lib/',
+ '' => "$base/",
+ };
+ }
+ return $excluded, $map;
+}
+
+
+# Given an exclude list and a mapping hash, convert a CPAN filename
+# (eg 't/bar.t') to the equivalent perl filename (eg 'lib/Foo/Bar/t/bar.t').
+# Returns an empty list for an excluded file
+
+sub cpan_to_perl {
+ my ($excluded, $map, $cpan_file) = @_;
+
+ for my $exclude (@$excluded) {
+ # may be a simple string to match exactly, or a pattern
+ if (ref $exclude) {
+ return if $cpan_file =~ $exclude;
+ }
+ else {
+ return if $cpan_file eq $exclude;
+ }
+ }
+
+ my $perl_file = $cpan_file;
+
+ # try longest prefix first, then alphabetically on tie-break
+ for my $prefix (sort { length($b) <=> length($a) || $a cmp $b } keys %$map)
+ {
+ last if $perl_file =~ s/^\Q$prefix/$map->{$prefix}/;
+ }
+ return $perl_file;
+}
+
+
+
+# do LWP::Simple::getstore, possibly without LWP::Simple being available
+
+my $lwp_simple_available;
+
+sub my_getstore {
+ my ($url, $file) = @_;
+ unless (defined $lwp_simple_available) {
+ eval { require LWP::Simple };
+ $lwp_simple_available = $@ eq '';
+ }
+ if ($lwp_simple_available) {
+ return LWP::Simple::is_success(LWP::Simple::getstore($url, $file));
+ }
+ else {
+ return system(WGET_CMD, "-O", $file, $url) == 0;
+ }
+}
+
+
+# download and unpack a distribution
+# Returns the full pathname of the extracted directory
+# (eg '/tmp/XYZ/Foo_bar-1.23')
+
+# cache_dir: where to dowenload the .tar.gz file to
+# untar_dir: where to untar or unzup the file
+# module: name of module
+# dist: name of the distribution
+
+sub get_distribution {
+ my ($cache_dir, $untar_dir, $module, $dist) = @_;
+
+ $dist =~ m{.+/([^/]+)$}
+ or die "ERROR: $module: invalid DISTRIBUTION name (no AUTHOR/ prefix): $dist";
+ my $filename = $1;
+
+ my $download_dir = $cache_dir || File::Temp::tempdir( CLEANUP => 1 );
+ my $download_file = File::Spec->catfile($download_dir, $filename);
+
+ # download distribution
+
+ if (-f $download_file and ! -s $download_file ) {
+ # wget can leave a zero-length file on failed download
+ unlink $download_file;
+ }
+
+ unless (-f $download_file) {
+ # not cached
+ $dist =~ /^([A-Z])([A-Z])/
+ or die "ERROR: $module: invalid DISTRIBUTION name (not /^[A-Z]{2}/): $dist";
+
+ my $url = "http://www.cpan.org/modules/by-authors/id/$1/$1$2/$dist";
+ my_getstore($url, $download_file)
+ or die "ERROR: Could not fetch '$url'";
+ }
+
+ # extract distribution
+
+ my $ae = Archive::Extract->new( archive => $download_file);
+ $ae->extract( to => $untar_dir )
+ or die "ERROR: failed to extract distribution '$download_file to temp. dir: " . $ae->error();
+
+ # get the name of the extracted distribution dir
+
+ my $path = File::Spec->catfile($untar_dir, $filename);
+
+ $path =~ s/\.tar\.gz$// or
+ $path =~ s/\.zip$// or
+ die "ERROR: downloaded file does not have a recognised suffix: $path\n";
+
+ die "ERROR: Extracted tarball does not appear as $path\n" unless -d $path;
+
+ return $path;
+}
+
+
+# produce the diff of a single file
+sub file_diff {
+ my $outfh = shift;
+ my $cpan_file = shift;
+ my $perl_file = shift;
+ my $reverse = shift;
+ my $diff_opts = shift;
+
+
+ my @cmd = (DIFF_CMD, split ' ', $diff_opts);
+ if ($reverse) {
+ push @cmd, $perl_file, $cpan_file;
+ }
+ else {
+ push @cmd, $cpan_file, $perl_file;
+ }
+ my $result = `@cmd`;
+
+ $result =~ s{^(--- |\+\+\+ )/tmp/[^/]+/}{$1}gm;
+
+ print $outfh $result;
+}
+
+
+run();
+
diff --git a/Porting/expand-macro.pl b/Porting/expand-macro.pl
index 2cdaa79..ed8e188 100644
--- a/Porting/expand-macro.pl
+++ b/Porting/expand-macro.pl
@@ -32,6 +32,7 @@ if (!(@ARGV = @headers)) {
while (<$fh>) {
push @ARGV, $1 if m!^([^/]+\.h)\t!;
}
+ push @ARGV, 'config.h' if -f 'config.h';
}

my $header;
@@ -56,7 +57,12 @@ my $sentinel = "$macro expands to";
print $out <<"EOF";
#include "EXTERN.h"
#include "perl.h"
-#include "$header"
+EOF
+
+print qq{#include "$header"\n}
+ unless $header eq 'perl.h' or $header eq 'EXTERN.h';
+
+print $out <<"EOF";
#line 4 "$sentinel"
$macro$args
EOF
diff --git a/ext/threads-shared/Makefile.PL b/ext/threads-shared/Makefile.PL
index 7856617..05c7383 100755
--- a/ext/threads-shared/Makefile.PL
+++ b/ext/threads-shared/Makefile.PL
@@ -62,7 +62,7 @@ if (not grep { $_ eq 'PERL_CORE=1' } @ARGV) {
'Carp' => 0,
'XSLoader' => 0,
'Scalar::Util' => 0,
- 'threads' => 1.71,
+ 'threads' => 1.73,

'Test' => 0,
'Test::More' => 0,
diff --git a/ext/threads-shared/shared.pm b/ext/threads-shared/shared.pm
index 6f606b0..722e3ce 100644
--- a/ext/threads-shared/shared.pm
+++ b/ext/threads-shared/shared.pm
@@ -7,7 +7,7 @@ use warnings;

use Scalar::Util qw(reftype refaddr blessed);

-our $VERSION = '1.28';
+our $VERSION = '1.29';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;

@@ -187,7 +187,7 @@ threads::shared - Perl extension for sharing data structures between threads

=head1 VERSION

-This document describes threads::shared version 1.28
+This document describes threads::shared version 1.29

=head1 SYNOPSIS

@@ -401,7 +401,7 @@ important to check the value of the variable and go back to waiting if the
requirement is not fulfilled. For example, to pause until a shared counter
drops to zero:

- { lock($counter); cond_wait($count) until $counter == 0; }
+ { lock($counter); cond_wait($counter) until $counter == 0; }

=item cond_timedwait VARIABLE, ABS_TIMEOUT

@@ -588,7 +588,7 @@ L<threads::shared> Discussion Forum on CPAN:
L<http://www.cpanforum.com/dist/threads-shared>

Annotated POD for L<threads::shared>:
-L<http://annocpan.org/~JDHEDDEN/threads-shared-1.28/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-shared-1.29/shared.pm>

Source repository:
L<http://code.google.com/p/threads-shared/>
diff --git a/ext/threads-shared/t/0nothread.t b/ext/threads-shared/t/0nothread.t
index 36b1564..7609fbe 100644
--- a/ext/threads-shared/t/0nothread.t
+++ b/ext/threads-shared/t/0nothread.t
@@ -1,13 +1,6 @@
use strict;
use warnings;

-BEGIN {
- if ($ENV{'PERL_CORE'}){
- chdir 't';
- unshift @INC, '../lib';
- }
-}
-
use Test::More (tests => 53);

### Start of Testing ###
@@ -65,7 +58,7 @@ sub array

ok((require threads::shared),"Require module");

-if ($threads::shared::VERSION && ! exists($ENV{'PERL_CORE'})) {
+if ($threads::shared::VERSION && ! $ENV{'PERL_CORE'}) {
diag('Testing threads::shared ' . $threads::shared::VERSION);
}

diff --git a/ext/threads-shared/t/av_refs.t b/ext/threads-shared/t/av_refs.t
index 2e77031..8106e32 100644
--- a/ext/threads-shared/t/av_refs.t
+++ b/ext/threads-shared/t/av_refs.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/av_simple.t b/ext/threads-shared/t/av_simple.t
index 67d9a32..7fab9b2 100644
--- a/ext/threads-shared/t/av_simple.t
+++ b/ext/threads-shared/t/av_simple.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/blessed.t b/ext/threads-shared/t/blessed.t
index 225725f..2599423 100644
--- a/ext/threads-shared/t/blessed.t
+++ b/ext/threads-shared/t/blessed.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/clone.t b/ext/threads-shared/t/clone.t
index 64ef93a..fd31181 100644
--- a/ext/threads-shared/t/clone.t
+++ b/ext/threads-shared/t/clone.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/cond.t b/ext/threads-shared/t/cond.t
index 3a6bfdf..c2f02a4 100644
--- a/ext/threads-shared/t/cond.t
+++ b/ext/threads-shared/t/cond.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/disabled.t b/ext/threads-shared/t/disabled.t
index 161bc79..46e781e 100644
--- a/ext/threads-shared/t/disabled.t
+++ b/ext/threads-shared/t/disabled.t
@@ -1,13 +1,6 @@
use strict;
use warnings;

-BEGIN {
- if ($ENV{'PERL_CORE'}){
- chdir 't';
- unshift @INC, '../lib';
- }
-}
-
use Test;
plan tests => 31;

diff --git a/ext/threads-shared/t/hv_refs.t b/ext/threads-shared/t/hv_refs.t
index 3985b3c..ecefdc6 100644
--- a/ext/threads-shared/t/hv_refs.t
+++ b/ext/threads-shared/t/hv_refs.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/hv_simple.t b/ext/threads-shared/t/hv_simple.t
index e80cd08..574d8d5 100644
--- a/ext/threads-shared/t/hv_simple.t
+++ b/ext/threads-shared/t/hv_simple.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/no_share.t b/ext/threads-shared/t/no_share.t
index 7c97b22..21703ae 100644
--- a/ext/threads-shared/t/no_share.t
+++ b/ext/threads-shared/t/no_share.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/object.t b/ext/threads-shared/t/object.t
index 394ed6a..4e3c189 100644
--- a/ext/threads-shared/t/object.t
+++ b/ext/threads-shared/t/object.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/shared_attr.t b/ext/threads-shared/t/shared_attr.t
index 09f2310..9085e27 100644
--- a/ext/threads-shared/t/shared_attr.t
+++ b/ext/threads-shared/t/shared_attr.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/stress.t b/ext/threads-shared/t/stress.t
index 9fe1c21..e36ab0a 100644
--- a/ext/threads-shared/t/stress.t
+++ b/ext/threads-shared/t/stress.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/sv_refs.t b/ext/threads-shared/t/sv_refs.t
index 30173bd..5cc6a22 100644
--- a/ext/threads-shared/t/sv_refs.t
+++ b/ext/threads-shared/t/sv_refs.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/sv_simple.t b/ext/threads-shared/t/sv_simple.t
index f4cbcf2..9d264f7 100644
--- a/ext/threads-shared/t/sv_simple.t
+++ b/ext/threads-shared/t/sv_simple.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/utf8.t b/ext/threads-shared/t/utf8.t
index 42e7c3f..6e0e664 100644
--- a/ext/threads-shared/t/utf8.t
+++ b/ext/threads-shared/t/utf8.t
@@ -2,10 +2,6 @@ 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");
diff --git a/ext/threads-shared/t/wait.t b/ext/threads-shared/t/wait.t
index b0a7cc1..2c367fd 100644
--- a/ext/threads-shared/t/wait.t
+++ b/ext/threads-shared/t/wait.t
@@ -2,11 +2,6 @@ use strict;
use warnings;

BEGIN {
- if ($ENV{'PERL_CORE'}){
- chdir 't';
- unshift @INC, '../lib';
- }
-
# Import test.pl into its own package
{
package Test;
diff --git a/ext/threads-shared/t/waithires.t b/ext/threads-shared/t/waithires.t
index 4cda602..ae82448 100644
--- a/ext/threads-shared/t/waithires.t
+++ b/ext/threads-shared/t/waithires.t
@@ -2,11 +2,6 @@ use strict;
use warnings;

BEGIN {
- if ($ENV{'PERL_CORE'}){
- chdir 't';
- unshift @INC, '../lib';
- }
-
# Import test.pl into its own package
{
package Test;
diff --git a/make_patchnum.pl b/make_patchnum.pl
index 2bacd4b..1644d41 100644
--- a/make_patchnum.pl
+++ b/make_patchnum.pl
@@ -13,7 +13,7 @@ make_patchnum.pl - make patchnum

perl make_patchnum.pl

-=head1 DESCRITPTION
+=head1 DESCRIPTION

This program creates the files holding the information
about locally applied patches to the source code. The created
@@ -23,7 +23,7 @@ files are C<git_version.h> and C<lib/Config_git.pl>.

Contains status information from git in a form meant to be processed
by the tied hash logic of Config.pm. It is actually optional,
-although -V will look strange without it.
+although -V:git.\* will be uninformative without it.

C<git_version.h> contains similar information in a C header file
format, designed to be used by patchlevel.h. This file is obtained
@@ -40,8 +40,25 @@ Same terms as Perl itself.

=cut

+# from a -Dmksymlink target dir, I need to cd to the git-src tree to
+# use git (like script does). Presuming that's not unique, one fix is
+# to follow Configure's symlink-path to run git. Maybe GIT_DIR or
+# path-args can solve it, if so we should advise here, I tried only
+# very briefly ('cd -' works too).
+
+my ($subcd, $srcdir);
+our $opt_v = scalar grep $_ eq '-v', @ARGV;
+
BEGIN {
my $root=".";
+ # test 1st to see if we're a -Dmksymlinks target dir
+ $subcd = '';
+ $srcdir = $root;
+ if (-l "./Configure") {
+ $srcdir = readlink("./Configure");
+ $srcdir =~ s/Configure//;
+ $subcd = "cd $srcdir &&"; # activate backtick fragment
+ }
while (!-e "$root/perl.c" and length($root)<100) {
if ($root eq '.') {
$root="..";
@@ -71,14 +88,20 @@ sub write_file {
}

sub backtick {
+ # only for git. If we're in a -Dmksymlinks build-dir, we need to
+ # cd to src so git will work . Probably a better way.
my $command = shift;
if (wantarray) {
- my @result= `$command`;
+ my @result= `$subcd $command`;
+ warn "$subcd $command: \$?=$?\n" if $?;
+ print "#> $subcd $command ->\n @result\n" if !$? and $opt_v;
chomp @result;
return @result;
} else {
- my $result= `$command`;
+ my $result= `$subcd $command`;
$result="" if ! defined $result;
+ warn "$subcd $command: \$?=$?\n" if $?;
+ print "#> $subcd $command ->\n $result\n" if !$? and $opt_v;
chomp $result;
return $result;
}
@@ -102,14 +125,15 @@ sub write_files {
my $unpushed_commits = '/*no-op*/';
my ($read, $branch, $snapshot_created, $commit_id, $describe)= ("") x 5;
my ($changed, $extra_info, $commit_title, $new_patchnum, $status)= ("") x 5;
+
if (my $patch_file= read_file(".patch")) {
($branch, $snapshot_created, $commit_id, $describe) = split /\s+/, $patch_file;
$extra_info = "git_snapshot_date='$snapshot_created'";
$commit_title = "Snapshot of:";
}
-elsif (-d path_to('.git')) {
+elsif (-d "$srcdir/.git") {
# git branch | awk 'BEGIN{ORS=""} /\*/ { print $2 }'
- ($branch) = map { /\* ([^(]\S*)/ ? $1 : () } backtick('git branch');
+ ($branch) = map { /\* ([^(]\S*)/ ? $1 : () } backtick("git branch");
my ($remote,$merge);
if (length $branch) {
$merge= backtick("git config branch.$branch.merge");
@@ -139,12 +163,12 @@ git_remote_branch='$remote/$merge'
git_unpushed='$unpushed_commit_list'";
}
}
- if ($changed) {
+ if ($changed) { # not touched since init'd. never true.
$changed = 'true';
$commit_title = "Derived from:";
$status='"uncommitted-changes"'
} else {
- $status='/*clean-working-directory*/'
+ $status='/*clean-working-directory-maybe*/'
}
$commit_title ||= "Commit id:";
}
diff --git a/sv.h b/sv.h
index 9518fca..ccb5be3 100644
--- a/sv.h
+++ b/sv.h
@@ -1078,7 +1078,7 @@ in gv.h: */
#endif

/*
-=for apidoc Am|char*|SvGAMAGIC|SV* sv
+=for apidoc Am|U32|SvGAMAGIC|SV* sv

Returns true if the SV has get magic or overloading. If either is true then
the scalar is active data, and has the potential to return a new value every
diff --git a/vms/ext/filespec.t b/vms/ext/filespec.t
index 5dd27c9..b40cc81 100644
--- a/vms/ext/filespec.t
+++ b/vms/ext/filespec.t
@@ -83,6 +83,7 @@ __DATA__

# Basic VMS to Unix filespecs
__some_:[__where_.__over_]__the_.__rainbow_ unixify /__some_/__where_/__over_/__the_.__rainbow_ ^
+__some_:<__where_.__over_>__the_.__rainbow_ unixify /__some_/__where_/__over_/__the_.__rainbow_ ^
[.__some_.__where_.__over_]__the_.__rainbow_ unixify __some_/__where_/__over_/__the_.__rainbow_ ^
[-.__some_.__where_.__over_]__the_.__rainbow_ unixify ../__some_/__where_/__over_/__the_.__rainbow_ ^
[.__some_.--.__where_.__over_]__the_.__rainbow_ unixify __some_/../../__where_/__over_/__the_.__rainbow_ ^
diff --git a/vms/vms.c b/vms/vms.c
index 0896934..9e94935 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -7346,7 +7346,7 @@ static char *int_tounixspec(const char *spec, char *rslt, int * utf8_fl)
}
if (*cp2 == ':') {
*(cp1++) = '/';
- if (*(cp2+1) == '[') cp2++;
+ if (*(cp2+1) == '[' || *(cp2+1) == '<') cp2++;
}
else if (*cp2 == ']' || *cp2 == '>') {
if (*(cp1-1) != '/') *(cp1++) = '/'; /* Don't double after ellipsis */

--
Perl5 Master Repository