&CORE::umask()
authorFather Chrysostomos <sprout@cpan.org>
Mon, 29 Aug 2011 21:15:34 +0000 (14:15 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 30 Aug 2011 01:19:51 +0000 (18:19 -0700)
This commit allows &CORE::umask to be called through references and
via ampersand syntax.  pp_umask is modified to take into account the
nulls pushed on to the stack in pp_coreargs, which happens because
pp_coreargs has no other way to tell umask how many arguments it’s
actually getting.  See commit 0163043a for details.

gv.c
pp_sys.c
t/op/coreamp.t

diff --git a/gv.c b/gv.c
index 46559c7..8b53b94 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1362,7 +1362,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
            case KEY_splice:
            case KEY_stat:
            case KEY_system:
-           case KEY_truncate: case KEY_umask: case KEY_unlink:
+           case KEY_truncate: case KEY_unlink:
            case KEY_unpack: case KEY_unshift:
            case KEY_values: case KEY_write:
                ampable = FALSE;
index 2da7fbd..ccc4325 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -749,7 +749,7 @@ PP(pp_umask)
     dTARGET;
     Mode_t anum;
 
-    if (MAXARG < 1) {
+    if (MAXARG < 1 || (!TOPs && !POPs)) {
        anum = PerlLIO_umask(022);
        /* setting it to 022 between the two calls to umask avoids
         * to have a window where the umask is set to 0 -- meaning
@@ -765,7 +765,7 @@ PP(pp_umask)
     /* Only DIE if trying to restrict permissions on "user" (self).
      * Otherwise it's harmless and more useful to just return undef
      * since 'group' and 'other' concepts probably don't exist here. */
-    if (MAXARG >= 1 && (POPi & 0700))
+    if (MAXARG >= 1 && (TOPs||POPs) && (POPi & 0700))
        DIE(aTHX_ "umask not implemented");
     XPUSHs(&PL_sv_undef);
 #endif
index b03e834..b78a64b 100644 (file)
@@ -768,6 +768,11 @@ like join('-',&mytimes), '^[\d.]+-[\d.]+-[\d.]+-[\d.]+\z',
 
 test_proto 'uc', 'aa', 'AA';
 test_proto 'ucfirst', 'aa', "Aa";
+
+test_proto 'umask';
+$tests ++;
+is &myumask, umask, '&umask with no args';
+
 test_proto 'untie'; # behaviour already tested along with tie(d)
 
 test_proto 'utime';