Tie/File.pm: Fix pod broken link typo

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index 03e80a4..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);
@@ -1002,6 +999,16 @@ perl_destruct(pTHXx)
     PL_utf8_idstart    = NULL;
     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))
        PerlMemShared_free(PL_compiling.cop_warnings);
@@ -2242,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");
 
@@ -3025,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);
@@ -3036,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;
@@ -3130,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");
        }
@@ -3153,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 {
@@ -3181,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;
     }  
@@ -3274,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++;
@@ -3462,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");
@@ -3640,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;
 
@@ -3749,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;
 }
 
@@ -4474,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
     {