use strict;
use warnings;
-use Test::More;
+use Test::Leaner;
sub import {
no strict 'refs';
sub in_strict { (caller 0)[8] & (eval { strict::bits(@_) } || 0) };
+sub do_nothing { }
+
+sub set_arg { $_[0] = 1 }
+
sub generate {
my ($var, $init, $code, $exp, $use, $opts, $global) = @_;
my $decl = $global ? "our $var; local $var;" : "my $var;";
sub testcase_ok {
local $_ = shift;
my $sigil = shift;
+
my @chunks = split /#+/, "$_ ";
s/^\s+//, s/\s+$// for @chunks;
my ($init, $code, $exp, $opts) = @chunks;
+
(my $var = $init) =~ s/[^\$@%\w].*//;
$init = $var eq $init ? '' : "$init;";
my $use;
$opts = 'default';
$use = '';
}
- my @testcases = (
+
+ my @base = ([ $var, $init, $code, $exp, $use ]);
+ if ($var =~ /\$/) {
+ my ($name) = $var =~ /^\$(.*)/;
+
+ my @oldderef = @{$base[0]};
+ $oldderef[2] =~ s/\Q$var\E\->/\$$var/g;
+ push @base, \@oldderef;
+
+ my @nonref = @{$base[0]};
+ $nonref[0] = $sigil . $name;
+ for ($nonref[1], $nonref[2]) {
+ s/\@\Q$var\E([\[\{])/\@$name$1/g;
+ s/\Q$sigil$var\E/$nonref[0]/g;
+ s/\Q$var\E\->/$var/g;
+ }
+ my $simple = $nonref[2] !~ /->/;
+ my $plain_deref = $nonref[2] =~ /\Q$nonref[0]\E/;
+ my $empty = { '@' => '[ ]', '%' => '{ }' }->{$sigil};
+ if (($simple
+ and ( $nonref[3] =~ m!qr/\^Reference vivification forbidden.*?/!
+ or $nonref[3] =~ m!qr/\^Can't vivify reference.*?/!))
+ or ($plain_deref
+ and $nonref[3] =~ m!qr/\^Can't use an undefined value as a.*?/!)) {
+ $nonref[1] = '';
+ $nonref[2] = 1;
+ $nonref[3] = "'', 1, $empty";
+ }
+ $nonref[3] =~ s/,\s*undef\s*$/, $empty/;
+ push @base, \@nonref;
+ }
+
+ my @testcases = map {
+ my ($var, $init, $code, $exp, $use) = @$_;
[ $var, $init, $code, $exp, $use, $opts, 0 ],
[ $var, "use strict; $init", $code, $exp, $use, $opts, 1 ],
[ $var, "no strict; $init", $code, $exp, $use, $opts, 1 ],
- );
- my @extra;
- for (@testcases) {
- my $var = $_->[0];
- if ($var =~ /\$/) {
- my @new = @$_;
- $new[0] =~ s/^\$/$sigil/;
- for ($new[1], $new[2]) {
- s/\Q$sigil$var\E/$new[0]/g;
- s/\Q$var\E\->/$var/g;
- }
- my $simple = $new[2] !~ /->/;
- my $plain_deref = $new[2] =~ /\Q$new[0]\E/;
- my $empty = { '@' => '[ ]', '%' => '{ }' }->{$sigil};
- if (($simple
- and ( $new[3] =~ m!qr/\^Reference vivification forbidden.*?/!
- or $new[3] =~ m!qr/\^Can't vivify reference.*?/!))
- or ($plain_deref
- and $new[3] =~ m!qr/\^Can't use an undefined value as a.*?/!)) {
- $new[1] = '';
- $new[2] = 1;
- $new[3] = "'', 1, $empty";
- }
- $new[3] =~ s/,\s*undef\s*$/, $empty/;
- push @extra, \@new;
- }
- }
- push @testcases, @extra;
+ } @base;
+
for (@testcases) {
my ($testcase, $desc) = generate(@$_);
my @N = (0 .. 9);