Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

This commit makes Parrot's GC a sad puppy

This commit generates a stack trace of ~270k frames. The first 200
frames can be found at http://gist.github.com/528817
  • Loading branch information...
commit 1304847e507a2017323a29f8d29a2e4b7469a51d 1 parent aa265eb
@leto authored
Showing with 34 additions and 17 deletions.
  1. +17 −6 plperl6.pir
  2. +17 −11 t/sql/plperl6.sql
View
23 plperl6.pir
@@ -1,11 +1,12 @@
.sub run
.param string code
.param pmc args :slurpy
+ .local pmc perl6_args
- args = convert_to_perl6_parcel(args)
+ perl6_args = convert_to_perl6_parcel(args)
.local string wrap_start, wrap_end
- wrap_start = "eval q<<< sub (@_) {"
- wrap_end = "} >>>"
+ wrap_start = "eval q<<< sub "
+ wrap_end = " >>>"
code = wrap_start . code
code .= wrap_end
load_bytecode 'dumper.pbc'
@@ -16,15 +17,20 @@
compiler = compreg "perl6"
function = compiler.'compile'(code)
say "args="
- _dumper(args)
+ _dumper(perl6_args)
output = function()
- $P3 = output(args)
+ .local int nullargs
+ nullargs = isnull perl6_args
+ if nullargs goto call_with_empty_args
+ $P3 = output(perl6_args)
+ call_with_empty_args:
+ $P3 = output()
$I0 = isa $P3, "Block"
unless $I0 goto done
# the output of running the function returned a Block,
# such as a pointy block -> $a, $b { }, so let's go ahead
# and execute that
- $P3 = $P3(args)
+ $P3 = $P3(perl6_args)
done:
print "code returned: "
_dumper($P3)
@@ -36,6 +42,8 @@
.param pmc parrot_array
.local pmc arrayizer, perl6_parcel
+ unless parrot_array goto empty
+
# the infix comma operator, which creates Parcels from scalars
arrayizer = get_root_global ['perl6'], '&infix:<,>'
unless arrayizer goto error
@@ -45,4 +53,7 @@
.return(perl6_parcel)
error:
die "Could not turn Parrot array into a Perl 6 Parcel!"
+ empty:
+ say "EMTPY!"
+ .return()
.end
View
28 t/sql/plperl6.sql
@@ -18,32 +18,34 @@ BEGIN;
SELECT plan(13);
CREATE OR REPLACE FUNCTION test_void_plperl6() RETURNS void LANGUAGE plperl6 AS $$
-Nil
+() { Nil }
$$;
CREATE OR REPLACE FUNCTION test_int_plperl6() RETURNS int LANGUAGE plperl6 AS $$
-42
+() { 42 }
$$;
CREATE OR REPLACE FUNCTION test_arguments_plperl6(integer) RETURNS int LANGUAGE plperl6 AS $$
-@_[0]
+{ @_[0] }
$$;
CREATE OR REPLACE FUNCTION test_defined_plperl6(integer) RETURNS int LANGUAGE plperl6 AS $$
-@_[0].defined
+{ @_[0].defined }
$$;
CREATE OR REPLACE FUNCTION test_defined_plperl6() RETURNS int LANGUAGE plperl6 AS $$
-@_[0].defined
+{ @_[0].defined }
$$;
CREATE OR REPLACE FUNCTION test_2arguments_plperl6(integer,integer) RETURNS int LANGUAGE plperl6 AS $$
-@_.elems
+{ @_.elems }
$$;
CREATE OR REPLACE FUNCTION test_fibonacci_plperl6(integer) RETURNS int LANGUAGE plperl6 AS $$
-my $limit = @_[0];
-[+] (1, 1, *+* ... $limit)
+{
+ my $limit = @_[0];
+ [+] (1, 1, *+* ... $limit)
+}
$$;
CREATE OR REPLACE FUNCTION test_pointy_fibonacci_plperl6(integer) RETURNS int LANGUAGE plperl6 AS $$
@@ -58,11 +60,15 @@ CREATE OR REPLACE FUNCTION test_named_pointy(integer, integer, integer) RETURNS
}(|@_);
$$;
-CREATE OR REPLACE FUNCTION test_float_plperl6() RETURNS float AS $$ 5.0 $$ LANGUAGE plperl6;
+CREATE OR REPLACE FUNCTION test_float_plperl6() RETURNS float AS $$
+{ 5.0 }
+$$ LANGUAGE plperl6;
-CREATE OR REPLACE FUNCTION test_string_plperl6() RETURNS varchar AS $$ "rakudo" $$ LANGUAGE plperl6;
+CREATE OR REPLACE FUNCTION test_string_plperl6() RETURNS varchar AS $$
+{ "rakudo" } $$ LANGUAGE plperl6;
-CREATE OR REPLACE FUNCTION test_singlequote_plperl6() RETURNS varchar AS $$ 'rakudo*' $$ LANGUAGE plperl6;
+CREATE OR REPLACE FUNCTION test_singlequote_plperl6() RETURNS varchar AS $$
+{ 'rakudo*' } $$ LANGUAGE plperl6;
select is(test_int_plperl6(),42,'Return an integer from PL/Perl6');
select is(test_void_plperl6()::text,''::text,'Return nothing from PL/Perl6');
Please sign in to comment.
Something went wrong with that request. Please try again.