This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Tie/File.pm: Fix pod broken link typo
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index 0e56b88..e9549d5 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -758,15 +758,12 @@ perl_destruct(pTHXx)
 
     PerlIO_destruct(aTHX);
 
-    if (PL_sv_objcount) {
-       /*
-        * Try to destruct global references.  We do this first so that the
-        * destructors and destructees still exist.  Some sv's might remain.
-        * Non-referenced objects are on their own.
-        */
-       sv_clean_objs();
-       PL_sv_objcount = 0;
-    }
+    /*
+     * Try to destruct global references.  We do this first so that the
+     * destructors and destructees still exist.  Some sv's might remain.
+     * Non-referenced objects are on their own.
+     */
+    sv_clean_objs();
 
     /* unhook hooks which will soon be, or use, destroyed data */
     SvREFCNT_dec(PL_warnhook);
@@ -3471,7 +3468,7 @@ S_minus_v(pTHX)
 #endif
 
        PerlIO_printf(PIO_stdout,
-                     "\n\nCopyright 1987-2012, Larry Wall\n");
+                     "\n\nCopyright 1987-2013, Larry Wall\n");
 #ifdef MSDOS
        PerlIO_printf(PIO_stdout,
                      "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
@@ -3649,6 +3646,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
     int fdscript = -1;
     PerlIO *rsfp = NULL;
     dVAR;
+    Stat_t tmpstatbuf;
 
     PERL_ARGS_ASSERT_OPEN_SCRIPT;
 
@@ -3758,6 +3756,13 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
     /* ensure close-on-exec */
     fcntl(PerlIO_fileno(rsfp), F_SETFD, 1);
 #endif
+
+    if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0
+        && S_ISDIR(tmpstatbuf.st_mode))
+        Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
+            CopFILE(PL_curcop),
+            strerror(EISDIR));
+
     return rsfp;
 }
 
@@ -4483,16 +4488,12 @@ S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags)
     PERL_ARGS_ASSERT_MAYBERELOCATE;
     assert(len > 0);
 
-       if (len) {
-           /* I am not convinced that this is valid when PERLLIB_MANGLE is
-              defined to so something (in os2/os2.c), but the code has been
-              this way, ignoring any possible changed of length, since
-              760ac839baf413929cd31cc32ffd6dba6b781a81 (5.003_02) so I'll leave
-              it be.  */
-           libdir = newSVpvn(PERLLIB_MANGLE(dir, len), len);
-       } else {
-           libdir = newSVpv(PERLLIB_MANGLE(dir, 0), 0);
-       }
+    /* I am not convinced that this is valid when PERLLIB_MANGLE is
+       defined to so something (in os2/os2.c), but the code has been
+       this way, ignoring any possible changed of length, since
+       760ac839baf413929cd31cc32ffd6dba6b781a81 (5.003_02) so I'll leave
+       it be.  */
+    libdir = newSVpvn(PERLLIB_MANGLE(dir, len), len);
 
 #ifdef VMS
     {