perl/hints/vos.sh

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

diff --git a/perl.c b/perl.c
index a27620a..91a3dda 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1,6 +1,6 @@
 /*    perl.c
  *
- *    Copyright (c) 1987-2001 Larry Wall
+ *    Copyright (c) 1987-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.
@@ -102,6 +102,8 @@ perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
 #else
 
 /*
+=head1 Embedding Functions
+
 =for apidoc perl_alloc
 
 Allocates a new Perl interpreter.  See L<perlembed>.
@@ -200,16 +202,6 @@ perl_construct(pTHXx)
 
        PL_sighandlerp = Perl_sighandler;
        PL_pidstatus = newHV();
-
-#ifdef MSDOS
-       /*
-        * There is no way we can refer to them from Perl so close them to save
-        * space.  The other alternative would be to provide STDAUX and STDPRN
-        * filehandles.
-        */
-       (void)PerlIO_close(PerlIO_importFILE(stdaux, 0));
-       (void)PerlIO_close(PerlIO_importFILE(stdprn, 0));
-#endif
     }
 
     PL_rs = newSVpvn("\n", 1);
@@ -694,15 +686,8 @@ perl_destruct(pTHXx)
     if (!specialCopIO(PL_compiling.cop_io))
        SvREFCNT_dec(PL_compiling.cop_io);
     PL_compiling.cop_io = Nullsv;
-#ifdef USE_ITHREADS
-    Safefree(CopFILE(&PL_compiling));
-    CopFILE(&PL_compiling) = Nullch;
-    Safefree(CopSTASHPV(&PL_compiling));
-#else
-    SvREFCNT_dec(CopFILEGV(&PL_compiling));
-    CopFILEGV(&PL_compiling) = Nullgv;
-    /* cop_stash is not refcounted */
-#endif
+    CopFILE_free(&PL_compiling);
+    CopSTASH_free(&PL_compiling);
 
     /* Prepare to destruct main symbol table.  */
 
@@ -1099,10 +1084,16 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                goto reswitch;
            break;
 
-    case 't':
-        PL_taint_warn = TRUE;
+       case 't':
+           if( !PL_tainting ) {
+                PL_taint_warn = TRUE;
+                PL_tainting = TRUE;
+           }
+           s++;
+           goto reswitch;
        case 'T':
            PL_tainting = TRUE;
+           PL_taint_warn = FALSE;
            s++;
            goto reswitch;
 
@@ -1281,8 +1272,10 @@ print \"  \\@INC:\\n    @INC\\n\";");
        char *popt = s;
        while (isSPACE(*s))
            s++;
-       if (*s == '-' && *(s+1) == 'T')
+       if (*s == '-' && *(s+1) == 'T') {
            PL_tainting = TRUE;
+            PL_taint_warn = FALSE;
+       }
        else {
            char *popt_copy = Nullch;
            while (s && *s) {
@@ -1297,7 +1290,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
                d = s;
                if (!*s)
                    break;
-               if (!strchr("DIMUdmw", *s))
+               if (!strchr("DIMUdmtw", *s))
                    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
                while (++s && *s) {
                    if (isSPACE(*s)) {
@@ -1310,11 +1303,22 @@ print \"  \\@INC:\\n    @INC\\n\";");
                        break;
                    }
                }
-               moreswitches(d);
+               if (*d == 't') {
+                   if( !PL_tainting ) {
+                       PL_taint_warn = TRUE;
+                       PL_tainting = TRUE;
+                   }
+               } else {
+                   moreswitches(d);
+               }
            }
        }
     }
 
