2
0
mirror of https://github.com/xcat2/xcat-core.git synced 2026-09-04 20:17:55 +00:00

Merge pull request #7770 from VersatusHPC/refactor/test-file-writing

test: reuse File::Slurper for fixture files
This commit is contained in:
Daniel Hilst
2026-08-28 17:40:34 -03:00
committed by GitHub
5 changed files with 56 additions and 106 deletions
+9 -22
View File
@@ -3,11 +3,15 @@ use strict;
use warnings;
use File::Path qw(make_path);
use File::Slurper qw(read_lines write_text);
use File::Temp qw(tempdir);
use FindBin;
use lib "$FindBin::Bin/../lib";
use Test::More;
my $bmcsetup = "$FindBin::Bin/../../xCAT-genesis-scripts/usr/bin/bmcsetup";
use XCAT::Test::File qw(repo_path);
my $bmcsetup = repo_path('xCAT-genesis-scripts/usr/bin/bmcsetup');
plan skip_all => 'bmcsetup script not found' unless -x $bmcsetup;
my $ipmicfg = '/tmp/ipmicfg.xml';
@@ -105,7 +109,7 @@ EOF
);
my $user_list = "$tmpdir/user-list.txt";
write_file(
write_text(
$user_list,
<<'EOF'
ID Name Callin Link Auth IPMI Msg Channel Priv Limit
@@ -130,10 +134,10 @@ my $rc = $? >> 8;
is($rc, 0, 'bmcsetup exits successfully with stubbed IPMI commands')
or diag($output);
my @disabled = read_lines($disable_log);
my @disabled = -e $disable_log ? read_lines($disable_log) : ();
is_deeply(\@disabled, ['4'], 'bmcsetup disables only enabled non-target user slots');
my @calls = read_lines($call_log);
my @calls = -e $call_log ? read_lines($call_log) : ();
ok(
!grep({ /user disable (1|3|5)\b/ } @calls),
'bmcsetup does not retry user disable for slots that are already disabled'
@@ -143,23 +147,6 @@ done_testing();
sub write_executable {
my ($path, $content) = @_;
write_file($path, $content);
write_text($path, $content);
chmod 0755, $path or die "chmod $path: $!";
}
sub write_file {
my ($path, $content) = @_;
open(my $fh, '>', $path) or die "open $path: $!";
print {$fh} $content;
close($fh) or die "close $path: $!";
}
sub read_lines {
my ($path) = @_;
return () unless -e $path;
open(my $fh, '<', $path) or die "open $path: $!";
my @lines = <$fh>;
close($fh) or die "close $path: $!";
chomp @lines;
return @lines;
}
+5 -12
View File
@@ -5,6 +5,7 @@ use warnings;
use FindBin;
use lib "$FindBin::Bin/../../xCAT-probe/lib/perl";
use File::Slurper qw(write_text);
use File::Temp qw(tempdir);
use Test::More;
@@ -36,18 +37,10 @@ my %netplan = (
ok(probe_utils::_netplan_has_static_ip('bond0.123', '10.0.123.5'), 'dotted VLAN interface is escaped for netplan get');
}
sub write_file {
my ($file, $contents) = @_;
open(my $fh, '>', $file) or die "Unable to write $file: $!";
print $fh $contents;
close $fh;
}
my $networkd_dir = tempdir(CLEANUP => 1);
my $fake_bin = tempdir(CLEANUP => 1);
write_file("$networkd_dir/10-netplan-eth2.network", <<'EOF');
write_text("$networkd_dir/10-netplan-eth2.network", <<'EOF');
[Match]
Name=eth2
@@ -55,7 +48,7 @@ Name=eth2
Address=10.0.2.5/24
EOF
write_file("$networkd_dir/10-netplan-eth3.network", <<'EOF');
write_text("$networkd_dir/10-netplan-eth3.network", <<'EOF');
[Match]
Name=eth3
@@ -64,7 +57,7 @@ Address=10.0.3.5/24
DHCP=ipv4
EOF
write_file("$networkd_dir/10-netplan-eth20.network", <<'EOF');
write_text("$networkd_dir/10-netplan-eth20.network", <<'EOF');
[Match]
Name=eth20
@@ -73,7 +66,7 @@ Address=10.0.20.5/24
EOF
my $fake_netplan = "$fake_bin/netplan";
write_file($fake_netplan, <<'EOF');
write_text($fake_netplan, <<'EOF');
#!/bin/sh
echo "netplan get is not supported" >&2
exit 1
+14 -23
View File
@@ -2,6 +2,7 @@ use strict;
use warnings;
use Cwd qw(realpath);
use File::Slurper qw(write_text);
use File::Spec;
use File::Temp qw(tempdir);
use FindBin;
@@ -120,8 +121,8 @@ ok(
);
my $svrutils_dir = tempdir(CLEANUP => 1);
_write_file(File::Spec->catfile($svrutils_dir, 'compute.pkglist'), "default\n");
_write_file(File::Spec->catfile($svrutils_dir, 'compute.ubuntu24.x86_64.pkglist'), "wrong\n");
write_text(File::Spec->catfile($svrutils_dir, 'compute.pkglist'), "default\n");
write_text(File::Spec->catfile($svrutils_dir, 'compute.ubuntu24.x86_64.pkglist'), "wrong\n");
is(
xCAT::SvrUtils::get_pkglist_file_name($svrutils_dir, 'compute', 'ubuntu24.04', 'x86_64', 'subiquity'),
@@ -129,7 +130,7 @@ is(
'SvrUtils lookup does not fall back from ubuntu24.04 to ubuntu24'
);
_write_file(File::Spec->catfile($svrutils_dir, 'compute.ubuntu24.04.x86_64.pkglist'), "exact\n");
write_text(File::Spec->catfile($svrutils_dir, 'compute.ubuntu24.04.x86_64.pkglist'), "exact\n");
is(
xCAT::SvrUtils::get_pkglist_file_name($svrutils_dir, 'compute', 'ubuntu24.04', 'x86_64', 'subiquity'),
File::Spec->catfile($svrutils_dir, 'compute.ubuntu24.04.x86_64.pkglist'),
@@ -137,7 +138,7 @@ is(
);
unlink File::Spec->catfile($svrutils_dir, 'compute.ubuntu24.04.x86_64.pkglist');
_write_file(File::Spec->catfile($svrutils_dir, 'compute.ubuntu24.04.pkglist'), "release\n");
write_text(File::Spec->catfile($svrutils_dir, 'compute.ubuntu24.04.pkglist'), "release\n");
is(
xCAT::SvrUtils::get_pkglist_file_name($svrutils_dir, 'compute', 'ubuntu24.04.1', 'x86_64', 'subiquity'),
File::Spec->catfile($svrutils_dir, 'compute.ubuntu24.04.pkglist'),
@@ -145,8 +146,8 @@ is(
);
my $svrutils_rpm_dir = tempdir(CLEANUP => 1);
_write_file(File::Spec->catfile($svrutils_rpm_dir, 'compute.pkglist'), "default\n");
_write_file(File::Spec->catfile($svrutils_rpm_dir, 'compute.rocky9.x86_64.pkglist'), "major\n");
write_text(File::Spec->catfile($svrutils_rpm_dir, 'compute.pkglist'), "default\n");
write_text(File::Spec->catfile($svrutils_rpm_dir, 'compute.rocky9.x86_64.pkglist'), "major\n");
is(
xCAT::SvrUtils::get_pkglist_file_name($svrutils_rpm_dir, 'compute', 'rocky9.6', 'x86_64', 'rocky9'),
@@ -154,7 +155,7 @@ is(
'SvrUtils lookup keeps major-version fallback for non-leading-zero minor releases'
);
_write_file(File::Spec->catfile($svrutils_rpm_dir, 'compute.ol8.4.x86_64.pkglist'), "minor\n");
write_text(File::Spec->catfile($svrutils_rpm_dir, 'compute.ol8.4.x86_64.pkglist'), "minor\n");
is(
xCAT::SvrUtils::get_pkglist_file_name($svrutils_rpm_dir, 'compute', 'ol8.4.0', 'x86_64', 'ol8'),
File::Spec->catfile($svrutils_rpm_dir, 'compute.ol8.4.x86_64.pkglist'),
@@ -163,8 +164,8 @@ is(
my $imgutils_dir = tempdir(CLEANUP => 1);
my $real_imgutils_dir = realpath($imgutils_dir) || $imgutils_dir;
_write_file(File::Spec->catfile($imgutils_dir, 'compute.pkglist'), "default\n");
_write_file(File::Spec->catfile($imgutils_dir, 'compute.ubuntu24.x86_64.pkglist'), "wrong\n");
write_text(File::Spec->catfile($imgutils_dir, 'compute.pkglist'), "default\n");
write_text(File::Spec->catfile($imgutils_dir, 'compute.ubuntu24.x86_64.pkglist'), "wrong\n");
is(
imgutils::get_profile_def_filename('ubuntu24.04', 'compute', 'x86_64', $imgutils_dir, 'pkglist'),
@@ -172,7 +173,7 @@ is(
'imgutils lookup does not fall back from ubuntu24.04 to ubuntu24'
);
_write_file(File::Spec->catfile($imgutils_dir, 'compute.ubuntu24.04.x86_64.pkglist'), "exact\n");
write_text(File::Spec->catfile($imgutils_dir, 'compute.ubuntu24.04.x86_64.pkglist'), "exact\n");
is(
imgutils::get_profile_def_filename('ubuntu24.04', 'compute', 'x86_64', $imgutils_dir, 'pkglist'),
File::Spec->catfile($real_imgutils_dir, 'compute.ubuntu24.04.x86_64.pkglist'),
@@ -187,8 +188,8 @@ is(
my $imgutils_rpm_dir = tempdir(CLEANUP => 1);
my $real_imgutils_rpm_dir = realpath($imgutils_rpm_dir) || $imgutils_rpm_dir;
_write_file(File::Spec->catfile($imgutils_rpm_dir, 'compute.pkglist'), "default\n");
_write_file(File::Spec->catfile($imgutils_rpm_dir, 'compute.rocky9.x86_64.pkglist'), "major\n");
write_text(File::Spec->catfile($imgutils_rpm_dir, 'compute.pkglist'), "default\n");
write_text(File::Spec->catfile($imgutils_rpm_dir, 'compute.rocky9.x86_64.pkglist'), "major\n");
is(
imgutils::get_profile_def_filename('rocky9.6', 'compute', 'x86_64', $imgutils_rpm_dir, 'pkglist'),
@@ -196,7 +197,7 @@ is(
'imgutils lookup keeps major-version fallback for non-leading-zero minor releases'
);
_write_file(File::Spec->catfile($imgutils_rpm_dir, 'compute.ol8.4.x86_64.pkglist'), "minor\n");
write_text(File::Spec->catfile($imgutils_rpm_dir, 'compute.ol8.4.x86_64.pkglist'), "minor\n");
is(
imgutils::get_profile_def_filename('ol8.4.0', 'compute', 'x86_64', $imgutils_rpm_dir, 'pkglist'),
File::Spec->catfile($real_imgutils_rpm_dir, 'compute.ol8.4.x86_64.pkglist'),
@@ -204,13 +205,3 @@ is(
);
done_testing();
sub _write_file {
my ($path, $content) = @_;
open(my $fh, '>', $path) or die "Cannot write $path: $!";
print {$fh} $content;
close($fh);
return;
}
+15 -22
View File
@@ -3,6 +3,7 @@ use strict;
use warnings;
use File::Path qw(make_path);
use File::Slurper qw(write_text);
use File::Temp qw(tempdir);
use FindBin;
use Test::More;
@@ -13,14 +14,6 @@ use lib "$FindBin::Bin/../../xCAT-server/lib/xcat/plugins";
require sles;
sub write_file
{
my ($path, $contents) = @_;
open(my $fh, '>', $path) or die "Cannot write $path: $!";
print {$fh} $contents;
close($fh);
}
sub inspect_media
{
my $mountpoint = shift;
@@ -45,9 +38,9 @@ sub inspect_media
my $sles12 = tempdir(CLEANUP => 1);
make_path("$sles12/media.1");
write_file("$sles12/content", "DEFAULTBASE ppc64le\nVERSION 12.4-0\n");
write_file("$sles12/media.1/media", "SUSE Linux Enterprise Server 12 SP4\nppc64le\n1\n");
write_file("$sles12/media.1/products", "SUSE-Linux-Enterprise-Server 12.4-0 ppc64le\n");
write_text("$sles12/content", "DEFAULTBASE ppc64le\nVERSION 12.4-0\n");
write_text("$sles12/media.1/media", "SUSE Linux Enterprise Server 12 SP4\nppc64le\n1\n");
write_text("$sles12/media.1/products", "SUSE-Linux-Enterprise-Server 12.4-0 ppc64le\n");
like(
inspect_media($sles12),
@@ -57,16 +50,16 @@ like(
my $sles12_source = tempdir(CLEANUP => 1);
make_path("$sles12_source/media.2");
write_file("$sles12_source/content", "DEFAULTBASE ppc64le\nVERSION 12.4-0\n");
write_file("$sles12_source/media.2/media", "SUSE\n20181107140652\n");
write_file("$sles12_source/media.2/products", "/ SLES12-SP4 12.4-0\n");
write_text("$sles12_source/content", "DEFAULTBASE ppc64le\nVERSION 12.4-0\n");
write_text("$sles12_source/media.2/media", "SUSE\n20181107140652\n");
write_text("$sles12_source/media.2/products", "/ SLES12-SP4 12.4-0\n");
like(
inspect_media($sles12_source),
qr/^DISTNAME:sles12\.4\nARCH:ppc64le\nDISCNO:2\n$/,
'SLES 12 source media uses its embedded media.2 sequence',
);
write_file("$sles12/media.1/products", "SUSE-Linux-Enterprise-Software-Development-Kit 12.4-0 ppc64le\n");
write_text("$sles12/media.1/products", "SUSE-Linux-Enterprise-Software-Development-Kit 12.4-0 ppc64le\n");
like(
inspect_media($sles12),
qr/^DISTNAME:sles12\.4\nARCH:ppc64le\nDISCNO:sdk3\n$/,
@@ -75,44 +68,44 @@ like(
my $sle15 = tempdir(CLEANUP => 1);
make_path("$sle15/media.1");
write_file("$sle15/media.1/products", "SLES 15 ppc64le\n");
write_text("$sle15/media.1/products", "SLES 15 ppc64le\n");
write_file("$sle15/media.1/media", "SUSE - SLE-15-Installer-DVD-ppc64le-Build668.1-Media\n");
write_text("$sle15/media.1/media", "SUSE - SLE-15-Installer-DVD-ppc64le-Build668.1-Media\n");
like(
inspect_media($sle15),
qr/^DISTNAME:sle15\nARCH:ppc64le\nDISCNO:1\n$/,
'SLE 15 primary Installer media keeps slot 1',
);
write_file("$sle15/media.1/media", "SUSE - SLE-15-Installer-DVD-ppc64le-Build668.1-Media-SOURCE\n");
write_text("$sle15/media.1/media", "SUSE - SLE-15-Installer-DVD-ppc64le-Build668.1-Media-SOURCE\n");
like(
inspect_media($sle15),
qr/^DISTNAME:sle15\nARCH:ppc64le\nDISCNO:installer2\n$/,
'SLE 15 Installer source media uses its embedded SOURCE marker',
);
write_file("$sle15/media.1/media", "SUSE - SLE-15-Packages-ppc64le-Build668.1-Media1.iso\n");
write_text("$sle15/media.1/media", "SUSE - SLE-15-Packages-ppc64le-Build668.1-Media1.iso\n");
like(
inspect_media($sle15),
qr/^DISTNAME:sle15\nARCH:ppc64le\nDISCNO:2\n$/,
'SLE 15 primary Packages media keeps slot 2',
);
write_file("$sle15/media.1/media", "SUSE - SLE-15-Packages-ppc64le-Build668.1-Media2.iso\n");
write_text("$sle15/media.1/media", "SUSE - SLE-15-Packages-ppc64le-Build668.1-Media2.iso\n");
like(
inspect_media($sle15),
qr/^DISTNAME:sle15\nARCH:ppc64le\nDISCNO:packages2\n$/,
'SLE 15 Packages source media uses its embedded Media2 marker',
);
write_file("$sle15/media.1/media", "SLE-15 SOURCE ppc64le\n");
write_text("$sle15/media.1/media", "SLE-15 SOURCE ppc64le\n");
like(
inspect_media($sle15),
qr/^DISTNAME:sle15\nARCH:ppc64le\nDISCNO:2\n$/,
'SLE 15 SOURCE Media2 keeps the existing packages-compatible slot',
);
write_file("$sle15/media.1/media", "SLE-15 Full ppc64le\n");
write_text("$sle15/media.1/media", "SLE-15 Full ppc64le\n");
like(
inspect_media($sle15),
qr/^DISTNAME:sle15\nARCH:ppc64le\nDISCNO:1\n$/,
+13 -27
View File
@@ -4,12 +4,15 @@ use warnings;
use File::Copy qw(copy);
use File::Path qw(make_path);
use File::Slurper qw(write_text);
use File::Spec;
use File::Temp qw(tempdir);
use FindBin;
use lib "$FindBin::Bin/../lib";
use Test::More;
my $repo_root = File::Spec->rel2abs(File::Spec->catdir($FindBin::Bin, '..', '..'));
use XCAT::Test::File qw(repo_path slurp_repo_file);
my @helpers = qw(
GlobalDef.pm
NetworkUtils.pm
@@ -22,9 +25,9 @@ my @affected_subcommands = qw(
xcatmn
);
my $builder = read_file('buildrpms.pl');
my $rpm_spec = read_file('xCAT-probe/xCAT-probe.spec');
my $debian_control = read_file('xCAT-probe/debian/control');
my $builder = slurp_repo_file('buildrpms.pl');
my $rpm_spec = slurp_repo_file('xCAT-probe/xCAT-probe.spec');
my $debian_control = slurp_repo_file('xCAT-probe/debian/control');
like($builder, qr/sub prepare_xcat_probe_source_tar\b/, 'RPM builder has dedicated xCAT-probe source preparation');
like(
$builder,
@@ -59,7 +62,7 @@ like(
);
for my $helper (@helpers) {
my $source = File::Spec->catfile($repo_root, 'perl-xCAT', 'xCAT', $helper);
my $source = repo_path(File::Spec->catfile('perl-xCAT', 'xCAT', $helper));
ok(-f $source, "$helper source exists");
like($builder, qr/^\s*\Q$helper\E\s*$/m, "RPM builder stages $helper");
}
@@ -72,24 +75,24 @@ my $subcmd_dir = File::Spec->catdir($probe_root, 'subcmds');
my $helper_dir = File::Spec->catdir($probe_root, 'lib', 'perl', 'xCAT');
make_path($probe_root, $bin_dir);
copy_tree(File::Spec->catdir($repo_root, 'xCAT-probe', 'lib'), File::Spec->catdir($probe_root, 'lib'));
copy_tree(File::Spec->catdir($repo_root, 'xCAT-probe', 'subcmds'), $subcmd_dir);
copy_tree(repo_path(File::Spec->catdir('xCAT-probe', 'lib')), File::Spec->catdir($probe_root, 'lib'));
copy_tree(repo_path(File::Spec->catdir('xCAT-probe', 'subcmds')), $subcmd_dir);
my $xcatprobe_source = File::Spec->catfile($repo_root, 'xCAT-probe', 'xcatprobe');
my $xcatprobe_source = repo_path(File::Spec->catfile('xCAT-probe', 'xcatprobe'));
my $xcatprobe = File::Spec->catfile($bin_dir, 'xcatprobe');
copy($xcatprobe_source, $xcatprobe) or die "copy $xcatprobe_source: $!";
chmod 0755, $xcatprobe or die "chmod $xcatprobe: $!";
make_path($helper_dir, File::Spec->catdir($subcmd_dir, 'bin'));
for my $helper (@helpers) {
my $source = File::Spec->catfile($repo_root, 'perl-xCAT', 'xCAT', $helper);
my $source = repo_path(File::Spec->catfile('perl-xCAT', 'xCAT', $helper));
my $destination = File::Spec->catfile($helper_dir, $helper);
copy($source, $destination) or die "copy $source: $!";
chmod 0644, $destination or die "chmod $destination: $!";
}
my $xcatclient = File::Spec->catfile($bin_dir, 'xcatclient');
write_file($xcatclient, "#!/bin/sh\nprintf '[ok]:dummy xcatclient\\n'\n");
write_text($xcatclient, "#!/bin/sh\nprintf '[ok]:dummy xcatclient\\n'\n");
chmod 0755, $xcatclient or die "chmod $xcatclient: $!";
local $ENV{XCATROOT} = $xcatroot;
@@ -117,16 +120,6 @@ for my $subcommand (@affected_subcommands) {
done_testing();
sub read_file {
my ($file) = @_;
my $path = File::Spec->catfile($repo_root, $file);
open(my $fh, '<', $path) or die "open $path: $!";
my $contents = do { local $/; <$fh> };
close($fh) or die "close $path: $!";
return $contents;
}
sub copy_tree {
my ($source, $destination) = @_;
my $rc = system('cp', '-R', $source, $destination);
@@ -141,10 +134,3 @@ sub run_command {
close($fh);
return ($? >> 8, $output // '');
}
sub write_file {
my ($path, $contents) = @_;
open(my $fh, '>', $path) or die "open $path: $!";
print {$fh} $contents;
close($fh) or die "close $path: $!";
}