RT 75902: Add prototypes for tie() and untie() to allow overloading
authorFather Chrysostomos <sprout@cpan.org>
Fri, 25 Jun 2010 12:10:36 +0000 (22:10 +1000)
committerTony Cook <tony@develop-help.com>
Fri, 25 Jun 2010 12:10:36 +0000 (22:10 +1000)
perl_keyword.pl
pp.c
t/op/cproto.t
toke.c

index f53416c..73128c3 100644 (file)
@@ -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 (file)
--- 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";
                }
index af1555f..3e3c0de 100644 (file)
@@ -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 (file)
--- 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':