X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=8e11c43cbfd7c61feaa52888574ecf4b4527bb0f;hb=8f1f23e8b15dc90b39e5be39711437f27f72b526;hp=c91c960632ea89a34a25a59524022bd6669f0ad0;hpb=32b3cf08c33ce13099612a2fa015ff215de6fc24;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index c91c960..8e11c43 100644
--- a/perl.c
+++ b/perl.c
@@ -13,7 +13,6 @@
 
 #include "EXTERN.h"
 #include "perl.h"
-#include "patchlevel.h"
 
 /* XXX If this causes problems, set i_unistd=undef in the hint file.  */
 #ifdef I_UNISTD
@@ -210,13 +209,13 @@ perl_construct(register PerlInterpreter *sv_interp)
     STATUS_ALL_SUCCESS;
 
     SET_NUMERIC_STANDARD();
-#if defined(SUBVERSION) && SUBVERSION > 0
-    sprintf(PL_patchlevel, "%7.5f",   (double) 5 
-				+ ((double) PATCHLEVEL / (double) 1000)
-				+ ((double) SUBVERSION / (double) 100000));
+#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
+    sprintf(PL_patchlevel, "%7.5f",   (double) PERL_REVISION
+				+ ((double) PERL_VERSION / (double) 1000)
+				+ ((double) PERL_SUBVERSION / (double) 100000));
 #else
-    sprintf(PL_patchlevel, "%5.3f", (double) 5 +
-				((double) PATCHLEVEL / (double) 1000));
+    sprintf(PL_patchlevel, "%5.3f", (double) PERL_REVISION +
+				((double) PERL_VERSION / (double) 1000));
 #endif
 
 #if defined(LOCAL_PATCH_COUNT)
@@ -564,6 +563,9 @@ perl_destruct(register PerlInterpreter *sv_interp)
     MUTEX_DESTROY(&PL_eval_mutex);
     MUTEX_DESTROY(&PL_cred_mutex);
     COND_DESTROY(&PL_eval_cond);
+#ifdef EMULATE_ATOMIC_REFCOUNTS
+    MUTEX_DESTROY(&PL_svref_mutex);
+#endif /* EMULATE_ATOMIC_REFCOUNTS */
 
     /* As the penultimate thing, free the non-arena SV for thrsv */
     Safefree(SvPVX(PL_thrsv));
@@ -656,7 +658,7 @@ setuid perl scripts securely.\n");
 	return 255;
 #endif
 
-#if defined(NeXT) && defined(__DYNAMIC__)
+#if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
     _dyld_lookup_and_bind
 	("__environ", (unsigned long *) &environ_pointer, NULL);
 #endif /* environ */
