[Templates-cvs] cvs commit: Template2/t tiedhash.t
cvs@template-toolkit.org
cvs@template-toolkit.org
cvs 06/01/29 11:37:37
Modified: t tiedhash.t
Log:
* added more tests for tied hashes and lists
Revision Changes Path
2.5 +163 -67 Template2/t/tiedhash.t
Index: tiedhash.t
===================================================================
RCS file: /template-toolkit/Template2/t/tiedhash.t,v
retrieving revision 2.4
retrieving revision 2.5
diff -u -r2.4 -r2.5
--- tiedhash.t 2002/08/12 11:07:17 2.4
+++ tiedhash.t 2006/01/29 11:37:37 2.5
@@ -12,15 +12,16 @@
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
-# $Id: tiedhash.t,v 2.4 2002/08/12 11:07:17 abw Exp $
+# $Id: tiedhash.t,v 2.5 2006/01/29 11:37:37 abw Exp $
#
#========================================================================
use strict;
+use warnings;
use lib qw( blib/lib blib/arch lib ../blib/lib ../blib/arch ../lib );
use Template::Test;
use Template::Stash;
-$^W = 1;
+our $DEBUG = grep(/-d/, @ARGV);
eval {
require Template::Stash::XS;
@@ -33,73 +34,72 @@
#print "stash: $Template::Config::STASH\n";
#$Template::Config::STASH = 'Template::Stash::XS';
+our $STORE_PREFIX = '';
+our $FETCH_PREFIX = '';
+
#------------------------------------------------------------------------
package My::Tied::Hash;
-use base qw( Tie::Hash );
-use vars qw( $AUTOLOAD );
+use Tie::Hash;
+use base 'Tie::StdHash';
-sub new {
- my ($class, $meths) = @_;
- my %hash;
- tie %hash, $class, $meths;
- return \%hash;
+sub FETCH {
+ my ($hash, $key) = @_;
+ print STDERR "FETCH($key)\n" if $main::DEBUG;
+ my $val = $hash->{ $key };
+ return $val ? (ref $val ? $val : "$main::FETCH_PREFIX$val") : undef;
}
-sub TIEHASH {
- my ($class, $meths) = @_;
- bless $meths, $class;
+sub STORE {
+ my ($hash, $key, $val) = @_;
+ print STDERR "STORE($key, $val)\n" if $main::DEBUG;
+ $hash->{ $key } = ref $val ? $val : "$main::STORE_PREFIX$val";
}
+#------------------------------------------------------------------------
+package My::Tied::List;
+use Tie::Array;
+use base 'Tie::StdArray';
+
sub FETCH {
- my ($self, $key) = @_;
- my $action = $self->{ FETCH } || return undef;
- &$action($key);
+ my ($list, $n) = @_;
+ print STDERR "FETCH from list [$n]\n" if $main::DEBUG;
+ my $val = $list->[ $n ];
+ return $val ? (ref $val ? $val : "$main::FETCH_PREFIX$val") : undef;
}
sub STORE {
- my ($self, $key, $value) = @_;
- my $action = $self->{ STORE } || return undef;
- &$action($key, $value);
+ my ($list, $n, $val) = @_;
+ print STDERR "STORE to list [$n => $val]\n" if $main::DEBUG;
+ $list->[$n] = ref $val ? $val : "$main::STORE_PREFIX$val";
}
-# sub DELETE { }
-# sub CLEAR { }
-# sub EXISTS { }
-# sub FIRSTKEY { }
-# sub NEXTKEY { }
-
-sub AUTOLOAD {
- my $self = shift;
- my $item = $AUTOLOAD;
- $item =~ s/.*:://;
- return if $item eq 'DESTROY';
- my $action = $self->{ $item } || return undef;
- &$action(@_);
-}
-
#------------------------------------------------------------------------
package main;
-my $DEBUG = grep(/-d/, @ARGV);
-my $data = callsign();
-$data->{ zero } = 0;
-$data->{ one } = 1;
-
-my $hash = My::Tied::Hash->new({
- FETCH => sub { my $key = shift;
- print "FETCH($key)\n" if $DEBUG;
- $data->{ $key };
- },
- STORE => sub { my ($key, $val) = @_;
- print "STORE($key, $val)\n" if $DEBUG;
- $data->{ $key } = $val;
- },
-});
-
-#------------------------------------------------------------------------
-my $stash_perl = Template::Stash->new({ hash => $hash });
-my $stash_xs = Template::Stash::XS->new({ hash => $hash });
+# setup a tied hash and a tied list
+my @list;
+tie @list, 'My::Tied::List';
+push(@list, 10, 20, 30);
+
+my %hash = (a => 'alpha');
+tie %hash, 'My::Tied::Hash';
+$hash{ a } = 'alpha';
+$hash{ b } = 'bravo';
+$hash{ zero } = 0;
+$hash{ one } = 1;
+
+# now turn on the prefixes so we can track items going in
+# and out of the tied hash/list
+$FETCH_PREFIX = 'FETCH:';
+$STORE_PREFIX = 'STORE:';
+
+my $data = {
+ hash => \%hash,
+ list => \@list,
+};
+my $stash_perl = Template::Stash->new($data);
+my $stash_xs = Template::Stash::XS->new($data);
my $tt = [
perl => Template->new( STASH => $stash_perl ),
xs => Template->new( STASH => $stash_xs ),
@@ -107,15 +107,22 @@
test_expect(\*DATA, $tt);
__DATA__
+
+#------------------------------------------------------------------------
+# first try with the Perl stash
+#------------------------------------------------------------------------
+
+# hash tests
+
-- test --
[% hash.a %]
-- expect --
-alpha
+FETCH:alpha
-- test --
[% hash.b %]
-- expect --
-bravo
+FETCH:bravo
-- test --
ready
@@ -124,7 +131,7 @@
-- expect --
ready
set:
-go:cosmos
+go:FETCH:STORE:cosmos
-- test --
[% hash.foo.bar = 'one' -%]
@@ -132,44 +139,133 @@
-- expect --
one
+# list tests
+
+-- test --
+[% list.0 %]
+-- expect --
+FETCH:10
+
-- test --
+[% list.first %]-[% list.last %]
+-- expect --
+FETCH:10-FETCH:30
+
+-- test --
+[% list.push(40); list.last %]
+-- expect --
+FETCH:40
+
+-- test --
+[% list.4 = 50; list.4 %]
+-- expect --
+FETCH:STORE:50
+
+
+#------------------------------------------------------------------------
+# now try using the XS stash
+#------------------------------------------------------------------------
+
+# hash tests
+
+-- test --
-- use xs --
[% hash.a %]
-- expect --
-alpha
+FETCH:alpha
-- test --
[% hash.b %]
-- expect --
-bravo
+FETCH:bravo
-- test --
-ready
-set:[% hash.c = 'crazy' %]
-go:[% hash.c %]
+[% hash.c = 'crazy'; hash.c %]
-- expect --
-ready
-set:
-go:crazy
+FETCH:STORE:crazy
+
+-- test --
+[% DEFAULT hash.c = 'more crazy'; hash.c %]
+-- expect --
+FETCH:STORE:crazy
-- test --
[% hash.wiz = 'woz' -%]
[% hash.wiz %]
-- expect --
-woz
+FETCH:STORE:woz
-- test --
[% DEFAULT hash.zero = 'nothing';
hash.zero
%]
-- expect --
-nothing
+FETCH:STORE:nothing
-- test --
-[% DEFAULT hash.one = 'solitude';
+before: [% hash.one %]
+after: [% DEFAULT hash.one = 'solitude';
hash.one
%]
-- expect --
-1
+before: FETCH:1
+after: FETCH:1
+-- test --
+[% hash.foo = 10; hash.foo = 20; hash.foo %]
+-- expect --
+FETCH:STORE:20
+
+# this test should create an intermediate hash
+-- test --
+[% DEFAULT hash.person = { };
+ hash.person.name = 'Arthur Dent';
+ hash.person.email = 'dent@tt2.org';
+-%]
+name: [% hash.person.name %]
+email: [% hash.person.email %]
+-- expect --
+name: Arthur Dent
+email: dent@tt2.org
+
+
+# list tests
+
+-- test --
+[% list.0 %]
+-- expect --
+FETCH:10
+
+-- test --
+[% list.first %]-[% list.last %]
+-- expect --
+FETCH:10-FETCH:STORE:50
+
+-- test --
+[% list.push(60); list.last %]
+-- expect --
+FETCH:60
+
+-- test --
+[% list.5 = 70; list.5 %]
+-- expect --
+FETCH:STORE:70
+
+-- test --
+[% DEFAULT list.5 = 80; list.5 %]
+-- expect --
+FETCH:STORE:70
+
+-- test --
+[% list.10 = 100; list.10 %]
+-- expect --
+FETCH:STORE:100
+
+-- test --
+[% stuff = [ ];
+ stuff.0 = 'some stuff';
+ stuff.0
+-%]
+-- expect --
+some stuff