In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/f78966ffb0f47ffdd7e0bb07b422308709bd39ae?hp=96d268e2f48e69b4cb65326df6690ffc21120f3c>

- Log -----------------------------------------------------------------
commit f78966ffb0f47ffdd7e0bb07b422308709bd39ae
Author: Chris 'BinGOs' Williams <[email protected]>
Date:   Thu Mar 7 19:31:01 2013 +0000

    Update perlfaq to CPAN version 5.0150042
    
      [DELTA]
    
      5.0150042 Wed  6 Mar 2013 14:37:08 +0100
        * Fix dodgy link as reports in #114260 of cpan RT (ranguard)
        * Hex typo (Martin Becker)
        * Typo (joaquinferrero)

M       Porting/Maintainers.pl
M       cpan/perlfaq/lib/perlfaq.pm
M       cpan/perlfaq/lib/perlfaq2.pod
M       cpan/perlfaq/lib/perlglossary.pod

commit b2a8d771f2f5721aa711c6ecdb42fdc198bfd244
Author: John Peacock <[email protected]>
Date:   Wed Mar 6 19:22:26 2013 -0500

    Bring core up to version-0.9902
    
    The attached patch bring the core Perl version code (including a fairly
    significant leak when run in a tight loop) up to parity with CPAN
    0.9902.  This deals with all open issues except:
    
       https://rt.cpan.org/Ticket/Display.html?id=81294
    
    which I am having a hard time modeling.
    
    John
    
    Signed-off-by: Chris 'BinGOs' Williams <[email protected]>

M       lib/version.pm
M       lib/version/t/01base.t
M       lib/version/t/02derived.t
M       lib/version/t/03require.t
M       lib/version/t/05sigdie.t
M       lib/version/t/06noop.t
M       lib/version/t/07locale.t
M       universal.c
M       util.c
-----------------------------------------------------------------------

