X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=eb386eede1c984f0ca19de3fe2a8efd1d5f503ff;hb=d54344fc28d39ef8e90173262ec572bec67f5e6c;hp=ff85c372e83010645430d601833b78a3d867e02f;hpb=3510b4a1c70ec95b37a6a1ef86c5555610f0dc75;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index ff85c37..eb386ee 100644
--- a/pp.c
+++ b/pp.c
@@ -15,6 +15,7 @@
 #include "EXTERN.h"
 #define PERL_IN_PP_C
 #include "perl.h"
+#include "keywords.h"
 
 /* variations on pp_null */
 
@@ -365,6 +366,8 @@ PP(pp_prototype)
 		I32 oa;
 		char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
 
+		if (code == -KEY_chop || code == -KEY_chomp)
+		    goto set;
 		while (i < MAXO) {	/* The slow way. */
 		    if (strEQ(s + 6, PL_op_name[i])
 			|| strEQ(s + 6, PL_op_desc[i]))
@@ -1120,8 +1123,8 @@ PP(pp_modulo)
     {
 	UV left  = 0;
 	UV right = 0;
-	bool left_neg;
-	bool right_neg;
+	bool left_neg = FALSE;
+	bool right_neg = FALSE;
 	bool use_double = FALSE;
 	bool dright_valid = FALSE;
 	NV dright = 0.0;
@@ -2255,7 +2258,7 @@ PP(pp_complement)
 	      while (tmps < send) {
 		  UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
 		  tmps += UTF8SKIP(tmps);
-		  result = uvchr_to_utf8(result, ~c);
+		  result = uvchr_to_utf8_flags(result, ~c, UNICODE_ALLOW_ANY);
 	      }
 	      *result = '\0';
 	      result -= targlen;
@@ -2624,7 +2627,7 @@ PP(pp_log)
       value = POPn;
       if (value <= 0.0) {
 	SET_NUMERIC_STANDARD();
-	DIE(aTHX_ "Can't take log of %g", value);
+	DIE(aTHX_ "Can't take log of %"NVgf, value);
       }
       value = Perl_log(value);
       XPUSHn(value);
@@ -2640,7 +2643,7 @@ PP(pp_sqrt)
       value = POPn;
       if (value < 0.0) {
 	SET_NUMERIC_STANDARD();
-	DIE(aTHX_ "Can't take sqrt of %g", value);
+	DIE(aTHX_ "Can't take sqrt of %"NVgf, value);
       }
       value = Perl_sqrt(value);
       XPUSHn(value);
@@ -2648,6 +2651,28 @@ PP(pp_sqrt)
     }
 }
 
+/*
+ * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
+ * These need to be revisited when a newer toolchain becomes available.
+ */
+#if defined(__sparc64__) && defined(__GNUC__)
+#   if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
+#       undef  SPARC64_MODF_WORKAROUND
+#       define SPARC64_MODF_WORKAROUND 1
+#   endif
+#endif
+
+#if defined(SPARC64_MODF_WORKAROUND)
+static NV
+sparc64_workaround_modf(NV theVal, NV *theIntRes)
+{
+    NV res, ret;
+    ret = Perl_modf(theVal, &res);
+    *theIntRes = res;
+    return ret;
+}
+#endif
+
 PP(pp_int)
 {
     dSP; dTARGET; tryAMAGICun(int);
@@ -2671,21 +2696,25 @@ PP(pp_int)
 	      if (value < (NV)UV_MAX + 0.5) {
 		  SETu(U_V(value));
 	      } else {
-#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
-#   ifdef HAS_MODFL_POW32_BUG
+#if defined(SPARC64_MODF_WORKAROUND)
+		(void)sparc64_workaround_modf(value, &value);
+#else
+#   if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
+#       ifdef HAS_MODFL_POW32_BUG
 /* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */
                 { 
                     NV offset = Perl_modf(value, &value);
                     (void)Perl_modf(offset, &offset);
                     value += offset;
                 }
-#   else
+#       else
 		  (void)Perl_modf(value, &value);
-#   endif
-#else
+#       endif
+#   else
 		  double tmp = (double)value;
 		  (void)Perl_modf(tmp, &tmp);
 		  value = (NV)tmp;
+#   endif
 #endif
 		  SETn(value);
 	      }
@@ -3119,7 +3148,8 @@ PP(pp_chr)
 
     if (value > 255 && !IN_BYTES) {
 	SvGROW(TARG, UNISKIP(value)+1);
-	tmps = (char*)uvchr_to_utf8((U8*)SvPVX(TARG), value);
+	tmps = (char*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value,
+					  UNICODE_ALLOW_SUPER);
 	SvCUR_set(TARG, tmps - SvPVX(TARG));
 	*tmps = '\0';
 	(void)SvPOK_only(TARG);
@@ -3184,7 +3214,7 @@ PP(pp_ucfirst)
     STRLEN slen;
 
     if (DO_UTF8(sv)) {
-	U8 tmpbuf[UTF8_MAXLEN*2+1];
+	U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
 	STRLEN ulen;
 	STRLEN tculen;
 
@@ -3239,7 +3269,7 @@ PP(pp_lcfirst)
 
     if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
 	STRLEN ulen;
-	U8 tmpbuf[UTF8_MAXLEN*2+1];
+	U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
 	U8 *tend;
 	UV uv;
 
@@ -3296,7 +3326,7 @@ PP(pp_uc)
 	STRLEN ulen;
 	register U8 *d;
 	U8 *send;
-	U8 tmpbuf[UTF8_MAXLEN*2+1];
+	U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
 
 	s = (U8*)SvPV(sv,len);
 	if (!len) {
@@ -3363,7 +3393,7 @@ PP(pp_lc)
 	STRLEN ulen;
 	register U8 *d;
 	U8 *send;
-	U8 tmpbuf[UTF8_MAXLEN*2+1];
+	U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
 
 	s = (U8*)SvPV(sv,len);
 	if (!len) {