[Bast-commits] r4468 - in trunk/DBIx-Class-InflateColumn-Currency: . lib/DBIx/Class/InflateColumn t

[claco at dev.catalyst.perl.org]

Author: claco
Date: 2008-06-05 02:46:59 +0100 (Thu, 05 Jun 2008)
New Revision: 4468

Modified:
   trunk/DBIx-Class-InflateColumn-Currency/
   trunk/DBIx-Class-InflateColumn-Currency/Changes
   trunk/DBIx-Class-InflateColumn-Currency/lib/DBIx/Class/InflateColumn/Currency.pm
   trunk/DBIx-Class-InflateColumn-Currency/t/currency.t
Log:
 r1669 at mbp:  claco | 2008-06-04 21:46:49 -0400
 Added rounding before comparisons in decimals as some test machines sqlite actually returns real numbers instead of the original input



Property changes on: trunk/DBIx-Class-InflateColumn-Currency
___________________________________________________________________
Name: svk:merge
   - 58586828-bfeb-4a8b-ac3c-3302daf284f8:/local/DBIx-Class-InflateColumn-Currency:1540
d21250e9-0eb8-4cf9-8d68-8684fda3ee2b:/local/DBIx-Class-InflateColumn-Currency:1672
   + 58586828-bfeb-4a8b-ac3c-3302daf284f8:/local/DBIx-Class-InflateColumn-Currency:1669
d21250e9-0eb8-4cf9-8d68-8684fda3ee2b:/local/DBIx-Class-InflateColumn-Currency:1672

Modified: trunk/DBIx-Class-InflateColumn-Currency/Changes
===================================================================
--- trunk/DBIx-Class-InflateColumn-Currency/Changes	2008-06-04 17:49:15 UTC (rev 4467)
+++ trunk/DBIx-Class-InflateColumn-Currency/Changes	2008-06-05 01:46:59 UTC (rev 4468)
@@ -1,5 +1,8 @@
 Revision history for DBIx::Class::InflateColumn::Currency
 
+0.02005 Wed Jun 4 21:32:44 2008
+    - Fix decimal tests when Sqlite/64bit something returns a real
+
 0.02004 Mon Apr 22 21:22:44 2008
     - Fix test failure under SQL::Translator <= 0.07
     - Removed Build.PL now that Module::Install no longer supports it

Modified: trunk/DBIx-Class-InflateColumn-Currency/lib/DBIx/Class/InflateColumn/Currency.pm
===================================================================
--- trunk/DBIx-Class-InflateColumn-Currency/lib/DBIx/Class/InflateColumn/Currency.pm	2008-06-04 17:49:15 UTC (rev 4467)
+++ trunk/DBIx-Class-InflateColumn-Currency/lib/DBIx/Class/InflateColumn/Currency.pm	2008-06-05 01:46:59 UTC (rev 4468)
@@ -1,7 +1,7 @@
 package DBIx::Class::InflateColumn::Currency;
 use strict;
 use warnings;
-our $VERSION = '0.02003';
+our $VERSION = '0.02005';
 
 BEGIN {
     use base qw/DBIx::Class Class::Accessor::Grouped/;

Modified: trunk/DBIx-Class-InflateColumn-Currency/t/currency.t
===================================================================
--- trunk/DBIx-Class-InflateColumn-Currency/t/currency.t	2008-06-04 17:49:15 UTC (rev 4467)
+++ trunk/DBIx-Class-InflateColumn-Currency/t/currency.t	2008-06-05 01:46:59 UTC (rev 4468)
@@ -64,9 +64,9 @@
     isa_ok($item->dec_currency, 'Data::Currency');
     is($item->dec_currency->code, 'USD', 'code from currency_code attribute');
     is($item->dec_currency->name, 'US Dollar');
-    is($item->dec_currency->value, 1.23);
+    is(round($item->dec_currency->value), 1.23);
     is($item->dec_currency, '$1.23');
-    is($item->dec_currency + 1, 2.23);
+    is(round($item->dec_currency + 1), 2.23);
 
     $item = $items->next;
     isa_ok($item, 'DBIC::TestSchema::Items');
@@ -94,9 +94,9 @@
     isa_ok($item->dec_currency, 'Data::Currency');
     is($item->dec_currency->code, 'CAD', 'code from currency_code attribute');
     is($item->dec_currency->name, 'Canadian Dollar', 'This might fail due to core Locale w/msipelling');
-    is($item->dec_currency->value, 2.34);
+    is(round($item->dec_currency->value), 2.34);
     is($item->dec_currency, '$2.34');
-    is($item->dec_currency + 1, 3.34);
+    is(round($item->dec_currency + 1), 3.34);
 
     $item = $items->next;
     isa_ok($item, 'DBIC::TestSchema::Items');
@@ -124,9 +124,9 @@
     isa_ok($item->dec_currency, 'Data::Currency');
     is($item->dec_currency->code, 'NPR', 'code from currency_code attribute');
     is($item->dec_currency->name, 'Nepalese Rupee');
-    is($item->dec_currency->value, 3.45);
+    is(round($item->dec_currency->value), 3.45);
     is($item->dec_currency, 'Rs. 3.45');
-    is($item->dec_currency + 1, 4.45);
+    is(round($item->dec_currency + 1), 4.45);
 
 
     ## create with values
@@ -163,9 +163,9 @@
     isa_ok($row1->dec_currency, 'Data::Currency');
     is($row1->dec_currency->code, 'PHP', 'code from currency_code attribute');
     is($row1->dec_currency->name, 'Philippine Peso');
-    is($row1->dec_currency->value, 4.56);
+    is(round($row1->dec_currency->value), 4.56);
     is($row1->dec_currency, 'PHP4.56');
-    is($row1->dec_currency + 1, 5.56);
+    is(round($row1->dec_currency + 1), 5.56);
 
 
     ## create with objects/deflate
@@ -202,9 +202,9 @@
     isa_ok($row2->dec_currency, 'Data::Currency');
     is($row2->dec_currency->code, 'USD', 'code from object not inflate');
     is($row2->dec_currency->name, 'US Dollar');
-    is($row2->dec_currency->value, 5.67);
+    is(round($row2->dec_currency->value), 5.67);
     is($row2->dec_currency, '$5.67');
-    is($row2->dec_currency + 1, 6.67);
+    is(round($row2->dec_currency + 1), 6.67);
 };
 
 
