Attachment #39220 for bug #13673

View | Details | Raw Unified | Return to bug 13673
Collapse All | Expand All





use Test::More tests => 66;
BEGIN {
    use FindBin;
    use lib $FindBin::Bin;
    use_ok('C4::Barcodes');
}

my %thash = (
    incremental => [],
    annual => [],
    hbyymmincr => ['MAIN'],
    EAN13 => ['0000000695152','892685001928'],
);


my ($obj1,$obj2,$format,$value,$initial,$serial,$re,$next,$previous,$temp);
my @formats = sort keys %thash;
foreach (@formats) {
    my $pre = sprintf '(%-12s)', $_;
    ok($obj1 = C4::Barcodes->new($_),           "$pre Barcode Creation : new($_)");
    SKIP: {
        skip "No Object Returned by new($_)", 17 unless $obj1;
        ok($_ eq ($format = $obj1->autoBarcode()),  "$pre autoBarcode()    : " . ($format || 'FAILED') );
        ok($initial= $obj1->initial(),              "$pre initial()        : " . ($initial|| 'FAILED') );
        $temp = $obj1->db_max();
        diag ".    $pre db_max()         : " . ($temp   || 'Database Empty or No Matches') ;
        ok($temp   = $obj1->max(),                  "$pre max()            : " . ($temp   || 'FAILED') );
        ok($value  = $obj1->value(),                "$pre value()          : " . ($value  || 'FAILED') );
        ok($serial = $obj1->serial(),               "$pre serial()         : " . ($serial || 'FAILED') );
        ok($temp   = $obj1->is_max(),               "$pre obj1->is_max() [obj1 should currently be max]");
        diag "Creating new Barcodes object (obj2) based on the old one (obj1)\n";
        ok($obj2   = $obj1->new(),                  "$pre Barcode Creation : obj2 = obj1->new()");
        diag ".    $pre obj2->value: " . $obj2->value . "\n";
        ok(not($obj1->is_max()),                    "$pre obj1->is_max() [obj1 should no longer be max]");
        ok(    $obj2->is_max(),                     "$pre obj2->is_max() [obj2 should currently be max]");
        ok($obj2->serial == $obj1->serial + 1,      "$pre obj2->serial()   : " . ($obj2->serial || 'FAILED'));
        ok($previous = $obj2->previous(),           "$pre obj2->previous() : " . ($previous     || 'FAILED'));
        ok($next     = $obj1->next(),               "$pre obj1->next()     : " . ($next         || 'FAILED'));
        ok($next->previous()->value() eq $obj1->value(),  "$pre Roundtrip, value : " . ($obj1->value || 'FAILED'));
        ok($previous->next()->value() eq $obj2->value(),  "$pre Roundtrip, value : " . ($obj2->value || 'FAILED'));
    }
    print "\n";
}

diag "\nTesting with valid inputs:\n";
foreach $format (@formats) {
    my $pre = sprintf '(%-12s)', $format;
    foreach my $testval (@{$thash{ $format }}) {
        ok($obj1 = C4::Barcodes->new($format,$testval),    "$pre Barcode Creation : new('$format','$testval')");
        if ($format eq 'hbyymmincr') {
            diag "\nExtra tests for hbyymmincr\n";
            $obj2 = $obj1->new();
            my $branch;
            ok($branch = $obj1->branch(),   "$pre branch() : " . ($branch || 'FAILED') );
            ok($branch eq $obj2->branch(),  "$pre branch extended to derived object : " . ($obj2->branch || 'FAILED'));
        }
        print "\n";
    }
}

diag "done.\n";
- 

Return to bug 13673

Lines 5-19 use warnings; Link Here

