[perl5.git] / t / op / packagev.t

#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = qw '../lib ../cpan/version/lib';
    require './test.pl';
}

# XXX remove this later -- dagolden, 2010-01-13
# local *STDERR = *STDOUT;

my @syntax_cases = (
    'package Foo',
    'package Bar 1.23',
    'package Baz v1.2.3',
);

my @version_cases = <DATA>;

plan tests => 7 * @syntax_cases + 7 * (grep { $_ !~ /^#/ } @version_cases)
            + 2 * 3;

use warnings qw/syntax/;
use version;

for my $string ( @syntax_cases ) {
    eval "$string";
    is( $@, '', qq/eval "$string"/ );
    eval "$string;";
    is( $@, '', qq/eval "$string;"/ );
    eval "$string ;";
    is( $@, '', qq/eval "$string ;"/ );
    eval "{$string}";
    is( $@, '', qq/eval "{$string}"/ );
    eval "{ $string }";
    is( $@, '', qq/eval "{ $string }"/ );
    eval "${string}{}";
    is( $@, '', qq/eval "${string}{}"/ );
    eval "$string {}";
    is( $@, '', qq/eval "$string {}"/ );
}

LINE:
for my $line (@version_cases) {
    chomp $line;
    # comments in data section are just diagnostics
    if ($line =~ /^#/) {
	diag $line;
	next LINE;
    }

    my ($v, $package, $quoted, $bare, $match) = split /\t+/, $line;
    my $warning = "";
    local $SIG{__WARN__} = sub { $warning .= $_[0] . "\n" };
    $match = defined $match ? $match : "";
    $match =~ s/\s*\z//; # kill trailing spaces

    # First handle the 'package NAME VERSION' case
    foreach my $suffix (";", "{}") {
	$withversion::VERSION = undef;
	if ($package eq 'fail') {
	    eval "package withversion $v$suffix";
	    like($@, qr/$match/, "package withversion $v$suffix -> syntax error ($match)");
	    ok(! version::is_strict($v), qq{... and "$v" should also fail STRICT regex});
	}
	else {
	    my $ok = eval "package withversion $v$suffix $v eq \$withversion::VERSION";
	    ok($ok, "package withversion $v$suffix")
	      or diag( $@ ? $@ : "and \$VERSION = $withversion::VERSION");
	    ok( version::is_strict($v), qq{... and "$v" should pass STRICT regex});
	}
    }

    # Now check the version->new("V") case
    my $ver = undef;
    eval qq/\$ver = version->new("$v")/;
    if ($quoted eq 'fail') {
	like($@, qr/$match/, qq{version->new("$v") -> invalid format ($match)})
          or diag( $@ ? $@ : "and \$ver = $ver" );
	ok( ! version::is_lax($v), qq{... and "$v" should fail LAX regex});
    }
    else {
	is($@, "", qq{version->new("$v")});
	ok( version::is_lax($v), qq{... and "$v" should pass LAX regex});
    }

    # Now check the version->new(V) case, unless we're skipping it
    if ( $bare eq 'na' ) {
        pass( "... skipping version->new($v)" );
	next LINE;
    }
    $ver = undef;
    eval qq/\$ver = version->new($v)/;
    if ($bare eq 'fail') {
	like($@, qr/$match/m, qq{... and unquoted version->new($v) has same error})
          or diag( $@ ? $@ : "and \$ver = $ver" );
    }
    else {
	is($@, "", qq{... and version->new($v) is ok});
    }
}

#
# Tests for #72432 - which reports a syntax error if there's a newline
# between the package name and the version.
#
# Note that we are using 'run_perl' here - there's no problem if 
# "package Foo\n1;" is evalled.
#
for my $v ("1", "1.23", "v1.2.3") {
    ok (run_perl (prog => "package Foo\n$v; print 1;"),
                          "New line between package name and version");
    ok (run_perl (prog => "package Foo\n$v { print 1; }"),
                          "New line between package name and version");
}

# The data is organized in tab delimited format with these columns:
#
# value		package		version->new	version->new	regex
# 				quoted		unquoted
#
# For each value, it is tested using eval in the following expressions
#
# 	package foo $value;			# column 2
# and
# 	my $ver = version->new("$value");	# column 3
# and
# 	my $ver = version->new($value);		# column 4
#
# The second through fourth columns can contain 'pass' or 'fail'.
#
# For any column with 'pass', the tests makes sure that no warning/error
# was thrown.  For any column with 'fail', the tests make sure that the
# error thrown matches the regex in the last column.  The unquoted column
# may also have 'na' indicating that it's pointless to test as behavior
# is subject to the perl parser before a stringifiable value is available
# to version->new
#
# If all columns are marked 'pass', the regex column is left empty.
#
# there are multiple ways that underscores can fail depending on strict
# vs lax format so these test do not distinguish between them
#
# If the DATA line begins with a # mark, it is used as a diag comment
__DATA__
1.00		pass	pass	pass
1.00001		pass	pass	pass
0.123		pass	pass	pass
12.345		pass	pass	pass
42		pass	pass	pass
0		pass	pass	pass
0.0		pass	pass	pass
v1.2.3		pass	pass	pass
v1.2.3.4	pass	pass	pass
v0.1.2		pass	pass	pass
v0.0.0		pass	pass	pass
01		fail	pass	pass	no leading zeros
01.0203		fail	pass	pass	no leading zeros
v01		fail	pass	pass	no leading zeros
v01.02.03	fail	pass	pass	no leading zeros
.1		fail	pass	pass	0 before decimal required
.1.2		fail	pass	pass	0 before decimal required
1.		fail	pass	pass	fractional part required
1.a		fail	fail	na	fractional part required
1._		fail	fail	na	fractional part required
1.02_03		fail	pass	pass	underscore
v1.2_3		fail	pass	pass	underscore
v1.02_03	fail	pass	pass	underscore
v1.2_3_4	fail	fail	fail	underscore
v1.2_3.4	fail	fail	fail	underscore
1.2_3.4		fail	fail	fail	underscore
0_		fail	fail	na	underscore
1_		fail	fail	na	underscore
1_.		fail	fail	na	underscore
1.1_		fail	fail	na	underscore
1.02_03_04	fail	fail	na	underscore
1.2.3		fail	pass	pass	dotted-decimal versions must begin with 'v'
v1.2		fail	pass	pass	dotted-decimal versions require at least three parts
v0		fail	pass	pass	dotted-decimal versions require at least three parts
v1		fail	pass	pass	dotted-decimal versions require at least three parts
v.1.2.3		fail	fail	na	dotted-decimal versions require at least three parts
v		fail	fail	na	dotted-decimal versions require at least three parts
v1.2345.6	fail	pass	pass	maximum 3 digits between decimals
undef		fail	pass	pass	non-numeric data
1a		fail	fail	na	non-numeric data
1.2a3		fail	fail	na	non-numeric data
bar		fail	fail	na	non-numeric data
_		fail	fail	na	non-numeric data
Commit	Line	Data
91152fc1 DG	1	#!./perl
	2
	3	BEGIN {
a817e89d	4	chdir 't' if -d 't';
13ab9e47	5	@INC = qw '../lib ../cpan/version/lib';
91152fc1 DG	6	require './test.pl';
	7	}
	8
	9	# XXX remove this later -- dagolden, 2010-01-13
	10	# local STDERR = STDOUT;
	11
	12	my @syntax_cases = (
	13	'package Foo',
	14	'package Bar 1.23',
	15	'package Baz v1.2.3',
	16	);
	17
	18	my @version_cases = <DATA>;
	19
36f77d71 Z	20	plan tests => 7 * @syntax_cases + 7 * (grep { $_ !~ /^#/ } @version_cases)
36f77d71 Z	21	+ 2 * 3;
91152fc1 DG	22
	23	use warnings qw/syntax/;
	24	use version;
	25
	26	for my $string ( @syntax_cases ) {
	27	eval "$string";
	28	is( $@, '', qq/eval "$string"/ );
	29	eval "$string;";
	30	is( $@, '', qq/eval "$string;"/ );
	31	eval "$string ;";
	32	is( $@, '', qq/eval "$string ;"/ );
	33	eval "{$string}";
	34	is( $@, '', qq/eval "{$string}"/ );
	35	eval "{ $string }";
	36	is( $@, '', qq/eval "{ $string }"/ );
36f77d71 Z	37	eval "${string}{}";
	38	is( $@, '', qq/eval "${string}{}"/ );
	39	eval "$string {}";
	40	is( $@, '', qq/eval "$string {}"/ );
91152fc1 DG	41	}
	42
	43	LINE:
	44	for my $line (@version_cases) {
	45	chomp $line;
	46	# comments in data section are just diagnostics
	47	if ($line =~ /^#/) {
	48	diag $line;
	49	next LINE;
	50	}
	51
	52	my ($v, $package, $quoted, $bare, $match) = split /\t+/, $line;
	53	my $warning = "";
	54	local $SIG{__WARN__} = sub { $warning .= $_[0] . "\n" };
	55	$match = defined $match ? $match : "";
	56	$match =~ s/\s*\z//; # kill trailing spaces
	57
	58	# First handle the 'package NAME VERSION' case
36f77d71 Z	59	foreach my $suffix (";", "{}") {
	60	$withversion::VERSION = undef;
	61	if ($package eq 'fail') {
	62	eval "package withversion $v$suffix";
	63	like($@, qr/$match/, "package withversion $v$suffix -> syntax error ($match)");
	64	ok(! version::is_strict($v), qq{... and "$v" should also fail STRICT regex});
	65	}
	66	else {
	67	my $ok = eval "package withversion $v$suffix $v eq \$withversion::VERSION";
	68	ok($ok, "package withversion $v$suffix")
	69	or diag( $@ ? $@ : "and \$VERSION = $withversion::VERSION");
	70	ok( version::is_strict($v), qq{... and "$v" should pass STRICT regex});
	71	}
91152fc1 DG	72	}
91152fc1 DG	73
91152fc1 DG	74	# Now check the version->new("V") case
	75	my $ver = undef;
	76	eval qq/\$ver = version->new("$v")/;
	77	if ($quoted eq 'fail') {
	78	like($@, qr/$match/, qq{version->new("$v") -> invalid format ($match)})
	79	or diag( $@ ? $@ : "and \$ver = $ver" );
	80	ok( ! version::is_lax($v), qq{... and "$v" should fail LAX regex});
	81	}
	82	else {
	83	is($@, "", qq{version->new("$v")});
	84	ok( version::is_lax($v), qq{... and "$v" should pass LAX regex});
	85	}
	86
	87	# Now check the version->new(V) case, unless we're skipping it
	88	if ( $bare eq 'na' ) {
	89	pass( "... skipping version->new($v)" );
	90	next LINE;
	91	}
	92	$ver = undef;
	93	eval qq/\$ver = version->new($v)/;
	94	if ($bare eq 'fail') {
	95	like($@, qr/$match/m, qq{... and unquoted version->new($v) has same error})
	96	or diag( $@ ? $@ : "and \$ver = $ver" );
	97	}
	98	else {
	99	is($@, "", qq{... and version->new($v) is ok});
	100	}
	101	}
	102
872cbd3c A	103	#
	104	# Tests for #72432 - which reports a syntax error if there's a newline
	105	# between the package name and the version.
	106	#
	107	# Note that we are using 'run_perl' here - there's no problem if
	108	# "package Foo\n1;" is evalled.
	109	#
	110	for my $v ("1", "1.23", "v1.2.3") {
	111	ok (run_perl (prog => "package Foo\n$v; print 1;"),
	112	"New line between package name and version");
36f77d71 Z	113	ok (run_perl (prog => "package Foo\n$v { print 1; }"),
36f77d71 Z	114	"New line between package name and version");
872cbd3c	115	}
91152fc1 DG	116
	117	# The data is organized in tab delimited format with these columns:
	118	#
	119	# value package version->new version->new regex
	120	# quoted unquoted
	121	#
	122	# For each value, it is tested using eval in the following expressions
	123	#
	124	# package foo $value; # column 2
	125	# and
	126	# my $ver = version->new("$value"); # column 3
	127	# and
	128	# my $ver = version->new($value); # column 4
	129	#
	130	# The second through fourth columns can contain 'pass' or 'fail'.
	131	#
	132	# For any column with 'pass', the tests makes sure that no warning/error
	133	# was thrown. For any column with 'fail', the tests make sure that the
	134	# error thrown matches the regex in the last column. The unquoted column
	135	# may also have 'na' indicating that it's pointless to test as behavior
	136	# is subject to the perl parser before a stringifiable value is available
	137	# to version->new
	138	#
	139	# If all columns are marked 'pass', the regex column is left empty.
	140	#
	141	# there are multiple ways that underscores can fail depending on strict
	142	# vs lax format so these test do not distinguish between them
	143	#
	144	# If the DATA line begins with a # mark, it is used as a diag comment
	145	__DATA__
	146	1.00 pass pass pass
	147	1.00001 pass pass pass
	148	0.123 pass pass pass
	149	12.345 pass pass pass
	150	42 pass pass pass
	151	0 pass pass pass
	152	0.0 pass pass pass
	153	v1.2.3 pass pass pass
	154	v1.2.3.4 pass pass pass
	155	v0.1.2 pass pass pass
	156	v0.0.0 pass pass pass
	157	01 fail pass pass no leading zeros
	158	01.0203 fail pass pass no leading zeros
	159	v01 fail pass pass no leading zeros
	160	v01.02.03 fail pass pass no leading zeros
	161	.1 fail pass pass 0 before decimal required
	162	.1.2 fail pass pass 0 before decimal required
	163	1. fail pass pass fractional part required
	164	1.a fail fail na fractional part required
	165	1._ fail fail na fractional part required
	166	1.02_03 fail pass pass underscore
	167	v1.2_3 fail pass pass underscore
	168	v1.02_03 fail pass pass underscore
	169	v1.2_3_4 fail fail fail underscore
	170	v1.2_3.4 fail fail fail underscore
	171	1.2_3.4 fail fail fail underscore
	172	0_ fail fail na underscore
	173	1_ fail fail na underscore
	174	1_. fail fail na underscore
	175	1.1_ fail fail na underscore
	176	1.02_03_04 fail fail na underscore
	177	1.2.3 fail pass pass dotted-decimal versions must begin with 'v'
	178	v1.2 fail pass pass dotted-decimal versions require at least three parts
	179	v0 fail pass pass dotted-decimal versions require at least three parts
180	v1 fail pass pass dotted-decimal versions require at least three parts
181	v.1.2.3 fail fail na dotted-decimal versions require at least three parts
182	v fail fail na dotted-decimal versions require at least three parts
183	v1.2345.6 fail pass pass maximum 3 digits between decimals
184	undef fail pass pass non-numeric data
185	1a fail fail na non-numeric data
186	1.2a3 fail fail na non-numeric data
187	bar fail fail na non-numeric data
188	_ fail fail na non-numeric data