Changeset 36058

Show
Ignore:
Timestamp:
12/02/09 13:47:47 (3 years ago)
Author:
ktat
Message:

japanese doc euc-jp -> utf8; implement CLEAR method and STORESIZE method; fix bug: wrong message when 0 is stored.

Location:
lang/perl/Tie-Trace/trunk
Files:
6 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Tie-Trace/trunk/Changes

    r14192 r36058  
    11Revision history for Tie-Trace 
     2 
     30.13    2009-12-02 05:00:00 
     4        implement CLEAR method for Hash and Array. 
     5        implement STORESIZE method for Array. 
     6 
     70.12    2009-11-24 03:49:12 
     8        fix bug of output variable whose value is 0. 
     9        Thanks to Christoph. 
    210 
    3110.11    2008-06-10 01:21:00 

  • lang/perl/Tie-Trace/trunk/README

    r14192 r36058  
    3737COPYRIGHT AND LICENCE 
    3838 
    39 Copyright (C) 2006-2007 Ktat 
     39Copyright (C) 2006-2010 Ktat 
    4040 
    4141This program is free software; you can redistribute it and/or modify it 

  • lang/perl/Tie-Trace/trunk/lib/Tie/Trace.pm

    r14192 r36058  
    6666    $$s = $s_; 
    6767  }elsif($s_type eq 'ARRAY'){ 
    68     @$s = @$s_; 
     68    @$s = @$s_ if @$s_; 
    6969  }elsif($s_type eq 'HASH'){ 
    70     %$s = %$s_; 
     70    %$s = %$s_ if %$s_; 
    7171  } 
    7272  return $tied_value; 
    … …  
    172172    push @filename, $f; 
    173173    push @line, $l; 
    174   } 
     174 
     175  } 
     176 
    175177  my $location = @line == 1 ? " at $filename[0] line $line[0]." : 
    176178                              join "\n", map " at $filename[$_] line $line[$_].", (0 .. $#filename); 
    … …  
    190192 
    191193 
    192   $value ||= ''; 
     194  $value = '' unless defined $value; 
    193195  if ($class eq 'Scalar') { 
    194196    return("${msg} => $value$location"); 
    … …  
    329331} 
    330332 
     333sub CLEAR{ 
     334  my($self) = @_; 
     335  return $self->Tie::Hash::CLEAR; 
     336} 
     337 
    331338# Array ///////////////////////// 
    332339package 
    … …  
    368375  my $to  = $off + $len -1; 
    369376  my $p = $off eq $to ? $off : $off < $to ? "$off .. $to" : $off; 
    370   my @point = $func ? () : (point => $p); 
     377  my @point = ($func and $func ne 'STORESIZE') ? () : (point => $p); 
    371378  $self->_carpit(@point, value => \@_, filter => sub {$_[0] =~ s/^\[(.*)\]$/$func\($1\)/} )  unless $QUIET; 
    372379  local $QUIET = 1; 
    … …  
    415422} 
    416423 
     424sub STORESIZE { 
     425  my ($self, $p) = @_; 
     426  $self->SPLICE($p, $self->FETCHSIZE - $p); 
     427  return undef; 
     428} 
     429 
     430sub CLEAR{ 
     431  my($self) = @_; 
     432  return $self->Tie::Array::CLEAR(); 
     433  $self->DELETE($_) for 0 .. $#{$self->{storage}}; 
     434  return undef; 
     435} 
     436 
    417437# Scalar ///////////////////////// 
    418438package 
    … …  
    438458=head1 VERSION 
    439459 
    440 Version 0.08 
     460Version 0.13 
    441461 
    442462=cut 
    443463 
    444 our $VERSION = '0.11'; 
     464our $VERSION = '0.13'; 
    445465 
    446466=head1 SYNOPSIS 
    … …  
    739759=head1 COPYRIGHT & LICENSE 
    740760 
    741 Copyright 2006-2008 Ktat, all rights reserved. 
     761Copyright 2006-2010 Ktat, all rights reserved. 
    742762 
    743763This program is free software; you can redistribute it and/or modify it 

  • lang/perl/Tie-Trace/trunk/lib/Tie/Trace_JP.pod

    r14192 r36058  
    1 =encoding euc-jp 
    2  
    3 =head1 ̾� 
    4  
    5 Tie::Trace - tie�Ǵ��print�ǥХå��� 
    6 =head1 �С����� 
    7  
    8 Version 0.08 
    9  
    10 =head1 ��� 
     1=encoding utf8 
     2 
     3=head1 名前 
     4 
     5Tie::Trace - tieで簡単printデバッギング 
     6 
     7=head1 バージョン 
     8 
     9Version 0.12 
     10 
     11=head1 概要 
    1112 
    1213use Tie::Trace qw/watch/; # or qw/:all/ 
    … …  
    2526    $scalar = "scalar";      # warn "main:: $scalar => scalar at ..." 
    2627 
    27 =head1 �� 
    28  
    29 Tie::Trace��rint�ǥХå��󥰤����Ǥ���tie��äơ�����ѿ�����줿/�����줿��򸫤뤳�Ȥ�������� 
    30  
    31 ����줿��������������å����ե������Ǥ����� 
    32 Tie::Trace�ϺƵ�Ū�ˤ���ͤ���å��Ǥ��ޤ��� 
    33  
    34 �; 
     28=head1 説明 
     29 
     30Tie::Traceはprintでバッキングに有用です。tieを使って、特定の変数に 
     31入れられた/削除された値を見ることが出来ます。 
     32 
     33入れられた値が、スカラ/配列/ハッシュリファレンスであれば、 
     34Tie::Traceは再帰的にその値をチェックできます。 
     35 
     36例; 
    3537 
    3638 watch %hash; 
    … …  
    3941 $hash{foo}->{a} = 2            # warn "main:: %hash => {foo}{a} => 2" 
    4042 
    41 �Ǥ�����bless���줿����������e���줿�����뤵������ 
    42  
    43 =head1 �ؿ���Υ⥸�塼����version 0.06 ���顢C<watch>�ؿ�󶡤��Ƥ��ޤ��� 
    44 ���δؿ�ߤ���٤��Ǥ��äơ������tie �ؿ�ȤäƤϤ����ޤ��� 
     43ですが、blessされたリファレンスやtieされた値は無視されます。 
     44 
     45=head1 関数 
     46 
     47このモジュールは、version 0.06 から、C<watch>関数を提供しています。 
     48この関数のみを使うべきであって、代わりに tie 関数を使ってはいけません。 
     49 
    4550=over 4 
    4651 
    … …  
    5358 watch %hash, %options; 
    5459 
    55 ���<watch>���������ˡ������ä��ꡢ�ä��줿�ꤹ���� 
    56 �����Τ褦�ʥ��������Ƿٹ𤷤ޤ��� 
     60変数をC<watch>し、そこに、値が入ったり、消されたりすると、 
     61下記のようなメッセージで警告します。 
    5762 
    5863 main:: %hash => {key} => value at ... 
    5964 
    60 C<watch>������ͤ���äƤ��Ƥ⡢����������ie::Trace�Ϥ��ޤ�ư���ޤ��� 
     65C<watch>する前に値が入っていても、問題ありません。Tie::Traceはうまく動きます。 
    6166 
    6267 my %hash = (key => 'value'); 
    … …  
    6570=back 
    6671 
    67 =head1 ���ץ��� 
    68  
    69 C<watch>�򥪥ץ�������ǻȤ����Ȥ��Ǥ��ޤ��� 
    70 ����Х����ץ��������������L<����Х���򸫤Ƥ�������� 
     72=head1 オプション 
     73 
     74C<watch>をオプション付きで使うことができます。 
     75グローバルなオプションが欲しければ、L<グローバル変数> を見てください。 
    7176 
    7277=over 4 
    … …  
    7681 watch %hash, key => [qw/foo bar/]; 
    7782 
    78 �����ϥå����������Ǥ�������å����륭����������������Ф�����ɽ��������ޤ��� 
    79 ��ꤵ�줿/�ޥå���������Ǥʤ������ٹ�оݤˤʤ餺��̵�뤵������ 
    80 �����ɥ���������ꤷ�����������ɥ��������������tie���줿��ǡ������ߤ�ͤǤ��� 
    81 �����ɥ��������������������̵�뤵������ 
    82  
    83 �; 
     83これはハッシュのためのものです。チェックするキーの名前か、キーに対する正規表現を指定できます。 
     84指定された/マッチしたキーでなければ、警告の対象にならず、無視されます。 
     85コードリファレンスを指定した場合、コードリファレンスの第一引数は、tieされた値で、第二引数以降は値です。 
     86コードリファレンスが偽を返した場合、無視されます。 
     87 
     88例; 
    8489 
    8590 watch %hash, key => [qw/foo bar/, qr/x/]; 
    … …  
    9499 watch %hash, value => [qw/foo bar/]; 
    95100 
    96 ����å���������������Ф�����ɽ��������ޤ��� 
    97 ��ꤵ�줿/�ޥå������Ǥʤ������ٹ�оݤˤʤ餺��̵�뤵������ 
    98 �����ɥ���������ꤷ�����������ɥ��������������tie���줿��ǡ������ߤ�ͤǤ��� 
    99 �����ɥ��������������������̵�뤵������ 
    100  
    101 �; 
     101チェックする値の内容か、値に対する正規表現を指定できます。 
     102指定された/マッチした値でなければ、警告の対象にならず、無視されます。 
     103コードリファレンスを指定した場合、コードリファレンスの第一引数は、tieされた値で、第二引数以降は値です。 
     104コードリファレンスが偽を返した場合、無視されます。 
     105 
     106例; 
    102107 
    103108 watch %hash, value => [qw/foo bar/, qr/\)/]; 
    … …  
    112117 watch %hash, use => [qw/array/]; 
    113118 
    114 ����å�����������������顼�������ϥå����ꤷ�ޤ��� 
    115 �ǥե����Ǥϡ���ƤΥ����פ�����å��������� 
    116  
    117 �; 
     119チェックする変数のタイプ(スカラー、配列、ハッシュ)を指定します。 
     120デフォルトでは、全てのタイプがチェックされます。 
     121 
     122例; 
    118123 
    119124 watch %hash, use => [qw/array/]; 
    … …  
    129134 watch %hash, debug => sub{my($self, @v) = @_; return @v } 
    130135 
    131 ������������ޤ�. �ǥե����Ǥ�dumper"�����åȤ������ޤ��� 
    132 "dumper"�ϡ����a::Dumper::Dumper�Υե����ޥåȤ�������ޤ�(::Terse = 0 ��::Indent = 0���� 
    133 "dumper"������������ɥ�������������Ȥ����ޤ��� 
    134 �����ɥ���������ꤷ�����������ɥ��������������tie���줿��ǡ������ߤ�ͤǤ��� 
    135 �����ɥ��������μ¹Է���ɽ�����ͤȤ��ƻȤ��ޤ��� 
     136値の表現を指定できます. デフォルトでは"dumper"がセットされています。 
     137"dumper"は、値をData::Dumper::Dumperのフォーマットで表現します(::Terse = 0 と ::Indent = 0で)。 
     138"dumper"の代わりに、コードリファレンスを使うこともできます。 
     139コードリファレンスを指定した場合、コードリファレンスの第一引数は、tieされた値で、第二引数以降は値です。 
     140コードリファレンスの実行結果が表示用の値として使われます。 
    136141 
    137142=item debug_value => [contents/regexs/codref] 
    … …  
    139144 watch %hash, debug => sub{my($s,$v) = @_; $v =~tr/op/po/;}, debug_value => [qw/foo boo/]; 
    140145 
    141 value��ͤ�Ф����ΤǤ�������debug_value�ϡ�debug�ˤ��ù����줿�����Ф����ΤǤ��� 
    142 �����ɥ���������ꤷ�����������ɥ��������������tie���줿��ǡ������ߤ�ͤǤ��� 
    143 �����ɥ��������������������̵�뤵������ 
    144  
    145 �; 
     146valueは値に対するものでしたが、debug_valueは、debugにより加工された後の値に対するものです。 
     147コードリファレンスを指定した場合、コードリファレンスの第一引数は、tieされた値で、第二引数以降は値です。 
     148コードリファレンスが偽を返した場合、無視されます。 
     149 
     150例; 
    146151 
    147152 watch %hash, debug => sub{my($s,$v) = @_; $v =~tr/op/po/;}, debug_value => [qw/foo boo/]; 
    … …  
    155160 watch %hash, r => 0; 
    156161 
    157 r��0�Ǥ�����������������äƤ������ˡ��Ƶ�Ū�˥���å����ޤ��󡣥ǥե����ϡ�1�Ǥ��� 
     162rが0であれば、リファレンスが入ってきた場合に、再帰的にチェックしません。デフォルトは、1です。 
    158163 
    159164=item caller => number/[numbers] 
    … …  
    161166 watch %hash, caller => 2; 
    162167 
    163 �������ٹ�å������˱ƶ���ޤ���caller�������ꤷ�ޤ��� 
    164 �ǥե������Ǥ���0������������������������� 
    165  
    166 ������������ꤹ�뤳�Ȥ���ޤ��� 
     168これは、警告メッセージに影響します。callerが遡る数を指定します。 
     169デフォルトは0です。0より大きくすると、その分遡ります。 
     170 
     171配列リファレンスを指定することも出来ます。 
    167172 
    168173 watch %hash, caller => [1, 2, 3]; 
    169174 
    170 �����Τ褦������ˤʤ����� 
     175下記のような表示になります。 
    171176 
    172177 main %hash => {key} => 'hoge' at filename line 61. 
    … …  
    176181=back 
    177182 
    178 =head1 �᥽�å� 
    179 key�� value�� debug_value�ʤɤΥ��ץ�����Ϥ��������ɥ��������ǻȤ��ޤ��� 
    180 tied �ؿ����Υ᥽�åɤȤ��ƻȤ��ޤ��� 
     183=head1 メソッド 
     184 
     185key、 value、 debug_valueなどのオプションに渡されるコードリファレンスで使われます。 
     186tied 関数の戻り値のメソッドとして使われます。 
    181187 
    182188=over 4 
    … …  
    191197   }; 
    192198 
    193 ���������Ƥ����ե���������ޤ��� 
     199値が蓄えられているリファレンスを返します。 
    194200 
    195201=item parent 
    … …  
    202208   }; 
    203209 
    204 ���Υ᥽�åɤϡ�$self�οƤ�ie������������ޤ��� 
    205  
    206 �; 
     210このメソッドは、$selfの親のtieされている値を返します。 
     211 
     212例; 
    207213 
    208214 watch my %hash; 
    … …  
    214220=back 
    215221 
    216 =head1 ����Х���over 4 
     222=head1 グローバル変数 
     223 
     224=over 4 
    217225 
    218226=item %Tie::Trace::OPTIONS 
    219227 
    220 Tie::Trace�Υ���Х륪�ץ����Ǥ��� 
    221 ���Υ��ץ���������ʤ��������Υ��ץ������Ȥ��ޤ��� 
    222 ���Υ��ץ����򥪡��С��饤�ɤ�������C<watch>�򥪥ץ�������ǻȤäƤ�������� 
     228Tie::Traceのグローバルオプションです。 
     229何のオプションも指定しなければ、このオプションが使われます。 
     230このオプションをオーバーライドする場合は、C<watch>をオプション付きで使ってください。 
    223231 
    224232 %Tie::Trace::OPTIONS = (debug => undef, ...); 
    … …  
    232240=item $Tie::Trace::QUIET 
    233241 
    234 ���ʤ顢�ٹ�Ф��ʤ��ʤ����� 
     242真なら、警告を出さなくなります。 
    235243 
    236244 watch my %hash; 
    … …  
    244252=back 
    245253 
    246 =head1 ��� 
     254=head1 著者 
     255 
    247256Ktat, C<< <ktat.is at gmail.com> >> 
    248257 
    249 =head1 �Х� 
     258=head1 バグ 
    250259 
    251260Please report any bugs or feature requests to 
    … …  
    255264your bug as I make changes. 
    256265 
    257 =head1 ���ݡ��� 
    258 perldoc���ޥ�Ǥ��Υ⥸�塼���ɥ�����򸫤Ĥ����ޤ��� 
     266=head1 サポート 
     267 
     268perldocコマンドでこのモジュールのドキュメントを見つけられます。 
    259269 
    260270    perldoc Tie::Trace 
    261271 
    262 �����ɥ�����euc-jp)�ϲ����ˤʤ����� 
     272日本語のドキュメント(euc-jp)は下記になります。 
    263273 
    264274    perldoc Tie::Trace_JP 
    265275 
    266 �ޤ�������������򸫤뤳�Ȥ������: 
     276また、下記からも情報を見ることが出来ます: 
    267277 
    268278=over 4 
    … …  
    286296=back 
    287297 
    288 =head1 ���� 
    289 JN�Ͽ������ٹ�å�����(0.06����Υ����ǥ��򤯤������� 
    290  
    291 =head1 �� & �饤���� 
    292 Copyright 2006-2007 Ktat, all rights reserved. 
     298=head1 感謝 
     299 
     300JNは新しい警告メッセージ(0.06から)のアイデアをくれました。 
     301 
     302=head1 著作権 & ライセンス 
     303 
     304Copyright 2006-2009 Ktat, all rights reserved. 
    293305 
    294306This program is free software; you can redistribute it and/or modify it 

  • lang/perl/Tie-Trace/trunk/t/tie-trace-watch.t

    r14192 r36058  
    1 use Test::More tests => 23; 
     1use Test::More tests => 24; 
    22 
    33local $SIG{__DIE__} = sub {print "ERROR: ", @_;}; 
    … …  
    55 
    66use_ok("Tie::Trace"); 
    7 use Tie::Hash; 
     7#use Tie::Hash; 
     8 
     9 
    810 
    911{ 
    … …  
    1214 
    1315  ok(open(STDERR, ">", \$err), "open"); 
     16 
     17 
     18   
    1419  my %hash = (); 
    1520  Tie::Trace::watch(\%hash, r => 1); 
    … …  
    2328  like($err, qr/^main:: \%hash => \{1\} => \{/m, '$hash{1} = $x'); 
    2429 
     30   
    2531  $hash{1}->{hoge} = 3;     # hoge -- 3 
    2632  like($err, qr/^main:: \%hash => \{1\}\{hoge\} => 3/m, '$hash{1}->{hoge} = 3'); 
     33 
     34   
    2735 
    2836  $hash{1}->{hoge} = 4;     # hoge -- 4 
    2937  like($err, qr/^main:: \%hash => \{1\}{hoge} => 4/m, '$hash{1}->{hoge} = 4'); 
    3038 
     39  close STDERR; 
     40 
     41  open STDERR, '>', \$err or die $!; 
     42 
     43  $hash{1}->{hoge} = 0;     # hoge -- 0 
     44  like($err, qr/^main:: \%hash => \{1\}{hoge} => 0/m, '$hash{1}->{hoge} = 0'); 
     45 
     46   
    3147  $hash{2}->{hoge} = 222;   # 2 -- HASH(...) 
    3248                          # hoge - 222 
    3349  like($err, qr/^main:: \%hash => \{2\} => \{/m, '$hash{2} = HASH'); 
    3450  like($err, qr/^main:: \%hash => \{2\}\{hoge\} => 222/m, '$hash{2}->{hoge} = 222'); 
     51  
    3552 
    3653  push(@{$hash{1}->{hoge3}}, "array");# array 
    … …  
    7794  $hash4{xxx}->{xxx} = 'var'; 
    7895  unlike($err, qr/^\s*\{xxx\} => 'var'/m, q{$hash{xxx}->{xxx} = 'var'}); 
    79  
     96  
    8097=iranai 
    8198 

  • lang/perl/Tie-Trace/trunk/t/tie-trace.t

    r14192 r36058  
    1 use Test::More tests => 36; 
     1use Test::More tests => 45; 
    22 
    3 use_ok("Tie::Trace"); 
     3use_ok("Tie::Trace", ":all"); 
    44use Tie::Hash; 
     5use Tie::Trace ":all"; 
    56 
    67{ 
    … …  
    1213 
    1314  my %hash; 
    14   tie %hash, "Tie::Trace", r => 1, debug => undef; 
     15  watch(%hash, r => 1, debug => undef); 
    1516 
    1617  my $s; 
    … …  
    1819 
    1920  $hash{1} = $x;            # 1 -- HASH(....) 
    20   like($err, qr/^\{1\} => HASH/m, '$hash{1} = $x'); 
     21  like($err, qr/^main:: \%hash => \{1\} => HASH/m, '$hash{1} = $x'); 
    2122 
    2223  $hash{1}->{hoge} = 3;     # hoge -- 3 
    23   like($err, qr/^\{1\}\{hoge\} => 3/m, '$hash{1}->{hoge} = 3'); 
     24  like($err, qr/^main:: \%hash => \{1\}\{hoge\} => 3/m, '$hash{1}->{hoge} = 3'); 
    2425 
    2526  $hash{1}->{hoge} = 4;     # hoge -- 4 
    26   like($err, qr/^\{1\}{hoge} => 4/m, '$hash{1}->{hoge} = 4'); 
     27  like($err, qr/^main:: \%hash => \{1\}{hoge} => 4/m, '$hash{1}->{hoge} = 4'); 
    2728 
    2829  my $s2; 
    … …  
    3031  $x->{hoge5} = $array; 
    3132  ${$array->[2]} = "4"; 
    32   like($err, qr/^\{1\}\{hoge5\}\[2] => 4/m, '${$array->[2]} = "4"'); 
     33  like($err, qr/^main:: \%hash => \{1\}\{hoge5\}\[2] => 4/m, '${$array->[2]} = "4"'); 
    3334  delete $x->{hoge5}; 
    3435 
    3536  ${$x->{hoge4}} = "0000";  # 0000 
    36   like($err, qr/^\{1\}\{hoge4\} => 0000/m, '${$x->{hoge4}} = "0000"'); 
     37  like($err, qr/^main:: \%hash => \{1\}\{hoge4\} => 0000/m, '${$x->{hoge4}} = "0000"'); 
    3738 
    3839  $hash{2}->{hoge} = 222;   # 2 -- HASH(...) 
    3940                            # hoge - 222 
    40   like($err, qr/^\{2\} => HASH/m, '$hash{2}->{hoge} = 222'); 
    41   like($err, qr/^\{2\}\{hoge\} => 222/m, '$hash{2}->{hoge} = 222'); 
     41  like($err, qr/^main:: \%hash => \{2\} => HASH/m, '$hash{2}->{hoge} = 222'); 
     42  like($err, qr/^main:: \%hash => \{2\}\{hoge\} => 222/m, '$hash{2}->{hoge} = 222'); 
    4243 
    4344  push(@{$hash{1}->{hoge3}}, "array");# array 
    44   like($err, qr/^\@\{\{1\}\{hoge3\}\} => ARRAY/m, 'push(@{$hash{1}->{hoge3}}, "array")'); 
     45  like($err, qr/^main:: \%hash => \@\{\{1\}\{hoge3\}\} => ARRAY/m, 'push(@{$hash{1}->{hoge3}}, "array")'); 
    4546 
    4647  push(@{$hash{1}->{hoge3}}, "array2");# array 
    47   like($err, qr/^\@\{\{1\}\{hoge3\}\} => ARRAY/m, 'push(@{$hash{1}->{hoge3}}, "array2")'); 
     48  like($err, qr/^main:: \%hash => \@\{\{1\}\{hoge3\}\} => ARRAY/m, 'push(@{$hash{1}->{hoge3}}, "array2")'); 
    4849 
    4950  is_deeply([sort keys(%hash)], [1,2], "hash key check");      # 1, 2, 3, 4 
    … …  
    5152  is_deeply([sort @{$hash{1}->{hoge3}}], [qw/a array array2 b c d e/], "array check"); 
    5253  $hash{xxx}->{bless} = bless {}; 
    53   like($err, qr/^\{xxx\}\{bless} => main=HASH/m, '$hash{xxx}->{bless} = bless {}'); 
     54  like($err, qr/^main:: \%hash => \{xxx\}\{bless} => main=HASH/m, '$hash{xxx}->{bless} = bless {}'); 
    5455  $hash{xxx}->{bless}->{bless_hoge} = 1; 
    55   unlike($err, qr/^\{xxx\}\{bless_hoge} => 1/m, '$hash{xxx}->{bless}->{bless_hoge} = 1'); 
     56  unlike($err, qr/^main:: \%hash => \{xxx\}\{bless_hoge} => 1/m, '$hash{xxx}->{bless}->{bless_hoge} = 1'); 
    5657  my %tied; 
    5758  tie %tied, "Tie::StdHash"; 
    5859  $hash{xxx}->{tied} = \%tied; 
    59   like($err, qr/^\{xxx\}\{tied\} => HASH/m, '$hash{xxx}->{tied} = HASH'); 
     60  like($err, qr/^main:: \%hash => \{xxx\}\{tied\} => HASH/m, '$hash{xxx}->{tied} = HASH'); 
    6061  $hash{xxx}->{tied}->{a} = 1234; 
    61   like($err, qr/^\{xxx\}\{tied\}\{a\} => 1234/m, '$hash{xxx}->{tied}->{a} = 1234'); 
     62  like($err, qr/^main:: \%hash => \{xxx\}\{tied\}\{a\} => 1234/m, '$hash{xxx}->{tied}->{a} = 1234'); 
    6263  close STDERR; 
    6364 
    … …  
    6566 
    6667  my %hash2; 
    67   tie %hash2, "Tie::Trace", key => ["foo", "bar"] or die $!; 
     68  watch(%hash2, key => ["foo", "bar"]) or die $!; 
    6869 
    6970  $hash2{foo} = 1; 
    70   like($err, qr/^\{foo\} => 1/m, '$hash{foo} = 1'); 
     71  like($err, qr/^main:: \%hash2 => \{foo\} => 1/m, '$hash{foo} = 1'); 
    7172  $hash2{bar} = 1; 
    72   like($err, qr/^\{bar\} => 1/m, '$hash{bar} = 1'); 
     73  like($err, qr/^main:: \%hash2 => \{bar\} => 1/m, '$hash{bar} = 1'); 
    7374  $hash2{xxx} = {}; 
    74   unlike($err, qr/^\{xxx\} => HASH/m, '$hash{xxx} = {}'); 
     75  unlike($err, qr/^main:: \%hash2 => \{xxx\} => HASH/m, '$hash{xxx} = {}'); 
    7576  $hash2{xxx}->{foo} = 2; 
    76   like($err, qr/^\{xxx\}\{foo\} => 2/m, '$hash{xxx}->{foo} = 2'); 
     77  like($err, qr/^main:: \%hash2 => \{xxx\}\{foo\} => 2/m, '$hash{xxx}->{foo} = 2'); 
    7778  $hash2{xxx}->{bar} = 2; 
    78   like($err, qr/^\{xxx\}\{bar\} => 2/m, '$hash{xxx}->{bar} = 2'); 
     79  like($err, qr/^main:: \%hash2 => \{xxx\}\{bar\} => 2/m, '$hash{xxx}->{bar} = 2'); 
    7980  $hash2{xxx}->{xxx} = 2; 
    80   unlike($err, qr/^\{xxx\}\{xxx\} => 2/m, '$hash{xxx}->{xxx} = 2'); 
     81  unlike($err, qr/^main:: \%hash2 => \{xxx\}\{xxx\} => 2/m, '$hash{xxx}->{xxx} = 2'); 
    8182 
    8283  close STDERR; 
    … …  
    8485 
    8586  my %hash3; 
    86   tie %hash3, "Tie::Trace", value => ["foo", "bar"] or die $!; 
     87  watch(%hash3, value => ["foo", "bar"]) or die $!; 
    8788 
    8889  $hash3{oo} = 'foo'; 
    89   like($err, qr/^\{oo\} => 'foo'/m, q{$hash{oo} = 'foo'}); 
     90  like($err, qr/^main:: \%hash3 => \{oo\} => 'foo'/m, q{$hash{oo} = 'foo'}); 
    9091  $hash3{ar} = 'bar'; 
    91   like($err, qr/^\{ar\} => 'bar'/m, q{$hash{ar} = 'bar'}); 
     92  like($err, qr/^main:: \%hash3 => \{ar\} => 'bar'/m, q{$hash{ar} = 'bar'}); 
    9293  $hash3{xxx} = {}; 
    93   unlike($err, qr/^\{xxx\} => HASH/m, '$hash{xxx} = {}'); 
     94  unlike($err, qr/^main:: \%hash3 => \{xxx\} => HASH/m, '$hash{xxx} = {}'); 
    9495  $hash3{xxx}->{oox} = 'foo'; 
    95   like($err, qr/^\{xxx\}\{oox\} => 'foo'/m, q{$hash{xxx}->{oo} = 'foo'}); 
     96  like($err, qr/^main:: \%hash3 => \{xxx\}\{oox\} => 'foo'/m, q{$hash{xxx}->{oo} = 'foo'}); 
    9697  $hash3{xxx}->{arx} = 'bar'; 
    97   like($err, qr/^\{xxx\}\{arx\} => 'bar'/m, q{$hash{xxx}->{ar} = 'bar'}); 
     98  like($err, qr/^main:: \%hash3 => \{xxx\}\{arx\} => 'bar'/m, q{$hash{xxx}->{ar} = 'bar'}); 
    9899  $hash3{xxx}->{xxx} = 'var'; 
    99   unlike($err, qr/^\{xxx\}\{xxx\} => 'var'/m, q{$hash{xxx}->{xxx} = 'var'}); 
     100  unlike($err, qr/^main:: \%hash3 => \{xxx\}\{xxx\} => 'var'/m, q{$hash{xxx}->{xxx} = 'var'}); 
    100101 
    101102  close STDERR; 
    … …  
    103104 
    104105  my %hash4; 
    105   tie(%hash4, 'Tie::Trace', value => ['foo', 'bar'], r => 0) or die $!; 
     106  watch(%hash4, value => ['foo', 'bar'], r => 0) or die $!; 
    106107 
    107108  $hash4{oo} = 'foo'; 
    108   like($err, qr/^\{oo\} => 'foo'/m, q{$hash{oo} = 'foo'}); 
     109  like($err, qr/^main:: \%hash4 => \{oo\} => 'foo'/m, q{$hash{oo} = 'foo'}); 
    109110  $hash4{ar} = 'bar'; 
    110   like($err, qr/^\{ar\} => 'bar'/m, q{$hash{ar} = 'bar'}); 
     111  like($err, qr/^main:: \%hash4 => \{ar\} => 'bar'/m, q{$hash{ar} = 'bar'}); 
    111112  $hash4{xxx} = {}; 
    112   unlike($err, qr/^\{xxx\}\{xxx\} => HASH/m, '$hash{xxx} = {}'); 
     113  unlike($err, qr/^main:: \%hash4 => \{xxx\}\{xxx\} => HASH/m, '$hash{xxx} = {}'); 
    113114  $hash4{xxx}->{ooxx} = 'foo'; 
    114   unlike($err, qr/^\{xxx\}\{oox\} => 'foo'/m, q{$hash{xxx}->{oo} = 'foo'}); 
     115  unlike($err, qr/^main:: \%hash4 => \{xxx\}\{oox\} => 'foo'/m, q{$hash{xxx}->{oo} = 'foo'}); 
    115116  $hash4{xxx}->{arx} = 'bar'; 
    116   unlike($err, qr/^\{xxx\}\{arx\} => 'bar'/m, q{$hash{xxx}->{ar} = 'bar'}); 
     117  unlike($err, qr/^main:: \%hash4 => \{xxx\}\{arx\} => 'bar'/m, q{$hash{xxx}->{ar} = 'bar'}); 
    117118  $hash4{xxx}->{xxx} = 'var'; 
    118   unlike($err, qr/^\{xxx\}\{xxx\} => 'var'/m, q{$hash{xxx}->{xxx} = 'var'}); 
     119  unlike($err, qr/^main:: \%hash4 => \{xxx\}\{xxx\} => 'var'/m, q{$hash{xxx}->{xxx} = 'var'}); 
     120  
     121  close STDERR; 
     122  open STDERR, '>', \$err or die $!; 
     123 
     124  my @array; 
     125  watch(@array) or die $!; 
     126  @array = (1,2,3,4); 
     127  like($err, qr{^main:: \@array\[0\] => 1}m); 
     128  like($err, qr{^main:: \@array\[1\] => 2}m); 
     129  like($err, qr{^main:: \@array\[2\] => 3}m); 
     130  like($err, qr{^main:: \@array\[3\] => 4}m); 
     131  @array = (8,7,6,5); 
     132  like($err, qr{^main:: \@array\[0\] => 8}m); 
     133  like($err, qr{^main:: \@array\[1\] => 7}m); 
     134  like($err, qr{^main:: \@array\[2\] => 6}m); 
     135  like($err, qr{^main:: \@array\[3\] => 5}m); 
     136  undef @array; 
     137  like($err, qr{^main:: \@array\[0 .. 3\] => STORESIZE\(\)}m); 
     138 
     139  close STDERR; 
    119140} 
    120