From ee39f29cf48e873e015c0da8b1257097c4fb966e Mon Sep 17 00:00:00 2001 From: einhverfr Date: Mon, 17 Nov 2008 17:30:44 +0000 Subject: More test cases and framework stuff. t/62-api.t is currently not working. git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@2403 4979c152-3d1c-0410-bac9-87ea11338e46 --- LedgerSMB/DBTest.pm | 126 +++++++++++++++++++++++++++++++++++++++++++++++ README.tests | 24 +++++++++ t/11-ledgersmb.t | 131 ++++++++++++++++++++++--------------------------- t/43-dbtest.t | 10 +++- t/62-api.t | 76 ++++++++++++++++++++++++++++ t/63-lwp.t | 0 t/data/62-request-data | 58 ++++++++++++++++++++++ 7 files changed, 351 insertions(+), 74 deletions(-) create mode 100644 LedgerSMB/DBTest.pm create mode 100644 t/62-api.t create mode 100644 t/63-lwp.t create mode 100644 t/data/62-request-data diff --git a/LedgerSMB/DBTest.pm b/LedgerSMB/DBTest.pm new file mode 100644 index 00000000..915bfc0b --- /dev/null +++ b/LedgerSMB/DBTest.pm @@ -0,0 +1,126 @@ + +=head1 NAME + +LedgerSMB::DBTest - LedgerSMB commit filter for test cases. + +=head1 SYOPSIS + +This module creates a DBI-like interface but ensures autocommit is off, +and filters commit statements such that they don't do anything. This can be +used for making API test cases which involve DB commits safe for production +environments. + +=head1 USAGE + +Both LedgerSMB.pm and LedgerSMB/Form.pm assign a global database handler for all +database access within a script in the dbh property (for example, +$request->{dbh} or $form->{dbh}). By setting this early to a +LedgerSMB::DBTest (instead of a DBI object), the tests can be made safe. + +However, there are a few limitations to be aware of. One cannot run tests +through the standard request handler and use this module. Hence this is limited +to unit tests of files in the LedgerSMB, scripts, and bin directories. + +Here is an example of how this could be done: + + my $lsmb = LedgerSMB->new(); + $lsmb->merge($testdata); + my $dbh = LedgerSMB::DBTest->connect("dbi:Pg:dbname=$company", "$username", + "$password",) + $lsmb->{dbh} = $dbh; + + +=head1 METHODS + +=over + +=item connect($dsn, $user, $pass) + +Connects to the database and returns a LedgerSMB::DBTest object + +=item commit() + +Tests the current transaction (issues a 'SELECT 1;' to the database). If this +is successful returns 1, if not, rolls back and returns false. + +Note that this means all past tests are rolled back and this is inconsistent +with normal transactional behavior. + +=item prepare() + +Returns a statement handle, via the private DBI database handle. + +=item do() + +passes this statement on to the private database handle + +=item errstr() + +passes this call on to the private database handle + +=item err() + +passes this call on to the private database handle + +=item rollback() + +passes this call on to the private database handle. Note that this will roll +back all statements issues through this object. + +=back + +=cut + +use DBI; +package LedgerSMB::DBTest; + +sub DISTROY { + my ($self) = @_; + $self->disconnect; +} + +sub connect{ + my ($class, $dsn, $user, $pass) = @_; + my $self = {}; + $self->{_dbh} = DBI->connect($dsn, $user, $pass, {AutoCommit => 0 }); + bless $self, $class; + return $self; +} + +sub disconnect { + my ($self) = @_; + $self->rollback; + $self->{_dbh}->disconnect; +} + +sub do { + my ($self, $statement) = @_; + return $self->{_dbh}->do($statement); +} + +sub err{ + my ($self) = @_; + return $self->{_dbh}->err; +} + +sub errstr{ + my ($self) = @_; + return $self->{_dbh}->errstr; +} + +sub prepare{ + my ($self, $statement) = @_; + return $self->{_dbh}->prepare($statement); +} + +sub rollback { + my ($self) = @_; + return $self->{_dbh}->rollback; +} + +sub state{ + my ($self) = @_; + return $self->{_dbh}->state; +} + +1; diff --git a/README.tests b/README.tests index ebbdac82..52bea2ae 100644 --- a/README.tests +++ b/README.tests @@ -8,3 +8,27 @@ Test file number allocation: 90 - 99: Packaging checks Environment variables can be used as flags to disable/enable tests >= 40 + +LSMB_TEST_DB must be set to a defined value if databases are going to be tested. + +if LSMB_NEW_DB is set, test 40 (when it is complete) will create a database with +the name from this environment variable, and subsequent database tests will run +against that database. If this is not set, and PGDATABASE is set, tests will +run on that database. If neither are set, the tests will bail out. + +Special notes on specific test cases: + +42-dbobject.t: Some tests will run even if LSMB_TEST_DB is not enabled. These +tests do not require a database connection. + +43-dbtest.t: This runs defined test cases from sql/modules/test/. If new +scripts are added, they must be listed in this script as well. + +62-api.t uses request hashes defined in t/data/62-request-data. This +script employs a database commit filter to prevent commits to the db. It is +safe to run on existing databases. + +63-lwp.t will re-use the request hashes defined in test/data/62-request-data. +It does NOT employ a commit filter, so is NOT safe to run against production +data. It will only run if the environment variable LSMB_TEST_LWN is set to true. + diff --git a/t/11-ledgersmb.t b/t/11-ledgersmb.t index 0ddf29ab..be112bef 100644 --- a/t/11-ledgersmb.t +++ b/t/11-ledgersmb.t @@ -12,7 +12,7 @@ use Math::BigFloat; use LedgerSMB::Sysconfig; use LedgerSMB; - +my $lsmb; sub redirect { print "redirected\n"; } @@ -34,7 +34,7 @@ sub lsmb_error_func { ##547 merge -my $lsmb = LedgerSMB->new(); +$lsmb = LedgerSMB->new(); my %myconfig; my $utfstr; my @r; @@ -43,7 +43,7 @@ ok(defined $lsmb); isa_ok($lsmb, 'LedgerSMB'); # $lsmb->escape checks -my $lsmb = LedgerSMB->new(); +$lsmb = LedgerSMB->new(); $utfstr = "\xd8\xad"; utf8::decode($utfstr); ok(!$lsmb->escape, 'escape: (undef)'); @@ -61,7 +61,7 @@ TODO: { } # $lsmb->is_blank checks -my $lsmb = LedgerSMB->new(); +$lsmb = LedgerSMB->new(); $lsmb->{blank} = ' '; $lsmb->{notblank} = ' d '; TODO: { @@ -74,7 +74,7 @@ is($lsmb->is_blank('name' => 'notblank'), 0, 'is_blank: notblank'); is($lsmb->is_blank('name' => 'blank'), 1, 'is_blank: blank'); # $lsmb->is_run_mode checks -my $lsmb = LedgerSMB->new(); +$lsmb = LedgerSMB->new(); $ENV{GATEWAY_INTERFACE} = 'foo'; is($lsmb->is_run_mode('cgi'), 1, 'is_run_mode: CGI - CGI'); is($lsmb->is_run_mode('cli'), 0, 'is_run_mode: CGI - CLI'); @@ -101,7 +101,7 @@ is($lsmb->is_run_mode('foo'), 0, 'is_run_mode: CLI - (bad mode)'); is($lsmb->is_run_mode, 0, 'is_run_mode: CLI - (unknown mode)'); # $lsmb->num_text_rows checks -my $lsmb = LedgerSMB->new(); +$lsmb = LedgerSMB->new(); is($lsmb->num_text_rows('string' => "apple\npear", 'cols' => 10, 'max' => 5), 2, 'num_text_rows: 2 rows, no column breakage, max 5 rows'); is($lsmb->num_text_rows('string' => "apple\npear", 'cols' => 10, 'max' => 1), @@ -124,7 +124,7 @@ is($lsmb->num_text_rows('string' => "012345 67890123456789", 'cols' => 10), 3, 'num_text_rows: 3 rows, word and non column breakage, no max row count'); # $lsmb->debug checks -my $lsmb = LedgerSMB->new(); +$lsmb = LedgerSMB->new(); @r = trap{$lsmb->debug()}; #SKIP: {like($trap->stdout, qr|\n\$VAR1 = bless\( {[\n\s]+'action' => '',[\n\s]+'dbversion' => '\d+\.\d+\.\d+',[\n\s]+'path' => 'bin/mozilla',[\n\s]+'version' => '$lsmb->{version}'[\n\s]+}, 'LedgerSMB' \);|, # 'debug: $lsmb->debug'); @@ -138,9 +138,18 @@ SKIP: { my @str = <$FH>; close($FH); chomp(@str); - #FIXME test broken below: - #like(join("\n", @str), qr|\$VAR1 = 'file';\n\$VAR2 = 't/var/lsmb-11.$$';\n\$VAR3 = bless\( {[\n\s]+'action' => '',[\n\s]+'dbversion' => '\d+\.\d+\.\d+',[\n\s]+'file' => 't/var/lsmb-11.$$',[\n\s]+'path' => 'bin/mozilla',[\n\s]+'version' => '$lsmb->{version}'[\n\s]+}, 'LedgerSMB' \);|, - # 'debug: $lsmb with file, contents'); + cmp_ok(grep (/\s?\$VAR1\s=\sbless/, @str), '>', 0, + 'Debug Contents, var1 type'); + cmp_ok(grep (/'action' => ''/, @str), '>', 0, + 'Debug contents, blank action'); + cmp_ok(grep (/'dbversion' => '\d+\.\d+\.\d+'/, @str), '>', 0, + 'Debug contents, dbversion format'); + cmp_ok(grep (/'path' => 'bin\/mozilla'/, @str), '>', 0, + 'Debug contents, path'); + cmp_ok(grep (/'version' => '$lsmb->{version}'/, @str), '>', 0, + 'Debug contents, version match'); + cmp_ok(grep (/'file' => 't\/var\/lsmb-11.$$'/, @str), '>', 0, + 'Debug contents file attribute match'); is(unlink("t/var/lsmb-11.$$"), 1, "debug: removing t/var/lsmb-11.$$"); ok(!-e "t/var/lsmb-11.$$", "debug: t/var/lsmb-11.$$ removed"); }; @@ -152,7 +161,7 @@ like($trap->die, qr/No such file or directory/, ok(!-e $lsmb->{file}, "debug: file creation failed"); # $lsmb->new checks -my $lsmb = LedgerSMB->new(); +$lsmb = LedgerSMB->new(); ok(defined $lsmb, 'new: blank, defined'); isa_ok($lsmb, 'LedgerSMB', 'new: blank, correct type'); ok(defined $lsmb->{action}, 'new: blank, action defined'); @@ -160,41 +169,21 @@ ok(defined $lsmb->{dbversion}, 'new: blank, dbversion defined'); ok(defined $lsmb->{path}, 'new: blank, path defined'); ok(defined $lsmb->{version}, 'new: blank, version defined'); -#my $lsmb = LedgerSMB->new(); -#ok(defined $lsmb, 'new: action set, defined'); -#isa_ok($lsmb, 'LedgerSMB', 'new: action set, correct type'); -#ok(defined $lsmb->{action}, 'new: action set, action defined'); -#is($lsmb->{action}, 'apple_sauce', 'new: action set, action processed'); -#ok(defined $lsmb->{dbversion}, 'new: action set, dbversion defined'); -#ok(defined $lsmb->{path}, 'new: action set, path defined'); -#ok(defined $lsmb->{version}, 'new: action set, version defined'); - -#my $lsmb = LedgerSMB->new(); -#ok(defined $lsmb, 'new: lynx, defined'); -#isa_ok($lsmb, 'LedgerSMB', 'new: lynx, correct type'); -#ok(defined $lsmb->{action}, 'new: lynx, action defined'); -#ok(defined $lsmb->{dbversion}, 'new: lynx, dbversion defined'); -#ok(defined $lsmb->{path}, 'new: lynx, path defined'); -#is($lsmb->{path}, 'bin/lynx', 'new: lynx, path carried through'); -#ok(defined $lsmb->{lynx}, 'new: lynx, lynx defined'); -#is($lsmb->{lynx}, 1, 'new: lynx, lynx enabled'); -#ok(defined $lsmb->{menubar}, 'new: lynx, menubar defined (deprecated)'); -#is($lsmb->{menubar}, 1, 'new: lynx, menubar enabled (deprecated)'); -#ok(defined $lsmb->{version}, 'new: lynx, version defined'); - -# THe test cases below are incomplete and need to be finished -#@r = trap {$lsmb = LedgerSMB->new()}; -#is($trap->die, "Error: Access Denied\n", -# 'new: directory traversal 1 caught'); -#@r = trap {$lsmb = LedgerSMB->new()}; -#is($trap->die, "Error: Access Denied\n", -# 'new: directory traversal 2 caught'); -#@r = trap {$lsmb = LedgerSMB->new()}; -#is($trap->die, "Error: Access Denied\n", -# 'new: directory traversal 3 caught'); +$lsmb = LedgerSMB->new('path=bin/lynx'); +ok(defined $lsmb, 'new: lynx, defined'); +isa_ok($lsmb, 'LedgerSMB', 'new: lynx, correct type'); +ok(defined $lsmb->{action}, 'new: lynx, action defined'); +ok(defined $lsmb->{dbversion}, 'new: lynx, dbversion defined'); +ok(defined $lsmb->{path}, 'new: lynx, path defined'); +is($lsmb->{path}, 'bin/lynx', 'new: lynx, path carried through'); +ok(defined $lsmb->{lynx}, 'new: lynx, lynx defined'); +is($lsmb->{lynx}, 1, 'new: lynx, lynx enabled'); +ok(defined $lsmb->{menubar}, 'new: lynx, menubar defined (deprecated)'); +is($lsmb->{menubar}, 1, 'new: lynx, menubar enabled (deprecated)'); +ok(defined $lsmb->{version}, 'new: lynx, version defined'); # $lsmb->redirect checks -my $lsmb = LedgerSMB->new(); +$lsmb = LedgerSMB->new(); ok(!defined $lsmb->{callback}, 'redirect: No callback set'); @r = trap{$lsmb->redirect}; is($trap->stdout, "redirected\n", 'redirect: No message or callback redirect'); @@ -210,49 +199,47 @@ is($trap->stdout, "redirected\n", 'redirect: callback, no message redirect'); @r = trap{$lsmb->redirect('msg' => "hello world\n")}; is($trap->stdout, "redirected\n", 'redirect: callback and message redirect'); -# Commenting out tests that have to hit db, since this doesn't work so well with -# 1.3 # $lsmb->call_procedure checks -#my $lsmb = LedgerSMB->new(); -#$lsmb->{dbh} = ${LedgerSMB::Sysconfig::GLOBALDBH}; -#@r = $lsmb->call_procedure('procname' => 'character_length', -# 'args' => ['month']); -#is($#r, 0, 'call_procedure: correct return length (one row)'); -#is($r[0]->{'character_length'}, 5, -# 'call_procedure: single arg, non-numeric return'); -# -#@r = $lsmb->call_procedure('procname' => 'trunc', 'args' => [57.1, 0]); -#is($r[0]->{'trunc'}, Math::BigFloat->new('57'), -# 'call_procedure: two args, numeric return'); -# -#@r = $lsmb->call_procedure('procname' => 'pi', 'args' => []); -#like($r[0]->{'pi'}, qr/^3.14/, -# 'call_procedure: empty arg list, non-numeric return'); +SKIP: { + skip 'Skipping call_procedure tests, no db specified' + if !defined $ENV{PGDATABASE}; + $lsmb = LedgerSMB->new(); + $lsmb->{dbh} = DBI->connect("dbi:Pg:dbname=$ENV{PGDATABASE}", + undef, undef, {AutoCommit => 0 }); + @r = $lsmb->call_procedure('procname' => 'character_length', + 'args' => ['month']); + is($#r, 0, 'call_procedure: correct return length (one row)'); + is($r[0]->{'character_length'}, 5, + 'call_procedure: single arg, non-numeric return'); + + @r = $lsmb->call_procedure('procname' => 'trunc', 'args' => [57.1, 0]); + is($r[0]->{'trunc'}, Math::BigFloat->new('57'), + 'call_procedure: two args, numeric return'); -## -##TODO: { -## local $TODO = 'Breaks when no arglist given'; -## @r = $lsmb->call_procedure('procname' => 'pi'); -## like($r[0]->{'pi'}, qr/^3.14/, -## 'call_procedure: no args, non-numeric return'); -##} + @r = $lsmb->call_procedure('procname' => 'pi', 'args' => []); + like($r[0]->{'pi'}, qr/^3.14/, + 'call_procedure: empty arg list, non-numeric return'); + @r = $lsmb->call_procedure('procname' => 'pi'); + like($r[0]->{'pi'}, qr/^3.14/, + 'call_procedure: no args, non-numeric return'); +} # $lsmb->merge checks -my $lsmb = LedgerSMB->new(); +$lsmb = LedgerSMB->new(); $lsmb->merge({'apple' => 1, 'pear' => 2, 'peach' => 3}, 'keys' => ['apple', 'pear']); ok(!defined $lsmb->{peach}, 'merge: Did not add unselected key'); is($lsmb->{apple}, 1, 'merge: Added unselected key apple'); is($lsmb->{pear}, 2, 'merge: Added unselected key pear'); like($lsmb->{path}, qr#bin/(lynx|mozilla)#, 'merge: left existing key'); -my $lsmb = LedgerSMB->new(); +$lsmb = LedgerSMB->new(); $lsmb->merge({'apple' => 1, 'pear' => 2, 'peach' => 3}); is($lsmb->{apple}, 1, 'merge: No key, added apple'); is($lsmb->{pear}, 2, 'merge: No key, added pear'); is($lsmb->{peach}, 3, 'merge: No key, added peach'); like($lsmb->{path}, qr#bin/(lynx|mozilla)#, 'merge: No key, left existing key'); -my $lsmb = LedgerSMB->new(); +$lsmb = LedgerSMB->new(); $lsmb->merge({'apple' => 1, 'pear' => 2, 'peach' => 3}, 'index' => 1); is($lsmb->{apple_1}, 1, 'merge: Index 1, added apple as apple_1'); is($lsmb->{pear_1}, 2, 'merge: Index 1, added pear as pear_1'); @@ -260,7 +247,7 @@ is($lsmb->{peach_1}, 3, 'merge: Index 1, added peach as peach_1'); like($lsmb->{path}, qr#bin/(lynx|mozilla)#, 'merge: Index 1, left existing key'); # $lsmb->is_allowed_role checks -my $lsmb = LedgerSMB->new(); +$lsmb = LedgerSMB->new(); $lsmb->{_roles} = ['apple', 'pear']; is($lsmb->is_allowed_role({allowed_roles => ['pear']}), 1, 'is_allowed_role: allowed role'); diff --git a/t/43-dbtest.t b/t/43-dbtest.t index 812c382b..9cc9fd15 100644 --- a/t/43-dbtest.t +++ b/t/43-dbtest.t @@ -1,11 +1,17 @@ use Test::More; use strict; -if (!defined $ENV{PGDATABASE}){ - plan skip_all => 'PGDATABASE Environment Variable not set up'; +if (!defined $ENV{LSMB_TEST_DB}){ + plan skip_all => 'Skipping all. Told not to test db.'; } else { plan tests => 50; + if (defined $ENV{LSMB_NEW_DB}){ + $ENV{PGDATABASE} = $ENV{LSMB_NEW_DB}; + } + if (!defined $ENV{PGDATABASE}){ + die "We were told to run tests, but no database specified!"; + } } my @testscripts = qw(Account Business_type Company Draft Payment diff --git a/t/62-api.t b/t/62-api.t new file mode 100644 index 00000000..0e897f35 --- /dev/null +++ b/t/62-api.t @@ -0,0 +1,76 @@ +BEGIN { + use LedgerSMB; + use Test::More; + use LedgerSMB::Template; + use LedgerSMB::DBTest; +} + +our $test_case_defs = { +}; + +if (defined $ENV{LSMB_TEST_DB}){ + if (defined $ENV{LSMB_NEW_DB}){ + $ENV{PGDATABASE} = $ENV{LSMB_NEW_DB}; + } + if (!defined $ENV{PGDATABASE}){ + die "Oops... LSMB_TEST_DB set but no db selected!"; + } + plan 'no_plan'; +} else { + plan skip_all => 'Skipping, LSMB_TEST_DB environment variable not set.'; +} + +do 't/data/62-request-data'; # Import test case hashes + +for (qw( admin.pl drafts.pl login.pl payment.pl + report.pl employee.pl menu.pl vendor.pl + customer.pl inventory.pl migration.pl recon.pl + vouchers.pl)){ + + do "$_"; +} # Import new code namespaces + +my $dbh = LedgerSMB::DBTest->connect("dbi:Pg:dbname=$ENV{PGDATABASE}", undef, undef); + +print scalar @$test_request_data ." test case scenarios defined"; + +for my $test (@$test_request_data){ + if (lc $test->{_codebase} eq 'old'){ + old_code_test::_load_script($test->{module}); + $old_code_test::form = new Form(); + for (keys (%$test)){ + $form->{$_} = $test->{$_}; + } + ok(eval ("old_code_test::$test->{action}()"), + "$test->{_test_id}: Action Successful"); + } else { + my $request = LedgerSMB->new(); + $request->merge($test); + my $script = $test->{module}; + $script =~ s/\.pl$//; + ok(eval "LedgerSMB::Scripts::$script::$request->{action}(\$request)"); + } + for (@{$test_case_defs->{"$test->{_test_id}"}}){ + &$_; + } + ok($dbh->rollback, "$test->{_test_id}: rollback"); +} + +package LedgerSMB::Template; + +# Don't render templates. Just return so we can run tests on data structures. +sub render { + return 1; +} + +package old_code_test; +# Keeps old code isolated in a different namespace, and provides for reasonable +# reload facilities. +our $form; + +sub _load_script { + do "bin/arapprn.pl"; + do "bin/arap.pl"; + do "bin/io.pl"; + do "bin/$1[0]"; +} diff --git a/t/63-lwp.t b/t/63-lwp.t new file mode 100644 index 00000000..e69de29b diff --git a/t/data/62-request-data b/t/data/62-request-data new file mode 100644 index 00000000..ae8c6d0e --- /dev/null +++ b/t/data/62-request-data @@ -0,0 +1,58 @@ + +our $test_request_data = [ + # AR/AP Transaction Screen Tests + { + '_test_id' => 'AR Transaction Screen', + '_codebase' => 'old', + 'module' => 'ar.pl', + 'action' => 'add' + }, + { + '_test_id' => 'AP Transaction Screen', + '_codebase' => 'old', + 'module' => 'ap.pl', + 'action' => 'add' + }, + # Create Batch Screens + { + '_test_id' => 'AR Transaction Voucher Screen', + '_codebase' => 'new', + 'action' => 'create_batch', + 'batch_type' => 'recievable', + 'module' => 'vouchers.pl', + }, + { + '_test_id' => 'AP Transaction Voucher Screen', + '_codebase' => 'new', + 'action' => 'create_batch', + 'batch_type' => 'payable', + 'module' => 'vouchers.pl', + }, + { + '_test_id' => 'Payment Transaction Voucher Screen', + '_codebase' => 'new', + 'action' => 'create_batch', + 'batch_type' => 'payment', + 'module' => 'vouchers.pl', + }, + { + '_test_id' => 'Payment Reversal Transaction Voucher Screen', + '_codebase' => 'new', + 'action' => 'create_batch', + 'batch_type' => 'payment_reversal', + 'module' => 'vouchers.pl', + }, + { + '_test_id' => 'GL Transaction Voucher Screen', + '_codebase' => 'new', + 'action' => 'create_batch', + 'batch_type' => 'gl', + 'module' => 'vouchers.pl', + }, +]; + + +opendir (D62, 't/data/62.d'); +for my $testfile (readdir(D62)){ + do "t/data/62.d/$testfile"; +}; -- cgit v1.2.3