Navigation Menu

Skip to content

Commit

Permalink
Allow Perl 6 Grammars as return values of stored procedures
Browse files Browse the repository at this point in the history
When defining a global grammar for later use, the return value of the
stored procedure was a Grammar object, which PL/Perl6 did not know how
to convert to a Postgres datatype, so the sausage machine came to a
grinding halt. We catch these and just return a true value instead.

There is currently a bug in Rakudo where Grammar.WHAT is "Code", and
somehow that gets turned into a "Sub", so that was worked around as
well.
  • Loading branch information
leto committed Sep 9, 2010
1 parent f759d4b commit 2b0aabf
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 7 deletions.
11 changes: 10 additions & 1 deletion plparrot.c
Expand Up @@ -566,6 +566,16 @@ plparrot_make_sausage(Parrot_Interp interp, Parrot_PMC pmc, FunctionCallInfo fci
return Float8GetDatum(Parrot_PMC_get_number(interp,pmc));
} else if (PMC_ISA(pmc,"Rat")) {
return Float8GetDatum(Parrot_PMC_get_number(interp,pmc));
/* Rakudo currently has a bug where a grammar returns Code for .WHAT */
/* Somehow this becomes a Sub */
} else if (PMC_ISA(pmc,"Grammar")
|| PMC_ISA(pmc,"Code") || PMC_ISA(pmc,"Sub") ) {
/*
Converting a grammar to a Datum doesn't make sense, just return a true value.
This happens when we define a grammar in a stored procedure and it ends up
being the return value
*/
return (Datum) 1;
} else if (PMC_ISA(pmc,"Nil")
/* XXX: TODO should check for an empty Parcel */
/* This should only have to check Any, but Rakudo
Expand All @@ -578,7 +588,6 @@ plparrot_make_sausage(Parrot_Interp interp, Parrot_PMC pmc, FunctionCallInfo fci
elog(ERROR, "CANNOT MAKE Parcel INTO SAUSAGE");
} else {
elog(ERROR,"CANNOT MAKE SAUSAGE");
return (Datum) 0;
}
}

Expand Down
17 changes: 11 additions & 6 deletions t/sql/plperl6.sql
Expand Up @@ -15,7 +15,7 @@ BEGIN;
\i plparrot.sql

-- Plan the tests.
SELECT plan(26);
SELECT plan(28);

CREATE OR REPLACE FUNCTION test_void_plperl6() RETURNS void LANGUAGE plperl6 AS $$
{ Nil }
Expand Down Expand Up @@ -121,7 +121,7 @@ CREATE OR REPLACE FUNCTION test_global_grammar(text) RETURNS integer LANGUAGE pl
}
$q$;

CREATE OR REPLACE FUNCTION load_global_grammar() RETURNS void LANGUAGE plperl6 AS $q$
CREATE OR REPLACE FUNCTION load_global_grammar() RETURNS integer LANGUAGE plperl6 AS $q$
{
grammar Inventory {
regex product { \d+ }
Expand All @@ -136,12 +136,15 @@ CREATE OR REPLACE FUNCTION load_global_grammar() RETURNS void LANGUAGE plperl6 A
$$
}
};
# This is needed becaues PL/Parrot does not know how to
# cope with a grammar as a return value
return 1;
}
$q$;

CREATE OR REPLACE FUNCTION test_return_grammar() RETURNS integer LANGUAGE plperl6 AS $$
{
return Grammar;
}
$$;

CREATE OR REPLACE FUNCTION test_string_plperl6() RETURNS varchar AS $$
{ "rakudo" } $$ LANGUAGE plperl6;

Expand Down Expand Up @@ -176,8 +179,10 @@ select is(test_grammar('123 456 red balloon'), 1, 'test a string that parses in
select is(test_grammar('123 456 balloons (red)'), 1, 'test a string that parses in the Inventory grammar');
select is(test_grammar(''), 0, 'empty string should not parse in the Inventory grammar');

select is(test_return_grammar(), 1, 'returning an empty Grammar works');

-- load the Inventory grammar into package scope
select load_global_grammar();
select is(load_global_grammar(), 1, 'loading a grammar returns 1');

select is(test_global_grammar('some junk'), 0, 'test a string that does not parse in the global Inventory grammar');
select is(test_global_grammar('123 456 red balloon'), 1, 'test a string that parses in the global Inventory grammar');
Expand Down

0 comments on commit 2b0aabf

Please sign in to comment.