Revision ed5ef25b
Von Sven Schöling vor etwa 13 Jahren hinzugefügt
| t/wh/transfer.t | ||
|---|---|---|
| 35 | 35 |
return $result; |
| 36 | 36 |
}; |
| 37 | 37 |
|
| 38 |
my $r1 = $report->(); |
|
| 38 |
sub test (&@) {
|
|
| 39 |
my ($arg_sub, @transfers) = @_; |
|
| 40 |
my $before = $report->(); |
|
| 39 | 41 |
|
| 40 |
WH->transfer({
|
|
| 42 |
WH->transfer(@transfers); |
|
| 43 |
|
|
| 44 |
my $after = $report->(); |
|
| 45 |
my @args = $arg_sub->($before, $after); |
|
| 46 |
|
|
| 47 |
is $args[0], $args[1], $args[2]; |
|
| 48 |
} |
|
| 49 |
|
|
| 50 |
test { shift->{qty}, shift->{qty} + 4, 'transfer one way' } {
|
|
| 41 | 51 |
transfer_type => 'transfer', |
| 42 | 52 |
parts_id => $part->id, |
| 43 | 53 |
src_warehouse_id => $wh->id, |
| ... | ... | |
| 46 | 56 |
dst_bin_id => $bin2->id, |
| 47 | 57 |
qty => 4, |
| 48 | 58 |
chargenumber => '', |
| 49 |
}); |
|
| 50 |
|
|
| 51 |
my $r2 = $report->(); |
|
| 52 |
|
|
| 53 |
is $r1->{qty}, $r2->{qty} + 4, 'transfer one way';
|
|
| 59 |
}; |
|
| 54 | 60 |
|
| 55 | 61 |
################################################# |
| 56 | 62 |
|
| 57 |
WH->transfer({
|
|
| 63 |
test { shift->{qty}, shift->{qty} - 4, 'and back' } {
|
|
| 58 | 64 |
transfer_type => 'transfer', |
| 59 | 65 |
parts_id => $part->id, |
| 60 | 66 |
src_warehouse_id => $wh->id, |
| ... | ... | |
| 63 | 69 |
dst_bin_id => $bin1->id, |
| 64 | 70 |
qty => 4, |
| 65 | 71 |
chargenumber => '', |
| 66 |
}); |
|
| 67 |
|
|
| 68 |
|
|
| 69 |
my $r3 = $report->(); |
|
| 70 |
|
|
| 71 |
is $r2->{qty}, $r3->{qty} - 4, 'and back';
|
|
| 72 |
}; |
|
| 72 | 73 |
|
| 73 | 74 |
############################################## |
| 74 | 75 |
|
| ... | ... | |
| 76 | 77 |
|
| 77 | 78 |
# object interface test |
| 78 | 79 |
|
| 79 |
WH->transfer({
|
|
| 80 |
test { shift->{qty}, shift->{qty} + 6.2, 'object transfer one way' } {
|
|
| 80 | 81 |
transfer_type => SL::DB::Manager::TransferType->find_by(description => 'transfer'), |
| 81 | 82 |
parts => $part, |
| 82 | 83 |
src_bin => $bin1, |
| 83 | 84 |
dst_bin => $bin2, |
| 84 | 85 |
qty => 6.2, |
| 85 | 86 |
chargenumber => '', |
| 86 |
}); |
|
| 87 |
|
|
| 88 |
my $r4 = $report->(); |
|
| 89 |
|
|
| 90 |
is $r3->{qty}, $r4->{qty} + 6.2, 'object transfer one way';
|
|
| 87 |
}; |
|
| 91 | 88 |
|
| 92 | 89 |
############################################# |
| 93 | 90 |
|
| 94 |
WH->transfer({
|
|
| 91 |
test { shift->{qty}, shift->{qty} - 6.2, 'full object transfer back' } {
|
|
| 95 | 92 |
transfer_type => SL::DB::Manager::TransferType->find_by(description => 'transfer'), |
| 96 | 93 |
parts => $part, |
| 97 | 94 |
src_bin => $bin2, |
| ... | ... | |
| 100 | 97 |
dst_warehouse => $wh, |
| 101 | 98 |
qty => 6.2, |
| 102 | 99 |
chargenumber => '', |
| 103 |
}); |
|
| 104 |
|
|
| 105 |
my $r5 = $report->(); |
|
| 106 |
|
|
| 107 |
is $r4->{qty}, $r5->{qty} - 6.2, 'full object transfer back';
|
|
| 100 |
}; |
|
| 108 | 101 |
|
| 109 | 102 |
############################################# |
| 110 | 103 |
|
| 111 |
WH->transfer({
|
|
| 104 |
test { shift->{qty}, shift->{qty}, 'back and forth in one transaction' } {
|
|
| 112 | 105 |
transfer_type => SL::DB::Manager::TransferType->find_by(description => 'transfer'), |
| 113 | 106 |
parts => $part, |
| 114 | 107 |
src_bin => $bin2, |
| ... | ... | |
| 125 | 118 |
dst_bin => $bin2, |
| 126 | 119 |
dst_warehouse => $wh, |
| 127 | 120 |
qty => 1, |
| 128 |
}); |
|
| 129 |
|
|
| 130 |
my $r6 = $report->(); |
|
| 121 |
}; |
|
| 131 | 122 |
|
| 132 |
is $r5->{qty}, $r6->{qty}, 'back and forth in one transaction';
|
|
| 133 | 123 |
|
| 134 | 124 |
done_testing; |
| 135 | 125 |
|
| 136 |
|
|
| 137 |
|
|
| 138 |
|
|
| 139 |
|
|
| 140 | 126 |
1; |
Auch abrufbar als: Unified diff
transfer tests positionsunabhängig gemacht