test(xCAT-test): exercise real RISC-V helper implementations

xCAT-test/unit/copycd_grub2_loader.t

@@ -1,15 +1,19 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
+no warnings 'once';
 
 use File::Path qw(make_path);
+use File::Slurper qw(read_text write_text);
 use File::Spec;
 use File::Temp qw(tempdir);
 use FindBin;
 use lib "$FindBin::Bin/../lib";
+use lib "$FindBin::Bin/../../perl-xCAT";
+use lib "$FindBin::Bin/../../xCAT-server/lib/perl";
 use Test::More;
 
-use XCAT::Test::File qw(repo_path slurp_repo_file);
+use XCAT::Test::File qw(repo_path);
 
 # copycd publishes the grub2 UEFI image of the installation media so that nodes
 # of an architecture xCAT builds no boot loader for -- riscv64 -- can net boot
@@ -18,25 +22,13 @@ use XCAT::Test::File qw(repo_path slurp_repo_file);
 
 my $plugin = repo_path('xCAT-server/lib/xcat/plugins/anaconda.pm');
 plan skip_all => "$plugin not found" unless -r $plugin;
-
-my $source = slurp_repo_file('xCAT-server/lib/xcat/plugins/anaconda.pm');
-
-# anaconda.pm needs a database to load, so take just the loader publication out
-# of it, the way the other unit tests here isolate a shipped sub.
-my ($loaders) = $source =~ /^(my %MEDIA_GRUB2_LOADERS = \([^)]*\);)$/m;
-ok( $loaders, 'the media boot loader map was located in anaconda.pm' )
-  or BAIL_OUT('anaconda.pm no longer defines %MEDIA_GRUB2_LOADERS');
-my ($sub) = $source =~ /^(sub _install_media_grub2_loader \{.*?^\})$/ms;
-ok( $sub, 'the media boot loader publication was located in anaconda.pm' )
-  or BAIL_OUT('anaconda.pm no longer defines _install_media_grub2_loader');
+$ENV{XCATROOT} ||= repo_path('xCAT-server');
+require $plugin;
 
 my $tftpdir;
