Skip most of FindExt's tests for troublesome configurations.

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index 5f0f758..7ff78c1 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1051,16 +1051,16 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        SvNOK_on(sv);   /* what a wonderful hack! */
        break;
     case '<':
-       sv_setiv(sv, (IV)PerlProc_getuid());
+        sv_setuid(sv, PerlProc_getuid());
        break;
     case '>':
-       sv_setiv(sv, (IV)PerlProc_geteuid());
+        sv_setuid(sv, PerlProc_geteuid());
        break;
     case '(':
-       sv_setiv(sv, (IV)PerlProc_getgid());
+        sv_setgid(sv, PerlProc_getgid());
        goto add_groups;
     case ')':
-       sv_setiv(sv, (IV)PerlProc_getegid());
+        sv_setgid(sv, PerlProc_getegid());
       add_groups:
 #ifdef HAS_GETGROUPS
        {
@@ -1704,7 +1704,7 @@ Returns the SV (if any) returned by the method, or NULL on failure.
 */
 
 SV*
-Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
+Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
                    U32 argc, ...)
 {
     dVAR;
@@ -1745,10 +1745,10 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
     }
     PUTBACK;
     if (flags & G_DISCARD) {
-       call_method(meth, G_SCALAR|G_DISCARD);
+       call_sv(meth, G_SCALAR|G_DISCARD|G_METHOD_NAMED);
     }
     else {
-       if (call_method(meth, G_SCALAR))
+       if (call_sv(meth, G_SCALAR|G_METHOD_NAMED))
            ret = *PL_stack_sp--;
     }
     POPSTACK;
@@ -1758,11 +1758,10 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
     return ret;
 }
 
-
 /* wrapper for magic_methcall that creates the first arg */
 
 STATIC SV*
-S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
+S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
     int n, SV *val)
 {
     dVAR;
@@ -1788,7 +1787,7 @@ S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
 }
 
 STATIC int
-S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, const char *meth)
+S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, SV *meth)
 {
     dVAR;
     SV* ret;
@@ -1808,7 +1807,7 @@ Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg)
 
     if (mg->mg_type == PERL_MAGIC_tiedelem)
        mg->mg_flags |= MGf_GSKIP;
-    magic_methpack(sv,mg,"FETCH");
+    magic_methpack(sv,mg,SV_CONST(FETCH));
     return 0;
 }
 
@@ -1840,7 +1839,7 @@ Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
     else
        val = sv;
 
-    magic_methcall1(sv, mg, "STORE", G_DISCARD, 2, val);
+    magic_methcall1(sv, mg, SV_CONST(STORE), G_DISCARD, 2, val);
     return 0;
 }
 
@@ -1850,7 +1849,7 @@ Perl_magic_clearpack(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_CLEARPACK;
 
     if (mg->mg_type == PERL_MAGIC_tiedscalar) return 0;
-    return magic_methpack(sv,mg,"DELETE");
+    return magic_methpack(sv,mg,SV_CONST(DELETE));
 }
 
 
@@ -1863,7 +1862,7 @@ Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
 
     PERL_ARGS_ASSERT_MAGIC_SIZEPACK;
 
-    retsv = magic_methcall1(sv, mg, "FETCHSIZE", 0, 1, NULL);
+    retsv = magic_methcall1(sv, mg, SV_CONST(FETCHSIZE), 0, 1, NULL);
     if (retsv) {
        retval = SvIV(retsv)-1;
        if (retval < -1)
@@ -1879,7 +1878,7 @@ Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
 
     PERL_ARGS_ASSERT_MAGIC_WIPEPACK;
 
-    Perl_magic_methcall(aTHX_ sv, mg, "CLEAR", G_DISCARD, 0);
+    Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(CLEAR), G_DISCARD, 0);
     return 0;
 }
 
@@ -1891,8 +1890,8 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 
     PERL_ARGS_ASSERT_MAGIC_NEXTPACK;
 
-    ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, "NEXTKEY", 0, 1, key)
-       : Perl_magic_methcall(aTHX_ sv, mg, "FIRSTKEY", 0, 0);
+    ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(NEXTKEY), 0, 1, key)
+       : Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(FIRSTKEY), 0, 0);
     if (ret)
        sv_setsv(key,ret);
     return 0;
@@ -1903,7 +1902,7 @@ Perl_magic_existspack(pTHX_ SV *sv, const MAGIC *mg)
 {
     PERL_ARGS_ASSERT_MAGIC_EXISTSPACK;
 
-    return magic_methpack(sv,mg,"EXISTS");
+    return magic_methpack(sv,mg,SV_CONST(EXISTS));
 }
 
 SV *
@@ -1929,7 +1928,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
     }
    
     /* there is a SCALAR method that we can call */
-    retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, "SCALAR", 0, 0);
+    retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, SV_CONST(SCALAR), 0, 0);
     if (!retval)
        retval = &PL_sv_undef;
     return retval;
