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