r35894 - in /trunk/libb-perlreq-perl: Changes MANIFEST META.yml README debian/changelog debian/control debian/copyright lib/B/Clobbers.pm lib/B/PerlReq.pm lib/B/Walker.pm lib/PerlReq/Utils.pm perl5-alt-rpm-macros rpm-build-perl.spec t/01-B-PerlReq.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Tue May 19 20:40:22 UTC 2009
Author: jawnsy-guest
Date: Tue May 19 20:40:17 2009
New Revision: 35894
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=35894
Log:
* New upstream release
-> Adds a few experimental modules (B::Walker, B::Clobbers, PerlReq::Utils)
-> Added some macros for compilation
-> Now handles 'leavetry' operations from B::Walker
* Updated copyright statement
* Added /me to uploaders
* Standards-Version changed to 3.8.1
Added:
trunk/libb-perlreq-perl/lib/B/Clobbers.pm
trunk/libb-perlreq-perl/lib/B/Walker.pm
Modified:
trunk/libb-perlreq-perl/Changes
trunk/libb-perlreq-perl/MANIFEST
trunk/libb-perlreq-perl/META.yml
trunk/libb-perlreq-perl/README
trunk/libb-perlreq-perl/debian/changelog
trunk/libb-perlreq-perl/debian/control
trunk/libb-perlreq-perl/debian/copyright
trunk/libb-perlreq-perl/lib/B/PerlReq.pm
trunk/libb-perlreq-perl/lib/PerlReq/Utils.pm
trunk/libb-perlreq-perl/perl5-alt-rpm-macros
trunk/libb-perlreq-perl/rpm-build-perl.spec
trunk/libb-perlreq-perl/t/01-B-PerlReq.t
Modified: trunk/libb-perlreq-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/Changes?rev=35894&op=diff
==============================================================================
--- trunk/libb-perlreq-perl/Changes (original)
+++ trunk/libb-perlreq-perl/Changes Tue May 19 20:40:17 2009
@@ -1,3 +1,15 @@
+* Mon May 11 2009 Alexey Tourbin <at at altlinux> 0.70-alt1
+- B/Walker.pm: new module, implements optree traversal
+- B/Clobbers.pm: new experimental module, for checking global variables
+- PerlReq/Utils.pm: updated version formatting algorithm for better precision;
+ the most general version format for rpm dependencies is now d.ddd.ddd
+
+* Tue Mar 24 2009 Alexey Tourbin <at at altlinux> 0.6.8-alt3
+- macros (_perl_vendor_check_dso): disabled this check
+
+* Tue Mar 24 2009 Alexey Tourbin <at at altlinux> 0.6.8-alt2
+- macros (_perl_vendor_check_dso): gcc -Wl,--no-as-needed
+
* Fri May 09 2008 Alexey Tourbin <at at altlinux> 0.6.8-alt1
- perl.prov: try to detect block-level packages, fixes MP3/Tag.pm version
Modified: trunk/libb-perlreq-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/MANIFEST?rev=35894&op=diff
==============================================================================
--- trunk/libb-perlreq-perl/MANIFEST (original)
+++ trunk/libb-perlreq-perl/MANIFEST Tue May 19 20:40:17 2009
@@ -5,7 +5,9 @@
README
README.ALT
fake.pm
+lib/B/Walker.pm
lib/B/PerlReq.pm
+lib/B/Clobbers.pm
lib/PerlReq/Utils.pm
perl.prov
perl.req
Modified: trunk/libb-perlreq-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/META.yml?rev=35894&op=diff
==============================================================================
--- trunk/libb-perlreq-perl/META.yml (original)
+++ trunk/libb-perlreq-perl/META.yml Tue May 19 20:40:17 2009
@@ -1,18 +1,24 @@
--- #YAML:1.0
-name: rpm-build-perl
-version: 0.6.8
-abstract: Calculate dependencies for Perl sources
-license: ~
-author:
+name: rpm-build-perl
+version: 0.70
+abstract: Calculate dependencies for Perl sources
+author:
- Alexey Tourbin <at at altlinux.org>
-generated_by: ExtUtils::MakeMaker version 6.42
-distribution_type: module
-requires:
- B: 0
- Encode: 0
- O: 0
- Safe: 0
- Test::More: 0
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ B: 0
+ Encode: 0
+ O: 0
+ Safe: 0
+ Test::More: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.48
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: trunk/libb-perlreq-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/README?rev=35894&op=diff
==============================================================================
--- trunk/libb-perlreq-perl/README (original)
+++ trunk/libb-perlreq-perl/README Tue May 19 20:40:17 2009
@@ -1,4 +1,4 @@
-rpm-build-perl version 0.6.8
+rpm-build-perl version 0.70
B::PerlReq - Perl compiler backend to extract Perl dependencies
perl.req - list requirements for Perl scripts and libraries
Modified: trunk/libb-perlreq-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/debian/changelog?rev=35894&op=diff
==============================================================================
--- trunk/libb-perlreq-perl/debian/changelog (original)
+++ trunk/libb-perlreq-perl/debian/changelog Tue May 19 20:40:17 2009
@@ -1,9 +1,19 @@
-libb-perlreq-perl (0.6.8-2) UNRELEASED; urgency=low
+libb-perlreq-perl (0.70-1) UNRELEASED; urgency=low
+ [ Jonathan Yu ]
+ * New upstream release
+ -> Adds a few experimental modules (B::Walker, B::Clobbers, PerlReq::Utils)
+ -> Added some macros for compilation
+ -> Now handles 'leavetry' operations from B::Walker
+ * Updated copyright statement
+ * Added /me to uploaders
+ * Standards-Version changed to 3.8.1
+
+ [ gregor herrmann ]
* debian/control: Changed: Switched Vcs-Browser field to ViewSVN
(source stanza).
- -- gregor herrmann <gregoa at debian.org> Sun, 16 Nov 2008 20:39:56 +0100
+ -- Jonathan Yu <frequency at cpan.org> Tue, 19 May 2009 15:09:38 -0400
libb-perlreq-perl (0.6.8-1) unstable; urgency=low
Modified: trunk/libb-perlreq-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/debian/control?rev=35894&op=diff
==============================================================================
--- trunk/libb-perlreq-perl/debian/control (original)
+++ trunk/libb-perlreq-perl/debian/control Tue May 19 20:40:17 2009
@@ -4,8 +4,8 @@
Build-Depends: debhelper (>= 7)
Build-Depends-Indep: perl (>= 5.6.10-12)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Damyan Ivanov <dmn at debian.org>
-Standards-Version: 3.8.0
+Uploaders: Damyan Ivanov <dmn at debian.org>, Jonathan Yu <frequency at cpan.org>
+Standards-Version: 3.8.1
Homepage: http://search.cpan.org/dist/rpm-build-perl/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libb-perlreq-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libb-perlreq-perl/
@@ -13,8 +13,11 @@
Package: libb-perlreq-perl
Architecture: all
Depends: ${perl:Depends}, ${misc:Depends}
-Description: Calculate dependencies for Perl sources
- B::PerlReq is a backend module for the Perl compiler that extracts
- dependencies from Perl source code, based on the internal compiled structure
- that Perl itself creates after parsing a program. The output of B::PerlReq is
- suitable for automatic dependency tracking.
+Description: Perl module to determine Perl module dependencies
+ B::PerlReq is a backend module for the Perl compiler that determines the
+ dependencies of Perl source code, based on the internal structure that Perl
+ creates itself after parsing a program source file. The output of this module
+ is suitable for automatic dependency detection, tracking and organization,
+ particularly for building and maintaining binary packages.
+ .
+ It includes a script called perl.req which demonstrates module functionality.
Modified: trunk/libb-perlreq-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/debian/copyright?rev=35894&op=diff
==============================================================================
--- trunk/libb-perlreq-perl/debian/copyright (original)
+++ trunk/libb-perlreq-perl/debian/copyright Tue May 19 20:40:17 2009
@@ -5,20 +5,19 @@
Upstream-Name: rpm-build-perl
Files: *
-Copyright: (c) 2003, 2004, 2006, 2007, 2008 Alexey Tourbin, ALT Linux Team.
+Copyright: 2003-2008, Alexey Tourbin <at at altlinux.org>
+ 1999, Ken Estes <kestes at staff.mail.com>
License: GPL-2+
- This is free software; you can redistribute it and/or modify it under the
- terms of the GNU General Public License as published by the Free Software
- Foundation; either version 2 of the License, or (at your option) any later
- version.
- .
- On Debian systems the complete text of GNU General Public License can be found
- in /usr/share/common-licenses/GPL
Files: debian/*
-Copyright: © Damyan Ivanov <dmn at debian.org>
+Copyright: 2009, Jonathan Yu <frequency at cpan.org>
+ 2008, Damyan Ivanov <dmn at debian.org>
License: GPL-2+
- This is free software; you can redistribute it and/or modify it under the
- terms of the GNU General Public License as published by the Free Software
- Foundation; either version 2 of the License, or (at your option) any later
- version.
+
+License: GPL-2+
+ This is free software; you can redistribute it and/or modify it under the
+ terms of the GNU General Public License as published by the Free Software
+ Foundation; either version 2 of the License, or (at your option) any later
+ version.
+ On Debian systems the complete text of GNU General Public License can be
+ found in /usr/share/common-licenses/GPL
Added: trunk/libb-perlreq-perl/lib/B/Clobbers.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/lib/B/Clobbers.pm?rev=35894&op=file
==============================================================================
--- trunk/libb-perlreq-perl/lib/B/Clobbers.pm (added)
+++ trunk/libb-perlreq-perl/lib/B/Clobbers.pm Tue May 19 20:40:17 2009
@@ -1,0 +1,107 @@
+package B::Clobbers;
+our $VERSION = '0.01';
+
+use strict;
+use B::Walker qw(padval walk);
+use B qw(ppname OPpLVAL_INTRO);
+
+our @vars = qw(_ / , \ ");
+our %vars = map { $_ => 1 } @vars;
+our $Verbose = 0;
+
+sub do_gvsv ($) {
+ my $op = shift;
+ my $var = padval($op->padix)->SAFENAME;
+ return unless $vars{$var};
+ if ($op->private & OPpLVAL_INTRO) {
+ $B::Walker::BlockData{$var} = 1;
+ print STDERR "local \$$var at $0 line $B::Walker::Line\n" if $Verbose;
+ }
+ elsif ($op = $op->next and $$op and $op->name eq "sassign") {
+ return if $B::Walker::BlockData{$var};
+ print "\t*** \$$var clobbered at $0 line $B::Walker::Line\n";
+ }
+}
+
+sub do_rv2gv ($) {
+ my $op = shift;
+ my $gv = $op->first;
+ return unless $gv->name eq "gv";
+ my $var = padval($gv->padix)->SAFENAME;
+ return unless $vars{$var};
+ if ($op->private & OPpLVAL_INTRO) {
+ $B::Walker::BlockData{$var} = 1;
+ print STDERR "local \*$var at $0 line $B::Walker::Line\n" if $Verbose;
+ }
+ elsif ($op = $op->next and $$op and $op->name eq "sassign") {
+ return if $B::Walker::BlockData{$var};
+ print "\t*** \*$var clobbered at $0 line $B::Walker::Line\n";
+ }
+}
+
+sub do_readline ($) {
+ my $op = shift;
+ $op = $op->next;
+ $op = $op->first while ref($op) eq "B::UNOP";
+ return unless $op->name eq "gvsv";
+ my $var = padval($op->padix)->SAFENAME;
+ return unless $vars{$var};
+ return if $B::Walker::BlockData{$var};
+ print "\t*** \$$var clobbered at $0 line $B::Walker::Line\n";
+}
+
+sub do_enteriter ($) {
+ my $op = shift;
+ my $op = $op->first->sibling->sibling;
+ return unless $$op;
+ $op = $op->first if $op->name eq "rv2gv";
+ return unless $op->name eq "gv";
+ my $gv = ref($op) eq "B::PADOP" ? padval($op->padix) : $op->gv;
+ my $var = $gv->SAFENAME;
+ return unless $vars{$var};
+ print STDERR "implicitly localized \$$var at $0 line $B::Walker::Line\n" if $Verbose;
+ $B::Walker::BlockData{_} = 1;
+}
+
+%B::Walker::Ops = (
+ gvsv => \&do_gvsv,
+ rv2gv => \&do_rv2gv,
+ readline => \&do_readline,
+ enteriter => \&do_enteriter,
+ grepwhile => sub { $B::Walker::BlockData{_} = 1 },
+ mapwhile => sub { $B::Walker::BlockData{_} = 1 },
+);
+
+sub compile {
+ my $pkg = __PACKAGE__;
+ for my $opt (@_) {
+ $opt =~ /^-(?:v|-?verbose)$/ and ++$Verbose or
+ die "$pkg: unknown option: $opt\n";
+ }
+ return sub {
+ local $| = 1;
+ local $SIG{__DIE__} = sub {
+ print STDERR "Dying at $0 line $B::Walker::Line\n";
+ require Carp;
+ Carp::cluck();
+ };
+ walk();
+ }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Clobbers - clobbering analyzer
+
+=head1 COPYING
+
+Copyright (c) 2007 Alexey Tourbin, ALT Linux Team.
+
+This is free software; you can redistribute it and/or modify it under the terms
+of the GNU General Public License as published by the Free Software Foundation;
+either version 2 of the License, or (at your option) any later version.
+
Modified: trunk/libb-perlreq-perl/lib/B/PerlReq.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/lib/B/PerlReq.pm?rev=35894&op=diff
==============================================================================
--- trunk/libb-perlreq-perl/lib/B/PerlReq.pm (original)
+++ trunk/libb-perlreq-perl/lib/B/PerlReq.pm Tue May 19 20:40:17 2009
@@ -12,7 +12,7 @@
# and micro hacks.
package B::PerlReq;
-our $VERSION = "0.6.8";
+our $VERSION = '0.70';
use 5.006;
use strict;
@@ -41,26 +41,14 @@
qr(^vars\.pm$),
);
-our $CurCV;
-sub const_sv ($) {
- my $op = shift;
- my $sv = $op->sv;
- $sv = (($CurCV->PADLIST->ARRAY)[1]->ARRAY)[$op->targ] unless $$sv;
- return $sv;
-}
-
-our $CurLevel = 0;
-our $CurEval;
-our $CurLine;
-our $CurSub;
-our $CurOpname;
-
our ($Strict, $Relaxed, $Verbose, $Debug);
+
+use B::Walker qw(const_sv);
sub RequiresPerl ($) {
my $v = shift;
my $dep = "perl-base >= " . verf_perl($v);
- my $msg = "$dep at line $CurLine (depth $CurLevel)";
+ my $msg = "$dep at line $B::Walker::Line (depth $B::Walker::Level)";
if (not $Strict and $v < 5.006) {
print STDERR "# $msg old perl SKIP\n" if $Verbose;
return;
@@ -75,12 +63,12 @@
sub Requires ($;$) {
my ($f, $v) = @_;
my $dep = path2dep($f) . ($v ? " >= " . verf($v) : "");
- my $msg = "$dep at line $CurLine (depth $CurLevel)";
+ my $msg = "$dep at line $B::Walker::Line (depth $B::Walker::Level)";
if ($f !~ m#^\w+(?:[/-]\w+)*[.]p[lmh]$#) { # bits/ioctl-types.ph
print STDERR "# $msg invalid SKIP\n";
return;
}
- if ($CurSub eq "BEGIN" and not $INC{$f} and $CurOpname ne "autouse") {
+ if ($B::Walker::Sub eq "BEGIN" and not $INC{$f} and $B::Walker::Opname ne "autouse") {
print STDERR "# $msg not loaded at BEGIN SKIP\n";
return;
}
@@ -88,14 +76,14 @@
print STDERR "# $msg builtin SKIP\n" if $Verbose;
return;
}
- if ($CurSub eq "BEGIN" and $INC{$f}) {
+ if ($B::Walker::Sub eq "BEGIN" and $INC{$f}) {
goto req;
}
- if (not $Strict and $CurEval) {
+ if (not $Strict and $B::Walker::BlockData{Eval}) {
print STDERR "# $msg inside eval SKIP\n";
return;
}
- if ($Relaxed and $CurLevel > 4) {
+ if ($Relaxed and $B::Walker::Level > 4) {
print STDERR "# $msg deep SKIP\n";
return;
}
@@ -118,15 +106,15 @@
sub check_encoding ($) {
my $enc = shift;
eval { local $SIG{__DIE__}; require Encode; } or do {
- print STDERR "Encode.pm not available at $0 line $CurLine\n";
+ print STDERR "Encode.pm not available at $0 line $B::Walker::Line\n";
return;
};
my $e = Encode::resolve_alias($enc) or do {
- print STDERR "invalid encoding $enc at $0 line $CurLine\n";
+ print STDERR "invalid encoding $enc at $0 line $B::Walker::Line\n";
return;
};
my $mod = $Encode::ExtModule{$e} || $Encode::ExtModule{lc($e)} or do {
- print STDERR "no module for encoding $enc at $0 line $CurLine\n";
+ print STDERR "no module for encoding $enc at $0 line $B::Walker::Line\n";
return;
};
Requires(mod2path($mod));
@@ -151,7 +139,7 @@
$op = $op->sibling; return unless $$op; # gv[*FH] -- arg1
$op = $op->sibling; return unless $$op and $op->name eq "const";
my $sv = const_sv($op); return unless $sv->can("PV");
- local $CurOpname = $opname;
+ local $B::Walker::Opname = $opname;
my $arg2 = $sv->PV; $arg2 =~ s/\s//g;
if ($opname eq "open") {
return unless $arg2 =~ s/^[+]?[<>]+//; # validate arg2
@@ -178,7 +166,7 @@
sub grok_import ($$@) {
my ($class, undef, @args) = @_;
return unless @args;
- local $CurOpname = $class;
+ local $B::Walker::Opname = $class;
if ($class eq "base") {
foreach my $m (@args) {
my $f = mod2path($m);
@@ -215,7 +203,7 @@
my ($class, undef, $version) = @_;
return unless $version;
my $f = mod2path($class);
- local $CurOpname = "version";
+ local $B::Walker::Opname = "version";
Requires($f, $version);
}
@@ -268,111 +256,15 @@
$methods{$method}->($class, $method, @args);
}
-our %ops = (
+%B::Walker::Ops = (
'require' => \&grok_require,
'dofile' => \&grok_require,
'method_named' => \&grok_method,
'open' => \&grok_perlio,
'binmode' => \&grok_perlio,
'dbmopen' => sub { Requires("AnyDBM_File.pm") },
+ 'leavetry' => sub { $B::Walker::BlockData{Eval} = $B::Walker::Level },
);
-
-sub grok_root ($);
-sub grok_root ($) {
- my $op = shift;
- my $ref = ref($op);
- return unless $ref and $$op;
-# caller is OP, gvsv is PADOP
-# return if $ref eq "B::PADOP" or $ref eq "B::OP";
- if ($ref eq "B::COP") {
- $CurLine = $op->line;
- return;
- }
- my $name = $op->name;
- local $CurLevel = $CurLevel + 1;
- local $CurEval = $CurLevel if $name eq "leavetry";
- if ($ops{$name}) {
- local $CurOpname = $name;
- $ops{$name}->($op);
- }
- grok_root($op->pmreplroot) if $ref eq "B::PMOP";
- use B qw(OPf_KIDS);
- if ($op->flags & OPf_KIDS) {
- for ($op = $op->first; $$op; $op = $op->sibling) {
- grok_root($op);
- }
- }
-}
-
-sub grok_cv ($);
-
-sub grok_av ($$) {
- my ($name, $av) = @_;
- return if ref($av) ne "B::AV";
- local $CurSub = $name;
- grok_cv($_) for $av->ARRAY;
-}
-
-sub grok_pad ($) {
- my $pad = shift;
- return unless $pad->can("ARRAY");
- grok_av ANON => $pad->ARRAY;
-}
-
-sub grok_cv ($) {
- my $cv = shift;
- return if ref($cv) ne "B::CV";
- return if $cv->FILE and $cv->FILE ne $0;
- local $CurCV = $cv;
- grok_root($cv->ROOT);
- grok_pad($cv->PADLIST);
-}
-
-sub grok_blocks () {
- use B qw(begin_av init_av);
- grok_av "BEGIN" => begin_av;
- grok_av "INIT" => init_av;
-}
-
-sub grok_main () {
- use B qw(main_cv main_root);
- local $CurSub = "MAIN";
- grok_cv(main_cv);
- local $CurCV = main_cv;
- grok_root(main_root);
-}
-
-sub grok_gv ($) {
- my $gv = shift;
- my $cv = $gv->CV;
- return unless $$cv;
- return if $cv->XSUB;
- local $CurSub = $gv->SAFENAME;
- $CurLine = $gv->LINE;
- grok_cv($cv);
-}
-
-sub grok_stash { # similar to B::walksymtable
- my ($symref, $prefix) = @_;
- while (my ($sym) = each %$symref) {
- no strict 'refs';
- my $fullname = "*main::". $prefix . $sym;
- if ($sym =~ /::\z/) {
- $sym = $prefix . $sym;
- grok_stash(\%$fullname, $sym)
- if $sym ne "main::" && $sym ne "<none>::";
- }
- else {
- use B qw(svref_2object);
- grok_gv(svref_2object(\*$fullname))
- if *$fullname{CODE};
- }
- }
-}
-
-sub grok_subs () {
- grok_stash \%::, '';
-}
sub compile {
my $pkg = __PACKAGE__;
@@ -389,19 +281,19 @@
$| = 1;
local $SIG{__DIE__} = sub {
# checking $^S is unreliable because O.pm uses eval
- print STDERR "dying at $0 line $CurLine\n";
+ print STDERR "dying at $0 line $B::Walker::Line\n";
require Carp;
Carp::cluck();
};
- grok_blocks();
- grok_main();
- grok_subs() if not $Relaxed;
+ B::Walker::walk_blocks();
+ B::Walker::walk_main();
+ B::Walker::walk_subs() if not $Relaxed;
finalize();
};
}
END {
- print STDERR "# CurEval=$CurEval\n" if $CurEval;
+ print STDERR "# Eval=$B::Walker::BlockData{Eval}\n" if $B::Walker::BlockData{Eval};
}
1;
Added: trunk/libb-perlreq-perl/lib/B/Walker.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/lib/B/Walker.pm?rev=35894&op=file
==============================================================================
--- trunk/libb-perlreq-perl/lib/B/Walker.pm (added)
+++ trunk/libb-perlreq-perl/lib/B/Walker.pm Tue May 19 20:40:17 2009
@@ -1,0 +1,156 @@
+package B::Walker;
+our $VERSION = 0.1;
+
+use 5.006;
+use strict;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(padval const_sv walk);
+
+our $CV;
+sub padval ($) {
+ my $targ = shift;
+ return $CV->PADLIST->ARRAYelt(1)->ARRAYelt($targ);
+}
+
+sub const_sv ($) {
+ my $op = shift;
+ my $sv = $op->sv;
+ $sv = padval($op->targ) unless $$sv;
+ return $sv;
+}
+
+our $Level = 0;
+our $Line;
+our $Sub;
+our $Opname;
+
+our %Ops;
+our %BlockData;
+
+my %startblock = map { $_ => 1 }
+ qw(leave leaveloop leavesub leavesublv leavetry
+ grepwhile mapwhile scope);
+
+sub walk_root ($);
+sub walk_root ($) {
+ my $op = shift;
+ my $ref = ref($op);
+ return unless $ref and $$op;
+ if ($ref eq "B::COP") {
+ $Line = $op->line;
+ return;
+ }
+ my $name = $op->name;
+ use B qw(ppname);
+ $name = ppname($op->targ) if $name eq "null";
+ local $Level = $Level + 1;
+ local %BlockData = %BlockData if $startblock{$name};
+ local $Opname = $name if $Ops{$name};
+ $Ops{$name}->($op) if $Ops{$name};
+ walk_root($op->pmreplroot) if $ref eq "B::PMOP";
+ use B qw(OPf_KIDS);
+ if ($op->flags & OPf_KIDS) {
+ for ($op = $op->first; $$op; $op = $op->sibling) {
+ walk_root($op);
+ }
+ }
+}
+
+sub walk_cv ($);
+
+sub walk_av ($$) {
+ my ($name, $av) = @_;
+ return if ref($av) ne "B::AV";
+ local $Sub = $name;
+ walk_cv($_) for $av->ARRAY;
+}
+
+sub walk_pad ($) {
+ my $pad = shift;
+ return unless $pad->can("ARRAY");
+ walk_av ANON => $pad->ARRAY;
+}
+
+sub walk_cv ($) {
+ my $cv = shift;
+ return if ref($cv) ne "B::CV";
+ return if $cv->FILE and $cv->FILE ne $0;
+ local $CV = $cv;
+ walk_root($cv->ROOT);
+ walk_pad($cv->PADLIST);
+}
+
+sub walk_blocks () {
+ use B qw(begin_av init_av);
+ walk_av "BEGIN" => begin_av;
+ walk_av "INIT" => init_av;
+}
+
+sub walk_main () {
+ use B qw(main_cv main_root);
+ local $Sub = "MAIN";
+ walk_cv(main_cv);
+ local $CV = main_cv;
+ walk_root(main_root);
+}
+
+sub walk_gv ($) {
+ my $gv = shift;
+ my $cv = $gv->CV;
+ return unless $$cv;
+ return if $cv->XSUB;
+ local $Sub = $gv->SAFENAME;
+ $Line = $gv->LINE;
+ walk_cv($cv);
+}
+
+sub walk_stash ($$);
+sub walk_stash ($$) { # similar to B::walksymtable
+ my ($symref, $prefix) = @_;
+ while (my ($sym) = each %$symref) {
+ no strict 'refs';
+ my $fullname = "*main::". $prefix . $sym;
+ if ($sym =~ /::\z/) {
+ $sym = $prefix . $sym;
+ walk_stash(\%$fullname, $sym)
+ if $sym ne "main::" && $sym ne "<none>::";
+ }
+ else {
+ use B qw(svref_2object);
+ walk_gv(svref_2object(\*$fullname))
+ if *$fullname{CODE};
+ }
+ }
+}
+
+sub walk_subs () {
+ walk_stash \%::, '';
+}
+
+sub walk () {
+ walk_blocks();
+ walk_main();
+ walk_subs();
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Walker - dumb walker, optree ranger
+
+=head1 COPYING
+
+Copyright (c) 2006, 2007 Alexey Tourbin, ALT Linux Team.
+
+This is free software; you can redistribute it and/or modify it under the terms
+of the GNU General Public License as published by the Free Software Foundation;
+either version 2 of the License, or (at your option) any later version.
+
+=head1 SEE ALSO
+
+L<B::Utils>
Modified: trunk/libb-perlreq-perl/lib/PerlReq/Utils.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/lib/PerlReq/Utils.pm?rev=35894&op=diff
==============================================================================
--- trunk/libb-perlreq-perl/lib/PerlReq/Utils.pm (original)
+++ trunk/libb-perlreq-perl/lib/PerlReq/Utils.pm Tue May 19 20:40:17 2009
@@ -75,20 +75,19 @@
truncated to 3 digits after decimal point, except for all zeroes, e.g.
I<2.000> -> I<2.0>.
-=for comment
-$ perl -le 'print 2.01 * 1000'
-2010
-$ perl -le 'print int(2.01 * 1000)'
-2009
-$
-Gotta use 1e-3 and 1e-6.
+Update. The algorithm has been amended in almost compatible way
+so that versions do not lose precision when truncated. Now we allow
+one more I<.ddd> series at the end, but I<.000> is still truncated
+by default, e.g. I<2.123> -> I<2.123>, I<2.123456> -> I<2.123.456>.
=cut
sub verf ($) {
my $v = shift;
- $v = sprintf("%.3f", int($v * 1000 + 1e-3) / 1000 + 1e-6);
- $v =~ s/\.000$/.0/g;
+ $v = sprintf "%.6f", $v;
+ $v =~ s/[.]000000$/.0/ ||
+ $v =~ s/000$// ||
+ $v =~ s/(\d\d\d)$/.$1/ && $v =~ s/[.]000[.]/.0./;
return $v;
}
Modified: trunk/libb-perlreq-perl/perl5-alt-rpm-macros
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/perl5-alt-rpm-macros?rev=35894&op=diff
==============================================================================
--- trunk/libb-perlreq-perl/perl5-alt-rpm-macros (original)
+++ trunk/libb-perlreq-perl/perl5-alt-rpm-macros Tue May 19 20:40:17 2009
@@ -58,7 +58,7 @@
BLIBS="$BLIBS${BLIBS:+ }$(find $PWD/blib -type f -name '*.so' ||:)" \
[ -n "$BLIBS" ] || return 0 \
echo 'int main(){return 0;}' >ldtest.c \
- gcc ldtest.c ${LD_LIBRARY_PATH:+-L$LD_LIBRARY_PATH} -lperl $BLIBS $EXTRA_BLIBS \
+ gcc -Wl,--no-as-needed ldtest.c ${LD_LIBRARY_PATH:+-L$LD_LIBRARY_PATH} -lperl $BLIBS $EXTRA_BLIBS \
LD_BIND_NOW=1 ./a.out \
rm -f ldtest.c ./a.out \
} \
@@ -71,7 +71,7 @@
else \
_perl_vendor_MM_build "$@" \
fi \
- _perl_vendor_check_dso \
+ #_perl_vendor_check_dso \
} \
perl_vendor_build
Modified: trunk/libb-perlreq-perl/rpm-build-perl.spec
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/rpm-build-perl.spec?rev=35894&op=diff
==============================================================================
--- trunk/libb-perlreq-perl/rpm-build-perl.spec (original)
+++ trunk/libb-perlreq-perl/rpm-build-perl.spec Tue May 19 20:40:17 2009
@@ -1,5 +1,5 @@
Name: rpm-build-perl
-Version: 0.6.8
+Version: 0.70
Release: alt1
Summary: RPM helper scripts to calculate Perl dependencies
@@ -45,13 +45,27 @@
%_rpmlibdir/perl.prov.files
%_rpmlibdir/fake.pm
%dir %perl_vendor_privlib/B
+%perl_vendor_privlib/B/Walker.pm
%perl_vendor_privlib/B/PerlReq.pm
+%perl_vendor_privlib/B/Clobbers.pm
%dir %perl_vendor_privlib/PerlReq
%perl_vendor_privlib/PerlReq/Utils.pm
%config /etc/rpm/macros.d/perl5
%config /etc/rpm/macros.d/perl5.env
%changelog
+* Mon May 11 2009 Alexey Tourbin <at at altlinux.ru> 0.70-alt1
+- B/Walker.pm: new module, implements optree traversal
+- B/Clobbers.pm: new experimental module, for checking global variables
+- PerlReq/Utils.pm: updated version formatting algorithm for better precision;
+ the most general version format for rpm dependencies is now d.ddd.ddd
+
+* Tue Mar 24 2009 Alexey Tourbin <at at altlinux.ru> 0.6.8-alt3
+- macros (_perl_vendor_check_dso): disabled this check
+
+* Tue Mar 24 2009 Alexey Tourbin <at at altlinux.ru> 0.6.8-alt2
+- macros (_perl_vendor_check_dso): gcc -Wl,--no-as-needed
+
* Fri May 09 2008 Alexey Tourbin <at at altlinux.ru> 0.6.8-alt1
- perl.prov: try to detect block-level packages, fixes MP3/Tag.pm version
Modified: trunk/libb-perlreq-perl/t/01-B-PerlReq.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libb-perlreq-perl/t/01-B-PerlReq.t?rev=35894&op=diff
==============================================================================
--- trunk/libb-perlreq-perl/t/01-B-PerlReq.t (original)
+++ trunk/libb-perlreq-perl/t/01-B-PerlReq.t Tue May 19 20:40:17 2009
@@ -62,20 +62,20 @@
cmp_ok $d2, 'eq', grok qq(eval { require $m; } || eval { require $m3; }; require $m2;);
cmp_ok $d2, 'eq', grok qq(require $m2; eval { $m2->VERSION(0.1); };);
-cmp_ok "$d >= 2.0", 'eq', grok qq(use $m 2;);
-cmp_ok "$d >= 2.0", 'eq', grok qq(use $m 2.0;);
-cmp_ok "$d >= 2.0", 'eq', grok qq(use $m 2.00;);
-cmp_ok "$d >= 2.0", 'eq', grok qq(use $m 2.000998;);
-cmp_ok "$d >= 2.001", 'eq', grok qq(use $m 2.000999;);
-cmp_ok "$d >= 2.010", 'eq', grok qq(use $m 2.01;);
-cmp_ok "$d >= 2.012", 'eq', grok qq(use $m 2.012;);
-cmp_ok "$d >= 2.019", 'eq', grok qq(use $m 2.0199;);
-cmp_ok "$d >= 2.0", 'eq', grok qq(use $m v2;);
-cmp_ok "$d >= 2.0", 'eq', grok qq(use $m v2.0;);
-cmp_ok "$d >= 2.0", 'eq', grok qq(use $m v2.0.998;);
-cmp_ok "$d >= 2.001", 'eq', grok qq(use $m v2.0.999;);
-cmp_ok "$d >= 2.001", 'eq', grok qq(use $m 2.1.1;);
-cmp_ok "$d >= 2.001", 'eq', grok qq(use $m v2.1.1;);
+cmp_ok "$d >= 2.0", 'eq', grok qq(use $m 2;);
+cmp_ok "$d >= 2.0", 'eq', grok qq(use $m 2.0;);
+cmp_ok "$d >= 2.0", 'eq', grok qq(use $m 2.00;);
+cmp_ok "$d >= 2.0.998", 'eq', grok qq(use $m 2.000998;);
+cmp_ok "$d >= 2.001", 'eq', grok qq(use $m 2.0009999;);
+cmp_ok "$d >= 2.010", 'eq', grok qq(use $m 2.01;);
+cmp_ok "$d >= 2.012", 'eq', grok qq(use $m 2.012;);
+cmp_ok "$d >= 2.019.900", 'eq', grok qq(use $m 2.0199;);
+cmp_ok "$d >= 2.0", 'eq', grok qq(use $m v2;);
+cmp_ok "$d >= 2.0", 'eq', grok qq(use $m v2.0;);
+cmp_ok "$d >= 2.0.998", 'eq', grok qq(use $m v2.0.998;);
+cmp_ok "$d >= 2.0.999", 'eq', grok qq(use $m v2.0.999;);
+cmp_ok "$d >= 2.001.001", 'eq', grok qq(use $m 2.1.1;);
+cmp_ok "$d >= 2.001.001", 'eq', grok qq(use $m v2.1.1;);
cmp_ok "perl(base.pm)\n$d", 'eq', grok qq(use base qw($m););
cmp_ok "perl(base.pm) >= 1.0\n$d", 'eq', grok qq(use base 1 qw($m););
More information about the Pkg-perl-cvs-commits
mailing list