[win32] another maintpatch (this one needed adjust of test nos.)

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

diff --git a/mg.c b/mg.c
index 8a7cfdd..4f5f06f 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -69,7 +69,6 @@ restore_magic(void *p)
     }
 }
 
-
 void
 mg_magical(SV *sv)
 {
@@ -171,6 +170,37 @@ mg_len(SV *sv)
     return len;
 }
 
+I32
+mg_size(SV *sv)
+{
+    MAGIC* mg;
+    I32 len;
+    
+    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+       MGVTBL* vtbl = mg->mg_virtual;
+       if (vtbl && vtbl->svt_len) {
+           MGS mgs;
+           ENTER;
+           /* omit MGf_GSKIP -- not changed here */
+           len = (*vtbl->svt_len)(sv, mg);
+           LEAVE;
+           return len;
+       }
+    }
+
+    switch(SvTYPE(sv)) {
+       case SVt_PVAV:
+           len = AvFILLp((AV *) sv); /* Fallback to non-tied array */
+           return len;
+       case SVt_PVHV:
+           /* FIXME */
+       default:
+           croak("Size magic not implemented");
+           break;
+    }
+    return 0;
+}
+
 int
 mg_clear(SV *sv)
 {
@@ -350,10 +380,22 @@ magic_get(SV *sv, MAGIC *mg)
            sv_setpv(sv, os2error(Perl_rc));
        }
 #else
+#ifdef WIN32
+       {
+           DWORD dwErr = GetLastError();
+           sv_setnv(sv, (double)dwErr);
+           if (dwErr)
+               win32_str_os_error(sv, dwErr);
+           else
+               sv_setpv(sv, "");
+           SetLastError(dwErr);
+       }
+#else
        sv_setnv(sv, (double)errno);
        sv_setpv(sv, errno ? Strerror(errno) : "");
 #endif
 #endif
+#endif
        SvNOK_on(sv);   /* what a wonderful hack! */
        break;
     case '\006':               /* ^F */
@@ -600,7 +642,7 @@ magic_setenv(SV *sv, MAGIC *mg)
     }
 #endif
 
-#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32)
+#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) && !defined(MSDOS)
                            /* And you'll never guess what the dog had */
                            /*   in its mouth... */
     if (tainting) {
@@ -649,7 +691,7 @@ magic_setenv(SV *sv, MAGIC *mg)
            }
        }
     }
-#endif /* neither OS2 nor AMIGAOS nor WIN32 */
+#endif /* neither OS2 nor AMIGAOS nor WIN32 nor MSDOS */
 
     return 0;
 }
@@ -854,8 +896,9 @@ magic_setisa(SV *sv, MAGIC *mg)
 
     stash = GvSTASH(mg->mg_obj);
     svp = AvARRAY((AV*)sv);
-    
-    for (fill = AvFILL((AV*)sv); fill >= 0; fill--, svp++) {
+                
+    /* NOTE: No support for tied ISA */
+    for (fill = AvFILLp((AV*)sv); fill >= 0; fill--, svp++) {
        HV *basestash = gv_stashsv(*svp, FALSE);
 
        if (!basestash) {
@@ -909,30 +952,46 @@ magic_setnkeys(SV *sv, MAGIC *mg)
        LvTARG(sv) = Nullsv;    /* Don't allow a ref to reassign this. */
     }
     return 0;
-}
+}          
 
 static int
