Fix some integer overflow issues (and a porting/diag.t bug)

dump.c

@@ -2765,9 +2765,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                                  PTR2UV(CvSTART(sv)));
                 else
                     Perl_dump_indent(aTHX_ level, file,
-                                 "  START = 0x%" UVxf " ===> %" IVdf "\n",
+                                 "  START = 0x%" UVxf " ===> %" UVuf "\n",
                                  PTR2UV(CvSTART(sv)),
-                                 (IV)sequence_num(CvSTART(sv)));
+                                 sequence_num(CvSTART(sv)));
             }
             Perl_dump_indent(aTHX_ level, file, "  ROOT = 0x%" UVxf "\n",
                              PTR2UV(CvROOT(sv)));

perl.h

@@ -1700,8 +1700,15 @@ Use L</UV> to declare variables of the maximum usable size on this platform.
  * multiple of PTRSIZE, for a minimum of PERL_STRLEN_NEW_MIN. This is
  * not entirely useless, just not terribly accurate.
  */
-#define expected_size(n) ( ((n) > PERL_STRLEN_NEW_MIN)               \
-                            ? (((n) + PTRSIZE - 1) & ~(PTRSIZE - 1)) \
+#define expected_size(n) ( ((n) > PERL_STRLEN_NEW_MIN)                                     \
+                            ? (                                                            \
+                                (void)(                                                    \
+                                    (MEM_SIZE)(n) > MEM_SIZE_MAX - (PTRSIZE - 1)           \
+                                        ? (croak_memory_wrap(), 0)                         \
+                                        : 0                                                \
+                                ),                                                         \
+                                ((MEM_SIZE)(n) + (PTRSIZE - 1)) & ~(MEM_SIZE)(PTRSIZE - 1) \
+                            )                                                              \
                             : PERL_STRLEN_NEW_MIN )
 
 /* This use of offsetof() requires /Zc:offsetof- for VS2017 (and presumably

pod/perldiag.pod

@@ -5228,6 +5228,12 @@ was string.
 
 (P) The compiler attempted to do a goto, or something weird like that.
 
+=item panic! %s: %d: Tried to warn when none expected at '%s'
+
+(P) The regex engine tried to emit a warning for a temporary regex that it
+generated internally. This should never happen because any regex thus generated
+should be correct and free of warnings.
+
 =item panic: unexpected constant lvalue entersub entry via type/targ %d:%d
 
 (P) When compiling a subroutine call in lvalue context, Perl failed an

pp_ctl.c

@@ -6852,7 +6852,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     const int filter_has_file = IoLINES(datasv);
     SV * const filter_state = MUTABLE_SV(IoTOP_GV(datasv));
     SV * const filter_sub = MUTABLE_SV(IoBOTTOM_GV(datasv));
-    int status = 0;
+    I32 status = 0;
     SV *upstream;
     STRLEN got_len;
     char *got_p = NULL;

pp_sort.c

@@ -1167,7 +1167,6 @@ static I32
 S_sortcv(pTHX_ SV *const a, SV *const b)
 {
     const I32 oldsaveix = PL_savestack_ix;
-    I32 result;
     PMOP * const pm = PL_curpm;
     COP * const cop = PL_curcop;
     SV *olda, *oldb;
@@ -1191,7 +1190,11 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     /* entry zero of a stack is always PL_sv_undef, which
      * simplifies converting a '()' return into undef in scalar context */
     assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
-    result = SvIV(*PL_stack_sp);
+    const IV iv = SvIV(*PL_stack_sp);
+    const I32 result =
+        iv > 0 ? 1 :
+        iv < 0 ? -1 :
+        0;
     rpp_popfree_to_NN(PL_stack_base);
 
     LEAVE_SCOPE(oldsaveix);
