Permalink
Browse files

implemented and tested &eval_fragment

  • Loading branch information...
1 parent 62f59f7 commit 744984d7d6f9d0ec3bb7306a1b6527fe328d836d @pmurias committed Aug 6, 2010
Showing with 36 additions and 35 deletions.
  1. +12 −3 lib/Devel/EvalFragment.pm
  2. +12 −16 lib/Devel/EvalFragment.xs
  3. +12 −16 t/eval_fragment.t
@@ -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
@@ -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
View
@@ -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;

0 comments on commit 744984d

Please sign in to comment.