-magic_methpack(SV *sv, MAGIC *mg, char *meth)
+magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val)
 {
     dSP;
 
-    ENTER;
-    SAVETMPS;
     PUSHMARK(sp);
-    EXTEND(sp, 2);
+    EXTEND(sp, n);
     PUSHs(mg->mg_obj);
-    if (mg->mg_ptr) {
-       if (mg->mg_len >= 0)
-           PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
-       else if (mg->mg_len == HEf_SVKEY)
-           PUSHs((SV*)mg->mg_ptr);
+    if (n > 1) { 
+       if (mg->mg_ptr) {
+           if (mg->mg_len >= 0)
+               PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
+           else if (mg->mg_len == HEf_SVKEY)
+               PUSHs((SV*)mg->mg_ptr);
+       }
+       else if (mg->mg_type == 'p') {
+           PUSHs(sv_2mortal(newSViv(mg->mg_len)));
+       }
+    }
+    if (n > 2) {
+       PUSHs(val);
     }
-    else if (mg->mg_type == 'p')
-       PUSHs(sv_2mortal(newSViv(mg->mg_len)));
     PUTBACK;
 
-    if (perl_call_method(meth, G_SCALAR))
+    return perl_call_method(meth, flags);
+}
+
+static int
+magic_methpack(SV *sv, MAGIC *mg, char *meth)
+{
+    dSP;
+
+    ENTER;
+    SAVETMPS;
+
+    if (magic_methcall(mg, meth, G_SCALAR, 2, NULL)) {
        sv_setsv(sv, *stack_sp--);
+    }
 
     FREETMPS;
     LEAVE;
@@ -950,25 +1009,10 @@ magic_getpack(SV *sv, MAGIC *mg)
 
 int
 magic_setpack(SV *sv, MAGIC *mg)
-{
-    dSP;
-
-    PUSHMARK(sp);
-    EXTEND(sp, 3);
-    PUSHs(mg->mg_obj);
-    if (mg->mg_ptr) {
-       if (mg->mg_len >= 0)
-           PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
-       else if (mg->mg_len == HEf_SVKEY)
-           PUSHs((SV*)mg->mg_ptr);
-    }
-    else if (mg->mg_type == 'p')
-       PUSHs(sv_2mortal(newSViv(mg->mg_len)));
-    PUSHs(sv);
-    PUTBACK;
-
-    perl_call_method("STORE", G_SCALAR|G_DISCARD);
-
+{   
+    ENTER;
+    magic_methcall(mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
+    LEAVE;
     return 0;
 }
 
@@ -978,6 +1022,24 @@ magic_clearpack(SV *sv, MAGIC *mg)
     return magic_methpack(sv,mg,"DELETE");
 }
 
+
+U32
+magic_sizepack(SV *sv, MAGIC *mg)
+{         
+    dTHR;
+    U32 retval = 0;
+
+    ENTER;
+    SAVETMPS;
+    if (magic_methcall(mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
+       sv = *stack_sp--;
+       retval = (U32) SvIV(sv)-1;
+    }
+    FREETMPS;
+    LEAVE;
+    return retval;
+}
+
 int magic_wipepack(SV *sv, MAGIC *mg)
 {
     dSP;
@@ -985,9 +1047,9 @@ int magic_wipepack(SV *sv, MAGIC *mg)
     PUSHMARK(sp);
     XPUSHs(mg->mg_obj);
     PUTBACK;
-
+    ENTER;
     perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
-
+    LEAVE;
     return 0;
 }
 
@@ -1197,7 +1259,7 @@ magic_getdefelem(SV *sv, MAGIC *mg)
                targ = HeVAL(he);
        }
        else {
-           AV* av = (AV*)LvTARG(sv);
+           AV* av = (AV*)LvTARG(sv); 
            if ((I32)LvTARGOFF(sv) <= AvFILL(av))
                targ = AvARRAY(av)[LvTARGOFF(sv)];
        }
@@ -1349,9 +1411,13 @@ magic_set(SV *sv, MAGIC *mg)
 #ifdef VMS
        set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 #else
+#ifdef WIN32
+       SetLastError( SvIV(sv) );
+#else
        /* will anyone ever use this? */
        SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
 #endif
+#endif
        break;
     case '\006':       /* ^F */
        maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
@@ -1481,7 +1547,7 @@ magic_set(SV *sv, MAGIC *mg)
            STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
        break;
     case '!':
-       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),
+       SETERRNO(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0,
                 (SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
        break;
     case '<':
@@ -1797,7 +1863,7 @@ sighandler(int sig)
 
     oldstack = curstack;
     if (curstack != signalstack)
-       AvFILL(signalstack) = 0;
+       AvFILLp(signalstack) = 0;
     SWITCHSTACK(curstack, signalstack);
 
     if(psig_name[sig]) {