ossp-pkg/string-divert/test.pl
1.7
##
## String::Divert - String Object supporting Folding and Diversion
## Copyright (c) 2003-2005 Ralf S. Engelschall <rse@engelschall.com>
##
## This file is part of String::Divert, a Perl module providing
## a string object supporting folding and diversion.
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
## as published by the Free Software Foundation; either version
## 2.0 of the License, or (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
## General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this file; if not, write to the Free Software Foundation,
## Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
##
## test.pl: Module Test Suite
##
use 5.006;
use Test::More tests => 37;
# test: module loading
BEGIN { use_ok('String::Divert') };
# test: object creation
my $x = new String::Divert;
ok(defined($x), "object creation");
$x->destroy;
$x = new String::Divert;
ok(defined($x), "object (re)creation");
$x->name("xx");
ok($x->name() eq "xx", "overwritten object name");
$x->name("x");
my $y = $x->clone();
ok($x != $y, "cloning");
# test: simple content
ok($x->string() eq "", "empty initial content");
$x->append("foo");
$x->append("bar");
ok($x->string() eq "foobar", "appended content");
$x->assign("quux");
ok($x->string() eq "quux", "assigned content");
$x->assign("foo");
ok($x->string() eq "foo", "(re)assigned content");
$x->append("bar");
ok($x->string() eq "foobar", "append after assign");
# test: content overwrite mode
$x->assign("foo");
$x->overwrite('once');
$x->append("bar");
$x->append("quux");
ok($x->string() eq "barquux", "appending with overwrite 'once'");
$x->overwrite('always');
$x->append("bar");
$x->append("quux");
ok($x->string() eq "quux", "appending with overwrite 'always'");
$x->overwrite('none');
$x->append("bar");
$x->append("quux");
ok($x->string() eq "quuxbarquux", "appending with overwrite 'none'");
# test: content folding
$x->assign("foo");
$x->fold("bar");
$x->append("quux");
my $bar = $x->folding("bar");
ok(defined($bar), "folding object retrival 1");
ok($x->string() eq "fooquux", "folding 1");
$bar->append("bar");
ok($x->string() eq "foobarquux", "folding 2");
$bar->fold("baz");
$bar->append("bar2");
$bar->fold("baz");
$bar->append("bar3");
ok($x->string() eq "foobarbar2bar3quux", "folding 3");
my $baz = $x->folding("baz");
ok(defined($baz), "folding object retrival 2");
$baz->append("baz");
ok($baz->string() eq "baz", "folding 3");
ok($bar->string() eq "barbazbar2bazbar3", "folding 4");
ok($x->string() eq "foobarbazbar2bazbar3quux", "folding 5");
$baz->assign("XX");
ok($baz->string() eq "XX", "folding 6");
ok($bar->string() eq "barXXbar2XXbar3", "folding 7");
ok($x->string() eq "foobarXXbar2XXbar3quux", "folding 8");
my @foldings = $x->folding();
ok(@foldings == 3, "folding 9");
# test: content diversion
$x->assign("foo");
$x->fold("bar");
$x->append("quux");
$x->divert("bar");
$x->append("bar1");
$x->fold("baz");
$x->append("bar2");
$x->divert("baz");
$x->append("baz");
ok($x->string() eq "baz", "diversion 1");
$x->undivert;
ok($x->string() eq "bar1bazbar2", "diversion 2");
$x->undivert;
ok($x->string() eq "foobar1bazbar2quux", "diversion 3");
$x->divert("bar");
$x->divert("baz");
my @diversions = $x->diversion();
ok(@diversions == 2, "diversion 4");
$x->undivert(0);
@diversions = $x->diversion();
ok(@diversions == 0, "diversion 5");
# test: operator overloading
ok($x->overload == 0, "default overloading mode");
$x->overload(1);
ok($x->overload == 1, "default overloading mode");
$x->assign("foo");
ok("$x" eq "foo", "stringify operation");
$x .= "bar";
ok("$x" eq "foobar", "appending string");
$x *= "baz";
$x .= "quux";
ok("$x" eq "foobarquux", "appending folding");
$x >> "baz";
$x .= "baz";
$x << 0;
ok("$x" eq "foobarbazquux", "diversion");
# configuring folder patters
$x->assign("x");
$x->folder('{#%s#}', '\{#([a-zA-Z_][a-zA-Z0-9_.-]*)#\}');
ok("$x" eq "x", "folder pattern 1");
