X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=91a3ddaf686f3f19155d7a0307638e12a34f2bf9;hb=1059054db273fce406f731966b935f417b38dbd5;hp=a27620a41d6ff2dae2fe38eae0338db5ef408ad8;hpb=6537fe72dd6d63cc0c7164fec44beb82d2568599;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index a27620a..91a3dda 100644
--- 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 = "";