test/suites/version.sh

# suite: mplib::version -- vercmp/ver_satisfies/parse_dep_token across a
# wide matrix of real and pathological inputs. pure perl-level checks (no
# installs), so the matrix is run as dozens of individually-reported
# cases without the cost of a staging cycle each.
 
# one vercmp case: prints "-1/0/1" for cmp(a,b), asserted against the
# expected sign.
vercmp_case() {
	# $1 name, $2 a, $3 b, $4 expected sign
	t_begin "$1"
	reset_state
	out=$(cd /root/mpbuildtest && perl -I. -Implib -Mmplib::version=vercmp -e "print vercmp('$2','$3');" 2>&1)
	if [ "$out" != "$4" ]; then
		t_fail "$CUR_TEST (vercmp($2,$3) = $out, expected $4)"
		return
	fi
	t_pass
}
 
run_vercmp_matrix() {
	vercmp_case vercmp_release_equal 1.0 1.0 0
	vercmp_case vercmp_patch_higher 1.0.1 1.0 1
	vercmp_case vercmp_major_higher 2.0 1.9.9 1
	vercmp_case vercmp_zerofill_equal 1.0.0 1.0 0
	vercmp_case vercmp_stage_below_release 1.0rc1 1.0 -1
	vercmp_case vercmp_stage_below_release2 1.0b2 1.0 -1
	vercmp_case vercmp_alpha_below_beta 1.0a1 1.0b1 -1
	vercmp_case vercmp_beta_below_pre 1.0b9 1.0pre1 -1
	vercmp_case vercmp_pre_below_rc 1.0pre2 1.0rc1 -1
	vercmp_case vercmp_rc_above_alpha 1.0rc1 1.0a2 1
	vercmp_case vercmp_stage_numbering 1.0rc9 1.0rc2 1
	vercmp_case vercmp_stage_beats_no_stage 1.0a1 1.0 -1
	vercmp_case vercmp_revision_tiebreak 1.0-r2 1.0-r1 1
	vercmp_case vercmp_revision_beats_stage 1.0-r1 1.0rc9 1
	vercmp_case vercmp_stage_beats_revision 1.0b1-r1 1.0b1 1
	vercmp_case vercmp_git_newest 1.0 git -1
	vercmp_case vercmp_git_beats_anything git 999.999 1
	vercmp_case vercmp_git_equal_self git git 0
	vercmp_case vercmp_numeric_components 10.0 9.999 1
	vercmp_case vercmp_zerofill_equal2 1.1 1.1.0 0
	vercmp_case vercmp_many_components 1.2.3.4.5 1.2.3.4 1
	vercmp_case vercmp_unparsable_newest 1.0 nosuchver -1
	vercmp_case vercmp_unparsable_both 1.0.foo 1.0.bar 1
	vercmp_case vercmp_trailing_dot 1.0. 1.0 0
	# "p" (post-release patch level): the one stage this scheme had no
	# way to express until now -- unlike a/b/pre/rc (all PRE-release,
	# ordered before a plain release), "p" sorts AFTER it, same
	# direction as PMS's own "_p" this is modeled on (see version.pm's
	# own comment for why the underscore itself isn't carried over).
	vercmp_case vercmp_p_above_release 1.0p1 1.0 1
	vercmp_case vercmp_p_above_rc 1.0p1 1.0rc1 1
	vercmp_case vercmp_p_numbering 1.0p2 1.0p1 1
	vercmp_case vercmp_p_with_revision 1.0p1-r1 1.0p1 1
}
 
# one ver_satisfies case.
versat_case() {
	# $1 name, $2 ver, $3 op, $4 val, $5 expected (0/1)
	t_begin "$1"
	reset_state
	out=$(cd /root/mpbuildtest && perl -I. -Implib -Mmplib::version=ver_satisfies -e "print ver_satisfies('$2','$3','$4') ? 1 : 0;" 2>&1)
	if [ "$out" != "$5" ]; then
		t_fail "$CUR_TEST (ver_satisfies($2,$3,$4) = $out, expected $5)"
		return
	fi
	t_pass
}
 