Summary of changes:
 Porting/Maintainers.pl            |    2 +-
 cpan/perlfaq/lib/perlfaq.pm       |    2 +-
 cpan/perlfaq/lib/perlfaq2.pod     |    2 +-
 cpan/perlfaq/lib/perlglossary.pod |    6 +++---
 lib/version.pm                    |    2 +-
 lib/version/t/01base.t            |   14 +++++++++++++-
 lib/version/t/02derived.t         |    2 +-
 lib/version/t/03require.t         |    2 +-
 lib/version/t/05sigdie.t          |    2 +-
 lib/version/t/06noop.t            |    2 +-
 lib/version/t/07locale.t          |    2 +-
 universal.c                       |    2 +-
 util.c                            |   28 ++++++++++++++++------------
 13 files changed, 42 insertions(+), 26 deletions(-)

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 9be46bc..d8a1dcc 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -775,7 +775,7 @@ use File::Glob qw(:case);
 
     'perlfaq' => {
         'MAINTAINER'   => 'perlfaq',
-        'DISTRIBUTION' => 'LLAP/perlfaq-5.0150041.tar.gz',
+        'DISTRIBUTION' => 'LLAP/perlfaq-5.0150042.tar.gz',
         'FILES'        => q[cpan/perlfaq],
         'EXCLUDED'     => [
             qw( t/release-pod-syntax.t
diff --git a/cpan/perlfaq/lib/perlfaq.pm b/cpan/perlfaq/lib/perlfaq.pm
index bbd176c..976b525 100644
--- a/cpan/perlfaq/lib/perlfaq.pm
+++ b/cpan/perlfaq/lib/perlfaq.pm
@@ -1,6 +1,6 @@
 package perlfaq;
 {
-  $perlfaq::VERSION = '5.0150041';
+  $perlfaq::VERSION = '5.0150042';
 }
 
 0; # not is it supposed to be loaded
diff --git a/cpan/perlfaq/lib/perlfaq2.pod b/cpan/perlfaq/lib/perlfaq2.pod
index e890cc3..ce7cd1b 100644
--- a/cpan/perlfaq/lib/perlfaq2.pod
+++ b/cpan/perlfaq/lib/perlfaq2.pod
@@ -151,7 +151,7 @@ Perl user group.
 
 CPAN, or the Comprehensive Perl Archive Network L<http://www.cpan.org/>,
 is a replicated, worldwide repository of Perl software.
-See L<What is CPAN?|/"What modules and extensions are available for Perl? What 
is CPAN? What does CPANE<sol>srcE<sol>... mean?">.
+See L<What is CPAN?|/"What modules and extensions are available for Perl? What 
is CPAN?">.
 
 =head2 Where can I post questions?
 
diff --git a/cpan/perlfaq/lib/perlglossary.pod 
b/cpan/perlfaq/lib/perlglossary.pod
index c173def..6d6f280 100644
--- a/cpan/perlfaq/lib/perlglossary.pod
+++ b/cpan/perlfaq/lib/perlglossary.pod
@@ -89,8 +89,8 @@ name so people don’t realize they are using a program.
 
 =item architecture
 
-The kind of X<architecture>computer you’re working on, where one “kind” 
of
-computer means all those computers sharing a compatible machine language.
+The kind of X<architecture>computer you’re working on, where one “kind of
+computer” means all those computers sharing a compatible machine language.
 Since Perl programs are (typically) simple text files, not executable
 images, a Perl program is much less sensitive to the architecture it’s
 running on than programs in other languages, such as C, that are B<compiled>
@@ -1495,7 +1495,7 @@ it’s just a fancy form of quoting.
 =item hexadecimal
 
 A X<hexadecimals>number in base 16, “hex” for short. The digits for 10
-through 16 are customarily represented by the letters C<a> through C<f>.
+through 15 are customarily represented by the letters C<a> through C<f>.
 Hexadecimal constants in Perl start with C<0x>. See also the C<hex>
 function in Camel chapter 27, “Functions”.
 
diff --git a/lib/version.pm b/lib/version.pm
index 286dc79..27774bd 100644
--- a/lib/version.pm
+++ b/lib/version.pm
@@ -6,7 +6,7 @@ use strict;
 
 use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
 
-$VERSION = 0.9901;
+$VERSION = 0.9902;
 
 $CLASS = 'version';
 
diff --git a/lib/version/t/01base.t b/lib/version/t/01base.t
index c84531d..9aa8052 100644
--- a/lib/version/t/01base.t
+++ b/lib/version/t/01base.t
@@ -9,7 +9,7 @@ use Test::More qw/no_plan/;
 BEGIN {
     (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm';
     require $coretests;
-    use_ok('version', 0.9901);
+    use_ok('version', 0.9902);
 }
 
 diag "Tests with base class" unless $ENV{PERL_CORE};
@@ -32,3 +32,15 @@ my $v = eval {
     return IO::Handle->VERSION;
 };
 ok defined($v), 'Fix for RT #47980';
+
+{ # https://rt.cpan.org/Ticket/Display.html?id=81085
+    eval { version::new() };
+    like $@, qr'Usage: version::new\(class, version\)',
+       'No bus err when called as function';
+    eval { $x = 1; print version::new };
+    like $@, qr'Usage: version::new\(class, version\)',
+       'No implicit object creation when called as function';
+    eval { $x = "version"; print version::new };
+    like $@, qr'Usage: version::new\(class, version\)',
+       'No implicit object creation when called as function';
+}
diff --git a/lib/version/t/02derived.t b/lib/version/t/02derived.t
index ea683a9..c7afe0f 100644
--- a/lib/version/t/02derived.t
+++ b/lib/version/t/02derived.t
@@ -10,7 +10,7 @@ use File::Temp qw/tempfile/;
 BEGIN {
     (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm';
     require $coretests;
-    use_ok("version", 0.9901);
+    use_ok("version", 0.9902);
     # If we made it this far, we are ok.
 }
 
diff --git a/lib/version/t/03require.t b/lib/version/t/03require.t
index 3d99cb1..66c6bd3 100644
--- a/lib/version/t/03require.t
+++ b/lib/version/t/03require.t
@@ -14,7 +14,7 @@ BEGIN {
 # Don't want to use, because we need to make sure that the import doesn't
 # fire just yet (some code does this to avoid importing qv() and delare()).
 require_ok("version");
-is $version::VERSION, 0.9901, "Make sure we have the correct class";
+is $version::VERSION, 0.9902, "Make sure we have the correct class";
 ok(!"main"->can("qv"), "We don't have the imported qv()");
 ok(!"main"->can("declare"), "We don't have the imported declare()");
 
diff --git a/lib/version/t/05sigdie.t b/lib/version/t/05sigdie.t
index dd785d5..188f185 100644
--- a/lib/version/t/05sigdie.t
+++ b/lib/version/t/05sigdie.t
@@ -15,7 +15,7 @@ BEGIN {
 
 
 BEGIN {
-    use version 0.9901;
+    use version 0.9902;
 }
 
 pass "Didn't get caught by the wrong DIE handler, which is a good thing";
diff --git a/lib/version/t/06noop.t b/lib/version/t/06noop.t
index ff556ad..9d113ed 100644
--- a/lib/version/t/06noop.t
+++ b/lib/version/t/06noop.t
@@ -7,7 +7,7 @@
 use Test::More qw/no_plan/;
 
 BEGIN {
-    use_ok('version', 0.9901);
+    use_ok('version', 0.9902);
 }
 
 my $v1 = version->new('1.2');
diff --git a/lib/version/t/07locale.t b/lib/version/t/07locale.t
index a2005f8..3b67f3d 100644
--- a/lib/version/t/07locale.t
+++ b/lib/version/t/07locale.t
@@ -11,7 +11,7 @@ use Test::More tests => 7;
 use Config;
 
 BEGIN {
-    use_ok('version', 0.9901);
+    use_ok('version', 0.9902);
 }
 
 SKIP: {
diff --git a/universal.c b/universal.c
index f583817..a72c072 100644
--- a/universal.c
+++ b/universal.c
@@ -490,7 +490,7 @@ XS(XS_version_new)
 {
     dVAR;
     dXSARGS;
-    if (items > 3)
+    if (items > 3 || items < 1)
        croak_xs_usage(cv, "class, version");
     SP -= items;
     {
diff --git a/util.c b/util.c
index a3fbd3c..2c745bf 100644
--- a/util.c
+++ b/util.c
@@ -4500,7 +4500,7 @@ it doesn't.
 const char *
 Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
 {
-    const char *start;
+    const char *start = s;
     const char *pos;
     const char *last;
     const char *errstr = NULL;
@@ -4508,17 +4508,11 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     int width = 3;
     bool alpha = FALSE;
     bool vinf = FALSE;
-    AV * const av = newAV();
-    SV * const hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV 
*/
+    AV * av;
+    SV * hv;
 
     PERL_ARGS_ASSERT_SCAN_VERSION;
 
-    (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
-
-#ifndef NODEFAULT_SHAREKEYS
-    HvSHAREKEYS_on(hv);         /* key-sharing on by default */
-#endif
-
     while (isSPACE(*s)) /* leading whitespace is OK */
        s++;
 
@@ -4526,6 +4520,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     if (errstr) {
        /* "undef" is a special case and not an error */
        if ( ! ( *s == 'u' && strEQ(s,"undef")) ) {
+           Safefree(start);
            Perl_croak(aTHX_ "%s", errstr);
        }
     }
@@ -4535,13 +4530,22 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
        s++;
     pos = s;
 
+    /* Now that we are through the prescan, start creating the object */
+    av = newAV();
+    hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
+    (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
+
+#ifndef NODEFAULT_SHAREKEYS
+    HvSHAREKEYS_on(hv);         /* key-sharing on by default */
+#endif
+
     if ( qv )
        (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(qv));
     if ( alpha )
        (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(alpha));
     if ( !qv && width < 3 )
        (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
-    
+
     while (isDIGIT(*pos))
        pos++;
     if (!isALPHA(*pos)) {
@@ -4712,7 +4716,7 @@ Perl_new_version(pTHX_ SV *ver)
 
        if ( hv_exists(MUTABLE_HV(ver), "alpha", 5) )
            (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(1));
-       
+
        if ( hv_exists(MUTABLE_HV(ver), "width", 5 ) )
        {
            const I32 width = SvIV(*hv_fetchs(MUTABLE_HV(ver), "width", FALSE));
@@ -4846,7 +4850,7 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
                    }
 
                    /* is definitely a v-string */
-                   if ( saw_decimal >= 2 ) {   
+                   if ( saw_decimal >= 2 ) {
                        Safefree(version);
                        version = nver;
                    }

--
Perl5 Master Repository

Reply via email to