mirror of
https://github.com/xcat2/xcat-core.git
synced 2026-09-21 08:33:20 +00:00
test(xcat-core): a failed extraction in thirteen test files stops the whole suite
Thirteen test files this branch adds call BAIL_OUT at fifty-one places: an extraction that stopped matching, a fixture that is not there, a harness that wrote no log. prove stops every remaining file on a bail-out, not only the file that called it, so one of them hides the results of every test that would have run after it. die is just as loud and costs only its own file. Fifteen comments the branch added also carried the incident rather than the constraint. Three pasted an error transcript, five traced a failure from a macro or a missing file out to a node that never boots, and the rest counted call sites, package sizes or dracut build numbers. Each now states the one fact the reader cannot re-derive from the code. Signed-off-by: Daniel Hilst <392820+dhilst@users.noreply.github.com>
This commit is contained in:
@@ -33,9 +33,8 @@ my $GITHUB_API = "https://api.github.com";
|
||||
# before building and run the unit tests out of the copy.
|
||||
#
|
||||
# The copy is tidiness, not a requirement: builddebs.pl writes under dist/debs
|
||||
# inside the checkout and restores every file it edits, so it isolates the tests
|
||||
# from build residue and nothing more. Its predecessor deleted the checkout's
|
||||
# parent directory, which is why the copy was added.
|
||||
# inside the checkout and restores every file it edits, so the copy only keeps
|
||||
# build residue away from the tests.
|
||||
my $srcdir = getcwd();
|
||||
my $unitsrc = ($ENV{'RUNNER_TEMP'} ? $ENV{'RUNNER_TEMP'} : "/tmp") . "/xcat-core-unitsrc";
|
||||
|
||||
|
||||
@@ -48,8 +48,7 @@ install() {
|
||||
dracut_install mount.nfs sshd vi reboot lspci parted tmux mkfs mkfs.ext4 mkfs.xfs xfs_db
|
||||
#dracut_install libvirtd /usr/share/libvirt/cpu_map.xml /usr/bin/qemu-img /usr/libexec/qemu-kvm
|
||||
dracut_install mkswap df ifenslave ssh-keygen scp clear
|
||||
# getdestiny makes its request file with mktemp. Without it the node reports no
|
||||
# destiny, so xcatd never moves nodelist.status past powering-on.
|
||||
# getdestiny makes its request file with mktemp.
|
||||
dracut_install mktemp
|
||||
dracut_install lldpad
|
||||
|
||||
@@ -69,7 +68,7 @@ install() {
|
||||
fi
|
||||
|
||||
# OpenSSH 9.8 moved the per-connection work into sshd-session, which sshd execs by
|
||||
# absolute path. Without it every connection to Genesis is refused.
|
||||
# absolute path.
|
||||
for _sshd_helper in \
|
||||
/usr/libexec/openssh/sshd-session \
|
||||
/usr/libexec/openssh/sshd-auth \
|
||||
|
||||
@@ -53,13 +53,12 @@ install() {
|
||||
dracut_install mount.nfs sshd vi reboot lspci parted screen mkfs mkfs.ext4 mkfs.btrfs
|
||||
#dracut_install libvirtd /usr/share/libvirt/cpu_map.xml /usr/bin/qemu-img /usr/libexec/qemu-kvm
|
||||
dracut_install mkswap df ifenslave ssh-keygen scp clear
|
||||
# getdestiny makes its request file with mktemp. Without it the node reports no
|
||||
# destiny, so xcatd never moves nodelist.status past powering-on.
|
||||
# getdestiny makes its request file with mktemp.
|
||||
dracut_install mktemp
|
||||
dracut_install dhclient lldpad
|
||||
|
||||
# OpenSSH 9.8 moved the per-connection work into sshd-session, which sshd execs by
|
||||
# absolute path. Without it every connection to Genesis is refused.
|
||||
# absolute path.
|
||||
for _sshd_helper in \
|
||||
/usr/libexec/openssh/sshd-session \
|
||||
/usr/libexec/openssh/sshd-auth \
|
||||
|
||||
@@ -3,9 +3,7 @@
|
||||
# verify-genesis-payload [--commands-from <module-setup.sh>] <payload-root> [required-path ...]
|
||||
#
|
||||
# dracut_install() reports a missing binary and returns, so the module install function keeps
|
||||
# going and the image ships without it. Four such holes reached a release: no dhclient, no
|
||||
# openssl, no sshd-session and no UTF-8 locale. Check the extracted payload before it becomes
|
||||
# an rpm.
|
||||
# going and the image ships without it. Check the extracted payload before it is packaged.
|
||||
#
|
||||
# Paths given on the command line are relative to <payload-root>. --commands-from reads back
|
||||
# what the dracut module installs: a bare command name is looked for in the four binary
|
||||
|
||||
@@ -16,8 +16,7 @@ function runcmd(){
|
||||
# We should be using private networks
|
||||
TESTNODE=testnode
|
||||
TESTNODE_IP="192.168.3.1"
|
||||
# nodeset resolves the genesis kernel by the node arch. A hardcoded ppc64le node fails on
|
||||
# every other management node with "Could not find genesis.kernel.ppc64".
|
||||
# nodeset resolves the genesis kernel by the node arch, so the node takes this machine's.
|
||||
TESTNODE_ARCH="$(uname -m)"
|
||||
# The boot-loader configuration lives under the tftp root. Overridable so the check can run
|
||||
# against a scratch tree.
|
||||
|
||||
@@ -11,8 +11,8 @@ use Test::More;
|
||||
|
||||
my $program = "$FindBin::Bin/../xcattest";
|
||||
my $casedir = "$FindBin::Bin/../autotest/testcase";
|
||||
BAIL_OUT("xcattest is not at $program") unless -f $program;
|
||||
BAIL_OUT("no test cases under $casedir") unless -d $casedir;
|
||||
die("xcattest is not at $program") unless -f $program;
|
||||
die("no test cases under $casedir") unless -d $casedir;
|
||||
|
||||
# A check line xcattest does not understand costs the case the assertion it describes, and the
|
||||
# case says nothing about it: an unknown operator reports "Unrecognized testcase syntax", and a
|
||||
@@ -20,11 +20,11 @@ BAIL_OUT("no test cases under $casedir") unless -d $casedir;
|
||||
# Read the shipped check lines and let the harness report on them.
|
||||
my @files;
|
||||
find({ wanted => sub { push(@files, $File::Find::name) if -f $File::Find::name }, no_chdir => 1 }, $casedir);
|
||||
BAIL_OUT("no case files under $casedir") unless @files;
|
||||
die("no case files under $casedir") unless @files;
|
||||
|
||||
my (%checks, %vars);
|
||||
for my $file (sort @files) {
|
||||
open(my $fh, '<', $file) or BAIL_OUT("open $file: $!");
|
||||
open(my $fh, '<', $file) or die("open $file: $!");
|
||||
while (my $line = <$fh>) {
|
||||
chomp($line);
|
||||
next unless $line =~ /^check\s*:\s*(\S.*)$/;
|
||||
@@ -36,9 +36,9 @@ for my $file (sort @files) {
|
||||
$vars{$1} = 1 while ($check =~ /\$\$(\w+)/g);
|
||||
push(@{ $checks{$file} }, $check);
|
||||
}
|
||||
close($fh) or BAIL_OUT("close $file: $!");
|
||||
close($fh) or die("close $file: $!");
|
||||
}
|
||||
BAIL_OUT("no check lines under $casedir") unless keys %checks;
|
||||
die("no check lines under $casedir") unless keys %checks;
|
||||
|
||||
# One case per shipped file, so a check that reports nothing is attributed to its own file.
|
||||
my %case_of_file = map { $_ => 'syntax_' . do { my $n = $_; $n =~ s{^\Q$casedir\E/?}{}; $n =~ s/[^A-Za-z0-9_-]/_/g; $n } } keys %checks;
|
||||
@@ -55,11 +55,11 @@ for my $file (sort keys %checks) {
|
||||
# scratch tree keeps every file the run writes inside that tree.
|
||||
my $root = tempdir(CLEANUP => 1);
|
||||
make_path("$root/bin", "$root/cases");
|
||||
copy($program, "$root/bin/xcattest") or BAIL_OUT("copy xcattest: $!");
|
||||
copy($program, "$root/bin/xcattest") or die("copy xcattest: $!");
|
||||
chmod 0755, "$root/bin/xcattest";
|
||||
open(my $fixture_fh, '>', "$root/cases/fixture") or BAIL_OUT("write the fixture case: $!");
|
||||
open(my $fixture_fh, '>', "$root/cases/fixture") or die("write the fixture case: $!");
|
||||
print $fixture_fh $fixture;
|
||||
close($fixture_fh) or BAIL_OUT("close the fixture case: $!");
|
||||
close($fixture_fh) or die("close the fixture case: $!");
|
||||
|
||||
# Every variable a check line names has to resolve, or xcattest drops the whole case.
|
||||
# A "local" here would be undone at the end of its own statement, before the run.
|
||||
@@ -67,16 +67,16 @@ $ENV{"XCATTEST_$_"} = 'placeholder' for keys %vars;
|
||||
$ENV{XCATTEST_CASEDIR} = "$root/cases";
|
||||
# Some shipped patterns warn when perl compiles them, and the warnings say nothing about the
|
||||
# operator. The log file carries what this test reads, so the warnings go to the scratch tree.
|
||||
open(my $stderr_save, '>&', \*STDERR) or BAIL_OUT("save STDERR: $!");
|
||||
open(STDERR, '>', "$root/stderr") or BAIL_OUT("redirect STDERR: $!");
|
||||
open(my $stderr_save, '>&', \*STDERR) or die("save STDERR: $!");
|
||||
open(STDERR, '>', "$root/stderr") or die("redirect STDERR: $!");
|
||||
system($^X, "$root/bin/xcattest", '-q', '-t', join(',', sort values %case_of_file));
|
||||
open(STDERR, '>&', $stderr_save) or BAIL_OUT("restore STDERR: $!");
|
||||
open(STDERR, '>&', $stderr_save) or die("restore STDERR: $!");
|
||||
|
||||
my ($logname) = glob("$root/share/xcat/tools/autotest/result/xcattest.log.*");
|
||||
BAIL_OUT("the harness wrote no log under $root") unless $logname;
|
||||
open(my $log_fh, '<', $logname) or BAIL_OUT("open $logname: $!");
|
||||
die("the harness wrote no log under $root") unless $logname;
|
||||
open(my $log_fh, '<', $logname) or die("open $logname: $!");
|
||||
my @log = <$log_fh>;
|
||||
close($log_fh) or BAIL_OUT("close $logname: $!");
|
||||
close($log_fh) or die("close $logname: $!");
|
||||
chomp(@log);
|
||||
|
||||
# Count what the harness reported for each case, and keep the lines it did not understand.
|
||||
|
||||
@@ -1,11 +1,6 @@
|
||||
#!/usr/bin/env perl
|
||||
# xCAT and xCATsn name their Debian architectures explicitly. An architecture missing from that
|
||||
# list is not a build failure -- it is a package that never exists: apt on that architecture says
|
||||
#
|
||||
# E: Unable to locate package xcat
|
||||
#
|
||||
# and the management node cannot be installed at all. riscv64 was missing while the rest of the
|
||||
# tree already carried riscv64 install templates, DHCP boot policy and a Genesis machine config.
|
||||
# list is not a build failure: it is a package apt cannot find at all.
|
||||
#
|
||||
# The list is compared against the architectures the DEB build itself supports, taken from
|
||||
# build-utils/lib/XCAT/BuildUtils or, failing that, the documented set.
|
||||
@@ -38,16 +33,12 @@ for my $ctl (@controls) {
|
||||
}
|
||||
|
||||
# The genesis dependency must follow the architecture. xCAT and xCATsn are built once per
|
||||
# architecture from one control file, so an unrestricted "Depends: xcat-genesis-scripts-amd64"
|
||||
# reaches the ppc64el and riscv64 debs too. That package is Architecture: all, so it installs and
|
||||
# apt reports no error -- it lays down the x86_64 Genesis tree and pulls the 128 MB amd64
|
||||
# genesis-base, and the management node gets no Genesis for its own architecture. The rpm side
|
||||
# already selects per architecture through %{?genesistarch:Requires: xCAT-genesis-scripts-...}.
|
||||
# architecture from one control file, and xcat-genesis-scripts-amd64 is Architecture: all, so an
|
||||
# unrestricted Depends on it installs the x86_64 Genesis tree on every architecture.
|
||||
#
|
||||
# xCAT-genesis-scripts keeps one control file per Debian architecture, and the file name is the
|
||||
# Debian architecture. Its package name and its genesis-base dependency must carry that same
|
||||
# architecture: xcat-genesis-base-ppc64 is a name no repository publishes, while the base deb
|
||||
# that builddeb-genesis-base builds for ppc64el is xcat-genesis-base-ppc64el.
|
||||
# xCAT-genesis-scripts keeps one control file per Debian architecture, named for it. Its package
|
||||
# name and its genesis-base dependency must carry that same architecture: the base deb
|
||||
# builddeb-genesis-base builds for ppc64el is xcat-genesis-base-ppc64el, not -ppc64.
|
||||
|
||||
# Return the folded value of a control field, or undef.
|
||||
sub control_field {
|
||||
|
||||
@@ -15,7 +15,7 @@ use Test::More;
|
||||
|
||||
my $root = "$FindBin::Bin/../..";
|
||||
my $script = "$root/xCAT-genesis-builder/debuild-xcat-genesis-base";
|
||||
BAIL_OUT("debuild-xcat-genesis-base not found at $script") unless -f $script;
|
||||
die("debuild-xcat-genesis-base not found at $script") unless -f $script;
|
||||
|
||||
my $tmpdir = tempdir(CLEANUP => 1);
|
||||
my $driver = "$tmpdir/driver.sh";
|
||||
@@ -86,7 +86,7 @@ my %superseded = (
|
||||
for my $rpm (sort keys %expected) {
|
||||
my $arch = $expected{$rpm};
|
||||
my ($dir, $control) = convert($arch, $rpm);
|
||||
BAIL_OUT("debuild-xcat-genesis-base produced no source tree for $rpm")
|
||||
die("debuild-xcat-genesis-base produced no source tree for $rpm")
|
||||
unless defined $dir;
|
||||
|
||||
like($dir, qr/\Q-$arch-\E/, "$rpm builds in a $arch source tree");
|
||||
|
||||
@@ -25,7 +25,7 @@ plan tests => 8;
|
||||
|
||||
my $text = slurp_repo_file('xCAT-genesis-builder/builddeb-genesis-base');
|
||||
my ($function) = $text =~ /^(rewrite_control\(\)\s*\{.*?^\})/ms;
|
||||
BAIL_OUT('rewrite_control() no longer matches in builddeb-genesis-base')
|
||||
die('rewrite_control() no longer matches in builddeb-genesis-base')
|
||||
unless defined $function;
|
||||
|
||||
my $tmpdir = tempdir(CLEANUP => 1);
|
||||
@@ -59,6 +59,6 @@ sub rewrite {
|
||||
my $driver = "$tmpdir/driver.$arch.sh";
|
||||
write_text($driver, "#!/bin/bash\nset -eu\n$function\nrewrite_control \"\$1\" \"\$2\"\n");
|
||||
system('bash', $driver, $copy, $arch) == 0
|
||||
or BAIL_OUT("rewrite_control failed for $arch");
|
||||
or die("rewrite_control failed for $arch");
|
||||
return read_text($copy);
|
||||
}
|
||||
|
||||
@@ -24,8 +24,7 @@ plan tests => 5 * scalar(keys %HOOK) + 2;
|
||||
|
||||
my $tmpdir = tempdir(CLEANUP => 1);
|
||||
|
||||
# The failure this captures: with no UTF-8 locale in the image, tmux exits and the old
|
||||
# unconditional `while :; do tmux ...; done` never reached doxcat.
|
||||
# tmux exits under the C locale, so an unguarded tmux loop never reaches doxcat.
|
||||
my $el = read_text(repo_path($HOOK{el}{path}));
|
||||
ok($el !~ qr/^while :; do tmux attach-session/m,
|
||||
'el: no unguarded tmux loop is left at column 0');
|
||||
@@ -62,7 +61,7 @@ sub extract_function {
|
||||
my ($path, $name, $label) = @_;
|
||||
my $text = read_text($path);
|
||||
my ($body) = $text =~ /^($name\(\)\s*\{.*?^\})$/ms;
|
||||
BAIL_OUT("$label: $name() not found in $path") unless defined $body;
|
||||
die("$label: $name() not found in $path") unless defined $body;
|
||||
return $body;
|
||||
}
|
||||
|
||||
|
||||
@@ -23,9 +23,7 @@ my $ISC6 = 'dhclient -6 -pf /var/run/dhclient6.eth0.pid eth0 -lf /var/lib/dhcl
|
||||
my $source = read_text( repo_path($DOXCAT) );
|
||||
my $tmpdir = tempdir( CLEANUP => 1 );
|
||||
|
||||
# The failure this captures: doxcat named dhclient at six call sites, so on a release that
|
||||
# packages no ISC client Genesis reported "dhclient: command not found" and no node ever got
|
||||
# an address.
|
||||
# A release that packages no ISC client has no dhclient, so doxcat must not name one directly.
|
||||
ok( $source !~ qr/^\s*dhclient\s/m,
|
||||
'doxcat starts no command line with dhclient' );
|
||||
ok( $source !~ qr/;\s*dhclient\s/,
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
#!/usr/bin/env perl
|
||||
# Drive verify-genesis-payload against payload trees that reproduce the three holes the
|
||||
# released legacy Genesis image shipped with.
|
||||
# Drive verify-genesis-payload against payload trees that each leave out one thing the image
|
||||
# needs.
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
@@ -25,8 +25,7 @@ my $good = build_payload(sshd_execs_session => 1, session_helper => 1, tmux => 1
|
||||
my ($rc, $err) = run($good, 'usr/sbin/dhclient');
|
||||
is($rc, 0, 'a complete payload passes') or diag($err);
|
||||
|
||||
# doxcat calls dhclient with ISC flags. The released el9 image carried dhclient.conf and
|
||||
# dhclient-script but no dhclient, so Genesis never acquired an address.
|
||||
# doxcat calls dhclient with ISC flags. dhclient.conf and dhclient-script are not enough.
|
||||
my $nodhcp = build_payload(sshd_execs_session => 1, session_helper => 1, tmux => 1, locale => 1, dhclient => 0, mktemp => 1);
|
||||
($rc, $err) = run($nodhcp, 'usr/sbin/dhclient');
|
||||
isnt($rc, 0, 'a payload without dhclient fails');
|
||||
@@ -49,16 +48,14 @@ my $nolocale = build_payload(sshd_execs_session => 1, session_helper => 1, tmux
|
||||
isnt($rc, 0, 'a payload with tmux and no UTF-8 locale fails');
|
||||
like($err, qr{C\.utf8}, 'the missing locale is named');
|
||||
|
||||
# getdestiny makes its request file with mktemp. Without it the node never reports its destiny,
|
||||
# so xcatd never sets nodelist.status and the node stays at powering-on.
|
||||
# getdestiny makes its request file with mktemp.
|
||||
my $nomktemp = build_payload(sshd_execs_session => 1, session_helper => 1, tmux => 1, locale => 1, dhclient => 1, mktemp => 0);
|
||||
($rc, $err) = run($nomktemp, 'usr/sbin/dhclient');
|
||||
isnt($rc, 0, 'a payload without mktemp fails');
|
||||
like($err, qr{usr/bin/mktemp}, 'the missing mktemp is named');
|
||||
|
||||
# dracut_install reports a missing binary and returns, so every name the dracut module
|
||||
# installs has to be checked against the payload. The el10 image shipped with no openssl and
|
||||
# getcert waited on it for the life of the node.
|
||||
# installs has to be checked against the payload.
|
||||
my $module = write_module_setup([qw(openssl wget tar)]);
|
||||
my $full = build_payload(sshd_execs_session => 1, session_helper => 1, tmux => 1, locale => 1,
|
||||
dhclient => 1, mktemp => 1, commands => [qw(openssl wget tar)]);
|
||||
|
||||
@@ -22,9 +22,8 @@ my @HOOKS = (
|
||||
'xCAT-genesis-builder/dracut_105/ubuntu/xcat-cmdline.sh',
|
||||
);
|
||||
|
||||
# dracut 99base writes the root entry itself. Up to dracut 057 the password field is
|
||||
# always x. From dracut 060 the x arrives only with --hostonly, and the Genesis image is
|
||||
# built with -N, so el10 (dracut 107) ships an empty password field.
|
||||
# dracut 99base writes the root entry itself. Up to dracut 057 the password field is always
|
||||
# x; from dracut 060 the x arrives only with --hostonly, and the Genesis image is built -N.
|
||||
my %SHIPPED = (
|
||||
'dracut 049/057 (el8, el9)' => "root:x:0:0::/root:/bin/sh\n",
|
||||
'dracut 107 (el10)' => "root::0:0::/root:/bin/sh\n",
|
||||
@@ -62,7 +61,7 @@ sub extract_passwd_block {
|
||||
my ($path, $label) = @_;
|
||||
my $text = read_text($path);
|
||||
my ($block) = $text =~ m{^(sed [^\n]*/etc/passwd\ncat >>/etc/passwd <<"__ENDL"\n.*?^__ENDL)$}ms;
|
||||
BAIL_OUT("$label: the /etc/passwd rewrite was not found") unless defined $block;
|
||||
die("$label: the /etc/passwd rewrite was not found") unless defined $block;
|
||||
return $block;
|
||||
}
|
||||
|
||||
@@ -80,11 +79,11 @@ sub run_rewrite {
|
||||
|
||||
my $script = $block;
|
||||
my $hits = ($script =~ s{/etc/passwd}{$passwd}g);
|
||||
BAIL_OUT("$label: expected 2 references to /etc/passwd, found $hits") unless $hits == 2;
|
||||
BAIL_OUT("$label: a reference to the real /etc/passwd survived") if index($script, '/etc/passwd') >= 0;
|
||||
die("$label: expected 2 references to /etc/passwd, found $hits") unless $hits == 2;
|
||||
die("$label: a reference to the real /etc/passwd survived") if index($script, '/etc/passwd') >= 0;
|
||||
|
||||
write_text("$dir/rewrite.sh", "set -e\n$script\n");
|
||||
system('/bin/bash', "$dir/rewrite.sh") == 0
|
||||
or BAIL_OUT("$label: the /etc/passwd rewrite failed to run");
|
||||
or die("$label: the /etc/passwd rewrite failed to run");
|
||||
return read_text($passwd);
|
||||
}
|
||||
|
||||
@@ -1,9 +1,8 @@
|
||||
#!/usr/bin/env perl
|
||||
# The genesis specs name their package after the target arch: xCAT-genesis-scripts-<tarch> and
|
||||
# xCAT-genesis-base-<tarch>. %{tarch} comes from an %ifarch ladder, and an arch missing from that
|
||||
# ladder leaves the macro UNEXPANDED instead of failing: rpm then builds a package literally named
|
||||
# "xCAT-genesis-scripts-%{tarch}", buildrpms.pl cannot find the srpm it asked for, and the whole
|
||||
# target build dies with a "Cannot find/open srpm" that names the right file.
|
||||
# ladder leaves the macro unexpanded instead of failing, so rpm builds a package whose Name
|
||||
# carries the macro.
|
||||
#
|
||||
# Expand each spec with rpmspec for every arch xCAT supports and assert the Name carries that arch.
|
||||
use strict;
|
||||
|
||||
@@ -52,8 +52,7 @@ is(os_for("NAME=\"Ubuntu\"\nID=ubuntu\n"), 'ubuntu', 'Ubuntu is still
|
||||
1, 'report_genesis_files propagates the failure to its caller');
|
||||
}
|
||||
|
||||
# Genesis generates new host keys at every boot and each case boots the node several times, so
|
||||
# the second boot met "REMOTE HOST IDENTIFICATION HAS CHANGED" and xdsh could not reach it.
|
||||
# Genesis generates new host keys at every boot, and each case boots the node several times.
|
||||
{
|
||||
no warnings 'once';
|
||||
eval_subs($source, qw(forget_host_keys testxdsh));
|
||||
@@ -65,8 +64,7 @@ is(os_for("NAME=\"Ubuntu\"\nID=ubuntu\n"), 'ubuntu', 'Ubuntu is still
|
||||
}
|
||||
|
||||
# xCAT sets nodelist.status from the destiny the node reports with getdestiny: "shell" for the
|
||||
# shell destiny, "configuring" for runcmd. A Genesis node never reaches "booted" -- that status
|
||||
# belongs to an operating system install reporting through updateflag.
|
||||
# shell destiny, "configuring" for runcmd. "booted" belongs to an operating system install.
|
||||
{
|
||||
no warnings 'once';
|
||||
local $GenesisTest::noderange = 'xcat71-cn';
|
||||
@@ -147,11 +145,11 @@ sub eval_subs {
|
||||
$code .= "sub send_msg { push \@GenesisTest::MSG, \$_[1]; return 0; }\n";
|
||||
foreach my $name (@names) {
|
||||
my ($body) = $text =~ /^(sub \Q$name\E \{.*?^\})$/ms;
|
||||
BAIL_OUT("sub $name() not found in $helper") unless defined $body;
|
||||
die("sub $name() not found in $helper") unless defined $body;
|
||||
$code .= "$body\n";
|
||||
}
|
||||
$code .= "1;\n";
|
||||
eval $code or BAIL_OUT("cannot compile the extracted helpers: $@");
|
||||
eval $code or die("cannot compile the extracted helpers: $@");
|
||||
}
|
||||
|
||||
#---
|
||||
@@ -162,7 +160,7 @@ sub waiter_name {
|
||||
foreach my $name (qw(wait_for_node_status wait_for_boot)) {
|
||||
return $name if $text =~ /^sub \Q$name\E \{/m;
|
||||
}
|
||||
BAIL_OUT("no destiny status check found in $helper");
|
||||
die("no destiny status check found in $helper");
|
||||
}
|
||||
|
||||
#---
|
||||
|
||||
@@ -1,10 +1,8 @@
|
||||
#!/usr/bin/env perl
|
||||
# go-xcat installs and uninstalls a fixed list of package names, and it keeps one list per
|
||||
# packaging format. The Genesis packages are named after the architecture, and the two formats
|
||||
# spell that architecture differently: the rpm is xCAT-genesis-scripts-ppc64, the deb is
|
||||
# xcat-genesis-scripts-ppc64el. A name that no repository publishes makes apt fail the whole
|
||||
# transaction, so one stale entry stops "go-xcat install" and "go-xcat uninstall" on that
|
||||
# architecture.
|
||||
# spell it differently: the rpm is xCAT-genesis-scripts-ppc64, the deb is
|
||||
# xcat-genesis-scripts-ppc64el.
|
||||
#
|
||||
# The lists are built by go-xcat itself here, not read as text: the deb list exists only when
|
||||
# "type dpkg" succeeds, so a shell function decides which branch each run takes.
|
||||
@@ -17,7 +15,7 @@ use Test::More;
|
||||
|
||||
my $root = "$FindBin::Bin/../..";
|
||||
my $go_xcat = "$root/xCAT-server/share/xcat/tools/go-xcat";
|
||||
BAIL_OUT("go-xcat not found at $go_xcat") unless -f $go_xcat;
|
||||
die("go-xcat not found at $go_xcat") unless -f $go_xcat;
|
||||
|
||||
my $tmpdir = tempdir(CLEANUP => 1);
|
||||
my $driver = "$tmpdir/driver.sh";
|
||||
@@ -60,7 +58,7 @@ sub package_lists {
|
||||
$list{$which} = [ split /\s+/, ($packages // '') ];
|
||||
}
|
||||
close($out);
|
||||
BAIL_OUT('go-xcat package arrays could not be evaluated')
|
||||
die('go-xcat package arrays could not be evaluated')
|
||||
unless $list{install} && $list{uninstall};
|
||||
return \%list;
|
||||
}
|
||||
@@ -82,16 +80,16 @@ sub named {
|
||||
|
||||
my $rpm = package_lists(0);
|
||||
my $deb = package_lists(1);
|
||||
BAIL_OUT('the dpkg branch of go-xcat was not taken')
|
||||
die('the dpkg branch of go-xcat was not taken')
|
||||
unless grep { $_ eq 'xcat-client' } @{ $deb->{install} };
|
||||
BAIL_OUT('the rpm branch of go-xcat was not taken')
|
||||
die('the rpm branch of go-xcat was not taken')
|
||||
unless grep { $_ eq 'xCAT-client' } @{ $rpm->{install} };
|
||||
|
||||
# The deb names come from the packaging: one control file per Debian architecture names the
|
||||
# genesis-scripts package, and its Depends names the genesis-base package that carries the
|
||||
# Genesis tree for that same architecture.
|
||||
my @control = sort glob("$root/xCAT-genesis-scripts/debian/control-*");
|
||||
BAIL_OUT('no xCAT-genesis-scripts Debian control files') unless @control;
|
||||
die('no xCAT-genesis-scripts Debian control files') unless @control;
|
||||
my (@deb_scripts, @deb_base);
|
||||
for my $control (@control) {
|
||||
my $text = slurp($control);
|
||||
@@ -112,7 +110,7 @@ for my $which (qw(install uninstall)) {
|
||||
# architecture name.
|
||||
my %tarch = map { $_ => 1 } (slurp("$root/xCAT-genesis-builder/xCAT-genesis-base.spec")
|
||||
=~ /^%define\s+tarch\s+(\S+)/mg);
|
||||
BAIL_OUT('no Genesis target architectures in xCAT-genesis-base.spec') unless %tarch;
|
||||
die('no Genesis target architectures in xCAT-genesis-base.spec') unless %tarch;
|
||||
|
||||
for my $which (qw(install uninstall)) {
|
||||
for my $prefix (qw(xCAT-genesis-scripts- xCAT-genesis-base-)) {
|
||||
|
||||
@@ -17,7 +17,7 @@ my @routines;
|
||||
for my $name (qw(createstorage build_diskstruct guest_arch_profile getUnits
|
||||
default_storagemodel)) {
|
||||
my ($routine) = $content =~ /^(sub \Q$name\E\s*\{.*?^\})/ms;
|
||||
BAIL_OUT("could not extract $name from kvm.pm") unless $routine;
|
||||
die("could not extract $name from kvm.pm") unless $routine;
|
||||
push(@routines, $routine);
|
||||
}
|
||||
|
||||
@@ -34,7 +34,7 @@ sub get_multiple_paths_by_url { return {}; }
|
||||
PERL
|
||||
|
||||
eval $harness . join("\n", @routines) . "\n1;\n"; ## no critic (BuiltinFunctions::ProhibitStringyEval)
|
||||
BAIL_OUT("could not load the kvm storage routines: $@") if $@;
|
||||
die("could not load the kvm storage routines: $@") if $@;
|
||||
|
||||
# The name createstorage gives the volume of one node. $stale is a capture left live in this
|
||||
# block by an earlier successful match, which is the state createstorage runs in when a
|
||||
@@ -81,13 +81,12 @@ is(volume_dev(storage => 'dir:///var/lib/libvirt/images/=scsi'), 'sda',
|
||||
is(volume_dev(storagemodel => 'virtio'), 'vda',
|
||||
'vmstoragemodel=virtio names a vd* volume');
|
||||
|
||||
# createstorage on its own defaults to ide. Nothing in the product reaches this today, because
|
||||
# dohyp gives every node the default storage model first.
|
||||
# createstorage on its own defaults to ide. Nothing in the product reaches this today: dohyp
|
||||
# gives every node the default storage model first.
|
||||
is(volume_dev(), 'hda', 'createstorage alone defaults to an hd* volume');
|
||||
|
||||
# So the sd* name of a node with no vmstoragemodel rests on that default, and a riscv64 node
|
||||
# rests on the sd* name. Drive the two together, so a change to the default fails here rather
|
||||
# than on a riscv64 node that stops booting.
|
||||
# A node with no vmstoragemodel takes its sd* name from that default, so the two are driven
|
||||
# together.
|
||||
is(volume_dev(storagemodel => KVMStore::default_storagemodel()), 'sda',
|
||||
'the default storage model names an sd* volume');
|
||||
|
||||
|
||||
@@ -16,7 +16,7 @@ close($source_fh) or die "close $source: $!";
|
||||
my @routines;
|
||||
for my $name (qw(build_diskstruct guest_arch_profile getUnits)) {
|
||||
my ($routine) = $content =~ /^(sub \Q$name\E\s*\{.*?^\})/ms;
|
||||
BAIL_OUT("could not extract $name from kvm.pm") unless $routine;
|
||||
die("could not extract $name from kvm.pm") unless $routine;
|
||||
push(@routines, $routine);
|
||||
}
|
||||
|
||||
@@ -30,7 +30,7 @@ sub get_multiple_paths_by_url { return $pool; }
|
||||
PERL
|
||||
|
||||
eval $harness . join("\n", @routines) . "\n1;\n"; ## no critic (BuiltinFunctions::ProhibitStringyEval)
|
||||
BAIL_OUT("could not load the kvm disk builder: $@") if $@;
|
||||
die("could not load the kvm disk builder: $@") if $@;
|
||||
|
||||
# Build the disks of a node of $arch whose vmstorage is a libvirt pool holding the volumes
|
||||
# in $pool: a path => { device, format } map, the shape get_multiple_paths_by_url returns.
|
||||
@@ -54,7 +54,7 @@ sub pool_disks {
|
||||
local *STDOUT = $capture;
|
||||
($disks) = KVMDisk::build_diskstruct(undef);
|
||||
}
|
||||
BAIL_OUT('build_diskstruct returned no disks') unless ref $disks eq 'ARRAY';
|
||||
die('build_diskstruct returned no disks') unless ref $disks eq 'ARRAY';
|
||||
return $disks;
|
||||
}
|
||||
|
||||
|
||||
@@ -16,7 +16,7 @@ close($source_fh) or die "close $source: $!";
|
||||
my @routines;
|
||||
for my $name (qw(build_xmldesc guest_arch_profile build_oshash build_diskstruct getUnits)) {
|
||||
my ($routine) = $content =~ /^(sub \Q$name\E\s*\{.*?^\})/ms;
|
||||
BAIL_OUT("could not extract $name from kvm.pm") unless $routine;
|
||||
die("could not extract $name from kvm.pm") unless $routine;
|
||||
push(@routines, $routine);
|
||||
}
|
||||
|
||||
@@ -34,7 +34,7 @@ sub genpassword { return 'password'; }
|
||||
PERL
|
||||
|
||||
eval $harness . join("\n", @routines) . "\n1;\n"; ## no critic (BuiltinFunctions::ProhibitStringyEval)
|
||||
BAIL_OUT("could not load the kvm domain builder: $@") if $@;
|
||||
die("could not load the kvm domain builder: $@") if $@;
|
||||
|
||||
# Build one domain for a node of $guest_arch on a hypervisor that reports $hyp_cpumodel.
|
||||
sub domain_xml {
|
||||
@@ -47,7 +47,7 @@ sub domain_xml {
|
||||
};
|
||||
local $KVMArch::updatetable = {};
|
||||
my $xml = KVMArch::build_xmldesc('cn1');
|
||||
BAIL_OUT("build_xmldesc returned no XML for $guest_arch on $hyp_cpumodel")
|
||||
die("build_xmldesc returned no XML for $guest_arch on $hyp_cpumodel")
|
||||
unless defined $xml and !ref $xml;
|
||||
return $xml;
|
||||
}
|
||||
|
||||
@@ -1,8 +1,6 @@
|
||||
#!/usr/bin/env perl
|
||||
# mknb stages the Genesis payload before it can build a netboot image. Those copies are the
|
||||
# only point at which mknb learns that an installed Genesis image is unusable, so a copy that
|
||||
# fails silently produces an initramfs built from nothing and an exit status of 0 -- the node
|
||||
# then never boots, with no error anywhere naming the cause.
|
||||
# mknb stages the Genesis payload before it can build a netboot image. Those copies are the only
|
||||
# point at which mknb learns that an installed Genesis image is unusable.
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
@@ -18,7 +16,7 @@ BEGIN { $INC{'xCAT/Utils.pm'} = 1; $INC{'xCAT/MsgUtils.pm'} = 1;
|
||||
require "$FindBin::Bin/../../xCAT-server/lib/xcat/plugins/mknb.pm";
|
||||
|
||||
can_ok('xCAT_plugin::mknb', 'stage_genesis_payload')
|
||||
or BAIL_OUT('mknb has no stage_genesis_payload to drive');
|
||||
or die('mknb has no stage_genesis_payload to drive');
|
||||
|
||||
# Drive the routine with a runner that fails exactly one copy, so each assertion names the
|
||||
# copy it is about rather than the pair.
|
||||
|
||||
@@ -148,7 +148,7 @@ sub copy_tree {
|
||||
my ($source, $destination) = @_;
|
||||
my $rc = system('cp', '-R', $source, $destination);
|
||||
is($rc, 0, "copied $source into the package fixture")
|
||||
or BAIL_OUT("unable to create package fixture from $source");
|
||||
or die("unable to create package fixture from $source");
|
||||
}
|
||||
|
||||
sub run_command {
|
||||
|
||||
@@ -9,7 +9,7 @@ use File::Temp qw(tempdir);
|
||||
use Test::More;
|
||||
|
||||
my $program = "$FindBin::Bin/../xcattest";
|
||||
BAIL_OUT("xcattest is not at $program") unless -f $program;
|
||||
die("xcattest is not at $program") unless -f $program;
|
||||
|
||||
#---
|
||||
=head3 run_harness
|
||||
@@ -29,29 +29,29 @@ sub run_harness {
|
||||
# under the scratch tree keeps every file the run writes inside that tree.
|
||||
my $root = tempdir(CLEANUP => 1);
|
||||
make_path("$root/bin", "$root/cases");
|
||||
copy($program, "$root/bin/xcattest") or BAIL_OUT("copy xcattest: $!");
|
||||
copy($program, "$root/bin/xcattest") or die("copy xcattest: $!");
|
||||
chmod 0755, "$root/bin/xcattest";
|
||||
|
||||
open(my $case_fh, '>', "$root/cases/fixture") or BAIL_OUT("write the fixture case: $!");
|
||||
open(my $case_fh, '>', "$root/cases/fixture") or die("write the fixture case: $!");
|
||||
print $case_fh $case_text;
|
||||
close($case_fh) or BAIL_OUT("close the fixture case: $!");
|
||||
close($case_fh) or die("close the fixture case: $!");
|
||||
|
||||
local $ENV{XCATTEST_CASEDIR} = "$root/cases";
|
||||
system($^X, "$root/bin/xcattest", '-q', '-t', join(',', @names));
|
||||
|
||||
my $slurp = sub {
|
||||
my ($path) = @_;
|
||||
open(my $fh, '<', $path) or BAIL_OUT("open $path: $!");
|
||||
open(my $fh, '<', $path) or die("open $path: $!");
|
||||
my @lines = <$fh>;
|
||||
close($fh) or BAIL_OUT("close $path: $!");
|
||||
close($fh) or die("close $path: $!");
|
||||
chomp(@lines);
|
||||
return @lines;
|
||||
};
|
||||
|
||||
my ($log) = glob("$root/share/xcat/tools/autotest/result/xcattest.log.*");
|
||||
BAIL_OUT("the harness wrote no running log under $root") unless $log;
|
||||
die("the harness wrote no running log under $root") unless $log;
|
||||
my ($failed) = glob("$root/share/xcat/tools/autotest/result/failedcases.*");
|
||||
BAIL_OUT("the harness wrote no failed-cases report under $root") unless $failed;
|
||||
die("the harness wrote no failed-cases report under $root") unless $failed;
|
||||
|
||||
return ([ $slurp->($log) ], [ $slurp->($failed) ]);
|
||||
}
|
||||
|
||||
+2
-3
@@ -1417,9 +1417,8 @@ sub run_case {
|
||||
log_this($running_log_fd, ("ElapsedTime:$diffduration sec", "RETURN rc = $rc", "OUTPUT:", @output));
|
||||
push(@caselog, ("ElapsedTime:$diffduration sec", "RETURN rc = $rc", "OUTPUT:", @output));
|
||||
|
||||
# $checkfail is the result of this check, $failflag the result of the case. They
|
||||
# were one variable, so a failed check made every later check read as failed, and
|
||||
# the guard that hid that also hid the checks (issue #76).
|
||||
# $checkfail is the result of this check, $failflag the result of the case. One
|
||||
# variable for both makes a failed check read as failing every later check.
|
||||
my $checkfail = 0;
|
||||
foreach my $check (@{ $cases_ref->[ $case_name_index_map_ref->{$case} ]->{check}->[$j] }) {
|
||||
$checkfail = 0;
|
||||
|
||||
Reference in New Issue
Block a user