run_versat_matrix() {
	versat_case versat_ge_match 1.5 '>=' 1.5 1
	versat_case versat_ge_higher 2.0 '>=' 1.5 1
	versat_case versat_ge_lower 1.0 '>=' 1.5 0
	versat_case versat_le_match 1.5 '<=' 1.5 1
	versat_case versat_le_lower 1.0 '<=' 1.5 1
	versat_case versat_le_higher 2.0 '<=' 1.5 0
	versat_case versat_gt_above 2.0 '>' 1.5 1
	versat_case versat_gt_equal 1.5 '>' 1.5 0
	versat_case versat_lt_below 1.0 '<' 1.5 1
	versat_case versat_lt_equal 1.5 '<' 1.5 0
	versat_case versat_eq_match 1.5 '=' 1.5 1
	versat_case versat_eq_mismatch 1.6 '=' 1.5 0
	versat_case versat_tilde_prefix 1.2.9 '~' 1.2 1
	versat_case versat_tilde_exact 1.2 '~' 1.2 1
	versat_case versat_tilde_wrong 1.3.0 '~' 1.2 0
	versat_case versat_tilde_shorter 1.2 '~' 1.2.3 0
	versat_case versat_tilde_rc 1.2rc1 '~' 1.2 1
	versat_case versat_tilde_revision 1.2-r1 '~' 1.2 1
	versat_case versat_noop_empty 1.0 '' 9.9 1
	versat_case versat_git_anyop git '>=' 1.0 1
	versat_case versat_ge_stage 1.0rc1 '>=' 1.0a1 1
	versat_case versat_le_stage 1.0a1 '<=' 1.0b1 1
	versat_case versat_p_ge 1.0p1 '>=' 1.0 1
	versat_case versat_p_gt_rc 1.0p1 '>' 1.0rc1 1
}
 
