In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/1db4d19556a36b5a8e8604c1e7656999ebc7732b?hp=8af710ebc7fee929ae47793d5a0cce5362af52db>
- Log -----------------------------------------------------------------
commit 1db4d19556a36b5a8e8604c1e7656999ebc7732b
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri Jun 25 22:10:36 2010 +1000
RT 75902: Add prototypes for tie() and untie() to allow overloading
-----------------------------------------------------------------------
Summary of changes:
perl_keyword.pl | 7 ++++---
pp.c | 8 ++++++++
t/op/cproto.t | 6 +++---
toke.c | 6 +++---
4 files changed, 18 insertions(+), 9 deletions(-)
diff --git a/perl_keyword.pl b/perl_keyword.pl
index f53416c..73128c3 100644
--- a/perl_keyword.pl
+++ b/perl_keyword.pl
@@ -9,7 +9,7 @@ my @pos = qw(__DATA__ __END__ AUTOLOAD BEGIN CHECK DESTROY
default defined
delete do END else eval elsif exists for format foreach given grep
goto glob INIT if last local m my map next no our pos print printf
package prototype q qr qq qw qx redo return require s say scalar
sort
- split state study sub tr tie tied use undef UNITCHECK until untie
+ split state study sub tr use undef UNITCHECK until
unless when while y);
my @neg = qw(__FILE__ __LINE__ __PACKAGE__ and abs alarm atan2 accept bless
@@ -31,8 +31,9 @@ my @neg = qw(__FILE__ __LINE__ __PACKAGE__ and abs alarm
atan2 accept bless
setservent setpriority setprotoent shift shmctl shmget shmread
shmwrite shutdown sin sleep socket socketpair sprintf splice sqrt
srand stat substr system symlink syscall sysopen sysread sysseek
- syswrite tell time times telldir truncate uc utime umask unpack
- unlink unshift ucfirst values vec warn wait write waitpid wantarray
+ syswrite tell tie tied time times telldir truncate uc utime
+ umask unpack unlink unshift untie ucfirst values vec warn wait
+ write waitpid wantarray
x xor);
my %feature_kw = (
diff --git a/pp.c b/pp.c
index 57f1ca6..94965f2 100644
--- a/pp.c
+++ b/pp.c
@@ -429,6 +429,14 @@ PP(pp_prototype)
ret = newSVpvs_flags("\...@%]", SVs_TEMP);
goto set;
}
+ if (code == -KEY_tied || code == -KEY_untie) {
+ ret = newSVpvs_flags("\...@%*]", SVs_TEMP);
+ goto set;
+ }
+ if (code == -KEY_tie) {
+ ret = newSVpvs_flags("\...@%*]$@", SVs_TEMP);
+ goto set;
+ }
if (code == -KEY_readpipe) {
s = "CORE::backtick";
}
diff --git a/t/op/cproto.t b/t/op/cproto.t
index af1555f..3e3c0de 100644
--- a/t/op/cproto.t
+++ b/t/op/cproto.t
@@ -234,8 +234,8 @@ system undef
syswrite (*$;$$)
tell (;*)
telldir (*)
-tie undef
-tied undef
+tie (\...@%*]$@)
+tied (\...@%*])
time ()
times ()
tr undef
@@ -248,7 +248,7 @@ unless undef
unlink (@)
unpack ($;$)
unshift (\@@)
-untie undef
+untie (\...@%*])
until undef
use undef
utime (@)
diff --git a/toke.c b/toke.c
index a94753a..d7d5d4d 100644
--- a/toke.c
+++ b/toke.c
@@ -8501,7 +8501,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool
all_keywords)
if (name[1] == 'i' &&
name[2] == 'e')
{ /* tie */
- return KEY_tie;
+ return -KEY_tie;
}
goto unknown;
@@ -8945,7 +8945,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool
all_keywords)
case 'e':
if (name[3] == 'd')
{ /* tied */
- return KEY_tied;
+ return -KEY_tied;
}
goto unknown;
@@ -9440,7 +9440,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool
all_keywords)
{
case 'e':
{ /* untie */
- return KEY_untie;
+ return -KEY_untie;
}
case 'l':
--
Perl5 Master Repository
