1
1
# ! /usr/local/perl -w
2
2
package main ;
3
+
4
+ use strict;
3
5
require Test::Harness;
4
6
use Data::Dumper;
5
7
use File::Temp qw/ tempfile/ ;
@@ -10,7 +12,10 @@ if ($Test::More::VERSION < 0.48) { # Fix for RT#48268
10
12
*main::use_ok = sub ($;@) {
11
13
my ($pkg , $req , @args ) = @_ ;
12
14
eval " use $pkg $req " .join (' ' ,@args );
13
- is ${" $pkg \: :VERSION" }, eval ($req ), ' Had to manually use version' ;
15
+ {
16
+ no strict ' refs' ;
17
+ is ${" $pkg \: :VERSION" }, eval ($req ), ' Had to manually use version' ;
18
+ }
14
19
# If we made it this far, we are ok.
15
20
};
16
21
}
@@ -25,7 +30,7 @@ sub BaseTests {
25
30
# its man page ( perldoc Test ) for help writing this test script.
26
31
27
32
# Test bare number processing
28
- $version = $CLASS -> $method (5.005_03);
33
+ my $version = $CLASS -> $method (5.005_03);
29
34
is ( " $version " , " 5.00503" , ' 5.005_03 eq 5.00503' );
30
35
$version = $CLASS -> $method (1.23);
31
36
is ( " $version " , " 1.23" , ' 1.23 eq "1.23"' );
@@ -97,7 +102,7 @@ sub BaseTests {
97
102
# Test Numeric Comparison operators
98
103
# test first with non-object
99
104
$version = $CLASS -> $method (" 5.006.001" );
100
- $new_version = " 5.8.0" ;
105
+ my $new_version = " 5.8.0" ;
101
106
ok ( $version == $version , ' $version == $version' );
102
107
ok ( $version < $new_version , ' $version < $new_version' );
103
108
ok ( $new_version > $version , ' $new_version > $version' );
@@ -303,7 +308,7 @@ SKIP: {
303
308
{ # dummy up some variously broken modules for testing
304
309
my ($fh , $filename ) = tempfile(' tXXXXXXX' , SUFFIX => ' .pm' , UNLINK => 1);
305
310
(my $package = basename($filename )) =~ s /\. pm$// ;
306
- print $fh " package $package ;\n \@ VERSION = ();\n 1;\n " ;
311
+ print $fh " package $package ;\n our \@ VERSION = ();\n 1;\n " ;
307
312
close $fh ;
308
313
eval " use lib '.'; use $package 3;" ;
309
314
like ($@ , qr /$error_regex / ,
@@ -318,7 +323,7 @@ SKIP: { # https://rt.perl.org/rt3/Ticket/Display.html?id=95544
318
323
unless defined $qv_declare ;
319
324
my ($fh , $filename ) = tempfile(' tXXXXXXX' , SUFFIX => ' .pm' , UNLINK => 1);
320
325
(my $package = basename($filename )) =~ s /\. pm$// ;
321
- print $fh " package $package ;\n \$ VERSION = '3alpha';\n 1;\n " ;
326
+ print $fh " package $package ;\n our \$ VERSION = '3alpha';\n 1;\n " ;
322
327
close $fh ;
323
328
eval " use lib '.'; use $package ; print $package ->VERSION" ;
324
329
like ($@ , qr / Invalid version format \( non-numeric data\) / ,
@@ -338,8 +343,12 @@ SKIP: {
338
343
ok($version == $new_version , ' $version == $new_version' );
339
344
skip " version require'd instead of use'd, cannot test declare" , 1
340
345
unless defined $qv_declare ;
341
- $version = &$qv_declare (1.2.3);
342
- ok(" $version " eq " v1.2.3" , ' v-string initialized $qv_declare()' );
346
+
347
+ {
348
+ no strict ' refs' ;
349
+ $version = &{$qv_declare }(1.2.3);
350
+ ok(" $version " eq " v1.2.3" , ' v-string initialized $qv_declare()' );
351
+ }
343
352
}
344
353
345
354
SKIP: {
@@ -400,7 +409,7 @@ SKIP: {
400
409
(my $package = basename($filename )) =~ s /\. pm$// ;
401
410
print $fh <<"EOF" ;
402
411
package $package ;
403
- use $CLASS ; \$ VERSION = ${CLASS} ->new('0.0.4');
412
+ use $CLASS ; our \$ VERSION = ${CLASS} ->new('0.0.4');
404
413
1;
405
414
EOF
406
415
close $fh ;
@@ -429,22 +438,29 @@ EOF
429
438
}
430
439
431
440
SKIP: {
432
- skip " Cannot test \" use parent $CLASS \" when require is used" , 3
441
+ skip " Cannot test \" use base $CLASS \" when require is used" , 3
433
442
unless defined $qv_declare ;
434
443
my ($fh , $filename ) = tempfile(' tXXXXXXX' , SUFFIX => ' .pm' , UNLINK => 1);
435
444
(my $package = basename($filename )) =~ s /\. pm$// ;
436
445
print $fh <<"EOF" ;
437
446
package $package ;
438
- use base $CLASS ;
447
+ use base ' $CLASS ' ;
439
448
1;
440
449
EOF
441
450
close $fh ;
442
451
# need to eliminate any other $qv_declare()'s
443
- undef *{" main\: :$qv_declare " };
444
- ok(!defined (&{" main\: :$qv_declare " }), " make sure we cleared $qv_declare () properly" );
452
+ {
453
+ no strict ' refs' ;
454
+ undef *{" main\: :$qv_declare " };
455
+ ok(!defined (&{" main\: :$qv_declare " }), " make sure we cleared $qv_declare () properly" );
456
+ }
445
457
eval " use lib '.'; use $package qw/declare qv/;" ;
458
+ die " Error from test: $@ " if $@ ;
446
459
ok(defined (&{" main\: :$qv_declare " }), " make sure we exported $qv_declare () properly" );
447
- isa_ok( &$qv_declare (1.2), $package );
460
+ {
461
+ no strict ' refs' ;
462
+ isa_ok( main-> can($qv_declare )-> (1.2), $package );
463
+ }
448
464
unlink $filename ;
449
465
}
450
466
@@ -456,7 +472,7 @@ SKIP: {
456
472
(my $package = basename($filename )) =~ s /\. pm$// ;
457
473
print $fh <<"EOF" ;
458
474
package $package ;
459
- \$ VERSION = 1.0;
475
+ our \$ VERSION = 1.0;
460
476
1;
461
477
EOF
462
478
close $fh ;
@@ -614,23 +630,23 @@ SKIP: {
614
630
}
615
631
{
616
632
# now as a number
617
- $two31 = 2**31;
618
- $v = $CLASS -> new($two31 );
633
+ my $two31 = 2**31;
634
+ my $v = $CLASS -> new($two31 );
619
635
is " $v " , ' v.Inf' , ' Element Exceeds VERSION_MAX' ;
620
636
like $warning , qr / Integer overflow in version/ , ' Overflow warning' ;
621
637
}
622
638
{ # https://rt.cpan.org/Ticket/Display.html?id=101628
623
639
undef $warning ;
624
- $v = $CLASS -> new(' 1.1.00000000010' );
640
+ my $v = $CLASS -> new(' 1.1.00000000010' );
625
641
is $v -> normal, " v1.1.10" , ' Ignore leading zeros' ;
626
642
unlike $warning , qr / Integer overflow in version/ , ' No overflow warning' ;
627
643
}
628
644
{ # https://rt.cpan.org/Ticket/Display.html?id=93340
629
- $v = $CLASS -> parse(q[ 2.6_01] );
645
+ my $v = $CLASS -> parse(q[ 2.6_01] );
630
646
is $v -> normal, ' v2.601.0' , ' Normal strips underscores from alphas'
631
647
}
632
648
{ # https://rt.cpan.org/Ticket/Display.html?id=98744
633
- $v = $CLASS -> new(" 1.02_003" );
649
+ my $v = $CLASS -> new(" 1.02_003" );
634
650
is $v -> numify, ' 1.020030' , ' Ignore underscores for numify' ;
635
651
}
636
652
}
0 commit comments