Skip to content

Commit

Permalink
fix error with non-standard decimal characters.
Browse files Browse the repository at this point in the history 
update
  • Loading branch information
@pstaabp
pstaabp committed Apr 1, 2023
1 parent 9384da8 commit f1f1ba3
Show file tree
Hide file tree
Showing 2 changed files with 39 additions and 36 deletions.
51 changes: 25 additions & 26 deletions macros/contexts/contextNondecimalBase.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -78,19 +78,20 @@ sub _contextNondecimalBase_init {
package context::NondecimalBase;
our @ISA = ('Parser::Context');

# Note it seems like these need to be recreated each time the base is changed,
# so these are done each time in convertBase
#
# The standard digits, pre-built so it doesn't have to be done each time the conversion is called
#
our $digits16 = [ '0' .. '9', 'A' .. 'F' ];
our $digit16 = { map { ($digits16->[$_], $_) } (0 .. scalar(@$digits16) - 1) };
# The standard digits, pre-built so it doesn't have to be done each time the conversion is called
# our $digits16 = [ '0' .. '9', 'A' .. 'F' ];
# our $digit16 = { map { ($digits16->[$_], $_) } (0 .. scalar(@$digits16) - 1) };

# Initialize the contexts and make the creator function.
sub Init {
my $context = $main::context{NondecimalBase} = Parser::Context->getCopy("Numeric");
$context->{name} = 'NondecimalBase';
$context->{parser}{Number} = 'context::NondecimalBase::Number';
$context->{value}{Real} = 'context::NondecimalBase::Real';
$context->{pattern}{number} = '[0-9A-F]+';
$context->{pattern}{number} = '[0-9A-Z]+';
$context->functions->disable('All');

# don't allow division
Expand Down Expand Up @@ -155,31 +156,29 @@ =head3 Examples
sub convert {
my $value = shift;
my %options = (
from => 10,
to => 10,
digits => $digits16,
from => 10,
to => 10,
@_
);
my $from = $options{'from'};
my $to = $options{'to'};
my $digits = $options{'digits'};

# warn $value;
# warn $from;
# warn $to;
# warn $digits;
my $from = $options{'from'};
my $to = $options{'to'};

die "The digits option must be an array of characters to use for the digits"
unless ref($digits) eq 'ARRAY';
if $options{digits} && ref($options{digits}) ne 'ARRAY';

# Unfortunately this needs to be called each time in case the digits were
# set in a previous call.
my $digits16 = $options{'digits'} // [ 0 .. 9, 'A' .. 'F' ];
my $digit16 = { map { ($digits16->[$_], $_) } (0 .. scalar(@$digits16) - 1) };

# The highest base the digits will support
my $maxBase = scalar(@$digits);
my $maxBase = scalar(@$digits16);

die "The base of conversion must be between 2 and $maxBase"
unless $to >= 2 && $to <= $maxBase && $from >= 2 && $from <= $maxBase;

# Reverse map the digits to base 10 values
my $baseBdigits = { map { ($digits->[$_], $_) } (0 .. $from - 1) };
my $baseBdigits = { map { ($digits16->[$_], $_) } (0 .. $from - 1) };

# Convert to base 10
my $base10;
Expand All @@ -190,7 +189,7 @@ sub convert {
} else {
$base10 = 0;
foreach my $d (split(//, $value)) {
die "The number must consist only of digits: " . join(',', @$digits[ 0 .. $from - 1 ])
die "The number must consist only of digits: " . join(',', @$digits16[ 0 .. $from - 1 ])
unless defined($baseBdigits->{$d});
$base10 = $base10 * $from + $baseBdigits->{$d};
}
Expand All @@ -202,7 +201,7 @@ sub convert {
do {
my $d = $base10 % $to;
$base10 = ($base10 - $d) / $to;
unshift(@base, $digits->[$d]);
unshift(@base, $digits16->[$d]);
} while $base10;

return join('', @base);
Expand All @@ -214,19 +213,19 @@ package context::NondecimalBase::Number;
our @ISA = ('Parser::Number');

# Create a new number in the given base and convert to base 10.

sub new {
my ($self, $equation, $value, $ref) = @_;
Value::Error('The base must be set for this context') unless $equation->{context}{flags}{base};
my %opts = (from => $equation->{context}{flags}{base});
$opts{digits} = $equation->{context}{flags}{digits} if $equation->{context}{flags}{digits};
my $context = $equation->{context};

Value::Error('The base must be set for this context') unless $context->{flags}{base};
my %opts = (from => $context->{flags}{base});
$opts{digits} = $context->{flags}{digits} if $context->{flags}{digits};

$value = context::NondecimalBase::convert($value, %opts);
return $self->SUPER::new($equation, $value, $ref);
}

# Return the value of the number in its given base.

sub eval {
$self = shift;
my $base = $self->{equation}{context}{flags}{base};
Expand Down
24 changes: 14 additions & 10 deletions t/contexts/nondecimal_base.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,8 +23,6 @@ use Data::Dumper;

Context('NondecimalBase');

# test that convert is working

subtest 'conversion from a non-decimal base to base 10' => sub {
is convertBase('101010', from => 2), 42, 'convert from base 2';
is convertBase('44011', from => 5), 3006, 'convert from base 5';
Expand Down Expand Up @@ -59,9 +57,7 @@ subtest 'Convert between two non-decimal bases' => sub {
};

# Now test the Context.

Context()->flags->set(base => 5);
# # context::NondecimalBase->setBase(5);

subtest 'Check that the Context parses number correct' => sub {
is Context()->{flags}->{base}, 5, 'Check that the base is stored.';
Expand All @@ -73,7 +69,8 @@ subtest 'Check that the Context parses number correct' => sub {
};

subtest 'check that non-valid digits return errors' => sub {
like dies { Compute('456'); }, qr/^The number must consist/, 'Try to build a base-5 number will illegal digits';
like dies { Compute('456'); }, qr/^The number must consist only of digits: 0,1,2,3,4/,
'Try to build a base-5 number will illegal digits';
};

subtest 'check arithmetic in base-5' => sub {
Expand Down Expand Up @@ -127,6 +124,7 @@ subtest 'check different digits' => sub {
ok my $a1 = Compute('E9'), "Base 12 number 'E9' with E=eleven";
is $a1->value, 141, "Base-12 number E9=141";

ok my $a2 = Compute("3TE"), "Base 12 number '3TE' with T=ten and E = eleven";
like dies { Compute('A5'); },
qr/The number must consist only of digits: 0,1,2,3,4,5,6,7,8,9,T,E/,
'Check that A=10 is not allowed';
Expand All @@ -150,12 +148,18 @@ subtest 'Check the LimitedNondecimalBase features' => sub {

};

print Dumper convertBase(58, to => 8);
subtest 'Test with different set of digits' => sub {
Context('NondecimalBase');
Context()->flags->set(base => 12, digits => [ 0 .. 9, 'B', 'D' ]);
# setBase(Context(),

ok my $a1 = Compute("3BD"), "Create '3BD' in base-12 with B=10, D=11";
is $a1->value, 563, "'3BD'=563 in base-12 with B=10, D=11";

print Dumper convertBase(213, from => 5); # returns 58
print Dumper convertBase(72, from => 8); # returns 58
print Dumper convertBase('2DE', from => 16); # returns 734
Context()->flags->set(base => 12, digits => [ 0 .. 9, 'T', 'E' ]);
ok my $a2 = Compute('E9T'), "Create 'E9T' in base-12 with T=10, E=11";
is $a2->value, 1702, "'E9T'= 1702 in base-12 with T=10, E=11";

print Dumper convertBase(565, to => 12, digits => [ 0 .. 9, 'T', 'E' ]);
};

done_testing();

0 comments on commit f1f1ba3

Please sign in to comment.