Skip to content

Commit

Permalink
First draft of a version based on Moose.
Browse files Browse the repository at this point in the history
  • Loading branch information
@davorg
davorg committed May 3, 2013
1 parent 9a3440c commit cbe0d22
Show file tree
Hide file tree
Showing 5 changed files with 93 additions and 74 deletions.
1 change: 1 addition & 0 deletions Build.PL
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ my $build = Module::Build->new(
perl => '5.6.0',
Carp => 0,
overload => 0,
Moose => 0,
},
build_requires => {
'Test::More' => 0,
Expand Down
69 changes: 43 additions & 26 deletions lib/Number/Fraction.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -115,6 +115,7 @@ use strict;
use warnings;

use Carp;
use Moose;

our $VERSION = '1.14';

Expand All @@ -129,8 +130,13 @@ use overload
'abs' => 'abs',
fallback => 1;

my %_const_handlers =
(q => sub { return __PACKAGE__->new($_[0]) || $_[1] });
my %_const_handlers = (
q => sub {
my $f = eval { __PACKAGE__->new($_[0]) };
return $_[1] if $@;
return $f;
}
);

=head2 import
Expand All @@ -154,9 +160,19 @@ sub unimport {
overload::remove_constant(q => undef);
}

=head2 new
has num => (
is => 'rw',
isa => 'Int',
);

has den => (
is => 'rw',
isa => 'Int',
);

Constructor for Number::Fraction object. Takes the following kinds of
=head2 BUILDARGS
Parameter massager for Number::Fraction object. Takes the following kinds of
parameters:
=over 4
Expand Down Expand Up @@ -191,40 +207,41 @@ Returns C<undef> if a Number::Fraction object can't be created.
=cut

sub new {
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;

my $self;
if (@_ >= 2) {
return unless $_[0] =~ /^-?[0-9]+\z/ and $_[1] =~ /^-?[0-9]+\z/;
die unless $_[0] =~ /^-?[0-9]+\z/ and $_[1] =~ /^-?[0-9]+\z/;

$self->{num} = $_[0];
$self->{den} = $_[1];
return $class->$orig({ num => $_[0], den => $_[1] });
} elsif (@_ == 1) {
if (ref $_[0]) {
if (UNIVERSAL::isa($_[0], $class)) {
return $class->new($_[0]->{num},
$_[0]->{den});
return $class->$orig({ num => $_[0]->{num}, den => $_[0]->{den} });
} else {
croak "Can't make a $class from a ",
ref $_[0];
}
die "Can't make a $class from a ", ref $_[0];
}
} else {
return unless $_[0] =~ m|^(-?[0-9]+)(?:/(-?[0-9]+))?\z|;
die unless $_[0] =~ m|^(-?[0-9]+)(?:/(-?[0-9]+))?\z|;

$self->{num} = $1;
$self->{den} = defined $2 ? $2 : 1;
return $class->$orig({ num => $1, den => ( defined $2 ? $2 : 1) });
}
} else {
$self->{num} = 0;
$self->{den} = 1;
return $class->$orig({ num => 0, den => 1 });
}
};

bless $self, $class;
=head2 BUILD
$self->_normalise;
Object initialiser for Number::Fraction. Ensures that fractions are in a
normalised format.
return $self;
=cut

sub BUILD {
my $self = shift;
$self->_normalise;
}

