From: Jarkko Hietaniemi Date: Fri, 17 May 2002 03:08:01 +0000 (+0000) Subject: Upgrade to Switch 2.07. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6596d39b554785758f393f2dda70b41e7e3c4251;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Switch 2.07. p4raw-id: //depot/perl@16643 --- diff --git a/lib/Switch.pm b/lib/Switch.pm index 7f05bc0..c1820bf 100644 --- a/lib/Switch.pm +++ b/lib/Switch.pm @@ -4,7 +4,7 @@ use strict; use vars qw($VERSION); use Carp; -$VERSION = '2.06'; +$VERSION = '2.07'; # LOAD FILTERING MODULE... @@ -22,7 +22,6 @@ my ($Perl5, $Perl6) = (0,0); sub import { - $DB::single = 1; $fallthrough = grep /\bfallthrough\b/, @_; $offset = (caller)[2]+1; filter_add({}) unless @_>1 && $_[1] eq 'noimport'; @@ -92,6 +91,7 @@ sub filter_blocks || $Perl6 && $source =~ /when|given/; pos $source = 0; my $text = ""; + $DB::single = 1; component: while (pos $source < length $source) { if ($source =~ m/(\G\s*use\s+Switch\b)/gc) @@ -116,15 +116,20 @@ sub filter_blocks } if ($Perl5 && $source =~ m/\G(\n*)(\s*)(switch)\b(?=\s*[(])/gc - || $Perl6 && $source =~ m/\G(\n*)(\s*)(given)\b(?=\s*[(])/gc) + || $Perl6 && $source =~ m/\G(\n*)(\s*)(given)\b(?=\s*[(])/gc + || $Perl6 && $source =~ m/\G(\n*)(\s*)(given)\b(.*)(?=\{)/gc) { my $keyword = $3; + my $arg = $4; + print STDERR "[$arg]\n"; $text .= $1.$2.'S_W_I_T_C_H: while (1) '; - @pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\(/,qr/\)/,qr/[[{(<]/,qr/[]})>]/,undef) - or do { - die "Bad $keyword statement (problem in the parentheses?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n"; - }; - my $arg = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line)); + unless ($arg) { + @pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\(/,qr/\)/,qr/[[{(<]/,qr/[]})>]/,undef) + or do { + die "Bad $keyword statement (problem in the parentheses?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n"; + }; + $arg = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line)); + } $arg =~ s {^\s*[(]\s*%} { ( \\\%} || $arg =~ s {^\s*[(]\s*m\b} { ( qr} || $arg =~ s {^\s*[(]\s*/} { ( qr/} || @@ -171,7 +176,7 @@ sub filter_blocks $text .= " $code)"; } elsif ($Perl5 && $source =~ m/\G\s*(([^\$\@{])[^\$\@{]*)(?=\s*{)/gc - || $Perl6 && $source =~ m/\G\s*([^:;]*)()/gc) { + || $Perl6 && $source =~ m/\G\s*([^;{]*)()/gc) { my $code = filter_blocks($1,line(substr($source,0,pos $source),$line)); $text .= ' \\' if $2 eq '%'; $text .= " $code)"; @@ -180,8 +185,8 @@ sub filter_blocks die "Bad $keyword statement (invalid $keyword value?) near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n"; } - die "Missing colon or semi-colon after 'when' value near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n" - unless !$Perl6 || $source =~ m/\G(\s*)(:|(?=;))/gc; + die "Missing opening brace or semi-colon after 'when' value near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n" + unless !$Perl6 || $source =~ m/\G(\s*)(?=;|\{)/gc; do{@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)} or do { @@ -487,8 +492,8 @@ Switch - A switch statement for Perl =head1 VERSION -This document describes version 2.06 of Switch, -released November 14, 2001. +This document describes version 2.07 of Switch, +released May 15, 2002. =head1 SYNOPSIS @@ -739,23 +744,25 @@ Perl 6 will provide a built-in switch statement with essentially the same semantics as those offered by Switch.pm, but with a different pair of keywords. In Perl 6 C with be spelled C, and C will be pronounced C. In addition, the C statement -will use a colon between its case value and its block (removing the -need to parenthesize variables. +will not require switch or case values to be parenthesized. -This future syntax is also available via the Switch.pm module, by +This future syntax is also (largely) available via the Switch.pm module, by importing it with the argument C<"Perl6">. For example: use Switch 'Perl6'; given ($val) { - when 1 : { handle_num_1(); } - when $str1 : { handle_str_1(); } - when [0..9] : { handle_num_any(); last } - when /\d/ : { handle_dig_any(); } - when /.*/ : { handle_str_any(); } + when 1 { handle_num_1(); } + when ($str1) { handle_str_1(); } + when [0..9] { handle_num_any(); last } + when /\d/ { handle_dig_any(); } + when /.*/ { handle_str_any(); } } -Note that you can mix and match both syntaxes by importing the module +Note that scalars still need to be parenthesized, since they would be +ambiguous in Perl 5. + +Note too that you can mix and match both syntaxes by importing the module with: use Switch 'Perl5', 'Perl6'; diff --git a/lib/Switch/Changes b/lib/Switch/Changes index add2130..c872bdd 100755 --- a/lib/Switch/Changes +++ b/lib/Switch/Changes @@ -59,3 +59,12 @@ Revision history for Perl extension Switch. - Fixed the parsing of embedded POD (thanks Brent) - Fixed bug encountered when -s or -m file test used (thanks Jochen) + + +2.07 Wed May 15 15:19:28 2002 + + - Corified tests + + - Updated "Perl6" syntax to reflect current design + (as far as possible -- can't eliminate need to parenthesize + variables, since they're ambiguous in Perl 5) diff --git a/lib/Switch/README b/lib/Switch/README index f2cf139..5a51740 100644 --- a/lib/Switch/README +++ b/lib/Switch/README @@ -1,5 +1,5 @@ ============================================================================== - Release of version 2.06 of Switch + Release of version 2.07 of Switch ============================================================================== @@ -26,16 +26,14 @@ COPYRIGHT ============================================================================== -CHANGES IN VERSION 2.06 +CHANGES IN VERSION 2.07 - - Fixed parsing of ternary operators in Switch'ed source code - (at the expense of no longer correctly parsing ?...? regexes) - (thanks Mark) + - Corified tests - - Fixed the parsing of embedded POD (thanks Brent) - - - Fixed bug encountered when -s or -m file test used (thanks Jochen) + - Updated "Perl6" syntax to reflect current design + (as far as possible -- can't eliminate need to parenthesize + variables, since they're ambiguous in Perl 5) ============================================================================== diff --git a/lib/Switch/t/given.t b/lib/Switch/t/given.t index d47541a..c396c35 100755 --- a/lib/Switch/t/given.t +++ b/lib/Switch/t/given.t @@ -1,8 +1,8 @@ -#! /usr/local/bin/perl -w - BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if ($ENV{PERL_CORE}) { + chdir('t') if -d 't'; + @INC = qw(../lib); + } } use Carp; @@ -19,22 +19,22 @@ $when->{when} = { when => "when" }; # PREMATURE when -eval { when 1: { ok(0) }; ok(0) } || ok(1); +eval { when 1 { ok(0) }; ok(0) } || ok(1); # H.O. FUNCS -given (__ > 2) { +given __ > 2 { - when 1: { ok(0) } else { ok(1) } - when 2: { ok(0) } else { ok(1) } - when 3: { ok(1) } else { ok(0) } + when 1 { ok(0) } else { ok(1) } + when 2 { ok(0) } else { ok(1) } + when 3 { ok(1) } else { ok(0) } } given (3) { - eval { when __ <= 1 || __ > 2: { ok(0) } } || ok(1); - when __ <= 2: { ok(0) }; - when __ <= 3: { ok(1) }; + eval { when __ <= 1 || __ > 2 { ok(0) } } || ok(1); + when __ <= 2 { ok(0) }; + when __ <= 3 { ok(1) }; } # POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE @@ -45,40 +45,40 @@ for (1..3) { given ($_) { # SELF - when $_: { ok(1) } else { ok(0) } + when ($_) { ok(1) } else { ok(0) } # NUMERIC - when 1: { ok ($_==1) } else { ok($_!=1) } - when (1): { ok ($_==1) } else { ok($_!=1) } - when 3: { ok ($_==3) } else { ok($_!=3) } - when (4): { ok (0) } else { ok(1) } - when (2): { ok ($_==2) } else { ok($_!=2) } + when 1 { ok ($_==1) } else { ok($_!=1) } + when (1) { ok ($_==1) } else { ok($_!=1) } + when 3 { ok ($_==3) } else { ok($_!=3) } + when (4) { ok (0) } else { ok(1) } + when (2) { ok ($_==2) } else { ok($_!=2) } # STRING - when ('a'): { ok (0) } else { ok(1) } - when 'a' : { ok (0) } else { ok(1) } - when ('3'): { ok ($_ == 3) } else { ok($_ != 3) } - when ('3.0'): { ok (0) } else { ok(1) } + when ('a') { ok (0) } else { ok(1) } + when 'a' { ok (0) } else { ok(1) } + when ('3') { ok ($_ == 3) } else { ok($_ != 3) } + when ('3.0') { ok (0) } else { ok(1) } # ARRAY - when ([10,5,1]): { ok ($_==1) } else { ok($_!=1) } - when [10,5,1]: { ok ($_==1) } else { ok($_!=1) } - when (['a','b']): { ok (0) } else { ok(1) } - when (['a','b',3]): { ok ($_==3) } else { ok ($_!=3) } - when (['a','b',2.0]) : { ok ($_==2) } else { ok ($_!=2) } - when ([]) : { ok (0) } else { ok(1) } + when ([10,5,1]) { ok ($_==1) } else { ok($_!=1) } + when [10,5,1] { ok ($_==1) } else { ok($_!=1) } + when (['a','b']) { ok (0) } else { ok(1) } + when (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) } + when (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) } + when ([]) { ok (0) } else { ok(1) } # HASH - when ({}) : { ok (0) } else { ok (1) } - when {} : { ok (0) } else { ok (1) } - when {1,1} : { ok ($_==1) } else { ok($_!=1) } - when ({1=>1, 2=>0}) : { ok ($_==1) } else { ok($_!=1) } + when ({}) { ok (0) } else { ok (1) } + when {} { ok (0) } else { ok (1) } + when {1,1} { ok ($_==1) } else { ok($_!=1) } + when ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) } # SUB/BLOCK - when (sub {$_[0]==2}) : { ok ($_==2) } else { ok($_!=2) } - when {$_[0]==2} : { ok ($_==2) } else { ok($_!=2) } - when {0} : { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH - when {1} : { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH + when (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) } + when {$_[0]==2} { ok ($_==2) } else { ok($_!=2) } + when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH + when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH } } @@ -89,36 +89,36 @@ for ('a'..'c','1') { given ($_) { # SELF - when ($_) : { ok(1) } else { ok(0) } + when ($_) { ok(1) } else { ok(0) } # NUMERIC - when (1) : { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } - when (1.0) : { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } + when (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } + when (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } # STRING - when ('a') : { ok ($_ eq 'a') } else { ok($_ ne 'a') } - when ('b') : { ok ($_ eq 'b') } else { ok($_ ne 'b') } - when ('c') : { ok ($_ eq 'c') } else { ok($_ ne 'c') } - when ('1') : { ok ($_ eq '1') } else { ok($_ ne '1') } - when ('d') : { ok (0) } else { ok (1) } + when ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') } + when ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') } + when ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') } + when ('1') { ok ($_ eq '1') } else { ok($_ ne '1') } + when ('d') { ok (0) } else { ok (1) } # ARRAY - when (['a','1']) : { ok ($_ eq 'a' || $_ eq '1') } + when (['a','1']) { ok ($_ eq 'a' || $_ eq '1') } else { ok ($_ ne 'a' && $_ ne '1') } - when (['z','2']) : { ok (0) } else { ok(1) } - when ([]) : { ok (0) } else { ok(1) } + when (['z','2']) { ok (0) } else { ok(1) } + when ([]) { ok (0) } else { ok(1) } # HASH - when ({}) : { ok (0) } else { ok (1) } - when ({a=>'a', 1=>1, 2=>0}) : { ok ($_ eq 'a' || $_ eq '1') } + when ({}) { ok (0) } else { ok (1) } + when ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') } else { ok ($_ ne 'a' && $_ ne '1') } # SUB/BLOCK - when (sub{$_[0] eq 'a' }) : { ok ($_ eq 'a') } + when (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') } else { ok($_ ne 'a') } - when {$_[0] eq 'a'} : { ok ($_ eq 'a') } else { ok($_ ne 'a') } - when {0} : { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH - when {1} : { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH + when {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') } + when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH + when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH } } @@ -131,35 +131,35 @@ for ([],[1,'a'],[2,'b']) given ($_) { $iteration++; # SELF - when ($_) : { ok(1) } + when ($_) { ok(1) } # NUMERIC - when (1) : { ok ($iteration==2) } else { ok ($iteration!=2) } - when (1.0) : { ok ($iteration==2) } else { ok ($iteration!=2) } + when (1) { ok ($iteration==2) } else { ok ($iteration!=2) } + when (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) } # STRING - when ('a') : { ok ($iteration==2) } else { ok ($iteration!=2) } - when ('b') : { ok ($iteration==3) } else { ok ($iteration!=3) } - when ('1') : { ok ($iteration==2) } else { ok ($iteration!=2) } + when ('a') { ok ($iteration==2) } else { ok ($iteration!=2) } + when ('b') { ok ($iteration==3) } else { ok ($iteration!=3) } + when ('1') { ok ($iteration==2) } else { ok ($iteration!=2) } # ARRAY - when (['a',2]) : { ok ($iteration>=2) } else { ok ($iteration<2) } - when ([1,'a']) : { ok ($iteration==2) } else { ok($iteration!=2) } - when ([]) : { ok (0) } else { ok(1) } - when ([7..100]) : { ok (0) } else { ok(1) } + when (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) } + when ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) } + when ([]) { ok (0) } else { ok(1) } + when ([7..100]) { ok (0) } else { ok(1) } # HASH - when ({}) : { ok (0) } else { ok (1) } - when ({a=>'a', 1=>1, 2=>0}) : { ok ($iteration==2) } + when ({}) { ok (0) } else { ok (1) } + when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) } else { ok ($iteration!=2) } # SUB/BLOCK - when {scalar grep /a/, @_} : { ok ($iteration==2) } + when {scalar grep /a/, @_} { ok ($iteration==2) } else { ok ($iteration!=2) } - when (sub {scalar grep /a/, @_ }) : { ok ($iteration==2) } + when (sub {scalar grep /a/, @_ }) { ok ($iteration==2) } else { ok ($iteration!=2) } - when {0} : { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH - when {1} : { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH + when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH + when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH } } @@ -173,37 +173,37 @@ for ({},{a=>1,b=>0}) $iteration++; # SELF - when ($_) : { ok(1) } else { ok(0) } + when ($_) { ok(1) } else { ok(0) } # NUMERIC - when (1) : { ok (0) } else { ok (1) } - when (1.0) : { ok (0) } else { ok (1) } + when (1) { ok (0) } else { ok (1) } + when (1.0) { ok (0) } else { ok (1) } # STRING - when ('a') : { ok ($iteration==2) } else { ok ($iteration!=2) } - when ('b') : { ok (0) } else { ok (1) } - when ('c') : { ok (0) } else { ok (1) } + when ('a') { ok ($iteration==2) } else { ok ($iteration!=2) } + when ('b') { ok (0) } else { ok (1) } + when ('c') { ok (0) } else { ok (1) } # ARRAY - when (['a',2]) : { ok ($iteration==2) } + when (['a',2]) { ok ($iteration==2) } else { ok ($iteration!=2) } - when (['b','a']) : { ok ($iteration==2) } + when (['b','a']) { ok ($iteration==2) } else { ok ($iteration!=2) } - when (['b','c']) : { ok (0) } else { ok (1) } - when ([]) : { ok (0) } else { ok(1) } - when ([7..100]) : { ok (0) } else { ok(1) } + when (['b','c']) { ok (0) } else { ok (1) } + when ([]) { ok (0) } else { ok(1) } + when ([7..100]) { ok (0) } else { ok(1) } # HASH - when ({}) : { ok (0) } else { ok (1) } - when ({a=>'a', 1=>1, 2=>0}) : { ok (0) } else { ok (1) } + when ({}) { ok (0) } else { ok (1) } + when ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) } # SUB/BLOCK - when {$_[0]{a}} : { ok ($iteration==2) } + when {$_[0]{a}} { ok ($iteration==2) } else { ok ($iteration!=2) } - when (sub {$_[0]{a}}) : { ok ($iteration==2) } + when (sub {$_[0]{a}}) { ok ($iteration==2) } else { ok ($iteration!=2) } - when {0} : { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH - when {1} : { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH + when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH + when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH } } @@ -224,40 +224,40 @@ for ( sub {1}, given ($_) { $iteration++; # SELF - when ($_) : { ok(1) } else { ok(0) } + when ($_) { ok(1) } else { ok(0) } # NUMERIC - when (1) : { ok ($iteration<=2) } else { ok ($iteration>2) } - when (1.0) : { ok ($iteration<=2) } else { ok ($iteration>2) } - when (1.1) : { ok ($iteration==1) } else { ok ($iteration!=1) } + when (1) { ok ($iteration<=2) } else { ok ($iteration>2) } + when (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) } + when (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) } # STRING - when ('a') : { ok ($iteration==1) } else { ok ($iteration!=1) } - when ('b') : { ok ($iteration==1) } else { ok ($iteration!=1) } - when ('c') : { ok ($iteration==1) } else { ok ($iteration!=1) } - when ('1') : { ok ($iteration<=2) } else { ok ($iteration>2) } + when ('a') { ok ($iteration==1) } else { ok ($iteration!=1) } + when ('b') { ok ($iteration==1) } else { ok ($iteration!=1) } + when ('c') { ok ($iteration==1) } else { ok ($iteration!=1) } + when ('1') { ok ($iteration<=2) } else { ok ($iteration>2) } # ARRAY - when ([1, 'a']) : { ok ($iteration<=2) } + when ([1, 'a']) { ok ($iteration<=2) } else { ok ($iteration>2) } - when (['b','a']) : { ok ($iteration==1) } + when (['b','a']) { ok ($iteration==1) } else { ok ($iteration!=1) } - when (['b','c']) : { ok ($iteration==1) } + when (['b','c']) { ok ($iteration==1) } else { ok ($iteration!=1) } - when ([]) : { ok ($iteration==1) } else { ok($iteration!=1) } - when ([7..100]) : { ok ($iteration==1) } + when ([]) { ok ($iteration==1) } else { ok($iteration!=1) } + when ([7..100]) { ok ($iteration==1) } else { ok($iteration!=1) } # HASH - when ({}) : { ok ($iteration==1) } else { ok ($iteration!=1) } - when ({a=>'a', 1=>1, 2=>0}) : { ok ($iteration<=2) } + when ({}) { ok ($iteration==1) } else { ok ($iteration!=1) } + when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) } else { ok ($iteration>2) } # SUB/BLOCK - when {$_[0]->{a}} : { ok (0) } else { ok (1) } - when (sub {$_[0]{a}}) : { ok (0) } else { ok (1) } - when {0} : { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH - when {1} : { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH + when {$_[0]->{a}} { ok (0) } else { ok (1) } + when (sub {$_[0]{a}}) { ok (0) } else { ok (1) } + when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH + when {1} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH } } @@ -267,11 +267,11 @@ for ( sub {1}, for my $count (1..3) { given ([9,"a",11]) { - when (qr/\d/) : { + when (qr/\d/) { given ($count) { - when (1) : { ok($count==1) } + when (1) { ok($count==1) } else { ok($count!=1) } - when ([5,6]) : { ok(0) } else { ok(1) } + when ([5,6]) { ok(0) } else { ok(1) } } } ok(1) when 11; diff --git a/lib/Switch/t/nested.t b/lib/Switch/t/nested.t index 87451ed..e7e520a 100755 --- a/lib/Switch/t/nested.t +++ b/lib/Switch/t/nested.t @@ -1,8 +1,8 @@ -#! /usr/local/bin/perl -w - BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if ($ENV{PERL_CORE}) { + chdir('t') if -d 't'; + @INC = qw(../lib); + } } use Switch; diff --git a/lib/Switch/t/switch.t b/lib/Switch/t/switch.t index 5f5451d..ad0f958 100755 --- a/lib/Switch/t/switch.t +++ b/lib/Switch/t/switch.t @@ -1,8 +1,8 @@ -#! /usr/local/bin/perl -w - BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if ($ENV{PERL_CORE}) { + chdir('t') if -d 't'; + @INC = qw(../lib); + } } use Carp;