From 80fb9d5658579dda5cfa70af07d2694a5400f70d Mon Sep 17 00:00:00 2001 From: Tom Browder Date: Sun, 27 Jun 2021 18:39:26 -0500 Subject: [PATCH 1/2] Add test file for the 'modf' routine in rakudo See rakudo PR #4434. --- S32-num/modf.t | 91 ++++++++++++++++++++++++++++++++++++++++++++++++++ spectest.data | 1 + 2 files changed, 92 insertions(+) create mode 100644 S32-num/modf.t diff --git a/S32-num/modf.t b/S32-num/modf.t new file mode 100644 index 0000000000..3bfe2593c6 --- /dev/null +++ b/S32-num/modf.t @@ -0,0 +1,91 @@ +use Test; + +# L + +plan 240; + +my %n = + '-123457e-3' => [-123, -0.457, 3], + '-10' => [-10, 0, 0], + '-0x10' => [-16, 0, 0], + '-0o10' => [-8, 0, 0], + '-0xa' => [-10, 0, 0], + '-0o127' => [-87, 0, 0], + '-100' => [-100, 0, 0], + '-5.9' => [-5, -0.9, 1], + '-5.499' => [-5, -0.499, 3], + '-2' => [-2, 0, 0], + '-3/2' => [-1, -0.5, 1], + '-1.5e0' => [-1, -0.5, 1], + '-1.4999' => [-1, -0.4999, 4], + '-1.23456' => [-1, -0.23456, 5], + '-1' => [-1, 0, 0], + '-0.5' => [ 0, -0.5, 1], + '-0.499' => [ 0, -0.499, 3], + '-0.1' => [ 0, -0.1, 1], + '-0' => [ 0, 0, 0], + '-1.5e-10' => [ 0, -0.000_000_000_15, 11], # -0.000_000_000_15 +; + + +# test the routine +for %n.kv -> $val is copy, $arr { + my $int-part = @($arr)[0]; + my $frac-part = @($arr)[1]; + my $places = @($arr)[2]; + + # check the negative values + my ($int, $frac) = modf $val; + is $int, $int-part, "modf($val), int: expected $int-part, got $int"; + is-approx $frac, $frac-part, "modf($val), approx frac: expected $frac-part, got $frac"; + + # using places for exact frac match + ($int, $frac) = modf $val, $places; + is $frac, $frac-part, "modf($val, $places), exact frac: expected $frac-part, got $frac"; + + # check the positive values + $val .= abs; + $int-part .= abs; + $frac-part .= abs; + + ($int, $frac) = modf $val; + is $int, $int-part, "modf($val), int: expected $int-part, got $int"; + is-approx $frac, $frac-part, "modf($val), approx frac: expected $frac-part, got $frac"; + + # using places for exact frac match + ($int, $frac) = modf $val, $places; + is $frac, $frac-part, "modf($val, $places), exact frac: expected $frac-part, got $frac"; +} + +# test the method +for %n.kv -> $val is copy, $arr { + $val .= Real; + + my $int-part = @($arr)[0]; + my $frac-part = @($arr)[1]; + my $places = @($arr)[2]; + + # check the negative values + my ($int, $frac) = $val.modf; + is $int, $int-part, "$val.modf(), int: expected $int-part, got $int"; + is-approx $frac, $frac-part, "modf($val), approx frac: expected $frac-part, got $frac"; + + # using places for exact frac match + ($int, $frac) = $val.modf($places); + is $frac, $frac-part, "$val.modf($places), exact frac: expected $frac-part, got $frac"; + + # check the positive values + $val .= abs; + $int-part .= abs; + $frac-part .= abs; + + ($int, $frac) = $val.modf; + is $int, $int-part, "$val.modf(), int: expected $int-part, got $int"; + is-approx $frac, $frac-part, "modf($val), approx frac: expected $frac-part, got $frac"; + + # using places for exact frac match + ($int, $frac) = $val.modf($places); + is $frac, $frac-part, "$val.modf($places), exact frac: expected $frac-part, got $frac"; +} + +# vim: expandtab shiftwidth=4 diff --git a/spectest.data b/spectest.data index 1fa5ed5b7d..29652ea7ff 100644 --- a/spectest.data +++ b/spectest.data @@ -1200,6 +1200,7 @@ S32-num/fatrat.t S32-num/int.t S32-num/is-prime.t S32-num/log.t +S32-num/modf.t S32-num/narrow.t S32-num/negative-zero.t S32-num/pi.t From 47a7dd8cfcf64fe306a8bcf5a6338002e7f7c0b9 Mon Sep 17 00:00:00 2001 From: Tom Browder Date: Sun, 4 Jul 2021 14:20:33 -0500 Subject: [PATCH 2/2] commit all changes prior to closing branch 'modf', roast PR #742 --- S32-num/modf.t | 268 ++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 241 insertions(+), 27 deletions(-) diff --git a/S32-num/modf.t b/S32-num/modf.t index 3bfe2593c6..8fbe59ba80 100644 --- a/S32-num/modf.t +++ b/S32-num/modf.t @@ -1,34 +1,82 @@ use Test; - # L -plan 240; - -my %n = - '-123457e-3' => [-123, -0.457, 3], - '-10' => [-10, 0, 0], - '-0x10' => [-16, 0, 0], - '-0o10' => [-8, 0, 0], - '-0xa' => [-10, 0, 0], - '-0o127' => [-87, 0, 0], - '-100' => [-100, 0, 0], - '-5.9' => [-5, -0.9, 1], - '-5.499' => [-5, -0.499, 3], - '-2' => [-2, 0, 0], - '-3/2' => [-1, -0.5, 1], - '-1.5e0' => [-1, -0.5, 1], - '-1.4999' => [-1, -0.4999, 4], - '-1.23456' => [-1, -0.23456, 5], - '-1' => [-1, 0, 0], - '-0.5' => [ 0, -0.5, 1], - '-0.499' => [ 0, -0.499, 3], - '-0.1' => [ 0, -0.1, 1], - '-0' => [ 0, 0, 0], - '-1.5e-10' => [ 0, -0.000_000_000_15, 11], # -0.000_000_000_15 -; +#plan 244; +#plan 4; +#plan 20; + +my $debug = 0; + +# test values and data defined in the BEGIN block below +my @n; +my $i; + +sub test-routine($val, $exp-int, $exp-frac, , $places, :$test-sign!) { +} +sub test-method($val, $exp-int, $exp-frac, , $places, :$test-sign!) { +} + +# test the internal subs with positive data +$i = 0; +for @n -> ($val is copy, $exp-int is copy, $exp-frac is copy, $places) { + ++$i; + + # raw data are originally Cool strings with leading minus signs + my $test-sign = +1; + test-helpers($val, $exp-int, $exp-frac, , $places, :$test-sign!) { +} + +# test the internal subs with negative data +$i = 0; +for @n -> ($val is copy, $exp-int is copy, $exp-frac is copy, $places) { + ++$i; + my $test-sign = -1; + test-helpers($val, $exp-int, $exp-frac, , $places, :$test-sign!) { +} + + + +=begin comment + +next; + + note "DEBUG: item $i val = '$val', int = '$Int'. frac = '$Frac', places = '$places'" if $debug; + my $s = _num2str $val; + cmp-ok $s, '~~', Str; + note "DEBUG: item $i val = '$val', _num2str = '$s', str2num '{$s.Num}'" if $debug; + +# next; + + my $I = $Int.Str; + my $F = $Frac.Str; + my $P = $places.Str; + + cmp-ok $val, '~~', Str; + cmp-ok $I, '~~', Str; + cmp-ok $F, '~~', Str; + cmp-ok $P, '~~', Str; + + $val = $val.Real; + if $val ~~ Rational { + $val = $val.base(10, *); + } + else { + $val = $val.base(10, $places); + } + + my ($left, $right) = _modf-str $val; + note "DEBUG: val = '$val', base(10) = '$left'" if $debug; + is $left, $I; + is $right, $F; + +} +=end comment +done-testing; +=begin comment # test the routine +#for @n -> ($val is copy, $Int is copy, $Frac is copy, $places) { for %n.kv -> $val is copy, $arr { my $int-part = @($arr)[0]; my $frac-part = @($arr)[1]; @@ -45,7 +93,7 @@ for %n.kv -> $val is copy, $arr { # check the positive values $val .= abs; - $int-part .= abs; + $int-part .= abs; $frac-part .= abs; ($int, $frac) = modf $val; @@ -58,6 +106,7 @@ for %n.kv -> $val is copy, $arr { } # test the method +#for @n -> ($val is copy, $Int is copy, $Frac is copy, $places) { for %n.kv -> $val is copy, $arr { $val .= Real; @@ -76,7 +125,7 @@ for %n.kv -> $val is copy, $arr { # check the positive values $val .= abs; - $int-part .= abs; + $int-part .= abs; $frac-part .= abs; ($int, $frac) = $val.modf; @@ -87,5 +136,170 @@ for %n.kv -> $val is copy, $arr { ($int, $frac) = $val.modf($places); is $frac, $frac-part, "$val.modf($places), exact frac: expected $frac-part, got $frac"; } +=end comment + +sub test-helpers($val, $exp-int, $exp-frac, , $places, :$test-sign!) { + +} + +sub test-routine($val, $exp-int, $exp-frac, , $places, :$test-sign!) { +} +sub test-method($val, $exp-int, $exp-frac, , $places, :$test-sign!) { +} + +sub _num2str(Cool $n is copy --> Str) { + #=========================================================== + # THIS SUB IS DUPLICATED IN CORE AND ROAST AND MUST REMAIN + # IDENTICAL IN BOTH PLACES. THE TWO FILES CONTAINING IT ARE: + # repo https://github.com/rakudo/rakudo/src/core.*/Num.pm6 + # repo https://github.com/Raku/roast/S32-Num/modf.t + #=========================================================== + + # the incoming value a string representing a number + my $s = $n.Str; + given $s { + when /^ <[+-]>? \d* '.' \d* $/ { + # base 10 rational as string + # use as is + } + when /^ :i <[+-]>? 0 <[box]> <[abcde\d]>* '.' <[abcde\d]>* $/ { + # base 2, 8, or 16 rational as string + # use base 10,* + $s = $s.Num.base(10, *) + } + when /:i e/ { + # 1.3e-1 + # use base, but how many places? + $s = $s.Num.base(10, 15) + } + when /:i '/' / { + # 1/3 + # rational as string + # use base 10,* + $s = $s.Num.base(10, *) + } + when $s.Numeric ~~ Int { + $s = $s.Num.base(10) + } + default { + note "|-- DEBUG: incoming, unhandled value '$n' is type '{$n.^name}'"; + } + } + $s +} + +sub _modf-str(Str $s is copy, $places? --> List) { + #=========================================================== + # THIS SUB IS DUPLICATED IN CORE AND ROAST AND MUST REMAIN + # IDENTICAL IN BOTH PLACES. THE TWO FILES CONTAINING IT ARE: + # repo https://github.com/rakudo/rakudo/src/core.*/Num.pm6 + # repo https://github.com/Raku/roast/S32-Num/modf.t + #=========================================================== + + # the incoming string was a number converted to + # an integer OR a decimal number + + # check for the sign, if any + my $sign = ''; + if $s ~~ /^ (<[+-]>) (.*) $/ { + $sign = ~$0; + $s = ~$1; + } + + my ($left, $right); + my $idx = index $s, '.'; + if $idx.defined { + $left = $s.substr: 0, $idx; + $right = $s.substr: $idx+1; # do NOT keep the decimal point here + + # get the length of the bare right side + my $nr-chars = $right.chars; + # now embellish it + $right = '0.' ~ $right; + + if $sign { + $left = $sign ~ $left; + $right = $sign ~ $right; + } + # pad right with zeroes if need be + # note we do NOT trim any chars if right is too long + if $places.defined and $places > $nr-chars { + my $n = $places - $nr-chars; + $right ~= ('0' x $n); + } + $right = _trim-zeroes $right; + + $left = '0' if $left.Num == 0; + $right = '0' if $right.Num == 0; + } + else { + $left = $s; + note "DEBUG dotless left: '$left'" if $debug; + $left = $sign ?? ($sign ~ $left) !! $left; + $left = '0' if $left.Num == 0; + $right = '0'; + } + $left, $right +} # sub _modf-str + +sub _trim-zeroes(Str $x is copy --> Str) { + #=========================================================== + # THIS SUB IS DUPLICATED IN CORE AND ROAST AND MUST REMAIN + # IDENTICAL IN BOTH PLACES. THE TWO FILES CONTAINING IT ARE: + # repo https://github.com/rakudo/rakudo/src/core.*/Num.pm6 + # repo https://github.com/Raku/roast/S32-Num/modf.t + #=========================================================== + + # the incoming string may have a decimal point. if + # so, leave it + while $x ~~ /<[.1..9]>0$/ { + note "DEBUG before trim '$x'"; + $x ~~ s/0$//; + note "DEBUG after trim '$x'"; + } + $x +} # sub _trim-zeroes + +BEGIN { + + @n = + # 27 elements + + #=== two cases reported by reviewers: + # possible problem child: + ['-6.2' , -6, -0.2000000000_0000000000_0000000000_0000000000_0000000000_0000000000_0000000000_0000000000_0000000000_0000000000, 100], + # okay tests + ['-123456789123456789.6', -123456789123456789, -0.6, 1], + + #=== other possible problem children: + ['-1.5e-10' , 0, -0.000_000_000_15, 11], + ['-123457e-3' , -123, -0.457, 3], + + # okay tests + ['-0x10.1' , -16, -0.0625, 4], + ['-0o10.1' , -8, -0.125, 3], + ['-0xa.1' , -10, -0.0625, 4], + ['-0b10.1' , -2, -0.5, 1], + ['-0b10' , -2, 0, 0], + ['-10' , -10, 0, 0], + ['-0x10' , -16, 0, 0], + ['-0o10' , -8, 0, 0], + ['-0xa' , -10, 0, 0], + ['-0o127' , -87, 0, 0], + ['-100' , -100, 0, 0], + ['-5.9' , -5, -0.9, 1], + ['-5.499' , -5, -0.499, 3], + ['-2' , -2, 0, 0], + ['-3/2' , -1, -0.5, 1], + ['-1.5e0' , -1, -0.5, 1], + ['-1.4999' , -1, -0.4999, 4], + ['-1.23456' , -1, -0.23456, 5], + ['-1' , -1, 0, 0], + ['-0.5' , 0, -0.5, 1], + ['-0.499' , 0, -0.499, 3], + ['-0.1' , 0, -0.1, 1], + ['-0' , 0, 0, 0], + ; +} # vim: expandtab shiftwidth=4