Install extensions with bootstrap (again) in $archlib

[p5sagit/p5-mst-13.2.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 5cfb74b..e630e1f 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -525,16 +525,17 @@ PP(pp_binmode)
 PP(pp_tie)
 {
     djSP;
+    dMARK;
     SV *varsv;
     HV* stash;
     GV *gv;
     SV *sv;
-    SV **mark = stack_base + ++*markstack_ptr; /* reuse in entersub */
-    I32 markoff = mark - stack_base - 1;
+    I32 markoff = MARK - stack_base;
     char *methname;
     int how = 'P';
+    U32 items;
 
-    varsv = mark[0];  
+    varsv = *++MARK;
     switch(SvTYPE(varsv)) {
        case SVt_PVHV:
            methname = "TIEHASH";
@@ -551,26 +552,39 @@ PP(pp_tie)
            how = 'q';
            break;
     }
-
-    if (sv_isobject(mark[1])) {
+    items = SP - MARK++;
+    if (sv_isobject(*MARK)) {
        ENTER;
+       PUSHSTACK(SI_MAGIC);
+       PUSHMARK(SP);
+       EXTEND(SP,items);
+       while (items--)
+           PUSHs(*MARK++);
+       PUTBACK;
        perl_call_method(methname, G_SCALAR);
     } 
     else {
        /* Not clear why we don't call perl_call_method here too.
         * perhaps to get different error message ?
         */
-       stash = gv_stashsv(mark[1], FALSE);
+       stash = gv_stashsv(*MARK, FALSE);
        if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
            DIE("Can't locate object method \"%s\" via package \"%s\"",
-                methname, SvPV(mark[1],na));                   
+                methname, SvPV(*MARK,na));                   
        }
        ENTER;
+       PUSHSTACK(SI_MAGIC);
+       PUSHMARK(SP);
+       EXTEND(SP,items);
+       while (items--)
+           PUSHs(*MARK++);
+       PUTBACK;
        perl_call_sv((SV*)GvCV(gv), G_SCALAR);
     }
     SPAGAIN;
 
     sv = TOPs;
+    POPSTACK();
     if (sv_isobject(sv)) {
        sv_unmagic(varsv, how);            
        sv_magic(varsv, sv, how, Nullch, 0);
@@ -4110,41 +4124,55 @@ PP(pp_gpwent)
     if (pwent) {
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setpv(sv, pwent->pw_name);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setpv(sv, pwent->pw_passwd);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setiv(sv, (IV)pwent->pw_uid);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setiv(sv, (IV)pwent->pw_gid);
+
+       /* pw_change, pw_quota, and pw_age are mutually exclusive. */
        PUSHs(sv = sv_mortalcopy(&sv_no));
 #ifdef PWCHANGE
        sv_setiv(sv, (IV)pwent->pw_change);
 #else
-#ifdef PWQUOTA
+#   ifdef PWQUOTA
        sv_setiv(sv, (IV)pwent->pw_quota);
-#else
-#ifdef PWAGE
+#   else
+#       ifdef PWAGE
        sv_setpv(sv, pwent->pw_age);
+#       endif
+#   endif
 #endif
-#endif
-#endif
+
+       /* pw_class and pw_comment are mutually exclusive. */
        PUSHs(sv = sv_mortalcopy(&sv_no));
 #ifdef PWCLASS
        sv_setpv(sv, pwent->pw_class);
 #else
-#ifdef PWCOMMENT
+#   ifdef PWCOMMENT
        sv_setpv(sv, pwent->pw_comment);
+#   endif
 #endif
-#endif
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
+#ifdef PWGECOS
        sv_setpv(sv, pwent->pw_gecos);
+#endif
 #ifndef INCOMPLETE_TAINTS
+       /* pw_gecos is tainted. */
        SvTAINTED_on(sv);
 #endif
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setpv(sv, pwent->pw_dir);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setpv(sv, pwent->pw_shell);
+
 #ifdef PWEXPIRE
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setiv(sv, (IV)pwent->pw_expire);