This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove Switch from the core distribution. Get it from CPAN now.
authorNicholas Clark <nick@ccl4.org>
Mon, 19 Apr 2010 19:35:54 +0000 (20:35 +0100)
committerNicholas Clark <nick@ccl4.org>
Tue, 20 Apr 2010 20:32:50 +0000 (21:32 +0100)
MANIFEST
Porting/Maintainers.pl
dist/Switch/Changes [deleted file]
dist/Switch/MANIFEST [deleted file]
dist/Switch/META.yml [deleted file]
dist/Switch/Makefile.PL [deleted file]
dist/Switch/README [deleted file]
dist/Switch/Switch.pm [deleted file]
dist/Switch/t/given.t [deleted file]
dist/Switch/t/nested.t [deleted file]
dist/Switch/t/switch.t [deleted file]

index 8024fae..7195508 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2811,15 +2811,6 @@ dist/Storable/t/tied.t                   See if Storable works
 dist/Storable/t/utf8hash.t             See if Storable works
 dist/Storable/t/utf8.t                 See if Storable works
 dist/Storable/t/weak.t                 Can Storable store weakrefs
-dist/Switch/Changes            Changes for Switch.pm
-dist/Switch/Makefile.PL                Makefile.PL for Switch.pm
-dist/Switch/MANIFEST           MANIFEST for Switch.pm
-dist/Switch/META.yml           META.yml for Switch.pm
-dist/Switch/README             README for Switch.pm
-dist/Switch/Switch.pm          Switch for Perl
-dist/Switch/t/given.t          See if Perl 6 given (switch) works
-dist/Switch/t/nested.t         See if nested switch works
-dist/Switch/t/switch.t         See if Perl 5 switch works
 dist/Thread-Queue/lib/Thread/Queue.pm  Thread-safe queues
 dist/Thread-Queue/t/01_basic.t         Thread::Queue tests
 dist/Thread-Queue/t/02_refs.t          Thread::Queue tests
index 2d10b7c..d6bb9df 100755 (executable)
@@ -1374,16 +1374,6 @@ use File::Glob qw(:case);
        'UPSTREAM'      => 'blead',
        },
 
