[Bps-public-commit] r14753 - in Locale-Maketext-Lexicon: . inc inc/Test lib/Locale/Maketext

jesse at bestpractical.com jesse at bestpractical.com
Mon Aug 4 12:20:32 EDT 2008


Author: jesse
Date: Mon Aug  4 12:20:29 2008
New Revision: 14753

Added:
   Locale-Maketext-Lexicon/MANIFEST.SKIP
   Locale-Maketext-Lexicon/META.yml
   Locale-Maketext-Lexicon/inc/PerlIO.pm
Modified:
   Locale-Maketext-Lexicon/Changes
   Locale-Maketext-Lexicon/MANIFEST
   Locale-Maketext-Lexicon/Makefile.PL
   Locale-Maketext-Lexicon/inc/Test/Builder.pm
   Locale-Maketext-Lexicon/inc/Test/Builder/Module.pm
   Locale-Maketext-Lexicon/inc/Test/More.pm
   Locale-Maketext-Lexicon/inc/attributes.pm
   Locale-Maketext-Lexicon/lib/Locale/Maketext/Lexicon.pm

Log:
* 0.67 releng

Modified: Locale-Maketext-Lexicon/Changes
==============================================================================
--- Locale-Maketext-Lexicon/Changes	(original)
+++ Locale-Maketext-Lexicon/Changes	Mon Aug  4 12:20:29 2008
@@ -1,4 +1,4 @@
-[Changes for 0.67 - .........]
+[Changes for 0.67 - 2008-08-04]
 
 * Locale::Maketext::Extract: Support in Extract.pm and Lexicon/Gettext.pm
   for parsing and keeping user comments in PO files.

Modified: Locale-Maketext-Lexicon/MANIFEST
==============================================================================
--- Locale-Maketext-Lexicon/MANIFEST	(original)
+++ Locale-Maketext-Lexicon/MANIFEST	Mon Aug  4 12:20:29 2008
@@ -13,6 +13,7 @@
 inc/Module/Install/Scripts.pm
 inc/Module/Install/Win32.pm
 inc/Module/Install/WriteAll.pm
+inc/PerlIO.pm
 inc/Test/Builder.pm
 inc/Test/Builder/Module.pm
 inc/Test/More.pm
@@ -25,9 +26,11 @@
 lib/Locale/Maketext/Lexicon/Tie.pm
 Makefile.PL
 MANIFEST			This list of files
+MANIFEST.SKIP
 META.yml
 README
 script/xgettext.pl
+SIGNATURE
 t/1-basic.t
 t/2-lmg.t
 t/3-big-endian.t
@@ -36,6 +39,7 @@
 t/6-gettext.t
 t/7-comments.t
 t/99-bug-import-for-subclasses.t
+t/comments.po
 t/gencat.m
 t/locale/en/LC_MESSAGES/test.mo
 t/locale/en/LC_MESSAGES/test_be.mo
@@ -46,7 +50,6 @@
 t/locale/zh_TW/LC_MESSAGES/test.mo
 t/locale/zh_TW/LC_MESSAGES/test_be.mo
 t/locale/zh_TW/LC_MESSAGES/test_utf8.mo
-t/comments.po
 t/messages.mo
 t/messages.po
 t/T_L10N.pm

Added: Locale-Maketext-Lexicon/MANIFEST.SKIP
==============================================================================
--- (empty file)
+++ Locale-Maketext-Lexicon/MANIFEST.SKIP	Mon Aug  4 12:20:29 2008
@@ -0,0 +1,8 @@
+^.svn$
+.bak$
+.rej$
+~$
+.old$
+blib
+pm_to_blib
+^Makefile$

