Make prototype("CORE::foo") return prototypes with _ when it should

(except for mkdir)

p4raw-id: //depot/perl@29044

diff --git a/pp.c b/pp.c
index f04b55d..ba01223 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -392,7 +392,7 @@ PP(pp_prototype)
            const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
            if (code < 0) {     /* Overridable. */
 #define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
-               int i = 0, n = 0, seen_question = 0;
+               int i = 0, n = 0, seen_question = 0, defgv = 0;
                I32 oa;
                char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
 
@@ -409,9 +409,10 @@ PP(pp_prototype)
                }
                goto nonesuch;          /* Should not happen... */
              found:
+               defgv = PL_opargs[i] & OA_DEFGV;
                oa = PL_opargs[i] >> OASHIFT;
                while (oa) {
-                   if (oa & OA_OPTIONAL && !seen_question) {
+                   if (oa & OA_OPTIONAL && !seen_question && !defgv) {
                        seen_question = 1;
                        str[n++] = ';';
                    }
@@ -425,6 +426,8 @@ PP(pp_prototype)
                    str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
                    oa = oa >> 4;
                }
+               if (defgv && str[n - 1] == '$')
+                   str[n - 1] = '_';
                str[n++] = '\0';
                ret = sv_2mortal(newSVpvn(str, n - 1));
            }

diff --git a/t/op/cproto.t b/t/op/cproto.t
index a02ab46..49ba0d7 100644 (file)
--- a/t/op/cproto.t
+++ b/t/op/cproto.t
@@ -11,7 +11,7 @@ plan tests => 238;
 
 while (<DATA>) {
     chomp;
-    my ($keyword, $proto) = split;
+    (my $keyword, my $proto, local $TODO) = split " ", $_, 3;
     if ($proto eq 'undef') {
        ok( !defined prototype "CORE::".$keyword, $keyword );
     }
@@ -27,9 +27,9 @@ while (<DATA>) {
 # the keyword list :
 
 __DATA__
-abs (;$)
+abs (_)
 accept (**)
-alarm (;$)
+alarm (_)
 and ()
 atan2 ($$)
 bind (*$)
@@ -41,14 +41,14 @@ chmod (@)
 chomp undef
 chop undef
 chown (@)
-chr (;$)
-chroot (;$)
+chr (_)
+chroot (_)
 close (;*)
 closedir (*)
 cmp unknown
 connect (*$)
 continue ()
-cos (;$)
+cos (_)
 crypt ($$)
 dbmclose (\%)
 dbmopen (\%$$)
@@ -73,7 +73,7 @@ eval undef
 exec undef
 exists undef
 exit (;$)
-exp (;$)
+exp (_)
 fcntl (*$$)
 fileno (*)
 flock (*$)
@@ -115,30 +115,30 @@ gmtime (;$)
 goto undef
 grep undef
 gt ($$)
-hex (;$)
+hex (_)
 if undef
 index ($$;$)
-int (;$)
+int (_)
 ioctl (*$$)
 join ($@)
 keys (\%)
 kill (@)
 last undef
-lc (;$)
-lcfirst (;$)
+lc (_)
+lcfirst (_)
 le ($$)
-length (;$)
+length (_)
 link ($$)
 listen (*$)
 local undef
 localtime (;$)
 lock (\$)
-log (;$)
+log (_)
 lstat (*)
 lt ($$)
 m undef
 map undef
-mkdir (;$$)
+mkdir (_;$) this prototype is not supported
 msgctl ($$$)
 msgget ($$)
 msgrcv ($$$$$)
@@ -148,11 +148,11 @@ ne ($$)
 next undef
 no undef
 not ($)
-oct (;$)
+oct (_)
 open (*;$@)
 opendir (*$)
 or ()
-ord (;$)
+ord (_)
 our undef
 pack ($@)
 package undef
@@ -166,18 +166,18 @@ push (\@@)
 q undef
 qq undef
 qr undef
-quotemeta (;$)
+quotemeta (_)
 qw undef
 qx undef
 rand (;$)
 read (*\$$;$)
 readdir (*)
 readline (;*)
-readlink (;$)
+readlink (_)
 readpipe unknown
 recv (*\$$$)
 redo undef
-ref (;$)
+ref (_)
 rename ($$)
 require undef
 reset (;$)
@@ -185,7 +185,7 @@ return undef
 reverse (@)
 rewinddir (*)
 rindex ($$;$)
-rmdir (;$)
+rmdir (_)
 s undef
 say (;*@)
 scalar undef
@@ -211,7 +211,7 @@ shmget ($$$)
 shmread ($$$$)
 shmwrite ($$$$)
 shutdown (*$)
-sin (;$)
+sin (_)
 sleep (;$)
 socket (*$$$)
 socketpair (**$$$)
@@ -219,7 +219,7 @@ sort undef
 splice (\@;$$@)
 split undef
 sprintf ($@)
-sqrt (;$)
+sqrt (_)
 srand (;$)
 stat (*)
 state undef
@@ -241,8 +241,8 @@ time ()
 times ()
 tr undef
 truncate ($$)
-uc (;$)
-ucfirst (;$)
+uc (_)
+ucfirst (_)
 umask (;$)
 undef undef
 unless undef