pat_advanced.t: Update test

[perl5.git] / Porting / corelist-perldelta.pl

diff --git a/Porting/corelist-perldelta.pl b/Porting/corelist-perldelta.pl
index afda394..c036a18 100755 (executable)
--- a/Porting/corelist-perldelta.pl
+++ b/Porting/corelist-perldelta.pl
@@ -34,6 +34,7 @@ corelist sections of the last perldelta and the next perldelta.
 
 Currently no information about Removed Modules is displayed in any of the
 modes.
 
 Currently no information about Removed Modules is displayed in any of the
 modes.

+

 =cut
 
 my %sections = (
 =cut
 
 my %sections = (


@@ -58,9 +59,7 @@ sub run {
   );
 
   # by default, compare latest two version in CoreList;
   );
 
   # by default, compare latest two version in CoreList;

-  my @versions = sort keys %Module::CoreList::version;
-  my $old = $versions[-2];
-  my $new = $versions[-1];
+  my ($old, $new) = latest_two_perl_versions();

 
   # use the provided versions if present
   # @ARGV >=2 means [old_version] [new_version] [path/to/file]
 
   # use the provided versions if present
   # @ARGV >=2 means [old_version] [new_version] [path/to/file]


@@ -88,6 +87,23 @@ sub run {
   exit 0;
 }
 
   exit 0;
 }
 

+sub latest_two_perl_versions {
+
+  my @versions = sort keys %Module::CoreList::version;
+
+  my $new = pop @versions;
+
+  # If a fully-padded version number ends in a zero (as in "5.019010"), that
+  # version shows up in %Module::CoreList::version both with and without its
+  # trailing zeros. So skip all versions that are numerically equal to $new.
+  pop @versions while @versions && $versions[-1] == $new;
+
+  die "Too few distinct core versions in %Module::CoreList::version ?!\n"
+    if !@versions;
+
+  return $versions[-1], $new;
+}
+

 # Given two perl versions, it returns a list describing the core distributions that have changed.
 # The first three elements are hashrefs corresponding to new, updated, and removed modules
 # and are of the form (mostly, see the special remarks about removed):
 # Given two perl versions, it returns a list describing the core distributions that have changed.
 # The first three elements are hashrefs corresponding to new, updated, and removed modules
 # and are of the form (mostly, see the special remarks about removed):


@@ -139,23 +155,30 @@ sub corelist_delta {
     return undef;
   };
 
     return undef;
   };
 

