Keyword-Simple-0.04/0000755000175000017500000000000013154474525013310 5ustar maukemaukeKeyword-Simple-0.04/Makefile_PL_settings.plx0000644000175000017500000000110513154340310020042 0ustar maukemaukeuse strict; use warnings; return { NAME => 'Keyword::Simple', AUTHOR => q{Lukas Mai }, MIN_PERL_VERSION => '5.12.0', CONFIGURE_REQUIRES => {}, BUILD_REQUIRES => {}, TEST_REQUIRES => { 'strict' => 0, 'Test::More' => 0, }, PREREQ_PM => { 'Carp' => 0, 'XSLoader' => 0, 'warnings' => 0, }, DEVELOP_REQUIRES => { 'Test::Pod' => 1.22, }, depend => { Makefile => '$(VERSION_FROM)' }, REPOSITORY => [ github => 'mauke' ], }; Keyword-Simple-0.04/README0000644000175000017500000000226613154474525014176 0ustar maukemaukeNAME Keyword::Simple - define new keywords in pure Perl INSTALLATION To download and install this module, use your favorite CPAN client, e.g. "cpan": cpan Keyword::Simple Or "cpanm": cpanm Keyword::Simple To do it manually, run the following commands (after downloading and unpacking the tarball): perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the "perldoc" command. perldoc Keyword::Simple You can also look for information at . To see a list of open bugs, visit . To report a new bug, send an email to "bug-Keyword-Simple [at] rt.cpan.org". COPYRIGHT & LICENSE Copyright (C) 2012, 2013 Lukas Mai. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. Keyword-Simple-0.04/Changes0000644000175000017500000000065213154474333014603 0ustar maukemaukeRevision history for Keyword-Simple 0.04 2017-09-08 - Fix crash when using keywords in string eval (RT #122983). - Document that keywords are broken in s//.../e. 0.03 2014-10-19 - Add note to POD about requiring perl v5.12. 0.02 2013-09-27 - Fix line number bug (line numbers off by one after keyword). 0.01 2012-12-02 First version, released on an unsuspecting world. Keyword-Simple-0.04/lib/0000755000175000017500000000000013154474523014054 5ustar maukemaukeKeyword-Simple-0.04/lib/Keyword/0000755000175000017500000000000013154474523015500 5ustar maukemaukeKeyword-Simple-0.04/lib/Keyword/Simple.pm0000644000175000017500000001070513154474256017275 0ustar maukemaukepackage Keyword::Simple; use v5.12.0; use warnings; use Carp qw(croak); use XSLoader; BEGIN { our $VERSION = '0.04'; XSLoader::load __PACKAGE__, $VERSION; } sub define { my ($kw, $sub) = @_; $kw =~ /^\p{XIDS}\p{XIDC}*\z/ or croak "'$kw' doesn't look like an identifier"; ref($sub) eq 'CODE' or croak "'$sub' doesn't look like a coderef"; my %keywords = %{$^H{+HINTK_KEYWORDS} // {}}; $keywords{$kw} = $sub; $^H{+HINTK_KEYWORDS} = \%keywords; } sub undefine { my ($kw) = @_; $kw =~ /^\p{XIDS}\p{XIDC}*\z/ or croak "'$kw' doesn't look like an identifier"; my %keywords = %{$^H{+HINTK_KEYWORDS} // {}}; delete $keywords{$kw}; $^H{+HINTK_KEYWORDS} = \%keywords; } 'ok' __END__ =encoding UTF-8 =for highlighter language=perl =head1 NAME Keyword::Simple - define new keywords in pure Perl =head1 SYNOPSIS package Some::Module; use Keyword::Simple; sub import { # create keyword 'provided', expand it to 'if' at parse time Keyword::Simple::define 'provided', sub { my ($ref) = @_; substr($$ref, 0, 0) = 'if'; # inject 'if' at beginning of parse buffer }; } sub unimport { # lexically disable keyword again Keyword::Simple::undefine 'provided'; } 'ok' =head1 DESCRIPTION Warning: This module is still new and experimental. The API may change in future versions. The code may be buggy. This module lets you implement new keywords in pure Perl. To do this, you need to write a module and call L|/Keyword::Simple::define> in your C method. Any keywords defined this way will be available in the lexical scope that's currently being compiled. =head2 Functions =over =item C Takes two arguments, the name of a keyword and a coderef. Injects the keyword in the lexical scope currently being compiled. For every occurrence of the keyword, your coderef will be called with one argument: A reference to a scalar holding the rest of the source code (following the keyword). You can modify this scalar in any way you like and after your coderef returns, perl will continue parsing from that scalar as if its contents had been the real source code in the first place. =item C Takes one argument, the name of a keyword. Disables that keyword in the lexical scope that's currently being compiled. You can call this from your C method to make the C syntax work. =back =head1 BUGS AND LIMITATIONS This module depends on the L API introduced in perl 5.12. Older versions of perl are not supported. Every new keyword is actually a complete statement by itself. The parsing magic only happens afterwards. This means that e.g. the code in the L actually does this: provided ($foo > 2) { ... } # expands to ; if ($foo > 2) { ... } The C<;> represents a no-op statement, the C was injected by the Perl code, and the rest of the file is unchanged. This also means your new keywords can only occur at the beginning of a statement, not embedded in an expression. Keywords in the replacement part of a C substitution aren't handled correctly and break parsing. There are barely any tests. =begin :README =head1 INSTALLATION To download and install this module, use your favorite CPAN client, e.g. L|cpan>: =for highlighter language=sh cpan Keyword::Simple Or L|cpanm>: cpanm Keyword::Simple To do it manually, run the following commands (after downloading and unpacking the tarball): perl Makefile.PL make make test make install =end :README =head1 SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the L|perldoc> command. =for highlighter language=sh perldoc Keyword::Simple You can also look for information at L. To see a list of open bugs, visit L. To report a new bug, send an email to C. =head1 AUTHOR Lukas Mai, C<< >> =head1 COPYRIGHT & LICENSE Copyright (C) 2012, 2013 Lukas Mai. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =cut Keyword-Simple-0.04/Simple.xs0000644000175000017500000001507513154456600015117 0ustar maukemauke/* Copyright 2012, 2013, 2017 Lukas Mai. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. */ #ifdef __GNUC__ #if __GNUC__ >= 5 #define IF_HAVE_GCC_5(X) X #endif #if (__GNUC__ == 4 && __GNUC_MINOR__ >= 6) || __GNUC__ >= 5 #define PRAGMA_GCC_(X) _Pragma(#X) #define PRAGMA_GCC(X) PRAGMA_GCC_(GCC X) #endif #endif #ifndef IF_HAVE_GCC_5 #define IF_HAVE_GCC_5(X) #endif #ifndef PRAGMA_GCC #define PRAGMA_GCC(X) #endif #ifdef DEVEL #define WARNINGS_RESET PRAGMA_GCC(diagnostic pop) #define WARNINGS_ENABLEW(X) PRAGMA_GCC(diagnostic error #X) #define WARNINGS_ENABLE \ WARNINGS_ENABLEW(-Wall) \ WARNINGS_ENABLEW(-Wextra) \ WARNINGS_ENABLEW(-Wundef) \ WARNINGS_ENABLEW(-Wshadow) \ WARNINGS_ENABLEW(-Wbad-function-cast) \ WARNINGS_ENABLEW(-Wcast-align) \ WARNINGS_ENABLEW(-Wwrite-strings) \ WARNINGS_ENABLEW(-Wstrict-prototypes) \ WARNINGS_ENABLEW(-Wmissing-prototypes) \ WARNINGS_ENABLEW(-Winline) \ WARNINGS_ENABLEW(-Wdisabled-optimization) \ IF_HAVE_GCC_5(WARNINGS_ENABLEW(-Wnested-externs)) #else #define WARNINGS_RESET #define WARNINGS_ENABLE #endif #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #include #ifdef DEVEL #undef NDEBUG #endif #include #define HAVE_PERL_VERSION(R, V, S) \ (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) #ifndef STATIC_ASSERT_STMT #if (defined(static_assert) || (defined(__cplusplus) && __cplusplus >= 201103L)) && (!defined(__IBMC__) || __IBMC__ >= 1210) /* static_assert is a macro defined in in C11 or a compiler builtin in C++11. But IBM XL C V11 does not support _Static_assert, no matter what says. */ # define STATIC_ASSERT_DECL(COND) static_assert(COND, #COND) #else /* We use a bit-field instead of an array because gcc accepts 'typedef char x[n]' where n is not a compile-time constant. We want to enforce constantness. */ # define STATIC_ASSERT_2(COND, SUFFIX) \ typedef struct { \ unsigned int _static_assertion_failed_##SUFFIX : (COND) ? 1 : -1; \ } _static_assertion_failed_##SUFFIX PERL_UNUSED_DECL # define STATIC_ASSERT_1(COND, SUFFIX) STATIC_ASSERT_2(COND, SUFFIX) # define STATIC_ASSERT_DECL(COND) STATIC_ASSERT_1(COND, __LINE__) #endif /* We need this wrapper even in C11 because 'case X: static_assert(...);' is an error (static_assert is a declaration, and only statements can have labels). */ #define STATIC_ASSERT_STMT(COND) do { STATIC_ASSERT_DECL(COND); } while (0) #endif WARNINGS_ENABLE #define MY_PKG "Keyword::Simple" #define HINTK_KEYWORDS MY_PKG "/keywords" #ifndef PL_rsfp_filters #define PL_rsfp_filters (PL_parser->rsfp_filters) #endif #ifndef PL_parser_filtered #if HAVE_PERL_VERSION(5, 15, 5) #define PL_parser_filtered (PL_parser->filtered) #else #define PL_parser_filtered 0 #endif #endif static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **); static SV *kw_handler(pTHX_ const char *kw_ptr, STRLEN kw_len) { HV *hints; SV **psv, *sv, *sv2; I32 kw_xlen; /* don't bother doing anything fancy after a syntax error */ if (PL_parser && PL_parser->error_count) { return NULL; } STATIC_ASSERT_STMT(~(STRLEN)0 > (U32)I32_MAX); if (kw_len > (STRLEN)I32_MAX) { return NULL; } if (!(hints = GvHV(PL_hintgv))) { return NULL; } if (!(psv = hv_fetchs(hints, HINTK_KEYWORDS, 0))) { return NULL; } sv = *psv; if (!(SvROK(sv) && (sv2 = SvRV(sv), SvTYPE(sv2) == SVt_PVHV))) { croak("%s: internal error: $^H{'%s'} not a hashref: %"SVf, MY_PKG, HINTK_KEYWORDS, SVfARG(sv)); } kw_xlen = kw_len; if (lex_bufutf8()) { kw_xlen = -kw_xlen; } if (!(psv = hv_fetch((HV *)sv2, kw_ptr, kw_xlen, 0))) { return NULL; } sv = *psv; if (!(SvROK(sv) && (sv2 = SvRV(sv), SvTYPE(sv2) == SVt_PVCV))) { croak("%s: internal error: $^H{'%s'}{'%.*s'} not a coderef: %"SVf, MY_PKG, HINTK_KEYWORDS, (int)kw_len, kw_ptr, SVfARG(sv)); } return sv2; } static I32 playback(pTHX_ int idx, SV *buf, int n) { char *ptr; STRLEN len, d; SV *sv = FILTER_DATA(idx); ptr = SvPV(sv, len); if (!len) { return 0; } if (!n) { char *nl = memchr(ptr, '\n', len); d = nl ? (STRLEN)(nl - ptr + 1) : len; } else { d = n < 0 ? INT_MAX : n; if (d > len) { d = len; } } sv_catpvn(buf, ptr, d); sv_chop(sv, ptr + d); return 1; } static void total_recall(pTHX_ SV *cb) { SV *sv; dSP; ENTER; SAVETMPS; sv = sv_2mortal(newSVpvs("")); if (lex_bufutf8()) { SvUTF8_on(sv); } /* sluuuuuurrrrp */ sv_setpvn(sv, PL_parser->bufptr, PL_parser->bufend - PL_parser->bufptr); lex_unstuff(PL_parser->bufend); /* you saw nothing */ if (PL_parser->rsfp || PL_parser_filtered) { if (!PL_rsfp_filters) { /* because FILTER_READ fails with filters=null but DTRT with filters=[] */ PL_rsfp_filters = newAV(); } while (FILTER_READ(0, sv, 4096) > 0) ; } PUSHMARK(SP); mXPUSHs(newRV_inc(sv)); PUTBACK; call_sv(cb, G_VOID); SPAGAIN; { /* $sv .= "\n" */ char *p; STRLEN n; SvPV_force(sv, n); p = SvGROW(sv, n + 2); p[n] = '\n'; p[n + 1] = '\0'; SvCUR_set(sv, n + 1); } if (PL_parser->rsfp || PL_parser_filtered) { filter_add(playback, SvREFCNT_inc_simple_NN(sv)); CopLINE_dec(PL_curcop); } else { lex_stuff_sv(sv, 0); } FREETMPS; LEAVE; } static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) { SV *cb; if ((cb = kw_handler(aTHX_ keyword_ptr, keyword_len))) { total_recall(aTHX_ cb); *op_ptr = newOP(OP_NULL, 0); return KEYWORD_PLUGIN_STMT; } return next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr); } static void my_boot(pTHX) { HV *const stash = gv_stashpvs(MY_PKG, GV_ADD); newCONSTSUB(stash, "HINTK_KEYWORDS", newSVpvs(HINTK_KEYWORDS)); next_keyword_plugin = PL_keyword_plugin; PL_keyword_plugin = my_keyword_plugin; } WARNINGS_RESET MODULE = Keyword::Simple PACKAGE = Keyword::Simple PROTOTYPES: ENABLE BOOT: my_boot(aTHX); Keyword-Simple-0.04/META.yml0000644000175000017500000000134513154474523014562 0ustar maukemauke--- abstract: 'define new keywords in pure Perl' author: - 'Lukas Mai ' build_requires: Test::More: '0' strict: '0' configure_requires: ExtUtils::MakeMaker: '0' File::Find: '0' File::Spec: '0' strict: '0' warnings: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Keyword-Simple no_index: directory: - t - inc - xt requires: Carp: '0' XSLoader: '0' perl: '5.012000' warnings: '0' resources: repository: git://github.com/mauke/Keyword-Simple version: '0.04' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Keyword-Simple-0.04/xt/0000755000175000017500000000000013154474523013741 5ustar maukemaukeKeyword-Simple-0.04/xt/pod.t0000644000175000017500000000011313154326435014701 0ustar maukemauke#!perl use strict; use warnings; use Test::Pod 1.22; all_pod_files_ok(); Keyword-Simple-0.04/META.json0000644000175000017500000000306513154474524014734 0ustar maukemauke{ "abstract" : "define new keywords in pure Perl", "author" : [ "Lukas Mai " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Keyword-Simple", "no_index" : { "directory" : [ "t", "inc", "xt" ] }, "prereqs" : { "build" : { "requires" : {} }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "File::Find" : "0", "File::Spec" : "0", "strict" : "0", "warnings" : "0" } }, "develop" : { "requires" : { "Pod::Markdown" : "3.005", "Pod::Text" : "4.09", "Test::Pod" : "1.22" } }, "runtime" : { "requires" : { "Carp" : "0", "XSLoader" : "0", "perl" : "5.012000", "warnings" : "0" } }, "test" : { "requires" : { "Test::More" : "0", "strict" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "git://github.com/mauke/Keyword-Simple", "web" : "https://github.com/mauke/Keyword-Simple" } }, "version" : "0.04", "x_serialization_backend" : "JSON::PP version 2.94" } Keyword-Simple-0.04/Makefile.PL0000644000175000017500000001221413154326240015250 0ustar maukemaukeuse strict; use warnings; use ExtUtils::MakeMaker; use File::Spec (); use File::Find (); sub find_tests_recursively_in { my ($dir) = @_; -d $dir or die "$dir is not a directory"; my %seen; my $wanted = sub { /\.t\z/ or return; my $directories = (File::Spec->splitpath($File::Find::name))[1]; my $depth = grep $_ ne '', File::Spec->splitdir($directories); $seen{$depth} = 1; }; File::Find::find($wanted, $dir); join ' ', map { $dir . '/*' x $_ . '.t' } sort { $a <=> $b } keys %seen } $::MAINT_MODE = !-f 'META.yml'; my $settings_file = 'Makefile_PL_settings.plx'; my %settings = %{do "./$settings_file" or die "Internal error: can't do $settings_file: ", $@ || $!}; { $settings{depend}{Makefile} .= " $settings_file"; $settings{LICENSE} ||= 'perl'; $settings{PL_FILES} ||= {}; $settings{CONFIGURE_REQUIRES}{strict} ||= 0; $settings{CONFIGURE_REQUIRES}{warnings} ||= 0; $settings{CONFIGURE_REQUIRES}{'ExtUtils::MakeMaker'} ||= 0; $settings{CONFIGURE_REQUIRES}{'File::Find'} ||= 0; $settings{CONFIGURE_REQUIRES}{'File::Spec'} ||= 0; my $module_file = $settings{NAME}; $module_file =~ s!::!/!g; $module_file = "lib/$module_file.pm"; $settings{VERSION_FROM} ||= $module_file; $settings{ABSTRACT_FROM} ||= $module_file; $settings{test}{TESTS} ||= find_tests_recursively_in 't'; $settings{DISTNAME} ||= do { my $name = $settings{NAME}; $name =~ s!::!-!g; $name }; $settings{clean}{FILES} ||= "$settings{DISTNAME}-*"; $settings{dist}{COMPRESS} ||= 'gzip -9f'; $settings{dist}{SUFFIX} ||= '.gz'; my $version = $settings{VERSION} || MM->parse_version($settings{VERSION_FROM}); if ($version =~ s/-TRIAL[0-9]*\z//) { $settings{META_MERGE}{release_status} ||= 'unstable'; $settings{META_MERGE}{version} ||= $version; $settings{XS_VERSION} ||= $version; } $settings{META_MERGE}{'meta-spec'}{version} ||= 2; $settings{META_MERGE}{dynamic_config} ||= 0; push @{$settings{META_MERGE}{no_index}{directory}}, 'xt'; if (my $dev = delete $settings{DEVELOP_REQUIRES}) { @{$settings{META_MERGE}{prereqs}{develop}{requires}}{keys %$dev} = values %$dev; } if (my $rec = delete $settings{RECOMMENDS}) { @{$settings{META_MERGE}{prereqs}{runtime}{recommends}}{keys %$rec} = values %$rec; } if (my $sug = delete $settings{SUGGESTS}) { @{$settings{META_MERGE}{prereqs}{runtime}{suggests}}{keys %$sug} = values %$sug; } if (my $repo = delete $settings{REPOSITORY}) { if (ref($repo) eq 'ARRAY') { my ($type, @args) = @$repo; if ($type eq 'github') { my ($account, $project) = @args; $project ||= '%d'; $project =~ s{%(L?)(.)}{ my $x = $2 eq '%' ? '%' : $2 eq 'd' ? $settings{DISTNAME} : $2 eq 'm' ? $settings{NAME} : die "Internal error: unknown placeholder %$1$2"; $1 ? lc($x) : $x }seg; my $addr = "github.com/$account/$project"; $repo = { type => 'git', url => "git://$addr", web => "https://$addr", }; } else { die "Internal error: unknown REPOSITORY type '$type'"; } } ref($repo) eq 'HASH' or die "Internal error: REPOSITORY must be a hashref, not $repo"; @{$settings{META_MERGE}{resources}{repository}}{keys %$repo} = values %$repo; } } (do './maint/eumm-fixup.pl' || die $@ || $!)->(\%settings) if $::MAINT_MODE; (my $mm_version = ExtUtils::MakeMaker->VERSION) =~ tr/_//d; if ($mm_version < 6.63_03) { $settings{META_MERGE}{resources}{repository} = $settings{META_MERGE}{resources}{repository}{url} if $settings{META_MERGE}{resources} && $settings{META_MERGE}{resources}{repository} && $settings{META_MERGE}{resources}{repository}{url}; delete $settings{META_MERGE}{'meta-spec'}{version}; } elsif ($mm_version < 6.67_04) { # Why? For the glory of satan, of course! no warnings qw(redefine); *ExtUtils::MM_Any::_add_requirements_to_meta_v1_4 = \&ExtUtils::MM_Any::_add_requirements_to_meta_v2; } { my $merge_key_into = sub { my ($target, $source) = @_; %{$settings{$target}} = (%{$settings{$target}}, %{delete $settings{$source}}); }; $merge_key_into->('BUILD_REQUIRES', 'TEST_REQUIRES') if $mm_version < 6.63_03; $merge_key_into->('CONFIGURE_REQUIRES', 'BUILD_REQUIRES') if $mm_version < 6.55_01; $merge_key_into->('PREREQ_PM', 'CONFIGURE_REQUIRES') if $mm_version < 6.51_03; } delete $settings{MIN_PERL_VERSION} if $mm_version < 6.47_01; delete $settings{META_MERGE} if $mm_version < 6.46; delete $settings{LICENSE} if $mm_version < 6.30_01; delete $settings{ABSTRACT_FROM} if $mm_version < 6.06_03; delete $settings{AUTHOR} if $mm_version < 6.06_03; WriteMakefile %settings; Keyword-Simple-0.04/MANIFEST0000644000175000017500000000065213154474525014444 0ustar maukemaukeChanges lib/Keyword/Simple.pm Makefile.PL Makefile_PL_settings.plx MANIFEST MANIFEST.SKIP Simple.xs t/00-load.t t/basic.t t/eval.t t/lineno.t xt/pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README generated from Keyword::Simple POD (added by maint/eumm-fixup.pl) Keyword-Simple-0.04/t/0000755000175000017500000000000013154474523013551 5ustar maukemaukeKeyword-Simple-0.04/t/00-load.t0000644000175000017500000000026212420742032015056 0ustar maukemauke#!perl use Test::More tests => 1; BEGIN { use_ok( 'Keyword::Simple' ) || print "Bail out!\n"; } diag( "Testing Keyword::Simple $Keyword::Simple::VERSION, Perl $], $^X" ); Keyword-Simple-0.04/t/lineno.t0000644000175000017500000000117313154325632015220 0ustar maukemauke#!perl use strict; use warnings FATAL => 'all'; use Test::More tests => 6; BEGIN { package Some::Module; use Keyword::Simple; sub import { Keyword::Simple::define 'provided', sub { my ($ref) = @_; substr($$ref, 0, 0) = 'if'; }; } sub unimport { Keyword::Simple::undefine 'provided'; } $INC{'Some/Module.pm'} = __FILE__; }; use Some::Module; provided (1) { is(__LINE__, 25); } #line 1 provided(1){is __LINE__, 1;} is __LINE__, 2; provided #line 1 (1) { is __LINE__, 1; } is __LINE__, 2; provided (2) { provided (3) { is __LINE__, 5; } } Keyword-Simple-0.04/t/basic.t0000644000175000017500000000063013154325626015015 0ustar maukemauke#!perl use warnings FATAL => 'all'; use strict; use Test::More tests => 2; { package Foo; use Keyword::Simple; sub import { Keyword::Simple::define peek => sub { substr ${$_[0]}, 0, 0, "ok 1, 'synthetic test';"; }; } sub unimport { Keyword::Simple::undefine 'peek'; } BEGIN { $INC{"Foo.pm"} = 1; } } use Foo; peek ok 1, "natural test"; Keyword-Simple-0.04/t/eval.t0000644000175000017500000000175313154471117014667 0ustar maukemauke#!perl use strict; use warnings FATAL => 'all'; no warnings 'once'; use Test::More; { package Foo; use Keyword::Simple; sub import { Keyword::Simple::define class => sub { substr ${$_[0]}, 0, 0, "package"; }; } sub unimport { Keyword::Simple::undefine 'peek'; } BEGIN { $INC{"Foo.pm"} = 1; } } use Foo; { class Gpkg0; our $v = __PACKAGE__; } is $Gpkg0::v, 'Gpkg0'; eval q{ class Gpkg1; our $v = __PACKAGE__ }; is $@, ''; is $Gpkg1::v, 'Gpkg1'; SKIP: { skip "evalbytes() requires v5.16", 3 if $^V lt v5.16; my $err; eval q{ use v5.16; evalbytes q{ class Gpkg2; our $v = __PACKAGE__ }; $err = $@; }; is $@, ''; is $err, ''; is $Gpkg2::v, 'Gpkg2'; } TODO: { local $TODO = 's//.../e handling is broken'; my $str = ''; eval q{ $str =~ s/^/ class Gpkg3; our $v = __PACKAGE__ /e }; is $@, ''; is $str, 'Gpkg3'; is $Gpkg3::v, 'Gpkg3'; } done_testing; Keyword-Simple-0.04/MANIFEST.SKIP0000644000175000017500000000027313154326336015204 0ustar maukemauke\.tar\.gz$ ^Build$ ^Keyword-Simple- ^MANIFEST\.(?!SKIP$) ^MYMETA\. ^Makefile$ ^Makefile\.old$ ^Simple\.(?:[iocs]|bs)$ ^\. ^_build ^blib ^cover_db$ ^pm_to_blib ^remote$ ^untracked ^maint/