r47881 - in /trunk/libfile-find-rule-perl: ./ debian/ debian/patches/ lib/File/Find/ t/ t/lib/ testdir/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Nov 28 21:06:22 UTC 2009
Author: jawnsy-guest
Date: Sat Nov 28 21:06:17 2009
New Revision: 47881
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=47881
Log:
* New upstream release
* Remove Jonas Gennant from Uploaders; given that he has not
responded to various mails, I assume he's MIA
* Update control description
* Use debhelper 7, short rules and --with quilt
* Refresh quilt patch to unified format
* Standards-Version 3.8.3 (no changes)
Added:
trunk/libfile-find-rule-perl/testdir/
- copied from r47880, branches/upstream/libfile-find-rule-perl/current/testdir/
Removed:
trunk/libfile-find-rule-perl/Build.PL
trunk/libfile-find-rule-perl/t/foobar
trunk/libfile-find-rule-perl/t/lib/
Modified:
trunk/libfile-find-rule-perl/Changes
trunk/libfile-find-rule-perl/MANIFEST
trunk/libfile-find-rule-perl/META.yml
trunk/libfile-find-rule-perl/Makefile.PL
trunk/libfile-find-rule-perl/README
trunk/libfile-find-rule-perl/debian/changelog
trunk/libfile-find-rule-perl/debian/compat
trunk/libfile-find-rule-perl/debian/control
trunk/libfile-find-rule-perl/debian/patches/sequential_slashes.patch
trunk/libfile-find-rule-perl/debian/rules
trunk/libfile-find-rule-perl/lib/File/Find/Rule.pm
trunk/libfile-find-rule-perl/t/File-Find-Rule.t
trunk/libfile-find-rule-perl/t/findrule.t
Modified: trunk/libfile-find-rule-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/Changes?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/Changes (original)
+++ trunk/libfile-find-rule-perl/Changes Sat Nov 28 21:06:17 2009
@@ -1,3 +1,17 @@
+0.32 Saturday 28th November, 2009
+ Rework the referencing of anyonymous subroutines internally,
+ closes RT#46599 (Reported by Kevin Ryde)
+
+0.31 Friday 27th November 2009
+ Move to Makefile.PL
+ use Test::Differences in the testsuite if available.
+ Rearrange the testsuite so you don't keep tripping over yourself.
+ Dropped 5.00503 backwards compatibility, allows some 5.6isms and
+ dropping the shonky Cwd code.
+ All taint 'bugs' are now the same as the behaviour of File::Find,
+ documentation has been added to describe this.
+
+
0.30 Wednesday 1st June, 2006
Made './//././././///.//././/////./blah' be treated the same
as './blah' (it gets turned into 'blah')
Modified: trunk/libfile-find-rule-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/MANIFEST?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/MANIFEST (original)
+++ trunk/libfile-find-rule-perl/MANIFEST Sat Nov 28 21:06:17 2009
@@ -2,13 +2,14 @@
README
Changes
Makefile.PL
-Build.PL
META.yml
lib/File/Find/Rule.pm
lib/File/Find/Rule/Extending.pod
lib/File/Find/Rule/Procedural.pod
t/File-Find-Rule.t
t/findrule.t
-t/foobar
-t/lib/File/Find/Rule/Test/ATeam.pm
+testdir/File-Find-Rule.t
+testdir/findrule.t
+testdir/foobar
+testdir/lib/File/Find/Rule/Test/ATeam.pm
findrule
Modified: trunk/libfile-find-rule-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/META.yml?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/META.yml (original)
+++ trunk/libfile-find-rule-perl/META.yml Sat Nov 28 21:06:17 2009
@@ -1,24 +1,25 @@
----
-name: File-Find-Rule
-version: 0.30
-author:
- - |-
- Richard Clamp <richardc at unixbeard.net> with input gained from this
- use.perl discussion: http://use.perl.org/~richardc/journal/6467
- - |-
- Additional proofreading and input provided by Kake, Greg McCarroll,
- and Andy Lester andy at petdance.com.
-abstract: Alternative interface to File::Find
-license: perl
+--- #YAML:1.0
+name: File-Find-Rule
+version: 0.32
+abstract: ~
+author: []
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
requires:
- Cwd: 0
- File::Find: 0
- File::Spec: 0
- Number::Compare: 0
- Test::More: 0
- Text::Glob: 0
-provides:
- File::Find::Rule:
- file: lib/File/Find/Rule.pm
- version: 0.30
-generated_by: Module::Build version 0.25
+ File::Find: 0
+ File::Spec: 0
+ Number::Compare: 0
+ Test::More: 0
+ Text::Glob: 0.07
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.50
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: trunk/libfile-find-rule-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/Makefile.PL?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/Makefile.PL (original)
+++ trunk/libfile-find-rule-perl/Makefile.PL Sat Nov 28 21:06:17 2009
@@ -1,21 +1,14 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.03
+use strict;
use ExtUtils::MakeMaker;
-WriteMakefile
-(
- 'NAME' => 'File::Find::Rule',
- 'VERSION_FROM' => 'lib/File/Find/Rule.pm',
- 'PREREQ_PM' => {
- 'Cwd' => '0',
- 'File::Find' => '0',
- 'File::Spec' => '0',
- 'Number::Compare' => '0',
- 'Test::More' => '0',
- 'Text::Glob' => '0'
- },
- 'INSTALLDIRS' => 'site',
- 'EXE_FILES' => [
- 'findrule'
- ],
- 'PL_FILES' => {}
- )
-;
+WriteMakefile(
+ 'NAME' => 'File::Find::Rule',
+ 'VERSION_FROM' => 'lib/File/Find/Rule.pm',
+ 'PREREQ_PM' => {
+ 'File::Find' => 0,
+ 'File::Spec' => 0,
+ 'Number::Compare' => 0,
+ 'Text::Glob' => '0.07',
+ 'Test::More' => 0,
+ },
+ 'EXE_FILES' => ['findrule'],
+);
Modified: trunk/libfile-find-rule-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/README?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/README (original)
+++ trunk/libfile-find-rule-perl/README Sat Nov 28 21:06:17 2009
@@ -1,4 +1,4 @@
-README for File::Find::Rule 0.30
+README for File::Find::Rule
=head1 NAME
@@ -22,25 +22,14 @@
my @files = $rule->in( @INC );
-=head1 DEPENDENCIES
-
-This module has external dependencies on the following modules:
-
- Cwd
- File::Find
- File::Spec
- Number::Compare
- Test::More
- Text::Glob
-
=head1 INSTALLATION
- perl Build.PL
- perl Build test
+ perl Makefile.PL
+ make test
and if all goes well
- perl Build install
+ make install
=head1 HISTORY
@@ -48,22 +37,28 @@
=over
+=item 0.32 Saturday 28th November, 2009
+
+ Rework the referencing of anyonymous subroutines internally,
+ closes RT#46599 (Reported by Kevin Ryde)
+
+
+=item 0.31 Friday 27th November 2009
+
+ Move to Makefile.PL
+ use Test::Differences in the testsuite if available.
+ Rearrange the testsuite so you don't keep tripping over yourself.
+ Dropped 5.00503 backwards compatibility, allows some 5.6isms and
+ dropping the shonky Cwd code.
+ All taint 'bugs' are now the same as the behaviour of File::Find,
+ documentation has been added to describe this.
+
+
+
=item 0.30 Wednesday 1st June, 2006
Made './//././././///.//././/////./blah' be treated the same
as './blah' (it gets turned into 'blah')
-
-
-=item 0.29 Tuesday 16th May, 2006
-
- Kludged around {min,max}depth and trailing slashes in path
- names.
-
-
-=item 0.28 Tuesday 18th May, 2004
-
- exposed %X_tests and @stat_tests as package variables, and make a
- _call_find method for File::Find::Rule::Filesys::Virtual
=back
@@ -77,7 +72,7 @@
=head1 COPYRIGHT
-Copyright (C) 2002, 2003, 2004, 2006 Richard Clamp. All Rights Reserved.
+Copyright (C) 2002, 2003, 2004, 2006, 2009 Richard Clamp. All Rights Reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Modified: trunk/libfile-find-rule-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/debian/changelog?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/debian/changelog (original)
+++ trunk/libfile-find-rule-perl/debian/changelog Sat Nov 28 21:06:17 2009
@@ -1,4 +1,13 @@
-libfile-find-rule-perl (0.30-4) UNRELEASED; urgency=low
+libfile-find-rule-perl (0.32-1) UNRELEASED; urgency=low
+
+ [ Jonathan Yu ]
+ * New upstream release
+ * Remove Jonas Gennant from Uploaders; given that he has not
+ responded to various mails, I assume he's MIA
+ * Update control description
+ * Use debhelper 7, short rules and --with quilt
+ * Refresh quilt patch to unified format
+ * Standards-Version 3.8.3 (no changes)
[ gregor herrmann ]
* Add debian/README.source to document quilt usage, as required by
@@ -20,7 +29,7 @@
* debian/control: Changed: (build-)depend on perl instead of perl-
modules.
- -- gregor herrmann <gregoa at debian.org> Wed, 06 Aug 2008 21:33:38 -0300
+ -- Jonathan Yu <jawnsy at cpan.org> Sat, 28 Nov 2009 12:33:18 -0500
libfile-find-rule-perl (0.30-3) unstable; urgency=low
Modified: trunk/libfile-find-rule-perl/debian/compat
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/debian/compat?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/debian/compat (original)
+++ trunk/libfile-find-rule-perl/debian/compat Sat Nov 28 21:06:17 2009
@@ -1,1 +1,1 @@
-5
+7
Modified: trunk/libfile-find-rule-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/debian/control?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/debian/control (original)
+++ trunk/libfile-find-rule-perl/debian/control Sat Nov 28 21:06:17 2009
@@ -1,12 +1,12 @@
Source: libfile-find-rule-perl
Section: perl
Priority: optional
+Build-Depends: debhelper (>= 7), quilt (>= 0.46-7)
+Build-Depends-Indep: perl, libtext-glob-perl, libnumber-compare-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Jonas Genannt <jonas.genannt at capi2name.de>, Niko Tyni <ntyni at iki.fi>,
- Gunnar Wolf <gwolf at debian.org>, gregor herrmann <gregoa at debian.org>
-Build-Depends: debhelper (>= 5), quilt
-Build-Depends-Indep: perl, libtext-glob-perl, libnumber-compare-perl
-Standards-Version: 3.7.3
+Uploaders: Niko Tyni <ntyni at iki.fi>, Gunnar Wolf <gwolf at debian.org>,
+ gregor herrmann <gregoa at debian.org>
+Standards-Version: 3.8.3
Homepage: http://search.cpan.org/dist/File-Find-Rule/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libfile-find-rule-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libfile-find-rule-perl/
@@ -14,6 +14,9 @@
Package: libfile-find-rule-perl
Architecture: all
Depends: ${misc:Depends}, ${perl:Depends}, libtext-glob-perl, libnumber-compare-perl
-Description: Alternative interface to File::Find
- A friendlier interface to File::Find. It allows you to build rules which
- specify the desired files and directories.
+Description: module to search for files based on rules
+ File::Find::Rule is a Perl module which essentially provides an easy-to-use
+ interface to the popular module, File::Find. It provides a way to build rules
+ that specify desired file and directory names using a text-globbing syntax
+ (provided by Text::Glob). This makes it useful for simple tasks, like finding
+ all ".pm" files in a given directory.
Modified: trunk/libfile-find-rule-perl/debian/patches/sequential_slashes.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/debian/patches/sequential_slashes.patch?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/debian/patches/sequential_slashes.patch (original)
+++ trunk/libfile-find-rule-perl/debian/patches/sequential_slashes.patch Sat Nov 28 21:06:17 2009
@@ -1,6 +1,6 @@
--- a/lib/File/Find/Rule.pm
+++ b/lib/File/Find/Rule.pm
-@@ -541,6 +541,7 @@ sub in {
+@@ -540,6 +540,7 @@
my $topdir;
my $code = 'sub {
(my $path = $File::Find::name) =~ s#^(?:\./+)+##;
Modified: trunk/libfile-find-rule-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/debian/rules?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/debian/rules (original)
+++ trunk/libfile-find-rule-perl/debian/rules Sat Nov 28 21:06:17 2009
@@ -1,72 +1,4 @@
#!/usr/bin/make -f
-# This debian/rules file is provided as a template for normal perl
-# packages. It was created by Marc Brockschmidt <marc at dch-faq.de> for
-# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may
-# be used freely wherever it is useful.
-# Uncomment this to turn on verbose mode.
-#export DH_VERBOSE=1
-
-include /usr/share/quilt/quilt.make
-
-# If set to a true value then MakeMaker's prompt function will
-# always return the default without waiting for user input.
-export PERL_MM_USE_DEFAULT=1
-
-PACKAGE=$(shell dh_listpackages)
-
-ifndef PERL
-PERL = /usr/bin/perl
-endif
-
-TMP =$(CURDIR)/debian/$(PACKAGE)
-
-build: build-stamp
-build-stamp: $(QUILT_STAMPFN)
- dh_testdir
-
- $(PERL) Makefile.PL INSTALLDIRS=vendor
- $(MAKE)
- $(MAKE) test
-
- touch $@
-
-clean: unpatch
- dh_testdir
- dh_testroot
-
- dh_clean build-stamp install-stamp
- [ ! -f Makefile ] || $(MAKE) realclean
-
-install: install-stamp
-install-stamp: build-stamp
- dh_testdir
- dh_testroot
- dh_clean -k
-
- $(MAKE) install DESTDIR=$(TMP) PREFIX=/usr
- [ ! -d $(TMP)/usr/lib/perl5 ] || rmdir --ignore-fail-on-non-empty --parents --verbose $(TMP)/usr/lib/perl5
-
- touch $@
-
-binary-arch:
-# We have nothing to do here for an architecture-independent package
-
-binary-indep: build install
- dh_testdir
- dh_testroot
- dh_installdocs
- dh_installchangelogs Changes
- dh_perl
- dh_compress
- dh_fixperms
- dh_installdeb
- dh_gencontrol
- dh_md5sums
- dh_builddeb
-
-source diff:
- @echo >&2 'source and diff are obsolete - use dpkg-source -b'; false
-
-binary: binary-indep binary-arch
-.PHONY: build clean binary-indep binary-arch binary install
+%:
+ dh --with quilt $@
Modified: trunk/libfile-find-rule-perl/lib/File/Find/Rule.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/lib/File/Find/Rule.pm?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/lib/File/Find/Rule.pm (original)
+++ trunk/libfile-find-rule-perl/lib/File/Find/Rule.pm Sat Nov 28 21:06:17 2009
@@ -1,16 +1,14 @@
-# $Id: /mirror/lab/perl/File-Find-Rule/lib/File/Find/Rule.pm 2102 2006-06-01T15:39:03.942922Z richardc $
+# $Id$
package File::Find::Rule;
use strict;
-use vars qw/$VERSION $AUTOLOAD/;
use File::Spec;
use Text::Glob 'glob_to_regex';
use Number::Compare;
use Carp qw/croak/;
use File::Find (); # we're only wrapping for now
-use Cwd; # 5.00503s File::Find goes screwy with max_depth == 0
-
-$VERSION = '0.30';
+
+our $VERSION = '0.32';
# we'd just inherit from Exporter, but I want the colon
sub import {
@@ -105,8 +103,8 @@
my $referent = shift;
my $class = ref $referent || $referent;
bless {
- rules => [], # [0]
- subs => [], # [1]
+ rules => [],
+ subs => {},
iterator => [],
extras => {},
maxdepth => undef,
@@ -290,15 +288,15 @@
sub any {
my $self = _force_object shift;
- my @rulesets = @_;
-
+ # compile all the subrules to code fragments
push @{ $self->{rules} }, {
- rule => 'any',
- code => '(' . join( ' || ', map {
- "( " . $_->_compile( $self->{subs} ) . " )"
- } @_ ) . ")",
+ rule => "any",
+ code => '(' . join( ' || ', map '( ' . $_->_compile . ' )', @_ ). ')',
args => \@_,
};
+
+ # merge all the subs hashes of the kids into ourself
+ %{ $self->{subs} } = map { %{ $_->{subs} } } $self, @_;
$self;
}
@@ -319,15 +317,15 @@
sub not {
my $self = _force_object shift;
- my @rulesets = @_;
push @{ $self->{rules} }, {
rule => 'not',
- args => \@rulesets,
- code => '(' . join ( ' && ', map {
- "!(". $_->_compile( $self->{subs} ) . ")"
- } @_ ) . ")",
+ args => \@_,
+ code => '(' . join ( ' && ', map { "!(". $_->_compile . ")" } @_ ) . ")",
};
+
+ # merge all the subs hashes into us
+ %{ $self->{subs} } = map { %{ $_->{subs} } } $self, @_;
$self;
}
@@ -390,7 +388,7 @@
$self;
}
-=item ->grep( @specifiers );
+=item C<grep( @specifiers )>
Opens a file and tests it each line at a time.
@@ -500,6 +498,7 @@
sub DESTROY {}
sub AUTOLOAD {
+ our $AUTOLOAD;
$AUTOLOAD =~ /::not_([^:]*)$/
or croak "Can't locate method $AUTOLOAD";
my $method = $1;
@@ -532,8 +531,8 @@
my $self = _force_object shift;
my @found;
- my $fragment = $self->_compile( $self->{subs} );
- my @subs = @{ $self->{subs} };
+ my $fragment = $self->_compile;
+ my %subs = %{ $self->{subs} };
warn "relative mode handed multiple paths - that's a bit silly\n"
if $self->{relative} && @_ > 1;
@@ -573,11 +572,10 @@
}';
#use Data::Dumper;
- #print Dumper \@subs;
+ #print Dumper \%subs;
#warn "Compiled sub: '$code'\n";
my $sub = eval "$code" or die "compile error '$code' $@";
- my $cwd = getcwd;
for my $path (@_) {
# $topdir is used for relative and maxdepth
$topdir = $path;
@@ -587,7 +585,6 @@
unless $topdir eq '/';
$self->_call_find( { %{ $self->{extras} }, wanted => $sub }, $path );
}
- chdir $cwd;
return @found;
}
@@ -599,19 +596,20 @@
sub _compile {
my $self = shift;
- my $subs = shift; # [1]
return '1' unless @{ $self->{rules} };
my $code = join " && ", map {
if (ref $_->{code}) {
- push @$subs, $_->{code};
- "\$subs[$#{$subs}]->(\@args) # $_->{rule}\n";
+ my $key = "$_->{code}";
+ $self->{subs}{$key} = $_->{code};
+ "\$subs{'$key'}->(\@args) # $_->{rule}\n";
}
else {
"( $_->{code} ) # $_->{rule}\n";
}
} @{ $self->{rules} };
+ #warn $code;
return $code;
}
@@ -622,7 +620,7 @@
iterator.
my $rule = File::Find::Rule->file->name("*.jpeg")->start( "/web" );
- while ( my $image = $rule->match ) {
+ while ( defined ( my $image = $rule->match ) ) {
...
}
@@ -718,10 +716,22 @@
L</find>, L</rule>
+=head1 TAINT MODE INTERACTION
+
+As of 0.32 File::Find::Rule doesn't capture the current working directory in
+a taint-unsafe manner. File::Find itself still does operations that the taint
+system will flag as insecure but you can use the L</extras> feature to ask
+L<File::Find> to internally C<untaint> file paths with a regex like so:
+
+ my $rule = File::Find::Rule->extras({ untaint => 1 });
+
+Please consult L<File::Find>'s documentation for C<untaint>,
+C<untaint_pattern>, and C<untaint_skip> for more information.
+
=head1 BUGS
-The code relies on qr// compiled regexes, therefore this module
-requires perl version 5.005_03 or newer.
+The code makes use of the C<our> keyword and as such requires perl version
+5.6.0 or newer.
Currently it isn't possible to remove a clause from a rule object. If
this becomes a significant issue it will be addressed.
@@ -736,7 +746,7 @@
=head1 COPYRIGHT
-Copyright (C) 2002, 2003, 2004, 2006 Richard Clamp. All Rights Reserved.
+Copyright (C) 2002, 2003, 2004, 2006, 2009 Richard Clamp. All Rights Reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -753,23 +763,19 @@
Implementation notes:
-[0] Currently we use an array of anonymous subs, and call those
-repeatedly from match. It'll probably be way more effecient to
-instead eval-string compile a dedicated matching sub, and call that to
-avoid the repeated sub dispatch.
-
-[1] Though [0] isn't as true as it once was, I'm not sure that the
-subs stack is exposed in quite the right way. Maybe it'd be better as
-a private global hash. Something like $subs{$self} = []; and in
-C<DESTROY>, delete $subs{$self}.
-
-That'd make compiling subrules really much easier (no need to pass
- at subs in for context), and things that work via a mix of callbacks and
-code fragments are possible (you'd probably want this for the stat
-tests).
-
-Need to check this currently working version in before I play with
-that though.
+$self->rules is an array of hashrefs. it may be a code fragment or a call
+to a subroutine.
+
+Anonymous subroutines are stored in the $self->subs hashref keyed on the
+stringfied version of the coderef.
+
+When one File::Find::Rule object is combined with another, such as in the any
+and not operations, this entire hash is merged.
+
+The _compile method walks the rules element and simply glues the code
+fragments together so they can be compiled into an anyonymous File::Find
+match sub for speed
+
[*] There's probably a win to be made with the current model in making
stat calls use C<_>. For
Modified: trunk/libfile-find-rule-perl/t/File-Find-Rule.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/t/File-Find-Rule.t?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/t/File-Find-Rule.t (original)
+++ trunk/libfile-find-rule-perl/t/File-Find-Rule.t Sat Nov 28 21:06:17 2009
@@ -1,19 +1,25 @@
#!perl -w
-# $Id: /mirror/lab/perl/File-Find-Rule/t/File-Find-Rule.t 2100 2006-05-28T16:06:50.725367Z richardc $
+# $Id$
use strict;
-use Test::More tests => 41;
+use Test::More tests => 44;
+
+if (eval { require Test::Differences; 1 }) {
+ no warnings;
+ *is_deeply = *Test::Differences::eq_or_diff;
+}
+
my $class;
-my @tests = qw( t/File-Find-Rule.t t/findrule.t );
+my @tests = qw( testdir/File-Find-Rule.t testdir/findrule.t );
BEGIN {
$class = 'File::Find::Rule';
use_ok($class)
}
-# on win32 systems the t/foobar file isn't 10 bytes it's 11, so the
+# on win32 systems the testdir/foobar file isn't 10 bytes it's 11, so the
# previous tests on the magic number 10 failed. rt.cpan.org #3838
-my $foobar_size = -s 't/foobar';
+my $foobar_size = -s 'testdir/foobar';
my $f = $class->new;
isa_ok($f, $class);
@@ -21,45 +27,45 @@
# name
$f = $class->name( qr/\.t$/ );
-is_deeply( [ sort $f->in('t') ],
+is_deeply( [ sort $f->in('testdir') ],
[ @tests ],
"name( qr/\\.t\$/ )" );
$f = $class->name( 'foobar' );
-is_deeply( [ $f->in('t') ],
- [ 't/foobar' ],
+is_deeply( [ $f->in('testdir') ],
+ [ 'testdir/foobar' ],
"name( 'foobar' )" );
$f = $class->name( '*.t' );
-is_deeply( [ sort $f->in('t') ],
+is_deeply( [ sort $f->in('testdir') ],
\@tests,
"name( '*.t' )" );
$f = $class->name( 'foobar', '*.t' );
-is_deeply( [ sort $f->in('t') ],
- [ @tests, 't/foobar' ],
+is_deeply( [ sort $f->in('testdir') ],
+ [ @tests, 'testdir/foobar' ],
"name( 'foobar', '*.t' )" );
$f = $class->name( [ 'foobar', '*.t' ] );
-is_deeply( [ sort $f->in('t') ],
- [ @tests, 't/foobar' ],
+is_deeply( [ sort $f->in('testdir') ],
+ [ @tests, 'testdir/foobar' ],
"name( [ 'foobar', '*.t' ] )" );
# exec
$f = $class->exec(sub { length == 6 })->maxdepth(1);
-is_deeply( [ $f->in('t') ],
- [ 't/foobar' ],
+is_deeply( [ $f->in('testdir') ],
+ [ 'testdir/foobar' ],
"exec (short)" );
$f = $class->exec(sub { length > $foobar_size })->maxdepth(1);
-is_deeply( [ $f->in('t') ],
- [ 't/File-Find-Rule.t' ],
+is_deeply( [ $f->in('testdir') ],
+ [ 'testdir/File-Find-Rule.t' ],
"exec (long)" );
-is_deeply( [ find( maxdepth => 1, exec => sub { $_[2] eq 't/foobar' }, in => 't' ) ],
- [ 't/foobar' ],
+is_deeply( [ find( maxdepth => 1, exec => sub { $_[2] eq 'testdir/foobar' }, in => 'testdir' ) ],
+ [ 'testdir/foobar' ],
"exec (check arg 2)" );
# name and exec, chained
@@ -67,8 +73,8 @@
->exec(sub { length > $foobar_size })
->name( qr/\.t$/ );
-is_deeply( [ $f->in('t') ],
- [ 't/File-Find-Rule.t' ],
+is_deeply( [ $f->in('testdir') ],
+ [ 'testdir/File-Find-Rule.t' ],
"exec(match) and name(match)" );
$f = $class
@@ -76,7 +82,7 @@
->name( qr/foo/ )
->maxdepth(1);
-is_deeply( [ $f->in('t') ],
+is_deeply( [ $f->in('testdir') ],
[ ],
"exec(match) and name(fail)" );
@@ -87,8 +93,8 @@
->maxdepth(1)
->exec(sub { $_ !~ /(\.svn|CVS)/ }); # ignore .svn/CVS dirs
-is_deeply( [ $f->in('t') ],
- [ qw( t t/lib ) ],
+is_deeply( [ $f->in('testdir') ],
+ [ qw( testdir testdir/lib ) ],
"directory autostub" );
@@ -98,8 +104,8 @@
->exec( sub { length > $foobar_size } )
)->maxdepth(1);
-is_deeply( [ sort $f->in('t') ],
- [ 't/File-Find-Rule.t', 't/foobar' ],
+is_deeply( [ sort $f->in('testdir') ],
+ [ 'testdir/File-Find-Rule.t', 'testdir/foobar' ],
"any" );
$f = $class->or( $class->exec( sub { length == 6 } ),
@@ -107,9 +113,15 @@
->exec( sub { length > $foobar_size } )
)->maxdepth(1);
-is_deeply( [ sort $f->in('t') ],
- [ 't/File-Find-Rule.t', 't/foobar' ],
+is_deeply( [ sort $f->in('testdir') ],
+ [ 'testdir/File-Find-Rule.t', 'testdir/foobar' ],
"or" );
+
+# nesting ->or (RT 46599)
+$f = $class->or( $class->or( $class->name("foobar") ) );
+is_deeply( [ sort $f->in('testdir') ],
+ [ 'testdir/foobar' ],
+ "or, nested" );
# not/none
@@ -118,8 +130,8 @@
->not( $class->name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ ) )
->maxdepth(1)
->exec(sub { length == 6 || length > 10 });
-is_deeply( [ $f->in('t') ],
- [ 't/File-Find-Rule.t' ],
+is_deeply( [ $f->in('testdir') ],
+ [ 'testdir/File-Find-Rule.t' ],
"not" );
# not as not_*
@@ -128,8 +140,8 @@
->not_name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ )
->maxdepth(1)
->exec(sub { length == 6 || length > 10 });
-is_deeply( [ $f->in('t') ],
- [ 't/File-Find-Rule.t' ],
+is_deeply( [ $f->in('testdir') ],
+ [ 'testdir/File-Find-Rule.t' ],
"not_*" );
# prune/discard (.svn demo)
@@ -141,8 +153,8 @@
->discard,
$class->new->file );
-is_deeply( [ sort $f->in('t') ],
- [ @tests, 't/foobar', 't/lib/File/Find/Rule/Test/ATeam.pm' ],
+is_deeply( [ sort $f->in('testdir') ],
+ [ @tests, 'testdir/foobar', 'testdir/lib/File/Find/Rule/Test/ATeam.pm' ],
"prune/discard .svn"
);
@@ -154,51 +166,51 @@
discard => ),
find( file => ) ]);
-is_deeply( [ sort $f->in('t') ],
- [ @tests, 't/foobar', 't/lib/File/Find/Rule/Test/ATeam.pm' ],
+is_deeply( [ sort $f->in('testdir') ],
+ [ @tests, 'testdir/foobar', 'testdir/lib/File/Find/Rule/Test/ATeam.pm' ],
"procedural prune/discard .svn"
);
# size (stat test)
-is_deeply( [ find( maxdepth => 1, file => size => $foobar_size, in => 't' ) ],
- [ 't/foobar' ],
+is_deeply( [ find( maxdepth => 1, file => size => $foobar_size, in => 'testdir' ) ],
+ [ 'testdir/foobar' ],
"size $foobar_size (stat)" );
is_deeply( [ find( maxdepth => 1, file => size => "<= $foobar_size",
- in => 't' ) ],
- [ 't/foobar' ],
+ in => 'testdir' ) ],
+ [ 'testdir/foobar' ],
"size <= $foobar_size (stat)" );
is_deeply( [ find( maxdepth => 1, file => size => "<".($foobar_size + 1),
- in => 't' ) ],
- [ 't/foobar' ],
+ in => 'testdir' ) ],
+ [ 'testdir/foobar' ],
"size <($foobar_size + 1) (stat)" );
is_deeply( [ find( maxdepth => 1, file => size => "<1K",
exec => sub { length == 6 },
- in => 't' ) ],
- [ 't/foobar' ],
+ in => 'testdir' ) ],
+ [ 'testdir/foobar' ],
"size <1K (stat)" );
-is_deeply( [ find( maxdepth => 1, file => size => ">3K", in => 't' ) ],
- [ 't/File-Find-Rule.t' ],
+is_deeply( [ find( maxdepth => 1, file => size => ">3K", in => 'testdir' ) ],
+ [ 'testdir/File-Find-Rule.t' ],
"size >3K (stat)" );
# these next two should never fail. if they do then the testing fairy
# went mad
-is_deeply( [ find( file => size => ">3M", in => 't' ) ],
+is_deeply( [ find( file => size => ">3M", in => 'testdir' ) ],
[ ],
"size >3M (stat)" );
-is_deeply( [ find( file => size => ">3G", in => 't' ) ],
+is_deeply( [ find( file => size => ">3G", in => 'testdir' ) ],
[ ],
"size >3G (stat)" );
#min/maxdepth
-is_deeply( [ find( maxdepth => 0, in => 't' ) ],
- [ 't' ],
+is_deeply( [ find( maxdepth => 0, in => 'testdir' ) ],
+ [ 'testdir' ],
"maxdepth == 0" );
@@ -209,26 +221,35 @@
],
maxdepth => 1 );
-is_deeply( [ sort $rule->in( 't' ) ],
- [ 't', @tests, 't/foobar', 't/lib' ],
+is_deeply( [ sort $rule->in( 'testdir' ) ],
+ [ 'testdir', @tests, 'testdir/foobar', 'testdir/lib' ],
"maxdepth == 1" );
-is_deeply( [ sort $rule->in( 't/' ) ],
- [ 't', @tests, 't/foobar', 't/lib' ],
+is_deeply( [ sort $rule->in( 'testdir/' ) ],
+ [ 'testdir', @tests, 'testdir/foobar', 'testdir/lib' ],
"maxdepth == 1, trailing slash on the path" );
-is_deeply( [ sort $rule->in( './t' ) ],
- [ 't', @tests, 't/foobar', 't/lib' ],
+is_deeply( [ sort $rule->in( './testdir' ) ],
+ [ 'testdir', @tests, 'testdir/foobar', 'testdir/lib' ],
"maxdepth == 1, ./t" );
-is_deeply( [ sort $rule->in( './././///./t' ) ],
- [ 't', @tests, 't/foobar', 't/lib' ],
- "maxdepth == 1, ./././///./t" );
-
-my @ateam_path = qw( t/lib
- t/lib/File
- t/lib/File/Find
- t/lib/File/Find/Rule
- t/lib/File/Find/Rule/Test
- t/lib/File/Find/Rule/Test/ATeam.pm );
+
+is_deeply( [ sort $rule->in( './/testdir' ) ],
+ [ 'testdir', @tests, 'testdir/foobar', 'testdir/lib' ],
+ "maxdepth == 1, .//t" );
+
+is_deeply( [ sort $rule->in( './//testdir' ) ],
+ [ 'testdir', @tests, 'testdir/foobar', 'testdir/lib' ],
+ "maxdepth == 1, .///testdir" );
+
+is_deeply( [ sort $rule->in( './././///./testdir' ) ],
+ [ 'testdir', @tests, 'testdir/foobar', 'testdir/lib' ],
+ "maxdepth == 1, ./././///./testdir" );
+
+my @ateam_path = qw( testdir/lib
+ testdir/lib/File
+ testdir/lib/File/Find
+ testdir/lib/File/Find/Rule
+ testdir/lib/File/Find/Rule/Test
+ testdir/lib/File/Find/Rule/Test/ATeam.pm );
is_deeply( [ sort +find( or => [ find( name => qr/(\.svn|CVS)/,
prune =>
@@ -236,8 +257,8 @@
find( ),
],
mindepth => 1,
- in => 't' ) ],
- [ @tests, 't/foobar', @ateam_path ],
+ in => 'testdir' ) ],
+ [ @tests, 'testdir/foobar', @ateam_path ],
"mindepth == 1" );
@@ -247,13 +268,13 @@
],
maxdepth => 1,
mindepth => 1,
- in => 't' ) ],
- [ @tests, 't/foobar', 't/lib' ],
+ in => 'testdir' ) ],
+ [ @tests, 'testdir/foobar', 'testdir/lib' ],
"maxdepth = 1 mindepth == 1" );
# extras
my $ok = 0;
-find( extras => { preprocess => sub { $ok = 1 } }, in => 't' );
+find( extras => { preprocess => sub { $ok = 1 } }, in => 'testdir' );
ok( $ok, "extras preprocess fired" );
#iterator
@@ -262,30 +283,30 @@
discard =>),
find(),
],
- start => 't' );
+ start => 'testdir' );
{
my @found;
while ($_ = $f->match) { push @found, $_ }
-is_deeply( [ sort @found ], [ 't', @tests, 't/foobar', @ateam_path ], "iterator" );
+is_deeply( [ sort @found ], [ 'testdir', @tests, 'testdir/foobar', @ateam_path ], "iterator" );
}
# negating in the procedural interface
is_deeply( [ find( file => '!name' => qr/^[^.]{1,8}(\.[^.]{0,3})?$/,
maxdepth => 1,
- in => 't' ) ],
- [ 't/File-Find-Rule.t' ],
+ in => 'testdir' ) ],
+ [ 'testdir/File-Find-Rule.t' ],
"negating in the procedural interface" );
# grep
-is_deeply( [ find( maxdepth => 1, file => grep => [ qr/bytes./, [ qr/.?/ ] ], in => 't' ) ],
- [ 't/foobar' ],
+is_deeply( [ find( maxdepth => 1, file => grep => [ qr/bytes./, [ qr/.?/ ] ], in => 'testdir' ) ],
+ [ 'testdir/foobar' ],
"grep" );
# relative
-is_deeply( [ find( 'relative', maxdepth => 1, name => 'foobar', in => 't' ) ],
+is_deeply( [ find( 'relative', maxdepth => 1, name => 'foobar', in => 'testdir' ) ],
[ 'foobar' ],
'relative' );
@@ -293,7 +314,7 @@
# bootstrapping extensions via import
-use lib qw(t/lib);
+use lib qw(testdir/lib);
eval { $class->import(':Test::Elusive') };
like( $@, qr/^couldn't bootstrap File::Find::Rule::Test::Elusive/,
Modified: trunk/libfile-find-rule-perl/t/findrule.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-rule-perl/t/findrule.t?rev=47881&op=diff
==============================================================================
--- trunk/libfile-find-rule-perl/t/findrule.t (original)
+++ trunk/libfile-find-rule-perl/t/findrule.t Sat Nov 28 21:06:17 2009
@@ -9,27 +9,27 @@
[ sort split /\n/, `$^X -Iblib/lib -Iblib/arch findrule $expr 2>&1` ];
}
-is_deeply(run 't -file -name foobar', [ 't/foobar' ],
+is_deeply(run 'testdir -file -name foobar', [ 'testdir/foobar' ],
'-file -name foobar');
-is_deeply(run 't -maxdepth 0 -directory',
- [ 't' ], 'last clause has no args');
+is_deeply(run 'testdir -maxdepth 0 -directory',
+ [ 'testdir' ], 'last clause has no args');
{
local $TODO = "Win32 cmd.exe hurts my brane"
if ($^O =~ m/Win32/ || $^O eq 'dos');
- is_deeply(run 't -file -name \( foobar \*.t \)',
- [ qw( t/File-Find-Rule.t t/findrule.t t/foobar ) ],
+ is_deeply(run 'testdir -file -name \( foobar \*.t \)',
+ [ qw( testdir/File-Find-Rule.t testdir/findrule.t testdir/foobar ) ],
'grouping ()');
- is_deeply(run 't -name \( -foo foobar \)',
- [ 't/foobar' ], 'grouping ( -literal )');
+ is_deeply(run 'testdir -name \( -foo foobar \)',
+ [ 'testdir/foobar' ], 'grouping ( -literal )');
}
-is_deeply(run 't -file -name foobar baz',
+is_deeply(run 'testdir -file -name foobar baz',
[ "unknown option 'baz'" ], 'no implicit grouping');
-is_deeply(run 't -maxdepth 0 -name -file',
+is_deeply(run 'testdir -maxdepth 0 -name -file',
[], 'terminate at next -');
More information about the Pkg-perl-cvs-commits
mailing list