t/33-code.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 2 * 12 + 11 + 1;
   7
   8 use Variable::Magic qw<cast dispell>;
   9
  10 use lib 't/lib';
  11 use Variable::Magic::TestWatcher;
  12
  13 my $wiz = init_watcher
  14         [ qw<get set len clear free copy dup local fetch store exists delete> ],
  15         'code';
  16
  17 my $x = 0;
  18 sub hlagh { ++$x };
  19
  20 watch { cast &hlagh, $wiz } { }, 'cast';
  21 is $x, 0, 'code: cast didn\'t called code';
  22
  23 watch { hlagh() } { }, 'call without arguments';
  24 is $x, 1, 'code: call without arguments succeeded';
  25
  26 watch { hlagh(1, 2, 3) } { }, 'call with arguments';
  27 is $x, 2, 'code: call with arguments succeeded';
  28
  29 watch { undef *hlagh } { free => 1 }, 'undef symbol table entry';
  30 is $x, 2, 'code: undef symbol table entry didn\'t call code';
  31
  32 my $y = 0;
  33 watch { *hlagh = sub { ++$y } } { }, 'redefining sub';
  34
  35 watch { cast &hlagh, $wiz } { }, 're-cast';
  36 is $y, 0, 'code: re-cast didn\'t called code';
  37
  38 my ($r) = watch { \&hlagh } { }, 'reference';
  39 is $y, 0, 'code: reference didn\'t called code';
  40
  41 watch { $r->() } { }, 'call reference';
  42 is $y, 1, 'code: call reference succeeded';
  43 is $x, 2, 'code: call reference didn\'t called the previous code';
  44
  45 my $z = 0;
  46 watch {
  47  no warnings 'redefine';
  48  *hlagh = sub { ++$z }
  49 } { }, 'redefining sub 2';
  50
  51 watch { hlagh() } { }, 'call without arguments 2';
  52 is $z, 1, 'code: call without arguments 2 succeeded';
  53 is $y, 1, 'code: call without arguments 2 didn\'t called the previous code';
  54
  55 watch { dispell &hlagh, $wiz } { }, 'dispell';
  56 is $z, 1, 'code: dispell didn\'t called code';
  57
  58 $Variable::Magic::TestWatcher::mg_end = { free => 1 };