Added: Locale-Maketext-Lexicon/META.yml
==============================================================================
--- (empty file)
+++ Locale-Maketext-Lexicon/META.yml	Mon Aug  4 12:20:29 2008
@@ -0,0 +1,19 @@
+--- 
+abstract: Use other catalog formats in Maketext
+author: 
+  - Audrey Tang <cpan at audreyt.org>
+distribution_type: module
+generated_by: Module::Install version 0.68
+license: MIT
+meta-spec: 
+  url: http://module-build.sourceforge.net/META-spec-v1.3.html
+  version: 1.3
+name: Locale-Maketext-Lexicon
+no_index: 
+  directory: 
+    - inc
+    - t
+requires: 
+  Locale::Maketext: 0.01
+  perl: 5.004
+version: 0.67

Modified: Locale-Maketext-Lexicon/Makefile.PL
==============================================================================
--- Locale-Maketext-Lexicon/Makefile.PL	(original)
+++ Locale-Maketext-Lexicon/Makefile.PL	Mon Aug  4 12:20:29 2008
@@ -12,4 +12,4 @@
 requires        'Locale::Maketext' => '0.01';
 include_deps    'Test::More';
 
-sign; WriteAll;
+WriteAll( sign => 1, meta => 1);

Added: Locale-Maketext-Lexicon/inc/PerlIO.pm
==============================================================================
--- (empty file)
+++ Locale-Maketext-Lexicon/inc/PerlIO.pm	Mon Aug  4 12:20:29 2008
@@ -0,0 +1,33 @@
+#line 1
+package PerlIO;
+
+our $VERSION = '1.04';
+
+# Map layer name to package that defines it
+our %alias;
+
+sub import
+{
+ my $class = shift;
+ while (@_)
+  {
+   my $layer = shift;
+   if (exists $alias{$layer})
+    {
+     $layer = $alias{$layer}
+    }
+   else
+    {
+     $layer = "${class}::$layer";
+    }
+   eval "require $layer";
+   warn $@ if $@;
+  }
+}
+
+sub F_UTF8 () { 0x8000 }
+
+1;
+__END__
+
+#line 340

Modified: Locale-Maketext-Lexicon/inc/Test/Builder.pm
==============================================================================
--- Locale-Maketext-Lexicon/inc/Test/Builder.pm	(original)
+++ Locale-Maketext-Lexicon/inc/Test/Builder.pm	Mon Aug  4 12:20:29 2008
@@ -1,16 +1,11 @@
 #line 1
 package Test::Builder;
 
-use 5.004;
-
-# $^C was only introduced in 5.005-ish.  We do this to prevent
-# use of uninitialized value warnings in older perls.
-$^C ||= 0;
-
+use 5.006;
 use strict;
-use vars qw($VERSION);
-$VERSION = '0.74';
-$VERSION = eval $VERSION;    # make the alpha version come out as a number
+
+our $VERSION = '0.78';
+$VERSION = eval { $VERSION }; # make the alpha version come out as a number
 
 # Make Test::Builder thread-safe for ithreads.
 BEGIN {
@@ -67,7 +62,7 @@
 }
 
 
-#line 128
+#line 110
 
 my $Test = Test::Builder->new;
 sub new {
@@ -77,7 +72,7 @@
 }
 
 
-#line 150
+#line 132
 
 sub create {
     my $class = shift;
@@ -88,7 +83,7 @@
     return $self;
 }
 
-#line 169
+#line 151
 
 use vars qw($Level);
 
@@ -99,7 +94,6 @@
     # hash keys is just asking for pain.  Also, it was documented.
     $Level = 1;
 
-    $self->{Test_Died}    = 0;
     $self->{Have_Plan}    = 0;
     $self->{No_Plan}      = 0;
     $self->{Original_Pid} = $$;
@@ -118,23 +112,14 @@
     $self->{No_Header}  = 0;
     $self->{No_Ending}  = 0;
 
-    $self->_dup_stdhandles unless $^C;
-
-    return undef;
-}
-
-#line 221
+    $self->{TODO}       = undef;
 
-sub exported_to {
-    my($self, $pack) = @_;
+    $self->_dup_stdhandles unless $^C;
 
-    if( defined $pack ) {
-        $self->{Exported_To} = $pack;
-    }
-    return $self->{Exported_To};
+    return;
 }
 
