X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/86f72d56e71cb202c98802b68923dfca4797c3e2..ddf23d4a1ae98daa8608179f83aad311d03898ef:/perl.c

diff --git a/perl.c b/perl.c
index f8d9e8f..e9549d5 100644
--- 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);
@@ -1003,8 +1000,14 @@ perl_destruct(pTHXx)
     PL_utf8_idcont	= NULL;
     PL_utf8_foldclosures = NULL;
     for (i = 0; i < POSIX_CC_COUNT; i++) {
+        SvREFCNT_dec(PL_Posix_ptrs[i]);
+        PL_Posix_ptrs[i] = NULL;
+
         SvREFCNT_dec(PL_L1Posix_ptrs[i]);
         PL_L1Posix_ptrs[i] = NULL;
+
+        SvREFCNT_dec(PL_XPosix_ptrs[i]);
+        PL_XPosix_ptrs[i] = NULL;
     }
 
     if (!specialWARN(PL_compiling.cop_warnings))
@@ -2246,8 +2249,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
 
     lex_start(linestr_sv, rsfp, lex_start_flags);
-    if(linestr_sv)
-	SvREFCNT_dec(linestr_sv);
+    SvREFCNT_dec(linestr_sv);
 
     PL_subname = newSVpvs("main");
 
@@ -3029,7 +3031,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
 	/* if adding extra options, remember to update DEBUG_MASK */
 	static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMB";
 
-	for (; isALNUM(**s); (*s)++) {
+	for (; isWORDCHAR(**s); (*s)++) {
 	    const char * const d = strchr(debopts,**s);
 	    if (d)
 		i |= 1 << (d - debopts);
@@ -3040,7 +3042,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
     }
     else if (isDIGIT(**s)) {
 	i = atoi(*s);
-	for (; isALNUM(**s); (*s)++) ;
+	for (; isWORDCHAR(**s); (*s)++) ;
     }
     else if (givehelp) {
       const char *const *p = usage_msgd;
@@ -3134,7 +3136,7 @@ Perl_moreswitches(pTHX_ const char *s)
 	s++;
 
         /* -dt indicates to the debugger that threads will be used */
-	if (*s == 't' && !isALNUM(s[1])) {
+	if (*s == 't' && !isWORDCHAR(s[1])) {
 	    ++s;
 	    my_setenv("PERL5DB_THREADED", "1");
 	}
@@ -3157,7 +3159,7 @@ Perl_moreswitches(pTHX_ const char *s)
 	    end = s + strlen(s);
 
 	    /* We now allow -d:Module=Foo,Bar and -d:-Module */
-	    while(isALNUM(*s) || *s==':') ++s;
+	    while(isWORDCHAR(*s) || *s==':') ++s;
 	    if (*s != '=')
 		sv_catpvn(sv, start, end - start);
 	    else {
@@ -3185,7 +3187,7 @@ Perl_moreswitches(pTHX_ const char *s)
 	if (ckWARN_d(WARN_DEBUGGING))
 	    Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
 	           "Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)\n");
-	for (s++; isALNUM(*s); s++) ;
+	for (s++; isWORDCHAR(*s); s++) ;
 #endif
 	return s;
     }	
@@ -3278,7 +3280,7 @@ Perl_moreswitches(pTHX_ const char *s)
 	    sv = newSVpvn(use,4);
 	    start = s;
 	    /* We allow -M'Module qw(Foo Bar)'	*/
-	    while(isALNUM(*s) || *s==':') {
+	    while(isWORDCHAR(*s) || *s==':') {
 		if( *s++ == ':' ) {
 		    if( *s == ':' ) 
 			s++;
@@ -3466,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");
@@ -3644,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;
 
@@ -3753,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;
 }
 
@@ -4478,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
     {