Merge branch 'corpus'

Adopt official SemVer regular expressions

Thanks to @jwdonahue for pointing me to it in theory/pg-semver#46. Adopted
here for strict parsing, and modified it for the lenient parsing of
`declare()` and `parse()` (which allow a single integer or a decimal number
version). Resolves #11 and closes #10.

5 files changed, 213 insertions, 93 deletions

diff --git a/Changes b/Changes
index fc173c3..f38a336 100644
--- a/Changes
+++ b/Changes
@@ -1,9 +1,27 @@
 Revision history for Perl extension SemVer.
 
+0.10.0
+      - Adopted the official regular expression from the SemVer FAQ for strict
+        parsing by new(), as well as a modification of that regex for the more
+        lenient cases supported by declare() and new(). This results in the
+        following changes in the behavior of the parser:
+        +   SemVers with build metadata but no prerelease are now valid, e.g.
+            `1.1.2+meta`
+        +   SemVers with a numeric-only prerelease part are no longer valid
+            if that part has a leading zero, e.g., `1.2.3-123` is valid but
+            `1.2.3-0123` is not
+        +   Restored support for prerelease and build metadata parts are in
+            declare() and parse()
+      - Added tests for the official SemVer test corpus as linked under the
+        FAQ about an official regular expression:
+        https://semver.org/#is-there-a-suggested-regular-expression-regex-to-check-a-semver-string
+      - Added explicit boolean overloading to ensure consistent behavior
+        between different implementations of the version parent class.
+
 0.7.0  2018-07-24T11:09:17Z
-	- Implemented Semantic Versioning 2.0.0 specification
-	- Updated tests for Semantic Versioning 2.0.0
-	- added testing for Perl 5.24, 5.26, 5.28
+      - Implemented Semantic Versioning 2.0.0 specification
+      - Updated tests for Semantic Versioning 2.0.0
+      - added testing for Perl 5.24, 5.26, 5.28
 
 0.6.0  2015-01-23T05:07:58Z
       - Removed tests that fail on version.pm 0.9910 and higher due to
@@ -31,7 +49,7 @@ Revision history for Perl extension SemVer.
 0.3.0  2011-05-26T04:54:50
       - Made leading zeros, such as the "04" in "1.04.3" illegal when parsing
         via `new()`.
-      - Eliminted "Use of qw(...) as parentheses is deprecated" in the tests
+      - Eliminated "Use of qw(...) as parentheses is deprecated" in the tests
         when running on Perl 5.14.
 
 0.2.0  2010-09-17T17:59:57
diff --git a/README.md b/README.md
index a6a1438..828737a 100644
--- a/README.md
+++ b/README.md
@@ -1,5 +1,5 @@
-SemVer version 0.7.0
-====================
+SemVer version 0.10.0
+=====================
 
 This module subclasses [`version`] to create semantic versions, as defined by
 the [Semantic Versioning 2.0.0 Specification]
diff --git a/lib/SemVer.pm b/lib/SemVer.pm
index 97cc321..9a7f3c9 100644
--- a/lib/SemVer.pm
+++ b/lib/SemVer.pm
@@ -9,30 +9,17 @@ use overload (
     '""'   => 'stringify',
     '<=>'  => 'vcmp',
     'cmp'  => 'vcmp',
+    'bool' => 'vbool',
 );
 
 our @ISA = qw(version);
-our $VERSION = '0.7.0'; # For Module::Build
+our $VERSION = '0.10.0'; # For Module::Build
 
 sub _die { require Carp; Carp::croak(@_) }
 
 # Prevent version.pm from mucking with our internals.
 sub import {}
 
