implemented and tested &eval_fragment

pmurias · Aug 6, 2010 · 744984d · 744984d
1 parent 62f59f7
commit 744984d
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 35 deletions.
diff --git a/lib/Devel/EvalFragment.pm b/lib/Devel/EvalFragment.pm
@@ -12,20 +12,29 @@ Devel::EvalFragment - eval perl fragments till }
 
 package Devel::EvalFragment;
 
-{ use 5.011002; }
+ use 5.011002; 
 use warnings;
 use strict;
 
+use Exporter qw(import);
+our @EXPORT = qw(eval_fragment);
 use B::Hooks::EndOfScope 0.05 ();
 
 our $VERSION = "0.000";
 
+sub eval_fragment {
+    my ($code) = @_;
+    my $skipped;
+    eval("{BEGIN {B::Hooks::EndOfScope::on_scope_end { \$skipped = Devel::EvalFragment::stop_the_parse()}}\n".$code);
+    die if $@;
+    my $executed = length($code)-$skipped+2;
+    return $executed;
+}
+
 require XSLoader;
 XSLoader::load(__PACKAGE__, $VERSION);
 
 
-sub import {
-}
 
 
 =head1 SEE ALSO

diff --git a/lib/Devel/EvalFragment.xs b/lib/Devel/EvalFragment.xs
@@ -2,23 +2,19 @@
 #include "perl.h"
 #include "XSUB.h"
 
-#if 1 /* bug #74006 not yet fixed */
-# define lex_stuff_fixup() \
-		SvCUR_set(PL_parser->linestr, \
-			PL_parser->bufend - SvPVX(PL_parser->linestr))
-# define lex_stuff_sv_(sv, flags) \
-		(lex_stuff_sv((sv), (flags)), lex_stuff_fixup())
-# define lex_stuff_pvn_(pv, len, flags) \
-		(lex_stuff_pvn((pv), (len), (flags)), lex_stuff_fixup())
-# define lex_stuff_pvs_(s, flags) \
-		lex_stuff_pvn_((""s""), sizeof(""s"")-1, (flags))
-#endif /* bug #74006 not yet fixed */
+MODULE = Devel::EvalFragment PACKAGE = Devel::EvalFragment
 
-
-MODULE = Devel::EvalFragment PACKAGE = Devel:EvalFragment
-
-void
+int
 stop_the_parse()
 PROTOTYPE: 
 CODE:
-    lex_stuff_pvs_("__END__", 0);
+    int count = 0;
+    int c;
+    while ((c = lex_read_unichar(0)) != -1)
+    {
+        /*printf("skip %c[%c]\n",c,c);*/
+        count++;
+    }
+    RETVAL = count;
+OUTPUT:
+    RETVAL
diff --git a/t/eval_fragment.t b/t/eval_fragment.t
@@ -1,22 +1,18 @@
 use v5.10;
-use Scope::Escape::Sugar;
+use Devel::EvalFragment qw(eval_fragment);
 use B::Hooks::EndOfScope;
 use Test::More;
-
 my ($flag1,$flag2);
-sub eval_fragment {
-    my ($code) = @_;
-    eval("{BEGIN {B::Hooks::EndOfScope::on_scope_end { Scope::Escape::Sugar::stop_the_parse()}}\n".$code);
-    die if $@;
-}
-sub line {
-    my ($file,$sub,$line) = caller(0);
-    $line;
-}
-
-eval_fragment('$flag1 = 42}');
-is $flag1,42,'evaling code works';
-eval_fragment(q[$flag2 = 66};fail("the parse isn't stopped")]);
-is $flag2,66,"the code after the } brace doesn't get run";
 
+eval_fragment('$Devel::EvalFragment::Testing::flag1 = 42}');
+is $Devel::EvalFragment::Testing::flag1,42,'evaling code works';
+eval_fragment(q[$Devel::EvalFragment::Testing::flag2 = 66};fail("the parse isn't stopped")]);
+is $Devel::EvalFragment::Testing::flag2,66,"the code after the } brace doesn't get run";
+sub check {
+    my ($code,$trash) = @_;
+    is(eval_fragment($code.'}'.$trash),length($code)+1,$code.'}'.$trash);
+}
+check '','';
+check '{123}',' dsafdsfdf #$@ dfdf';
+check " #1\n#2\n#3\n","#1\n#2\n#3";
 done_testing;