for(;;), sort

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

diff --git a/perl.c b/perl.c
index 3e999c4..c57eaa8 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -300,7 +300,6 @@ void
 perl_destruct(pTHXx)
 {
     int destruct_level;  /* 0=none, 1=full, 2=full with checks */
-    I32 last_sv_count;
     HV *hv;
 #ifdef USE_THREADS
     Thread t;
@@ -396,6 +395,7 @@ perl_destruct(pTHXx)
     LEAVE;
     FREETMPS;
 
+
     /* We must account for everything.  */
 
     /* Destroy the main CV and syntax tree */
@@ -410,6 +410,13 @@ perl_destruct(pTHXx)
     PL_main_cv = Nullcv;
     PL_dirty = TRUE;
 
+    /* Tell PerlIO we are about to tear things apart in case
+       we have layers which are using resources that should
+       be cleaned up now.
+     */
+
+    PerlIO_destruct(aTHX);
+
     if (PL_sv_objcount) {
        /*
         * Try to destruct global references.  We do this first so that the
@@ -578,7 +585,7 @@ perl_destruct(pTHXx)
 #ifdef USE_LOCALE_NUMERIC
     Safefree(PL_numeric_name);
     PL_numeric_name = Nullch;
-    SvREFCNT_dec(PL_numeric_radix);
+    SvREFCNT_dec(PL_numeric_radix_sv);
 #endif
 
     /* clear utf8 character classes */
@@ -663,13 +670,13 @@ 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();
-    }
+
+    /* the 2 is for PL_fdpid and PL_strtab */
+    while (PL_sv_count > 2 && sv_clean_all())
+       ;
+
     SvFLAGS(PL_fdpid) &= ~SVTYPEMASK;
     SvFLAGS(PL_fdpid) |= SVt_PVAV;
     SvFLAGS(PL_strtab) &= ~SVTYPEMASK;
@@ -1978,10 +1985,11 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
 /*
 =for apidoc p||require_pv
 
-Tells Perl to C<require> a module.
+Tells Perl to C<require> the file named by the string argument.  It is
+analogous to the Perl code C<eval "require '$file'">.  It's even
+implemented that way; consider using Perl_load_module instead.
 
-=cut
-*/
+=cut */
 
 void
 Perl_require_pv(pTHX_ const char *pv)
@@ -2710,8 +2718,14 @@ sed %s -e \"/^[^#]/b\" \
        }
 #endif
 #endif
+#ifdef IAMSUID
+       errno = EPERM;
+       Perl_croak(aTHX_ "Can't open perl script: %s\n",
+                  Strerror(errno));
+#else
        Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
                   CopFILE(PL_curcop), Strerror(errno));
+#endif
     }
 }
 
@@ -3248,6 +3262,7 @@ S_init_predump_symbols(pTHX)
     PL_stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
     GvMULTI_on(PL_stdingv);
     io = GvIOp(PL_stdingv);
+    IoTYPE(io) = IoTYPE_RDONLY;
     IoIFP(io) = PerlIO_stdin();
     tmpgv = gv_fetchpv("stdin",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
@@ -3256,6 +3271,7 @@ S_init_predump_symbols(pTHX)
     tmpgv = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
     GvMULTI_on(tmpgv);
     io = GvIOp(tmpgv);
+    IoTYPE(io) = IoTYPE_WRONLY;
     IoOFP(io) = IoIFP(io) = PerlIO_stdout();
     setdefout(tmpgv);
     tmpgv = gv_fetchpv("stdout",TRUE, SVt_PV);
@@ -3265,6 +3281,7 @@ S_init_predump_symbols(pTHX)
     PL_stderrgv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
     GvMULTI_on(PL_stderrgv);
     io = GvIOp(PL_stderrgv);
+    IoTYPE(io) = IoTYPE_WRONLY;
     IoOFP(io) = IoIFP(io) = PerlIO_stderr();
     tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);