@@ -2761,20 +2760,20 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        break;
     case '<':
        {
-       const IV new_uid = SvIV(sv);
+       const Uid_t new_uid = SvUID(sv);
        PL_delaymagic_uid = new_uid;
        if (PL_delaymagic) {
            PL_delaymagic |= DM_RUID;
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETRUID
-       (void)setruid((Uid_t)new_uid);
+       (void)setruid(new_uid);
 #else
 #ifdef HAS_SETREUID
-       (void)setreuid((Uid_t)new_uid, (Uid_t)-1);
+       (void)setreuid(new_uid, (Uid_t)-1);
 #else
 #ifdef HAS_SETRESUID
-      (void)setresuid((Uid_t)new_uid, (Uid_t)-1, (Uid_t)-1);
+      (void)setresuid(new_uid, (Uid_t)-1, (Uid_t)-1);
 #else
        if (new_uid == PerlProc_geteuid()) {            /* special case $< = $> */
 #ifdef PERL_DARWIN
@@ -2793,20 +2792,20 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        }
     case '>':
        {
-       const UV new_euid = SvIV(sv);
+       const Uid_t new_euid = SvUID(sv);
        PL_delaymagic_euid = new_euid;
        if (PL_delaymagic) {
            PL_delaymagic |= DM_EUID;
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETEUID
-       (void)seteuid((Uid_t)new_euid);
+       (void)seteuid(new_euid);
 #else
 #ifdef HAS_SETREUID
-       (void)setreuid((Uid_t)-1, (Uid_t)new_euid);
+       (void)setreuid((Uid_t)-1, new_euid);
 #else
 #ifdef HAS_SETRESUID
-       (void)setresuid((Uid_t)-1, (Uid_t)new_euid, (Uid_t)-1);
+       (void)setresuid((Uid_t)-1, new_euid, (Uid_t)-1);
 #else
        if (new_euid == PerlProc_getuid())              /* special case $> = $< */
            PerlProc_setuid(new_euid);
@@ -2820,20 +2819,20 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        }
     case '(':
        {
-       const UV new_gid = SvIV(sv);
+       const Gid_t new_gid = SvGID(sv);
        PL_delaymagic_gid = new_gid;
        if (PL_delaymagic) {
            PL_delaymagic |= DM_RGID;
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETRGID
-       (void)setrgid((Gid_t)new_gid);
+       (void)setrgid(new_gid);
 #else
 #ifdef HAS_SETREGID
-       (void)setregid((Gid_t)new_gid, (Gid_t)-1);
+       (void)setregid(new_gid, (Gid_t)-1);
 #else
 #ifdef HAS_SETRESGID
-      (void)setresgid((Gid_t)new_gid, (Gid_t)-1, (Gid_t) -1);
+      (void)setresgid(new_gid, (Gid_t)-1, (Gid_t) -1);
 #else
        if (new_gid == PerlProc_getegid())                      /* special case $( = $) */
            (void)PerlProc_setgid(new_gid);
@@ -2847,7 +2846,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        }
     case ')':
        {
-       UV new_egid;
+       Gid_t new_egid;
 #ifdef HAS_SETGROUPS
        {
            const char *p = SvPV_const(sv, len);
@@ -2863,7 +2862,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 
             while (isSPACE(*p))
                 ++p;
-            new_egid = Atol(p);
+            new_egid = (Gid_t)Atol(p);
             for (i = 0; i < maxgrp; ++i) {
                 while (*p && !isSPACE(*p))
                     ++p;
@@ -2875,14 +2874,14 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
                     Newx(gary, i + 1, Groups_t);
                 else
                     Renew(gary, i + 1, Groups_t);
-                gary[i] = Atol(p);
+                gary[i] = (Groups_t)Atol(p);
             }
             if (i)
                 (void)setgroups(i, gary);
            Safefree(gary);
        }
 #else  /* HAS_SETGROUPS */
-       new_egid = SvIV(sv);
+        new_egid = SvGID(sv);
 #endif /* HAS_SETGROUPS */
        PL_delaymagic_egid = new_egid;
        if (PL_delaymagic) {
@@ -2890,13 +2889,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETEGID
-       (void)setegid((Gid_t)new_egid);
+       (void)setegid(new_egid);
 #else
 #ifdef HAS_SETREGID
-       (void)setregid((Gid_t)-1, (Gid_t)new_egid);
+       (void)setregid((Gid_t)-1, new_egid);
 #else
 #ifdef HAS_SETRESGID
-       (void)setresgid((Gid_t)-1, (Gid_t)new_egid, (Gid_t)-1);
+       (void)setresgid((Gid_t)-1, new_egid, (Gid_t)-1);
 #else
        if (new_egid == PerlProc_getgid())                      /* special case $) = $( */
            (void)PerlProc_setgid(new_egid);
@@ -3181,7 +3180,7 @@ cleanup:
     /* pop any of SAVEFREESV, SAVEDESTRUCTOR_X and "save in progress" */
     PL_savestack_ix = old_ss_ix;
     if (flags & 8)
-       SvREFCNT_dec(sv);
+       SvREFCNT_dec_NN(sv);
     PL_op = myop;                      /* Apparently not needed... */
 
     PL_Sv = tSv;                       /* Restore global temporaries. */
@@ -3247,7 +3246,7 @@ S_restore_magic(pTHX_ const void *p)
            SvTEMP_off(sv);
        }
        else
-           SvREFCNT_dec(sv); /* undo the inc in S_save_magic() */
+           SvREFCNT_dec_NN(sv); /* undo the inc in S_save_magic() */
     }
 }