From 2b0aabfea0d45947ef0a9a9eccc7866367559e4c Mon Sep 17 00:00:00 2001
From: "Jonathan \"Duke\" Leto" <jonathan@leto.net>
Date: Thu, 9 Sep 2010 12:09:12 -0700
Subject: [PATCH] Allow Perl 6 Grammars as return values of stored procedures

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.
---
 plparrot.c        | 11 ++++++++++-
 t/sql/plperl6.sql | 17 +++++++++++------
 2 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/plparrot.c b/plparrot.c
index 66c2df2..1926584 100644
--- a/plparrot.c
+++ b/plparrot.c
@@ -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
@@ -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;
     }
 }
 
diff --git a/t/sql/plperl6.sql b/t/sql/plperl6.sql
index b4bb88f..8f4ee51 100644
--- a/t/sql/plperl6.sql
+++ b/t/sql/plperl6.sql
@@ -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 }
@@ -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+ }
@@ -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;
 
@@ -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');