From fe572f30462d0e397b859a98684f391a76f9eb21 Mon Sep 17 00:00:00 2001 From: "Philippe Bruhat (BooK)" Date: Wed, 22 Oct 2025 22:16:57 +0200 Subject: [PATCH 1/9] add a script that merges all devel deltas into the final one For now, the script simply copies the content of each relevant section into the same one in the master document (pod/perldelta.pod). It will die when encountering an unexpected =head1 header. --- Porting/merge-deltas.pl | 205 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 205 insertions(+) create mode 100644 Porting/merge-deltas.pl diff --git a/Porting/merge-deltas.pl b/Porting/merge-deltas.pl new file mode 100644 index 000000000000..2e89401a6e21 --- /dev/null +++ b/Porting/merge-deltas.pl @@ -0,0 +1,205 @@ +#!perl +use v5.36; +use Pod::Simple::SimpleTree; + +# POD NAVIGATION SUBROUTINES + +sub header_pos ( $tree, $level, $title, $pos = 0 ) { + while ( $pos < @$tree ) { + next + unless ref( $tree->[$pos] ) eq 'ARRAY' + && $tree->[$pos][0] eq "head$level"; + return $pos if $tree->[$pos][2] eq $title; + } + continue { $pos++ } + return; # not found +} + +sub next_header_pos ( $tree, $level, $pos = 0 ) { + $pos++; + while ( $pos < @$tree ) { + next + unless ref( $tree->[$pos] ) eq 'ARRAY'; + next unless $tree->[$pos][0] =~ /\Ahead([1-4])\z/; + next if $1 > $level; + last if $1 < $level; + return $pos; + } + continue { $pos++ } + return; # not found +} + +sub find_pos_in ( $master, $delta, $title ) { + return + map header_pos( $_, 1, $title ), + $master, $delta; +} + +# POD GENERATION SUBROUTINES + +# NOTE: A Pod::Simple::SimpleTree "tree" is really just a list of +# directives. The only parts that are really tree-like / recursive are +# the list directives, and pod formatting codes. + +sub as_pod ( $tree ) { + return $tree unless ref $tree; # simple string + state $handler = { + Document => sub ( $name, $attr, @nodes ) { + return map( as_pod($_), @nodes), "=cut\n"; + }, + Para => sub ( $name, $attr, @nodes ) { + return map( as_pod($_), @nodes ), "\n\n"; + }, + Verbatim => sub ( $name, $attr, @nodes ) { + return map( as_pod($_), @nodes ), "\n\n"; + }, + X => sub ( $name, $attr, @nodes ) { + my ( $open, $spacer, $close ) = + $attr->{'~bracket_count'} + ? ( + '<' x $attr->{'~bracket_count'}, + ' ', + '>' x $attr->{'~bracket_count'} + ) + : ( '<', '', '>' ); + return "$name$open$spacer", + map( as_pod($_), @nodes ), + "$spacer$close"; + }, + L => sub ( $name, $attr, @nodes ) { + return "$name<$attr->{raw}>"; + }, + # TODO: =begin / =for + over => sub ( $name, $attr, @nodes ) { + return "=over", + $attr->{'~orig_content'} && " $attr->{'~orig_content'}", "\n\n", + map( as_pod($_), @nodes ), "=back\n\n"; + }, + item => sub ( $name, $attr, @nodes ) { + return "=item ", + $attr->{'~orig_content'} ? "$attr->{'~orig_content'}\n\n" : '', + map( as_pod($_), @nodes ), "\n\n"; + }, + '' => sub ( $name, $attr, @nodes ) { + return "=$name", @nodes && ' ', map( as_pod($_), @nodes ), "\n\n"; + }, + }; + my ( $directive, $attr, @nodes ) = @$tree; + my $name = + exists $handler->{$directive} ? $directive + : $directive =~ /\Aover-/ ? 'over' + : $directive =~ /\Aitem-/ ? 'item' + : length($directive) == 1 ? 'X' + : ''; + return join '', $handler->{$name}->( $directive, $attr, @nodes ); +} + +# CONTENT MANIPULATION SUBROUTINES + +# copy the whole section content +sub copy_section ( $master, $title, $delta ) { + my ( $master_pos, $delta_pos ) = find_pos_in( $master, $delta, $title ); + + # find the end of the section in the delta + my $end_pos = next_header_pos( $delta, 1, $delta_pos ) - 1; + + # inject the whole section from the delta + splice @$master, $master_pos + 1, + 0, $delta->@[ $delta_pos + 1 .. $end_pos ]; +} + +# map each section to an action +my %ACTION_FOR = ( + 'NAME' => 'skip', + 'DESCRIPTION' => 'skip', + 'Notice' => 'copy', + 'Core Enhancements' => 'copy', + 'Security' => 'copy', + 'Incompatible Changes' => 'copy', + 'Deprecations' => 'copy', + 'Performance Enhancements' => 'copy', + 'Modules and Pragmata' => 'skip', + 'Documentation' => 'copy', + 'Diagnostics' => 'copy', + 'Utility Changes' => 'copy', + 'Configuration and Compilation' => 'copy', + 'Testing' => 'copy', + 'Platform Support' => 'copy', + 'Internal Changes' => 'copy', + 'Selected Bug Fixes' => 'copy', + 'Known Problems' => 'copy', + 'Errata From Previous Releases' => 'copy', + 'Obituary' => 'copy', + 'Acknowledgements' => 'skip', + 'Reporting Bugs' => 'skip', + 'Give Thanks' => 'skip', + 'SEE ALSO' => 'skip', +); + +# HELPER SUBROUTINES + +# Note: the parser can only be used *once* per file +sub tree_for ($string) { + my $parser = Pod::Simple::SimpleTree->new; + $parser->keep_encoding_directive(1); + $parser->preserve_whitespace(1); + $parser->accept_targets('*'); # for & begin/end + $parser->_output_is_for_JustPod(1); # for ~bracket_count + $parser->parse_string_document($string)->root; +} + +sub merge_into ( $master, $delta, $file ) { + + # loop over the =head1 sections + for my $title ( + map $_->[2], # grab the title + grep ref eq 'ARRAY' && $_->[0] eq 'head1', # of the =head1 + @$delta # of the delta + ) + { + die "Unexpected section '=head1 $title' in $file\n" + unless exists $ACTION_FOR{$title}; + next if $ACTION_FOR{$title} eq 'skip'; + copy_section( $master, $title, $delta ); + } +} + +sub slurp { return do { local @ARGV = @_; local $/; <> } } + +# MAIN PROGRAM + +sub main (@argv) { + + # compute the version + my ($version) = `git describe` =~ /\Av(5\.[0-9]+)/g; + die "$version does not look like a devel Perl version\n" + unless $version =~ /\A5\.[0-9]{1,2}[13579]\z/; + + # the current, unfinished, delta will be used + # as the master to produce the final document + my $final_delta = 'pod/perldelta.pod'; + my $master = tree_for( slurp($final_delta) ); + + # loop over all the development deltas + my $tag_devel = $version =~ tr/.//dr; + for my $file_tree ( + map [ $_->[0], tree_for( slurp( $_->[0] ) ) ], + sort { $b->[1] <=> $a->[1] } + map [ $_, m{pod/perl$tag_devel([0-9]+)delta\.pod}g ], + glob "pod/perl$tag_devel*delta.pod" + ) + { + my ( $file, $delta ) = @$file_tree; + merge_into( $master, $delta, $file ); + } + + # save the result + open my $fh, '>', $final_delta + or die "Can't open $final_delta for writing: $!"; + print $fh as_pod($master); + + return 0; +} + +# make it easier to test +exit main( @ARGV ) unless caller; From bf03879ff40e15f8516068703aa38529e7009794 Mon Sep 17 00:00:00 2001 From: "Philippe Bruhat (BooK)" Date: Thu, 23 Oct 2025 00:09:47 +0200 Subject: [PATCH 2/9] process the deltas as utf8 files --- Porting/merge-deltas.pl | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/Porting/merge-deltas.pl b/Porting/merge-deltas.pl index 2e89401a6e21..956687b2b86e 100644 --- a/Porting/merge-deltas.pl +++ b/Porting/merge-deltas.pl @@ -164,7 +164,11 @@ ( $master, $delta, $file ) } } -sub slurp { return do { local @ARGV = @_; local $/; <> } } +sub slurp ($file) { + open my $fh, '<:utf8', $file + or die "Can't open $file for reading: $!"; + return do { local $/; <$fh> }; +} # MAIN PROGRAM @@ -194,7 +198,7 @@ (@argv) } # save the result - open my $fh, '>', $final_delta + open my $fh, '>:utf8', $final_delta or die "Can't open $final_delta for writing: $!"; print $fh as_pod($master); From 68f209bba9a5f1b02b350aa8cebd186aa222bb65 Mon Sep 17 00:00:00 2001 From: "Philippe Bruhat (BooK)" Date: Thu, 23 Oct 2025 00:27:29 +0200 Subject: [PATCH 3/9] remove unmodified templated sections from the master --- Porting/merge-deltas.pl | 48 +++++++++++++++++++++++++++++++++++------ 1 file changed, 41 insertions(+), 7 deletions(-) diff --git a/Porting/merge-deltas.pl b/Porting/merge-deltas.pl index 956687b2b86e..66cfda8e440b 100644 --- a/Porting/merge-deltas.pl +++ b/Porting/merge-deltas.pl @@ -94,9 +94,12 @@ ( $tree ) return join '', $handler->{$name}->( $directive, $attr, @nodes ); } +sub pod_excerpt ( $tree, $begin, $end ) { + return as_pod( [ Document => {}, $tree->@[ $begin .. $end ] ] ); +} + # CONTENT MANIPULATION SUBROUTINES -# copy the whole section content sub copy_section ( $master, $title, $delta ) { my ( $master_pos, $delta_pos ) = find_pos_in( $master, $delta, $title ); @@ -108,6 +111,23 @@ ( $master, $title, $delta ) 0, $delta->@[ $delta_pos + 1 .. $end_pos ]; } +sub remove_identical ( $master, $title, $template ) { + my ( $master_pos, $template_pos ) = + find_pos_in( $master, $template, $title ); + + # find the end of the section in both + my $master_end_pos = next_header_pos( $master, 1, $master_pos ) - 1; + my $template_end_pos = next_header_pos( $template, 1, $template_pos ) - 1; + + # drop the section from the master if it's identical + # to that in the template + if ( pod_excerpt( $master, $master_pos, $master_end_pos ) eq + pod_excerpt( $template, $template_pos, $template_end_pos ) ) + { + splice @$master, $master_pos, $master_end_pos - $master_pos + 1; + } +} + # map each section to an action my %ACTION_FOR = ( 'NAME' => 'skip', @@ -148,19 +168,17 @@ ($string) $parser->parse_string_document($string)->root; } -sub merge_into ( $master, $delta, $file ) { - - # loop over the =head1 sections +sub loop_head1 ( $master, $tree, $file, $cb ) { for my $title ( map $_->[2], # grab the title grep ref eq 'ARRAY' && $_->[0] eq 'head1', # of the =head1 - @$delta # of the delta + @$tree # of the tree ) { die "Unexpected section '=head1 $title' in $file\n" unless exists $ACTION_FOR{$title}; next if $ACTION_FOR{$title} eq 'skip'; - copy_section( $master, $title, $delta ); + $cb->( $master, $title, $tree ); } } @@ -194,9 +212,25 @@ (@argv) ) { my ( $file, $delta ) = @$file_tree; - merge_into( $master, $delta, $file ); + loop_head1( + $master, $delta, $file, + sub ( $master, $title, $delta ) { + copy_section( $master, $title, $delta ); + } + ); } + # find all sections in the template identical to those + # in the master and remove them (from the master) + my $template_file = 'Porting/perldelta_template.pod'; + my $template = tree_for( slurp($template_file) ); + loop_head1( + $master, $template, $template_file, + sub ( $master, $title, $template ) { + remove_identical( $master, $title, $template ); + } + ); + # save the result open my $fh, '>:utf8', $final_delta or die "Can't open $final_delta for writing: $!"; From 0d17f7fef3a433a57aff9078bf93a6ba9494d8fb Mon Sep 17 00:00:00 2001 From: "Philippe Bruhat (BooK)" Date: Thu, 23 Oct 2025 01:01:58 +0200 Subject: [PATCH 4/9] add a test script for Porting/merge-deltas.pl --- t/porting/merge-deltas.t | 127 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 127 insertions(+) create mode 100644 t/porting/merge-deltas.t diff --git a/t/porting/merge-deltas.t b/t/porting/merge-deltas.t new file mode 100644 index 000000000000..8b7a7a170074 --- /dev/null +++ b/t/porting/merge-deltas.t @@ -0,0 +1,127 @@ +use v5.36; +use Test2::V0; + +# load the script +do('./Porting/merge-deltas.pl') or die $@ || $!; + +# tree_for & as_pod +{ + my $pod = <<~ 'POD'; + =head2 CVE-2025-xyzzy + + Some CVE was fixed. + + Found by some person. + + =cut + POD + + # just a single test: we're not testing Pod::Simple::SimpleTree + is( + tree_for($pod), + [ + Document => { start_line => 1 }, + [ head2 => { start_line => 1 }, 'CVE-2025-12345' ], + [ Para => { start_line => 3 }, 'Some CVE was fixed.' ], + [ Para => { start_line => 5 }, 'Found by some person.' ], + ], + 'tree_for' + ); + + # as_pod round-trips basic POD + is( as_pod( tree_for($pod) ), $pod, 'as_pod' ); +} + +# loop_head1 +{ + my $template_file = 'Porting/perldelta_template.pod'; + my $template = tree_for( slurp($template_file) ); + + # loop_head1 dies on unexpected =head1 + # the callback is only run on the unskipped sections + ok( + lives { + loop_head1( + [], + $template, + $template_file, + sub ( $master, $title, $template ) { + is( $title, L(), "=head1 $title" ); + } + ); + }, + 'loop_head1' + ); +} + +# copy_section +{ + my $master_pod = <<~ 'POD'; + =head1 NAME + + Master perldelta + + =head1 Notice + + XXX Some notice + + =head1 Acknowledgments + POD + my $delta_pod = <<~ 'POD'; + =head1 NAME + + Devel perldelta + + =head1 Notice + + Devel notice + + =head1 Acknowledgments + POD + my $master = tree_for($master_pod); + copy_section( $master, 'Notice', tree_for($delta_pod) ); + is( as_pod($master), <<~ 'EXPECTED', 'copy_section' ); + =head1 NAME + + Master perldelta + + =head1 Notice + + Devel notice + + XXX Some notice + + =head1 Acknowledgments + + =cut + EXPECTED +} + +# remove_identical +{ + my $pod = <<~ 'POD'; + =head1 NAME + + Template perldelta + + =head1 Notice + + XXX Some notice + + =head1 Acknowledgments + POD + + my $master = tree_for( $pod =~ s/Template/Master/r ); + remove_identical( $master, 'Notice', tree_for($pod) ); + is( as_pod($master), <<~ 'EXPECTED', 'remove_identical' ); + =head1 NAME + + Master perldelta + + =head1 Acknowledgments + + =cut + EXPECTED +} + +done_testing; From bb68e53223c7f412f8612f6f16eb62e4617fc919 Mon Sep 17 00:00:00 2001 From: "Philippe Bruhat (BooK)" Date: Thu, 23 Oct 2025 18:42:12 +0200 Subject: [PATCH 5/9] update MANIFEST --- MANIFEST | 2 ++ Porting/README.pod | 5 +++++ 2 files changed, 7 insertions(+) diff --git a/MANIFEST b/MANIFEST index b1a9db58d224..a07c286fce6f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5924,6 +5924,7 @@ Porting/makerel Release making utility Porting/manicheck Check against MANIFEST Porting/manifest_lib.pl Library for checking and sorting the MANIFEST Porting/manisort Sort the MANIFEST +Porting/merge-deltas.pl Merge developments deltas into the final perldelta Porting/mksample Generate Porting/config_H and Porting/config.sh Porting/new-perldelta.pl Generate a new perldelta Porting/newtests-perldelta.pl Generate Perldelta stub for newly added tests @@ -6559,6 +6560,7 @@ t/porting/libperl.t Check libperl.a sanity t/porting/maintainers.t Test that Porting/Maintainers.pl is up to date t/porting/makerel.t Test that files used by Porting/makerel exist t/porting/manifest.t Test that this MANIFEST file is well formed +t/porting/merge-deltas.t Test that the Porting/merge-deltas.pl script does its job t/porting/perlfunc.t Test that Functions_pm.PL can parse perlfunc.pod t/porting/pod_rules.t Check that various pod lists are consistent t/porting/podcheck.t Test the POD of shipped modules is well formed diff --git a/Porting/README.pod b/Porting/README.pod index 0f0d7584ef1f..740d792ab4c1 100644 --- a/Porting/README.pod +++ b/Porting/README.pod @@ -245,6 +245,11 @@ This library provides functions used in checking and sorting the F. This script sorts the files in F. +=head2 F + +This script merges the various perldeltas for the development releases +into the final perldelta for the stable release. + =head2 F This script regenerates F and F. From e9dcf5efc414ec9edf093825665e1b53ad29c5b8 Mon Sep 17 00:00:00 2001 From: "Philippe Bruhat (BooK)" Date: Thu, 23 Oct 2025 18:43:47 +0200 Subject: [PATCH 6/9] handle running the test from t/ instead of the root of the repository --- t/porting/merge-deltas.t | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/t/porting/merge-deltas.t b/t/porting/merge-deltas.t index 8b7a7a170074..9e2a82556cac 100644 --- a/t/porting/merge-deltas.t +++ b/t/porting/merge-deltas.t @@ -1,8 +1,10 @@ use v5.36; use Test2::V0; +my $root = -f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext' ? '.' : '..'; + # load the script -do('./Porting/merge-deltas.pl') or die $@ || $!; +do("$root/Porting/merge-deltas.pl") or die $@ || $!; # tree_for & as_pod { @@ -34,7 +36,7 @@ do('./Porting/merge-deltas.pl') or die $@ || $!; # loop_head1 { - my $template_file = 'Porting/perldelta_template.pod'; + my $template_file = "$root/Porting/perldelta_template.pod"; my $template = tree_for( slurp($template_file) ); # loop_head1 dies on unexpected =head1 From 13dd20453b5b00aa8ba3e8ae646b28dae9f9eb1d Mon Sep 17 00:00:00 2001 From: "Philippe Bruhat (BooK)" Date: Fri, 24 Oct 2025 00:51:19 +0200 Subject: [PATCH 7/9] use t/test.pl for testing --- t/porting/merge-deltas.t | 32 ++++++++++++-------------------- 1 file changed, 12 insertions(+), 20 deletions(-) diff --git a/t/porting/merge-deltas.t b/t/porting/merge-deltas.t index 9e2a82556cac..e1502e19b1ad 100644 --- a/t/porting/merge-deltas.t +++ b/t/porting/merge-deltas.t @@ -1,10 +1,13 @@ +#!perl -w +BEGIN { + chdir "t" if -d "t"; + require './test.pl'; + @INC = "../lib"; +} use v5.36; -use Test2::V0; - -my $root = -f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext' ? '.' : '..'; # load the script -do("$root/Porting/merge-deltas.pl") or die $@ || $!; +do("../Porting/merge-deltas.pl") or die $@ || $!; # tree_for & as_pod { @@ -18,39 +21,28 @@ do("$root/Porting/merge-deltas.pl") or die $@ || $!; =cut POD - # just a single test: we're not testing Pod::Simple::SimpleTree - is( - tree_for($pod), - [ - Document => { start_line => 1 }, - [ head2 => { start_line => 1 }, 'CVE-2025-12345' ], - [ Para => { start_line => 3 }, 'Some CVE was fixed.' ], - [ Para => { start_line => 5 }, 'Found by some person.' ], - ], - 'tree_for' - ); - # as_pod round-trips basic POD - is( as_pod( tree_for($pod) ), $pod, 'as_pod' ); + is( as_pod( tree_for($pod) ), $pod, 'as_pod( tree_pod ) round-trips' ); } # loop_head1 { - my $template_file = "$root/Porting/perldelta_template.pod"; + my $template_file = "../Porting/perldelta_template.pod"; my $template = tree_for( slurp($template_file) ); # loop_head1 dies on unexpected =head1 # the callback is only run on the unskipped sections ok( - lives { + eval { loop_head1( [], $template, $template_file, sub ( $master, $title, $template ) { - is( $title, L(), "=head1 $title" ); + ok( $title, "=head1 $title" ); } ); + 1; }, 'loop_head1' ); From 7c56a44a7ac4590b8be2530e2d8550f13fdc58c7 Mon Sep 17 00:00:00 2001 From: Eric Herman Date: Fri, 24 Oct 2025 15:12:10 +0000 Subject: [PATCH 8/9] test merge-deltas.pl dies on unexpected =head1 Co-authored-by: Philippe Bruhat (BooK) --- t/porting/merge-deltas.t | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/t/porting/merge-deltas.t b/t/porting/merge-deltas.t index e1502e19b1ad..88b36ab2c6bc 100644 --- a/t/porting/merge-deltas.t +++ b/t/porting/merge-deltas.t @@ -25,7 +25,36 @@ do("../Porting/merge-deltas.pl") or die $@ || $!; is( as_pod( tree_for($pod) ), $pod, 'as_pod( tree_pod ) round-trips' ); } -# loop_head1 +# loop_head1 (with unexpected head1) +{ + my $template = tree_for( <<~ 'POD' ); + =head1 Unexpected + + =cut + POD + + # loop_head1 dies on unexpected =head1 + # the callback is only run on the unskipped sections + ok( + !eval { + loop_head1( + [], + $template, + 'bogus_delta.pod', + sub {} + ); + 1; + }, + 'loop_head1 dies on unexpected =head1' + ); + is( + $@, + "Unexpected section '=head1 Unexpected' in bogus_delta.pod\n", + '.. expected error message for loop_head1' + ); +} + +# loop_head1 test contents of template have not changed { my $template_file = "../Porting/perldelta_template.pod"; my $template = tree_for( slurp($template_file) ); From 8f3dd3e676dc3c8c6d9cad8e178478091591e078 Mon Sep 17 00:00:00 2001 From: Eric Herman Date: Fri, 24 Oct 2025 15:34:51 +0000 Subject: [PATCH 9/9] Document BLEAD-FINAL perldelta process Co-authored-by: Philippe Bruhat (BooK) --- Porting/release_managers_guide.pod | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/Porting/release_managers_guide.pod b/Porting/release_managers_guide.pod index 0a2329672ada..0f33f3e89d07 100644 --- a/Porting/release_managers_guide.pod +++ b/Porting/release_managers_guide.pod @@ -478,8 +478,17 @@ time can save you from having to work out the details during the actual release process. Read F, and try to make sure that -every section it lists is, if necessary, populated and complete. Copy -edit the whole document. +every section it lists is, if necessary, populated and complete. + +In the case of a BLEAD-FINAL, all perldeltas from the 5.X series must be +merged into F. The process starts with + + ./perl -Ilib Porting/merge-deltas.pl + +The resulting F will need to be edited. In particular, +lists will need to be merged. Sections which were describe changes which +were reverted will need to be removed. Some items may benefit from being +merged into a new summary. You won't be able to automatically fill in the "Updated Modules" section until after L is updated (as described below in