@@ -730,6 +732,9 @@ setuid perl scripts securely.\n");
 	s = argv[0]+1;
       reswitch:
 	switch (*s) {
+#ifndef PERL_STRICT_CR
+	case '\r':
+#endif
 	case ' ':
 	case '0':
 	case 'F':
@@ -891,19 +896,25 @@ print \"  \\@INC:\\n    @INC\\n\";");
   switch_end:
 
     if (!PL_tainting && (s = PerlEnv_getenv("PERL5OPT"))) {
-	while (s && *s) {
-	    while (isSPACE(*s))
-		s++;
-	    if (*s == '-') {
-		s++;
-		if (isSPACE(*s))
-		    continue;
+	while (isSPACE(*s))
+	    s++;
+	if (*s == '-' && *(s+1) == 'T')
+	    PL_tainting = TRUE;
+	else {
+	    while (s && *s) {
+		while (isSPACE(*s))
+		    s++;
+		if (*s == '-') {
+		    s++;
+		    if (isSPACE(*s))
+			continue;
+		}
+		if (!*s)
+		    break;
+		if (!strchr("DIMUdmw", *s))
+		    croak("Illegal switch in PERL5OPT: -%c", *s);
+		s = moreswitches(s);
 	    }
-	    if (!*s)
-		break;
-	    if (!strchr("DIMUdmw", *s))
-		croak("Illegal switch in PERL5OPT: -%c", *s);
-	    s = moreswitches(s);
 	}
     }
 
@@ -1104,7 +1115,7 @@ perl_run(PerlInterpreter *sv_interp)
 }
 
 SV*
-perl_get_sv(char *name, I32 create)
+perl_get_sv(const char *name, I32 create)
 {
     GV *gv;
 #ifdef USE_THREADS
@@ -1123,7 +1134,7 @@ perl_get_sv(char *name, I32 create)
 }
 
 AV*
-perl_get_av(char *name, I32 create)
+perl_get_av(const char *name, I32 create)
 {
     GV* gv = gv_fetchpv(name, create, SVt_PVAV);
     if (create)
@@ -1134,7 +1145,7 @@ perl_get_av(char *name, I32 create)
 }
 
 HV*
-perl_get_hv(char *name, I32 create)
+perl_get_hv(const char *name, I32 create)
 {
     GV* gv = gv_fetchpv(name, create, SVt_PVHV);
     if (create)
@@ -1145,7 +1156,7 @@ perl_get_hv(char *name, I32 create)
 }
 
 CV*
-perl_get_cv(char *name, I32 create)
+perl_get_cv(const char *name, I32 create)
 {
     GV* gv = gv_fetchpv(name, create, SVt_PVCV);
     /* XXX unsafe for threads if eval_owner isn't held */
@@ -1162,7 +1173,7 @@ perl_get_cv(char *name, I32 create)
 /* Be sure to refetch the stack pointer after calling these routines. */
 
 I32
-perl_call_argv(char *sub_name, I32 flags, register char **argv)
+perl_call_argv(const char *sub_name, I32 flags, register char **argv)
               
           		/* See G_* flags in cop.h */
                      	/* null terminated arg list */
@@ -1181,7 +1192,7 @@ perl_call_argv(char *sub_name, I32 flags, register char **argv)
 }
 
 I32
-perl_call_pv(char *sub_name, I32 flags)
+perl_call_pv(const char *sub_name, I32 flags)
               		/* name of the subroutine */
           		/* See G_* flags in cop.h */
 {
@@ -1189,7 +1200,7 @@ perl_call_pv(char *sub_name, I32 flags)
 }
 
 I32
-perl_call_method(char *methname, I32 flags)
+perl_call_method(const char *methname, I32 flags)
                		/* name of the subroutine */
           		/* See G_* flags in cop.h */
 {
@@ -1438,7 +1449,7 @@ perl_eval_sv(SV *sv, I32 flags)
 }
 
 SV*
-perl_eval_pv(char *p, I32 croak_on_error)
+perl_eval_pv(const char *p, I32 croak_on_error)
 {
     dSP;
     SV* sv = newSVpv(p, 0);
@@ -1462,7 +1473,7 @@ perl_eval_pv(char *p, I32 croak_on_error)
 /* Require a module. */
 
 void
-perl_require_pv(char *pv)
+perl_require_pv(const char *pv)
 {
     SV* sv;
     dSP;
@@ -1713,9 +1724,9 @@ moreswitches(char *s)
 	s++;
 	return s;
     case 'v':
-#if defined(SUBVERSION) && SUBVERSION > 0
-	printf("\nThis is perl, version 5.%03d_%02d built for %s",
-	    PATCHLEVEL, SUBVERSION, ARCHNAME);
+#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
+	printf("\nThis is perl, version %d.%03d_%02d built for %s",
+	    PERL_REVISION, PERL_VERSION, PERL_SUBVERSION, ARCHNAME);
 #else
 	printf("\nThis is perl, version %s built for %s",
 		PL_patchlevel, ARCHNAME);
@@ -2113,6 +2124,13 @@ sed %s -e \"/^[^#]/b\" \
     }
 }
 
+/* Mention
+ * I_SYSSTATVFS	HAS_FSTATVFS
+ * I_SYSMOUNT
+ * I_STATFS	HAS_FSTATFS
+ * I_MNTENT	HAS_GETMNTENT	HAS_HASMNTOPT
+ * here so that metaconfig picks them up. */
+
 #ifdef IAMSUID
 static int
 fd_on_nosuid_fs(int fd)