--- Variable-Magic-0.62/t/11-multiple.t.orig 2014-10-20 23:23:19.000000000 +0200 +++ Variable-Magic-0.62/t/11-multiple.t 1970-01-01 01:00:00.000000000 +0100 @@ -1,155 +0,0 @@ -#!perl -T - -use strict; -use warnings; - -use Test::More tests => 33 + 41; - -use Variable::Magic qw; - -my $n = 3; -my @w; -my @c = (0) x $n; - -sub multi { - my ($cb, $tests) = @_; - for (my $i = 0; $i < $n; ++$i) { - my $res = eval { $cb->($i) }; - $tests->($i, $res, $@); - } -} - -eval { $w[0] = wizard get => sub { ++$c[0] }, set => sub { --$c[0] } }; -is($@, '', 'wizard 0 creation doesn\'t croak'); -eval { $w[1] = wizard get => sub { ++$c[1] }, set => sub { --$c[1] } }; -is($@, '', 'wizard 1 creation doesn\'t croak'); -eval { $w[2] = wizard get => sub { ++$c[2] }, set => sub { --$c[2] } }; -is($@, '', 'wizard 2 creation doesn\'t croak'); - -multi sub { - my ($i) = @_; - $w[$i] -}, sub { - my ($i, $res, $err) = @_; - ok(defined $res, "wizard $i is defined"); - is(ref $w[$i], 'SCALAR', "wizard $i is a scalar ref"); -}; - -my $a = 0; - -multi sub { - my ($i) = @_; - cast $a, $w[$i]; -}, sub { - my ($i, $res, $err) = @_; - is($err, '', "cast magic $i doesn't croak"); - ok($res, "cast magic $i is valid"); -}; - -my $b = $a; -for (0 .. $n - 1) { is($c[$_], 1, "get magic $_"); } - -$a = 1; -for (0 .. $n - 1) { is($c[$_], 0, "set magic $_"); } - -my $res = eval { dispell $a, $w[1] }; -is($@, '', 'dispell magic 1 doesn\'t croak'); -ok($res, 'dispell magic 1 is valid'); - -$b = $a; -for (0, 2) { is($c[$_], 1, "get magic $_ after dispelled 1"); } - -$a = 2; -for (0, 2) { is($c[$_], 0, "set magic $_ after dispelled 1"); } - -$res = eval { dispell $a, $w[0] }; -is($@, '', 'dispell magic 0 doesn\'t croak'); -ok($res, 'dispell magic 0 is valid'); - -$b = $a; -is($c[2], 1, 'get magic 2 after dispelled 1 & 0'); - -$a = 3; -is($c[2], 0, 'set magic 2 after dispelled 1 & 0'); - -$res = eval { dispell $a, $w[2] }; -is($@, '', 'dispell magic 2 doesn\'t croak'); -ok($res, 'dispell magic 2 is valid'); - -SKIP: { - skip 'No nice uvar magic for this perl' => 41 unless VMG_UVAR; - - $n = 3; - @c = (0) x $n; - - eval { $w[0] = wizard fetch => sub { ++$c[0] }, store => sub { --$c[0] } }; - is($@, '', 'wizard with uvar 0 doesn\'t croak'); - eval { $w[1] = wizard fetch => sub { ++$c[1] }, store => sub { --$c[1] } }; - is($@, '', 'wizard with uvar 1 doesn\'t croak'); - eval { $w[2] = wizard fetch => sub { ++$c[2] }, store => sub { --$c[2] } }; - is($@, '', 'wizard with uvar 2 doesn\'t croak'); - - multi sub { - my ($i) = @_; - $w[$i] - }, sub { - my ($i, $res, $err) = @_; - ok(defined $res, "wizard with uvar $i is defined"); - is(ref $w[$i], 'SCALAR', "wizard with uvar $i is a scalar ref"); - }; - - my %h = (a => 1, b => 2); - - multi sub { - my ($i) = @_; - cast %h, $w[$i]; - }, sub { - my ($i, $res, $err) = @_; - is($err, '', "cast uvar magic $i doesn't croak"); - ok($res, "cast uvar magic $i is valid"); - }; - - my $s = $h{a}; - is($s, 1, 'fetch magic doesn\'t clobber'); - for (0 .. $n - 1) { is($c[$_], 1, "fetch magic $_"); } - - $h{a} = 3; - for (0 .. $n - 1) { is($c[$_], 0, "store magic $_"); } - is($h{a}, 3, 'store magic doesn\'t clobber'); - # $c[$_] == 1 for 0 .. 2 - - my $res = eval { dispell %h, $w[1] }; - is($@, '', 'dispell uvar magic 1 doesn\'t croak'); - ok($res, 'dispell uvar magic 1 is valid'); - - $s = $h{b}; - is($s, 2, 'fetch magic after dispelled 1 doesn\'t clobber'); - for (0, 2) { is($c[$_], 2, "fetch magic $_ after dispelled 1"); } - - $h{b} = 4; - for (0, 2) { is($c[$_], 1, "store magic $_ after dispelled 1"); } - is($h{b}, 4, 'store magic after dispelled 1 doesn\'t clobber'); - # $c[$_] == 2 for 0, 2 - - $res = eval { dispell %h, $w[2] }; - is($@, '', 'dispell uvar magic 2 doesn\'t croak'); - ok($res, 'dispell uvar magic 2 is valid'); - - $s = $h{b}; - is($s, 4, 'fetch magic after dispelled 1,2 doesn\'t clobber'); - for (0) { is($c[$_], 3, "fetch magic $_ after dispelled 1,2"); } - - $h{b} = 6; - for (0) { is($c[$_], 2, "store magic $_ after dispelled 1,2"); } - is($h{b}, 6, 'store magic after dispelled 1,2 doesn\'t clobber'); - # $c[$_] == 3 for 0 - - $res = eval { dispell %h, $w[0] }; - is($@, '', 'dispell uvar magic 0 doesn\'t croak'); - ok($res, 'dispell uvar magic 0 is valid'); - - $s = $h{b}; - is($s, 6, 'fetch magic after dispelled 1,2,0 doesn\'t clobber'); - $h{b} = 8; - is($h{b}, 8, 'store magic after dispelled 1,2,0 doesn\'t clobber'); -} --- Variable-Magic-0.62/t/35-stash.t.orig 2017-11-04 17:20:15.000000000 +0100 +++ Variable-Magic-0.62/t/35-stash.t 1970-01-01 01:00:00.000000000 +0100 @@ -1,350 +0,0 @@ -#!perl -T - -use strict; -use warnings; - -use Test::More; - -use Variable::Magic qw< - wizard cast dispell - VMG_UVAR VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT ->; - -my $run; -if (VMG_UVAR) { - plan tests => 43; - $run = 1; -} else { - plan skip_all => 'uvar magic is required to test symbol table hooks'; -} - -our %mg; - -my $code = 'wizard ' - . join (', ', map { < sub { - my \$d = \$_[1]; - return 0 if \$d->{guard}; - local \$d->{guard} = 1; - push \@{\$mg{$_}}, \$_[2]; - () -} -CB -} qw); - -$code .= ', data => sub { +{ guard => 0 } }'; - -my $wiz = eval $code; -diag $@ if $@; - -cast %Hlagh::, $wiz; - -{ - local %mg; - - eval q{ - die "ok\n"; - package Hlagh; - our $thing; - { - package NotHlagh; - our $what = @Hlagh::stuff; - } - }; - - is $@, "ok\n", 'stash: variables compiled fine'; - is_deeply \%mg, { - fetch => [ qw ], - store => [ qw ], - }, 'stash: variables'; -} - -{ - local %mg; - - eval q[ - die "ok\n"; - package Hlagh; - sub eat; - sub shoot; - sub leave { "bye" }; - sub shoot { "bang" }; - ]; - - is $@, "ok\n", 'stash: function definitions compiled fine'; - is_deeply \%mg, { - store => [ qw ], - }, 'stash: function definitions'; -} - -{ - local %mg; - - eval q{ - die "ok\n"; - package Hlagh; - eat(); - shoot(); - leave(); - roam(); - yawn(); - roam(); - }; - - my @calls = qw; - my (@fetch, @store); - if ("$]" >= 5.011_002 && "$]" < 5.021_004) { - @fetch = @calls; - @store = map { ($_) x 2 } @calls; - } else { - @fetch = @calls; - @store = @calls; - } - - is $@, "ok\n", 'stash: function calls compiled fine'; - is_deeply \%mg, { - fetch => \@fetch, - store => \@store, - }, 'stash: function calls'; -} - -{ - local %mg; - - eval q{ Hlagh->shoot() }; - - is $@, '', 'stash: valid method call ran fine'; - my %expected = ( fetch => [ qw ] ); - # Typeglob reification may cause a store in 5.28+ - if ("$]" >= 5.027 && %mg == 2) { - $expected{store} = $expected{fetch}; - } - is_deeply \%mg, \%expected, 'stash: valid method call'; -} - -{ - local %mg; - - eval q{ Hlagh->shoot() }; - - is $@, '', 'stash: second valid method call ran fine'; - is_deeply \%mg, { - fetch => [ qw ], - }, 'stash: second valid method call'; -} - -{ - local %mg; - - eval q{ my $meth = 'shoot'; Hlagh->$meth() }; - - is $@, '', 'stash: valid dynamic method call ran fine'; - is_deeply \%mg, { - store => [ qw ], - }, 'stash: valid dynamic method call'; -} - -{ - local %mg; - - eval q[ - package Hlagher; - our @ISA; - BEGIN { @ISA = 'Hlagh' } - Hlagher->leave() - ]; - - is $@, '', 'inherited valid method call ran fine'; - is_deeply \%mg, { - fetch => [ qw ], - }, 'stash: inherited valid method call'; -} - -{ - local %mg; - - eval q{ Hlagher->leave() }; - - is $@, '', 'second inherited valid method call ran fine'; - is_deeply \%mg, { }, 'stash: second inherited valid method call doesn\'t call magic'; -} - -{ - local %mg; - - eval q{ Hlagher->shoot() }; - - is $@, '', 'inherited previously called valid method call ran fine'; - is_deeply \%mg, { - fetch => [ qw ], - }, 'stash: inherited previously called valid method call'; -} - -{ - local %mg; - - eval q{ Hlagher->shoot() }; - - is $@, '', 'second inherited previously called valid method call ran fine'; - is_deeply \%mg, { }, 'stash: second inherited previously called valid method call doesn\'t call magic'; -} - -{ - local %mg; - - eval q{ Hlagh->unknown() }; - - like $@, qr/^Can't locate object method "unknown" via package "Hlagh"/, 'stash: invalid method call croaked'; - is_deeply \%mg, { - fetch => [ qw ], - store => [ qw ], - }, 'stash: invalid method call'; -} - -{ - local %mg; - - eval q{ my $meth = 'unknown_too'; Hlagh->$meth() }; - - like $@, qr/^Can't locate object method "unknown_too" via package "Hlagh"/, 'stash: invalid dynamic method call croaked'; - is_deeply \%mg, { - store => [ qw ], - }, 'stash: invalid dynamic method call'; -} - -{ - local %mg; - - eval q{ Hlagher->also_unknown() }; - - like $@, qr/^Can't locate object method "also_unknown" via package "Hlagher"/, 'stash: invalid inherited method call croaked'; - is_deeply \%mg, { - fetch => [ qw ], - }, 'stash: invalid method call'; -} - -{ - local %mg; - - my @expected_stores = qw; - @expected_stores = map { ($_) x 2 } @expected_stores if "$]" < 5.017_004; - push @expected_stores, 'nevermentioned' if "$]" < 5.017_001; - - eval q{ - package Hlagh; - undef &nevermentioned; - undef &eat; - undef &shoot; - }; - - is $@, '', 'stash: delete executed fine'; - is_deeply \%mg, { store => \@expected_stores }, 'stash: delete'; -} - -END { - is_deeply \%mg, { }, 'stash: magic that remains at END time' if $run; -} - -dispell %Hlagh::, $wiz; - -{ - package AutoHlagh; - - use vars qw<$AUTOLOAD>; - - sub AUTOLOAD { return $AUTOLOAD } -} - -cast %AutoHlagh::, $wiz; - -{ - local %mg; - - my $res = eval q{ AutoHlagh->autoloaded() }; - - is $@, '', 'stash: autoloaded method call ran fine'; - is $res, 'AutoHlagh::autoloaded', - 'stash: autoloaded method call returned the right thing'; - is_deeply \%mg, { - fetch => [ qw ], - store => [ qw ], - }, 'stash: autoloaded method call'; -} - -{ - package AutoHlagher; - - our @ISA; - BEGIN { @ISA = ('AutoHlagh') } -} - -{ - local %mg; - - my $res = eval q{ AutoHlagher->also_autoloaded() }; - - is $@, '', 'stash: inherited autoloaded method call ran fine'; - is $res, 'AutoHlagher::also_autoloaded', - 'stash: inherited autoloaded method returned the right thing'; - is_deeply \%mg, { - fetch => [ qw ], - store => [ qw ], - }, 'stash: inherited autoloaded method call'; -} - -dispell %AutoHlagh::, $wiz; - -my $uo = 0; -$code = 'wizard ' - . join (', ', map { < sub { - my \$d = \$_[1]; - return 0 if \$d->{guard}; - local \$d->{guard} = 1; - ++\$uo; - () -} -CB -} qw); - -my $uo_exp = "$]" >= 5.011_002 && "$]" < 5.021_004 ? 3 : 2; - -$code .= ', data => sub { +{ guard => 0 } }'; - -$wiz = eval $code . ', op_info => ' . VMG_OP_INFO_NAME; -diag $@ if $@; - -cast %Hlagh::, $wiz; - -is $uo, 0, 'stash: no undef op before function call with op name'; -eval q{ - die "ok\n"; - package Hlagh; - meh(); -}; -is $@, "ok\n", 'stash: function call with op name compiled fine'; -is $uo, $uo_exp, 'stash: undef op after function call with op name'; - -dispell %Hlagh::, $wiz; -is $uo, $uo_exp, 'stash: undef op after dispell for function call with op name'; - -$uo = 0; - -$wiz = eval $code . ', op_info => ' . VMG_OP_INFO_OBJECT; -diag $@ if $@; - -cast %Hlagh::, $wiz; - -is $uo, 0, 'stash: no undef op before function call with op object'; -eval q{ - die "ok\n"; - package Hlagh; - wat(); -}; -is $@, "ok\n", 'stash: function call with op object compiled fine'; -is $uo, $uo_exp, - 'stash: undef op after dispell for function call with op object'; - -dispell %Hlagh::, $wiz; -is $uo, $uo_exp, - 'stash: undef op after dispell for function call with op object';