smartmatch needs your eyes

Front page | perl.perl5.porters | Postings from September 2015

smartmatch needs your eyes

Thread Next

From:

Ricardo Signes

Date:

September 10, 2015 15:26

Subject:

smartmatch needs your eyes

Message ID:

20150910152608.GA21000@cancer.codesimply.com

When we first discussed my propsal to fix the heck out of ~~ by killing off
almost all of its behavior, Father Chrysostomos went ahead and implemented it,
more or less, but it didn't get a good torture test.

Subsequently, I asked Tony Cook to revive the branch and make a few changes.
I've been playing with it to try to figure out whether I think we're ready to
make this breaking change.  I'd like to get more eyes on it.

BUT!

We've had lots of long, long discussions about this topic.  Let's avoid
rehashing them.  If you want to go back and read the long, long discussions of
the past, you are welcome to it of course.  I just don't want to reenact them.

As a reminder, and adding one small change, the new behavior is:

  # STEP ONE
  $x ~~ $qr       -->     $x =~ $qr
  $x ~~ /.../     -->     $x =~ /.../
  $x ~~ sub{...}  -->     $sub->($x)
  $x ~~ undef     -->     ! defined $x
  $x ~~ obj       -->     uses ~~ overloading if present, otherwise pass

  # STEP TWO
  $obj ~~ $x      -->     uses ~~ overloading if present, otherwise pass

  # STEP THREE
  $x ~~ $y        -->     fatal

The change here is "Step Two."  I'm not particularly a fan of it, and would
discourage it, but it has the practical benefit of keeping autodie working.

Below, I include a collection of little snippets that I was writing to play
with or test this code.  It may have errors, and it's not comprehensive, it's
just a sample that I threw together yesterday.

# ----------------------------------------------------------------------------
# also at https://gist.github.com/rjbs/fb5716d7dbd4f23939ea
#
#!perl
use 5.20.0;
use warnings;
use experimental qw(smartmatch signatures);
use Test::More 'no_plan';

my $evens;

sub test ($input) {
  given ($input) {
    when { ref }      { "ref" }
    when (/\D/)       { "non-number" }
    when { $_ == 0 }  { "zero" }
    when { $_ % 2  }  { "odd" }

    "negative" when { $_ < 0 };

    $evens++;

    default           { "even" }
  }
}

for (
  qw(
    1
    2
    123
    -124
    eleventy-one
  ),
  []
) {
  # Why do we warn on smart match in void?  smart match can have side effects
  # like capturing or whatever the subroutine does.  I'm not sold on this
  # warning. -- rjbs, 2015-09-09
  # $_ ~~ \&test;

  # It makes sense to me that test($_) returns the contents of the matching
  # when block.  I am surprised that the result of the subroutine is returned
  # as the result of the smart match — that is, that it is not forced into
  # a boolean.  I think I'm going to mark that up as my problem, not perl's,
  # but I'm still surprised. -- rjbs, 2015-09-09

  my $sub_rv = test($_);
  my $smt_rv = ($_ ~~ \&test);

  printf "%s ~~ \&test is: %s, %s\n", $_, $sub_rv, $smt_rv;
}

for (qw(Alice Bob Charlie Dirk Emanuel Freddi3)) {
  say "No Charlies allowed" when /Charlie/;

  say "Hello, $_";

  when { $_ eq 'Emmanuel' } {
    say "...and may the Lord be with you.";
  }

  # behold, the postfix when BLOCK form
  say "Good to see you again." when { $_ eq 'Alice' };
  say "Where's your lovely wife?" when sub ($who) { $who eq 'Bob' };

  my $odd = qr/[13479]\z/;
  when ($odd) {
    say "What an odd name.";
  }

  say "Nice to meet you, $_";
}

say "By the way, saw $evens even numbers.";

# ----------------------------------------------------------------------------

# We want this object to work like a test when on the rhs, but not to do
# anything special on the lhs.
package TestRHS {
  use overload '~~' => '_smartmatch',
               '""' => sub { 'Right Hand Side' },
               fallback => 1;

  sub new { bless {} }

  sub _smartmatch ($x, $y, $rev) {
    return $y eq 'Right' if $rev;
    return $y ~~ $x;
  }
}

my $rhs = TestRHS->new;

ok(   'Right' ~~ $rhs,   'Right ~~ RHS');
ok(! ('Left'  ~~ $rhs),  'Left !~~ RHS');

ok($rhs ~~ /Hand/,             'RHS ~~ /Hand/');
ok($rhs ~~ sub { ref($_[0]) }, 'RHS ~~ sub{ref$_[0]}');

# The one on the right gets first crack, and it checks whether the one on the
# left is eq to 'Right', which it isn't, because it stringifies to 'Right Hand
# Side.'
ok(! ($rhs ~~ $rhs),           'RHS !~~ RHS');

# ----------------------------------------------------------------------------

# We want this object to work like a test-me-specially on the left, but not on
# the right.
package TestLHS {
  use overload '~~' => '_smartmatch',
               '""' => sub { 'Left Hand Side' },
               fallback => 1;

  sub new { bless {} }

  sub _smartmatch ($x, $y, $rev) {
    return $y eq 'Left' if ! $rev;

    # This will also disable overloading on $y.  Will this ever be a problem?
    no overloading;
    return $y ~~ $x;
  }
}

package TestStringifies {
  use overload '""' => sub { 'Left' }, fallback => 1;
  sub new { bless {} }
}

my $lhs = TestLHS->new;
my $str = TestStringifies->new;

ok(   $lhs ~~ 'Left', 'LHS  ~~ Left');
ok(! ($lhs ~~ []),    'LHS !~~ []'); # Important: $x~~[] normally fatal!
ok(   $lhs ~~ $str,   'LHS !~~ ""-overloaded'); # also fatal w/o lhs ol!

# Note especially how we're showing that the test on the rhs is used when it's
# understood.  The left-hand-side fallback is used just before giving up only.
ok($lhs ~~ sub { ref($_[0]) }, 'LHS ~~ sub{ref$_[0]}');

{
  my $ok = eval { 'Left' ~~ $lhs; 1 };
  my $error = $@;

  ok(! $ok, 'Left ~~ LHS --> FATAL');
  like($error, qr/only smart/i, "can't put no-overload obj on rhs of ~~");
}

# ----------------------------------------------------------------------------

# Weird-o stuff:

# I believe this should pass, as literal array and hash expressions should
# become references before testing.  (Tony Cook: this was discussed in
# <20150618123544.GA17342@cancer.codesimply.com>, June 18, 2015)
ok( @INC ~~ /ARRAY/, '@INC~~/ARRAY/, because the LHS is en-referenced first');

ok(
  # remember: array slice in scalar context gets you the final element
  @INC[0 .. $#INC] ~~ sub { $_[0] eq $INC[-1] },
  'everything other than literal array/hash expr get scalar context',
);


-- 
rjbs

Thread Next