[Rt-commit] [svn] r1119 - in mzscheme: . Language-MzScheme/lib/Language/MzScheme Language-MzScheme/t

[autrijus at pallas.eruditorum.org]

Author: autrijus
Date: Sat Jun 19 15:33:49 2004
New Revision: 1119

Modified:
   mzscheme/   (props changed)
   mzscheme/Language-MzScheme/lib/Language/MzScheme/Object.pm
   mzscheme/Language-MzScheme/t/1-basic.t
Log:
 ----------------------------------------------------------------------
 r5672 at not:  autrijus | 2004-06-19T19:33:26.315211Z
 
 * Implement auto-increment/decrement mutators.
 ----------------------------------------------------------------------


Modified: mzscheme/Language-MzScheme/lib/Language/MzScheme/Object.pm
==============================================================================
--- mzscheme/Language-MzScheme/lib/Language/MzScheme/Object.pm	(original)
+++ mzscheme/Language-MzScheme/lib/Language/MzScheme/Object.pm	Sat Jun 19 15:33:49 2004
@@ -15,6 +15,8 @@
     '*{}'       => \&to_globref,
     '${}'       => \&to_scalarref,
     '<>'        => \&read,
+    '++'        => \&increment,
+    '--'        => \&decrement,
     fallback    => 1,
 );
 
@@ -94,6 +96,11 @@
     };
 }
 
+sub new {
+    my $self = shift;
+    $self->bless( S->from_perl_scalar($_[0]) );
+}
+
 sub to_bool {
     my $self = shift;
     !S->UNDEFP($self);
@@ -232,6 +239,18 @@
     return $p->($self);
 }
 
+sub increment {
+    my $scalar = as_perl_data($_[0]);
+    $scalar++;
+    $_[0] = $_[0]->new($scalar);
+}
+
+sub decrement {
+    my $scalar = as_perl_data($_[0]);
+    $scalar--;
+    $_[0] = $_[0]->new($scalar);
+}
+
 1;
 
 __END__

Modified: mzscheme/Language-MzScheme/t/1-basic.t
==============================================================================
--- mzscheme/Language-MzScheme/t/1-basic.t	(original)
+++ mzscheme/Language-MzScheme/t/1-basic.t	Sat Jun 19 15:33:49 2004
@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 
 use strict;
-use Test::More tests => 34;
+use Test::More tests => 40;
 
 use_ok('Language::MzScheme');
 
@@ -57,6 +57,18 @@
 isa_ok($code, 'CODE', 'to_coderef');
 is($code->(4), 16, '->(), scheme-lambda');
 
+my $num = $code->(4);
+is(++$num, 17, 'number ++');
+$num *= 2;
+is($num, 34, 'number *=');
+is(--$num, 33, 'number --');
+
+my $str = $env->eval('"abc"');
+is(++$str, 'abd', 'string ++ (magical)');
+$str x= 2;
+is($str, 'abdabd', 'string x=');
+cmp_ok(--$str, '==', -1, 'string -- (non-magical)');
+
 my $lambda = sub { (Hello => reverse @_) };
 my $hello = $env->define('perl-hello', $lambda);
 isa_ok($hello, 'CODE', 'define');