-open my $diagfh, "<:raw", "../pod/perldiag.pod"
- or die "Can't open ../pod/perldiag.pod: $!";
+chdir '..' or die "Can't chdir ..: $!";
+BEGIN { defined $ENV{PERL_UNICODE} and push @INC, "lib"; }
+
+my @functions;
+
+open my $func_fh, "<", "embed.fnc" or die "Can't open embed.fnc: $!";
+
+# Look for functions in embed.fnc that look like they could be diagnostic ones.
+while (<$func_fh>) {
+ chomp;
+ s/^\s+//;
+ while (s/\s*\\$//) { # Grab up all continuation lines, these end in \
+ my $next = <$func_fh>;
+ $next =~ s/^\s+//;
+ chomp $next;
+ $_ .= $next;
+ }
+ next if /^:/; # Lines beginning with colon are comments.
+ next unless /\|/; # Lines without a vertical bar are something we can't deal
+ # with
+ my @fields = split /\s*\|\s*/;
+ next unless $fields[2] =~ /warn|err|(\b|_)die|croak/i;
+ push @functions, $fields[2];
+
+ # The flag p means that this function may have a 'Perl_' prefix
+ # The flag s means that this function may have a 'S_' prefix
+ push @functions, "Perl_$fields[2]", if $fields[0] =~ /p/;
+ push @functions, "S_$fields[2]", if $fields[0] =~ /s/;
+}
+
+close $func_fh;
+
+my $function_re = join '|', @functions;
+my $source_msg_re = qr/(?<routine>\bDIE\b|$function_re)/;