r26365 - in /branches/upstream/libsub-current-perl: ./ current/ current/lib/ current/lib/Sub/ current/t/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Thu Oct 30 14:20:38 UTC 2008
Author: eloy
Date: Thu Oct 30 14:20:32 2008
New Revision: 26365
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=26365
Log:
[svn-inject] Installing original source of libsub-current-perl
Added:
branches/upstream/libsub-current-perl/
branches/upstream/libsub-current-perl/current/
branches/upstream/libsub-current-perl/current/Changes
branches/upstream/libsub-current-perl/current/Current.xs
branches/upstream/libsub-current-perl/current/MANIFEST
branches/upstream/libsub-current-perl/current/META.yml
branches/upstream/libsub-current-perl/current/Makefile.PL
branches/upstream/libsub-current-perl/current/lib/
branches/upstream/libsub-current-perl/current/lib/Sub/
branches/upstream/libsub-current-perl/current/lib/Sub/Current.pm
branches/upstream/libsub-current-perl/current/t/
branches/upstream/libsub-current-perl/current/t/01basic.t
branches/upstream/libsub-current-perl/current/t/02specialblocks.t
branches/upstream/libsub-current-perl/current/t/03autoload.t
branches/upstream/libsub-current-perl/current/t/04maincv.t
branches/upstream/libsub-current-perl/current/t/05proto.t
branches/upstream/libsub-current-perl/current/t/06eval.t
branches/upstream/libsub-current-perl/current/t/07recurse.t
branches/upstream/libsub-current-perl/current/t/08anon.t
branches/upstream/libsub-current-perl/current/t/50pod.t
Added: branches/upstream/libsub-current-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/Changes?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/Changes (added)
+++ branches/upstream/libsub-current-perl/current/Changes Thu Oct 30 14:20:32 2008
@@ -1,0 +1,5 @@
+0.02 - Wed Jul 4 2007
+ More tests.
+ Require 5.8.x.
+0.01 - Tue Jul 3 2007
+ Initial release
Added: branches/upstream/libsub-current-perl/current/Current.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/Current.xs?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/Current.xs (added)
+++ branches/upstream/libsub-current-perl/current/Current.xs Thu Oct 30 14:20:32 2008
@@ -1,0 +1,20 @@
+#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
Added: branches/upstream/libsub-current-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/MANIFEST?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/MANIFEST (added)
+++ branches/upstream/libsub-current-perl/current/MANIFEST Thu Oct 30 14:20:32 2008
@@ -1,0 +1,15 @@
+Changes
+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
Added: branches/upstream/libsub-current-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/META.yml?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/META.yml (added)
+++ branches/upstream/libsub-current-perl/current/META.yml Thu Oct 30 14:20:32 2008
@@ -1,0 +1,10 @@
+# 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
Added: branches/upstream/libsub-current-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/Makefile.PL?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/Makefile.PL (added)
+++ branches/upstream/libsub-current-perl/current/Makefile.PL Thu Oct 30 14:20:32 2008
@@ -1,0 +1,7 @@
+use ExtUtils::MakeMaker;
+use 5.008;
+
+WriteMakefile(
+ NAME => "Sub::Current",
+ VERSION_FROM => "lib/Sub/Current.pm",
+);
Added: branches/upstream/libsub-current-perl/current/lib/Sub/Current.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/lib/Sub/Current.pm?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/lib/Sub/Current.pm (added)
+++ branches/upstream/libsub-current-perl/current/lib/Sub/Current.pm Thu Oct 30 14:20:32 2008
@@ -1,0 +1,47 @@
+package 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<ROUTINE()>, 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<ROUTINE()> 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
Added: branches/upstream/libsub-current-perl/current/t/01basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/t/01basic.t?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/t/01basic.t (added)
+++ branches/upstream/libsub-current-perl/current/t/01basic.t Thu Oct 30 14:20:32 2008
@@ -1,0 +1,27 @@
+#!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();
Added: branches/upstream/libsub-current-perl/current/t/02specialblocks.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/t/02specialblocks.t?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/t/02specialblocks.t (added)
+++ branches/upstream/libsub-current-perl/current/t/02specialblocks.t Thu Oct 30 14:20:32 2008
@@ -1,0 +1,12 @@
+#!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" ); }
Added: branches/upstream/libsub-current-perl/current/t/03autoload.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/t/03autoload.t?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/t/03autoload.t (added)
+++ branches/upstream/libsub-current-perl/current/t/03autoload.t Thu Oct 30 14:20:32 2008
@@ -1,0 +1,13 @@
+#!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
Added: branches/upstream/libsub-current-perl/current/t/04maincv.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/t/04maincv.t?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/t/04maincv.t (added)
+++ branches/upstream/libsub-current-perl/current/t/04maincv.t Thu Oct 30 14:20:32 2008
@@ -1,0 +1,8 @@
+#!perl
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+use Sub::Current;
+
+ok( !defined ROUTINE, "Don't point to main CV" );
Added: branches/upstream/libsub-current-perl/current/t/05proto.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/t/05proto.t?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/t/05proto.t (added)
+++ branches/upstream/libsub-current-perl/current/t/05proto.t Thu Oct 30 14:20:32 2008
@@ -1,0 +1,14 @@
+#!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');
Added: branches/upstream/libsub-current-perl/current/t/06eval.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/t/06eval.t?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/t/06eval.t (added)
+++ branches/upstream/libsub-current-perl/current/t/06eval.t Thu Oct 30 14:20:32 2008
@@ -1,0 +1,22 @@
+#!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();
Added: branches/upstream/libsub-current-perl/current/t/07recurse.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/t/07recurse.t?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/t/07recurse.t (added)
+++ branches/upstream/libsub-current-perl/current/t/07recurse.t Thu Oct 30 14:20:32 2008
@@ -1,0 +1,25 @@
+#!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);
Added: branches/upstream/libsub-current-perl/current/t/08anon.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/t/08anon.t?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/t/08anon.t (added)
+++ branches/upstream/libsub-current-perl/current/t/08anon.t Thu Oct 30 14:20:32 2008
@@ -1,0 +1,14 @@
+#!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->();
Added: branches/upstream/libsub-current-perl/current/t/50pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-current-perl/current/t/50pod.t?rev=26365&op=file
==============================================================================
--- branches/upstream/libsub-current-perl/current/t/50pod.t (added)
+++ branches/upstream/libsub-current-perl/current/t/50pod.t Thu Oct 30 14:20:32 2008
@@ -1,0 +1,8 @@
+#!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();
More information about the Pkg-perl-cvs-commits
mailing list