(-)a/t/db_dependent/Barcodes.t (-43 / +42 lines)
5		5
6	use Test::More tests => 66;	6	use Test::More tests => 66;
7	BEGIN {	7	BEGIN {
8	use FindBin;	8	use FindBin;
9	use lib $FindBin::Bin;	9	use lib $FindBin::Bin;
10	use_ok('C4::Barcodes');	10	use_ok('C4::Barcodes');
11	}	11	}
12		12
13	my %thash = (	13	my %thash = (
14	incremental => [],	14	incremental => [],
15	annual => [],	15	annual => [],
16	hbyymmincr => ['MAIN'],	16	hbyymmincr => ['MAIN'],
17	EAN13 => ['0000000695152','892685001928'],	17	EAN13 => ['0000000695152','892685001928'],
18	);	18	);
19		19
Lines 21-66 print "\n"; Link Here
21	my ($obj1,$obj2,$format,$value,$initial,$serial,$re,$next,$previous,$temp);	21	my ($obj1,$obj2,$format,$value,$initial,$serial,$re,$next,$previous,$temp);
22	my @formats = sort keys %thash;	22	my @formats = sort keys %thash;
23	foreach (@formats) {	23	foreach (@formats) {
24	my $pre = sprintf '(%-12s)', $_;	24	my $pre = sprintf '(%-12s)', $_;
25	ok($obj1 = C4::Barcodes->new($_), "$pre Barcode Creation : new($_)");	25	ok($obj1 = C4::Barcodes->new($_), "$pre Barcode Creation : new($_)");
26	SKIP: {	26	SKIP: {
27	skip "No Object Returned by new($_)", 17 unless $obj1;	27	skip "No Object Returned by new($_)", 17 unless $obj1;
28	ok($_ eq ($format = $obj1->autoBarcode()), "$pre autoBarcode() : " . ($format \|\| 'FAILED') );	28	ok($_ eq ($format = $obj1->autoBarcode()), "$pre autoBarcode() : " . ($format \|\| 'FAILED') );
29	ok($initial= $obj1->initial(), "$pre initial() : " . ($initial\|\| 'FAILED') );	29	ok($initial= $obj1->initial(), "$pre initial() : " . ($initial\|\| 'FAILED') );
30	$temp = $obj1->db_max();	30	$temp = $obj1->db_max();
31	diag ". $pre db_max() : " . ($temp \|\| 'Database Empty or No Matches') ;	31	diag ". $pre db_max() : " . ($temp \|\| 'Database Empty or No Matches') ;
32	ok($temp = $obj1->max(), "$pre max() : " . ($temp \|\| 'FAILED') );	32	ok($temp = $obj1->max(), "$pre max() : " . ($temp \|\| 'FAILED') );
33	ok($value = $obj1->value(), "$pre value() : " . ($value \|\| 'FAILED') );	33	ok($value = $obj1->value(), "$pre value() : " . ($value \|\| 'FAILED') );
34	ok($serial = $obj1->serial(), "$pre serial() : " . ($serial \|\| 'FAILED') );	34	ok($serial = $obj1->serial(), "$pre serial() : " . ($serial \|\| 'FAILED') );
35	ok($temp = $obj1->is_max(), "$pre obj1->is_max() [obj1 should currently be max]");	35	ok($temp = $obj1->is_max(), "$pre obj1->is_max() [obj1 should currently be max]");
36	diag "Creating new Barcodes object (obj2) based on the old one (obj1)\n";	36	diag "Creating new Barcodes object (obj2) based on the old one (obj1)\n";
37	ok($obj2 = $obj1->new(), "$pre Barcode Creation : obj2 = obj1->new()");	37	ok($obj2 = $obj1->new(), "$pre Barcode Creation : obj2 = obj1->new()");
38	diag ". $pre obj2->value: " . $obj2->value . "\n";	38	diag ". $pre obj2->value: " . $obj2->value . "\n";
39	ok(not($obj1->is_max()), "$pre obj1->is_max() [obj1 should no longer be max]");	39	ok(not($obj1->is_max()), "$pre obj1->is_max() [obj1 should no longer be max]");
40	ok( $obj2->is_max(), "$pre obj2->is_max() [obj2 should currently be max]");	40	ok( $obj2->is_max(), "$pre obj2->is_max() [obj2 should currently be max]");
41	ok($obj2->serial == $obj1->serial + 1, "$pre obj2->serial() : " . ($obj2->serial \|\| 'FAILED'));	41	ok($obj2->serial == $obj1->serial + 1, "$pre obj2->serial() : " . ($obj2->serial \|\| 'FAILED'));
42	ok($previous = $obj2->previous(), "$pre obj2->previous() : " . ($previous \|\| 'FAILED'));	42	ok($previous = $obj2->previous(), "$pre obj2->previous() : " . ($previous \|\| 'FAILED'));
43	ok($next = $obj1->next(), "$pre obj1->next() : " . ($next \|\| 'FAILED'));	43	ok($next = $obj1->next(), "$pre obj1->next() : " . ($next \|\| 'FAILED'));
44	ok($next->previous()->value() eq $obj1->value(), "$pre Roundtrip, value : " . ($obj1->value \|\| 'FAILED'));	44	ok($next->previous()->value() eq $obj1->value(), "$pre Roundtrip, value : " . ($obj1->value \|\| 'FAILED'));
45	ok($previous->next()->value() eq $obj2->value(), "$pre Roundtrip, value : " . ($obj2->value \|\| 'FAILED'));	45	ok($previous->next()->value() eq $obj2->value(), "$pre Roundtrip, value : " . ($obj2->value \|\| 'FAILED'));
46	}	46	}
47	print "\n";	47	print "\n";
48	}	48	}
49		49
50	diag "\nTesting with valid inputs:\n";	50	diag "\nTesting with valid inputs:\n";
51	foreach $format (@formats) {	51	foreach $format (@formats) {
52	my $pre = sprintf '(%-12s)', $format;	52	my $pre = sprintf '(%-12s)', $format;
53	foreach my $testval (@{$thash{ $format }}) {	53	foreach my $testval (@{$thash{ $format }}) {
54	ok($obj1 = C4::Barcodes->new($format,$testval), "$pre Barcode Creation : new('$format','$testval')");	54	ok($obj1 = C4::Barcodes->new($format,$testval), "$pre Barcode Creation : new('$format','$testval')");
55	if ($format eq 'hbyymmincr') {	55	if ($format eq 'hbyymmincr') {
56	diag "\nExtra tests for hbyymmincr\n";	56	diag "\nExtra tests for hbyymmincr\n";
57	$obj2 = $obj1->new();	57	$obj2 = $obj1->new();
58	my $branch;	58	my $branch;
59	ok($branch = $obj1->branch(), "$pre branch() : " . ($branch \|\| 'FAILED') );	59	ok($branch = $obj1->branch(), "$pre branch() : " . ($branch \|\| 'FAILED') );
60	ok($branch eq $obj2->branch(), "$pre branch extended to derived object : " . ($obj2->branch \|\| 'FAILED'));	60	ok($branch eq $obj2->branch(), "$pre branch extended to derived object : " . ($obj2->branch \|\| 'FAILED'));
61	}	61	}
62	print "\n";	62	print "\n";
63	}	63	}
64	}	64	}
65		65
66	diag "done.\n";	66	diag "done.\n";
67	-