more complete File::Spec support for Mac and VMS, tests (from

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

diff --git a/perl.c b/perl.c
index 931e592..b5fd06f 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -442,10 +442,10 @@ perl_destruct(pTHXx)
 
     /* magical thingies */
 
-    Safefree(PL_ofs);  /* $, */
+    Safefree(PL_ofs);          /* $, */
     PL_ofs = Nullch;
 
-    Safefree(PL_ors);  /* $\ */
+    Safefree(PL_ors);          /* $\ */
     PL_ors = Nullch;
 
     SvREFCNT_dec(PL_rs);       /* $/ */
@@ -454,7 +454,9 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_nrs);      /* $/ helper */
     PL_nrs = Nullsv;
 
-    PL_multiline = 0;  /* $* */
+    PL_multiline = 0;          /* $* */
+    Safefree(PL_osname);       /* $^O */
+    PL_osname = Nullch;
 
     SvREFCNT_dec(PL_statname);
     PL_statname = Nullsv;
@@ -504,8 +506,6 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_argvout_stack);
     PL_argvout_stack = Nullav;
 
-    SvREFCNT_dec(PL_fdpid);
-    PL_fdpid = Nullav;
     SvREFCNT_dec(PL_modglobal);
     PL_modglobal = Nullhv;
     SvREFCNT_dec(PL_preambleav);
@@ -522,6 +522,13 @@ perl_destruct(pTHXx)
     PL_bodytarget = Nullsv;
     PL_formtarget = Nullsv;
 
+    /* free locale stuff */
+    Safefree(PL_collation_name);
+    PL_collation_name = Nullch;
+
+    Safefree(PL_numeric_name);
+    PL_numeric_name = Nullch;
+
     /* clear utf8 character classes */
     SvREFCNT_dec(PL_utf8_alnum);
     SvREFCNT_dec(PL_utf8_alnumc);
@@ -593,14 +600,21 @@ perl_destruct(pTHXx)
 
     /* Now absolutely destruct everything, somehow or other, loops or no. */
     last_sv_count = 0;
+    SvFLAGS(PL_fdpid) |= SVTYPEMASK;           /* don't clean out pid table now */
     SvFLAGS(PL_strtab) |= SVTYPEMASK;          /* don't clean out strtab now */
     while (PL_sv_count != 0 && PL_sv_count != last_sv_count) {
        last_sv_count = PL_sv_count;
        sv_clean_all();
     }
+    SvFLAGS(PL_fdpid) &= ~SVTYPEMASK;
+    SvFLAGS(PL_fdpid) |= SVt_PVAV;
     SvFLAGS(PL_strtab) &= ~SVTYPEMASK;
     SvFLAGS(PL_strtab) |= SVt_PVHV;
-    
+
+    AvREAL_off(PL_fdpid);              /* no surviving entries */
+    SvREFCNT_dec(PL_fdpid);            /* needed in io_close() */
+    PL_fdpid = Nullav;
+
     /* Destruct the global string table. */
     {
        /* Yell and reset the HeVAL() slots that are still holding refcounts,
@@ -632,6 +646,16 @@ perl_destruct(pTHXx)
     }
     SvREFCNT_dec(PL_strtab);
 
+    /* free special SVs */
+
+    SvREFCNT(&PL_sv_yes) = 0;
+    sv_clear(&PL_sv_yes);
+    SvANY(&PL_sv_yes) = NULL;
+
+    SvREFCNT(&PL_sv_no) = 0;
+    sv_clear(&PL_sv_no);
+    SvANY(&PL_sv_no) = NULL;
+
     if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
        Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
 
@@ -665,7 +689,7 @@ perl_destruct(pTHXx)
     Safefree(PL_thrsv);
     PL_thrsv = Nullsv;
 #endif /* USE_THREADS */
-    
+
     /* As the absolutely last thing, free the non-arena SV for mess() */
 
     if (PL_mess_sv) {
@@ -845,6 +869,7 @@ S_parse_body(pTHX_ va_list args)
 #endif
        case ' ':
        case '0':
+       case 'C':
        case 'F':
        case 'a':
        case 'c':
@@ -1451,13 +1476,15 @@ Perl_call_method(pTHX_ const char *methname, I32 flags)
 {
     dSP;
     OP myop;
-    if (!PL_op)
+    if (!PL_op) {
+       Zero(&myop, 1, OP);
        PL_op = &myop;
+    }
     XPUSHs(sv_2mortal(newSVpv(methname,0)));
     PUTBACK;
     pp_method();
-       if(PL_op == &myop)
-               PL_op = Nullop;
+    if (PL_op == &myop)
+       PL_op = Nullop;
     return call_sv(*PL_stack_sp--, flags);
 }
 
@@ -1797,6 +1824,7 @@ S_usage(pTHX_ char *name)         /* XXX move this out into a module ? */
     static char *usage_msg[] = {
 "-0[octal]       specify record separator (\\0, if no argument)",
 "-a              autosplit mode with -n or -p (splits $_ into @F)",
+"-C              enable native wide character system interfaces",
 "-c              check syntax only (runs BEGIN and END blocks)",
 "-d[:debugger]   run program under debugger",
 "-D[number/list] set debugging flags (argument is a bit mask or alphabets)",
@@ -1852,6 +1880,10 @@ Perl_moreswitches(pTHX_ char *s)
        }
        return s + numlen;
     }
+    case 'C':
+       PL_widesyscalls = TRUE;
+       s++;
+       return s;
     case 'F':
        PL_minus_F = TRUE;
        PL_splitstr = savepv(s + 1);
@@ -3113,16 +3145,23 @@ S_init_perllib(pTHX)
     incpush(PRIVLIB_EXP, FALSE);
 #endif
 
+#if defined(WIN32)
+    incpush(SITELIB_EXP, TRUE);        /* XXX Win32 needs inc_version_list support */
+#else
 #ifdef SITELIB_EXP
     {
-       char buf[MAXPATHLEN];
-
-       strcpy(buf,SITELIB_EXP);
-       if (strrchr(buf,'/'))           /* XXX Hack, Configure var needed */
-           *strrchr(buf,'/') = '\0';
-       incpush(buf, TRUE);
+       char *path = SITELIB_EXP;
+
+       if (path) {
+           char buf[1024];
+           strcpy(buf,path);
+           if (strrchr(buf,'/'))       /* XXX Hack, Configure var needed */
+               *strrchr(buf,'/') = '\0';
+           incpush(buf, TRUE);
+       }
     }
 #endif
+#endif
 #if defined(PERL_VENDORLIB_EXP)
 #if defined(WIN32) 
     incpush(PERL_VENDORLIB_EXP, TRUE);
@@ -3222,6 +3261,12 @@ S_incpush(pTHX_ char *p, int addsubdirs)
                  S_ISDIR(tmpstatbuf.st_mode))
                av_push(GvAVn(PL_incgv), newSVsv(subdir));
 
+           /* .../archname if -d .../archname */
+           Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME);
+           if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+                 S_ISDIR(tmpstatbuf.st_mode))
+               av_push(GvAVn(PL_incgv), newSVsv(subdir));
+
 #ifdef PERL_INC_VERSION_LIST
            for (incver = incverlist; *incver; incver++) {
                /* .../xxx if -d .../xxx */