-#line 243
+#line 207
 
 sub plan {
     my($self, $cmd, $arg) = @_;
@@ -173,7 +158,7 @@
     return 1;
 }
 
-#line 290
+#line 254
 
 sub expected_tests {
     my $self = shift;
@@ -192,7 +177,7 @@
 }
 
 
-#line 315
+#line 279
 
 sub no_plan {
     my $self = shift;
@@ -201,7 +186,7 @@
     $self->{Have_Plan} = 1;
 }
 
-#line 330
+#line 294
 
 sub has_plan {
     my $self = shift;
@@ -212,7 +197,7 @@
 };
 
 
-#line 348
+#line 312
 
 sub skip_all {
     my($self, $reason) = @_;
@@ -227,7 +212,19 @@
     exit(0);
 }
 
-#line 382
+
+#line 339
+
+sub exported_to {
+    my($self, $pack) = @_;
+
+    if( defined $pack ) {
+        $self->{Exported_To} = $pack;
+    }
+    return $self->{Exported_To};
+}
+
+#line 369
 
 sub ok {
     my($self, $test, $name) = @_;
@@ -249,9 +246,12 @@
     Very confusing.
 ERR
 
-    my($pack, $file, $line) = $self->caller;
+    my $todo = $self->todo();
+    
+    # Capture the value of $TODO for the rest of this ok() call
+    # so it can more easily be found by other routines.
+    local $self->{TODO} = $todo;
 
-    my $todo = $self->todo($pack);
     $self->_unoverload_str(\$todo);
 
     my $out;
@@ -296,13 +296,14 @@
         my $msg = $todo ? "Failed (TODO)" : "Failed";
         $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};
 
-	if( defined $name ) {
-	    $self->diag(qq[  $msg test '$name'\n]);
-	    $self->diag(qq[  at $file line $line.\n]);
-	}
-	else {
-	    $self->diag(qq[  $msg test at $file line $line.\n]);
-	}
+    my(undef, $file, $line) = $self->caller;
+        if( defined $name ) {
+            $self->diag(qq[  $msg test '$name'\n]);
+            $self->diag(qq[  at $file line $line.\n]);
+        }
+        else {
+            $self->diag(qq[  $msg test at $file line $line.\n]);
+        }
     } 
 
     return $test ? 1 : 0;
@@ -361,7 +362,7 @@
 
 
 
-#line 530
+#line 521
 
 sub is_eq {
     my($self, $got, $expect, $name) = @_;
@@ -418,6 +419,7 @@
         }
     }
 
+    local $Level = $Level + 1;
     return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
          got: %s
     expected: %s
@@ -425,7 +427,7 @@
 
 }    
 
-#line 608
+#line 600
 
 sub isnt_eq {
     my($self, $got, $dont_expect, $name) = @_;
@@ -460,7 +462,7 @@
 }
 
 
-#line 660
+#line 652
 
 sub like {
     my($self, $this, $regex, $name) = @_;
@@ -477,7 +479,7 @@
 }
 
 
-#line 685
+#line 677
 
 
 my %numeric_cmps = map { ($_, 1) } 
@@ -500,7 +502,8 @@
 
         my $code = $self->_caller_context;
 
-        # Yes, it has to look like this or 5.4.5 won't see the #line directive.
+        # Yes, it has to look like this or 5.4.5 won't see the #line 
+        # directive.
         # Don't ask me, man, I just work here.
         $test = eval "
 $code" . "\$got $type \$expect;";
@@ -525,6 +528,8 @@
     
     $got    = defined $got    ? "'$got'"    : 'undef';
     $expect = defined $expect ? "'$expect'" : 'undef';
+    
+    local $Level = $Level + 1;
     return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
     %s
         %s
@@ -544,7 +549,7 @@
     return $code;
 }
 
-#line 771
+#line 766
 
 sub BAIL_OUT {
     my($self, $reason) = @_;
@@ -554,12 +559,12 @@
     exit 255;
 }
 
-#line 784
+#line 779
 
 *BAILOUT = \&BAIL_OUT;
 
 
