NetWare tweak from Ananth Kesari.

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index 4369e4a..30f91ee 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1,6 +1,6 @@
 /*    mg.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -12,6 +12,10 @@
  * come here, and I don't want to see no more magic,' he said, and fell silent."
  */
 
+/*
+=head1 Magical Functions
+*/
+
 #include "EXTERN.h"
 #define PERL_IN_MG_C
 #include "perl.h"
@@ -30,7 +34,7 @@
 #  define  FAKE_PERSISTENT_SIGNAL_HANDLERS
 #endif
 /* if we're doing kill() with sys$sigprc on VMS, FAKE_DEFAULT_SIGNAL_HANDLERS */
-#if defined(KILL_BY_SIGPRC) 
+#if defined(KILL_BY_SIGPRC)
 #  define  FAKE_DEFAULT_SIGNAL_HANDLERS
 #endif
 
@@ -208,7 +212,7 @@ Perl_mg_length(pTHX_ SV *sv)
        }
     }
 
-    if (DO_UTF8(sv)) 
+    if (DO_UTF8(sv))
     {
         U8 *s = (U8*)SvPV(sv, len);
         len = Perl_utf8_length(aTHX_ s, s + len);
@@ -271,7 +275,7 @@ Perl_mg_clear(pTHX_ SV *sv)
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
        MGVTBL* vtbl = mg->mg_virtual;
        /* omit GSKIP -- never set here */
-       
+
        if (vtbl && vtbl->svt_clear)
            CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg);
     }
@@ -315,7 +319,11 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
     int count = 0;
     MAGIC* mg;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-       if (isUPPER(mg->mg_type)) {
+       MGVTBL* vtbl = mg->mg_virtual;
+       if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){
+           count += CALL_FPTR(vtbl->svt_copy)(aTHX_ sv, mg, nsv, key, klen);
+       }
+       else if (isUPPER(mg->mg_type)) {
            sv_magic(nsv,
                     mg->mg_type == PERL_MAGIC_tied ? SvTIED_obj(sv, mg) :
                     (mg->mg_type == PERL_MAGIC_regdata && mg->mg_obj)
@@ -346,7 +354,7 @@ Perl_mg_free(pTHX_ SV *sv)
        if (vtbl && vtbl->svt_free)
            CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg);
        if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
-           if (mg->mg_len >= 0)
+           if (mg->mg_len > 0)
                Safefree(mg->mg_ptr);
            else if (mg->mg_len == HEf_SVKEY)
                SvREFCNT_dec((SV*)mg->mg_ptr);
@@ -400,7 +408,7 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
                    i = t;
                else                    /* @- */
                    i = s;
-               
+
                if (i > 0 && PL_reg_match_utf8) {
                    char *b = rx->subbeg;
                    if (b)
@@ -454,6 +462,14 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
                    Perl_croak(aTHX_ "panic: magic_len: %"IVdf, (IV)i);
                return i;
            }
+           else {
+               if (ckWARN(WARN_UNINITIALIZED))
+                   report_uninit();
+           }
+       }
+       else {
+           if (ckWARN(WARN_UNINITIALIZED))
+               report_uninit();
        }
        return 0;
     case '+':
@@ -532,11 +548,11 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 #ifdef MACOS_TRADITIONAL
             {
                  char msg[256];
-       
+
                  sv_setnv(sv,(double)gMacPerl_OSErr);
-                 sv_setpv(sv, gMacPerl_OSErr ? GetSysErrText(gMacPerl_OSErr, msg) : "");       
+                 sv_setpv(sv, gMacPerl_OSErr ? GetSysErrText(gMacPerl_OSErr, msg) : "");
             }
-#else  
+#else
 #ifdef VMS
             {
 #                include <descrip.h>
@@ -999,7 +1015,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS)||defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
 static int sig_handlers_initted = 0;
 #endif
-#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS   
+#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
 static int sig_ignoring[SIG_SIZE];      /* which signals we are ignoring */
 #endif
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
@@ -1069,7 +1085,9 @@ Perl_raise_signal(pTHX_ int sig)
 Signal_t
 Perl_csighandler(int sig)
 {
-#ifndef PERL_OLD_SIGNALS
+#ifdef PERL_GET_SIG_CONTEXT
+    dTHXa(PERL_GET_SIG_CONTEXT);
+#else
     dTHX;
 #endif
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
@@ -1077,7 +1095,7 @@ Perl_csighandler(int sig)
     if (sig_ignoring[sig]) return;
 #endif
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
-    if (sig_defaulting[sig]) 
+    if (sig_defaulting[sig])
 #ifdef KILL_BY_SIGPRC
             exit((Perl_sig_to_vmscondition(sig)&STS$M_COND_ID)|STS$K_SEVERE|STS$M_INHIB_MSG);
 #else
@@ -1242,7 +1260,7 @@ Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg)
 {
     HV *hv = (HV*)LvTARG(sv);
     I32 i = 0;
-     
+
     if (hv) {
          (void) hv_iterinit(hv);
          if (! SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
@@ -1503,7 +1521,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
        sv_pos_u2b(lsv, &p, 0);
        pos = p;
     }
-       
+
     mg->mg_len = pos;
     mg->mg_flags &= ~MGf_MINMATCH;
 
@@ -1927,7 +1945,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
                    else if (isWARN_on(sv, WARN_ALL) && !any_fatals) {
                        PL_compiling.cop_warnings = pWARN_ALL;
                        PL_dowarn |= G_WARN_ONCE ;
-                   }   
+                   }
                     else {
                        if (specialWARN(PL_compiling.cop_warnings))
                            PL_compiling.cop_warnings = newSVsv(sv) ;
@@ -2306,8 +2324,8 @@ static SV* sig_sv;
 Signal_t
 Perl_sighandler(int sig)
 {
-#if defined(WIN32) && defined(PERL_IMPLICIT_CONTEXT)
-    dTHXa(PL_curinterp);       /* fake TLS, because signals don't do TLS */
+#ifdef PERL_GET_SIG_CONTEXT
+    dTHXa(PERL_GET_SIG_CONTEXT);
 #else
     dTHX;
 #endif
@@ -2320,10 +2338,6 @@ Perl_sighandler(int sig)
     U32 flags = 0;
     XPV *tXpv = PL_Xpv;
 
-#if defined(WIN32) && defined(PERL_IMPLICIT_CONTEXT)
-    PERL_SET_THX(aTHX);        /* fake TLS, see above */
-#endif
-
     if (PL_savestack_ix + 15 <= PL_savestack_max)
        flags |= 1;
     if (PL_markstack_ptr < PL_markstack_max - 2)
@@ -2333,9 +2347,11 @@ Perl_sighandler(int sig)
     if (PL_scopestack_ix < PL_scopestack_max - 3)
        flags |= 16;
 
-    if (!PL_psig_ptr[sig])
-       Perl_die(aTHX_ "Signal SIG%s received, but no signal handler set.\n",
-           PL_sig_name[sig]);
+    if (!PL_psig_ptr[sig]) {
+               Perl_warn(aTHX_ "Signal SIG%s received, but no signal handler set.\n",
+                                PL_sig_name[sig]);
+               exit(sig);
+       }
 
     /* Max number of items pushed there is 3*n or 4. We cannot fix
        infinity, so we fix 4 (in fact 5): */
@@ -2477,3 +2493,5 @@ unwind_handler_stack(pTHX_ void *p)
        SvREFCNT_dec(sig_sv);
 #endif
 }
+
+