From: Chip Salzenberg Date: Sat, 4 Jan 1997 05:44:00 +0000 (+1200) Subject: [shell changes from patch from perl5.003_18 to perl5.003_19] X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2223696182def99cda82e756db80d13949fc882e;p=p5sagit%2Fp5-mst-13.2.git [shell changes from patch from perl5.003_18 to perl5.003_19] Change from running these commands: # these files are obsolete rm -f pod/perlovl.pod rm -f t/lib/locale.t rm -f t/op/overload.t rm -f t/op/use.t # new test directory must exists test -d t/pragma || mkdir t/pragma # new tests must be executable t="t/comp/colon.t t/op/assignwarn.t t/pragma/locale.t \ t/pragma/overload.t t/pragma/strict.t t/pragma/subs.t t/pragma/warning.t" touch $t chmod +x $t # now that we have splain.PL, this need not be executable chmod a-x lib/diagnostics.pm # ready to patch exit 0 --- diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm old mode 100755 new mode 100644 diff --git a/pod/perlovl.pod b/pod/perlovl.pod deleted file mode 100644 index 208456d..0000000 --- a/pod/perlovl.pod +++ /dev/null @@ -1,15 +0,0 @@ -=head1 NAME - -perlovl - overload perl mathematical functions [superseded] - -=head1 DESCRIPTION - -This man page has been superseded by L. - -=head1 WARNING - -The old interface involving %OVERLOAD is deprecated and will go away -RSN. Convert your scripts to -use overload ...; -style. - diff --git a/t/comp/colon.t b/t/comp/colon.t new file mode 100755 index 0000000..e69de29 diff --git a/t/lib/locale.t b/t/lib/locale.t deleted file mode 100755 index 7f8c858..0000000 --- a/t/lib/locale.t +++ /dev/null @@ -1,440 +0,0 @@ -#!./perl -wT - -print "1..104\n"; - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -use strict; -use POSIX qw(locale_h); - -use vars qw($a - $English $German $French $Spanish - @C @English @German @French @Spanish - $Locale @Locale %iLocale %UPPER %lower @Neoalpha); - -$a = 'abc %'; - -sub ok { - my ($n, $result) = @_; - - print 'not ' unless ($result); - print "ok $n\n"; -} - -# First we'll do a lot of taint checking for locales. -# This is the easiest to test, actually, as any locale, -# even the default locale will taint under 'use locale'. - -sub is_tainted { # hello, camel two. - my $dummy; - not eval { $dummy = join("", @_), kill 0; 1 } -} - -sub check_taint ($$) { - ok $_[0], is_tainted($_[1]); -} - -sub check_taint_not ($$) { - ok $_[0], not is_tainted($_[1]); -} - -use locale; # engage locale and therefore locale taint. - -check_taint_not 1, $a; - -check_taint 2, uc($a); -check_taint 3, "\U$a"; -check_taint 4, ucfirst($a); -check_taint 5, "\u$a"; -check_taint 6, lc($a); -check_taint 7, "\L$a"; -check_taint 8, lcfirst($a); -check_taint 9, "\l$a"; - -check_taint 10, sprintf('%e', 123.456); -check_taint 11, sprintf('%f', 123.456); -check_taint 12, sprintf('%g', 123.456); -check_taint_not 13, sprintf('%d', 123.456); -check_taint_not 14, sprintf('%x', 123.456); - -$_ = $a; # untaint $_ - -$_ = uc($a); # taint $_ - -check_taint 15, $_; - -/(\w)/; # taint $&, $`, $', $+, $1. -check_taint 16, $&; -check_taint 17, $`; -check_taint 18, $'; -check_taint 19, $+; -check_taint 20, $1; -check_taint_not 21, $2; - -/(.)/; # untaint $&, $`, $', $+, $1. -check_taint_not 22, $&; -check_taint_not 23, $`; -check_taint_not 24, $'; -check_taint_not 25, $+; -check_taint_not 26, $1; -check_taint_not 27, $2; - -/(\W)/; # taint $&, $`, $', $+, $1. -check_taint 28, $&; -check_taint 29, $`; -check_taint 30, $'; -check_taint 31, $+; -check_taint 32, $1; -check_taint_not 33, $2; - -/(\s)/; # taint $&, $`, $', $+, $1. -check_taint 34, $&; -check_taint 35, $`; -check_taint 36, $'; -check_taint 37, $+; -check_taint 38, $1; -check_taint_not 39, $2; - -/(\S)/; # taint $&, $`, $', $+, $1. -check_taint 40, $&; -check_taint 41, $`; -check_taint 42, $'; -check_taint 43, $+; -check_taint 44, $1; -check_taint_not 45, $2; - -$_ = $a; # untaint $_ - -check_taint_not 46, $_; - -/(b)/; # this must not taint -check_taint_not 47, $&; -check_taint_not 48, $`; -check_taint_not 49, $'; -check_taint_not 50, $+; -check_taint_not 51, $1; -check_taint_not 52, $2; - -$_ = $a; # untaint $_ - -check_taint_not 53, $_; - -$b = uc($a); # taint $b -s/(.+)/$b/; # this must taint only the $_ - -check_taint 54, $_; -check_taint_not 55, $&; -check_taint_not 56, $`; -check_taint_not 57, $'; -check_taint_not 58, $+; -check_taint_not 59, $1; -check_taint_not 60, $2; - -$_ = $a; # untaint $_ - -s/(.+)/b/; # this must not taint -check_taint_not 61, $_; -check_taint_not 62, $&; -check_taint_not 63, $`; -check_taint_not 64, $'; -check_taint_not 65, $+; -check_taint_not 66, $1; -check_taint_not 67, $2; - -$b = $a; # untaint $b - -($b = $a) =~ s/\w/$&/; -check_taint 68, $b; # $b should be tainted. -check_taint_not 69, $a; # $a should be not. - -$_ = $a; # untaint $_ - -s/(\w)/\l$1/; # this must taint -check_taint 70, $_; -check_taint 71, $&; -check_taint 72, $`; -check_taint 73, $'; -check_taint 74, $+; -check_taint 75, $1; -check_taint_not 76, $2; - -$_ = $a; # untaint $_ - -s/(\w)/\L$1/; # this must taint -check_taint 77, $_; -check_taint 78, $&; -check_taint 79, $`; -check_taint 80, $'; -check_taint 81, $+; -check_taint 82, $1; -check_taint_not 83, $2; - -$_ = $a; # untaint $_ - -s/(\w)/\u$1/; # this must taint -check_taint 84, $_; -check_taint 85, $&; -check_taint 86, $`; -check_taint 87, $'; -check_taint 88, $+; -check_taint 89, $1; -check_taint_not 90, $2; - -$_ = $a; # untaint $_ - -s/(\w)/\U$1/; # this must taint -check_taint 91, $_; -check_taint 92, $&; -check_taint 93, $`; -check_taint 94, $'; -check_taint 95, $+; -check_taint 96, $1; -check_taint_not 97, $2; - -# After all this tainting $a should be cool. - -check_taint_not 98, $a; - -# I think we've seen quite enough of taint. -# Let us do some *real* locale work now. - -sub getalnum { - sort grep /\w/, map { chr } 0..255 -} - -sub locatelocale ($$@) { - my ($lcall, $alnum, @try) = @_; - - undef $$lcall; - - for (@try) { - local $^W = 0; # suppress "Subroutine LC_ALL redefined" - if (setlocale(LC_ALL, $_)) { - $$lcall = $_; - @$alnum = &getalnum; - last; - } - } - - @$alnum = () unless (defined $$lcall); -} - -# Find some default locale - -locatelocale(\$Locale, \@Locale, qw(C POSIX)); - -# Find some English locale - -locatelocale(\$English, \@English, - qw(en_US.ISO8859-1 en_GB.ISO8859-1 - en en_US en_UK en_IE en_CA en_AU en_NZ - english english.iso88591 - american american.iso88591 - british british.iso88591 - )); - -# Find some German locale - -locatelocale(\$German, \@German, - qw(de_DE.ISO8859-1 de_AT.ISO8859-1 de_CH.ISO8859-1 - de de_DE de_AT de_CH - german german.iso88591)); - -# Find some French locale - -locatelocale(\$French, \@French, - qw(fr_FR.ISO8859-1 fr_BE.ISO8859-1 fr_CA.ISO8859-1 fr_CH.ISO8859-1 - fr fr_FR fr_BE fr_CA fr_CH - french french.iso88591)); - -# Find some Spanish locale - -locatelocale(\$Spanish, \@Spanish, - qw(es_AR.ISO8859-1 es_BO.ISO8859-1 es_CL.ISO8859-1 - es_CO.ISO8859-1 es_CR.ISO8859-1 es_EC.ISO8859-1 - es_ES.ISO8859-1 es_GT.ISO8859-1 es_MX.ISO8859-1 - es_NI.ISO8859-1 es_PA.ISO8859-1 es_PE.ISO8859-1 - es_PY.ISO8859-1 es_SV.ISO8859-1 es_UY.ISO8859-1 es_VE.ISO8859-1 - es es_AR es_BO es_CL - es_CO es_CR es_EC - es_ES es_GT es_MX - es_NI es_PA es_PE - es_PY es_SV es_UY es_VE - spanish spanish.iso88591)); - -# Select the largest of the alpha(num)bets. - -($Locale, @Locale) = ($English, @English) - if (length(@English) > length(@Locale)); -($Locale, @Locale) = ($German, @German) - if (length(@German) > length(@Locale)); -($Locale, @Locale) = ($French, @French) - if (length(@French) > length(@Locale)); -($Locale, @Locale) = ($Spanish, @Spanish) - if (length(@Spanish) > length(@Locale)); - -print "# Locale = $Locale\n"; -print "# Alnum_ = @Locale\n"; - -{ - local $^W = 0; - setlocale(LC_ALL, $Locale); -} - -{ - my $i = 0; - - for (@Locale) { - $iLocale{$_} = $i++; - } -} - -# Sieve the uppercase and the lowercase. - -for (@Locale) { - if (/[^\d_]/) { # skip digits and the _ - if (lc eq $_) { - $UPPER{$_} = uc; - } else { - $lower{$_} = lc; - } - } -} - -# Cross-check the upper and the lower. -# Yes, this is broken when the upper<->lower changes the number of -# the glyphs (e.g. the German sharp-s aka double-s aka sz-ligature, -# or the Dutch IJ or the Spanish LL or ...) -# But so far all the implementations do this wrong so we can do it wrong too. - -for (keys %UPPER) { - if (defined $lower{$UPPER{$_}}) { - if ($_ ne $lower{$UPPER{$_}}) { - print 'not '; - last; - } - } -} -print "ok 99\n"; - -for (keys %lower) { - if (defined $UPPER{$lower{$_}}) { - if ($_ ne $UPPER{$lower{$_}}) { - print 'not '; - last; - } - } -} -print "ok 100\n"; - -# Find the alphabets that are not alphabets in the default locale. - -{ - no locale; - - for (keys %UPPER, keys %lower) { - push(@Neoalpha, $_) if (/\W/); - } -} - -@Neoalpha = sort @Neoalpha; - -# Test \w. - -{ - my $word = join('', @Neoalpha); - - $word =~ /^(\w*)$/; - - print 'not ' if ($1 ne $word); -} -print "ok 101\n"; - -# Find places where the collation order differs from the default locale. - -{ - my (@k, $i, $j, @d); - - { - no locale; - - @k = sort (keys %UPPER, keys %lower); - } - - for ($i = 0; $i < @k; $i++) { - for ($j = $i + 1; $j < @k; $j++) { - if ($iLocale{$k[$j]} < $iLocale{$k[$i]}) { - push(@d, [$k[$j], $k[$i]]); - } - } - } - - # Cross-check those places. - - for (@d) { - ($i, $j) = @$_; - if ($i gt $j) { - print "# i = $i, j = $j, i ", - $i le $j ? 'le' : 'gt', " j\n"; - print 'not '; - last; - } - } -} -print "ok 102\n"; - -# Cross-check whole character set. - -for (map { chr } 0..255) { - if (/\w/ and /\W/) { print 'not '; last } - if (/\d/ and /\D/) { print 'not '; last } - if (/\s/ and /\S/) { print 'not '; last } - if (/\w/ and /\D/ and not /_/ and - not (exists $UPPER{$_} or exists $lower{$_})) { - print 'not '; - last; - } -} -print "ok 103\n"; - -# The @Locale should be internally consistent. - -{ - my ($from, $to, , $lesser, $greater); - - for (0..9) { - # Select a slice. - $from = int(($_*@Locale)/10); - $to = $from + int(@Locale/10); - $to = $#Locale if ($to > $#Locale); - $lesser = join('', @Locale[$from..$to]); - # Select a slice one character on. - $from++; $to++; - $to = $#Locale if ($to > $#Locale); - $greater = join('', @Locale[$from..$to]); - if (not ($lesser lt $greater) or - not ($lesser le $greater) or - not ($lesser ne $greater) or - ($lesser eq $greater) or - ($lesser ge $greater) or - ($lesser gt $greater) or - ($greater lt $lesser ) or - ($greater le $lesser ) or - not ($greater ne $lesser ) or - ($greater eq $lesser ) or - not ($greater ge $lesser ) or - not ($greater gt $lesser ) or - # Well, these two are sort of redundant because @Locale - # was derived using cmp. - not (($lesser cmp $greater) == -1) or - not (($greater cmp $lesser ) == 1) - ) { - print 'not '; - last; - } - } -} -print "ok 104\n"; diff --git a/t/op/assignwarn.t b/t/op/assignwarn.t new file mode 100755 index 0000000..e69de29 diff --git a/t/op/overload.t b/t/op/overload.t deleted file mode 100755 index 9c897c3..0000000 --- a/t/op/overload.t +++ /dev/null @@ -1,345 +0,0 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -use Config; - -package Oscalar; -use overload ( - # Anonymous subroutines: -'+' => sub {new Oscalar $ {$_[0]}+$_[1]}, -'-' => sub {new Oscalar - $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]}, -'<=>' => sub {new Oscalar - $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]}, -'cmp' => sub {new Oscalar - $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])}, -'*' => sub {new Oscalar ${$_[0]}*$_[1]}, -'/' => sub {new Oscalar - $_[2]? $_[1]/${$_[0]} : - ${$_[0]}/$_[1]}, -'%' => sub {new Oscalar - $_[2]? $_[1]%${$_[0]} : ${$_[0]}%$_[1]}, -'**' => sub {new Oscalar - $_[2]? $_[1]**${$_[0]} : ${$_[0]}-$_[1]}, - -qw( -"" stringify -0+ numify) # Order of arguments unsignificant -); - -sub new { - my $foo = $_[1]; - bless \$foo, $_[0]; -} - -sub stringify { "${$_[0]}" } -sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead - # comparing to direct compilation based on - # stringify - -package main; - -$test = 0; -$| = 1; -print "1..",&last,"\n"; - -sub test { - $test++; if (shift) {print "ok $test\n";1} else {print "not ok $test\n";0} -} - -$a = new Oscalar "087"; -$b= "$a"; - -# All test numbers in comments are off by 1. -# So much for hard-wiring them in :-) To fix this: -test(1); # 1 - -test ($b eq $a); # 2 -test ($b eq "087"); # 3 -test (ref $a eq "Oscalar"); # 4 -test ($a eq $a); # 5 -test ($a eq "087"); # 6 - -$c = $a + 7; - -test (ref $c eq "Oscalar"); # 7 -test (!($c eq $a)); # 8 -test ($c eq "94"); # 9 - -$b=$a; - -test (ref $a eq "Oscalar"); # 10 - -$b++; - -test (ref $b eq "Oscalar"); # 11 -test ( $a eq "087"); # 12 -test ( $b eq "88"); # 13 -test (ref $a eq "Oscalar"); # 14 - -$c=$b; -$c-=$a; - -test (ref $c eq "Oscalar"); # 15 -test ( $a eq "087"); # 16 -test ( $c eq "1"); # 17 -test (ref $a eq "Oscalar"); # 18 - -$b=1; -$b+=$a; - -test (ref $b eq "Oscalar"); # 19 -test ( $a eq "087"); # 20 -test ( $b eq "88"); # 21 -test (ref $a eq "Oscalar"); # 22 - -eval q[ package Oscalar; use overload ('++' => sub { $ {$_[0]}++;$_[0] } ) ]; - -$b=$a; - -test (ref $a eq "Oscalar"); # 23 - -$b++; - -test (ref $b eq "Oscalar"); # 24 -test ( $a eq "087"); # 25 -test ( $b eq "88"); # 26 -test (ref $a eq "Oscalar"); # 27 - -package Oscalar; -$dummy=bless \$dummy; # Now cache of method should be reloaded -package main; - -$b=$a; -$b++; - -test (ref $b eq "Oscalar"); # 28 -test ( $a eq "087"); # 29 -test ( $b eq "88"); # 30 -test (ref $a eq "Oscalar"); # 31 - - -eval q[package Oscalar; use overload ('++' => sub { $ {$_[0]} += 2; $_[0] } ) ]; - -$b=$a; - -test (ref $a eq "Oscalar"); # 32 - -$b++; - -test (ref $b eq "Oscalar"); # 33 -test ( $a eq "087"); # 34 -test ( $b eq "88"); # 35 -test (ref $a eq "Oscalar"); # 36 - -package Oscalar; -$dummy=bless \$dummy; # Now cache of method should be reloaded -package main; - -$b++; - -test (ref $b eq "Oscalar"); # 37 -test ( $a eq "087"); # 38 -test ( $b eq "90"); # 39 -test (ref $a eq "Oscalar"); # 40 - -$b=$a; -$b++; - -test (ref $b eq "Oscalar"); # 41 -test ( $a eq "087"); # 42 -test ( $b eq "89"); # 43 -test (ref $a eq "Oscalar"); # 44 - - -test ($b? 1:0); # 45 - -eval q[ package Oscalar; use overload ('=' => sub {$main::copies++; - package Oscalar; - local $new=$ {$_[0]}; - bless \$new } ) ]; - -$b=new Oscalar "$a"; - -test (ref $b eq "Oscalar"); # 46 -test ( $a eq "087"); # 47 -test ( $b eq "087"); # 48 -test (ref $a eq "Oscalar"); # 49 - -$b++; - -test (ref $b eq "Oscalar"); # 50 -test ( $a eq "087"); # 51 -test ( $b eq "89"); # 52 -test (ref $a eq "Oscalar"); # 53 -test ($copies == 0); # 54 - -$b+=1; - -test (ref $b eq "Oscalar"); # 55 -test ( $a eq "087"); # 56 -test ( $b eq "90"); # 57 -test (ref $a eq "Oscalar"); # 58 -test ($copies == 0); # 59 - -$b=$a; -$b+=1; - -test (ref $b eq "Oscalar"); # 60 -test ( $a eq "087"); # 61 -test ( $b eq "88"); # 62 -test (ref $a eq "Oscalar"); # 63 -test ($copies == 0); # 64 - -$b=$a; -$b++; - -test (ref $b eq "Oscalar") || print ref $b,"=ref(b)\n"; # 65 -test ( $a eq "087"); # 66 -test ( $b eq "89"); # 67 -test (ref $a eq "Oscalar"); # 68 -test ($copies == 1); # 69 - -eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1]; - $_[0] } ) ]; -$c=new Oscalar; # Cause rehash - -$b=$a; -$b+=1; - -test (ref $b eq "Oscalar"); # 70 -test ( $a eq "087"); # 71 -test ( $b eq "90"); # 72 -test (ref $a eq "Oscalar"); # 73 -test ($copies == 2); # 74 - -$b+=$b; - -test (ref $b eq "Oscalar"); # 75 -test ( $b eq "360"); # 76 -test ($copies == 2); # 77 -$b=-$b; - -test (ref $b eq "Oscalar"); # 78 -test ( $b eq "-360"); # 79 -test ($copies == 2); # 80 - -$b=abs($b); - -test (ref $b eq "Oscalar"); # 81 -test ( $b eq "360"); # 82 -test ($copies == 2); # 83 - -$b=abs($b); - -test (ref $b eq "Oscalar"); # 84 -test ( $b eq "360"); # 85 -test ($copies == 2); # 86 - -eval q[package Oscalar; - use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]} - : "_.${$_[0]}._" x $_[1])}) ]; - -$a=new Oscalar "yy"; -$a x= 3; -test ($a eq "_.yy.__.yy.__.yy._"); # 87 - -eval q[package Oscalar; - use overload ('.' => sub {new Oscalar ( $_[2] ? - "_.$_[1].__.$ {$_[0]}._" - : "_.$ {$_[0]}.__.$_[1]._")}) ]; - -$a=new Oscalar "xx"; - -test ("b${a}c" eq "_._.b.__.xx._.__.c._"); # 88 - -# Check inheritance of overloading; -{ - package OscalarI; - @ISA = 'Oscalar'; -} - -$aI = new OscalarI "$a"; -test (ref $aI eq "OscalarI"); # 89 -test ("$aI" eq "xx"); # 90 -test ($aI eq "xx"); # 91 -test ("b${aI}c" eq "_._.b.__.xx._.__.c._"); # 92 - -# Here we test blessing to a package updates hash - -eval "package Oscalar; no overload '.'"; - -test ("b${a}" eq "_.b.__.xx._"); # 93 -$x="1"; -bless \$x, Oscalar; -test ("b${a}c" eq "bxxc"); # 94 -new Oscalar 1; -test ("b${a}c" eq "bxxc"); # 95 - -# Negative overloading: - -$na = eval { ~$a }; -test($@ =~ /no method found/); # 96 - -# Check AUTOLOADING: - -*Oscalar::AUTOLOAD = - sub { *{"Oscalar::$AUTOLOAD"} = sub {"_!_" . shift() . "_!_"} ; - goto &{"Oscalar::$AUTOLOAD"}}; - -eval "package Oscalar; use overload '~' => 'comple'"; - -$na = eval { ~$a }; # Hash was not updated -test($@ =~ /no method found/); # 97 - -bless \$x, Oscalar; - -$na = eval { ~$a }; # Hash updated -test !$@; # 98 -test($na eq '_!_xx_!_'); # 99 - -$na = 0; - -$na = eval { ~$aI }; # Hash was not updated -test($@ =~ /no method found/); # 100 - -bless \$x, OscalarI; - -$na = eval { ~$aI }; -print $@; - -test !$@; # 101 -test($na eq '_!_xx_!_'); # 102 - -eval "package Oscalar; use overload '>>' => 'rshft'"; - -$na = eval { $aI >> 1 }; # Hash was not updated -test($@ =~ /no method found/); # 103 - -bless \$x, OscalarI; - -$na = 0; - -$na = eval { $aI >> 1 }; -print $@; - -test !$@; # 104 -test($na eq '_!_xx_!_'); # 105 - -test (overload::Method($a, '0+') eq \&Oscalar::numify); # 106 -test (overload::Method($aI,'0+') eq \&Oscalar::numify); # 107 -test (overload::Overloaded($aI)); # 108 -test (!overload::Overloaded('overload')); # 109 - -test (! defined overload::Method($aI, '<<')); # 110 -test (! defined overload::Method($a, '<')); # 111 - -test (overload::StrVal($aI) =~ /^OscalarI=SCALAR\(0x[\da-fA-F]+\)$/); # 112 -test (overload::StrVal(\$aI) eq "@{[\$aI]}"); # 113 - -# Last test is: -sub last {113} diff --git a/t/op/use.t b/t/op/use.t deleted file mode 100755 index 96c59ee..0000000 --- a/t/op/use.t +++ /dev/null @@ -1,101 +0,0 @@ -#!./perl - -print "1..14\n"; - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -my $i = 1; - -eval "use 5.000;"; -if ($@) { - print STDERR $@,"\n"; - print "not "; -} -print "ok ",$i++,"\n"; - -eval sprintf "use %.5f;", $]; -if ($@) { - print STDERR $@,"\n"; - print "not "; -} -print "ok ",$i++,"\n"; - - -eval sprintf "use %.5f;", $] - 0.000001; -if ($@) { - print STDERR $@,"\n"; - print "not "; -} -print "ok ",$i++,"\n"; - -eval sprintf("use %.5f;", $] + 1); -unless ($@) { - print "not "; -} -print "ok ",$i++,"\n"; - -eval sprintf "use %.5f;", $] + 0.00001; -unless ($@) { - print "not "; -} -print "ok ",$i++,"\n"; - - - -use lib; # I know that this module will be there. - - -local $lib::VERSION = 1.0; - -eval "use lib 0.9"; -if ($@) { - print STDERR $@,"\n"; - print "not "; -} -print "ok ",$i++,"\n"; - -eval "use lib 1.0"; -if ($@) { - print STDERR $@,"\n"; - print "not "; -} -print "ok ",$i++,"\n"; - -eval "use lib 1.01"; -unless ($@) { - print "not "; -} -print "ok ",$i++,"\n"; - - -eval "use lib 0.9 qw(fred)"; -if ($@) { - print STDERR $@,"\n"; - print "not "; -} -print "ok ",$i++,"\n"; - -print "not " unless $INC[0] eq "fred"; -print "ok ",$i++,"\n"; - -eval "use lib 1.0 qw(joe)"; -if ($@) { - print STDERR $@,"\n"; - print "not "; -} -print "ok ",$i++,"\n"; - -print "not " unless $INC[0] eq "joe"; -print "ok ",$i++,"\n"; - -eval "use lib 1.01 qw(freda)"; -unless ($@) { - print "not "; -} -print "ok ",$i++,"\n"; - -print "not " if $INC[0] eq "freda"; -print "ok ",$i++,"\n"; diff --git a/t/pragma/locale.t b/t/pragma/locale.t new file mode 100755 index 0000000..e69de29 diff --git a/t/pragma/overload.t b/t/pragma/overload.t new file mode 100755 index 0000000..e69de29 diff --git a/t/pragma/strict.t b/t/pragma/strict.t new file mode 100755 index 0000000..e69de29 diff --git a/t/pragma/subs.t b/t/pragma/subs.t new file mode 100755 index 0000000..e69de29 diff --git a/t/pragma/warning.t b/t/pragma/warning.t new file mode 100755 index 0000000..e69de29