+    if (PL_taint_warn && PL_dowarn != G_WARN_ALL_OFF) {
+       PL_compiling.cop_warnings = newSVpvn(WARN_TAINTstring, WARNsize);
+    }
+
     if (!scriptname)
        scriptname = argv[0];
     if (PL_e_script) {
@@ -1603,6 +1607,8 @@ S_run_body(pTHX_ I32 oldscope)
 }
 
 /*
+=head1 SV Manipulation Functions
+
 =for apidoc p||get_sv
 
 Returns the SV of the specified Perl scalar.  If C<create> is set and the
@@ -1630,6 +1636,8 @@ Perl_get_sv(pTHX_ const char *name, I32 create)
 }
 
 /*
+=head1 Array Manipulation Functions
+
 =for apidoc p||get_av
 
 Returns the AV of the specified Perl array.  If C<create> is set and the
@@ -1651,6 +1659,8 @@ Perl_get_av(pTHX_ const char *name, I32 create)
 }
 
 /*
+=head1 Hash Manipulation Functions
+
 =for apidoc p||get_hv
 
 Returns the HV of the specified Perl hash.  If C<create> is set and the
@@ -1672,6 +1682,8 @@ Perl_get_hv(pTHX_ const char *name, I32 create)
 }
 
 /*
+=head1 CV Manipulation Functions
+
 =for apidoc p||get_cv
 
 Returns the CV of the specified Perl subroutine.  If C<create> is set and
@@ -1703,6 +1715,9 @@ Perl_get_cv(pTHX_ const char *name, I32 create)
 /* Be sure to refetch the stack pointer after calling these routines. */
 
 /*
+
+=head1 Callback Functions
+
 =for apidoc p||call_argv
 
 Performs a callback to the specified Perl sub.  See L<perlcall>.
@@ -2084,6 +2099,8 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
 /* Require a module. */
 
 /*
+=head1 Embedding Functions
+
 =for apidoc p||require_pv
 
 Tells Perl to C<require> the file named by the string argument.  It is
@@ -2423,10 +2440,10 @@ Perl_moreswitches(pTHX_ char *s)
 #endif
 
        PerlIO_printf(PerlIO_stdout(),
-                     "\n\nCopyright 1987-2001, Larry Wall\n");
+                     "\n\nCopyright 1987-2002, Larry Wall\n");
 #ifdef MACOS_TRADITIONAL
        PerlIO_printf(PerlIO_stdout(),
-                     "\nMac OS port Copyright 1991-2001, Matthias Neeracher;\n"
+                     "\nMac OS port Copyright 1991-2002, Matthias Neeracher;\n"
                      "maintained by Chris Nandor\n");
 #endif
 #ifdef MSDOS
@@ -2441,7 +2458,7 @@ Perl_moreswitches(pTHX_ char *s)
 #ifdef OS2
        PerlIO_printf(PerlIO_stdout(),
                      "\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
-                     "Version 5 port Copyright (c) 1994-1999, Andreas Kaiser, Ilya Zakharevich\n");
+                     "Version 5 port Copyright (c) 1994-2002, Andreas Kaiser, Ilya Zakharevich\n");
 #endif
 #ifdef atarist
        PerlIO_printf(PerlIO_stdout(),
@@ -2453,7 +2470,7 @@ Perl_moreswitches(pTHX_ char *s)
 #endif
 #ifdef MPE
        PerlIO_printf(PerlIO_stdout(),
-                     "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2001\n");
+                     "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2002\n");
 #endif
 #ifdef OEMVS
        PerlIO_printf(PerlIO_stdout(),
@@ -2461,7 +2478,7 @@ Perl_moreswitches(pTHX_ char *s)
 #endif
 #ifdef __VOS__
        PerlIO_printf(PerlIO_stdout(),
-                     "Stratus VOS port by Paul_Green@stratus.com, 1997-1999\n");
+                     "Stratus VOS port by Paul_Green@stratus.com, 1997-2002\n");
 #endif
 #ifdef __OPEN_VM
        PerlIO_printf(PerlIO_stdout(),
@@ -2477,10 +2494,10 @@ Perl_moreswitches(pTHX_ char *s)
 #endif
 #ifdef EPOC
        PerlIO_printf(PerlIO_stdout(),
-                     "EPOC port by Olaf Flebbe, 1999-2000\n");
+                     "EPOC port by Olaf Flebbe, 1999-2002\n");
 #endif
 #ifdef UNDER_CE
-       printf("WINCE port by Rainer Keuchel, 2001\n");
+       printf("WINCE port by Rainer Keuchel, 2001-2002\n");
        printf("Built on " __DATE__ " " __TIME__ "\n\n");
        wce_hitreturn();
 #endif
@@ -2502,11 +2519,15 @@ Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
        return s;
     case 'W':
        PL_dowarn = G_WARN_ALL_ON|G_WARN_ON;
+        if (!specialWARN(PL_compiling.cop_warnings))
+            SvREFCNT_dec(PL_compiling.cop_warnings);
        PL_compiling.cop_warnings = pWARN_ALL ;
        s++;
        return s;
     case 'X':
        PL_dowarn = G_WARN_ALL_OFF;
+        if (!specialWARN(PL_compiling.cop_warnings))
+            SvREFCNT_dec(PL_compiling.cop_warnings);
        PL_compiling.cop_warnings = pWARN_NONE ;
        s++;
        return s;
@@ -2679,11 +2700,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
        }
     }
 
-#   ifdef USE_ITHREADS
-        Safefree(CopFILE(PL_curcop));
-#   else
-        SvREFCNT_dec(CopFILEGV(PL_curcop));
-#   endif
+    CopFILE_free(PL_curcop);
     CopFILE_set(PL_curcop, PL_origfilename);
     if (strEQ(PL_origfilename,"-"))
        scriptname = "";