sub _normalise {
Expand Down Expand Up @@ -290,7 +307,7 @@ sub add {
if (ref $r) {
if (UNIVERSAL::isa($r, ref $l)) {
return (ref $l)->new($l->{num} * $r->{den} + $r->{num} * $l->{den},
$r->{den} * $l->{den});
$r->{den} * $l->{den});
} else {
croak "Can't add a ", ref $l, " to a ", ref $l;
}
Expand Down Expand Up @@ -319,7 +336,7 @@ sub mult {
if (ref $r) {
if (UNIVERSAL::isa($r, ref $l)) {
return (ref $l)->new($l->{num} * $r->{num},
$l->{den} * $r->{den});
$l->{den} * $r->{den});
} else {
croak "Can't multiply a ", ref $l, " by a ", ref $l;
}
Expand Down Expand Up @@ -348,7 +365,7 @@ sub subtract {
if (ref $r) {
if (UNIVERSAL::isa($r, ref $l)) {
return (ref $l)->new($l->{num} * $r->{den} - $r->{num} * $l->{den},
$r->{den} * $l->{den});
$r->{den} * $l->{den});
} else {
croak "Can't subtract a ", ref $l, " from a ", ref $l;
}
Expand Down Expand Up @@ -378,7 +395,7 @@ sub div {
if (ref $r) {
if (UNIVERSAL::isa($r, ref $l)) {
return (ref $l)->new($l->{num} * $r->{den},
$l->{den} * $r->{num});
$l->{den} * $r->{num});
} else {
croak "Can't divide a ", ref $l, " by a ", ref $l;
}
Expand Down
70 changes: 35 additions & 35 deletions t/02_create.t
View file
Original file line number Diff line number Diff line change
@@ -1,61 +1,61 @@
use Test::More tests => 33;
use Number::Fraction;

my $f = Number::Fraction->new('a', 'b');
ok(!ref $f);
my $f = eval {Number::Fraction->new('a', 'b') };
ok($@, 'Two non-digits');

$f = Number::Fraction->new(1, 'c');
ok(!ref $f);
$f = eval { Number::Fraction->new(1, 'c') };
ok($@, 'One non-digit');

$f = eval { Number::Fraction->new([]) };
ok($@);
ok($@, 'Array ref');

$f = Number::Fraction->new('1/2');
ok(ref $f eq 'Number::Fraction');
ok($f eq '1/2');
ok($f == 0.5);
cmp_ok(ref $f, 'eq', 'Number::Fraction', 'String: 1/2');
cmp_ok($f, 'eq', '1/2', '... as a string');
cmp_ok($f, '==', 0.5, '... as a number');

$f = Number::Fraction->new(1, 2);
ok(ref $f eq 'Number::Fraction');
ok($f eq '1/2');
ok($f == 0.5);
cmp_ok(ref $f, 'eq', 'Number::Fraction', 'Two digits');
cmp_ok($f, 'eq', '1/2', '... as a string');
cmp_ok($f, '==', 0.5, '... as a number');

my $f1 = Number::Fraction->new($f);
ok(ref $f1 eq 'Number::Fraction');
ok($f1 eq '1/2');
ok($f1 == 0.5);
cmp_ok(ref $f1, 'eq', 'Number::Fraction', 'Number::Fraction');
cmp_ok($f1, 'eq', '1/2', '... as a string');
cmp_ok($f1, '==', 0.5, '... as a number');

$f1 = Number::Fraction->new;
ok(ref $f1 eq 'Number::Fraction');
ok($f1 eq '0');
ok($f1 == 0);
cmp_ok(ref $f1, 'eq', 'Number::Fraction', 'Empty constructor');
cmp_ok($f1, 'eq', '0', '... as a string');
cmp_ok($f1, '==', 0, '... as a number');

my $f2 = Number::Fraction->new(4, 8);
ok(ref $f2 eq 'Number::Fraction');
ok($f2 eq '1/2');
ok($f2 == 0.5);
cmp_ok(ref $f2, 'eq', 'Number::Fraction', 'Two more digits');
cmp_ok($f2, 'eq', '1/2', '... as a string');
cmp_ok($f2, '==', 0.5, '... as a number');

$f2 = Number::Fraction->new('4/8');
ok(ref $f2 eq 'Number::Fraction');
ok($f2 eq '1/2');
ok($f2 == 0.5);
cmp_ok(ref $f2, 'eq', 'Number::Fraction', 'String: 4/8');
cmp_ok($f2, 'eq', '1/2', '... as a string');
cmp_ok($f2, '==', 0.5, '... as a number');

my $f3 = Number::Fraction->new(2, 1);
ok(ref $f3 eq 'Number::Fraction');
ok($f3 eq '2');
ok($f3 == 2);
cmp_ok(ref $f3, 'eq', 'Number::Fraction', 'Another two digits');
cmp_ok($f3, 'eq', '2', '... as a string');
cmp_ok($f3, '==', 2, '... as a number');

$f3 = Number::Fraction->new('2/1');
ok(ref $f3 eq 'Number::Fraction');
ok($f3 eq '2');
ok($f3 == 2);
cmp_ok(ref $f3, 'eq', 'Number::Fraction', 'String: 2/1');
cmp_ok($f3, 'eq', '2', '... as a string');
cmp_ok($f3, '==', 2, '... as a number');

$f3 = Number::Fraction->new(2);
ok(ref $f3 eq 'Number::Fraction');
ok($f3 eq '2');
ok($f3 == 2);
cmp_ok(ref $f3, 'eq', 'Number::Fraction', 'Another Number::Fraction');
cmp_ok($f3, 'eq', '2', '... as a string');
cmp_ok($f3, '==', 2, '... as a number');

$f3 = Number::Fraction->new('2');
ok(ref $f3 eq 'Number::Fraction');
ok($f3 eq '2');
ok($f3 == 2);
cmp_ok(ref $f3, 'eq', 'Number::Fraction', 'One more digit');
cmp_ok($f3, 'eq', '2', '... as a string');
cmp_ok($f3, '==', 2, '... as a number');
11 changes: 6 additions & 5 deletions t/03_create.t
View file
Original file line number Diff line number Diff line change
@@ -1,15 +1,16 @@
use Test::More tests => 4;
use Test::More tests => 5;
use Number::Fraction ':constants';

my $f = '1/2';
ok(ref $f eq 'Number::Fraction');
ok($f eq '1/2');
cmp_ok(ref $f, 'eq', 'Number::Fraction', 'Create from string');
cmp_ok($f, 'eq', '1/2', 'Created correct string');
cmp_ok($f, '==', 0.5, 'Created correct number');

no Number::Fraction;
$f = '1/2';
ok(!ref $f);
ok(!ref $f, 'Fail to create from string');

use Number::Fraction ':something';
$f = '1/2';
ok(!ref $f);
ok(!ref $f, 'Still fail to create from string');

16 changes: 8 additions & 8 deletions t/12_invalid.t
View file
Original file line number Diff line number Diff line change
@@ -1,14 +1,14 @@
use Test::More 'no_plan';
use Number::Fraction;

my $f = Number::Fraction->new("\x{555}");
ok(!$f);
my $f = eval { Number::Fraction->new("\x{555}") };
ok($@);

$f = Number::Fraction->new("\x{666}");
ok(!$f);
$f = eval { Number::Fraction->new("\x{666}") };
ok($@);

$f = Number::Fraction->new("6\n");
ok(!$f);
$f = eval { Number::Fraction->new("6\n") };
ok($@);

$f = Number::Fraction->new("6\n\n");
ok(!$f);
$f = eval {Number::Fraction->new("6\n\n") };
ok($@);

0 comments on commit cbe0d22

Please sign in to comment.