From 46f89f90a5eb4b8f298d5511d4f92569bc79c87e Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Tue, 22 Oct 2013 01:52:06 -0400
Subject: start fiddling around

---
 CompleteStatement.xs           | 130 +++++++++++++++++++++++++++++++++++++++++
 lib/Devel/CompleteStatement.pm |  13 +++++
 t/basic.t                      |  14 +++++
 3 files changed, 157 insertions(+)
 create mode 100644 CompleteStatement.xs
 create mode 100644 t/basic.t

diff --git a/CompleteStatement.xs b/CompleteStatement.xs
new file mode 100644
index 0000000..aee013a
--- /dev/null
+++ b/CompleteStatement.xs
@@ -0,0 +1,130 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+static BHK my_hooks;
+static int depth;
+
+static void
+my_start_hook(pTHX_ int full)
+{
+    ++depth;
+}
+
+static void
+my_end_hook(pTHX_ OP **o)
+{
+    --depth;
+}
+
+static void
+reset_block_hooks(pTHX_ void *p)
+{
+    BhkDISABLE(&my_hooks, bhk_start);
+    BhkDISABLE(&my_hooks, bhk_pre_end);
+}
+
+static void
+call_parse()
+{
+    dSP;
+
+    ENTER;
+    PUSHMARK(SP);
+    call_pv("Devel::CompleteStatement::_call_parse", G_DISCARD);
+    LEAVE;
+}
+
+MODULE = Devel::CompleteStatement  PACKAGE = Devel::CompleteStatement
+
+PROTOTYPES: DISABLE
+
+void
+_parse()
+  PREINIT:
+    OP *o;
+  CODE:
+    ENTER;
+
+    SAVEI8(PL_in_eval);
+    PL_in_eval = EVAL_INEVAL;
+
+    if (o = parse_stmtseq(0))
+        op_free(o);
+
+    LEAVE;
+
+int
+complete_statement(str)
+    SV *str
+  PREINIT:
+    CV *evalcv;
+  CODE:
+    ENTER;
+    SAVETMPS;
+    SAVEDESTRUCTOR_X(reset_block_hooks, NULL);
+
+    /* most of this copied from Parse::Perl */
+
+    /* populate PL_compiling and related state */
+    SAVECOPFILE_FREE(&PL_compiling);
+    {
+        char filename[TYPE_DIGITS(long) + 10];
+        sprintf(filename, "(eval %lu)", (unsigned long)++PL_evalseq);
+        CopFILE_set(&PL_compiling, filename);
+    }
+    SAVECOPLINE(&PL_compiling);
+    CopLINE_set(&PL_compiling, 1);
+    SAVEI32(PL_subline);
+    PL_subline = 1;
+    save_item(PL_curstname);
+    sv_setpv(PL_curstname,
+            !PL_curstash ? "<none>" : HvNAME_get(PL_curstash));
+    SAVECOPSTASH_FREE(&PL_compiling);
+    CopSTASH_set(&PL_compiling, PL_curstash);
+
+    SAVECOMPILEWARNINGS();
+
+    PL_hints |= HINT_LOCALIZE_HH;
+    SAVEHINTS();
+        HINT_BLOCK_SCOPE;
+
+    SAVEI32(PL_compiling.cop_hints);
+    PL_compiling.cop_hints = PL_hints;
+
+    SAVEVPTR(PL_curcop);
+    PL_curcop = &PL_compiling;
+    /* initialise PL_compcv and related state */
+    SAVEGENERICSV(PL_compcv);
+    PL_compcv = (CV*)newSV_type(SVt_PVCV);
+    CvANON_on(PL_compcv);
+    CvOUTSIDE(PL_compcv) = NULL;
+    CvOUTSIDE_SEQ(PL_compcv) = 0;
+    CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
+    /* initialise other parser state */
+    SAVEOP();
+    PL_op = NULL;
+    SAVEGENERICSV(PL_beginav);
+    PL_beginav = newAV();
+    SAVEGENERICSV(PL_unitcheckav);
+    PL_unitcheckav = newAV();
+    lex_start(str, NULL, 0);
+
+    depth = 0;
+    BhkENABLE(&my_hooks, bhk_start);
+    BhkENABLE(&my_hooks, bhk_pre_end);
+
+    call_parse();
+
+    RETVAL = (depth == 0);
+
+    FREETMPS;
+    LEAVE;
+  OUTPUT:
+    RETVAL
+
+BOOT:
+    BhkENTRY_set(&my_hooks, bhk_start, my_start_hook);
+    BhkENTRY_set(&my_hooks, bhk_pre_end, my_end_hook);
+    Perl_blockhook_register(aTHX_ &my_hooks);
+    reset_block_hooks(aTHX_ NULL);
diff --git a/lib/Devel/CompleteStatement.pm b/lib/Devel/CompleteStatement.pm
index e69de29..15cc867 100644
--- a/lib/Devel/CompleteStatement.pm
+++ b/lib/Devel/CompleteStatement.pm
@@ -0,0 +1,13 @@
+package Devel::CompleteStatement;
+use strict;
+use warnings;
+# ABSTRACT: foo
+
+use XSLoader;
+XSLoader::load;
+
+sub _call_parse {
+    eval { _parse() };
+}
+
+1;
diff --git a/t/basic.t b/t/basic.t
new file mode 100644
index 0000000..825017e
--- /dev/null
+++ b/t/basic.t
@@ -0,0 +1,14 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Devel::CompleteStatement;
+
+ok(Devel::CompleteStatement::complete_statement('if ($x) { $y }'));
+ok(!Devel::CompleteStatement::complete_statement('if ($x) { $y'));
+
+ok(Devel::CompleteStatement::complete_statement('if ($x) { BEGIN { die } }'));
+ok(!Devel::CompleteStatement::complete_statement('if ($x) { BEGIN { die }'));
+
+done_testing;
-- 
cgit v1.2.3