Skip to content

Commit

Permalink
No longer flatten arguments when passing through to Perl code
Browse files Browse the repository at this point in the history 
Due to the use of flattening slurpies arrays and hashes passed to Perl code
were often flattened leading to confusing results (most often because of
key, value pairs appearing instead of hash refs). While this could have been
worked around easily by itemizing those arrays and hashes, this behaviour was
a constant gotcha.

Change all slurpy args to non-flattening. This makes the semantics more
familiar to Perl programmers and makes it possible to directly follow Perl
examples. If arguments should be flattened, there's still the | operator
to do this explicitly.

Fixes GH #162
  • Loading branch information
@niner
niner committed May 24, 2021
1 parent 5e4dfee commit bb81304
Show file tree
Hide file tree
Showing 14 changed files with 48 additions and 42 deletions.
8 changes: 4 additions & 4 deletions examples/Dancr/dancr.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ ()
}

sub connect_db() {
my $dbh = DBI.connect("dbi:SQLite:dbname={setting('database')}", Any, Any, ${sqlite_unicode => 1}) or
my $dbh = DBI.connect("dbi:SQLite:dbname={setting('database')}", Any, Any, {sqlite_unicode => 1}) or
die %*PERL5<$DBI::errstr>;

return $dbh;
Expand Down Expand Up @@ -59,7 +59,7 @@ ()
}
}
PERL5
hook before_template_render => hash-filler({ ${
hook before_template_render => hash-filler({ {
css_url => request.base ~ 'css/style.css',
login_url => uri_for('/login'),
logout_url => uri_for('/logout'),
Expand All @@ -70,7 +70,7 @@ ()
my $sql = 'select id, title, text from entries order by id desc';
my $sth = $db.prepare($sql) or die $db.errstr;
$sth.execute or die $sth.errstr;
template 'show_entries.tt', ${
template 'show_entries.tt', {
'msg' => get_flash(),
'add_entry_url' => uri_for('/add'),
'entries' => $sth.fetchall_hashref('id'),
Expand Down Expand Up @@ -111,7 +111,7 @@ ()
}

# display login form
template 'login.tt', ${
template 'login.tt', {
'err' => $err,
};

Expand Down
32 changes: 16 additions & 16 deletions lib/Inline/Perl5.pm6
View file
Original file line number Diff line number Diff line change
Expand Up @@ -418,7 +418,7 @@ multi method unpack_return_values(Pointer:D \av, int32 \count, int32 \type) {
}
}

method call(Str $function, *@args, *%args) {
method call(Str $function, **@args, *%args) {
my int32 $retvals;
my int32 $err;
my int32 $type;
Expand Down Expand Up @@ -448,7 +448,7 @@ method call-args(Str $function, Capture \args) {
self.unpack_return_values($av, $retvals, $type);
}

method call-simple-args(Str $function, *@args) {
method call-simple-args(Str $function, **@args) {
my int32 $retvals;
my int32 $err;
my int32 $type;
Expand All @@ -467,7 +467,7 @@ method call-simple-args(Str $function, *@args) {
self.unpack_return_values($av, $retvals, $type);
}

multi method invoke(Str $package, Str $function, *@args, *%args) {
multi method invoke(Str $package, Str $function, **@args, *%args) {
my int32 $retvals;
my int32 $err;
my int32 $type;
Expand All @@ -483,7 +483,7 @@ multi method invoke(Str $package, Str $function, *@args, *%args) {
self.unpack_return_values($av, $retvals, $type);
}

multi method invoke(Any:U $package, Str $base_package, Str $function, *@args, *%args) {
multi method invoke(Any:U $package, Str $base_package, Str $function, **@args, *%args) {
my int32 $retvals;
my int32 $err;
my int32 $type;
Expand Down Expand Up @@ -788,7 +788,7 @@ method scalar-invoke-gv-args(Pointer $obj, Pointer $function, Capture $args) {
self.unpack_return_values($av, $retvals, $type);
}

multi method invoke(Pointer $obj, Str $function, *@args, *%args) {
multi method invoke(Pointer $obj, Str $function, **@args, *%args) {
my @svs := CArray[Pointer].new();
my Int $j = 0;
@svs[$j++] = $obj;
Expand Down Expand Up @@ -842,7 +842,7 @@ method invoke-parent(Str $package, Pointer $obj, Bool $context, Str $function, @
self.unpack_return_values($av, $retvals, $type);
}

method execute(Pointer $code_ref, *@args) {
method execute(Pointer $code_ref, **@args) {
my int32 $retvals;
my int32 $err;
my int32 $type;
Expand Down Expand Up @@ -951,7 +951,7 @@ method sv_refcnt_dec($obj) {
$!p5.p5_sv_refcnt_dec($obj);
}

method install_wrapper_method(Str:D $package, Str $name, *@attributes) {
method install_wrapper_method(Str:D $package, Str $name, **@attributes) {
self.call-simple-args('v6::install_p6_method_wrapper', $package, $name, |@attributes);
}

Expand All @@ -963,17 +963,17 @@ method variables_in_module(Str $module) {
self.call-simple-args('v6::variables_in_module', $module)
}

method import (Str $module, *@args) {
method import (Str $module, **@args) {
my $before = set self.subs_in_module('main').list;
self.invoke($module, 'import', @args.list);
self.invoke($module, 'import', |@args);
my $after = set self.subs_in_module('main').list;
return ($after ∖ ($before ∖ set @args)).keys;
}

method !require_modules(@required_modules) {
for @required_modules -> ($module, $version, @args) {
self.call-simple-args('v6::load_module', $module);
self.invoke($module, 'import', @args);
self.invoke($module, 'import', |@args);
}
}

Expand Down Expand Up @@ -1026,7 +1026,7 @@ method require(Str $module, Num $version?, Bool :$handle) {
$class := $created if $package eq $module;
}

my &export := sub EXPORT(*@args) {
my &export := sub EXPORT(**@args) {
@import_args = @args;
if &p5_terminate.^find_method('CALL-ME') { # looks like old rakudo without necessary fixes
$*W.do_pragma(Any, 'precompilation', False, []);
Expand All @@ -1041,7 +1041,7 @@ method require(Str $module, Num $version?, Bool :$handle) {
my $op := $*W.add_phaser(Mu, 'INIT', $block, class :: { method cuid { (^2**128).pick }});
}
}
my @symbols = self.import($module, @args.list).map({
my @symbols = self.import($module, |@args).map({
my $name = $_;
my $function = "main::$name";
'&' ~ $name => sub (|args) {
Expand Down Expand Up @@ -1141,8 +1141,8 @@ method !import_wrapper_class(Str $module, Stash $stash) {
# install subs like Test::More::ok
for @$symbols -> $name {
my $full-name = "{$module}::$name";
$class.WHO.BIND-KEY("&$name", sub (*@args) {
self.call($full-name, @args.list);
$class.WHO.BIND-KEY("&$name", sub (**@args) {
self.call($full-name, |@args);
});
}
for @$variables -> $name {
Expand All @@ -1160,9 +1160,9 @@ method !import_wrapper_class(Str $module, Stash $stash) {
return $class;
}

method use(Str $module, *@args) {
method use(Str $module, **@args) {
self.require($module);
self.import($module, @args.list);
self.import($module, |@args);
}

submethod DESTROY {
Expand Down
4 changes: 2 additions & 2 deletions lib/Inline/Perl5/Callable.pm6
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,8 @@ class Inline::Perl5::Callable does Callable {
has Pointer $.ptr;
has $.perl5; # Inline::Perl5 is circular

method CALL-ME(*@args) {
$.perl5.execute($.ptr, @args);
method CALL-ME(**@args) {
$.perl5.execute($.ptr, |@args);
}

submethod DESTROY {
Expand Down
10 changes: 5 additions & 5 deletions lib/Inline/Perl5/ClassHOW.pm6
View file
Original file line number Diff line number Diff line change
Expand Up @@ -315,7 +315,7 @@ class Inline::Perl5::ClassHOW
nqp::bindattr(self, $?CLASS, '$!composed_repr', nqp::unbox_i(1));
my $has_new = self.add_wrapper_method(type, 'new');
unless $has_new {
self.add_method(type, 'new', my method new(Any \SELF: *@a, *%h) {
self.add_method(type, 'new', my method new(Any \SELF: **@a, *%h) {
my \obj_ref = $p5.interpreter.p5_new_blessed_hashref(SELF.^name);
my \obj = $p5.p5_sv_rv(obj_ref);
$p5.interpreter.p5_sv_refcnt_inc(obj);
Expand Down Expand Up @@ -448,16 +448,16 @@ class Inline::Perl5::ClassHOW
$proto.set_name($name);
$proto does Inline::Perl5::WrapperMethod;

my $many-args := my sub many-args(Any $self, *@args, *%kwargs) {
my $many-args := my sub many-args(Any $self, **@args, *%kwargs) {
$self.defined
?? $p5.invoke-parent($module, $self.wrapped-perl5-object, False, $name, List.new($self, @args.Slip).flat.Array, %kwargs)
!! $p5.invoke($self, $module, $name, |@args.list, |%kwargs)
!! $p5.invoke($self, $module, $name, |@args, |%kwargs)
};
$proto.add_dispatchee($many-args);
my $scalar-many-args := my sub scalar-many-args(Any $self, Scalar:U, *@args, *%kwargs) {
my $scalar-many-args := my sub scalar-many-args(Any $self, Scalar:U, **@args, *%kwargs) {
$self.defined
?? $p5.invoke-parent($module, $self.wrapped-perl5-object, True, $name, [flat $self, |@args], %kwargs)
!! $p5.invoke($self, $module, $name, |@args.list, |%kwargs)
!! $p5.invoke($self, $module, $name, |@args, |%kwargs)
};
$proto.add_dispatchee($many-args);

Expand Down
8 changes: 4 additions & 4 deletions lib/Inline/Perl5/ClassHOW/ThreadSafe.pm6
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,19 +42,19 @@ class Inline::Perl5::ClassHOW::ThreadSafe is Inline::Perl5::ClassHOW {
$proto.set_name($name);
$proto does Inline::Perl5::WrapperMethod;

my $many-args := my sub many-args(Any $self, *@args, *%kwargs) {
my $many-args := my sub many-args(Any $self, **@args, *%kwargs) {
$gil.protect: {
$self.defined
?? $self.inline-perl5.invoke-parent($module, $self.wrapped-perl5-object, False, $name, List.new($self, @args.Slip).flat.Array, %kwargs)
!! $*p5.invoke($self, $module, $name, |@args.list, |%kwargs)
!! $*p5.invoke($self, $module, $name, |@args, |%kwargs)
}
};
$proto.add_dispatchee($many-args);
my $scalar-many-args := my sub scalar-many-args(Any $self, Scalar:U, *@args, *%kwargs) {
my $scalar-many-args := my sub scalar-many-args(Any $self, Scalar:U, **@args, *%kwargs) {
$gil.protect: {
$self.defined
?? $self.inline-perl5.invoke-parent($module, $self.wrapped-perl5-object, True, $name, [flat $self, |@args], %kwargs)
!! $*p5.invoke($self, $module, $name, |@args.list, |%kwargs)
!! $*p5.invoke($self, $module, $name, |@args, |%kwargs)
}
};
$proto.add_dispatchee($many-args);
Expand Down
2 changes: 1 addition & 1 deletion lib/Inline/Perl5/Hash.pm6
View file
Original file line number Diff line number Diff line change
Expand Up @@ -89,7 +89,7 @@ class Inline::Perl5::Hash does Iterable does Associative {
method Capture() {
self.Hash.Capture
}
method push(*@new) {
method push(**@new) {
self.Hash.push(|@new)
}
method append(+@values) {
Expand Down
2 changes: 1 addition & 1 deletion t/call.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -155,7 +155,7 @@ else {
say "not ok 10 - Any converted to undef";
}

if ($p5.call('test_hash', 'main', $({a => 2, b => {c => [4, 3]}})) == 1) {
if ($p5.call('test_hash', 'main', {a => 2, b => {c => [4, 3]}}) == 1) {
say "ok 11 - Passing hashes to Perl 5";
}
else {
Expand Down
2 changes: 1 addition & 1 deletion t/callables.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ is $p5.call('call_something', &something, 6), 'Perl 6';
is $p5.call('return_code', 'Perl')(5), 'Perl 5';
my $sub = $p5.call('return_code', 'Foo');
is $p5.call('call_something', $sub, 1), 'Foo 1';
is($p5.call('return_array_checker')([1, 2, 3].item), 3);
is($p5.call('return_array_checker')([1, 2, 3]), 3);
my &callable := $p5.call('return_code', 'Foo');

# vim: ft=perl6
1 change: 1 addition & 0 deletions t/from.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ is(P5Import::p5_ok(1), 1);
is(p5_ok(1), 1, "importing subs works");
is(p5_ok2(1), 1, "importing manually created subs works");
is(P5Import::import_called(), 1);
ok(p5_hash_ok({a => 1}), "passing a hash to imported sub works");

my $i = 0;
for 1, 2 {
Expand Down
9 changes: 7 additions & 2 deletions t/lib/P5Import.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ package P5Import;
require Exporter;

our @ISA = qw(Exporter);
our @EXPORT = qw(&p5_ok);
our @EXPORT = qw(&p5_ok &p5_hash_ok);

my $import_called = 0;

Expand All @@ -12,7 +12,7 @@ sub import {
$import_called = 1;
my ( $caller, $script ) = caller;
*{"${caller}::p5_ok2"} = \&p5_ok;
__PACKAGE__->export_to_level(1, $self, qw(p5_ok));
__PACKAGE__->export_to_level(1, $self, qw(p5_ok p5_hash_ok));
}

sub p5_ok {
Expand All @@ -23,4 +23,9 @@ sub import_called {
return $import_called;
}

sub p5_hash_ok {
my ($h) = @_;
return ref($h) eq 'HASH' && $h->{a} == 1;
}

1;
2 changes: 1 addition & 1 deletion t/modify_array.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ my $array = array-creator(sub (@array) {
for @array {
ok($_);
}
for @array.list {

This comment has been minimized.

Sign in to view

Copy link
@b2gills

b2gills Jun 8, 2021

Was this a search and replace error?

If not this entire for loop should be removed.
for @array {
ok($_);
}
for @array.pairs {
Expand Down
2 changes: 1 addition & 1 deletion t/p6_to_p5.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -84,7 +84,7 @@ $p5.run(q/
}
/);

ok($p5.call('is_hash_ref', Map.new((a => 1)).item), 'Map arrives as a HashRef');
ok($p5.call('is_hash_ref', Map.new((a => 1))), 'Map arrives as a HashRef');

$p5.run(q/
use warnings;
Expand Down
4 changes: 2 additions & 2 deletions t/perl5package.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,15 +11,15 @@ use TestPerl5Package:from<Perl5>;
ok(TestPerl5Package.take_string('a string'));
ok(TestPerl5Package.take_strings('first string', 'second string'));
ok(TestPerl5Package.take_array($['a string']));
ok(TestPerl5Package.take_hash(${a => 'a string'}));
ok(TestPerl5Package.take_hash({a => 'a string'}));

use TestPerl5Package::Sub:from<Perl5>;

# test FALLBACK
ok(TestPerl5Package::Sub.take_string('a string'));
ok(TestPerl5Package::Sub.take_strings('first string', 'second string'));
ok(TestPerl5Package::Sub.take_array($['a string']));
ok(TestPerl5Package::Sub.take_hash(${a => 'a string'}));
ok(TestPerl5Package::Sub.take_hash({a => 'a string'}));

done-testing;

Expand Down
4 changes: 2 additions & 2 deletions t/use.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,9 +18,9 @@ BEGIN {

use Data::Dumper:from<Perl5>;

my $dumper = Data::Dumper.new([1, 2].item);
my $dumper = Data::Dumper.new([1, 2]);
Test::More::is($dumper.Dump.Str, "\$VAR1 = 1;\n \$VAR2 = 2;\n", 'constructor works');
Test::More::is(Data::Dumper.Dump([1, 2].item).Str, "\$VAR1 = 1;\n \$VAR2 = 2;\n", 'package methods work');
Test::More::is(Data::Dumper.Dump([1, 2]).Str, "\$VAR1 = 1;\n \$VAR2 = 2;\n", 'package methods work');

# Should be safe to load a module more than once.
$p5.use('Test::More');
Expand Down

0 comments on commit bb81304

Please sign in to comment.