[Bast-commits] r3551 - in trunk/Devel-Declare: . lib/Devel t

matthewt at dev.catalyst.perl.org matthewt at dev.catalyst.perl.org
Fri Jun 29 09:29:41 GMT 2007


Author: matthewt
Date: 2007-06-29 09:29:41 +0100 (Fri, 29 Jun 2007)
New Revision: 3551

Added:
   trunk/Devel-Declare/t/proto.t
Modified:
   trunk/Devel-Declare/Declare.xs
   trunk/Devel-Declare/lib/Devel/Declare.pm
   trunk/Devel-Declare/stolen_chunk_of_toke.c
   trunk/Devel-Declare/t/simple.t
Log:
fun ($a, $b) { ... }

Modified: trunk/Devel-Declare/Declare.xs
===================================================================
--- trunk/Devel-Declare/Declare.xs	2007-06-29 05:20:23 UTC (rev 3550)
+++ trunk/Devel-Declare/Declare.xs	2007-06-29 08:29:41 UTC (rev 3551)
@@ -11,6 +11,9 @@
 
 #define DD_DEBUG 0
 
+#define DD_HANDLE_NAME 1
+#define DD_HANDLE_PROTO 2
+
 #ifdef DD_DEBUG
 #define DD_DEBUG_S printf("Buffer: %s\n", s);
 #else