-#line 796
+#line 791
 
 sub skip {
     my($self, $why) = @_;
@@ -591,7 +596,7 @@
 }
 
 
-#line 838
+#line 833
 
 sub todo_skip {
     my($self, $why) = @_;
@@ -620,7 +625,7 @@
 }
 
 
-#line 916
+#line 911
 
 
 sub maybe_regex {
@@ -632,7 +637,7 @@
     my($re, $opts);
 
     # Check for qr/foo/
-    if( ref $regex eq 'Regexp' ) {
+    if( _is_qr($regex) ) {
         $usable_regex = $regex;
     }
     # Check for '/foo/' or 'm,foo,'
@@ -644,7 +649,18 @@
     }
 
     return $usable_regex;
-};
+}
+
+
+sub _is_qr {
+    my $regex = shift;
+    
+    # is_regexp() checks for regexes in a robust manner, say if they're
+    # blessed.
+    return re::is_regexp($regex) if defined &re::is_regexp;
+    return ref $regex eq 'Regexp';
+}
+
 
 sub _regex_ok {
     my($self, $this, $regex, $cmp, $name) = @_;
@@ -663,7 +679,8 @@
 
         local($@, $!, $SIG{__DIE__}); # isolate eval
 
-        # Yes, it has to look like this or 5.4.5 won't see the #line directive.
+        # Yes, it has to look like this or 5.4.5 won't see the #line 
+        # directive.
         # Don't ask me, man, I just work here.
         $test = eval "
 $code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
@@ -677,6 +694,8 @@
     unless( $ok ) {
         $this = defined $this ? "'$this'" : 'undef';
         my $match = $cmp eq '=~' ? "doesn't match" : "matches";
+
+        local $Level = $Level + 1;
         $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
                   %s
     %13s '%s'
@@ -691,7 +710,7 @@
 # I'm not ready to publish this.  It doesn't deal with array return
 # values from the code or context.
 
-#line 1000
+#line 1009
 
 sub _try {
     my($self, $code) = @_;
@@ -704,7 +723,7 @@
     return wantarray ? ($return, $@) : $return;
 }
 
-#line 1022
+#line 1031
 
 sub is_fh {
     my $self = shift;
@@ -720,7 +739,7 @@
 }
 
 
-#line 1067
+#line 1076
 
 sub level {
     my($self, $level) = @_;
@@ -732,7 +751,7 @@
 }
 
 
-#line 1100
+#line 1109
 
 sub use_numbers {
     my($self, $use_nums) = @_;
@@ -744,7 +763,7 @@
 }
 
 
-#line 1134
+#line 1143
 
 foreach my $attribute (qw(No_Header No_Ending No_Diag)) {
     my $method = lc $attribute;
@@ -758,12 +777,12 @@
         return $self->{$attribute};
     };
 
-    no strict 'refs';
+    no strict 'refs';   ## no critic
     *{__PACKAGE__.'::'.$method} = $code;
 }
 
 
-#line 1188
+#line 1197
 
 sub diag {
     my($self, @msgs) = @_;
@@ -790,7 +809,7 @@
     return 0;
 }
 
-#line 1225
+#line 1234
 
 sub _print {
     my($self, @msgs) = @_;
@@ -814,7 +833,7 @@
     print $fh $msg;
 }
 
-#line 1259
+#line 1268
 
 sub _print_diag {
     my $self = shift;
@@ -824,7 +843,7 @@
     print $fh @_;
 }    
 
-#line 1296
+#line 1305
 
 sub output {
     my($self, $fh) = @_;
@@ -863,10 +882,9 @@
         $fh = $file_or_fh;
     }
     else {
-        $fh = do { local *FH };
-        open $fh, ">$file_or_fh" or
+        open $fh, ">", $file_or_fh or
             $self->croak("Can't open test output log $file_or_fh: $!");
-	_autoflush($fh);
+        _autoflush($fh);
     }
 
     return $fh;
@@ -881,6 +899,7 @@
 }
 
 