@@ -1206,7 +1209,6 @@ static I32
 S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
 {
     const I32 oldsaveix = PL_savestack_ix;
-    I32 result;
     AV * const av = GvAV(PL_defgv);
     PMOP * const pm = PL_curpm;
     COP * const cop = PL_curcop;
@@ -1256,7 +1258,11 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     /* entry zero of a stack is always PL_sv_undef, which
      * simplifies converting a '()' return into undef in scalar context */
     assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
-    result = SvIV(*PL_stack_sp);
+    const IV iv = SvIV(*PL_stack_sp);
+    const I32 result =
+        iv > 0 ? 1 :
+        iv < 0 ? -1 :
+        0;
     rpp_popfree_to_NN(PL_stack_base);
 
     LEAVE_SCOPE(oldsaveix);
@@ -1273,7 +1279,6 @@ S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
 {
     const I32 oldsaveix = PL_savestack_ix;
     CV * const cv=MUTABLE_CV(PL_sortcop);
-    I32 result;
     PMOP * const pm = PL_curpm;
 
     PERL_ARGS_ASSERT_SORTCV_XSUB;
@@ -1291,7 +1296,11 @@ S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
     /* entry zero of a stack is always PL_sv_undef, which
      * simplifies converting a '()' return into undef in scalar context */
     assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
-    result = SvIV(*PL_stack_sp);
+    const IV iv = SvIV(*PL_stack_sp);
+    const I32 result =
+        iv > 0 ? 1 :
+        iv < 0 ? -1 :
+        0;
     rpp_popfree_to_NN(PL_stack_base);
 
     LEAVE_SCOPE(oldsaveix);

pp_sys.c

@@ -5123,7 +5123,7 @@ PP_wrapped(pp_sleep, MAXARG, 0)
     if (MAXARG < 1 || (!TOPs && !POPs))
         PerlProc_pause();
     else {
-        const I32 duration = POPi;
+        const IV duration = POPi;
         if (duration < 0) {
           /* diag_listed_as: %s() with negative argument */
           ck_warner_d(packWARN(WARN_MISC),

t/porting/diag.t

@@ -12,7 +12,7 @@ use TestInit qw(T); # T is chdir to the top level
 use warnings;
 use strict;
 use Config;
-use Data::Dumper;
+#use Data::Dumper;
 require './t/test.pl';
 
 if ( $Config{usecrosscompile} ) {
@@ -56,9 +56,9 @@ push @functions, 'Perl_mess';
 @functions = sort { length($b) <=> length($a) || $a cmp $b } @functions;
 push @functions, 'PERL_DIAG_(?<wrapper>\w+)';
 
-my $regcomp_fail_re = '\b(?:(?:Simple_)?v)?FAIL[2-4]?(?:utf8f)?\b';
+my $regcomp_func_re = '\b(?:(?:Simple_)?v)?FAIL[2-4]?(?:utf8f)?\b';
 my $regcomp_re =
-   "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_fail_re)";
+   "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_func_re)";
 my $function_re = join '|', @functions;
 my $source_msg_re =
    "(?<routine>\\bDIE\\b|$function_re)";
@@ -69,7 +69,7 @@ my $source_msg_call_re = qr/$source_msg_re(?:_nocontext)? \s*
     (?:(?<category>WARN_DEPRECATED__\w+)\s*,(?:\s*(?<version_string>"[^"]+")\s*,)?)? \s*
     $text_re /x;
 my $bad_version_re = qr{BADVERSION\([^"]*$text_re};
-   $regcomp_fail_re = qr/$regcomp_fail_re\([^"]*$text_re/;
+my $regcomp_fail_re = qr/$regcomp_func_re\([^"]*$text_re/;
 my $regcomp_call_re = qr/$regcomp_re.*?$text_re/;
 
 my %entries;
@@ -332,20 +332,36 @@ sub check_file {
         }
       }
     }
-    next if /^#/;
+    if (/^#/) {
+      if (/^#\h*define\h+$regcomp_func_re/) {
+        # skip over entire definition of (v)FAIL macro
+        while (defined && m!\\$!) {
+          $_ = <$codefh>;
+        }
+      }
+      next;
+    }
 
     my $multiline = 0;
     # Loop to accumulate the message text all on one line.
-    if (m/(?!^)\b(?:$source_msg_re(?:_nocontext)?|$regcomp_re)\s*\((?<tail>(?:[^()]+|\([^()]+\))+\))?/
+    if (m/(?!^)\b(?:$source_msg_re(?:_nocontext)?|$regcomp_re)\s*\((?<tail>(?:[^()]|\([^()]*\))*\))?/
         and !$+{tail}
     ) {
       while (not m/\);\s*$/) {
-        my $nextline = <$codefh>;
+        my $nextchar = getc $codefh;
         # Means we fell off the end of the file.  Not terribly surprising;
         # this code tries to merge a lot of things that aren't regular C
         # code (preprocessor stuff, long comments).  That's OK; we don't
         # need those anyway.
-        last if not defined $nextline;
+        last if not defined $nextchar;
+
+        # If the next line is a preprocessor directive (starts with '#'), we
+        # stop without consuming it and let the next iteration of the outer
+        # loop handle it.
+        $codefh->ungetc(ord $nextchar);
+        last if $nextchar eq '#';
+
+        my $nextline = readline $codefh;
         chomp $nextline;
         $nextline =~ s/^\s+//;
         $_ =~ s/\\$//;
@@ -475,12 +491,12 @@ sub check_file {
 
     next if $name=~/\[TESTING\]/; # ignore these as they are works in progress
 
-    check_message(standardize($name),$codefn,$severity,$categories);
+    check_message(standardize($name),$codefn,$first_line,$severity,$categories);
   }
 }
 
 sub check_message {
-    my($name,$codefn,$severity,$categories,$partial) = @_;
+    my($name,$codefn,$lineno,$severity,$categories,$partial) = @_;
     my $key = $name =~ y/\n/ /r;
     my $ret;
 
@@ -511,7 +527,7 @@ sub check_message {
           # There is no listing, but it is in the list of exceptions.  TODO FAIL.
           fail($key);
           diag(
-            "    Message '$name'\n    from $codefn line $. is not listed in $pod\n".
+            "    Message '$name'\n    from $codefn line $lineno is not listed in $pod\n".
             "    (but it wasn't documented in 5.10 either, so marking it TODO)."
           );
         }
@@ -538,7 +554,7 @@ sub check_message {
         like($entries{$key}{severity}, $qr,
           ($severity =~ /\[/
             ? "severity is one of $severity"
-            : "severity is $severity") . " for '$name' at $codefn line $.$pod_line")
+            : "severity is $severity") . " for '$name' at $codefn line $lineno$pod_line")
         or do {
             if ($severity=~/D/ and $entries{$key}{severity}=~/W/) {
                 diag("You should change W to D if this is a deprecation");
@@ -547,15 +563,15 @@ sub check_message {
 
         is($entries{$key}{category}, $categories,
            ($categories ? "categories are [$categories]" : "no category")
-             . " for '$name' at $codefn line $.$pod_line");
+             . " for '$name' at $codefn line $lineno$pod_line");
       }
     } elsif ($partial) {
       # noop
     } else {
       my $ok;
       if ($name =~ /\n/) {
         $ok = 1;
-        check_message($_,$codefn,$severity,$categories,1) or $ok = 0, last
+        check_message($_,$codefn,$lineno,$severity,$categories,1) or $ok = 0, last
           for split /\n/, $name;
       }
       if ($ok) {
@@ -571,7 +587,7 @@ sub check_message {
         # No listing found, and no excuse either.
         # Find the correct place in perldiag.pod, and add a stanza beginning =item $name.
         fail($name);
-        diag("    Message '$name'\n    from $codefn line $. is not listed in $pod");
+        diag("    Message '$name'\n    from $codefn line $lineno is not listed in $pod");
       }
       # seen it, so only fail once for this message
       $entries{$name}{seen}++;