-# Adapted from version.pm.
-my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/;
-my $DOT_SEPARATOR = qr/\./;
-my $PLUS_SEPARATOR = qr/\+/;
-my $DASH_SEPARATOR = qr/-/;
-my $STRICT_DOTTED_INTEGER_PART = qr/$DOT_SEPARATOR$STRICT_INTEGER_PART/;
-my $STRICT_DOTTED_INTEGER_VERSION = qr/ $STRICT_INTEGER_PART $STRICT_DOTTED_INTEGER_PART{2,} /x;
-my $IDENTIFIER = qr/[-0-9A-Za-z]+/;
-my $DOTTED_IDENTIFIER = qr/(?:$DOT_SEPARATOR$IDENTIFIER)*/;
-my $PRERELEASE = qr/$IDENTIFIER$DOTTED_IDENTIFIER/;
-my $METADATA = qr/$IDENTIFIER$DOTTED_IDENTIFIER/;
-
-my $OPTIONAL_EXTRA_PART = qr/$PRERELEASE($PLUS_SEPARATOR$METADATA)?/;
-
 sub new {
     my ($class, $ival) = @_;
 
@@ -43,71 +30,64 @@ sub new {
     if (eval { $ival->isa('version') }) {
         my $self = $class->SUPER::new($ival);
         $self->{extra} = $ival->{extra};
-        $self->{dash}  = $ival->{dash};
-        $self->_evalPreRelease($self->{extra});
+        $self->{patch} = $ival->{patch};
+        $self->{prerelease} = $ival->{prerelease};
         return $self;
     }
 
-    my ($val, $dash, $extra) = (
-        $ival =~ /^v?($STRICT_DOTTED_INTEGER_VERSION)(?:($DASH_SEPARATOR)($OPTIONAL_EXTRA_PART))?$/
+    # Regex taken from https://semver.org/#is-there-a-suggested-regular-expression-regex-to-check-a-semver-string.
+    my ($major, $minor, $patch, $prerelease, $meta) = (
+        $ival =~ /^v?(0|[1-9]\d*)\.(0|[1-9]\d*)\.(0|[1-9]\d*)(?:-((?:0|[1-9]\d*|\d*[a-zA-Z-][0-9a-zA-Z-]*)(?:\.(?:0|[1-9]\d*|\d*[a-zA-Z-][0-9a-zA-Z-]*))*))?(?:\+([0-9a-zA-Z-]+(?:\.[0-9a-zA-Z-]+)*))?$/
     );
     _die qq{Invalid semantic version string format: "$ival"}
-        unless defined $val;
+        unless defined $major;
 
-    my $self = $class->SUPER::new($val);
-    $self->{dash}  = $dash;
-    $self->{extra} = $extra;
-    $self->_evalPreRelease($self->{extra});
-
-    return $self;
+    return _init($class->SUPER::new("$major.$minor.$patch"), $prerelease, $meta);
 }
 
-# Internal function to split up given string into prerelease- and patch-components
-sub _evalPreRelease {
-    no warnings 'uninitialized';
-    my $self = shift;
-    my $v = shift;
-    my ($preRelease, $plus, $patch) = (
-       $v =~ /^($PRERELEASE)(?:($PLUS_SEPARATOR)($METADATA))?$/
-    );
-    @{$self->{prerelease}} = split $DOT_SEPARATOR,$preRelease;
-    $self->{plus} = $plus;
-    @{$self->{patch}} = (split $DOT_SEPARATOR, $patch || undef);
-    return;
+sub _init {
+    my ($self, $pre, $meta) = @_;
+    if (defined $pre) {
+        $self->{extra} = "-$pre";
+        @{$self->{prerelease}} = split /[.]/, $pre;
+    }
+    if (defined $meta) {
+        $self->{extra} .= "+$meta";
+        @{$self->{patch}} = split /[.]/, $meta;
+    }
+
+    return $self;
 }
 
 $VERSION = __PACKAGE__->new($VERSION); # For ourselves.
 
-sub declare {
-    my ($class, $ival) = @_;
+sub _lenient {
+    my ($class, $ctor, $ival) = @_;
     return $class->new($ival) if Scalar::Util::isvstring($ival)
         or eval { $ival->isa('version') };
 
-    (my $v = $ival) =~ s/^v?$STRICT_DOTTED_INTEGER_VERSION(?:($DASH_SEPARATOR)($OPTIONAL_EXTRA_PART))[[:space:]]*$//;
-    my $dash  = $1;
-    my $extra = $2;
-    $v += 0 if $v =~ s/_//g; # ignore underscores.
-    my $self = $class->SUPER::declare($v);
-    $self->{dash}  = $dash;
-    $self->{extra} = $extra;
-    $self->_evalPreRelease($self->{extra});
-    return $self;
+    # Use official regex for prerelease and meta, use more lenient version num matching and whitespace.
+    my ($v, $prerelease, $meta) = (
+        $ival =~ /^[[:space:]]*
+            v?([\d_]+(?:\.[\d_]+(?:\.[\d_]+)?)?)
+            (?:-((?:0|[1-9]\d*|\d*[a-zA-Z-][0-9a-zA-Z-]*)(?:\.(?:0|[1-9]\d*|\d*[a-zA-Z-][0-9a-zA-Z-]*))*))?(?:\+([0-9a-zA-Z-]+(?:\.[0-9a-zA-Z-]+)*))?
+        [[:space:]]*$/x
+    );
+
+    _die qq{Invalid semantic version string format: "$ival"}
+        unless defined $v;
+
+    $v += 0 if $v && $v =~ s/_//g; # ignore underscores.
+    my $code = $class->can("SUPER::$ctor");
+    return _init($code->($class, $v), $prerelease, $meta);
 }
 
-sub parse {
-    my ($class, $ival) = @_;
-    return $class->new($ival) if Scalar::Util::isvstring($ival)
-        or eval { $ival->isa('version') };
+sub declare {
+    shift->_lenient('declare', @_);
+}
 
-    (my $v = $ival) =~ s/^v?$STRICT_DOTTED_INTEGER_VERSION(?:($DASH_SEPARATOR)($OPTIONAL_EXTRA_PART))[[:space:]]*$//;
-    my $dash  = $1;
-    my $extra = $2;
-    $v += 0 if $v =~ s/_//g; # ignore underscores.
-    my $self = $class->SUPER::parse($v);
-    $self->{dash}  = $dash;
-    $self->{extra} = $extra;
-    $self->_evalPreRelease($self->{extra});
-    return $self;
+sub parse {
+    shift->_lenient('parse', @_);
 }
 
 sub stringify {
@@ -122,12 +102,15 @@ sub normal   {
     my $self = shift;
     (my $norm = $self->SUPER::normal) =~ s/^v//;
     $norm =~ s/_/./g;
-    return $norm . ($self->{extra} ? "-$self->{extra}" : '');
+    return $norm . ($self->{extra} || '');
 }
 
 sub numify   { _die 'Semantic versions cannot be numified'; }
 sub is_alpha { !!shift->{extra} }
-
+sub vbool {
+    my $self = shift;
+    return version::vcmp($self, $self->declare("0.0.0"), 1);
+}
 
 # Sort Ordering:
 # Precedence refers to how versions are compared to each other when ordered. Precedence MUST be calculated by
@@ -283,7 +266,7 @@ shown as returned by C<normal()>:
   '  012.2.2' | <error>  | 12.2.2      | 12.2.2
   '1.1'       | <error>  | 1.1.0       | 1.100.0
    1.1        | <error>  | 1.1.0       | 1.100.0
-  '1.1.0b1'   | <error>  | 1.1.0-b1    | 1.1.0-b1
+  '1.1.0-b1'  | 1.1.0-b1 | 1.1.0-b1    | 1.1.0-b1
   '1.1-b1'    | <error>  | 1.1.0-b1    | 1.100.0-b1
   '1.2.b1'    | <error>  | 1.2.0-b1    | 1.2.0-b1
   '9.0-beta4' | <error>  | 9.0.0-beta4 | 9.0.0-beta4
@@ -378,6 +361,14 @@ Returns true if an ASCII string is appended to the end of the version string.
 This also means that the version number is a "special version", in the
 semantic versioning specification meaning of the phrase.
 
+=head3 C<vbool>
+
+  say "Version $semver" if $semver;
+  say "Not a $semver" if !$semver;
+
+Returns true for a non-zero semantic semantic version object, without regard
+to the prerelease or build metadata parts. Overload boolean operations.
+
 =head3 C<vcmp>
 
 Compares the semantic version object to another version object or string and
diff --git a/t/base.t b/t/base.t
index 17a4e3c..b0d3812 100644
--- a/t/base.t
+++ b/t/base.t
@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-use Test::More tests => 610;
+use Test::More tests => 666;
 #use Test::More 'no_plan';
 
 use FindBin qw($Bin);
@@ -29,7 +29,6 @@ can_ok $CLASS, qw(
 # Try the basics.
 isa_ok my $version = $CLASS->new('0.1.0'), $CLASS, 'An instance';
 isa_ok $SemVer::VERSION, $CLASS, q{SemVer's own $VERSION};
-my $is_vpp = !!grep { $_ eq 'version::vpp' } @version::ISA;
 
 for my $v (qw(
     1.2.2
@@ -45,19 +44,16 @@ for my $v (qw(
     v1.2.2
     999993333.0.0
 )) {
-    isa_ok my $semver =$CLASS->new($v), $CLASS, "new($v)";
+    isa_ok my $semver = $CLASS->new($v), $CLASS, "new($v)";
     my $str = $v =~ /^v/ ? substr $v, 1 : $v;
     is "$semver", $str, qq{$v should stringify to "$str"};
     $str =~ s/(\d)([a-z].+)$/$1-$2/;
     is $semver->normal, $str, qq{$v should normalize to "$str"};
 
-    SKIP: {
-        skip 'Boolean comparison broken with version::vpp', 1, $is_vpp;
-        if ($v =~ /0\.0\.0/) {
-            ok !$semver, "$v should be false";
-        } else {
-            ok !!$semver, "$v should be true";
-        }
+    if ($v =~ /0\.0\.0/) {
+        ok !$semver, "$v should be false";
+    } else {
+        ok !!$semver, "$v should be true";
     }
 
     ok $semver->is_qv, "$v should be dotted-decimal";
@@ -224,21 +220,27 @@ for my $v (qw(
     cmp_ok $v, 'eq', $semver, qq{"$v" eq $semver};
 }
 
+# Tweak tweak v prefix regex? Some versions of version:vpp do it differently.
+my $vq = qr/^\d+[.][^.]+$/;
+if ($CLASS->declare('0')->stringify eq 'v0') {
+    $vq = qr/^\d+([.]?[^.]+)?$/;
+}
+
 # Test declare() and parse.
 for my $spec (
     ['1.2.2',          '1.2.2'],
     ['01.2.2',         '1.2.2'],
     ['1.02.2',         '1.2.2'],
     ['1.2.02',         '1.2.2'],
-#    ['1.2.02b',        '1.2.2-b'],
-#    ['1.2.02beta-3  ', '1.2.2-beta-3'],
-#    ['1.02.02rc1',     '1.2.2-rc1'],
+    ['1.2.02-b',       '1.2.2-b'],
+    ['1.2.02-beta-3 ', '1.2.2-beta-3'],
+    ['1.02.02-rc1',    '1.2.2-rc1'],
     ['1.0',            '1.0.0'],
     ['1.1',            '1.1.0',   '1.100.0'],
     [ 1.1,             '1.1.0',   '1.100.0'],
-#    ['1.1b1',          '1.1.0-b1', '1.100.0-b1'],
-#    ['1b',             '1.0.0-b'],
-#    ['9.0beta4',       '9.0.0-beta4'],
+    ['1.1-b1',         '1.1.0-b1', '1.100.0-b1'],
+    ['1-b',            '1.0.0-b'],
+    ['9.0-beta4',      '9.0.0-beta4'],
     ['  012.2.2',      '12.2.2'],
     ['99999998',       '99999998.0.0'],
     ['1.02_30',        '1.23.0'],
@@ -251,7 +253,7 @@ for my $spec (
     ['9',              '9.0.0' ],
     ['0',              '0.0.0' ],
     [0,                '0.0.0' ],
-#    ['0rc1',           '0.0.0-rc1' ],
+    ['0-rc1',          '0.0.0-rc1' ],
 ) { SKIP: {
         skip 'Two-integer vstrings weak on Perl 5.8', 12
             if $no_2digitvst && Scalar::Util::isvstring($spec->[0]);
@@ -262,11 +264,8 @@ for my $spec (
     $string =~ s/^\s+//;
     $string =~ s/\s+$//;
     $string += 0 if $string =~ s/_//g;
-    my $vstring = $string =~ /^\d+[.][^.]+$/ ? "v$string" : $string;
-    SKIP: {
-        skip 'Stringification broken with version::vpp', 1, $is_vpp;
-        is $l->stringify, $vstring, qq{... And it should stringify to "$vstring"};
-    }
+    my $vstring = $string =~ $vq ? "v$string" : $string;
+    is $l->stringify, $vstring, qq{... And it should stringify to "$vstring"};
     is $l->normal, $spec->[1],  qq{... And it should normalize to "$spec->[1]"};
 
     # Compare the non-semantic version string to the semantic one.
diff --git a/t/corpus.t b/t/corpus.t
new file mode 100644
index 0000000..d5dbcb2
--- /dev/null
+++ b/t/corpus.t
@@ -0,0 +1,112 @@
+#!/usr/bin/perl -w
+
+# Test the SemVer corpus from https://regex101.com/r/Ly7O1x/3/.
+
+use strict;
+use warnings;
+use Test::More tests => 222;
+#use Test::More 'no_plan';
+
+use FindBin qw($Bin);
+use lib "$Bin/../lib";
+use SemVer;
+
+# Valid Semantic Versions
+for my $v (qw(
+    0.0.4
+    1.2.3
+    10.20.30
+    1.1.2-prerelease+meta
+    1.1.2+meta
+    1.1.2+meta-valid
+    1.0.0-alpha
+    1.0.0-beta
+    1.0.0-alpha.beta
+    1.0.0-alpha.beta.1
+    1.0.0-alpha.1
+    1.0.0-alpha0.valid
+    1.0.0-alpha.0valid
+    1.0.0-alpha-a.b-c-somethinglong+build.1-aef.1-its-okay
+    1.0.0-rc.1+build.1
+    2.0.0-rc.1+build.123
+    1.2.3-beta
+    10.2.3-DEV-SNAPSHOT
+    1.2.3-SNAPSHOT-123
+    1.0.0
+    2.0.0
+    1.1.7
+    2.0.0+build.1848
+    2.0.1-alpha.1227
+    1.0.0-alpha+beta
+    1.2.3----RC-SNAPSHOT.12.9.1--.12+788
+    1.2.3----R-S.12.9.1--.12+meta
+    1.2.3----RC-SNAPSHOT.12.9.1--.12
+    1.0.0+0.build.1-rc.10000aaa-kk-0.1
+    1.0.0-0A.is.legal
+)) {
+    local $@;
+    ok my $sv = eval { SemVer->new($v) }, qq{New "$v" should be valid} or diag $@;
+    is $sv->stringify, $v, qq{Should stringify to "$v"};
+
+    ok $sv = eval { SemVer->declare($v) }, qq{Declare "$v" should work} or diag $@;
+    is $sv->stringify, $v, qq{Should stringify to "$v"};
+
+    ok $sv = eval { SemVer->parse($v) }, qq{Parse "$v" should work} or diag $@;
+    is $sv->stringify, $v, qq{Should stringify to "$v"};
+}
+
+SKIP: {
+    local $TODO = 'Large versions overflow version.pm integer bounds';
+    local $SIG{__WARN__} = sub { }; # Ignore version overflow warning
+    my $v = '99999999999999999999999.999999999999999999.99999999999999999';
+    ok my $sv = eval { SemVer->new($v) }, qq{"$v" should be valid};
+    is $sv->stringify, $v, qq{Should stringify to "$v"};
+}
+
+# Invalid Semantic Versions
+for my $bv (qw(
+    1
+    1.2
+    1.2.3-0123
+    1.2.3-0123.0123
+    1.1.2+.123
+    +invalid
+    -invalid
+    -invalid+invalid
+    -invalid.01
+    alpha
+    alpha.beta
+    alpha.beta.1
+    alpha.1
+    alpha+beta
+    alpha_beta
+    alpha.
+    alpha..
+    beta
+    1.0.0-alpha_beta
+    -alpha.
+    1.0.0-alpha..
+    1.0.0-alpha..1
+    1.0.0-alpha...1
+    1.0.0-alpha....1
+    1.0.0-alpha.....1
+    1.0.0-alpha......1
+    1.0.0-alpha.......1
+    01.1.1
+    1.01.1
+    1.1.01
+    1.2
+    1.2.3.DEV
+    1.2-SNAPSHOT
+    1.2.31.2.3----RC-SNAPSHOT.12.09.1--..12+788
+    1.2-RC-SNAPSHOT
+    -1.0.3-gamma+b7718
+    +justmeta
+    9.8.7+meta+meta
+    9.8.7-whatever+meta+meta
+    99999999999999999999999.999999999999999999.99999999999999999----RC-SNAPSHOT.12.09.1--------------------------------..12
+)) {
+    local $@;
+    eval { SemVer->new($bv) };
+    ok $@, qq{"$bv" should be an invalid semver};
+}