use vars qw($VERSION);
use Carp;
-$VERSION = '2.06';
+$VERSION = '2.07';
# LOAD FILTERING MODULE...
sub import
{
- $DB::single = 1;
$fallthrough = grep /\bfallthrough\b/, @_;
$offset = (caller)[2]+1;
filter_add({}) unless @_>1 && $_[1] eq 'noimport';
|| $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)
}
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/} ||
$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)";
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 {
=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
same semantics as those offered by Switch.pm, but with a different
pair of keywords. In Perl 6 C<switch> with be spelled C<given>, and
C<case> will be pronounced C<when>. In addition, the C<when> 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';
-#! /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;
# 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
{
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
}
}
{
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
}
}
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
}
}
$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
}
}
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
}
}
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;