Sub-Current-0.02/0000755000175000017500000000000010642706020013047 5ustar rafaelrafaelSub-Current-0.02/t/0000755000175000017500000000000010642706020013312 5ustar rafaelrafaelSub-Current-0.02/t/50pod.t0000644000175000017500000000024310640477471014442 0ustar rafaelrafael#!perl use strict; use warnings; use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Sub-Current-0.02/t/07recurse.t0000644000175000017500000000044610642443072015327 0ustar rafaelrafael#!perl use strict; use warnings; use Test::More tests => 8; use Sub::Current; our $i = 0; sub recurse { if ($i++ < 4) { ok(1, "test i$i"); ROUTINE->(); } } recurse(); sub recurse2 { my $j = shift; if ($j > 0) { ok(1, "test j$j"); ROUTINE->($j - 1); } } recurse2(4); Sub-Current-0.02/t/02specialblocks.t0000644000175000017500000000046610642440754016476 0ustar rafaelrafael#!perl use strict; use warnings; use Test::More tests => 4; use Sub::Current; BEGIN { ok( !defined ROUTINE, "Don't point to BEGIN" ); } CHECK { ok( !defined ROUTINE, "Don't point to CHECK" ); } INIT { ok( !defined ROUTINE, "Don't point to INIT" ); } END { ok( !defined ROUTINE, "Don't point to END" ); } Sub-Current-0.02/t/04maincv.t0000644000175000017500000000020210642377111015117 0ustar rafaelrafael#!perl use strict; use warnings; use Test::More tests => 1; use Sub::Current; ok( !defined ROUTINE, "Don't point to main CV" ); Sub-Current-0.02/t/03autoload.t0000644000175000017500000000030510642441322015451 0ustar rafaelrafael#!perl use strict; use warnings; use Test::More tests => 3; use Sub::Current; sub AUTOLOAD { is(ROUTINE(), \&AUTOLOAD, "AUTOLOAD $::AUTOLOAD"); } sarah_jane(); leela(); sarah_jane(); # again Sub-Current-0.02/t/08anon.t0000644000175000017500000000027110642677773014630 0ustar rafaelrafael#!perl use strict; use warnings; use Test::More tests => 2; use Sub::Current; my $anon; $anon = sub { is(ROUTINE(), $anon, "anon sub"); }; $anon->(); my $copy = $anon; $copy->(); Sub-Current-0.02/t/06eval.t0000644000175000017500000000053210642442520014576 0ustar rafaelrafael#!perl use strict; use warnings; use Test::More tests => 3; use Sub::Current; sub runcible { is(eval { ROUTINE() }, \&runcible, "runcible"); } runcible(); sub omega { # eval("") is a special block context ok(!defined eval q{ ROUTINE() }, "omega"); } omega(); sub master { is(do { ROUTINE() }, \&master, "master"); } master(); Sub-Current-0.02/t/05proto.t0000644000175000017500000000043110642441610015006 0ustar rafaelrafael#!perl use strict; use warnings; use Test::More tests => 3; use Sub::Current; # prototype must be '' ok( defined prototype \&ROUTINE, 'proto defined' ); is( prototype \&ROUTINE, '', 'proto empty' ); # and this should compile sub skaro { ROUTINE } is(skaro(), \&skaro, 'skaro'); Sub-Current-0.02/t/01basic.t0000644000175000017500000000060510642376420014731 0ustar rafaelrafael#!perl use strict; use warnings; use Test::More tests => 5; use_ok("Sub::Current"); sub davros { ROUTINE() } is(davros(), \&davros, 'davros'); sub borusa { my $coderef = ROUTINE(); is($coderef, \&borusa, 'borusa'); } borusa(); sub romana { @_ = (ROUTINE(), \&romana, 'romana'); &is; } romana(); sub rassilon { is(ROUTINE(), \&rassilon, 'rassilon'); } rassilon(); Sub-Current-0.02/META.yml0000644000175000017500000000046510642706020014325 0ustar rafaelrafael# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Sub-Current version: 0.02 version_from: lib/Sub/Current.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30_01 Sub-Current-0.02/lib/0000755000175000017500000000000010642706020013615 5ustar rafaelrafaelSub-Current-0.02/lib/Sub/0000755000175000017500000000000010642706020014346 5ustar rafaelrafaelSub-Current-0.02/lib/Sub/Current.pm0000644000175000017500000000162410642705217016340 0ustar rafaelrafaelpackage Sub::Current; our $VERSION = '0.02'; require XSLoader; XSLoader::load('Sub::Current', $VERSION); sub import { *{caller() . '::ROUTINE'} = *ROUTINE; } __END__ =head1 NAME Sub::Current - Get the current subroutine =head1 SYNOPSIS use Sub::Current; sub f { # ... if ($some_condition) { # let's recurse! ROUTINE->(); } # ... } =head1 DESCRIPTION Sub::Current makes available a function C, that returns a code reference pointing at the currently executing subroutine. In a special block (BEGIN, END, CHECK, INIT, and UNITCHECK in Perl 5.10) this function will return undef. Outside of a special block (that is, at the top level of a program) C will return undef as well. =head1 COPYRIGHT (c) Copyright 2007 by Rafael Garcia-Suarez. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Sub-Current-0.02/Current.xs0000644000175000017500000000046410642440644015060 0ustar rafaelrafael#include "EXTERN.h" #include "perl.h" #include "XSUB.h" MODULE = Sub::Current PACKAGE = Sub::Current PROTOTYPES: ENABLE SV * ROUTINE() PREINIT: CV *cv; CODE: cv = Perl_find_runcv(aTHX_ NULL); if (CvUNIQUE(cv)) RETVAL = &PL_sv_undef; else RETVAL = newRV((SV*)cv); OUTPUT: RETVAL Sub-Current-0.02/Changes0000644000175000017500000000014510642705253014351 0ustar rafaelrafael0.02 - Wed Jul 4 2007 More tests. Require 5.8.x. 0.01 - Tue Jul 3 2007 Initial release Sub-Current-0.02/MANIFEST0000644000175000017500000000027210642705166014213 0ustar rafaelrafaelChanges Current.xs lib/Sub/Current.pm Makefile.PL MANIFEST META.yml t/01basic.t t/02specialblocks.t t/03autoload.t t/04maincv.t t/05proto.t t/06eval.t t/07recurse.t t/08anon.t t/50pod.t Sub-Current-0.02/Makefile.PL0000644000175000017500000000020410642705176015030 0ustar rafaelrafaeluse ExtUtils::MakeMaker; use 5.008; WriteMakefile( NAME => "Sub::Current", VERSION_FROM => "lib/Sub/Current.pm", );