[Templates-cvs] cvs commit: TT3/t base.t

[cvs@template-toolkit.org]

cvs         03/12/03 14:04:21

  Added:       t        base.t
  Log:
  added Template::Toolkit::Base and t/base.t
  
  Revision  Changes    Path
  1.1                  TT3/t/base.t
  
  Index: base.t
  ===================================================================
  #============================================================= -*-perl-*-
  #
  # t/base.t
  #
  # Test the Template::Toolkit::Base.pm module.
  #
  # Written by Andy Wardley <abw@wardley.org>
  #
  # This is free software; you can redistribute it and/or modify it
  # under the same terms as Perl itself.
  #
  # $Id: base.t,v 1.1 2003/12/03 14:04:21 abw Exp $
  #
  #========================================================================
  
  use strict;
  use warnings;
  
  use lib qw( ./lib ../lib );
  use Template::Toolkit::Base;
  use Test::More tests => 43;
  
  $Template::Toolkit::Base::DEBUG = grep(/^--?d(ebug)?/, @ARGV);
  
  my ($pkg, $obj);
  
  
  #------------------------------------------------------------------------
  # basic test of constructor
  #------------------------------------------------------------------------
  
  # instantiate a base class object and test error reporting/returning
  $pkg = 'Template::Toolkit::Base';
  $obj = $pkg->new() || die $pkg->error();
  ok( $obj, 'created a base class object' );
  
  
  #------------------------------------------------------------------------
  # test the error() method
  #------------------------------------------------------------------------
  
  ok( ! defined $obj->error('barf'), 'set object error' );
  ok( $obj->error() eq 'barf', 'got object error' );
  
  
  #------------------------------------------------------------------------
  # test the warning() and warnings() object methods
  #------------------------------------------------------------------------
  
  ok( ! $obj->warning('first warning'), 'sent first warning' );
  
  my $warnings = $obj->warning() || die "no warnings returned\n";
  ok( $warnings, 'got warnings back' );
  is( ref $warnings, 'ARRAY', 'warnings is an array ref' );
  is( scalar @$warnings, 1, 'has one item' );
  is( $warnings->[0], 'first warning', 'first warning correct' );
  
  ok( ! $obj->warning('second ', 'warning'), 'sent second warning' );
  is( scalar @$warnings, 2, 'has two items' );
  is( $warnings->[0], 'first warning', 'first warning still correct' );
  is( $warnings->[1], 'second warning', 'second warning correct' );
  
  ok( ! $obj->warning({ test => 'reference' }), 'sent reference warning' );
  is( $warnings->[2]->{ test }, 'reference', 'got reference warning back' );
  
  # warnings() returns list in list context
  my @warns = $obj->warnings();
  is( $warns[0], 'first warning', 'list warning one' );
  is( $warns[1], 'second warning', 'list warning two' );
  
  # warnings() returns list ref in scalar context
  my $warns = $obj->warnings();
  is( $warns->[0], 'first warning', 'list ref warning one' );
  is( $warns->[1], 'second warning', 'list ref warning two' );
  
  # warnings($a, $b, $c) sets several warnings
  ok( ! $obj->warnings('foo', 'bar', { ping => 'pong' }), 'set warnings' );
  is( $warns->[3], 'foo', 'foo warning' );
  is( $warns->[4], 'bar', 'bar warning' );
  is( $warns->[5]->{ ping }, 'pong', 'game of ping pong' );
  
  
  #------------------------------------------------------------------------
  # test the warning() and warnings() class methods
  #------------------------------------------------------------------------
  
  package Template::Test::Warning;
  use base qw( Template::Toolkit::Base );
  use vars qw( $WARNING );
  
  package main;
  
  my $wpkg = 'Template::Test::Warning';
  is( $wpkg->warning('warning one'), 0, 'sent first pkg warning' );
  $warns = $wpkg->warning();
  ok( $warns, 'got package warnings back' );
  is( ref $warns, 'ARRAY', 'it is an array' );
  is( scalar @$warns, '1', 'it has one entry' );
  is( $warns->[0], 'warning one', 'package warning is correct' );
  
  is( $wpkg->warning('two'), 0, 'sent second pkg warning' );
  is( join(', ', $wpkg->warnings()), 'warning one, two', 
      'got back both package warnings' );
  
  is( $wpkg->warnings('three', 'four'), 0, 
      'sent third and fourth pkg warning' );
  is( join(', ', $wpkg->warnings()), 'warning one, two, three, four', 
      'got back all four package warnings' );
  
  
  
  #------------------------------------------------------------------------
  # Template::Test::Fail always fails, but we check it reports errors OK
  #------------------------------------------------------------------------
  
  package Template::Test::Fail;
  use base qw( Template::Toolkit::Base );
  use vars qw( $ERROR $WARNING );
  
  sub init {
      my $self = shift;
      return $self->error('expected failure');
  }
  
  package main;
  
  # Template::Test::Fail should never work, but we check it reports errors OK
  $pkg = 'Template::Test::Fail';
  ok( ! $pkg->new(), 'test fail failed' );
  is( $pkg->error, 'expected failure', 'got object error' );
  is( $Template::Test::Fail::ERROR, 'expected failure', 'got package error' );
  
  
  
  #------------------------------------------------------------------------
  # Template::Test::Name should only work with a 'name' parameter
  #------------------------------------------------------------------------
  
  package Template::Test::Name;
  use base qw( Template::Toolkit::Base );
  use vars qw( $ERROR );
  
  sub init {
      my ($self, $params) = @_;
      $self->{ NAME } = $params->{ name } 
      || return $self->error("No name!");
      return $self;
  }
  
  sub name {
      $_[0]->{ NAME };
  }
  
  package main;
  
  $pkg = 'Template::Test::Name';
  $obj = $pkg->new();
  ok( ! $obj, 'name test failed' );
  is( $Template::Test::Name::ERROR, 'No name!', 'name error variable' );
  is( $pkg->error(), 'No name!', 'name error method' );
  
  # give it what it wants...
  $obj = $pkg->new({ name => 'foo' }) || die $pkg->error();
  ok( $obj, 'created name object' );
  ok( ! $obj->error(), 'no error' );
  is( $obj->name(), 'foo', 'name matches' );
  
  # ... in 2 different flavours
  $obj = $pkg->new(name => 'foo') || die $pkg->error();
  ok( $obj, 'got args object' );
  ok( ! $obj->error(), 'no args error' );
  is( $obj->name(), 'foo', 'args name matches' );
  
  
  __END__