Perlito5 - javascript: fix complement operation

fglock · May 15, 2012 · 7b23bb8 · 7b23bb8
1 parent c29e335
commit 7b23bb8
Show file tree

Hide file tree

Showing 5 changed files with 48 additions and 38 deletions.
diff --git a/html/perlito5.js b/html/perlito5.js
@@ -410,6 +410,11 @@ p5cmp = function(a, b) {
     return a > b ? 1 : a < b ? -1 : 0 
 };
 
+p5complement = function(a) {
+    return a < 0 ? ~a : 4294967295 - a
+    // return a < 0 ? ~a : 18446744073709551615 - a
+};
+
 p5str_replicate = function(o, n) {
     n = p5num(n);
     return n ? Array(n + 1).join(o) : "";
@@ -2870,7 +2875,7 @@ var p5100 = p5pkg['main'];
 					}, 'prefix:<~>', function (List__, p5want) {
 							var v_self = null;
 							(v_self = (List__[p5idx(List__,0)]));
-							return (p5context([('~( ' + p5str(p5pkg["Perlito5::Javascript"].to_num(p5list_to_a(((v_self || (v_self = new p5HashRef({})))._hash_['arguments'] || ((v_self || (v_self = new p5HashRef({})))._hash_['arguments'] = new p5ArrayRef([])))._array_[p5idx(((v_self || (v_self = new p5HashRef({})))._hash_['arguments'] || ((v_self || (v_self = new p5HashRef({})))._hash_['arguments'] = new p5ArrayRef([])))._array_,0)]), 0)) + ')')], p5want));
+							return (p5context([('p5complement( ' + p5str(p5pkg["Perlito5::Javascript"].to_num(p5list_to_a(((v_self || (v_self = new p5HashRef({})))._hash_['arguments'] || ((v_self || (v_self = new p5HashRef({})))._hash_['arguments'] = new p5ArrayRef([])))._array_[p5idx(((v_self || (v_self = new p5HashRef({})))._hash_['arguments'] || ((v_self || (v_self = new p5HashRef({})))._hash_['arguments'] = new p5ArrayRef([])))._array_,0)]), 0)) + ')')], p5want));
 					}, 'prefix:<->', function (List__, p5want) {
 							var v_self = null;
 							(v_self = (p5pkg["Perlito5::AST::Apply"].shift([List__])));

diff --git a/perlito5.pl b/perlito5.pl
diff --git a/src5/lib/Perlito5/Javascript/Emitter.pm b/src5/lib/Perlito5/Javascript/Emitter.pm
@@ -1180,7 +1180,7 @@ package Perlito5::AST::Apply;
         },
         'prefix:<~>' => sub {
             my $self = $_[0];
-            '~( ' . Perlito5::Javascript::to_num( $self->{arguments}->[0] ) . ')';
+            'p5complement( ' . Perlito5::Javascript::to_num( $self->{arguments}->[0] ) . ')';
         },
         'prefix:<->' => sub {
             my $self      = shift;

diff --git a/src5/lib/Perlito5/Javascript/Runtime.pm b/src5/lib/Perlito5/Javascript/Runtime.pm
@@ -416,6 +416,11 @@ p5cmp = function(a, b) {
     return a > b ? 1 : a < b ? -1 : 0 
 };
 
+p5complement = function(a) {
+    return a < 0 ? ~a : 4294967295 - a
+    // return a < 0 ? ~a : 18446744073709551615 - a
+};
+
 p5str_replicate = function(o, n) {
     n = p5num(n);
     return n ? Array(n + 1).join(o) : "";

diff --git a/t/test.pl b/t/test.pl
@@ -330,43 +330,43 @@ ($$$@)
     _ok($pass, _where(), $name, @mess);
 }
 
-####  # Check that $got is within $range of $expected
-####  # if $range is 0, then check it's exact
-####  # else if $expected is 0, then $range is an absolute value
-####  # otherwise $range is a fractional error.
-####  # Here $range must be numeric, >= 0
-####  # Non numeric ranges might be a useful future extension. (eg %)
-####  sub within ($$$@) {
-####      my ($got, $expected, $range, $name, @mess) = @_;
-####      my $pass;
-####      if (!defined $got or !defined $expected or !defined $range) {
-####          # This is a fail, but doesn't need extra diagnostics
+# Check that $got is within $range of $expected
+# if $range is 0, then check it's exact
+# else if $expected is 0, then $range is an absolute value
+# otherwise $range is a fractional error.
+# Here $range must be numeric, >= 0
+# Non numeric ranges might be a useful future extension. (eg %)
+sub within ($$$@) {
+    my ($got, $expected, $range, $name, @mess) = @_;
+    my $pass;
+    if (!defined $got or !defined $expected or !defined $range) {
+        # This is a fail, but doesn't need extra diagnostics
 ####      } elsif ($got !~ tr/0-9// or $expected !~ tr/0-9// or $range !~ tr/0-9//) {
 ####          # This is a fail
 ####          unshift @mess, "# got, expected and range must be numeric\n";
-####      } elsif ($range < 0) {
-####          # This is also a fail
-####          unshift @mess, "# range must not be negative\n";
-####      } elsif ($range == 0) {
-####          # Within 0 is ==
-####          $pass = $got == $expected;
-####      } elsif ($expected == 0) {
-####          # If expected is 0, treat range as absolute
-####          $pass = ($got <= $range) && ($got >= - $range);
-####      } else {
-####          my $diff = $got - $expected;
-####          $pass = abs ($diff / $expected) < $range;
-####      }
-####      unless ($pass) {
-####          if ($got eq $expected) {
-####              unshift @mess, "# $got - $expected = " . ($got - $expected) . "\n";
-####          }
-####  	unshift@mess, "#      got "._qq($got)."\n",
-####  		      "# expected "._qq($expected)." (within "._qq($range).")\n";
-####      }
-####      _ok($pass, _where(), $name, @mess);
-####  }
-####  
+    } elsif ($range < 0) {
+        # This is also a fail
+        unshift @mess, "# range must not be negative\n";
+    } elsif ($range == 0) {
+        # Within 0 is ==
+        $pass = $got == $expected;
+    } elsif ($expected == 0) {
+        # If expected is 0, treat range as absolute
+        $pass = ($got <= $range) && ($got >= - $range);
+    } else {
+        my $diff = $got - $expected;
+        $pass = abs ($diff / $expected) < $range;
+    }
+    unless ($pass) {
+        if ($got eq $expected) {
+            unshift @mess, "# $got - $expected = " . ($got - $expected) . "\n";
+        }
+	unshift@mess, "#      got "._qq($got)."\n",
+		      "# expected "._qq($expected)." (within "._qq($range).")\n";
+    }
+    _ok($pass, _where(), $name, @mess);
+}
+
 ####  # Note: this isn't quite as fancy as Test::More::like().
 ####  
 ####  sub like   ($$@) { like_yn (0,@_) }; # 0 for -