@@ -34,21 +37,25 @@
 STATIC OP *dd_ck_rv2cv(pTHX_ OP *o) {
   OP* kid;
   char* s;
+  char* save_s;
   char tmpbuf[sizeof PL_tokenbuf];
-  STRLEN len;
+  char found_name[sizeof PL_tokenbuf];
+  char* found_proto = NULL;
+  STRLEN len = 0;
   HV *stash;
   HV* is_declarator;
   SV** is_declarator_pack_ref;
   HV* is_declarator_pack_hash;
   SV** is_declarator_flag_ref;
-  char* cb_args[4];
+  int dd_flags;
+  char* cb_args[5];
 
   o = dd_old_ck_rv2cv(aTHX_ o); /* let the original do its job */
 
   if (in_declare) {
     cb_args[0] = NULL;
     call_argv("Devel::Declare::done_declare", G_VOID|G_DISCARD, cb_args);
-    in_declare = 0;
+    in_declare--;
     return o;
   }
 
@@ -82,15 +89,25 @@
   is_declarator_flag_ref = hv_fetch(is_declarator_pack_hash, GvNAME(kGVOP_gv),
                                 strlen(GvNAME(kGVOP_gv)), FALSE);
 
-  if (!is_declarator_flag_ref || !SvTRUE(*is_declarator_flag_ref))
+  /* requires SvIOK as well as TRUE since flags not being an int is useless */
+
+  if (!is_declarator_flag_ref
+        || !SvIOK(*is_declarator_flag_ref) 
+        || !SvTRUE(*is_declarator_flag_ref))
     return o;
 
+  dd_flags = SvIVX(*is_declarator_flag_ref);
+
+#ifdef DD_DEBUG
+  printf("dd_flags are: %i\n", dd_flags);
+#endif
+
   s = PL_bufptr; /* copy the current buffer pointer */
 
   DD_DEBUG_S
 
 #ifdef DD_DEBUG
-  printf("PL_tokenbuf: %s", PL_tokenbuf);
+  printf("PL_tokenbuf: %s\n", PL_tokenbuf);
 #endif
 
   /*
@@ -105,25 +122,70 @@
 
   DD_DEBUG_S
 
-  /* find next word */
+  if (dd_flags & DD_HANDLE_NAME) {
 
-  s = skipspace(s);
+    /* find next word */
 
-  DD_DEBUG_S
+    s = skipspace(s);
 
-  /* 0 in arg 4 is allow_package - not trying that yet :) */
+    DD_DEBUG_S
 
-  s = scan_word(s, tmpbuf, sizeof tmpbuf, 0, &len);
+    /* 0 in arg 4 is allow_package - not trying that yet :) */
 
-  DD_DEBUG_S
+    s = scan_word(s, tmpbuf, sizeof tmpbuf, 0, &len);
 
-  if (len) {
+    DD_DEBUG_S
+
+    if (len) {
+      strcpy(found_name, tmpbuf);
+#ifdef DD_DEBUG
+      printf("Found %s\n", found_name);
+#endif
+    }
+  }
+
+  if (dd_flags & DD_HANDLE_PROTO) {
+
+    s = skipspace(s);
+
+    if (*s == '(') { /* found a prototype-ish thing */
+      save_s = s;
+      s = scan_str(s, FALSE, FALSE); /* no keep_quoted, no keep_delims */
+      if (SvPOK(PL_lex_stuff)) {
+#ifdef DD_DEBUG
+        printf("Found proto %s\n", SvPVX(PL_lex_stuff));
+#endif
+        found_proto = SvPVX(PL_lex_stuff);
+        *save_s++ = '=';
+        *save_s++ = 'X';
+        while (save_s < s) {
+          *save_s++ = ' ';
+        }
+#ifdef DD_DEBUG
+        printf("Curbuf %s\n", PL_bufptr);
+#endif
+      }
+    }
+  }
+
+  if (len || found_proto) {
+    if (!len)
+      found_name[0] = 0;
+#ifdef DD_DEBUG
+  printf("Calling init_declare");
+#endif
     cb_args[0] = HvNAME(stash);
     cb_args[1] = GvNAME(kGVOP_gv);
-    cb_args[2] = tmpbuf;
-    cb_args[3] = NULL;
+    cb_args[2] = found_name;
+    cb_args[3] = found_proto;
+    cb_args[4] = NULL;
     call_argv("Devel::Declare::init_declare", G_VOID|G_DISCARD, cb_args);
-    in_declare = 1;
+    if (len && found_proto)
+      in_declare = 2;
+    else
+      in_declare = 1;
+    if (found_proto)
+      PL_lex_stuff = Nullsv;
   }
 
   return o;

Modified: trunk/Devel-Declare/lib/Devel/Declare.pm
===================================================================
--- trunk/Devel-Declare/lib/Devel/Declare.pm	2007-06-29 05:20:23 UTC (rev 3550)
+++ trunk/Devel-Declare/lib/Devel/Declare.pm	2007-06-29 08:29:41 UTC (rev 3551)
@@ -6,15 +6,27 @@
 
 our $VERSION = 0.001000;
 
-use vars qw(%declarators);
+# mirrored in Declare.xs as DD_HANDLE_*
+
+use constant DECLARE_NAME => 1;
+use constant DECLARE_PROTO => 2;
+
+use vars qw(%declarators %declarator_handlers);
 use base qw(DynaLoader);
 
 bootstrap Devel::Declare;
 
 sub import {
-  my ($class, @args) = @_;
+  my ($class, %args) = @_;
   my $target = caller;
-  $class->setup_for($target => \@args);
+  if (@_ == 1) { # "use Devel::Declare;"
+    no strict 'refs';
+    foreach my $name (qw(DECLARE_NAME DECLARE_PROTO)) {
+      *{"${target}::${name}"} = *{"${name}"};
+    }
+  } else {
+    $class->setup_for($target => \%args);
+  }
 }
 
 sub unimport {
@@ -26,28 +38,67 @@
 sub setup_for {
   my ($class, $target, $args) = @_;
   setup();
-  $declarators{$target}{$_} = 1 for @$args;
+  foreach my $key (keys %$args) {
+    my $info = $args->{$key};
+    my ($flags, $sub);
+    if (ref($info) eq 'ARRAY') {
+      ($flags, $sub) = @$info;
+    } elsif (ref($info) eq 'CODE') {
+      $flags = DECLARE_NAME;
+      $sub = $info;
+    } else {
+      die "Info for sub ${key} must be [ \$flags, \$sub ] or \$sub";
+    }
+    $declarators{$target}{$key} = $flags;
+    $declarator_handlers{$target}{$key} = $sub;
+  }
 }
 
 sub teardown_for {
   my ($class, $target) = @_;
   delete $declarators{$target};
+  delete $declarator_handlers{$target};
   teardown();
 }
 
 my $temp_pack;
 my $temp_name;
+my $temp_save;
 
 sub init_declare {
-  my ($pack, $use, $name) = @_;
-  no strict 'refs';
-  *{"${pack}::${name}"} = sub (&) { ($pack, $name, $_[0]); };
-  ($temp_pack, $temp_name) = ($pack, $name);
+  my ($pack, $use, $name, $proto) = @_;
+  my ($name_h, $XX_h) = $declarator_handlers{$pack}{$use}->(
+                            $pack, $use, $name, $proto
+                        );
+  ($temp_pack, $temp_name, $temp_save) = ($pack, [], []);
+  if ($name) {
+    push(@$temp_name, $name);
+    no strict 'refs';
+    push(@$temp_save, \&{"${pack}::${name}"});
+    no warnings 'redefine';
+    no warnings 'prototype';
+    *{"${pack}::${name}"} = $name_h;
+  }
+  if ($XX_h) {
+    push(@$temp_name, 'X');
+    no strict 'refs';
+    push(@$temp_save, \&{"${pack}::X"});
+    no warnings 'redefine';
+    no warnings 'prototype';
+    *{"${pack}::X"} = $XX_h;
+  }
 }
 
 sub done_declare {
   no strict 'refs';
-  delete ${"${temp_pack}::"}{$temp_name};
+  my $name = pop(@{$temp_name||[]});
+  die "done_declare called with no temp_name stack" unless defined($name);
+  my $saved = pop(@$temp_save);
+  delete ${"${temp_pack}::"}{$name};
+  if ($saved) {
+    no warnings 'prototype';
+    *{"${temp_pack}::${name}"} = $saved;
+  }
 }
 
 =head1 NAME

Modified: trunk/Devel-Declare/stolen_chunk_of_toke.c
===================================================================
--- trunk/Devel-Declare/stolen_chunk_of_toke.c	2007-06-29 05:20:23 UTC (rev 3550)
+++ trunk/Devel-Declare/stolen_chunk_of_toke.c	2007-06-29 08:29:41 UTC (rev 3551)
@@ -24,6 +24,13 @@
 #define PTR2nat(p)       (PTRV)(p)       /* pointer to integer of PTRSIZE */
 #define MEM_WRAP_CHECK_(n,t) MEM_WRAP_CHECK(n,t),
 #define Newx(v,n,t) (v = (MEM_WRAP_CHECK_(n,t) (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
+#define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
+#define SvPV_renew(sv,n) \
+  STMT_START { SvLEN_set(sv, n); \
+    SvPV_set((sv), (MEM_WRAP_CHECK_(n,char)     \
+        (char*)saferealloc((Malloc_t)SvPVX(sv), \
+               (MEM_SIZE)((n)))));  \
+     } STMT_END
 
 /* On MacOS, respect nonbreaking spaces */
 #ifdef MACOS_TRADITIONAL
@@ -32,6 +39,8 @@
 #define SPACE_OR_TAB(c) ((c)==' '||(c)=='\t')
 #endif
 
+#define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline))
+
 #define LEX_NORMAL    10 /* normal code (ie not within "...")     */
 #define LEX_INTERPNORMAL   9 /* code within a string, eg "$foo[$x+1]" */
 #define LEX_INTERPCASEMOD  8 /* expecting a \U, \Q or \E etc          */
@@ -391,3 +400,341 @@
     *t = ch;
     CopLINE_set(PL_curcop, atoi(n)-1);
 }
+
+/* scan_str
+   takes: start position in buffer
+	  keep_quoted preserve \ on the embedded delimiter(s)
+	  keep_delims preserve the delimiters around the string
+   returns: position to continue reading from buffer
+   side-effects: multi_start, multi_close, lex_repl or lex_stuff, and
+   	updates the read buffer.
+
+   This subroutine pulls a string out of the input.  It is called for:
+   	q		single quotes		q(literal text)
+	'		single quotes		'literal text'
+	qq		double quotes		qq(interpolate $here please)
+	"		double quotes		"interpolate $here please"
+	qx		backticks		qx(/bin/ls -l)
+	`		backticks		`/bin/ls -l`
+	qw		quote words		@EXPORT_OK = qw( func() $spam )
+	m//		regexp match		m/this/
+	s///		regexp substitute	s/this/that/
+	tr///		string transliterate	tr/this/that/
+	y///		string transliterate	y/this/that/
+	($*@)		sub prototypes		sub foo ($)
+	(stuff)		sub attr parameters	sub foo : attr(stuff)
+	<>		readline or globs	<FOO>, <>, <$fh>, or <*.c>
+	
+   In most of these cases (all but <>, patterns and transliterate)
+   yylex() calls scan_str().  m// makes yylex() call scan_pat() which
+   calls scan_str().  s/// makes yylex() call scan_subst() which calls
+   scan_str().  tr/// and y/// make yylex() call scan_trans() which
+   calls scan_str().
+
+   It skips whitespace before the string starts, and treats the first
+   character as the delimiter.  If the delimiter is one of ([{< then
+   the corresponding "close" character )]}> is used as the closing
+   delimiter.  It allows quoting of delimiters, and if the string has
+   balanced delimiters ([{<>}]) it allows nesting.
+
+   On success, the SV with the resulting string is put into lex_stuff or,
+   if that is already non-NULL, into lex_repl. The second case occurs only
+   when parsing the RHS of the special constructs s/// and tr/// (y///).
+   For convenience, the terminating delimiter character is stuffed into
+   SvIVX of the SV.
+*/
+
+STATIC char *
+S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
+{
+    SV *sv;				/* scalar value: string */
+    char *tmps;				/* temp string, used for delimiter matching */
+    register char *s = start;		/* current position in the buffer */
+    register char term;			/* terminating character */
+    register char *to;			/* current position in the sv's data */
+    I32 brackets = 1;			/* bracket nesting level */
+    bool has_utf8 = FALSE;		/* is there any utf8 content? */
+    I32 termcode;			/* terminating char. code */
+    U8 termstr[UTF8_MAXBYTES];		/* terminating string */
+    STRLEN termlen;			/* length of terminating string */
+    char *last = NULL;			/* last position for nesting bracket */
+
+    /* skip space before the delimiter */
+    if (isSPACE(*s))
+	s = skipspace(s);
+
+    /* mark where we are, in case we need to report errors */
+    CLINE;
+
+    /* after skipping whitespace, the next character is the terminator */
+    term = *s;
+    if (!UTF) {
+	termcode = termstr[0] = term;
+	termlen = 1;
+    }
+    else {
+	termcode = utf8_to_uvchr((U8*)s, &termlen);
+	Copy(s, termstr, termlen, U8);
+	if (!UTF8_IS_INVARIANT(term))
+	    has_utf8 = TRUE;
+    }
+
+    /* mark where we are */
+    PL_multi_start = CopLINE(PL_curcop);
+    PL_multi_open = term;
+
+    /* find corresponding closing delimiter */
+    if (term && (tmps = strchr("([{< )]}> )]}>",term)))
+	termcode = termstr[0] = term = tmps[5];
+
+    PL_multi_close = term;
+
+    /* create a new SV to hold the contents.  87 is leak category, I'm
+       assuming.  79 is the SV's initial length.  What a random number. */
+    sv = NEWSV(87,79);
+    sv_upgrade(sv, SVt_PVIV);
+    SvIV_set(sv, termcode);
+    (void)SvPOK_only(sv);		/* validate pointer */
+
+    /* move past delimiter and try to read a complete string */
+    if (keep_delims)
+	sv_catpvn(sv, s, termlen);
+    s += termlen;
+    for (;;) {
+	if (PL_encoding && !UTF) {
+	    bool cont = TRUE;
+
+	    while (cont) {
+		int offset = s - SvPVX_const(PL_linestr);
+		const bool found = sv_cat_decode(sv, PL_encoding, PL_linestr,
+					   &offset, (char*)termstr, termlen);
+		const char *ns = SvPVX_const(PL_linestr) + offset;
+		char *svlast = SvEND(sv) - 1;
+
+		for (; s < ns; s++) {
+		    if (*s == '\n' && !PL_rsfp)
+			CopLINE_inc(PL_curcop);
+		}
+		if (!found)
+		    goto read_more_line;
+		else {
+		    /* handle quoted delimiters */
+		    if (SvCUR(sv) > 1 && *(svlast-1) == '\\') {
+			const char *t;
+			for (t = svlast-2; t >= SvPVX_const(sv) && *t == '\\';)
+			    t--;
+			if ((svlast-1 - t) % 2) {
+			    if (!keep_quoted) {
+				*(svlast-1) = term;
+				*svlast = '\0';
+				SvCUR_set(sv, SvCUR(sv) - 1);
+			    }
+			    continue;
+			}
+		    }
+		    if (PL_multi_open == PL_multi_close) {
+			cont = FALSE;
+		    }
+		    else {
+			const char *t;
+			char *w;
+			if (!last)
+			    last = SvPVX(sv);
+			for (t = w = last; t < svlast; w++, t++) {
+			    /* At here, all closes are "was quoted" one,
+			       so we don't check PL_multi_close. */
+			    if (*t == '\\') {
+				if (!keep_quoted && *(t+1) == PL_multi_open)
+				    t++;
+				else
+				    *w++ = *t++;
+			    }
+			    else if (*t == PL_multi_open)
+				brackets++;
+
+			    *w = *t;
+			}
+			if (w < t) {
+			    *w++ = term;
+			    *w = '\0';
+			    SvCUR_set(sv, w - SvPVX_const(sv));
+			}
+			last = w;
+			if (--brackets <= 0)
+			    cont = FALSE;
+		    }
+		}
+	    }
+	    if (!keep_delims) {
+		SvCUR_set(sv, SvCUR(sv) - 1);
+		*SvEND(sv) = '\0';
+	    }
+	    break;
+	}
+
+    	/* extend sv if need be */
+	SvGROW(sv, SvCUR(sv) + (PL_bufend - s) + 1);
+	/* set 'to' to the next character in the sv's string */
+	to = SvPVX(sv)+SvCUR(sv);
+
+	/* if open delimiter is the close delimiter read unbridle */
+	if (PL_multi_open == PL_multi_close) {
+	    for (; s < PL_bufend; s++,to++) {
+	    	/* embedded newlines increment the current line number */
+		if (*s == '\n' && !PL_rsfp)
+		    CopLINE_inc(PL_curcop);
+		/* handle quoted delimiters */
+		if (*s == '\\' && s+1 < PL_bufend && term != '\\') {
+		    if (!keep_quoted && s[1] == term)
+			s++;
+		/* any other quotes are simply copied straight through */
+		    else
+			*to++ = *s++;
+		}
+		/* terminate when run out of buffer (the for() condition), or
+		   have found the terminator */
+		else if (*s == term) {
+		    if (termlen == 1)
+			break;
+		    if (s+termlen <= PL_bufend && memEQ(s, (char*)termstr, termlen))
+			break;
+		}
+		else if (!has_utf8 && !UTF8_IS_INVARIANT((U8)*s) && UTF)
+		    has_utf8 = TRUE;
+		*to = *s;
+	    }
+	}
+	
+	/* if the terminator isn't the same as the start character (e.g.,
+	   matched brackets), we have to allow more in the quoting, and
+	   be prepared for nested brackets.
+	*/
+	else {
+	    /* read until we run out of string, or we find the terminator */
+	    for (; s < PL_bufend; s++,to++) {
+	    	/* embedded newlines increment the line count */
+		if (*s == '\n' && !PL_rsfp)
+		    CopLINE_inc(PL_curcop);
+		/* backslashes can escape the open or closing characters */
+		if (*s == '\\' && s+1 < PL_bufend) {
+		    if (!keep_quoted &&
+			((s[1] == PL_multi_open) || (s[1] == PL_multi_close)))
+			s++;
+		    else
+			*to++ = *s++;
+		}
+		/* allow nested opens and closes */
+		else if (*s == PL_multi_close && --brackets <= 0)
+		    break;
+		else if (*s == PL_multi_open)
+		    brackets++;
+		else if (!has_utf8 && !UTF8_IS_INVARIANT((U8)*s) && UTF)
+		    has_utf8 = TRUE;
+		*to = *s;
+	    }
+	}
+	/* terminate the copied string and update the sv's end-of-string */
+	*to = '\0';
+	SvCUR_set(sv, to - SvPVX_const(sv));
+
+	/*
+	 * this next chunk reads more into the buffer if we're not done yet
+	 */
+
+  	if (s < PL_bufend)
+	    break;		/* handle case where we are done yet :-) */
+
+#ifndef PERL_STRICT_CR
+	if (to - SvPVX_const(sv) >= 2) {
+	    if ((to[-2] == '\r' && to[-1] == '\n') ||
+		(to[-2] == '\n' && to[-1] == '\r'))
+	    {
+		to[-2] = '\n';
+		to--;
+		SvCUR_set(sv, to - SvPVX_const(sv));
+	    }
+	    else if (to[-1] == '\r')
+		to[-1] = '\n';
+	}
+	else if (to - SvPVX_const(sv) == 1 && to[-1] == '\r')
+	    to[-1] = '\n';
+#endif
+	
+     read_more_line:
+	/* if we're out of file, or a read fails, bail and reset the current
+	   line marker so we can report where the unterminated string began
+	*/
+	if (!PL_rsfp ||
+	 !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
+	    sv_free(sv);
+	    CopLINE_set(PL_curcop, (line_t)PL_multi_start);
+	    return Nullch;
+	}
+	/* we read a line, so increment our line counter */
+	CopLINE_inc(PL_curcop);
+
+	/* update debugger info */
+	if (PERLDB_LINE && PL_curstash != PL_debstash) {
+	    SV *sv = NEWSV(88,0);
+
+	    sv_upgrade(sv, SVt_PVMG);
+	    sv_setsv(sv,PL_linestr);
+            (void)SvIOK_on(sv);
+            SvIV_set(sv, 0);
+	    av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv);
+	}
+
+	/* having changed the buffer, we must update PL_bufend */
+	PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+	PL_last_lop = PL_last_uni = Nullch;
+    }
+
+    /* at this point, we have successfully read the delimited string */
+
+    if (!PL_encoding || UTF) {
+	if (keep_delims)
+	    sv_catpvn(sv, s, termlen);
+	s += termlen;
+    }
+    if (has_utf8 || PL_encoding)
+	SvUTF8_on(sv);
+
+    PL_multi_end = CopLINE(PL_curcop);
+
+    /* if we allocated too much space, give some back */
+    if (SvCUR(sv) + 5 < SvLEN(sv)) {
+	SvLEN_set(sv, SvCUR(sv) + 1);
+	SvPV_renew(sv, SvLEN(sv));
+    }
+
+    /* decide whether this is the first or second quoted string we've read
+       for this op
+    */
+
+    if (PL_lex_stuff)
+	PL_lex_repl = sv;
+    else
+	PL_lex_stuff = sv;
+    return s;
+}
+
+/*
+ * S_force_next
+ * When the lexer realizes it knows the next token (for instance,
+ * it is reordering tokens for the parser) then it can call S_force_next
+ * to know what token to return the next time the lexer is called.  Caller
+ * will need to set PL_nextval[], and possibly PL_expect to ensure the lexer
+ * handles the token correctly.
+ */
+
+STATIC void
+S_force_next(pTHX_ I32 type)
+{
+    PL_nexttype[PL_nexttoke] = type;
+    PL_nexttoke++;
+    if (PL_lex_state != LEX_KNOWNEXT) {
+  PL_lex_defer = PL_lex_state;
+  PL_lex_expect = PL_expect;
+  PL_lex_state = LEX_KNOWNEXT;
+    }
+}

Added: trunk/Devel-Declare/t/proto.t
===================================================================
--- trunk/Devel-Declare/t/proto.t	                        (rev 0)
+++ trunk/Devel-Declare/t/proto.t	2007-06-29 08:29:41 UTC (rev 3551)
@@ -0,0 +1,26 @@
+use strict;
+use warnings;
+use Test::More 'no_plan';
+
+sub fun :lvalue { return my $sv; }
+
+sub X { "what?" }
+
+sub handle_fun {
+  my ($pack, $use, $name, $proto) = @_;
+  my $XX = sub (&) {
+    my $cr = $_[0];
+    return sub {
+      return join(': ', $proto, $cr->());
+    };
+  };
+  return (undef, $XX);
+}
+
+use Devel::Declare;
+use Devel::Declare fun => [ DECLARE_PROTO, \&handle_fun ];
+
+my $foo = fun ($a, $b) { "woot" };
+
+is($foo->(), '$a, $b: woot', 'proto declarator ok');
+is(X(), 'what?', 'X sub restored ok');

Modified: trunk/Devel-Declare/t/simple.t
===================================================================
--- trunk/Devel-Declare/t/simple.t	2007-06-29 05:20:23 UTC (rev 3550)
+++ trunk/Devel-Declare/t/simple.t	2007-06-29 08:29:41 UTC (rev 3551)
@@ -8,8 +8,13 @@
   *{"${pack}::${name}"} = $sub;
 }
 
-use Devel::Declare 'method';
+sub handle_method {
+  my ($pack, $use, $name) = @_;
+  return sub (&) { ($pack, $name, $_[0]); };
+}
 
+use Devel::Declare 'method' => \&handle_method;
+
 my ($args1, $args2);
 
 method bar {
@@ -28,3 +33,4 @@
 
 is($args1, 'main, 1, 2', 'Method bar args ok');
 is($args2, 'main, 3, 4', 'Method baz args ok');
+




More information about the Bast-commits mailing list