+my($Testout, $Testerr);
 sub _dup_stdhandles {
     my $self = shift;
 
@@ -888,29 +907,47 @@
 
     # Set everything to unbuffered else plain prints to STDOUT will
     # come out in the wrong order from our own prints.
-    _autoflush(\*TESTOUT);
+    _autoflush($Testout);
     _autoflush(\*STDOUT);
-    _autoflush(\*TESTERR);
+    _autoflush($Testerr);
     _autoflush(\*STDERR);
 
-    $self->output(\*TESTOUT);
-    $self->failure_output(\*TESTERR);
-    $self->todo_output(\*TESTOUT);
+    $self->output        ($Testout);
+    $self->failure_output($Testerr);
+    $self->todo_output   ($Testout);
 }
 
 
 my $Opened_Testhandles = 0;
 sub _open_testhandles {
+    my $self = shift;
+    
     return if $Opened_Testhandles;
+    
     # We dup STDOUT and STDERR so people can change them in their
     # test suites while still getting normal test output.
-    open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT:  $!";
-    open(TESTERR, ">&STDERR") or die "Can't dup STDERR:  $!";
+    open( $Testout, ">&STDOUT") or die "Can't dup STDOUT:  $!";
+    open( $Testerr, ">&STDERR") or die "Can't dup STDERR:  $!";
+
+#    $self->_copy_io_layers( \*STDOUT, $Testout );
+#    $self->_copy_io_layers( \*STDERR, $Testerr );
+    
     $Opened_Testhandles = 1;
 }
 
 
-#line 1396
+sub _copy_io_layers {
+    my($self, $src, $dest) = @_;
+    
+    $self->_try(sub {
+        require PerlIO;
+        my @layers = PerlIO::get_layers($src);
+        
+        binmode $dest, join " ", map ":$_", @layers if @layers;
+    });
+}
+
+#line 1423
 
 sub _message_at_caller {
     my $self = shift;
@@ -939,7 +976,7 @@
     }
 }
 
-#line 1444
+#line 1471
 
 sub current_test {
     my($self, $num) = @_;
@@ -975,7 +1012,7 @@
 }
 
 
-#line 1489
+#line 1516
 
 sub summary {
     my($self) = shift;
@@ -983,27 +1020,29 @@
     return map { $_->{'ok'} } @{ $self->{Test_Results} };
 }
 
-#line 1544
+#line 1571
 
 sub details {
     my $self = shift;
     return @{ $self->{Test_Results} };
 }
 
-#line 1569
+#line 1597
 
 sub todo {
     my($self, $pack) = @_;
 
-    $pack = $pack || $self->exported_to || $self->caller($Level);
+    return $self->{TODO} if defined $self->{TODO};
+
+    $pack = $pack || $self->caller(1) || $self->exported_to;
     return 0 unless $pack;
 
-    no strict 'refs';
+    no strict 'refs';   ## no critic
     return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
                                      : 0;
 }
 
-#line 1590
+#line 1622
 
 sub caller {
     my($self, $height) = @_;
@@ -1013,9 +1052,9 @@
     return wantarray ? @caller : $caller[0];
 }
 
-#line 1602
+#line 1634
 
-#line 1616
+#line 1648
 
 #'#
 sub _sanity_check {
@@ -1028,7 +1067,7 @@
           'Somehow you got a different number of results than tests ran!');
 }
 
-#line 1637
+#line 1669
 
 sub _whoa {
     my($self, $check, $desc) = @_;
@@ -1041,7 +1080,7 @@
     }
 }
 
-#line 1659
+#line 1691
 
 sub _my_exit {
     $? = $_[0];
@@ -1050,37 +1089,29 @@
 }
 
 