-    'Switch' =>
-       {
-       'MAINTAINER'    => 'rgarcia',
-       'DISTRIBUTION'  => 'RGARCIA/Switch-2.15.tar.gz',
-       'FILES'         => q[dist/Switch],
-       'CPAN'          => 1,
-       'UPSTREAM'      => 'blead',
-       'DEPRECATED'    => 5.011,
-       },
-
     'Sys::Syslog' =>
        {
        'MAINTAINER'    => 'saper',
diff --git a/dist/Switch/Changes b/dist/Switch/Changes
deleted file mode 100644 (file)
index ece38d8..0000000
+++ /dev/null
@@ -1,121 +0,0 @@
-Revision history for Perl extension Switch.
-
-0.01  Wed Dec 15 05:58:01 1999
-       - original version; created by h2xs 1.18
-
-
-
-2.00   Mon Jan  8 17:12:20 2001
-
-       - Complete revamp (including syntactic and semantic changes)
-         in line with proposed Perl 6 semantics.
-
-
-2.01   Tue Jan  9 07:19:02 2001
-
-       - Fixed infinite loop problem under 5.6.0 caused by change
-         in goto semantics between 5.00503 and 5.6.0
-         (thanks Scott!)
-         
-
-
-2.02   Thu Apr 26 12:01:06 2001
-
-       - Fixed unwarranted whitespace squeezing before quotelikes
-         (thanks Ray)
-
-       - Fixed pernicious bug that cause switch to fail to recognize
-         certain complex switch values
-
-
-2.03   Tue May 15 09:34:11 2001
-
-       - Fixed bug in 'fallthrough' specifications.
-
-       - Silenced gratuitous warnings for undefined values as
-         switch or case values
-
-
-2.04   Mon Jul 30 13:17:35 2001
-
-       - Suppressed 'undef value' warning under -w (thanks Michael)
-
-       - Added support for Perl 6 given..when syntax
-
-
-2.05   Mon Sep  3 08:13:25 2001
-
-       - Changed licence for inclusion in core distribution
-
-       - Added new test file for non-fallthrough and nested switches
-
-
-2.06   Wed Nov 14 16:18:54 2001
-
-       - Fixed parsing of ternary operators in Switch'ed source code
-         (at the expense of no longer correctly parsing ?...? regexes)
-         (thanks Mark)
-
-       - 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)
-
-
-2.09   Wed Jun 12 22:13:30 2002
-
-       - Removed spurious debugging statement
-
-
-2.10   Mon Dec 29 2003
-
-       - Introduce the "default" keyword for the Perl 6 syntax
-       - Raise the limitation on source file length to 1 million characters
-
-2.11   Wed Nov 22 2006
-
-       - Fix documentation issues
-       - Fix installation directory for perls >= 5.7.3 (Slaven Rezic)
-
-2.12   Mon Dec 11 2006
-
-       - Fix bug in parsing POD at end of document (Valentin Guignon)
-
-2.13   Sun Feb 25 2007
-
-       - Fix bug in parsing division statements (Wolfgang Laun)
-
-2.14   Mon Dec 29 2008
-
-       - Make Switch.pm skip POD like perl does
-         Patch provided by Daniel Klein <danielklein--airpost.net>
-         (bleadperl commit 39bcdda02ea582e7bdf8b0cf2e7186e89c6baea9)
-
-       - Fix line numbering issues with POD filtered by Switch.pm
-         Patch provided by Daniel Klein <danielklein--airpost.net>
-         (bleadperl commit 6a9befb105d93024902eb178dab77655333f1829)
-
-       - Switch.pm doesn't appear to support plain arrays and hashes in case().
-         (bleadperl commit cd3d9d47255d3080961ba7b58c9a145c7b45b905)
-
-       - Let us direct Switch questions to P5P.
-         (bleadperl commit b62fb10ea98565ce5572416500e1e3517cb17d33)
-
-       - POD nits from Frank Wiegand <frank.wiegand@gmail.com>
-         (bleadperl commit 3b46207fed7bf69caa32c27c04bd239cfb64cb53)
-
-2.15    Tue Oct 20 2009
-        - Deprecate shipping Switch.pm in the core distribution.
-          (Nicholas Clark)
-
-2.16    Fri Oct 23 2009
-        - For Perl 5.11+, install into 'site', not 'perl'
-
diff --git a/dist/Switch/MANIFEST b/dist/Switch/MANIFEST
deleted file mode 100644 (file)
index 4c50329..0000000
+++ /dev/null
@@ -1,9 +0,0 @@
-Changes
-MANIFEST
-Makefile.PL
-README
-Switch.pm
-t/given.t
-t/nested.t
-t/switch.t
-META.yml                                 Module meta-data (added by MakeMaker)
diff --git a/dist/Switch/META.yml b/dist/Switch/META.yml
deleted file mode 100644 (file)
index 2c42e24..0000000
+++ /dev/null
@@ -1,14 +0,0 @@
---- #YAML:1.0
-name:                Switch
-version:             2.16
-abstract:            ~
-license:             ~
-author:              ~
-generated_by:        ExtUtils::MakeMaker version 6.42
-distribution_type:   module
-requires:     
-    Filter::Util::Call:            0
-    Text::Balanced:                0
-meta-spec:
-    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
-    version: 1.3
diff --git a/dist/Switch/Makefile.PL b/dist/Switch/Makefile.PL
deleted file mode 100644 (file)
index 8d280f1..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-use ExtUtils::MakeMaker;
-WriteMakefile(
-    NAME => q[Switch],
-    VERSION_FROM => q[Switch.pm],
-    PREREQ_PM => { 'Filter::Util::Call' => 0, 'Text::Balanced' => 0 },
-    INSTALLDIRS => ($] >= 5.00703 && $] < 5.011) ? 'perl' : 'site',
-);
diff --git a/dist/Switch/README b/dist/Switch/README
deleted file mode 100644 (file)
index 6faf06b..0000000
+++ /dev/null
@@ -1,26 +0,0 @@
-==============================================================================
-                      Release of version 2.16 of Switch
-==============================================================================
-
-
-NAME
-    Switch - A switch statement for Perl
-
-DESCRIPTION
-
-    Switch.pm provides the syntax and semantics for an explicit case
-    mechanism for Perl. The syntax is minimal, introducing only the
-    keywords C<switch> and C<case> and conforming to the general pattern
-    of existing Perl control structures. The semantics are particularly
-    rich, allowing any one (or more) of nearly 30 forms of matching to
-    be used when comparing a switch value with its various cases.
-
-AUTHOR
-    Damian Conway (damian@conway.org)
-    Maintained by Rafael Garcia-Suarez (rgarciasuarez@gmail.com)
-    and the Perl 5 porters (perl5-porters@gmail.com)
-
-COPYRIGHT
-    Copyright (c) 1997-2008, Damian Conway. All Rights Reserved.
-    This module is free software. It may be used, redistributed
-        and/or modified under the same terms as Perl itself.
diff --git a/dist/Switch/Switch.pm b/dist/Switch/Switch.pm
deleted file mode 100644 (file)
index 2189ae0..0000000
+++ /dev/null
@@ -1,875 +0,0 @@
-package Switch;
-
-use strict;
-use vars qw($VERSION);
-use Carp;
-
-use if $] >= 5.011, 'deprecate';
-
-$VERSION = '2.16';
-  
-
-# LOAD FILTERING MODULE...
-use Filter::Util::Call;
-
-sub __();
-
-# CATCH ATTEMPTS TO CALL case OUTSIDE THE SCOPE OF ANY switch
-
-$::_S_W_I_T_C_H = sub { croak "case/when statement not in switch/given block" };
-
-my $offset;
-my $fallthrough;
-my ($Perl5, $Perl6) = (0,0);
-
-sub import
-{
-       $fallthrough = grep /\bfallthrough\b/, @_;
-       $offset = (caller)[2]+1;
-       filter_add({}) unless @_>1 && $_[1] eq 'noimport';
-       my $pkg = caller;
-       no strict 'refs';
-       for ( qw( on_defined on_exists ) )
-       {
-               *{"${pkg}::$_"} = \&$_;
-       }
-       *{"${pkg}::__"} = \&__ if grep /__/, @_;
-       $Perl6 = 1 if grep(/Perl\s*6/i, @_);
-       $Perl5 = 1 if grep(/Perl\s*5/i, @_) || !grep(/Perl\s*6/i, @_);
-       1;
-}
-
-sub unimport
-{      
-       filter_del()
-}
-
-sub filter
-{
-       my($self) = @_ ;
-       local $Switch::file = (caller)[1];
-
-       my $status = 1;
-       $status = filter_read(1_000_000);
-       return $status if $status<0;
-       $_ = filter_blocks($_,$offset);
-       $_ = "# line $offset\n" . $_ if $offset; undef $offset;
-       return $status;
-}
-
-use Text::Balanced ':ALL';
-
-sub line
-{
-       my ($pretext,$offset) = @_;
-       ($pretext=~tr/\n/\n/)+($offset||0);
-}
-
-sub is_block
-{
-       local $SIG{__WARN__}=sub{die$@};
-       local $^W=1;
-       my $ishash = defined  eval 'my $hr='.$_[0];
-       undef $@;
-       return !$ishash;
-}
-
-my $pod_or_DATA = qr/ ^=[A-Za-z] .*? ^=cut (?![A-Za-z]) .*? $
-                   | ^__(DATA|END)__\n.*
-                   /smx;
-
-my $casecounter = 1;
-sub filter_blocks
-{
-       my ($source, $line) = @_;
-       return $source unless $Perl5 && $source =~ /case|switch/
-                          || $Perl6 && $source =~ /when|given|default/;
-       pos $source = 0;
-       my $text = "";
-       component: while (pos $source < length $source)
-       {
-               if ($source =~ m/(\G\s*use\s+Switch\b)/gc)
-               {
-                       $text .= q{use Switch 'noimport'};
-                       next component;
-               }
-               my @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0);
-               if (defined $pos[0])
-               {
-                       my $pre = substr($source,$pos[0],$pos[1]); # matched prefix
-                        my $iEol;
-                        if( substr($source,$pos[4],$pos[5]) eq '/' && # 1st delimiter
-                            substr($source,$pos[2],$pos[3]) eq '' && # no op like 'm'
-                            index( substr($source,$pos[16],$pos[17]), 'x' ) == -1 && # no //x
-                            ($iEol = index( $source, "\n", $pos[4] )) > 0         &&
-                            $iEol < $pos[8] ){ # embedded newlines
-                            # If this is a pattern, it isn't compatible with Switch. Backup past 1st '/'.
-                            pos( $source ) = $pos[6];
-                           $text .= $pre . substr($source,$pos[2],$pos[6]-$pos[2]);
-                       } else {
-                           $text .= $pre . substr($source,$pos[2],$pos[18]-$pos[2]);
-                       }
-                       next component;
-               }
-               if ($source =~ m/(\G\s*$pod_or_DATA)/gc) {
-                       $text .= $1;
-                       next component;
-               }
-               @pos = Text::Balanced::_match_variable(\$source,qr/\s*/);
-               if (defined $pos[0])
-               {
-                       $text .= " " if $pos[0] < $pos[2];
-                       $text .= substr($source,$pos[0],$pos[4]-$pos[0]);
-                       next component;
-               }
-
-               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(.*)(?=\{)/gc)
-               {
-                       my $keyword = $3;
-                       my $arg = $4;
-                       $text .= $1.$2.'S_W_I_T_C_H: while (1) ';
-                       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/}      ||
-                       $arg =~ s {^\s*[(]\s*qw}  { ( \\qw};
-                       @pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)
-                       or do {
-                               die "Bad $keyword statement (problem in the code block?) near $Switch::file line ", line(substr($source,0, pos $source), $line), "\n";
-                       };
-                       my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
-                       $code =~ s/{/{ local \$::_S_W_I_T_C_H; Switch::switch $arg;/;
-                       $text .= $code . 'continue {last}';
-                       next component;
-               }
-               elsif ($Perl5 && $source =~ m/\G(\s*)(case\b)(?!\s*=>)/gc
-                   || $Perl6 && $source =~ m/\G(\s*)(when\b)(?!\s*=>)/gc
-                   || $Perl6 && $source =~ m/\G(\s*)(default\b)(?=\s*\{)/gc)
-               {
-                       my $keyword = $2;
-                       $text .= $1 . ($keyword eq "default"
-                                       ? "if (1)"
-                                       : "if (Switch::case");
-
-                       if ($keyword eq "default") {
-                               # Nothing to do
-                       }
-                       elsif (@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)) {
-                               my $code = substr($source,$pos[0],$pos[4]-$pos[0]);
-                               $text .= " " if $pos[0] < $pos[2];
-                               $text .= "sub " if is_block $code;
-                               $text .= filter_blocks($code,line(substr($source,0,$pos[0]),$line)) . ")";
-                       }
-                       elsif (@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/[[(]/,qr/[])]/,qr/[[({]/,qr/[])}]/,undef)) {
-                               my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
-                               $code =~ s {^\s*[(]\s*%}   { ( \\\%}    ||
-                               $code =~ s {^\s*[(]\s*m\b} { ( qr}      ||
-                               $code =~ s {^\s*[(]\s*/}   { ( qr/}     ||
-                               $code =~ s {^\s*[(]\s*qw}  { ( \\qw};
-                               $text .= " " if $pos[0] < $pos[2];
-                               $text .= "$code)";
-                       }
-                       elsif ($Perl6 && do{@pos = Text::Balanced::_match_variable(\$source,qr/\s*/)}) {
-                               my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
-                               $code =~ s {^\s*%}  { \%}       ||
-                               $code =~ s {^\s*@}  { \@};
-                               $text .= " " if $pos[0] < $pos[2];
-                               $text .= "$code)";
-                       }
-                       elsif ( @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0)) {
-                               my $code = substr($source,$pos[2],$pos[18]-$pos[2]);
-                               $code = filter_blocks($code,line(substr($source,0,$pos[2]),$line));
-                               $code =~ s {^\s*m}  { qr}       ||
-                               $code =~ s {^\s*/}  { qr/}      ||
-                               $code =~ s {^\s*qw} { \\qw};
-                               $text .= " " if $pos[0] < $pos[2];
-                               $text .= "$code)";
-                       }
-                       elsif ($Perl5 && $source =~ m/\G\s*(([^\$\@{])[^\$\@{]*)(?=\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)";
-                       }
-                       else {
-                               die "Bad $keyword statement (invalid $keyword value?) near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n";
-                       }
-
-                       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 {
-                               if ($source =~ m/\G\s*(?=([};]|\Z))/gc) {
-                                       $casecounter++;
-                                       next component;
-                               }
-                               die "Bad $keyword statement (problem in the code block?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n";
-                       };
-                       my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
-                       $code =~ s/}(?=\s*\Z)/;last S_W_I_T_C_H }/
-                               unless $fallthrough;
-                       $text .= "{ while (1) $code continue { goto C_A_S_E_$casecounter } last S_W_I_T_C_H; C_A_S_E_$casecounter: }";
-                       $casecounter++;
-                       next component;
-               }
-
-               $source =~ m/\G(\s*(-[sm]\s+|\w+|#.*\n|\W))/gc;
-               $text .= $1;
-       }
-       $text;
-}
-
-
-
-sub in
-{
-       my ($x,$y) = @_;
-       my @numy;
-       for my $nextx ( @$x )
-       {
-               my $numx = ref($nextx) || defined $nextx && (~$nextx&$nextx) eq 0;
-               for my $j ( 0..$#$y )
-               {
-                       my $nexty = $y->[$j];
-                       push @numy, ref($nexty) || defined $nexty && (~$nexty&$nexty) eq 0
-                               if @numy <= $j;
-                       return 1 if $numx && $numy[$j] && $nextx==$nexty
-                                || $nextx eq $nexty;
-                       
-               }
-       }
-       return "";
-}
-
-sub on_exists
-{
-       my $ref = @_==1 && ref($_[0]) eq 'HASH' ? $_[0] : { @_ };
-       [ keys %$ref ]
-}
-
-sub on_defined
-{
-       my $ref = @_==1 && ref($_[0]) eq 'HASH' ? $_[0] : { @_ };
-       [ grep { defined $ref->{$_} } keys %$ref ]
-}
-
-sub switch(;$)
-{
-       my ($s_val) = @_ ? $_[0] : $_;
-       my $s_ref = ref $s_val;
-       
-       if ($s_ref eq 'CODE')
-       {
-               $::_S_W_I_T_C_H =
-                     sub { my $c_val = $_[0];
-                           return $s_val == $c_val  if ref $c_val eq 'CODE';
-                           return $s_val->(@$c_val) if ref $c_val eq 'ARRAY';
-                           return $s_val->($c_val);
-                         };
-       }
-       elsif ($s_ref eq "" && defined $s_val && (~$s_val&$s_val) eq 0) # NUMERIC SCALAR
-       {
-               $::_S_W_I_T_C_H =
-                     sub { my $c_val = $_[0];
-                           my $c_ref = ref $c_val;
-                           return $s_val == $c_val     if $c_ref eq ""
-                                                       && defined $c_val
-                                                       && (~$c_val&$c_val) eq 0;
-                           return $s_val eq $c_val     if $c_ref eq "";
-                           return in([$s_val],$c_val)  if $c_ref eq 'ARRAY';
-                           return $c_val->($s_val)     if $c_ref eq 'CODE';
-                           return $c_val->call($s_val) if $c_ref eq 'Switch';
-                           return scalar $s_val=~/$c_val/
-                                                       if $c_ref eq 'Regexp';
-                           return scalar $c_val->{$s_val}
-                                                       if $c_ref eq 'HASH';
-                           return;     
-                         };
-       }
-       elsif ($s_ref eq "")                            # STRING SCALAR
-       {
-               $::_S_W_I_T_C_H =
-                     sub { my $c_val = $_[0];
-                           my $c_ref = ref $c_val;
-                           return $s_val eq $c_val     if $c_ref eq "";
-                           return in([$s_val],$c_val)  if $c_ref eq 'ARRAY';
-                           return $c_val->($s_val)     if $c_ref eq 'CODE';
-                           return $c_val->call($s_val) if $c_ref eq 'Switch';
-                           return scalar $s_val=~/$c_val/
-                                                       if $c_ref eq 'Regexp';
-                           return scalar $c_val->{$s_val}
-                                                       if $c_ref eq 'HASH';
-                           return;     
-                         };
-       }
-       elsif ($s_ref eq 'ARRAY')
-       {
-               $::_S_W_I_T_C_H =
-                     sub { my $c_val = $_[0];
-                           my $c_ref = ref $c_val;
-                           return in($s_val,[$c_val])  if $c_ref eq "";
-                           return in($s_val,$c_val)    if $c_ref eq 'ARRAY';
-                           return $c_val->(@$s_val)    if $c_ref eq 'CODE';
-                           return $c_val->call(@$s_val)
-                                                       if $c_ref eq 'Switch';
-                           return scalar grep {$_=~/$c_val/} @$s_val
-                                                       if $c_ref eq 'Regexp';
-                           return scalar grep {$c_val->{$_}} @$s_val
-                                                       if $c_ref eq 'HASH';
-                           return;     
-                         };
-       }
-       elsif ($s_ref eq 'Regexp')
-       {
-               $::_S_W_I_T_C_H =
-                     sub { my $c_val = $_[0];
-                           my $c_ref = ref $c_val;
-                           return $c_val=~/s_val/      if $c_ref eq "";
-                           return scalar grep {$_=~/s_val/} @$c_val
-                                                       if $c_ref eq 'ARRAY';
-                           return $c_val->($s_val)     if $c_ref eq 'CODE';
-                           return $c_val->call($s_val) if $c_ref eq 'Switch';
-                           return $s_val eq $c_val     if $c_ref eq 'Regexp';
-                           return grep {$_=~/$s_val/ && $c_val->{$_}} keys %$c_val
-                                                       if $c_ref eq 'HASH';
-                           return;     
-                         };
-       }
-       elsif ($s_ref eq 'HASH')
-       {
-               $::_S_W_I_T_C_H =
-                     sub { my $c_val = $_[0];
-                           my $c_ref = ref $c_val;
-                           return $s_val->{$c_val}     if $c_ref eq "";
-                           return scalar grep {$s_val->{$_}} @$c_val
-                                                       if $c_ref eq 'ARRAY';
-                           return $c_val->($s_val)     if $c_ref eq 'CODE';
-                           return $c_val->call($s_val) if $c_ref eq 'Switch';
-                           return grep {$_=~/$c_val/ && $s_val->{"$_"}} keys %$s_val
-                                                       if $c_ref eq 'Regexp';
-                           return $s_val==$c_val       if $c_ref eq 'HASH';
-                           return;     
-                         };
-       }
-       elsif ($s_ref eq 'Switch')
-       {
-               $::_S_W_I_T_C_H =
-                     sub { my $c_val = $_[0];
-                           return $s_val == $c_val  if ref $c_val eq 'Switch';
-                           return $s_val->call(@$c_val)
-                                                    if ref $c_val eq 'ARRAY';
-                           return $s_val->call($c_val);
-                         };
-       }
-       else
-       {
-               croak "Cannot switch on $s_ref";
-       }
-       return 1;
-}
-
-sub case($) { local $SIG{__WARN__} = \&carp;
-             $::_S_W_I_T_C_H->(@_); }
-
-# IMPLEMENT __
-
-my $placeholder = bless { arity=>1, impl=>sub{$_[1+$_[0]]} };
-
-sub __() { $placeholder }
-
-sub __arg($)
-{
-       my $index = $_[0]+1;
-       bless { arity=>0, impl=>sub{$_[$index]} };
-}
-
-sub hosub(&@)
-{
-       # WRITE THIS
-}
-
-sub call
-{
-       my ($self,@args) = @_;
-       return $self->{impl}->(0,@args);
-}
-
-sub meta_bop(&)
-{
-       my ($op) = @_;
-       sub
-       {
-               my ($left, $right, $reversed) = @_;
-               ($right,$left) = @_ if $reversed;
-
-               my $rop = ref $right eq 'Switch'
-                       ? $right
-                       : bless { arity=>0, impl=>sub{$right} };
-
-               my $lop = ref $left eq 'Switch'
-                       ? $left
-                       : bless { arity=>0, impl=>sub{$left} };
-
-               my $arity = $lop->{arity} + $rop->{arity};
-
-               return bless {
-                               arity => $arity,
-                               impl  => sub { my $start = shift;
-                                              return $op->($lop->{impl}->($start,@_),
-                                                           $rop->{impl}->($start+$lop->{arity},@_));
-                                            }
-                            };
-       };
-}
-
-sub meta_uop(&)
-{
-       my ($op) = @_;
-       sub
-       {
-               my ($left) = @_;
-
-               my $lop = ref $left eq 'Switch'
-                       ? $left
-                       : bless { arity=>0, impl=>sub{$left} };
-
-               my $arity = $lop->{arity};
-
-               return bless {
-                               arity => $arity,
-                               impl  => sub { $op->($lop->{impl}->(@_)) }
-                            };
-       };
-}
-
-
-use overload
-       "+"     =>      meta_bop {$_[0] + $_[1]},
-       "-"     =>      meta_bop {$_[0] - $_[1]},  
-       "*"     =>      meta_bop {$_[0] * $_[1]},
-       "/"     =>      meta_bop {$_[0] / $_[1]},
-       "%"     =>      meta_bop {$_[0] % $_[1]},
-       "**"    =>      meta_bop {$_[0] ** $_[1]},
-       "<<"    =>      meta_bop {$_[0] << $_[1]},
-       ">>"    =>      meta_bop {$_[0] >> $_[1]},
-       "x"     =>      meta_bop {$_[0] x $_[1]},
-       "."     =>      meta_bop {$_[0] . $_[1]},
-       "<"     =>      meta_bop {$_[0] < $_[1]},
-       "<="    =>      meta_bop {$_[0] <= $_[1]},
-       ">"     =>      meta_bop {$_[0] > $_[1]},
-       ">="    =>      meta_bop {$_[0] >= $_[1]},
-       "=="    =>      meta_bop {$_[0] == $_[1]},
-       "!="    =>      meta_bop {$_[0] != $_[1]},
-       "<=>"   =>      meta_bop {$_[0] <=> $_[1]},
-       "lt"    =>      meta_bop {$_[0] lt $_[1]},
-       "le"    =>      meta_bop {$_[0] le $_[1]},
-       "gt"    =>      meta_bop {$_[0] gt $_[1]},
-       "ge"    =>      meta_bop {$_[0] ge $_[1]},
-       "eq"    =>      meta_bop {$_[0] eq $_[1]},
-       "ne"    =>      meta_bop {$_[0] ne $_[1]},
-       "cmp"   =>      meta_bop {$_[0] cmp $_[1]},
-       "\&"    =>      meta_bop {$_[0] & $_[1]},
-       "^"     =>      meta_bop {$_[0] ^ $_[1]},
-       "|"     =>      meta_bop {$_[0] | $_[1]},
-       "atan2" =>      meta_bop {atan2 $_[0], $_[1]},
-
-       "neg"   =>      meta_uop {-$_[0]},
-       "!"     =>      meta_uop {!$_[0]},
-       "~"     =>      meta_uop {~$_[0]},
-       "cos"   =>      meta_uop {cos $_[0]},
-       "sin"   =>      meta_uop {sin $_[0]},
-       "exp"   =>      meta_uop {exp $_[0]},
-       "abs"   =>      meta_uop {abs $_[0]},
-       "log"   =>      meta_uop {log $_[0]},
-       "sqrt"  =>      meta_uop {sqrt $_[0]},
-       "bool"  =>      sub { croak "Can't use && or || in expression containing __" },
-
-       #       "&()"   =>      sub { $_[0]->{impl} },
-
-       #       "||"    =>      meta_bop {$_[0] || $_[1]},
-       #       "&&"    =>      meta_bop {$_[0] && $_[1]},
-       # fallback => 1,
-       ;
-1;
-
-__END__
-
-
-=head1 NAME
-
-Switch - A switch statement for Perl
-
-=head1 SYNOPSIS
-
-    use Switch;
-
-    switch ($val) {
-       case 1          { print "number 1" }
-       case "a"        { print "string a" }
-       case [1..10,42] { print "number in list" }
-       case (\@array)  { print "number in list" }
-       case /\w+/      { print "pattern" }
-       case qr/\w+/    { print "pattern" }
-       case (\%hash)   { print "entry in hash" }
-       case (\&sub)    { print "arg to subroutine" }
-       else            { print "previous case not true" }
-    }
-
-=head1 BACKGROUND
-
-[Skip ahead to L<"DESCRIPTION"> if you don't care about the whys
-and wherefores of this control structure]
-
-In seeking to devise a "Swiss Army" case mechanism suitable for Perl,
-it is useful to generalize this notion of distributed conditional
-testing as far as possible. Specifically, the concept of "matching"
-between the switch value and the various case values need not be
-restricted to numeric (or string or referential) equality, as it is in other 
-languages. Indeed, as Table 1 illustrates, Perl
-offers at least eighteen different ways in which two values could
-generate a match.
-
-       Table 1: Matching a switch value ($s) with a case value ($c)
-
-        Switch  Case    Type of Match Implied   Matching Code
-        Value   Value   
-        ======  =====   =====================   =============
-
-        number  same    numeric or referential  match if $s == $c;
-        or ref          equality
-
-       object  method  result of method call   match if $s->$c();
-       ref     name                            match if defined $s->$c();
-               or ref
-
-        other   other   string equality         match if $s eq $c;
-        non-ref non-ref
-        scalar  scalar
-
-        string  regexp  pattern match           match if $s =~ /$c/;
-
-        array   scalar  array entry existence   match if 0<=$c && $c<@$s;
-        ref             array entry definition  match if defined $s->[$c];
-                        array entry truth       match if $s->[$c];
-
-        array   array   array intersection      match if intersects(@$s, @$c);
-        ref     ref     (apply this table to
-                         all pairs of elements
-                         $s->[$i] and
-                         $c->[$j])
-
-        array   regexp  array grep              match if grep /$c/, @$s;
-        ref     
-
-        hash    scalar  hash entry existence    match if exists $s->{$c};
-        ref             hash entry definition   match if defined $s->{$c};
-                        hash entry truth        match if $s->{$c};
-
-        hash    regexp  hash grep               match if grep /$c/, keys %$s;
-        ref     
-
-        sub     scalar  return value defn       match if defined $s->($c);
-        ref             return value truth      match if $s->($c);
-
-        sub     array   return value defn       match if defined $s->(@$c);
-        ref     ref     return value truth      match if $s->(@$c);
-
-
-In reality, Table 1 covers 31 alternatives, because only the equality and
-intersection tests are commutative; in all other cases, the roles of
-the C<$s> and C<$c> variables could be reversed to produce a
-different test. For example, instead of testing a single hash for
-the existence of a series of keys (C<match if exists $s-E<gt>{$c}>),
-one could test for the existence of a single key in a series of hashes
-(C<match if exists $c-E<gt>{$s}>).
-
-=head1 DESCRIPTION
-
-The Switch.pm module implements a generalized case mechanism that covers
-most (but not all) of the numerous possible combinations of switch and case
-values described above.
-
-The module augments the standard Perl syntax with two new control
-statements: C<switch> and C<case>. The C<switch> statement takes a
-single scalar argument of any type, specified in parentheses.
-C<switch> stores this value as the
-current switch value in a (localized) control variable.
-The value is followed by a block which may contain one or more
-Perl statements (including the C<case> statement described below).
-The block is unconditionally executed once the switch value has
-been cached.
-
-A C<case> statement takes a single scalar argument (in mandatory
-parentheses if it's a variable; otherwise the parens are optional) and
-selects the appropriate type of matching between that argument and the
-current switch value. The type of matching used is determined by the
-respective types of the switch value and the C<case> argument, as
-specified in Table 1. If the match is successful, the mandatory
-block associated with the C<case> statement is executed.
-
-In most other respects, the C<case> statement is semantically identical
-to an C<if> statement. For example, it can be followed by an C<else>
-clause, and can be used as a postfix statement qualifier. 
-
-However, when a C<case> block has been executed control is automatically
-transferred to the statement after the immediately enclosing C<switch>
-block, rather than to the next statement within the block. In other
-words, the success of any C<case> statement prevents other cases in the
-same scope from executing. But see L<"Allowing fall-through"> below.
-
-Together these two new statements provide a fully generalized case
-mechanism:
-
-        use Switch;
-
-        # AND LATER...
-
-        %special = ( woohoo => 1,  d'oh => 1 );
-
-        while (<>) {
-           chomp;
-            switch ($_) {
-                case (%special) { print "homer\n"; }      # if $special{$_}
-                case /[a-z]/i   { print "alpha\n"; }      # if $_ =~ /a-z/i
-                case [1..9]     { print "small num\n"; }  # if $_ in [1..9]
-                case { $_[0] >= 10 } { print "big num\n"; } # if $_ >= 10
-                print "must be punctuation\n" case /\W/;  # if $_ ~= /\W/
-           }
-        }
-
-Note that C<switch>es can be nested within C<case> (or any other) blocks,
-and a series of C<case> statements can try different types of matches
--- hash membership, pattern match, array intersection, simple equality,
-etc. -- against the same switch value.
-
-The use of intersection tests against an array reference is particularly
-useful for aggregating integral cases:
-
-        sub classify_digit
-        {
-                switch ($_[0]) { case 0            { return 'zero' }
-                                 case [2,4,6,8]    { return 'even' }
-                                 case [1,3,5,7,9]  { return 'odd' }
-                                 case /[A-F]/i     { return 'hex' }
-                               }
-        }
-
-
-=head2 Allowing fall-through
-
-Fall-though (trying another case after one has already succeeded)
-is usually a Bad Idea in a switch statement. However, this
-is Perl, not a police state, so there I<is> a way to do it, if you must.
-
-If a C<case> block executes an untargeted C<next>, control is
-immediately transferred to the statement I<after> the C<case> statement
-(i.e. usually another case), rather than out of the surrounding
-C<switch> block.
-
-For example:
-
-        switch ($val) {
-                case 1      { handle_num_1(); next }    # and try next case...
-                case "1"    { handle_str_1(); next }    # and try next case...
-                case [0..9] { handle_num_any(); }       # and we're done
-                case /\d/   { handle_dig_any(); next }  # and try next case...
-                case /.*/   { handle_str_any(); next }  # and try next case...
-        }
-
-If $val held the number C<1>, the above C<switch> block would call the
-first three C<handle_...> subroutines, jumping to the next case test
-each time it encountered a C<next>. After the third C<case> block
-was executed, control would jump to the end of the enclosing
-C<switch> block.
-
-On the other hand, if $val held C<10>, then only the last two C<handle_...>
-subroutines would be called.
-
-Note that this mechanism allows the notion of I<conditional fall-through>.
-For example:
-
-        switch ($val) {
-                case [0..9] { handle_num_any(); next if $val < 7; }
-                case /\d/   { handle_dig_any(); }
-        }
-
-If an untargeted C<last> statement is executed in a case block, this
-immediately transfers control out of the enclosing C<switch> block
-(in other words, there is an implicit C<last> at the end of each
-normal C<case> block). Thus the previous example could also have been
-written:
-
-        switch ($val) {
-                case [0..9] { handle_num_any(); last if $val >= 7; next; }
-                case /\d/   { handle_dig_any(); }
-        }
-
-
-=head2 Automating fall-through
-
-In situations where case fall-through should be the norm, rather than an
-exception, an endless succession of terminal C<next>s is tedious and ugly.
-Hence, it is possible to reverse the default behaviour by specifying
-the string "fallthrough" when importing the module. For example, the 
-following code is equivalent to the first example in L<"Allowing fall-through">:
-
-        use Switch 'fallthrough';
-
-        switch ($val) {
-                case 1      { handle_num_1(); }
-                case "1"    { handle_str_1(); }
-                case [0..9] { handle_num_any(); last }
-                case /\d/   { handle_dig_any(); }
-                case /.*/   { handle_str_any(); }
-        }
-
-Note the explicit use of a C<last> to preserve the non-fall-through
-behaviour of the third case.
-
-
-
-=head2 Alternative syntax
-
-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<switch> will be spelled C<given>, and
-C<case> will be pronounced C<when>. In addition, the C<when> statement
-will not require switch or case values to be parenthesized.
-
-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(); }
-                default      { handle anything else; }
-        }
-
-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';
-
-
-=head2 Higher-order Operations
-
-One situation in which C<switch> and C<case> do not provide a good
-substitute for a cascaded C<if>, is where a switch value needs to
-be tested against a series of conditions. For example:
-
-        sub beverage {
-            switch (shift) {
-                case { $_[0] < 10 } { return 'milk' }
-                case { $_[0] < 20 } { return 'coke' }
-                case { $_[0] < 30 } { return 'beer' }
-                case { $_[0] < 40 } { return 'wine' }
-                case { $_[0] < 50 } { return 'malt' }
-                case { $_[0] < 60 } { return 'Moet' }
-                else                { return 'milk' }
-            }
-        }
-
-(This is equivalent to writing C<case (sub { $_[0] < 10 })>, etc.; C<$_[0]>
-is the argument to the anonymous subroutine.)
-
-The need to specify each condition as a subroutine block is tiresome. To
-overcome this, when importing Switch.pm, a special "placeholder"
-subroutine named C<__> [sic] may also be imported. This subroutine
-converts (almost) any expression in which it appears to a reference to a
-higher-order function. That is, the expression:
-
-        use Switch '__';
-
-        __ < 2
-
-is equivalent to:
-
-        sub { $_[0] < 2 }
-
-With C<__>, the previous ugly case statements can be rewritten:
-
-        case  __ < 10  { return 'milk' }
-        case  __ < 20  { return 'coke' }
-        case  __ < 30  { return 'beer' }
-        case  __ < 40  { return 'wine' }
-        case  __ < 50  { return 'malt' }
-        case  __ < 60  { return 'Moet' }
-        else           { return 'milk' }
-
-The C<__> subroutine makes extensive use of operator overloading to
-perform its magic. All operations involving __ are overloaded to
-produce an anonymous subroutine that implements a lazy version
-of the original operation.
-
-The only problem is that operator overloading does not allow the
-boolean operators C<&&> and C<||> to be overloaded. So a case statement
-like this:
-
-        case  0 <= __ && __ < 10  { return 'digit' }  
-
-doesn't act as expected, because when it is
-executed, it constructs two higher order subroutines
-and then treats the two resulting references as arguments to C<&&>:
-
-        sub { 0 <= $_[0] } && sub { $_[0] < 10 }
-
-This boolean expression is inevitably true, since both references are
-non-false. Fortunately, the overloaded C<'bool'> operator catches this
-situation and flags it as an error. 
-
-=head1 DEPENDENCIES
-
-The module is implemented using Filter::Util::Call and Text::Balanced
-and requires both these modules to be installed. 
-
-=head1 AUTHOR
-
-Damian Conway (damian@conway.org). This module is now maintained by Rafael
-Garcia-Suarez (rgarciasuarez@gmail.com) and more generally by the Perl 5
-Porters (perl5-porters@perl.org), as part of the Perl core.
-
-=head1 BUGS
-
-There are undoubtedly serious bugs lurking somewhere in code this funky :-)
-Bug reports and other feedback are most welcome.
-
-=head1 LIMITATIONS
-
-Due to the heuristic nature of Switch.pm's source parsing, the presence of
-regexes with embedded newlines that are specified with raw C</.../>
-delimiters and don't have a modifier C<//x> are indistinguishable from
-code chunks beginning with the division operator C</>. As a workaround
-you must use C<m/.../> or C<m?...?> for such patterns. Also, the presence
-of regexes specified with raw C<?...?> delimiters may cause mysterious
-errors. The workaround is to use C<m?...?> instead.
-
-Due to the way source filters work in Perl, you can't use Switch inside
-an string C<eval>.
-
-If your source file is longer then 1 million characters and you have a
-switch statement that crosses the 1 million (or 2 million, etc.)
-character boundary you will get mysterious errors. The workaround is to
-use smaller source files.
-
-=head1 COPYRIGHT
-
-    Copyright (c) 1997-2008, Damian Conway. All Rights Reserved.
-    This module is free software. It may be used, redistributed
-        and/or modified under the same terms as Perl itself.
diff --git a/dist/Switch/t/given.t b/dist/Switch/t/given.t
deleted file mode 100644 (file)
index 2b56151..0000000
+++ /dev/null
@@ -1,272 +0,0 @@
-use Carp;
-use Switch qw(Perl6 __ fallthrough);
-
-my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
-END{print"1..$C\n$M"}
-
-# NON-when THINGS;
-
-$when->{when} = { when => "when" };
-
-*when = \&when;
-
-# PREMATURE when
-
-eval { when 1 { ok(0) }; ok(0) } || ok(1);
-
-# H.O. FUNCS
-
-given __ > 2 {
-
-       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) };
-}
-
-# POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
-
-# 1. NUMERIC SWITCH
-
-for (1..3)
-{
-       given ($_) {
-               # SELF
-               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) }
-
-               # 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) }
-
-               # 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) }
-
-               # 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) }
-
-               # 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
-       }
-}
-
-
-# 2. STRING SWITCH
-
-for ('a'..'c','1')
-{
-       given ($_) {
-               # SELF
-               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]/) }
-
-               # 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) }
-
-               # ARRAY
-               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) }
-
-               # HASH
-               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') }
-                       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
-       }
-}
-
-
-# 3. ARRAY SWITCH
-
-my $iteration = 0;
-for ([],[1,'a'],[2,'b'])
-{
-       given ($_) {
-       $iteration++;
-               # SELF
-               when ($_)  { ok(1) }
-
-               # NUMERIC
-               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) }
-
-               # 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) }
-
-               # HASH
-               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) }
-                       else { 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
-       }
-}
-
-
-# 4. HASH SWITCH
-
-$iteration = 0;
-for ({},{a=>1,b=>0})
-{
-       given ($_) {
-       $iteration++;
-
-               # SELF
-               when ($_)  { ok(1) } else { ok(0) }
-
-               # NUMERIC
-               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) }
-
-               # ARRAY
-               when (['a',2])  { ok ($iteration==2) }
-                       else { 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) }
-
-               # HASH
-               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) }
-                       else { 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
-       }
-}
-
-
-# 5. CODE SWITCH
-
-$iteration = 0;
-for ( sub {1},
-      sub { return 0 unless @_;
-           my ($data) = @_;
-           my $type = ref $data;
-           return $type eq 'HASH'   && $data->{a}
-               || $type eq 'Regexp' && 'a' =~ /$data/
-               || $type eq ""       && $data eq '1';
-         },
-      sub {0} )
-{
-       given ($_) {
-       $iteration++;
-               # SELF
-               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) }
-
-               # 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) }
-
-               # ARRAY
-               when ([1, 'a'])  { ok ($iteration<=2) }
-                       else { ok ($iteration>2) }
-               when (['b','a'])  { ok ($iteration==1) }
-                       else { 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) }
-                       else { ok($iteration!=1) }
-
-               # HASH
-               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
-       }
-}
-
-
-# NESTED SWITCHES
-
-for my $count (1..3)
-{
-       given ([9,"a",11]) {
-               when (qr/\d/)  {
-                               given ($count) {
-                                       when (1)      { ok($count==1) }
-                                               else { ok($count!=1) }
-                                       when ([5,6])  { ok(0) } else { ok(1) }
-                               }
-                           }
-               ok(1) when 11;
-       }
-}
diff --git a/dist/Switch/t/nested.t b/dist/Switch/t/nested.t
deleted file mode 100644 (file)
index d10dff2..0000000
+++ /dev/null
@@ -1,35 +0,0 @@
-use Switch;
-
-print "1..4\n";
-
-my $count = 1;
-for my $count (1..3, 'four')
-{
-       switch ([$count])
-       {
-
-=pod
-
-=head1 Test
-
-We also test if Switch is POD-friendly here
-
-=cut
-
-               case qr/\d/ {
-                               switch ($count) {
-                                       case 1     { print "ok 1\n" }
-                                       case [2,3] { print "ok $count\n" }
-                               }
-                           }
-               case 'four' { print "ok 4\n" }
-       }
-}
-
-__END__
-
-=head1 Another test
-
-Still friendly???
-
-=cut
diff --git a/dist/Switch/t/switch.t b/dist/Switch/t/switch.t
deleted file mode 100644 (file)
index 280dcb2..0000000
+++ /dev/null
@@ -1,272 +0,0 @@
-use Carp;
-use Switch qw(__ fallthrough);
-
-my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
-END{print"1..$C\n$M"}
-
-# NON-case THINGS;
-
-$case->{case} = { case => "case" };
-
-*case = \&case;
-
-# PREMATURE case
-
-eval { case 1 { ok(0) }; ok(0) } || ok(1);
-
-# H.O. FUNCS
-
-switch (__ > 2) {
-
-       case 1  { ok(0) } else { ok(1) }
-       case 2  { ok(0) } else { ok(1) }
-       case 3  { ok(1) } else { ok(0) }
-}
-
-switch (3) {
-
-       eval { case __ <= 1 || __ > 2   { ok(0) } } || ok(1);
-       case __ <= 2            { ok(0) };
-       case __ <= 3            { ok(1) };
-}
-
-# POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
-
-# 1. NUMERIC SWITCH
-
-for (1..3)
-{
-       switch ($_) {
-               # SELF
-               case ($_) { ok(1) } else { ok(0) }
-
-               # NUMERIC
-               case (1) { ok ($_==1) } else { ok($_!=1) }
-               case  1  { ok ($_==1) } else { ok($_!=1) }
-               case (3) { ok ($_==3) } else { ok($_!=3) }
-               case (4) { ok (0) } else { ok(1) }
-               case (2) { ok ($_==2) } else { ok($_!=2) }
-
-               # STRING
-               case ('a') { ok (0) } else { ok(1) }
-               case  'a'  { ok (0) } else { ok(1) }
-               case ('3') { ok ($_ == 3) } else { ok($_ != 3) }
-               case ('3.0') { ok (0) } else { ok(1) }
-
-               # ARRAY
-               case ([10,5,1]) { ok ($_==1) } else { ok($_!=1) }
-               case  [10,5,1]  { ok ($_==1) } else { ok($_!=1) }
-               case (['a','b']) { ok (0) } else { ok(1) }
-               case (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) }
-               case (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) }
-               case ([]) { ok (0) } else { ok(1) }
-
-               # HASH
-               case ({}) { ok (0) } else { ok (1) }
-               case {} { ok (0) } else { ok (1) }
-               case {1,1} { ok ($_==1) } else { ok($_!=1) }
-               case ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) }
-
-               # SUB/BLOCK
-               case (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) }
-               case {$_[0]==2} { ok ($_==2) } else { ok($_!=2) }
-               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
-               case {1} { ok (1) } else { ok (0) }     # ; -> SUB, NOT HASH
-       }
-}
-
-
-# 2. STRING SWITCH
-
-for ('a'..'c','1')
-{
-       switch ($_) {
-               # SELF
-               case ($_) { ok(1) } else { ok(0) }
-
-               # NUMERIC
-               case (1)  { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
-               case (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
-
-               # STRING
-               case ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') }
-               case ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') }
-               case ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') }
-               case ('1') { ok ($_ eq '1') } else { ok($_ ne '1') }
-               case ('d') { ok (0) } else { ok (1) }
-
-               # ARRAY
-               case (['a','1']) { ok ($_ eq 'a' || $_ eq '1') }
-                       else { ok ($_ ne 'a' && $_ ne '1') }
-               case (['z','2']) { ok (0) } else { ok(1) }
-               case ([]) { ok (0) } else { ok(1) }
-
-               # HASH
-               case ({}) { ok (0) } else { ok (1) }
-               case ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') }
-                       else { ok ($_ ne 'a' && $_ ne '1') }
-
-               # SUB/BLOCK
-               case (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') }
-                       else { ok($_ ne 'a') }
-               case {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') }
-               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
-               case {1} { ok (1) } else { ok (0) }     # ; -> SUB, NOT HASH
-       }
-}
-
-
-# 3. ARRAY SWITCH
-
-my $iteration = 0;
-for ([],[1,'a'],[2,'b'])
-{
-       switch ($_) {
-       $iteration++;
-               # SELF
-               case ($_) { ok(1) }
-
-               # NUMERIC
-               case (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
-               case (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
-
-               # STRING
-               case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
-               case ('b') { ok ($iteration==3) } else { ok ($iteration!=3) }
-               case ('1') { ok ($iteration==2) } else { ok ($iteration!=2) }
-
-               # ARRAY
-               case (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) }
-               case ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) }
-               case ([]) { ok (0) } else { ok(1) }
-               case ([7..100]) { ok (0) } else { ok(1) }
-
-               # HASH
-               case ({}) { ok (0) } else { ok (1) }
-               case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-
-               # SUB/BLOCK
-               case {scalar grep /a/, @_} { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-               case (sub {scalar grep /a/, @_ }) { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
-               case {1} { ok (1) } else { ok (0) }     # ; -> SUB, NOT HASH
-       }
-}
-
-
-# 4. HASH SWITCH
-
-$iteration = 0;
-for ({},{a=>1,b=>0})
-{
-       switch ($_) {
-       $iteration++;
-
-               # SELF
-               case ($_) { ok(1) } else { ok(0) }
-
-               # NUMERIC
-               case (1) { ok (0) } else { ok (1) }
-               case (1.0) { ok (0) } else { ok (1) }
-
-               # STRING
-               case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
-               case ('b') { ok (0) } else { ok (1) }
-               case ('c') { ok (0) } else { ok (1) }
-
-               # ARRAY
-               case (['a',2]) { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-               case (['b','a']) { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-               case (['b','c']) { ok (0) } else { ok (1) }
-               case ([]) { ok (0) } else { ok(1) }
-               case ([7..100]) { ok (0) } else { ok(1) }
-
-               # HASH
-               case ({}) { ok (0) } else { ok (1) }
-               case ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
-
-               # SUB/BLOCK
-               case {$_[0]{a}} { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-               case (sub {$_[0]{a}}) { ok ($iteration==2) }
-                       else { ok ($iteration!=2) }
-               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
-               case {1} { ok (1) } else { ok (0) }     # ; -> SUB, NOT HASH
-       }
-}
-
-
-# 5. CODE SWITCH
-
-$iteration = 0;
-for ( sub {1},
-      sub { return 0 unless @_;
-           my ($data) = @_;
-           my $type = ref $data;
-           return $type eq 'HASH'   && $data->{a}
-               || $type eq 'Regexp' && 'a' =~ /$data/
-               || $type eq ""       && $data eq '1';
-         },
-      sub {0} )
-{
-       switch ($_) {
-       $iteration++;
-               # SELF
-               case ($_) { ok(1) } else { ok(0) }
-
-               # NUMERIC
-               case (1) { ok ($iteration<=2) } else { ok ($iteration>2) }
-               case (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) }
-               case (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) }
-
-               # STRING
-               case ('a') { ok ($iteration==1) } else { ok ($iteration!=1) }
-               case ('b') { ok ($iteration==1) } else { ok ($iteration!=1) }
-               case ('c') { ok ($iteration==1) } else { ok ($iteration!=1) }
-               case ('1') { ok ($iteration<=2) } else { ok ($iteration>2) }
-
-               # ARRAY
-               case ([1, 'a']) { ok ($iteration<=2) }
-                       else { ok ($iteration>2) }
-               case (['b','a']) { ok ($iteration==1) }
-                       else { ok ($iteration!=1) }
-               case (['b','c']) { ok ($iteration==1) }
-                       else { ok ($iteration!=1) }
-               case ([]) { ok ($iteration==1) } else { ok($iteration!=1) }
-               case ([7..100]) { ok ($iteration==1) }
-                       else { ok($iteration!=1) }
-
-               # HASH
-               case ({}) { ok ($iteration==1) } else { ok ($iteration!=1) }
-               case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) }
-                       else { ok ($iteration>2) }
-
-               # SUB/BLOCK
-               case {$_[0]->{a}} { ok (0) } else { ok (1) }
-               case (sub {$_[0]{a}}) { ok (0) } else { ok (1) }
-               case {0} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
-               case {1} { ok (0) } else { ok (1) }     # ; -> SUB, NOT HASH
-       }
-}
-
-
-# NESTED SWITCHES
-
-for my $count (1..3)
-{
-       switch ([9,"a",11]) {
-               case (qr/\d/) {
-                               switch ($count) {
-                                       case (1)     { ok($count==1) }
-                                               else { ok($count!=1) }
-                                       case ([5,6]) { ok(0) } else { ok(1) }
-                               }
-                           }
-               ok(1) case (11);
-       }
-}