Correct SvEND docs

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index 9ebb3d2..8f5f7c0 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -13,7 +13,7 @@
 /*
  *      A ship then new they built for him
  *      of mithril and of elven-glass
- *              --from Bilbo's song of Eärendil
+ *              --from Bilbo's song of Eärendil
  *
  *     [p.236 of _The Lord of the Rings_, II/i: "Many Meetings"]
  */
@@ -38,15 +38,15 @@
 #include "nwutil.h"    
 #endif
 
-/* XXX If this causes problems, set i_unistd=undef in the hint file.  */
-#ifdef I_UNISTD
-#include <unistd.h>
+#ifdef USE_KERN_PROC_PATHNAME
+#  include <sys/sysctl.h>
+#endif
+
+#ifdef USE_NSGETEXECUTABLEPATH
+#  include <mach-o/dyld.h>
 #endif
 
 #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
-#  ifdef I_SYS_WAIT
-#   include <sys/wait.h>
-#  endif
 #  ifdef I_SYSUIO
 #    include <sys/uio.h>
 #  endif
@@ -983,10 +983,8 @@ perl_destruct(pTHXx)
 
     /* clear utf8 character classes */
     SvREFCNT_dec(PL_utf8_alnum);
-    SvREFCNT_dec(PL_utf8_ascii);
     SvREFCNT_dec(PL_utf8_alpha);
     SvREFCNT_dec(PL_utf8_space);
-    SvREFCNT_dec(PL_utf8_cntrl);
     SvREFCNT_dec(PL_utf8_graph);
     SvREFCNT_dec(PL_utf8_digit);
     SvREFCNT_dec(PL_utf8_upper);
@@ -1003,10 +1001,8 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_utf8_idcont);
     SvREFCNT_dec(PL_utf8_foldclosures);
     PL_utf8_alnum      = NULL;
-    PL_utf8_ascii      = NULL;
     PL_utf8_alpha      = NULL;
     PL_utf8_space      = NULL;
-    PL_utf8_cntrl      = NULL;
     PL_utf8_graph      = NULL;
     PL_utf8_digit      = NULL;
     PL_utf8_upper      = NULL;
@@ -1389,54 +1385,81 @@ Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr)
     ++PL_exitlistlen;
 }
 
-#ifdef HAS_PROCSELFEXE
-/* This is a function so that we don't hold on to MAXPATHLEN
-   bytes of stack longer than necessary
- */
-STATIC void
-S_procself_val(pTHX_ SV *sv, const char *arg0)
-{
-    char buf[MAXPATHLEN];
-    int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
-
-    /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe)
-       includes a spurious NUL which will cause $^X to fail in system
-       or backticks (this will prevent extensions from being built and
-       many tests from working). readlink is not meant to add a NUL.
-       Normal readlink works fine.
-     */
-    if (len > 0 && buf[len-1] == '\0') {
-      len--;
-    }
-
-    /* FreeBSD's implementation is acknowledged to be imperfect, sometimes
-       returning the text "unknown" from the readlink rather than the path
-       to the executable (or returning an error from the readlink).  Any valid
-       path has a '/' in it somewhere, so use that to validate the result.
-       See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703
-    */
-    if (len > 0 && memchr(buf, '/', len)) {
-       sv_setpvn(sv,buf,len);
-    }
-    else {
-       sv_setpv(sv,arg0);
-    }
-}
-#endif /* HAS_PROCSELFEXE */
-
 STATIC void
 S_set_caret_X(pTHX) {
     dVAR;
     GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */
     if (tmpgv) {
-#ifdef HAS_PROCSELFEXE
-       S_procself_val(aTHX_ GvSV(tmpgv), PL_origargv[0]);
+       SV *const caret_x = GvSV(tmpgv);
+#if defined(OS2)
+       sv_setpv(caret_x, os2_execname(aTHX));
 #else
-#ifdef OS2
-       sv_setpv(GvSVn(tmpgv), os2_execname(aTHX));
-#else
-       sv_setpv(GvSVn(tmpgv),PL_origargv[0]);
-#endif
+#  ifdef USE_KERN_PROC_PATHNAME
+       size_t size = 0;
+       int mib[4];
+       mib[0] = CTL_KERN;
+       mib[1] = KERN_PROC;
+       mib[2] = KERN_PROC_PATHNAME;
+       mib[3] = -1;
+
+       if (sysctl(mib, 4, NULL, &size, NULL, 0) == 0
+           && size > 0 && size < MAXPATHLEN * MAXPATHLEN) {
+           sv_grow(caret_x, size);
+
+           if (sysctl(mib, 4, SvPVX(caret_x), &size, NULL, 0) == 0
+               && size > 2) {
+               SvPOK_only(caret_x);
+               SvCUR_set(caret_x, size - 1);
+               SvTAINT(caret_x);
+               return;
+           }
+       }
+#  elif defined(USE_NSGETEXECUTABLEPATH)
+       char buf[1];
+       uint32_t size = sizeof(buf);
+
+       _NSGetExecutablePath(buf, &size);
+       if (size < MAXPATHLEN * MAXPATHLEN) {
+           sv_grow(caret_x, size);
+           if (_NSGetExecutablePath(SvPVX(caret_x), &size) == 0) {
+               char *const tidied = realpath(SvPVX(caret_x), NULL);
+               if (tidied) {
+                   sv_setpv(caret_x, tidied);
+                   free(tidied);
+               } else {
+                   SvPOK_only(caret_x);
+                   SvCUR_set(caret_x, size);
+               }
+               return;
+           }
+       }
+#  elif defined(HAS_PROCSELFEXE)
+       char buf[MAXPATHLEN];
+       int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
+
+       /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe)
+          includes a spurious NUL which will cause $^X to fail in system
+          or backticks (this will prevent extensions from being built and
+          many tests from working). readlink is not meant to add a NUL.
+          Normal readlink works fine.
+       */
+       if (len > 0 && buf[len-1] == '\0') {
+           len--;
+       }
+
+       /* FreeBSD's implementation is acknowledged to be imperfect, sometimes
+          returning the text "unknown" from the readlink rather than the path
+          to the executable (or returning an error from the readlink). Any
+          valid path has a '/' in it somewhere, so use that to validate the
+          result. See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703
+       */
+       if (len > 0 && memchr(buf, '/', len)) {
+           sv_setpvn(caret_x, buf, len);
+           return;
+       }
+#  endif
+       /* Fallback to this:  */
+       sv_setpv(caret_x, PL_origargv[0]);
 #endif
     }
 }
@@ -1659,6 +1682,9 @@ S_Internals_V(pTHX_ CV *cv)
 #  ifdef DEBUGGING
                             " DEBUGGING"
 #  endif
+#  ifdef HOMEGROWN_POSIX_SIGNALS
+                            " HOMEGROWN_POSIX_SIGNALS"
+#  endif
 #  ifdef NO_MATHOMS
                             " NO_MATHOMS"
 #  endif