-#line 1672
-
-$SIG{__DIE__} = sub {
-    # We don't want to muck with death in an eval, but $^S isn't
-    # totally reliable.  5.005_03 and 5.6.1 both do the wrong thing
-    # with it.  Instead, we use caller.  This also means it runs under
-    # 5.004!
-    my $in_eval = 0;
-    for( my $stack = 1;  my $sub = (CORE::caller($stack))[3];  $stack++ ) {
-        $in_eval = 1 if $sub =~ /^\(eval\)/;
-    }
-    $Test->{Test_Died} = 1 unless $in_eval;
-};
+#line 1704
 
 sub _ending {
     my $self = shift;
 
+    my $real_exit_code = $?;
     $self->_sanity_check();
 
     # Don't bother with an ending if this is a forked copy.  Only the parent
     # should do the ending.
+    if( $self->{Original_Pid} != $$ ) {
+        return;
+    }
+    
     # Exit if plan() was never called.  This is so "require Test::Simple" 
     # doesn't puke.
+    if( !$self->{Have_Plan} ) {
+        return;
+    }
+
     # Don't do an ending if we bailed out.
-    if( ($self->{Original_Pid} != $$) 			or
-	(!$self->{Have_Plan} && !$self->{Test_Died}) 	or
-	$self->{Bailed_Out}
-      )
-    {
-	_my_exit($?);
-	return;
+    if( $self->{Bailed_Out} ) {
+        return;
     }
 
     # Figure out if we passed or failed and print helpful messages.
@@ -1130,7 +1161,7 @@
 FAIL
         }
 
-        if( $self->{Test_Died} ) {
+        if( $real_exit_code ) {
             $self->diag(<<"FAIL");
 Looks like your test died just after $self->{Curr_Test}.
 FAIL
@@ -1154,7 +1185,7 @@
     elsif ( $self->{Skip_All} ) {
         _my_exit( 0 ) && return;
     }
-    elsif ( $self->{Test_Died} ) {
+    elsif ( $real_exit_code ) {
         $self->diag(<<'FAIL');
 Looks like your test died before it could output anything.
 FAIL
@@ -1170,6 +1201,6 @@
     $Test->_ending if defined $Test and !$Test->no_ending;
 }
 
-#line 1847
+#line 1871
 
 1;

Modified: Locale-Maketext-Lexicon/inc/Test/Builder/Module.pm
==============================================================================
--- Locale-Maketext-Lexicon/inc/Test/Builder/Module.pm	(original)
+++ Locale-Maketext-Lexicon/inc/Test/Builder/Module.pm	Mon Aug  4 12:20:29 2008
@@ -1,14 +1,14 @@
 #line 1
 package Test::Builder::Module;
 
+use strict;
+
 use Test::Builder;
 
 require Exporter;
- at ISA = qw(Exporter);
+our @ISA = qw(Exporter);
 
-$VERSION = '0.74';
-
-use strict;
+our $VERSION = '0.78';
 
 # 5.004's Exporter doesn't have export_to_level.
 my $_export_to_level = sub {
@@ -24,6 +24,9 @@
 
 sub import {
     my($class) = shift;
+    
+    # Don't run all this when loading ourself.
+    return 1 if $class eq 'Test::Builder::Module';
 
     my $test = $class->builder;
 
@@ -67,12 +70,12 @@
 }
 
 
-#line 144
+#line 147
 
 sub import_extra {}
 
 
-#line 175
+#line 178
 
 sub builder {
     return Test::Builder->new;

Modified: Locale-Maketext-Lexicon/inc/Test/More.pm
==============================================================================
--- Locale-Maketext-Lexicon/inc/Test/More.pm	(original)
+++ Locale-Maketext-Lexicon/inc/Test/More.pm	Mon Aug  4 12:20:29 2008
@@ -1,8 +1,7 @@
 #line 1
 package Test::More;
 
-use 5.004;
-
+use 5.006;
 use strict;
 
 
@@ -17,7 +16,7 @@
 
 
 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.74';
+$VERSION = '0.78';
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
 use Test::Builder::Module;
@@ -32,11 +31,11 @@
              plan
              can_ok  isa_ok
              diag
-	     BAIL_OUT
+             BAIL_OUT
             );
 
 
-#line 157
+#line 156
 
 sub plan {
     my $tb = Test::More->builder;
@@ -70,7 +69,7 @@
 }
 
 
-#line 257
+#line 256
 
 sub ok ($;$) {
     my($test, $name) = @_;
@@ -79,7 +78,7 @@
     $tb->ok($test, $name);
 }
 
-#line 324
+#line 323
 
 sub is ($$;$) {
     my $tb = Test::More->builder;
@@ -96,7 +95,7 @@
 *isn't = \&isnt;
 
 
-#line 369
+#line 368
 
 sub like ($$;$) {
     my $tb = Test::More->builder;
@@ -105,7 +104,7 @@
 }
 
 
-#line 385
+#line 384
 
 sub unlike ($$;$) {
     my $tb = Test::More->builder;
@@ -114,7 +113,7 @@
 }
 
 
-#line 425
+#line 424
 
 sub cmp_ok($$$;$) {
     my $tb = Test::More->builder;
@@ -123,7 +122,7 @@
 }
 
 
-#line 461
+#line 460
 
 sub can_ok ($@) {
     my($proto, @methods) = @_;
@@ -158,7 +157,7 @@
     return $ok;
 }
 
-#line 523
+#line 522
 
 sub isa_ok ($$;$) {
     my($object, $class, $obj_name) = @_;
@@ -212,7 +211,7 @@
 }
 
 
-#line 592
+#line 591
 
 sub pass (;$) {
     my $tb = Test::More->builder;
@@ -224,7 +223,7 @@
     $tb->ok(0, @_);
 }
 
-#line 653
+#line 652
 
 sub use_ok ($;@) {
     my($module, @imports) = @_;
@@ -233,30 +232,28 @@
 
     my($pack,$filename,$line) = caller;
 
-    # Work around a glitch in $@ and eval
-    my $eval_error;
-    {
-        local($@,$!,$SIG{__DIE__});   # isolate eval
-
-        if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
-            # probably a version check.  Perl needs to see the bare number
-            # for it to work with non-Exporter based modules.
-            eval <<USE;
+    my $code;
+    if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
+        # probably a version check.  Perl needs to see the bare number
+        # for it to work with non-Exporter based modules.
+        $code = <<USE;
 package $pack;
 use $module $imports[0];
+1;
 USE
-        }
-        else {
-            eval <<USE;
+    }
+    else {
+        $code = <<USE;
 package $pack;
-use $module \@imports;
+use $module \@{\$args[0]};
+1;
 USE
-        }
-        $eval_error = $@;
     }
 
-    my $ok = $tb->ok( !$eval_error, "use $module;" );
 
+    my($eval_result, $eval_error) = _eval($code, \@imports);
+    my $ok = $tb->ok( $eval_result, "use $module;" );
+    
     unless( $ok ) {
         chomp $eval_error;
         $@ =~ s{^BEGIN failed--compilation aborted at .*$}
@@ -271,7 +268,21 @@
     return $ok;
 }
 
-#line 707
+
+sub _eval {
+    my($code) = shift;
+    my @args = @_;
+
+    # Work around oddities surrounding resetting of $@ by immediately
+    # storing it.
+    local($@,$!,$SIG{__DIE__});   # isolate eval
+    my $eval_result = eval $code;
+    my $eval_error  = $@;
+
+    return($eval_result, $eval_error);
+}
+
+#line 718
 
 sub require_ok ($) {
     my($module) = shift;
@@ -283,20 +294,20 @@
     # Module names must be barewords, files not.
     $module = qq['$module'] unless _is_module_name($module);
 
-    local($!, $@, $SIG{__DIE__}); # isolate eval
-    local $SIG{__DIE__};
-    eval <<REQUIRE;
+    my $code = <<REQUIRE;
 package $pack;
 require $module;
+1;
 REQUIRE
 
-    my $ok = $tb->ok( !$@, "require $module;" );
+    my($eval_result, $eval_error) = _eval($code);
+    my $ok = $tb->ok( $eval_result, "require $module;" );
 
     unless( $ok ) {
-        chomp $@;
+        chomp $eval_error;
         $tb->diag(<<DIAGNOSTIC);
     Tried to require '$module'.
-    Error:  $@
+    Error:  $eval_error
 DIAGNOSTIC
 
     }
@@ -315,7 +326,7 @@
     $module =~ /^[a-zA-Z]\w*$/;
 }
 
-#line 784
+#line 795
 
 use vars qw(@Data_Stack %Refs_Seen);
 my $DNE = bless [], 'Does::Not::Exist';
@@ -422,7 +433,7 @@
     return '';
 }
 
-#line 930
+#line 941
 
 sub diag {
     my $tb = Test::More->builder;
@@ -431,7 +442,7 @@
 }
 
 
-#line 999
+#line 1010
 
 #'#
 sub skip {
@@ -459,7 +470,7 @@
 }
 
 
-#line 1086
+#line 1097
 
 sub todo_skip {
     my($why, $how_many) = @_;
@@ -480,7 +491,7 @@
     last TODO;
 }
 
-#line 1139
+#line 1150
 
 sub BAIL_OUT {
     my $reason = shift;
@@ -489,7 +500,7 @@
     $tb->BAIL_OUT($reason);
 }
 
-#line 1178
+#line 1189
 
 #'#
 sub eq_array {
@@ -613,7 +624,7 @@
 }
 
 
-#line 1309
+#line 1320
 
 sub eq_hash {
     local @Data_Stack;
@@ -646,7 +657,7 @@
     return $ok;
 }
 
-#line 1366
+#line 1377
 
 sub eq_set  {
     my($a1, $a2) = @_;
@@ -672,6 +683,6 @@
     );
 }
 
-#line 1556
+#line 1567
 
 1;

Modified: Locale-Maketext-Lexicon/inc/attributes.pm
==============================================================================
--- Locale-Maketext-Lexicon/inc/attributes.pm	(original)
+++ Locale-Maketext-Lexicon/inc/attributes.pm	Mon Aug  4 12:20:29 2008
@@ -1,7 +1,7 @@
 #line 1
 package attributes;
 
-our $VERSION = 0.08;
+our $VERSION = 0.06;
 
 @EXPORT_OK = qw(get reftype);
 @EXPORT = ();
@@ -24,6 +24,7 @@
 #sub _fetch_attrs ($) ;
 #sub _guess_stash ($) ;
 #sub _modify_attrs ;
+#sub _warn_reserved () ;
 #
 # The extra trips through newATTRSUB in the interpreter wipe out any savings
 # from avoiding the BEGIN block.  Just do the bootstrap now.
@@ -43,10 +44,9 @@
     my @badattrs;
     if ($pkgmeth) {
 	my @pkgattrs = _modify_attrs($svref, @attrs);
-	@badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs);
+	@badattrs = $pkgmeth->($home_stash, $svref, @attrs);
 	if (!@badattrs && @pkgattrs) {
-            require warnings;
-	    return unless warnings::enabled('reserved');
+	    return unless _warn_reserved;
 	    @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs;
 	    if (@pkgattrs) {
 		for my $attr (@pkgattrs) {

Modified: Locale-Maketext-Lexicon/lib/Locale/Maketext/Lexicon.pm
==============================================================================
--- Locale-Maketext-Lexicon/lib/Locale/Maketext/Lexicon.pm	(original)
+++ Locale-Maketext-Lexicon/lib/Locale/Maketext/Lexicon.pm	Mon Aug  4 12:20:29 2008
@@ -1,5 +1,5 @@
 package Locale::Maketext::Lexicon;
-$Locale::Maketext::Lexicon::VERSION = '0.66';
+$Locale::Maketext::Lexicon::VERSION = '0.67';
 
 use 5.004;
 use strict;
@@ -10,8 +10,8 @@
 
 =head1 VERSION
 
-This document describes version 0.66 of Locale::Maketext::Lexicon,
-released February 12, 2008.
+This document describes version 0.67 of Locale::Maketext::Lexicon,
+released August 4, 2008.
 
 =head1 SYNOPSIS
 



More information about the Bps-public-commit mailing list