Group
Extension

Tk-DBI-LoginDialog/t/03driver.t

#!/usr/bin/perl
#########################
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl 03driver.t'
#
# 03driver.t - test harness for module Tk::DBI::LoginDialog
#
# 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 of the License,
# or 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 program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#########################
use strict;
use warnings;

use Data::Dumper;
use Log::Log4perl qw/ :easy /;
use Tk;
use Test::More;

# ---- test harness ----
use lib 't';
use tester;

my $ot = tester->new('Tk::DBI::LoginDialog');
my $tests = 18;  # we dynamically increment as number of DBI drivers unknown


# ---- globals ----
Log::Log4perl->easy_init($DEBUG);
my $log = get_logger(__FILE__);
my $top = $ot->top;


# ---- module ----
require_ok($ot->this);


# ---- create ----
my $ld0 = $top->LoginDialog;
my $ld1 = $top->LoginDialog;

isa_ok($ld0, $ot->this, "new object 0");
isa_ok($ld1, $ot->this, "new object 1");


# ---- override driver ----
my $default = $ld0->driver;
my $invalid = "_invalid_";

$ld0->_error("condition: $invalid");	# just to show us what is happening

isnt($default, "",			"default driver");
isnt($ld0->driver($invalid), $invalid,	"prevent invalid override");
is($ld0->driver, $default,		"driver still valid");

#$log->debug(sprintf "default drivers [%s]", Dumper($ld0->drivers));

# ---- override drivers ----
my @drivers = qw/ Oracle ODBC CSV DB2 /;

is_deeply($ld0->drivers(@drivers), [@drivers], "configure drivers");

$ot->queue_button($ld0, "Cancel");

for my $driver (@drivers) {

	is($ld0->driver($driver), $driver,	"driver override $driver");

	$ld0->_error("condition: DSN $driver");

	$ot->queue_button($ld0, "Cancel");

	isnt($ld0->driver, "",			"driver set after $driver");

	$tests += 2;
}


# ---- constrain drivers ----
my $drivers = $ld1->drivers;
my $count = @$drivers;
my $driver = $ld1->driver;
my $removed;

ok($count > 0,			"drivers are available");

$removed = shift @{ $ld1->drivers };
$ld1->_error("condition: removed $removed");
isnt($removed, "",			"remove driver non-null");
isnt($removed, $ld1->driver,		"remove a driver");
isnt($driver, $ld1->driver,		"check removed");
ok(@{ $ld1->drivers } == $count - 1,	"one less driver available");
$ot->queue_button($ld1, "Cancel");

$removed = pop @{ $ld1->drivers };
$ld1->_error("condition: removed $removed");
isnt($removed, "",			"remove another driver non-null");
isnt($removed, $ld1->driver,		"remove another driver");
isnt($driver, $ld1->driver,		"check another removed");
ok(@{ $ld1->drivers } == $count - 2,	"have removed again");
isnt($ld1->driver, $driver,		"revised default");

$ot->queue_button($ld1, "Cancel");

my $max = @{ $ld1->drivers };
for (my $i = 0; $i < $max; $i++) {

	$removed = pop @{ $ld1->drivers };
	$ld1->_error("condition: removing $removed");
	ok(@{ $ld1->drivers } > 0,	"removing $removed");
	$ot->queue_button($ld1, "Cancel");

	$tests++;
}

ok(@{ $ld1->drivers } == $count,	"restored default drivers");

$ot->queue_button($ld1, "Cancel");

$ot->done($tests);



Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.