-{
-    package xCAT::TableUtils;
-    sub getTftpDir { return $tftpdir; }
-}
-
-eval "use File::Path qw(mkpath); use File::Copy; $loaders $sub 1;" or die $@;
+no warnings 'redefine';
+local *xCAT::TableUtils::getTftpDir = sub { return $tftpdir; };
+use warnings;
 
 sub media {
     my ( $root, $name, $image ) = @_;
@@ -44,9 +36,7 @@ sub media {
     make_path( File::Spec->catdir( $path, 'EFI', 'BOOT' ) );
     if ($image) {
         my $file = File::Spec->catfile( $path, 'EFI', 'BOOT', $image );
-        open( my $fh, '>', $file ) or die "Unable to create $file: $!";
-        print $fh "boot loader from the media\n";
-        close($fh);
+        write_text( $file, "boot loader from the media\n" );
     }
     return $path;
 }
@@ -63,7 +53,9 @@ make_path($tftpdir);
 # riscv64 media, nothing published yet: the image is installed
 my $riscv_media = media( $root, 'rocky10-riscv64', 'grubriscv64.efi' );
 my @responses;
-my $written = _install_media_grub2_loader( $riscv_media, 'riscv64', sub { push @responses, @_; } );
+my $written = xCAT_plugin::anaconda::_install_media_grub2_loader(
+    $riscv_media, 'riscv64', sub { push @responses, @_; }
+);
 my $loader = File::Spec->catfile( $tftpdir, 'boot', 'grub2', 'grub2.riscv64' );
 is( $written, $loader, 'riscv64 media publish their grub2 image as the riscv64 boot loader' );
 ok( -f $loader, 'the boot loader is written under the TFTP root' );
@@ -72,15 +64,11 @@ is( ( stat($loader) )[7], ( stat( File::Spec->catfile( $riscv_media, 'EFI', 'BOO
 like( messages( \@responses ), qr/\QInstalled $loader from the media\E/, 'the published boot loader is reported' );
 
 # a boot loader that is already there is never replaced
-open( my $fh, '>', $loader ) or die "Unable to rewrite $loader: $!";
-print $fh "installed by grub2-xcat\n";
-close($fh);
+write_text( $loader, "installed by grub2-xcat\n" );
 @responses = ();
-is( scalar _install_media_grub2_loader( $riscv_media, 'riscv64', sub { push @responses, @_; } ),
+is( scalar xCAT_plugin::anaconda::_install_media_grub2_loader( $riscv_media, 'riscv64', sub { push @responses, @_; } ),
     undef, 'an existing boot loader is kept' );
-open( my $rfh, '<', $loader ) or die "Unable to read $loader: $!";
-my $content = do { local $/; <$rfh> };
-close($rfh);
+my $content = read_text($loader);
 is( $content, "installed by grub2-xcat\n", 'the existing boot loader is left untouched' );
 is( messages( \@responses ), '', 'nothing is reported when there is nothing to do' );
 unlink($loader);
@@ -91,7 +79,7 @@ $tftpdir = File::Spec->catdir( $root, 'tftpboot-x86' );
 make_path($tftpdir);
 my $x86_media = media( $root, 'rocky10-x86_64', 'grubx64.efi' );
 @responses = ();
-is( scalar _install_media_grub2_loader( $x86_media, 'x86_64', sub { push @responses, @_; } ),
+is( scalar xCAT_plugin::anaconda::_install_media_grub2_loader( $x86_media, 'x86_64', sub { push @responses, @_; } ),
     undef, 'x86_64 media publish no boot loader' );
 ok( !-e File::Spec->catfile( $tftpdir, 'boot', 'grub2', 'grub2.x86_64' ), 'no x86_64 boot loader is written' );
 ok( !-d File::Spec->catdir( $tftpdir, 'boot' ), 'the grub2 directory is only created when there is an image to put in it' );
@@ -101,7 +89,7 @@ $tftpdir = File::Spec->catdir( $root, 'tftpboot-bare' );
 make_path($tftpdir);
 my $bare_media = media( $root, 'rocky10-riscv64-bare' );
 @responses = ();
-is( scalar _install_media_grub2_loader( $bare_media, 'riscv64', sub { push @responses, @_; } ),
+is( scalar xCAT_plugin::anaconda::_install_media_grub2_loader( $bare_media, 'riscv64', sub { push @responses, @_; } ),
     undef, 'media without a grub2 image publish nothing' );
 is( messages( \@responses ), '', 'media without a grub2 image report nothing' );
 ok( !-d File::Spec->catdir( $tftpdir, 'boot' ), 'media without a grub2 image create no directories' );

xCAT-test/unit/lookup_netboot_arch.t

@@ -4,9 +4,12 @@ use warnings;
 
 use FindBin;
 use lib "$FindBin::Bin/../lib";
+use lib "$FindBin::Bin/../../perl-xCAT";
 use Test::More;
 
-use XCAT::Test::File qw(repo_path slurp_repo_file);
+use XCAT::Test::File qw(repo_path);
+use xCAT::ProfiledNodeUtils;
+use xCAT::Utils;
 
 # riscv64 nodes boot through UEFI and grub2 only. This test pins the three
 # places that declare which noderes.netboot values an architecture accepts:
@@ -14,31 +17,9 @@ use XCAT::Test::File qw(repo_path slurp_repo_file);
 # profiled-node netboot rule table in xCAT::ProfiledNodeUtils, and the
 # schema descriptions that document the valid values.
 #
-# xCAT::Utils and xCAT::ProfiledNodeUtils pull in the database layer at load
-# time, so the shipped subroutines are extracted from the source and evaluated
-# directly instead of loading the whole modules.
-
-my $utils_pm = repo_path('perl-xCAT/xCAT/Utils.pm');
-my $pnu_pm = repo_path('perl-xCAT/xCAT/ProfiledNodeUtils.pm');
-
-plan skip_all => "$utils_pm not found" unless -r $utils_pm;
-plan skip_all => "$pnu_pm not found"   unless -r $pnu_pm;
-
 # ---------------------------------------------------------------------------
 # xCAT::Utils::lookupNetboot
 # ---------------------------------------------------------------------------
-my $utils_source = slurp_repo_file('perl-xCAT/xCAT/Utils.pm');
-my ($lookup_sub) = $utils_source =~ m{^(sub lookupNetboot \{.*?^\})}ms;
-ok( $lookup_sub, 'lookupNetboot was located in xCAT::Utils' )
-  or BAIL_OUT('Utils.pm no longer matches the expected lookupNetboot shape');
-
-{
-    package Test::LookupNetboot;
-    my $code = $lookup_sub;
-    eval $code;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
-    die "Unable to evaluate lookupNetboot: $@" if $@;
-}
-
 my @lookup_cases = (
     [ 'rocky10.2', 'riscv64', 'Linux', 'grub2,grub2-tftp,grub2-http', 'riscv64 EL10 boots with grub2 over tftp or http' ],
     [ 'rhels10.2', 'riscv64', 'Linux', 'grub2,grub2-tftp,grub2-http', 'riscv64 RHEL 10 uses the same grub2 methods' ],
@@ -53,41 +34,23 @@ my @lookup_cases = (
 
 for my $case (@lookup_cases) {
     my ( $osvers, $osarch, $imgtype, $expected, $label ) = @$case;
-    is( Test::LookupNetboot::lookupNetboot( $osvers, $osarch, $imgtype ), $expected, $label );
+    is( xCAT::Utils->lookupNetboot( $osvers, $osarch, $imgtype ), $expected, $label );
 }
 
-is( Test::LookupNetboot::lookupNetboot( 'xCAT::Utils', 'rocky10.2', 'riscv64', 'Linux' ),
-    'grub2,grub2-tftp,grub2-http', 'the class-method calling convention works for riscv64' );
-
 # ---------------------------------------------------------------------------
 # xCAT::ProfiledNodeUtils netboot rule table + cal_netboot
 # ---------------------------------------------------------------------------
-my $pnu_source = slurp_repo_file('perl-xCAT/xCAT/ProfiledNodeUtils.pm');
-my ($netboot_dict) = $pnu_source =~ m{^(\s*my %netboot_dict = \(.*?^\s*\);)}ms;
-ok( $netboot_dict, 'the profiled-node netboot rule table was located' )
-  or BAIL_OUT('ProfiledNodeUtils.pm no longer matches the expected %netboot_dict shape');
-my ($cal_netboot) = $pnu_source =~ m{^(sub cal_netboot \{.*?^\})}ms;
-ok( $cal_netboot, 'cal_netboot was located in xCAT::ProfiledNodeUtils' )
-  or BAIL_OUT('ProfiledNodeUtils.pm no longer matches the expected cal_netboot shape');
+my $rule_table = \%xCAT::ProfiledNodeUtils::NETBOOT_RULES;
 
-my $rule_table;
-{
-    package Test::ProfiledNetboot;
-    my $code = "$cal_netboot\n sub rule_table { $netboot_dict return \\%netboot_dict; }";
-    eval $code;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
-    die "Unable to evaluate the profiled-node netboot rules: $@" if $@;
-    $rule_table = rule_table();
-}
-
-is( Test::ProfiledNetboot::cal_netboot( $rule_table, [ 'riscv64', 'rhels', '10', '*' ] ),
+is( xCAT::ProfiledNodeUtils::cal_netboot( $rule_table, [ 'riscv64', 'rhels', '10', '*' ] ),
     'grub2', 'profiled riscv64 nodes default to grub2' );
-is( Test::ProfiledNetboot::cal_netboot( $rule_table, [ 'riscv64', 'rhels', '10', 'ipmi' ] ),
+is( xCAT::ProfiledNodeUtils::cal_netboot( $rule_table, [ 'riscv64', 'rhels', '10', 'ipmi' ] ),
     'grub2', 'riscv64 grub2 does not depend on the management method' );
-is( Test::ProfiledNetboot::cal_netboot( $rule_table, [ 'x86_64', 'rhels', '10', '*' ] ),
+is( xCAT::ProfiledNodeUtils::cal_netboot( $rule_table, [ 'x86_64', 'rhels', '10', '*' ] ),
     'xnba', 'x86_64 profiled nodes still default to xnba' );
-is( Test::ProfiledNetboot::cal_netboot( $rule_table, [ 'ppc64le', 'rhels', '9', 'ipmi' ] ),
+is( xCAT::ProfiledNodeUtils::cal_netboot( $rule_table, [ 'ppc64le', 'rhels', '9', 'ipmi' ] ),
     'petitboot', 'ppc64le ipmi profiled nodes still default to petitboot' );
-is( Test::ProfiledNetboot::cal_netboot( $rule_table, [ 'aarch64', 'rhels', '9', '*' ] ),
+is( xCAT::ProfiledNodeUtils::cal_netboot( $rule_table, [ 'aarch64', 'rhels', '9', '*' ] ),
     '0', 'aarch64 profiled nodes are still undefined in the rule table' );
 
 # ---------------------------------------------------------------------------

xCAT-test/unit/netboot_profile_riscv64.t

@@ -5,38 +5,19 @@ use warnings;
 
 use FindBin;
 use lib "$FindBin::Bin/../lib";
+use lib "$FindBin::Bin/../../perl-xCAT";
+use lib "$FindBin::Bin/../../xCAT-server/lib/perl";
 use File::Spec;
 use Test::More;
 
 use XCAT::Test::File qw(repo_path slurp_repo_file);
+use xCAT::SvrUtils;
 
 # EL10 riscv64 diskless and service profiles are plain data files resolved by
 # imgutils::get_profile_def_filename (osver.arch first, then osbase.arch, then
 # the arch-less fallbacks). Pin that the riscv64 files exist, win the lookup
 # for rocky10/rhels10 point releases, and carry the right content.
 
-BEGIN {
-    # imgutils pulls in xCAT::SvrUtils only for the OS search list; emulate
-    # the point-release walk (rocky10.2 -> rocky10.2, rocky10.1, ..., rocky10,
-    # rocky) without the database-backed module.
-    package xCAT::SvrUtils;
-    sub get_os_search_list {
-        my ($os) = @_;
-        my @word = split( /\./, $os );
-        my @list;
-        while ( @word && $word[-1] =~ /^[0-9]+$/ ) {
-            my $last = pop @word;
-            while ( $last >= 0 ) {
-                push @list, join( '.', @word, $last );
-                $last--;
-            }
-        }
-        push @list, join( '.', @word );
-        return @list;
-    }
-    $INC{'xCAT/SvrUtils.pm'} = __FILE__;
-}
-
 my $share_relative = File::Spec->catdir( 'xCAT-server', 'share', 'xcat' );
 my $share = repo_path($share_relative);
 my $imgutils_relative = File::Spec->catfile(

xCAT-test/unit/nodediscover_default_netboot.t

@@ -7,7 +7,7 @@ use FindBin;
 use lib "$FindBin::Bin/../lib";
 use Test::More;
 
-use XCAT::Test::File qw(repo_path slurp_repo_file);
+use XCAT::Test::File qw(repo_path);
 
 # nodediscover sets noderes.netboot for a freshly discovered node when the
 # admin did not pick a method that fits the reported architecture. The ladder
@@ -16,8 +16,23 @@ use XCAT::Test::File qw(repo_path slurp_repo_file);
 
 BEGIN {
     package xCAT::Table;
+    sub new {
+        my ( $class, $name ) = @_;
+        return bless { name => $name }, 'Local::DiscoveryTable';
+    }
     $INC{'xCAT/Table.pm'} = __FILE__;
 
+    package Local::DiscoveryTable;
+    our @writes;
+    sub getNodeAttribs { return {}; }
+    sub setNodeAttribs {
+        my ( $self, $node, $attrs ) = @_;
+        push @writes, [ $self->{name}, $node, { %{$attrs} } ];
+        return;
+    }
+    sub close  { return; }
+    sub commit { return; }
+
     package xCAT::Utils;
     $INC{'xCAT/Utils.pm'} = __FILE__;
 
@@ -70,18 +85,28 @@ is( default_netboot( undef, undef, undef ),   undef,  'a missing arch sets nothi
 
 is( $warnings, 0, 'no warnings were emitted for undefined inputs' );
 
-# The discovery request is stored as discovery data key by key, so reading the platform
-# of a node that never reported one must not add the key to the request.
-my $source = slurp_repo_file('xCAT-server/lib/xcat/plugins/nodediscover.pm');
-like(
-    $source,
-    qr/my \$platform = exists \$request->\{platform\} \? \$request->\{platform\}->\[0\] : undef;/,
-    'the netboot ladder only reads the platform of a request that carries one',
+# Discovery data are later stored key by key. Exercise the real request path to
+# prove that an absent platform is not added while selecting the netboot method.
+@Local::DiscoveryTable::writes = ();
+my $request = {
+    node => ['node1'],
+    arch => ['riscv64'],
+};
+my @callbacks;
+xCAT_plugin::nodediscover::process_request(
+    $request,
+    sub { push @callbacks, @_ },
+    sub { },
 );
-unlike(
-    $source,
-    qr/_default_netboot\(\s*\$request->\{arch\}->\[0\],\s*\$request->\{platform\}->\[0\]/,
-    'the netboot ladder does not autovivify the platform key of the discovery request',
+ok( !exists $request->{platform}, 'discovery does not add a missing platform to the request' );
+ok(
+    scalar( grep {
+        $_->[0] eq 'noderes'
+          && $_->[1] eq 'node1'
+          && $_->[2]->{netboot} eq 'grub2'
+    } @Local::DiscoveryTable::writes ),
+    'the request path applies the riscv64 grub2 default',
 );
+is( scalar @callbacks, 1, 'the isolated request stops at the missing client address boundary' );
 
 done_testing();