# one parse_dep_token case: prints a canonical field dump (istag|name|
# slot|op|val|use|repo) asserted against the expected string. "use" is
# its own hash ({flag=>1|0, ...}, undef if the atom carried no "[...]"
# at all) -- dumped sorted-by-flag-name, "flag" for a required-enabled
# entry and "-flag" for required-disabled, comma-joined, so a multi-
# flag atom's dump is deterministic regardless of Perl's own internal
# hash key order.
depcase() {
	# $1 name, $2 token, $3 expected dump
	t_begin "$1"
	reset_state
	out=$(cd /root/mpbuildtest && perl -I. -Implib -Mmplib::version=parse_dep_token -e '
my $t = parse_dep_token($ARGV[0]);
my $usestr = "-";
if (defined $t->{use}) {
	$usestr = join(",", map { ($t->{use}{$_} ? "" : "-") . $_ } sort keys %{$t->{use}});
}
print join("|", ($t->{istag} ? "%" : ""), $t->{name}, defined($t->{slot}) ? $t->{slot} : "-", defined($t->{op}) ? $t->{op} : "-", defined($t->{val}) ? $t->{val} : "-", $usestr, defined($t->{repo}) ? $t->{repo} : "-");
' "$2" 2>&1)
	if [ "$out" != "$3" ]; then
		t_fail "$CUR_TEST (parse_dep_token($2) = $out, expected $3)"
		return
	fi
	t_pass
}
 
run_deptoken_matrix() {
	depcase deptok_bare 'zlib' '|zlib|-|-|-|-|-'
	depcase deptok_tag '%libc' '%|libc|-|-|-|-|-'
	depcase deptok_slot 'gcc:12' '|gcc|12|-|-|-|-'
	depcase deptok_compound_slot 'gcc:12-glibc-znver3-O3' '|gcc|12-glibc-znver3-O3|-|-|-|-'
	depcase deptok_version 'zlib>=1.2' '|zlib|-|>=|1.2|-|-'
	depcase deptok_eq 'zlib=2.0' '|zlib|-|=|2.0|-|-'
	depcase deptok_slot_version 'gcc:12>=12.2' '|gcc|12|>=|12.2|-|-'
	depcase deptok_revision 'somelib>=2.0-r1' '|somelib|-|>=|2.0-r1|-|-'
	depcase deptok_tilde 'somelib~1.2' '|somelib|-|~|1.2|-|-'
	depcase deptok_tag_slot '%gcc:12' '%|gcc|12|-|-|-|-'
	depcase deptok_dots 'pkg.name.sub=1.2' '|pkg.name.sub|-|=|1.2|-|-'
	depcase deptok_plus 'libstdc++>=13' '|libstdc++|-|>=|13|-|-'
	depcase deptok_hyphen_name 'foo-bar' '|foo-bar|-|-|-|-|-'
	depcase deptok_slot_only_colon 'x:' '|x:|-|-|-|-|-'
	depcase deptok_unparsable_slash 'cat/pkg' '|cat/pkg|-|-|-|-|-'
	depcase deptok_slash_barename 'meta/null' '|meta/null|-|-|-|-|-'
	depcase deptok_question_marker '?soft' '|?soft|-|-|-|-|-'
	depcase deptok_exclaim '!pkg' '|!pkg|-|-|-|-|-'
	depcase deptok_underscores 'pkg_name_slot:slot_x' '|pkg_name_slot|slot_x|-|-|-|-'
	depcase deptok_caps 'X11Lib>=1.0' '|X11Lib|-|>=|1.0|-|-'
	depcase deptok_stage_ver 'pkg>=1.0rc1' '|pkg|-|>=|1.0rc1|-|-'
	depcase deptok_p_ver 'pkg>=1.0p1' '|pkg|-|>=|1.0p1|-|-'
	# repo-qualified atoms ("::repo", always last -- see version.pm's own
	# comment for why this is unambiguous against slot/version). "a:b:c"
	# (single colons, never a literal "::") still falls through
	# unparsed, unaffected -- kept right below as a explicit contrast.
	depcase deptok_repo_bare 'gcc::main' '|gcc|-|-|-|-|main'
	depcase deptok_repo_slot 'gcc:12::main' '|gcc|12|-|-|-|main'
	depcase deptok_repo_version 'gcc>=12.2::main' '|gcc|-|>=|12.2|-|main'
	depcase deptok_repo_slot_version 'gcc:12>=12.2::main' '|gcc|12|>=|12.2|-|main'
	# this ONE case's expectation changed deliberately from before repo
	# qualifiers existed (was "unparsed bare name x::y") -- see
	# version.pm's own comment on parse_dep_token for why.
	depcase deptok_double_colon 'x::y' '|x|-|-|-|-|y'
	depcase deptok_multicolon 'a:b:c' '|a:b:c|-|-|-|-|-'
	# USE-conditional atoms ("[flag,-flag,...]", between the version
	# group and "::repo" -- see version.pm's own comment for the
	# ordering and why the fuller PMS "[flag=]"/"[flag?]" forms aren't
	# supported). BEFORE the version group (the wrong order for this
	# grammar) falls through unparsed, same as any other malformed atom.
	depcase deptok_use_require 'zlib[ssl]' '|zlib|-|-|-|ssl|-'
	depcase deptok_use_forbid 'zlib[-ssl]' '|zlib|-|-|-|-ssl|-'
	depcase deptok_use_multi 'curl[ssl,-http2,static]' '|curl|-|-|-|-http2,ssl,static|-'
	depcase deptok_use_wrong_order 'gcc:12[cxx]>=12.2' '|gcc:12[cxx]>=12.2|-|-|-|-|-'
	depcase deptok_use_with_version 'gcc:12>=12.2[cxx]' '|gcc|12|>=|12.2|cxx|-'
	depcase deptok_use_with_repo 'gcc:12>=12.2[cxx]::main' '|gcc|12|>=|12.2|cxx|main'
}
 
run_version_suite() {
	run_vercmp_matrix
	run_versat_matrix
	run_deptoken_matrix
}