From f1f1ba3f6bf895c99d4f1695d722fb031fc3e53d Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Sat, 1 Apr 2023 17:48:25 -0400 Subject: [PATCH] fix error with non-standard decimal characters. update --- macros/contexts/contextNondecimalBase.pl | 51 ++++++++++++------------ t/contexts/nondecimal_base.t | 24 ++++++----- 2 files changed, 39 insertions(+), 36 deletions(-) diff --git a/macros/contexts/contextNondecimalBase.pl b/macros/contexts/contextNondecimalBase.pl index 57a28e99da..65de493dc8 100644 --- a/macros/contexts/contextNondecimalBase.pl +++ b/macros/contexts/contextNondecimalBase.pl @@ -78,11 +78,12 @@ 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 { @@ -90,7 +91,7 @@ sub Init { $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 @@ -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; @@ -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}; } @@ -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); @@ -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}; diff --git a/t/contexts/nondecimal_base.t b/t/contexts/nondecimal_base.t index 34e45502e5..ebf64353fd 100644 --- a/t/contexts/nondecimal_base.t +++ b/t/contexts/nondecimal_base.t @@ -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'; @@ -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.'; @@ -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 { @@ -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'; @@ -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();