Author: twists
Date: Sat Jun 6 22:32:43 2009
New Revision: 757
Added:
trunk/t/31-env.t
Modified:
trunk/MANIFEST
trunk/lib/Devel/NYTProf/Core.pm
Log:
Test \ escape in NYPROF environment variable
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Sat Jun 6 22:32:43 2009
@@ -38,6 +38,7 @@
t/22-readstream-v20.out
t/22-readstream.t
t/30-util.t
+t/31-env.t
t/50-errno.t
t/80-version.t
t/90-pod.t
Modified: trunk/lib/Devel/NYTProf/Core.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Core.pm (original)
+++ trunk/lib/Devel/NYTProf/Core.pm Sat Jun 6 22:32:43 2009
@@ -21,6 +21,7 @@
if (my $NYTPROF = $ENV{NYTPROF}) {
for my $optval ( $NYTPROF =~ /((?:[^\\:]+|\\.)+)/g) {
my ($opt, $val) = $optval =~ /^((?:[^\\=]+|\\.)+)=((?:[^\\=]+|
\\.)+)\z/;
+ s/\\(.)/$1/g for $opt, $val;
DB::set_option($opt, $val);
}
}
Added: trunk/t/31-env.t
==============================================================================
--- (empty file)
+++ trunk/t/31-env.t Sat Jun 6 22:32:43 2009
@@ -0,0 +1,30 @@
+use Test::More;
+
+my @tests = (
+ [ 'start=no:file=nytprof.out' => { start => 'no', file
=> 'nytprof.out' } ],
+ [ 'start=no:file=nytprof\:out' => { start => 'no', file
=> 'nytprof:out' } ],
+ [ 'start=no:file=nytprof\=out' => { start => 'no', file
=> 'nytprof=out' } ],
+);
+
+plan( tests => 1 * @tests );
+for my $test ( @tests ) {
+ my ( $nytprof, $expected ) = @$test;
+
+ # Abrogate the XSLoader used to load the XS function DB::set_option.
+ local *XSLoader::load = sub {};
+
+ # Hook the function used to set options to capture it's parsing.
+ my %got;
+ local *DB::set_option = sub {
+ my ( $k, $v ) = @_;
+ $got{$k} = $v;
+ };
+
+ # Unload the class.
+ delete $INC{'Devel/NYTProf/Core.pm'};
+
+ # Test the class's parsing.
+ local $ENV{NYTPROF} = $nytprof;
+ require Devel::NYTProf::Core;
+ is_deeply( \%got, $expected, "Parsed \$ENV{NYTPROF}='$nytprof' ok" );
+}
\ No newline at end of file
--~--~---------~--~----~------------~-------~--~----~
You've received this message because you are subscribed to
the Devel::NYTProf Development User group.
Group hosted at: http://groups.google.com/group/develnytprof-dev
Project hosted at: http://perl-devel-nytprof.googlecode.com
CPAN distribution: http://search.cpan.org/dist/Devel-NYTProf
To post, email: [email protected]
To unsubscribe, email: [email protected]
-~----------~----~----~----~------~----~------~--~---