@@ -243,9 +243,9 @@
     isa_ok($price->dec_currency, 'Data::Currency::Custom');
     is($price->dec_currency->code, 'TZS', 'code from class');
     is($price->dec_currency->name, 'Tanzanian Shilling');
-    is($price->dec_currency->value, 1.23);
+    is(round($price->dec_currency->value), 1.23);
     is($price->dec_currency, '1.23 Tanzanian Shilling');
-    is($price->dec_currency + 1, 2.23);
+    is(round($price->dec_currency + 1), 2.23);
 
     $price = $prices->next;
     isa_ok($price, 'DBIC::TestSchema::Prices');
@@ -273,9 +273,9 @@
     isa_ok($price->dec_currency, 'Data::Currency::Custom');
     is($price->dec_currency->code, 'CAD', 'code from currency_code attribute');
     is($price->dec_currency->name, 'Canadian Dollar', 'This might fail due to core Locale w/msipelling');
-    is($price->dec_currency->value, 2.34);
+    is(round($price->dec_currency->value), 2.34);
     is($price->dec_currency, '2.34 Canadian Dollar');
-    is($price->dec_currency + 1, 3.34);
+    is(round($price->dec_currency + 1), 3.34);
 
     $price = $prices->next;
     isa_ok($price, 'DBIC::TestSchema::Prices');
@@ -303,9 +303,9 @@
     isa_ok($price->dec_currency, 'Data::Currency::Custom');
     is($price->dec_currency->code, 'NPR', 'code from currency_code attribute');
     is($price->dec_currency->name, 'Nepalese Rupee');
-    is($price->dec_currency->value, 3.45);
+    is(round($price->dec_currency->value), 3.45);
     is($price->dec_currency, '3.45 Nepalese Rupee');
-    is($price->dec_currency + 1, 4.45);
+    is(round($price->dec_currency + 1), 4.45);
 
 
     ## create with values
@@ -342,9 +342,9 @@
     isa_ok($row1->dec_currency, 'Data::Currency::Custom');
     is($row1->dec_currency->code, 'PHP', 'code from currency_code attribute');
     is($row1->dec_currency->name, 'Philippine Peso');
-    is($row1->dec_currency->value, 4.56);
+    is(round($row1->dec_currency->value), 4.56);
     is($row1->dec_currency, '4.56 Philippine Peso');
-    is($row1->dec_currency + 1, 5.56);
+    is(round($row1->dec_currency + 1), 5.56);
 
 
     ## create with objects/deflate
@@ -381,7 +381,21 @@
     isa_ok($row2->dec_currency, 'Data::Currency::Custom');
     is($row2->dec_currency->code, 'USD', 'code from object not inflate');
     is($row2->dec_currency->name, 'US Dollar');
-    is($row2->dec_currency->value, 5.67);
+    is(round($row2->dec_currency->value), 5.67);
     is($row2->dec_currency, '$5.67');
-    is($row2->dec_currency + 1, 6.67);
+    is(round($row2->dec_currency + 1), 6.67);
 };
+
+sub round {
+    my ($number, $precision) = @_;
+    
+    $precision = 2 unless defined $precision;
+    $number    = 0 unless defined $number;
+
+    my $sign = $number <=> 0;
+    my $multiplier = (10 ** $precision);
+    my $result = abs($number);
+    $result = int(($result * $multiplier) + .5000001) / $multiplier;
+    $result = -$result if $sign < 0;
+    return $result;
+}