Changeset 10894 for lang/perl/arguments

Timestamp:

05/01/08 22:20:21 (7 months ago)

Author:

takesako

Message:

lang/perl/arguments: 0.02 - supported arguments->length

Location:

lang/perl/arguments/trunk

Files:

• Changes (modified) (1 diff)
• README (modified) (1 diff)
• lib/arguments.pm (modified) (4 diffs)
• t/arguments.t (modified) (2 diffs)

lang/perl/arguments/trunk/Changes

@@ -1 +1 @@
 Revision history for Perl extension arguments.
 
-0.01  Thu May  1 16:34:55 2008
+0.02  Thu May  1 22:04:15 JST 2008
+        - supported: arguments->callee
+        - supported: arguments->length
+
+0.01  Thu May  1 16:34:55 JST 2008
         - original version; created 
 

lang/perl/arguments/trunk/README

@@ -1 @@
-arguments version 0.01
+arguments version 0.02
 ======================
 

lang/perl/arguments/trunk/lib/arguments.pm

@@ -4 +4 @@
 use warnings;
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(arguments);
+
+sub arguments {
+  { package DB; () = caller(1); }
+  return wantarray
+    ? @DB::args
+    : bless \@DB::args, 'arguments';
+}
+
+sub length {
+  { package DB; () = caller(1); }
+  return scalar @DB::args;
+}
 
 require XSLoader;
@@ -10 +26 @@
 
 sub callee {
-    my $level = shift;
-    $level = 0 if (!defined $level);
-    my $cx = _upcontext($level + 1);
+    my $cx = _upcontext(1);
     return unless $cx;
     return _context_cv($cx);
@@ -28 +42 @@
   use arguments;
 
+  print sub {
+    my $x = shift;
+    return 1 if ($x <= 1);
+    return $x * arguments->callee->($x - 1);
+  }->(5); # 120
+
   sub {
     my $c = shift;
     print "$c\n";
-    arguments::callee->($c) if ($c--);
+    arguments->callee->($c) if ($c--);
   }->(10);
 
@@ -40 +60 @@
 see also.
 http://d.hatena.ne.jp/amachang/20080501/1209623634
+http://d.hatena.ne.jp/amachang/20080501/1209640306
 
 =head1 SEE ALSO

lang/perl/arguments/trunk/t/arguments.t

@@ -1 @@
-use Test::More tests => 5;
+use Test::More tests => 9;
 BEGIN { use_ok('arguments') };
 
@@ -14 +14 @@
 }->(3);
 
+my $n = sub {
+  my $x = shift;
+  return 1 if ($x <= 1);
+  return $x * arguments::callee->($x - 1);
+}->(5);
+ok($n == 120);
+
+
+sub func {
+  ok(arguments->callee eq \&func);
+  ok(arguments->length == 3);
+  my @a = arguments();
+  ok(scalar @a == 3);
+}
+func(1,2,3);
+
+