This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
dist/Data-Dumper/t/quotekeys.t: Generalize for EBCDIC
[perl5.git] / pp_ctl.c
index d69710c..f7cb216 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -586,6 +586,7 @@ PP(pp_formline)
                         break;
                 }
                 itembytes = s - item;
+                chophere = s;
                break;
            }
 
@@ -2090,6 +2091,28 @@ PP(pp_leave)
     RETURN;
 }
 
+static bool
+S_outside_integer(pTHX_ SV *sv)
+{
+  if (SvOK(sv)) {
+    const NV nv = SvNV_nomg(sv);
+    if (Perl_isinfnan(nv))
+      return TRUE;
+#ifdef NV_PRESERVES_UV
+    if (nv < (NV)IV_MIN || nv > (NV)IV_MAX)
+      return TRUE;
+#else
+    if (nv <= (NV)IV_MIN)
+      return TRUE;
+    if ((nv > 0) &&
+        ((nv > (NV)UV_MAX ||
+          SvUV_nomg(sv) > (UV)IV_MAX)))
+      return TRUE;
+#endif
+  }
+  return FALSE;
+}
+
 PP(pp_enteriter)
 {
     dSP; dMARK;
@@ -2148,32 +2171,13 @@ PP(pp_enteriter)
            SvGETMAGIC(sv);
            SvGETMAGIC(right);
            if (RANGE_IS_NUMERIC(sv,right)) {
-               NV nv;
                cx->cx_type &= ~CXTYPEMASK;
                cx->cx_type |= CXt_LOOP_LAZYIV;
                /* Make sure that no-one re-orders cop.h and breaks our
                   assumptions */
                assert(CxTYPE(cx) == CXt_LOOP_LAZYIV);
-#ifdef NV_PRESERVES_UV
-               if ((SvOK(sv) && (((nv = SvNV_nomg(sv)) < (NV)IV_MIN) ||
-                                 (nv > (NV)IV_MAX)))
-                       ||
-                   (SvOK(right) && (((nv = SvNV_nomg(right)) > (NV)IV_MAX) ||
-                                    (nv < (NV)IV_MIN))))
-#else
-               if ((SvOK(sv) && (((nv = SvNV_nomg(sv)) <= (NV)IV_MIN)
-                                 ||
-                                 ((nv > 0) &&
-                                       ((nv > (NV)UV_MAX) ||
-                                        (SvUV_nomg(sv) > (UV)IV_MAX)))))
-                       ||
-                   (SvOK(right) && (((nv = SvNV_nomg(right)) <= (NV)IV_MIN)
-                                    ||
-                                    ((nv > 0) &&
-                                       ((nv > (NV)UV_MAX) ||
-                                        (SvUV_nomg(right) > (UV)IV_MAX))
-                                    ))))
-#endif
+               if (S_outside_integer(aTHX_ sv) ||
+                    S_outside_integer(aTHX_ right))
                    DIE(aTHX_ "Range iterator outside integer range");
                cx->blk_loop.state_u.lazyiv.cur = SvIV_nomg(sv);
                cx->blk_loop.state_u.lazyiv.end = SvIV_nomg(right);
@@ -3117,8 +3121,7 @@ PP(pp_goto)
        }
     }
 
-    else {
-        assert(do_dump);
+    if (do_dump) {
 #ifdef VMS
        if (!retop) retop = PL_main_start;
 #endif
@@ -3666,7 +3669,7 @@ S_doopen_pm(pTHX_ SV *name)
 #endif /* !PERL_DISABLE_PMC */
 
 /* require doesn't search for absolute names, or when the name is
-   explicity relative the current directory */
+   explicitly relative the current directory */
 PERL_STATIC_INLINE bool
 S_path_is_searchable(const char *name)
 {
@@ -5429,7 +5432,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     umaxlen = maxlen;
 
     /* I was having segfault trouble under Linux 2.2.5 after a
-       parse error occured.  (Had to hack around it with a test
+       parse error occurred.  (Had to hack around it with a test
        for PL_parser->error_count == 0.)  Solaris doesn't segfault --
        not sure where the trouble is yet.  XXX */