-  my @unclaimedModules = qw/AnyDBM_File B B::Concise B::Deparse Benchmark Class::Struct Config::Extensions DB DBM_Filter Devel::Peek DirHandle DynaLoader English Errno ExtUtils::Embed ExtUtils::Miniperl ExtUtils::Typemaps ExtUtils::XSSymSet Fcntl File::Basename File::Compare File::Copy File::DosGlob File::Find File::Glob File::stat FileCache FileHandle FindBin GDBM_File Getopt::Std Hash::Util Hash::Util::FieldHash I18N::Langinfo IPC::Open3 NDBM_File ODBM_File Opcode PerlIO PerlIO::encoding PerlIO::mmap PerlIO::scalar PerlIO::via Pod::Functions Pod::Html POSIX SDBM_File SelectSaver Symbol Sys::Hostname Thread Tie::Array Tie::Handle Tie::Hash Tie::Hash::NamedCapture Tie::Memoize Tie::Scalar Tie::StdHandle Tie::SubstrHash Time::gmtime Time::localtime Time::tm Unicode::UCD UNIVERSAL User::grent User::pwent VMS::DCLsym VMS::Filespec VMS::Stdio XS::Typemap Win32CORE/;
-  my @unclaimedPragmata = qw/_charnames arybase attributes blib bytes charnames deprecate diagnostics encoding feature fields filetest inc::latest integer less locale mro open ops overload overloading re sigtrap sort strict subs utf8 vars vmsish/;
+  my @unclaimedModules = qw/AnyDBM_File B B::Concise B::Deparse Benchmark Class::Struct Config::Extensions DB
+                            DBM_Filter Devel::Peek DirHandle DynaLoader English Errno ExtUtils::Embed ExtUtils::Miniperl
+                            ExtUtils::Typemaps ExtUtils::XSSymSet Fcntl File::Basename File::Compare File::Copy File::DosGlob
+                            File::Find File::Glob File::stat FileCache FileHandle FindBin GDBM_File Getopt::Std Hash::Util Hash::Util::FieldHash
+                            I18N::Langinfo IPC::Open3 NDBM_File ODBM_File Opcode PerlIO PerlIO::encoding PerlIO::mmap PerlIO::scalar PerlIO::via
+                            Pod::Functions Pod::Html POSIX SDBM_File SelectSaver Symbol Sys::Hostname Thread Tie::Array Tie::Handle Tie::Hash
+                            Tie::Hash::NamedCapture Tie::Memoize Tie::Scalar Tie::StdHandle Tie::SubstrHash Time::gmtime Time::localtime Time::tm
+                            Unicode::UCD UNIVERSAL User::grent User::pwent VMS::DCLsym VMS::Filespec VMS::Stdio XS::Typemap XS::APItest Win32CORE/;
+  my @unclaimedPragmata = qw/arybase attributes blib bytes charnames deprecate diagnostics encoding feature fields filetest inc::latest integer less locale mro open ops overload overloading re sigtrap sort strict subs utf8 vars vmsish/;

   my @unclaimed = (@unclaimedModules, @unclaimedPragmata);
 
   my %distToModules = (
     'IO-Compress' => [
       {
   my @unclaimed = (@unclaimedModules, @unclaimedPragmata);
 
   my %distToModules = (
     'IO-Compress' => [
       {

-        'name' => 'IO-Compress',
+        'name'         => 'IO-Compress',

         'modification' => $getModifyType->( $changes{'IO::Compress::Base'} ),
         'modification' => $getModifyType->( $changes{'IO::Compress::Base'} ),

-        'data' => $changes{'IO::Compress::Base'}
+        'data'         => $changes{'IO::Compress::Base'}

       }
     ],
       }
     ],

-    'Locale-Codes' => [
+    'libnet' => [

       {
       {

-        'name'         => 'Locale::Codes',
-        'modification' => $getModifyType->( $changes{'Locale::Codes'} ),
-        'data'         => $changes{'Locale::Codes'}
+        'name'         => 'libnet',
+        'modification' => $getModifyType->( $changes{'Net::Cmd'} ),
+        'data'         => $changes{'Net::Cmd'}

       }
     ],
     'PathTools' => [
       }
     ],
     'PathTools' => [


@@ -165,6 +188,13 @@ sub corelist_delta {
         'data'         => $changes{'Cwd'}
       }
     ],
         'data'         => $changes{'Cwd'}
       }
     ],

+    'podlators' => [
+      {
+        'name'         => 'podlators',
+        'modification' => $getModifyType->( $changes{'Pod::Text'} ),
+        'data'         => $changes{'Pod::Text'}
+      }
+    ],

     'Scalar-List-Utils' => [
       {
         'name'         => 'List::Util',
     'Scalar-List-Utils' => [
       {
         'name'         => 'List::Util',


@@ -175,6 +205,11 @@ sub corelist_delta {
         'name'         => 'Scalar::Util',
         'modification' => $getModifyType->( $changes{'Scalar::Util'} ),
         'data'         => $changes{'Scalar::Util'}
         'name'         => 'Scalar::Util',
         'modification' => $getModifyType->( $changes{'Scalar::Util'} ),
         'data'         => $changes{'Scalar::Util'}

+      },
+      {
+        'name'         => 'Sub::Util',
+        'modification' => $getModifyType->( $changes{'Sub::Util'} ),
+        'data'         => $changes{'Sub::Util'}

       }
     ],
     'Text-Tabs+Wrap' => [
       }
     ],
     'Text-Tabs+Wrap' => [


@@ -254,7 +289,7 @@ sub do_update_existing {
   my ( $existing, $old, $new ) = @_;
 
   my ( $added, $removed, $updated, $manuallyCheck ) = corelist_delta( $old => $new );
   my ( $existing, $old, $new ) = @_;
 
   my ( $added, $removed, $updated, $manuallyCheck ) = corelist_delta( $old => $new );

-  if ($manuallyCheck) {
+  if (@{$manuallyCheck}) {

     print "It cannot be determined whether the following distributions have changed.\n";
     print "Please check and list accordingly:\n";
     say "\t* $_" for sort @{$manuallyCheck};
     print "It cannot be determined whether the following distributions have changed.\n";
     print "Please check and list accordingly:\n";
     say "\t* $_" for sort @{$manuallyCheck};


@@ -430,7 +465,7 @@ sub do_check {
   sub add_to_section {
     my ( $section, $data, $title ) = @_;
 
   sub add_to_section {
     my ( $section, $data, $title ) = @_;
 

-    #undef is a valid version name in Module::CoreList so supress warnings about concatenating undef values
+    #undef is a valid version name in Module::CoreList so suppress warnings about concatenating undef values

     no warnings 'uninitialized';
     for ( values %{ $data->{$title} } ) {
       my ( $mod, $old_v, $new_v ) = @{$_};
     no warnings 'uninitialized';
     for ( values %{ $data->{$title} } ) {
       my ( $mod, $old_v, $new_v ) = @{$_};


@@ -463,7 +498,7 @@ sub do_check {
 
     # if we could not parse the module name, it will be uninitalized
     # in sort. This is not a problem as it will just result in these
 
     # if we could not parse the module name, it will be uninitalized
     # in sort. This is not a problem as it will just result in these

-    # sections being placed near the begining of the section
+    # sections being placed near the beginning of the section

     no warnings 'uninitialized';
     $section->{items} =
       [ sort { lc $a->{name} cmp lc $b->{name} } @{ $section->{items} } ];
     no warnings 'uninitialized';
     $section->{items} =
       [ sort { lc $a->{name} cmp lc $b->{name} } @{ $section->{items} } ];