From 1a0c3c3a02da09abc11bbad291d09a41c1850d1d Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Fri, 8 Jul 2011 03:01:49 -0500 Subject: split this out into its own dist, and implement the custom opcode --- t/basic.t | 20 -------- t/lexical.t | 69 ------------------------- t/lib/lexical.pl | 8 --- t/rjbs.t | 154 ------------------------------------------------------- 4 files changed, 251 deletions(-) delete mode 100644 t/basic.t delete mode 100644 t/lexical.t delete mode 100644 t/lib/lexical.pl delete mode 100644 t/rjbs.t (limited to 't') diff --git a/t/basic.t b/t/basic.t deleted file mode 100644 index 1de7d8f..0000000 --- a/t/basic.t +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -ok(1 ~~ 1); -{ - use smartmatch sub { 0 }; - ok(!(1 ~~ 1)); - ok(!(1 ~~ 2)); -} -ok(1 ~~ 1); - -{ - use smartmatch 'core'; - ok(1 ~~ 1); - ok(!(1 ~~ 2)); -} - -done_testing; diff --git a/t/lexical.t b/t/lexical.t deleted file mode 100644 index 036fe8a..0000000 --- a/t/lexical.t +++ /dev/null @@ -1,69 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -{ - ok(1 ~~ 1); - ok(!(1 ~~ 0)); - { - ok(1 ~~ 1); - ok(!(1 ~~ 0)); - use smartmatch sub { 0 }; - ok(!(1 ~~ 1)); - ok(!(1 ~~ 0)); - { - ok(!(1 ~~ 1)); - ok(!(1 ~~ 0)); - use smartmatch sub { 1 }; - ok(1 ~~ 1); - ok(1 ~~ 0); - use smartmatch sub { 0 }; - ok(!(1 ~~ 1)); - ok(!(1 ~~ 0)); - use smartmatch sub { 1 }; - ok(1 ~~ 1); - ok(1 ~~ 0); - } - ok(!(1 ~~ 1)); - ok(!(1 ~~ 0)); - } - ok(1 ~~ 1); - ok(!(1 ~~ 0)); -} - -{ - ok(eval "1 ~~ 1"); - ok(!eval "1 ~~ 0"); - { - ok(eval "1 ~~ 1"); - ok(!eval "1 ~~ 0"); - use smartmatch sub { 0 }; - ok(!eval "1 ~~ 1"); - ok(!eval "1 ~~ 0"); - { - ok(!eval "1 ~~ 1"); - ok(!eval "1 ~~ 0"); - use smartmatch sub { 1 }; - ok(eval "1 ~~ 1"); - ok(eval "1 ~~ 0"); - use smartmatch sub { 0 }; - ok(!eval "1 ~~ 1"); - ok(!eval "1 ~~ 0"); - use smartmatch sub { 1 }; - ok(eval "1 ~~ 1"); - ok(eval "1 ~~ 0"); - } - ok(!eval "1 ~~ 1"); - ok(!eval "1 ~~ 0"); - } - ok(eval "1 ~~ 1"); - ok(!eval "1 ~~ 0"); -} - -{ - use smartmatch sub { 0 }; - require 't/lib/lexical.pl'; -} - -done_testing; diff --git a/t/lib/lexical.pl b/t/lib/lexical.pl deleted file mode 100644 index d004c3f..0000000 --- a/t/lib/lexical.pl +++ /dev/null @@ -1,8 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; - -Test::More::ok(1 ~~ 1); -Test::More::ok(!(1 ~~ 0)); - -1; diff --git a/t/rjbs.t b/t/rjbs.t deleted file mode 100644 index b94e893..0000000 --- a/t/rjbs.t +++ /dev/null @@ -1,154 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -use smartmatch 'rjbs'; - -{ - package SmartOverload; - use overload '~~' => sub { - no warnings 'uninitialized'; - return $_[1] eq ${ $_[0] }; - }, fallback => 1; -} - -{ - package RegexOverload; - use overload 'qr' => sub { - return $_[0]->[0]; - }, fallback => 1; -} - -{ - package StringOverload; - use overload '""' => sub { - return $_[0]->{val}; - }, fallback => 1; -} - -sub smart { my $val = shift; bless \$val, SmartOverload:: } -sub regex { my $val = shift; bless [qr/$val/], RegexOverload:: } -sub string { my $val = shift; bless { val => $val }, StringOverload:: } - -my @tests = ( - # undef - [ 1, undef, undef ], - [ 0, '', undef ], - [ 0, 0, undef ], - [ 0, '0', undef ], - [ 0, '0.0', undef ], - [ 0, '0 but true', undef ], - [ 0, 1, undef ], - [ 0, 'x', undef ], - [ 0, [], undef ], - [ 0, {}, undef ], - [ 0, sub {}, undef ], - [ 0, smart(''), undef ], - [ 0, regex(''), undef ], - [ 0, string(''), undef ], - # smart match overload - [ 1, "smart", smart('smart') ], - [ 1, string('smart'), smart('smart') ], - [ 0, "SMART", smart('smart') ], - [ 0, string('SMART'), smart('smart') ], - [ 0, smart('smart'), smart('smart') ], - [ 0, undef, smart('smart') ], - [ 0, 1, smart('smart') ], - # regex - [ 0, undef, qr/a/ ], - [ 1, undef, qr/a?/ ], - [ 1, "foo", qr/f/ ], - [ 0, "foo", qr/g/ ], - [ 1, 1, qr/1/ ], - [ 0, ['z'], qr/z/ ], - [ 1, ['z'], qr/^ARRAY/ ], - [ 0, {'y' => 'y'}, qr/y/ ], - [ 1, {'y' => 'y'}, qr/^HASH/ ], - [ 1, string('foo'), qr/^foo$/ ], - [ 0, regex('foo'), qr/foo/ ], - [ 1, regex('foo'), qr/^Regex/ ], - [ 1, qr/foo/, qr/\(\?\^\:foo\)/ ], - # regex overload - [ 0, undef, regex('a') ], - [ 1, undef, regex('a?') ], - [ 1, "foo", regex('f') ], - [ 0, "foo", regex('g') ], - [ 1, 1, regex('1') ], - [ 0, ['z'], regex('z') ], - [ 1, ['z'], regex('^ARRAY') ], - [ 0, {'y' => 'y'}, regex('y') ], - [ 1, {'y' => 'y'}, regex('^HASH') ], - [ 1, string('foo'), regex('^foo$') ], - [ 0, regex('foo'), regex('foo') ], - [ 1, regex('foo'), regex('^Regex') ], - [ 1, qr/foo/, regex('\(\?\^\:foo\)') ], - # code - [ 1, undef, sub { 1 } ], - [ 1, '', sub { 1 } ], - [ 1, 0, sub { 1 } ], - [ 1, '0', sub { 1 } ], - [ 1, '0.0', sub { 1 } ], - [ 1, '0 but true', sub { 1 } ], - [ 1, 1, sub { 1 } ], - [ 1, 'x', sub { 1 } ], - [ 1, [], sub { 1 } ], - [ 1, {}, sub { 1 } ], - [ 1, sub {}, sub { 1 } ], - [ 1, smart(''), sub { 1 } ], - [ 1, regex(''), sub { 1 } ], - [ 1, string(''), sub { 1 } ], - [ 0, undef, sub { 0 } ], - [ 0, '', sub { 0 } ], - [ 0, 0, sub { 0 } ], - [ 0, '0', sub { 0 } ], - [ 0, '0.0', sub { 0 } ], - [ 0, '0 but true', sub { 0 } ], - [ 0, 1, sub { 0 } ], - [ 0, 'x', sub { 0 } ], - [ 0, [], sub { 0 } ], - [ 0, {}, sub { 0 } ], - [ 0, sub {}, sub { 0 } ], - [ 0, smart(''), sub { 0 } ], - [ 0, regex(''), sub { 0 } ], - [ 0, string(''), sub { 0 } ], - [ 1, ['a', 'b'], sub { ref $_[0] eq 'ARRAY' } ], - [ 1, ['a', 'b'], sub { $_[0]->[0] eq 'a' } ], - [ 1, string('x'), sub { $_[0] eq 'x' } ], - [ 1, smart('x'), sub { 'x' ~~ $_[0] } ], - [ 0, smart('x'), sub { 'y' ~~ $_[0] } ], - # any - [ 'die', undef, '' ], - [ 'die', undef, 0 ], - [ 'die', undef, '0' ], - [ 'die', undef, '0.0' ], - [ 'die', undef, '0 but true' ], - [ 'die', undef, 1 ], - [ 'die', undef, 'x' ], - [ 'die', undef, [] ], - [ 'die', undef, {} ], - [ 0, undef, sub {} ], - [ 1, undef, smart('') ], - [ 1, undef, regex('') ], - [ 'die', undef, string('') ], -); - -for my $test (@tests) { - # shut up warnings about undef =~ regex - $SIG{__WARN__} = sub { } unless defined $test->[1]; - - if ($test->[0] eq 'die') { - ok(!eval { $test->[1] ~~ $test->[2]; 1 }); - like($@, qr/invalid smart match/); - } - elsif ($test->[0]) { - ok($test->[1] ~~ $test->[2]); - } - else { - ok(!($test->[1] ~~ $test->[2])); - } - - delete $SIG{__WARN__}; -} - -done_testing; -- cgit v1.2.3-54-g00ecf