[Rt-commit] [svn] r1062 - in mzscheme: . Inline-MzScheme
Inline-MzScheme/lib/Inline Inline-MzScheme/t
Language-MzScheme Language-MzScheme/lib/Language
Language-MzScheme/lib/Language/MzScheme
Language-MzScheme/script Language-MzScheme/t
autrijus at pallas.eruditorum.org
autrijus at pallas.eruditorum.org
Sun Jun 13 14:50:43 EDT 2004
Author: autrijus
Date: Sun Jun 13 14:50:42 2004
New Revision: 1062
Modified:
mzscheme/ (props changed)
mzscheme/Inline-MzScheme/Changes
mzscheme/Inline-MzScheme/META.yml
mzscheme/Inline-MzScheme/Makefile.PL
mzscheme/Inline-MzScheme/SIGNATURE
mzscheme/Inline-MzScheme/lib/Inline/MzScheme.pm
mzscheme/Inline-MzScheme/t/1-basic.t
mzscheme/Language-MzScheme/Changes
mzscheme/Language-MzScheme/META.yml
mzscheme/Language-MzScheme/Makefile.PL
mzscheme/Language-MzScheme/SIGNATURE
mzscheme/Language-MzScheme/lib/Language/MzScheme.pm
mzscheme/Language-MzScheme/lib/Language/MzScheme/Env.pm
mzscheme/Language-MzScheme/lib/Language/MzScheme/Object.pm
mzscheme/Language-MzScheme/mzscheme.c
mzscheme/Language-MzScheme/mzscheme.h
mzscheme/Language-MzScheme/script/mzperl
mzscheme/Language-MzScheme/t/2-context.t
mzscheme/Language-MzScheme/t/5-perl.t
mzscheme/Language-MzScheme/t/6-error.t
Log:
----------------------------------------------------------------------
r5587 at not: autrijus | 2004-06-13T10:34:24.329410Z
* first cut at supporting full 10 contexts.
----------------------------------------------------------------------
r5588 at not: autrijus | 2004-06-13T15:25:55.527315Z
* Remove redundant calls to init wrappers.
----------------------------------------------------------------------
r5589 at not: autrijus | 2004-06-13T18:47:42.341426Z
* Beginning of at least some documentation.
* Massive refactoring for Perl method wrappers.
* script/mzperl now supports inline Perl code, via
;__PERL__; ... ;__END__; blocks.
----------------------------------------------------------------------
r5590 at not: autrijus | 2004-06-13T18:50:30.526437Z
* This be 0.06.
----------------------------------------------------------------------
Modified: mzscheme/Inline-MzScheme/Changes
==============================================================================
--- mzscheme/Inline-MzScheme/Changes (original)
+++ mzscheme/Inline-MzScheme/Changes Sun Jun 13 14:50:42 2004
@@ -1,3 +1,8 @@
+[Changes for 0.05 - June 13, 2004]
+
+Adapt to Language::MzScheme 0.05's auto-context -- now we don't
+need to use (car ...) on perl calls that returns one value.
+
[Changes for 0.04 - June 11, 2004]
Improved documentations and tests.
Modified: mzscheme/Inline-MzScheme/META.yml
==============================================================================
--- mzscheme/Inline-MzScheme/META.yml (original)
+++ mzscheme/Inline-MzScheme/META.yml Sun Jun 13 14:50:42 2004
@@ -1,5 +1,5 @@
name: Inline-MzScheme
-version: 0.04
+version: 0.05
abstract: Inline module for the PLT MzScheme interpreter
author: Autrijus Tang <autrijus at autrijus.org>
license: perl
@@ -8,7 +8,7 @@
Test::More: 0
requires:
Inline: 0.43
- Language::MzScheme: 0.04
+ Language::MzScheme: 0.05
no_index:
directory:
- inc
Modified: mzscheme/Inline-MzScheme/Makefile.PL
==============================================================================
--- mzscheme/Inline-MzScheme/Makefile.PL (original)
+++ mzscheme/Inline-MzScheme/Makefile.PL Sun Jun 13 14:50:42 2004
@@ -11,7 +11,7 @@
build_requires('Test::More');
requires(qw(
Inline 0.43
- Language::MzScheme 0.04
+ Language::MzScheme 0.05
));
WriteAll( sign => 1 );
Modified: mzscheme/Inline-MzScheme/SIGNATURE
==============================================================================
--- mzscheme/Inline-MzScheme/SIGNATURE (original)
+++ mzscheme/Inline-MzScheme/SIGNATURE Sun Jun 13 14:50:42 2004
@@ -14,11 +14,11 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 61220651880e45d32a005e73d33d22d587be37a9 Changes
+SHA1 6e455f0ced70071c436672314e510bb9d2e91467 Changes
SHA1 3ccdfbd7b06ce8f3703e818323d7aba879102d8b MANIFEST
SHA1 6fa56ce905a85a21ab38ace330ed5b54c07cb36e MANIFEST.SKIP
-SHA1 6e4ac8bf39ede39db9c8fa203933bcf7b2c6bfce META.yml
-SHA1 2c33b571190353948bbaf6e3771e5aceb5680b3f Makefile.PL
+SHA1 3475ff6d2c124dafc99768dc1448c445bb91cb7e META.yml
+SHA1 4c98768dd938ca80328fb902fb385393c24c669e Makefile.PL
SHA1 015ef794b70a926280cbbe8c8d34c1e1329896df README
SHA1 2b65fc08c268c16ae7097d800bacccc7b8c9c905 inc/Module/Install.pm
SHA1 fd56d5c793014bccac2cd1e61926c4da8538ef99 inc/Module/Install/Base.pm
@@ -28,13 +28,13 @@
SHA1 207dfa13341a374fc78325fbeb99bc36659aef2d inc/Module/Install/Metadata.pm
SHA1 aff9341a15c04faec47089851e43d9d4061337e7 inc/Module/Install/Win32.pm
SHA1 8e0d347ca21bc18b380d9d1aa5910b8d078a76b7 inc/Module/Install/WriteAll.pm
-SHA1 cf084d01f087f5e221065b09e8502aa1496ad356 lib/Inline/MzScheme.pm
+SHA1 44664bc3207d47d57055e26dd4dab0044aef0684 lib/Inline/MzScheme.pm
SHA1 63c7ea0cfdd7643aa113c260eec9c9bf0a6ee8a0 t/0-signature.t
-SHA1 7e990a6d60fe7cdf878a84ab7f8afcdc08fea037 t/1-basic.t
+SHA1 4d35e014b26c4de2c9f8796afc0cb301d65d61f0 t/1-basic.t
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.3 (FreeBSD)
-iD8DBQFAyLMitLPdNzw1AaARAtUXAKC3vYQv+N6HtKKq5lThobGoumphoQCfYnI5
-zPQWqzJ7N9fs2MKP7LrDNJg=
-=49c9
+iD8DBQFAy9gjtLPdNzw1AaARAopFAJ0RPdroilknR5JRx6lMeYHsnp4xwgCfT1Mc
+mn1MiU8ahwloeJOf3XGKlss=
+=T77P
-----END PGP SIGNATURE-----
Modified: mzscheme/Inline-MzScheme/lib/Inline/MzScheme.pm
==============================================================================
--- mzscheme/Inline-MzScheme/lib/Inline/MzScheme.pm (original)
+++ mzscheme/Inline-MzScheme/lib/Inline/MzScheme.pm Sun Jun 13 14:50:42 2004
@@ -1,5 +1,5 @@
package Inline::MzScheme;
-$Inline::MzScheme::VERSION = '0.04';
+$Inline::MzScheme::VERSION = '0.05';
@Inline::MzScheme::ISA = qw(Inline);
use strict;
@@ -13,20 +13,20 @@
=head1 VERSION
-This document describes version 0.04 of Inline::MzScheme, released
-June 11, 2004.
+This document describes version 0.05 of Inline::MzScheme, released
+June 13, 2004.
=head1 SYNOPSIS
use subs 'perl_multiply'; # have to declare before Inline runs
use Math::BigInt;
- use Inline MzScheme => '
- (define (square x) (car (perl-multiply x x)))
+ use Inline MzScheme => q{
+ (define (square x) (perl-multiply x x))
(define assoc-list '((1 . 2) (3 . 4) (5 . 6)))
(define linked-list '(1 2 3 4 5 6))
- (define hex-string (car (bigint 'as_hex)))
- ', (bigint => Math::BigInt->new(1792));
+ (define hex-string (bigint 'as_hex))
+ }, (bigint => Math::BigInt->new(1792));
sub perl_multiply { $_[0] * $_[1] }
@@ -83,7 +83,7 @@
# check options
sub validate {
my $self = shift;
- my $env = $self->{env} ||= Language::MzScheme->basic_env;
+ my $env = $self->{env} ||= Language::MzScheme->new;
while (@_ >= 2) {
my ($key, $value) = (shift, shift);
@@ -111,7 +111,7 @@
my $self = shift;
my $code = $self->{API}{code};
my $pkg = $self->{API}{pkg} || 'main';
- my $env = $self->{env} ||= Language::MzScheme->basic_env;
+ my $env = $self->{env} ||= Language::MzScheme->new;
my %sym = map(
( $_ => 1 ),
@@ -125,8 +125,8 @@
foreach my $sym (sort keys %{"$pkg\::"}) {
my $code = *{${"$pkg\::"}{$sym}}{CODE} or next;
$sym =~ tr/_/-/;
- next if $sym{$sym}++;
- $env->define($sym, $code);
+ $env->define("$pkg\::$sym", $code) unless $sym{"$pkg\::$sym"}++;
+ $env->define($sym, $code) unless $sym{$sym}++;
}
SYMBOL:
Modified: mzscheme/Inline-MzScheme/t/1-basic.t
==============================================================================
--- mzscheme/Inline-MzScheme/t/1-basic.t (original)
+++ mzscheme/Inline-MzScheme/t/1-basic.t Sun Jun 13 14:50:42 2004
@@ -8,7 +8,7 @@
use Inline MzScheme => q{
(define (square x)
- (car (perl-multiply x x)))
+ (perl-multiply x x))
(define plus_two
(lambda (num)
@@ -20,7 +20,7 @@
(define assoc-list '((1 . 2) (3 . 4) (5 . 6)))
(define linked-list '(1 2 3 4 5 6))
-(define hex-string (car (bigint 'as_hex)))
+(define hex-string (bigint 'as_hex))
}, (bigint => Math::BigInt->new(1792));
Modified: mzscheme/Language-MzScheme/Changes
==============================================================================
--- mzscheme/Language-MzScheme/Changes (original)
+++ mzscheme/Language-MzScheme/Changes Sun Jun 13 14:50:42 2004
@@ -1,3 +1,42 @@
+[Changes for 0.06 - June 14, 2004]
+
+Beginning of at least some module documentations.
+
+Massive refactoring for Perl method wrappers, resulting in better
+error handling and more robust symbol importing.
+
+The script/mzperl program now supports inlined Perl code, via
+;__PERL__; ... ;__END__; blocks.
+
+[Changes for 0.05 - June 13, 2004]
+
+Much more efficient vector<=>arrayref type conversion.
+
+Context symbols added to function definition and runtime object
+invocation with sigils; the default context is to interpret it
+as scalar if only one value has been returned, and as a list otherwise.
+
+Objects and code references now preserve their identity when
+casted into scheme object and later dereferenced with ->as_perl_data.
+
+Environment is now created with Language::MzScheme->new, which adds
+perl-specific bindings (perl-use, perl-require, perl-do, perl-eval)
+on top of the basic env.
+
+New utility, script/mzperl, a perl-embedded mzscheme interpreter.
+
+Full round-trip for non-self-referential data structures now works;
+you can now pass unblessed references into scheme. (Blessed references
+already works as object closures.)
+
+Proper error handling; scheme-level errors are turned into "die" calls.
+Calls within eval{} will return scheme_undefined, but $SIG{__DIE__} will
+catch the actual error.
+
+Object closure invocation now demands a method instead of silently dying.
+
+Extensive tests for context, object, data, perl-calls and error handling.
+
[Changes for 0.04 - June 11, 2004]
Backported to SWIG 1.3.19 and earlier versions.
Modified: mzscheme/Language-MzScheme/META.yml
==============================================================================
--- mzscheme/Language-MzScheme/META.yml (original)
+++ mzscheme/Language-MzScheme/META.yml Sun Jun 13 14:50:42 2004
@@ -1,5 +1,5 @@
name: Language-MzScheme
-version: 0.04
+version: 0.06
abstract: Perl bindings to PLT MzScheme
author: Autrijus Tang <autrijus at autrijus.org>
license: perl
Modified: mzscheme/Language-MzScheme/Makefile.PL
==============================================================================
--- mzscheme/Language-MzScheme/Makefile.PL (original)
+++ mzscheme/Language-MzScheme/Makefile.PL Sun Jun 13 14:50:42 2004
@@ -48,7 +48,7 @@
makemaker_args(
LIBS => "-L$plt_path/lib -lmzgc -lmzscheme ".run(qw(swig -perl -ldflags)),
INC => "-I$include",
- OPTIMIZE => '-g',
+# OPTIMIZE => '-g',
OBJECT => "mzscheme_wrap$Config{obj_ext}",
);
Modified: mzscheme/Language-MzScheme/SIGNATURE
==============================================================================
--- mzscheme/Language-MzScheme/SIGNATURE (original)
+++ mzscheme/Language-MzScheme/SIGNATURE Sun Jun 13 14:50:42 2004
@@ -14,11 +14,11 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 f6c07f9fd0026e51000ac42e74bdf5baa35b87b0 Changes
-SHA1 725258b0ccfbff6678e6654269fe517b22113db9 MANIFEST
+SHA1 a4de2d54f29b397fe30a533b71edf1def4f1d494 Changes
+SHA1 63708e7b2260e75bc91172aa577754c8e5415271 MANIFEST
SHA1 7a81e2090d10fa9903f45f7255b4f30156eb0d5e MANIFEST.SKIP
-SHA1 cde01e8ce89f28934db972e83e78b4918064e2ce META.yml
-SHA1 afb550250103699ef29fbb8655aa16746d32eac6 Makefile.PL
+SHA1 215e059ea7ecdb586a833dc41bba84b300578dfb META.yml
+SHA1 a41f7d933c9adb64682f139e17bf4d58fa45185e Makefile.PL
SHA1 f502bcb5576b2678f411613940c5b901ba5f0270 README
SHA1 2b65fc08c268c16ae7097d800bacccc7b8c9c905 inc/Module/Install.pm
SHA1 fd56d5c793014bccac2cd1e61926c4da8538ef99 inc/Module/Install/Base.pm
@@ -26,20 +26,27 @@
SHA1 b6c8f0f22c4c8ba48a7bac2c5e4bd61803a7b097 inc/Module/Install/Fetch.pm
SHA1 aabcd47178e4e7b27e340ff5273269c93697c9c1 inc/Module/Install/Makefile.pm
SHA1 207dfa13341a374fc78325fbeb99bc36659aef2d inc/Module/Install/Metadata.pm
+SHA1 bfc36deb38cf94243679dfa71f6e8c4e2000d20a inc/Module/Install/Scripts.pm
SHA1 aff9341a15c04faec47089851e43d9d4061337e7 inc/Module/Install/Win32.pm
SHA1 8e0d347ca21bc18b380d9d1aa5910b8d078a76b7 inc/Module/Install/WriteAll.pm
-SHA1 8972668427be2a5e60d605f6e7b2221bd473b177 lib/Language/MzScheme.pm
-SHA1 7e875019cf66fb5067f950303a04099e61013d15 lib/Language/MzScheme/Env.pm
-SHA1 1bd41bdd257036bdb498e1e994d46a0ee7a6bec7 lib/Language/MzScheme/Object.pm
-SHA1 94cc00555f421f82fec0c773cd78feada346efc9 mzscheme.c
-SHA1 037e4629663a8f49009c94ad07119e86a8167dfe mzscheme.h
-SHA1 f3380c2ca297a45f70f1c93765575f4f0fbc450c mzscheme.i
+SHA1 ed4e4d5bfe074732c8381471f29c31d3798739aa lib/Language/MzScheme.pm
+SHA1 c2fb92030184f9b4c17c453569c7c1252e5947c8 lib/Language/MzScheme/Env.pm
+SHA1 7ef0fc9e5a441b3b2b6d0aa920192282c223e479 lib/Language/MzScheme/Object.pm
+SHA1 7602d4a0c5f3c4eeefa676b6dcfb1b922f9a3751 mzscheme.c
+SHA1 17aa75bc0034488c686c3d370f9652b31925725b mzscheme.h
+SHA1 30bbb57c7092670e6ff2e607c4fef85ef32f0631 mzscheme.i
+SHA1 560aa6cebebd5a651eaf2bee5121fefc1c3a63e6 script/mzperl
SHA1 63c7ea0cfdd7643aa113c260eec9c9bf0a6ee8a0 t/0-signature.t
-SHA1 11073b71db07f6d25fadd1c8a521dd689fb9de45 t/1-basic.t
+SHA1 2d94109bd6ba3092b58c62d18c721cda2af0c7af t/1-basic.t
+SHA1 79f1e1568dd6043d8746f5e91bec7922ccec94ea t/2-context.t
+SHA1 86e4a8ba68f2b1ffc21a9f3a9a3f1f51beb69835 t/3-object.t
+SHA1 d5f24b9183df579f97f3a86d3a25bdcdad49180f t/4-data.t
+SHA1 42b23053d7905258079a5cbd43157de6c1dffb45 t/5-perl.t
+SHA1 d18267a6e23e81b724003850349c222e3b1ec729 t/6-error.t
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.3 (FreeBSD)
-iD8DBQFAyLgmtLPdNzw1AaARAvsRAJsGxPXslfOizm0fQyYSF1bC5EBa7gCeJXmb
-FhUWxyMewuNedJVKfy6vjqQ=
-=JhaR
+iD8DBQFAzKHutLPdNzw1AaARAktbAJ9aN03qhuUSFm/v+ic4QxcvF2rmuACfWMFO
+yUdontVm+6iu/9knHTgGKUQ=
+=QKBx
-----END PGP SIGNATURE-----
Modified: mzscheme/Language-MzScheme/lib/Language/MzScheme.pm
==============================================================================
--- mzscheme/Language-MzScheme/lib/Language/MzScheme.pm (original)
+++ mzscheme/Language-MzScheme/lib/Language/MzScheme.pm Sun Jun 13 14:50:42 2004
@@ -1,5 +1,5 @@
package Language::MzScheme;
-$Language::MzScheme::VERSION = '0.04';
+$Language::MzScheme::VERSION = '0.06';
use strict;
use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -19,8 +19,8 @@
=head1 VERSION
-This document describes version 0.04 of Language::MzScheme, released
-June 11, 2004.
+This document describes version 0.06 of Language::MzScheme, released
+June 14, 2004.
=head1 SYNOPSIS
@@ -34,6 +34,9 @@
This module provides Perl bindings to PLT's MzScheme language.
+For a proof-of-concept interpreter that can mix Perl and MzScheme code,
+see the L<mzperl> utility bundled with this distribution.
+
The documentation is sorely lacking at this moment. For an overview of
supported features, please consult F<t/*.t> in the source distribution.
@@ -41,9 +44,7 @@
sub new {
my $self = shift;
- my $env = $self->basic_env;
- $env->define_perl_wrappers;
- return $env;
+ return Language::MzScheme::Env->new(@_);
}
if (!$Language::MzScheme::Initialized) {
@@ -74,9 +75,15 @@
1;
+__END__
+
=head1 SEE ALSO
-L<Inline::MzScheme>, L<http://plt-scheme.org/software/mzscheme/>
+L<mzperl>, L<Inline::MzScheme>
+
+L<Language::MzScheme::Env>, L<Language::MzScheme::Object>
+
+L<http://plt-scheme.org/software/mzscheme/>
=head1 AUTHORS
Modified: mzscheme/Language-MzScheme/lib/Language/MzScheme/Env.pm
==============================================================================
--- mzscheme/Language-MzScheme/lib/Language/MzScheme/Env.pm (original)
+++ mzscheme/Language-MzScheme/lib/Language/MzScheme/Env.pm Sun Jun 13 14:50:42 2004
@@ -3,47 +3,130 @@
use vars '%Objects';
use strict;
-use constant S => "Language::MzScheme";
+use constant S => 'Language::MzScheme';
-foreach my $sym (qw(
- perl_do perl_eval perl_require perl_use perl_no
-)) {
- no strict 'refs';
- my $proc = $sym;
- $proc =~ tr/_/-/;
- *$sym = sub {
- my $self = shift;
- $self->apply($proc, @_);
- };
+my $SIGILS = '!?$~+.@^%&';
+my @SIGILS = split(//, $SIGILS);
+
+=head1 NAME
+
+Language::MzScheme::Env - MzScheme runtime environment
+
+=head1 SYNOPSIS
+
+ use Language::MzScheme;
+ my $env = Language::MzScheme->new;
+ # ...
+
+=head1 DESCRIPTION
+
+None at this moment.
+
+=head1 METHODS
+
+All methods below, except C<new>, returns an B<Language::MzScheme::Object>
+instance.
+
+=head2 new
+
+Constructs and returns a new environment object. Calling this method is
+identical to C<Language::MzScheme-E<gt>new>.
+
+=cut
+
+sub new {
+ my $env = S->basic_env;
+ $env->_init_perl_wrappers;
+ return $env;
}
-sub eval {
- my $self = shift;
- my $obj = UNIVERSAL::isa($_[0], S."::Object")
- ? S->do_eval($_[0], $self)
- : S->do_eval_string_all($_[0], $self, 1);
- $Objects{S->REFADDR($obj)} ||= $self if ref($obj);
+=head2 lookup($name)
+
+Given a global MzScheme variable name C<$name>, returns the current value.
+
+=cut
+
+sub lookup {
+ my ($self, $name) = @_;
+
+ return $name if UNIVERSAL::isa($name, S.'::Object') and $name->isa('CODE');
+
+ my $sym = S->intern_symbol($name);
+ my $obj = S->lookup_global($sym, $self);
+ $Objects{S->REFADDR($obj)} ||= $self;
return $obj;
}
+=head2 define($name, $code, $sigil)
+
+Defines a new MzScheme primitive C<$name> from C<$code>, with the
+calling context C<$sigil>, and returns it.
+
+If C<$sigil> is omitted, look at the end of C<$name> for a sigil
+character; if not found, uses the auto context. See L</CONTEXTS>
+for a list of sigils and their meanings.
+
+If C<$code> is omitted, defines a package with the name C<$name>
+and import all its symbols. Otherwise, pass it and the sigil to
+the C<lambda> method, and bind the returned lambda to C<$name>.
+
+=cut
+
sub define {
my ($self, $name, $code, $sigil) = @_;
- $code ||= $name;
- $sigil ||= substr($name, -1) if $name =~ /['!?\@\$\%]$/;
+ $sigil ||= substr($name, -1) if $name =~ /[$SIGILS]$/o;
- my $obj = $self->lambda($code, $sigil);
+ if (!defined($code)) {
+ no strict 'refs';
+ foreach my $sym (sort keys %{"$name\::"}) {
+ my $code = *{${"$name\::"}{$sym}}{CODE} or next;
+ $sym =~ tr/_/-/;
+ $self->define("$pkg\::$sym", $code);
+ }
+ $code = $name;
+ }
+ elsif (ref($code) eq 'CODE') {
+ foreach my $s (@SIGILS) {
+ my $obj = $self->lambda($code, $sigil);
+ S->add_global($name.$s, $obj, $self);
+ }
+ }
+ my $obj = $self->lambda($code, $sigil);
S->add_global($name, $obj, $self);
return $self->lookup($name);
}
+=head2 lambda($code, $sigil)
+
+Builds and returns a MzScheme procedure, as a wrapper for C<$code>.
+
+If C<$code> is a Perl code reference, returns a lambda that takes any
+number of parameters, under the context specified by C<$sigil>:
+
+ (func ...) ; ==> $code->(...)
+
+Otherwise, treat C<$code> as a class name or an object, and returns a
+lambda that takes a mandatory I<method> argument, followed by any
+number of parameters.
+
+ (obj 'method ...) ; ==> $obj->$method(...)
+
+Generally, you should only set C<$sigil> for code references, and let
+the user specity the context with the method name:
+
+ (obj 'set! ...) ; void context
+ (obj 'isa? ...) ; boolean context
+
+=cut
+
sub lambda {
my ($self, $code, $sigil) = @_;
my $name = "$code";
$name .= ":$sigil" if $sigil;
- my $obj = UNIVERSAL::isa($code, 'CODE')
+ my $obj = (ref($code) eq 'CODE')
? S->make_perl_prim_w_arity($code, "$name", 0, -1, $sigil)
: S->make_perl_object_w_arity($code, "$name", 1, -1, $sigil);
@@ -51,6 +134,29 @@
return $obj;
}
+=head2 eval($expr)
+
+Evaluates a MzScheme expression, passed as an object or a string,
+and returns the result.
+
+=cut
+
+sub eval {
+ my $self = shift;
+ my $obj = UNIVERSAL::isa($_[0], S."::Object")
+ ? S->do_eval($_[0], $self)
+ : S->do_eval_string_all($_[0], $self, 1);
+ $Objects{S->REFADDR($obj)} ||= $self if ref($obj);
+ return $obj;
+}
+
+=head2 apply($name, @args)
+
+Applies a MzScheme procedure, passed as an object or a global name,
+to C<@args>, and returns the result.
+
+=cut
+
sub apply {
my ($self, $name) = splice(@_, 0, 2);
@_ = map S->from_perl_scalar($_), @_;
@@ -59,58 +165,145 @@
return $obj;
}
-sub lookup {
- my ($self, $name) = @_;
+=head1 CONTEXTS
- return $name if UNIVERSAL::isa($name, S.'::Object') and $name->isa('CODE');
+There are 10 different sigils, each representing a way to interpret
+values returned by a Perl function or method.
- my $sym = S->intern_symbol($name);
- my $obj = S->lookup_global($sym, $self);
- $Objects{S->REFADDR($obj)} ||= $self;
- return $obj;
+If no sigils are specified, then B<auto-context> is assumed: it will
+call the perl code with Perl's list context, and look at the number
+of values returned. If there is exactly one return value, receive it
+as a scalar; otherwise, returns a MzScheme list that contains all
+return values.
+
+ ; list context calls
+ (perl-func "string") ; auto-context
+ (perl-func@ "string") ; a list
+ (perl-func^ "string") ; a vector
+ (perl-func% "string") ; a hash-table
+ (perl-func& "string") ; an association-list
+
+ ; scalar context calls
+ (perl-func$ "string") ; a scalar of an appropriate type
+ (perl-func~ "string") ; a string
+ (perl-func+ "string") ; a number
+ (perl-func. "string") ; a character
+ (perl-func? "string") ; a boolean (#t or #f)
+
+ ; void context calls
+ (perl-func! "string") ; always #<void>
+
+=cut
+
+foreach my $sym (qw(
+ perl_do perl_eval perl_require perl_use
+)) {
+ no strict 'refs';
+ my $proc = $sym;
+ $proc =~ tr/_/-/;
+ *$sym = sub {
+ my $self = shift;
+ $self->apply($proc, @_);
+ };
}
-sub define_perl_wrappers {
+sub _init_perl_wrappers {
my $self = shift;
- my $require = sub { $self->_wrap_require(@_) };
- $self->define('perl-do', sub { do $_[0] });
- $self->define('perl-eval', sub { eval "@_" });
- $self->define('perl-no', $require); # XXX unimport
- $self->define('perl-use', sub {
- no strict 'refs';
- my $pkg = $require->(@_); shift;
+ my $env_pkg = ref($self).(0+$self);
- # XXX - should export using a fake package instead
- @_ = @{"$pkg\::EXPORT"} if !@_ and UNIVERSAL::isa($pkg, 'Exporter');
+ no strict 'refs';
+ *{"$env_pkg\::mz_eval"} = sub { $self->eval(@_) };
+ *{"$env_pkg\::mz_apply"} = sub { $self->apply(@_) };
+ *{"$env_pkg\::mz_lambda"} = sub { $self->lambda(@_) };
+ *{"$env_pkg\::mz_define"} = sub { $self->define(@_) };
+ *{"$env_pkg\::mz_lookup"} = sub { $self->lookup(@_) };
+
+ # XXX current-command-line-arguments?
+ $self->define('perl-do', $self->_wrap_do($env_pkg));
+ $self->define('perl-eval', $self->_wrap_eval($env_pkg));
+ $self->define('perl-use', $self->_wrap_use($env_pkg));
+ $self->define('perl-require', $self->_wrap_require($env_pkg));
+}
- foreach my $sym (map { $_->isa('ARRAY') ? @$_ : $_ } @_) {
- my $code = $pkg->can($sym) or next;
- $self->define($sym, $code);
- }
+sub _wrap_require {
+ my ($self, $env_pkg) = @_;
+ return sub {
+ my $pkg = shift;
+ $pkg =~ s{::}{/}g;
+ $pkg .= ".pm" if index($pkg, '.') == -1;
+ local $@;
+ eval "package $env_pkg; require \$pkg;";
+ die $@ if $@;
+ $pkg =~ s{/}{::}g;
+ $pkg =~ s{\.pm$}{}i;
+ $self->define($pkg);
+ return $pkg;
+ };
+}
+
+sub _wrap_use {
+ my ($self, $env_pkg) = @_;
+ return sub {
+ no strict 'refs';
+ my $pkg = shift;
+ my %seen = map ( ( $_ => 1 ), keys %{"$env_pkg\::"} );
- foreach my $sym (sort keys %{"$pkg\::"}) {
+ local $@;
+ eval "package $env_pkg;\nuse $pkg ".(
+ @_ ? do {
+ @_ = map { $_->isa('ARRAY') ? @$_ : $_ } @_;
+ '@_;';
+ } : ';'
+ );
+ die $@ if $@;
+
+ foreach my $sym (sort keys %{"$env_pkg\::"}) {
+ next if $seen{$sym};
my $code = *{${"$pkg\::"}{$sym}}{CODE} or next;
- $sym =~ tr/_/-/;
- $self->define("$pkg\::$sym", $code);
$self->define($sym, $code);
}
+ $self->define($pkg);
return $pkg;
- });
- $self->define('perl-require', $require);
- # XXX current-command-line-arguments
+ };
}
-sub _wrap_require {
- my $self = shift;
- my $pkg = shift;
- $pkg =~ s{::}{/}g;
- $pkg .= ".pm" if index($pkg, '.') == -1;
- require $pkg;
- $pkg =~ s{/}{::}g;
- $pkg =~ s{\.pm$}{}i;
- $self->define($pkg);
- return $pkg;
+sub _wrap_do {
+ my ($self, $env_pkg) = @_;
+ return sub {
+ my $file = shift;
+ local $@;
+ return eval "package $env_pkg;\ndo \$file;";
+ }
+}
+
+sub _wrap_eval {
+ my ($self, $env_pkg) = @_;
+ return sub {
+ local $@;
+ return eval "package $env_pkg;\n at _;";
+ }
}
1;
+
+__END__
+
+=head1 SEE ALSO
+
+L<Language::MzScheme>, L<Language::MzScheme::Object>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
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 Sun Jun 13 14:50:42 2004
@@ -18,6 +18,52 @@
fallback => 1,
);
+=head1 NAME
+
+Language::MzScheme::Object - MzScheme value object
+
+=head1 SYNOPSIS
+
+ use Language::MzScheme;
+ my $env = Language::MzScheme->new;
+ my $obj = $env->lookup('cons');
+ # ...
+
+=head1 OVERLOADS
+
+Following operators are overloaded for this class:
+
+ bool "" 0+ ! &{} %{} @{} *{} ${} <>
+
+=head1 METHODS
+
+Under construction.
+
+=head2 Converting into Perl values
+
+ to_bool to_string to_number to_negate
+ to_coderef to_hashref to_arrayref to_globref to_scalarref
+ as_write as_display as_perl_data
+
+=head2 List object methods
+
+ car cdr cadr caar cddr caadr
+
+=head2 Port object methods
+
+ read write read-char write-char
+
+=head2 Environment dispatchers
+
+ eval apply lambda lookup
+ perl_do perl_eval perl_require perl_use perl_no
+
+=head2 Miscellanous Utilities
+
+ env bless isa
+
+=cut
+
foreach my $proc (qw( car cdr cadr caar cddr )) {
no strict 'refs';
my $code = S."::SCHEME_\U$proc";
@@ -103,7 +149,7 @@
my %rv;
while (my $obj = $alist->car) {
- $rv{$obj->car} = $obj->cdr;
+ $rv{as_perl_data($obj->car)} = $obj->cdr;
$alist = $alist->cdr;
}
return \%rv;
@@ -147,6 +193,8 @@
sub as_perl_data {
my $self = shift;
+ return $self unless UNIVERSAL::isa($self, __PACKAGE__);
+
if ( S->PERLP($self) ) {
return S->to_perl_scalar($self);
}
@@ -155,17 +203,17 @@
}
elsif ( S->HASHTP($self) ) {
my $hash = $self->to_hashref;
- $hash->{$_} = $hash->{$_}->as_perl_data for keys %$hash;
+ $hash->{$_} = as_perl_data($hash->{$_}) for keys %$hash;
return $hash;
}
elsif ( S->ARRAY_REFP($self) ) {
- return [ map $_->as_perl_data, @{$self->to_arrayref} ];
+ return [ map as_perl_data($_), @{$self->to_arrayref} ];
}
elsif ( S->GLOB_REFP($self) ) {
return $self; # XXX -- doesn't really know what to do
}
elsif ( S->SCALAR_REFP($self) ) {
- return \${$self->to_scalarref}->as_perl_data;
+ return \as_perl_data(${$self->to_scalarref});
}
elsif ( S->UNDEFP($self) ) {
return undef;
@@ -182,3 +230,24 @@
}
1;
+
+__END__
+
+=head1 SEE ALSO
+
+L<Language::MzScheme>, L<Language::MzScheme::Env>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Modified: mzscheme/Language-MzScheme/mzscheme.c
==============================================================================
--- mzscheme/Language-MzScheme/mzscheme.c (original)
+++ mzscheme/Language-MzScheme/mzscheme.c Sun Jun 13 14:50:42 2004
@@ -26,7 +26,7 @@
Perl_Callback *callback = (Perl_Callback *)malloc(sizeof(Perl_Callback));
callback->magic = Perl_Callback_MAGIC;
callback->sv = object;
- callback->sigil = ((sigil_string == NULL) ? NULL : *sigil_string);
+ callback->sigil = ((sigil_string == NULL) ? Perl_Context_AUTO : *sigil_string);
SvREFCNT_inc(object);
return scheme_make_closed_prim_w_arity(
@@ -174,24 +174,38 @@
SPAGAIN ;
- if (sigil == NULL) {
+ if (sigil == Perl_Context_AUTO) {
/* Auto-context */
sigil = ((count == 1) ? Perl_Context_SCALAR : Perl_Context_LIST);
}
switch (sigil) {
+ case Perl_Context_VOID :
+ rv = scheme_void;
+ break;
case Perl_Context_BOOLEAN :
rv = (((count > 0) && SvTRUE(TOPs)) ? scheme_true : scheme_false);
break;
- case Perl_Context_SYMBOL :
- rv = ((count > 0) ? mzscheme_from_perl_symbol(TOPs) : scheme_null);
- break;
case Perl_Context_SCALAR :
rv = ((count > 0) ? mzscheme_from_perl_scalar(TOPs) : scheme_null);
break;
- case Perl_Context_VOID :
- rv = scheme_void;
+ case Perl_Context_STRING :
+ rv = scheme_make_string( (count > 0) ? (char *)SvPV(TOPs, PL_na) : "" );
break;
+ case Perl_Context_NUMBER :
+ rv = ((count > 0) ? SvIOK(TOPs) ? scheme_make_integer_value( (int)SvIV(TOPs) )
+ : SvNOK(TOPs) ? scheme_make_double( (double)SvNV(TOPs) )
+ : (strchr(SvPV(TOPs, PL_na), '.') == NULL)
+ ? scheme_make_integer_value( (int)SvIV(TOPs) )
+ : scheme_make_double( (double)SvNV(TOPs) )
+ : scheme_make_integer_value(0));
+ break;
+ case Perl_Context_CHAR : {
+ char *tmpstr;
+ rv = scheme_make_character(
+ ((count > 0) && (tmpstr = SvPV(TOPs, PL_na))) ? *tmpstr : '\0'
+ );
+ } break;
case Perl_Context_HASH : {
Scheme_Hash_Table *hash = scheme_make_hash_table(SCHEME_hash_ptr);
if ((count % 2) == 1) {
@@ -212,7 +226,34 @@
}
rv = (Scheme_Object *)hash;
} break;
- default: /* ARRAY */
+ case Perl_Context_ALIST : {
+ return_values = (Scheme_Object **) malloc(((int)(count/2)+3)*sizeof(Scheme_Object *));
+ if ((count % 2) == 1) {
+ count--;
+ return_values[count / 2] = scheme_make_pair(
+ mzscheme_from_perl_scalar(POPs),
+ scheme_null
+ );
+ }
+ count = count / 2;
+ for (i = count - 1; i >= 0 ; i--) {
+ rv = mzscheme_from_perl_scalar(POPs);
+ return_values[i] = scheme_make_pair(
+ mzscheme_from_perl_scalar(POPs),
+ rv
+ );
+ }
+ rv = scheme_build_list(count, return_values);
+ } break;
+ case Perl_Context_VECTOR :
+ rv = scheme_make_vector(count+1, NULL);
+ SCHEME_VEC_SIZE(rv) = count;
+ for (i = count - 1; i >= 0 ; i--) {
+ SCHEME_VEC_ELS(rv)[i] = mzscheme_from_perl_scalar(POPs);
+ }
+ SCHEME_VEC_ELS(rv)[count] = NULL;
+ break;
+ default: /* LIST */
if (count == 0) {
rv = scheme_null;
}
@@ -221,8 +262,8 @@
for (i = count - 1; i >= 0 ; i--) {
return_values[i] = mzscheme_from_perl_scalar(POPs);
}
+ rv = scheme_build_list((int)count, return_values);
}
- rv = scheme_build_list((int)count, return_values);
}
PUTBACK ;
Modified: mzscheme/Language-MzScheme/mzscheme.h
==============================================================================
--- mzscheme/Language-MzScheme/mzscheme.h (original)
+++ mzscheme/Language-MzScheme/mzscheme.h Sun Jun 13 14:50:42 2004
@@ -14,17 +14,30 @@
Scheme_Object** _mzscheme_from_perl_arrayref_to_objects (Perl_Scalar sv);
#define Perl_Callback_MAGIC '&'
+
+#define Perl_Context_AUTO NULL
+#define Perl_Context_VOID '!'
+
#define Perl_Context_BOOLEAN '?'
#define Perl_Context_SCALAR '$'
-#define Perl_Context_SYMBOL '\''
+#define Perl_Context_STRING '~'
+#define Perl_Context_NUMBER '+'
+#define Perl_Context_CHAR '.'
+
#define Perl_Context_LIST '@'
+#define Perl_Context_VECTOR '^'
#define Perl_Context_HASH '%'
-#define Perl_Context_VOID '!'
+#define Perl_Context_ALIST '&'
+
+#define Perl_To_SYMBOL
+
#define Perl_Context(sigil) \
( (sigil == Perl_Context_VOID) ? G_VOID : \
((sigil == Perl_Context_BOOLEAN) || \
(sigil == Perl_Context_SCALAR) || \
- (sigil == Perl_Context_SYMBOL)) ? G_SCALAR : \
+ (sigil == Perl_Context_STRING) || \
+ (sigil == Perl_Context_NUMBER) || \
+ (sigil == Perl_Context_CHAR)) ? G_SCALAR : \
G_ARRAY )
#define MZSCHEME_REFADDR(sv) (SvROK(sv) ? (int)PTR2UV(SvRV(sv)) : 0)
Modified: mzscheme/Language-MzScheme/script/mzperl
==============================================================================
--- mzscheme/Language-MzScheme/script/mzperl (original)
+++ mzscheme/Language-MzScheme/script/mzperl Sun Jun 13 14:50:42 2004
@@ -1,6 +1,119 @@
#!/usr/bin/perl
use Language::MzScheme;
-my $env = Language::MzScheme->new;
-my $file = (@ARGV ? shift(@ARGV) : '-');
-open CODE, $file or die qq(Can't open mzperl script "$file": $!\n);
-$env->eval(do { local $/; my $code = <CODE>; $code =~ s{^#!.*}{}; $code });
+
+=head1 NAME
+
+mzperl - Embed Perl in MzScheme
+
+=head1 SYNOPSIS
+
+ #!/usr/local/bin/mzperl
+ (perl-use 'Config)
+ (printf "<MzScheme> I'm running under Perl, version ~A.\n"
+ (perl-eval "$Config{version}"))
+ ;__PERL__;
+ printf "<Perl> I'm running under MzScheme, version %s.\n",
+ mz_eval('(version)');
+
+=head1 DESCRIPTION
+
+Is it Scheme? Is it Perl? It's neither, it's both. It's MzPerl!
+
+MzPerl is a "new language" that looks like MzScheme. As an added bonus,
+you'll get access to the full Perl runtime via the MzPerl API.
+
+The F<mzperl> script will normally be installed in the same directory as the
+C<perl> binary on your system, for example as F</usr/local/bin/mzperl>.
+
+=cut
+
+Language::MzScheme->new->eval(do {
+ my $file = (@ARGV ? shift(@ARGV) : '-');
+
+ local *CODE;
+ open CODE, $file or die qq(Can't open mzperl script "$file": $!\n);
+ my $code = do { local $/; <CODE> };
+ close CODE;
+
+ my $escape = sub {
+ my $string = shift;
+ $string =~ s/(?=["\\])/\\/g;
+ return $string;
+ };
+
+ $code =~ s{^\s*#!.*}{};
+ $code =~ s{\;\s*__PERL__\s*;(.*?);\s*__END__\s*;}{
+ '(perl-eval "'.$escape->($1).'")'
+ }egs;
+ $code;
+});
+
+=head1 FUNCTIONS
+
+The MzPerl API is just a set of MzScheme primitives that you can use to
+access the Perl runtime. They are the same set of primitives defined in
+all C<Language::MzScheme-E<gt>new> instances:
+
+=head2 perl-eval I<code>
+
+Eval a string or symbol in Perl and return the result. There are 11
+variants of this call, just like any other functions exported from Perl:
+
+ ; list context calls
+ (perl-eval "string") ; if there is one return value, return it
+ ; as a scalar, otherwise returns a list
+ (perl-eval@ "string") ; returns a list
+ (perl-eval^ "string") ; returns a vector
+ (perl-eval% "string") ; returns a hash-table
+ (perl-eval& "string") ; returns an association-list
+
+ ; scalar context calls
+ (perl-eval$ "string") ; returns a scalar of an appropriate type
+ (perl-eval~ "string") ; returns a string
+ (perl-eval+ "string") ; returns a number
+ (perl-eval. "string") ; returns the first character
+ (perl-eval? "string") ; returns a boolean (#t or #f)
+
+ ; void context calls
+ (perl-eval! "string") ; always returns #<void>
+
+=head2 perl-use I<module> [ I<import-list> ]
+
+Loads a perl module, and optionally imports symbols from it, just
+like Perl's C<use> keyword. Imported symbols are available in
+subsequent C<perl-eval> calls, as well as in scheme code as primitives.
+
+Fully-qualified names (C<Module::symbol>) are always available.
+
+=head2 perl-require I<module-or-filename>
+
+Loads a perl module or file, without importing any symbols.
+
+=head2 perl-do I<filename>
+
+Evaluates a perl file. Also available in all 11 context forms like
+the C<perl-eval> above.
+
+=head2 ;__PERL__; ... ;__END__;
+
+The C<;__PERL__;> token begins a perl code region. It ends on the next
+C<;__END__;> token, or until the end of file.
+
+=head1 WHY?
+
+Scheme has no CPAN. Perl5 has no macros and no continuations. So... :-)
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Modified: mzscheme/Language-MzScheme/t/2-context.t
==============================================================================
--- mzscheme/Language-MzScheme/t/2-context.t (original)
+++ mzscheme/Language-MzScheme/t/2-context.t Sun Jun 13 14:50:42 2004
@@ -2,7 +2,7 @@
use strict;
use Data::Dumper;
-use Test::More tests => 43;
+use Test::More tests => 72;
use_ok('Language::MzScheme');
@@ -10,57 +10,63 @@
my $sigils = {
auto => '',
- bool => '?',
void => '!',
+ bool => '?',
+ scalar => '$',
+ string => '~',
+ number => '+',
+ char => '.',
list => '@',
+ vector => '^',
hash => '%',
- scalar => '$',
- symbol => '\'',
+ alist => '&',
};
my $plans = [
sub { @_ } => [
[] => {
- auto => [], void => undef,
- bool => undef, list => [],
- scalar => 0, symbol => 0,
- hash => {},
+ auto => [], void => undef, bool => undef,
+ scalar => 0, string => "0", number => 0,
+ char => '0', list => [], vector => [],
+ hash => {}, alist => [],
},
[2] => {
- auto => 2, void => undef,
- bool => '#t', list => [2],
- scalar => 1, symbol => 1,
+ auto => 2, void => undef, bool => '#t',
+ scalar => 1, string => "1", number => 1,
+ char => '1', list => [2], vector => [2],
hash => { 2 => undef },
},
[1,2] => {
- auto => [1,2], void => undef,
- bool => '#t', list => [1,2],
- scalar => 2, symbol => 2,
+ auto => [1,2], void => undef, bool => '#t',
+ scalar => 2, string => "2", number => 2,
+ char => '2', list => [1,2], vector => [1,2],
hash => { 1 => 2 },
},
["a","b"] => {
- auto => ["a","b"],void => undef,
- bool => '#t', list => ["a","b"],
- scalar => 2, symbol => 2,
+ auto => ["a","b"],void => undef, bool => '#t',
+ scalar => 2, string => "2", number => 2,
+ char => '2', list => ["a","b"],vector => ["a","b"],
hash => { a => "b" },
},
],
- sub { 0 } => [
- [] => {
- auto => 0, void => undef,
- bool => undef, list => [0],
- scalar => 0, symbol => 0,
+ sub { 0 } => [ [] => {
+ auto => 0, void => undef, bool => undef,
+ scalar => 0, string => "0", number => 0,
+ char => '0', list => [0], vector => [0],
hash => { 0 => undef },
- },
- ],
- sub { "a", "b" } => [
- [] => {
- auto => ["a","b"],void => undef,
- bool => '#t', list => ["a","b"],
- scalar => "b", symbol => "b",
+ }, ],
+ sub { \&ok } => [ [] => {
+ auto => \&ok, void => undef, bool => '#t',
+ scalar => \&ok.'', string => \&ok.'', number => \&ok+0,
+ char => 'C', list => [\&ok], vector => [\&ok],
+ hash => { \&ok => undef },
+ }, ],
+ sub { "a", "b" } => [ [] => {
+ auto => ["a","b"],void => undef, bool => '#t',
+ scalar => "b", string => "b", number => 0,
+ char => 'b', list => ["a","b"],vector => ["a","b"],
hash => {"a","b"},
- },
- ],
+ }, ],
];
my ($sub, $plan);
@@ -76,12 +82,14 @@
while (($sub, $plan) = splice(@$plans, 0, 2)) {
while (my ($input, $output) = splice(@$plan, 0, 2)) {
foreach my $context (sort keys %$output) {
- my $out = Dumper($output->{$context});
- chomp $out;
+ my $scheme_out = $subs->{$context}->(@$input);
+ my $scheme_data = $scheme_out->as_perl_data;
is_deeply(
- $subs->{$context}->(@$input)->as_perl_data,
+ $scheme_data,
$output->{$context},
- "$context context, input: (@$input), output: $out"
+ "$context context, ".
+ $scheme_out->as_write.
+ " => ".Dumper($scheme_data)
);
}
}
Modified: mzscheme/Language-MzScheme/t/5-perl.t
==============================================================================
--- mzscheme/Language-MzScheme/t/5-perl.t (original)
+++ mzscheme/Language-MzScheme/t/5-perl.t Sun Jun 13 14:50:42 2004
@@ -1,6 +1,6 @@
use strict;
use Math::Trig ();
-use Test::More tests => 13;
+use Test::More tests => 12;
use_ok('Language::MzScheme');
@@ -18,11 +18,5 @@
ok($env->eval("(Math::Trig 'can? 'pi)"), 'can? - true');
ok(!$env->eval("(Math::Trig 'can? 'pie)"), 'can? - false');
-is($env->eval("(GD)"), Math::Trig::GD, 'invocation - import');
-is($env->eval("(Math::Trig::GD)"), Math::Trig::GD, 'invocation - full name');
-cmp_ok(
- $env->eval("(deg2deg 1792)"),
- '==',
- Math::Trig::deg2deg(1792),
- 'invocation - with parameters'
-);
+is($env->eval("(deg2grad 90)"), 100, 'invocation - import');
+is($env->eval("(Math::Trig::deg2grad 90)"), 100, 'invocation - full name');
Modified: mzscheme/Language-MzScheme/t/6-error.t
==============================================================================
--- mzscheme/Language-MzScheme/t/6-error.t (original)
+++ mzscheme/Language-MzScheme/t/6-error.t Sun Jun 13 14:50:42 2004
@@ -27,5 +27,5 @@
sub show_ok {
my $err = shift; chomp $err;
- ok($err, "error captured with \$SIG{__DIE__}: $err");
+ ok($err, "error captured with \$SIG{__DIE__}: [$err]");
}
More information about the Rt-commit
mailing list