webmin/t/web-lib-funcs-numeric.t

#!/usr/bin/perl
# Unit tests for numeric / version-comparison helpers in web-lib-funcs.pl.
# Pure subs — bare require is enough.

use strict;
use warnings;
use Test::More;
use File::Basename qw(dirname);
use File::Spec;

my $script = File::Spec->rel2abs(
	File::Spec->catfile(dirname(__FILE__), '..', 'web-lib-funcs.pl'));
require $script;

# is_int — strict signed decimal integer.
#
# Regex is /^([-]?\d+)$/: allows a single leading "-", no leading "+",
# no whitespace, no scientific notation, no hex.
subtest 'is_int' => sub {
	ok( main::is_int('0'),    '"0" is int');
	ok( main::is_int('42'),   '"42" is int');
	ok( main::is_int('-5'),   'negative int');
	ok( main::is_int('01'),   'leading zero accepted');

	ok(!main::is_int('+5'),   'leading "+" rejected (no signed-positive form)');
	ok(!main::is_int(' 5'),   'leading whitespace rejected');
	ok(!main::is_int('5 '),   'trailing whitespace rejected');
	ok(!main::is_int('1.0'),  'decimals rejected');
	ok(!main::is_int('1e3'),  'scientific notation rejected');
	ok(!main::is_int('0x10'), 'hex rejected');
	ok(!main::is_int(''),     'empty rejected');
	ok(!main::is_int('abc'),  'non-numeric rejected');
	# undef returns false but also triggers a "uninitialized value" warning
	# inside the regex (web-lib-funcs.pl is not warnings-enabled today, but
	# `prove -w` or a future `use warnings` would surface it). Silence the
	# warning at the call site so the suite stays clean either way.
	{ local $SIG{__WARN__} = sub {};
	  ok(!main::is_int(undef), 'undef rejected'); }
};

# is_float — strict decimal with a dot.
#
# Regex is /^[-]?(\.\d+|\d+\.\d+)$/. The decimal point is required, so
# integers don't qualify. Trailing dot ("5.") is rejected. Scientific
# notation rejected.
subtest 'is_float' => sub {
	ok( main::is_float('1.5'),   'plain float');
	ok( main::is_float('-1.5'),  'negative float');
	ok( main::is_float('.5'),    'leading-dot form accepted');
	ok( main::is_float('-.5'),   'negative leading-dot form accepted');
	ok( main::is_float('0.0'),   'zero with decimal accepted');

	ok(!main::is_float('5'),     'plain integer rejected (decimal point required)');
	ok(!main::is_float('5.'),    'trailing-dot form rejected');
	ok(!main::is_float('1e3'),   'scientific notation rejected');
	ok(!main::is_float('+1.5'),  'leading "+" rejected');
	ok(!main::is_float(' 1.5'),  'leading whitespace rejected');
	ok(!main::is_float(''),      'empty rejected');
	ok(!main::is_float('abc'),   'non-numeric rejected');
	# See is_int's undef comment.
	{ local $SIG{__WARN__} = sub {};
	  ok(!main::is_float(undef), 'undef rejected'); }
};

# float — parse-and-format helper.
#
# Returns sprintf('%.2f', $n) if that's non-zero, otherwise the literal 0.
# So unparseable input collapses to plain 0 (no decimals), but a valid
# zero number also returns plain 0 — the two are indistinguishable from
# the output side. Leading "+" is silently accepted here even though
# is_int / is_float reject it — asymmetric with the validators.
subtest 'float' => sub {
	is(main::float('42'),    '42.00',  'integer string → 2-decimal form');
	is(main::float('1.5'),   '1.50',   'float string → 2-decimal form');
	is(main::float('-1.5'),  '-1.50',  'negative float');
	is(main::float('1e3'),   '1000.00', 'scientific notation parsed');
	is(main::float('+5'),    '5.00',   'leading "+" silently accepted (asymmetric with is_int/is_float)');

	# All these collapse to plain 0 — non-parseable, empty, undef, true
	# zero. Non-numeric / undef inputs warn inside sprintf under -w
	# (uninitialized / isn't numeric); silence per call site so the suite
	# stays warning-free regardless of how prove is invoked.
	{ local $SIG{__WARN__} = sub {};
	  is(main::float('abc'),  0, 'non-numeric → 0');
	  is(main::float(''),     0, 'empty → 0');
	  is(main::float(undef),  0, 'undef → 0'); }
	is(main::float('0'),   0, 'zero collapses to plain 0 (not "0.00")');
	is(main::float('0.0'), 0, 'zero with decimal also collapses to plain 0');
};

# compare_version_numbers — Debian-ish version comparator.
#
# Two calling shapes:
#   compare_version_numbers($a, $b)            → -1 / 0 / 1
#   compare_version_numbers($a, $op, $b)       → boolean
#
# Splits each version on /[.\-+~_]/, then walks segment-by-segment with
# a handful of special cases (pure numeric, numeric+string, "ubuntu"
# prefix strip, "rcN" < final).
subtest 'compare_version_numbers (numeric form)' => sub {
	# Equal.
	is(main::compare_version_numbers('1.0', '1.0'),     0, 'equal');
	is(main::compare_version_numbers('1.2.3', '1.2.3'), 0, 'equal three-part');

	# Numeric ordering — NOT lexical, so "1.10" > "1.9".
	is(main::compare_version_numbers('1.10', '1.9'),    1, '1.10 > 1.9 (numeric, not lexical)');
	is(main::compare_version_numbers('1.0', '1.1'),    -1, 'simple less-than');
	is(main::compare_version_numbers('2', '1.9'),       1, 'shorter higher major wins');

	# Different separators are interchangeable.
	is(main::compare_version_numbers('1-2', '1.2'),     0, 'dot and dash interchangeable');
	is(main::compare_version_numbers('1_2~3', '1.2.3'), 0, 'underscore and tilde interchangeable');

	# Numeric segment with a string tail — string compared after number.
	is(main::compare_version_numbers('1ubuntu5', '1ubuntu10'), -1, 'ubuntu5 < ubuntu10 (numeric tail)');
	is(main::compare_version_numbers('6redhat', '8redhat'),    -1, 'leading number wins over string tail');

	# Pure-string-prefix + number variant ("centos7" vs "centos8").
	is(main::compare_version_numbers('centos7', 'centos8'), -1, 'centos7 < centos8');

	# "ubuntu" prefix is silently stripped per-segment.
	is(main::compare_version_numbers('ubuntu5', '5'), 0,
	   '"ubuntu" prefix is stripped (ubuntu5 == 5)');

	# rcN is always older than the final release of the same number.
	is(main::compare_version_numbers('1rc1', '1'),   -1, 'rc1 < release');
	is(main::compare_version_numbers('1', '1rc1'),    1, 'release > rc1');
	is(main::compare_version_numbers('1RC1', '1'),   -1, 'rc match is case-insensitive');
	is(main::compare_version_numbers('1rc2', '1rc1'), 1, 'rc2 > rc1');

	# Other string tails (alpha, beta) are NOT special-cased like rc, so
	# they compare lexically after the leading number — and lose to a
	# bare number on the same prefix because "" sorts before "alpha".
	is(main::compare_version_numbers('1alpha', '1'),     1, '"alpha" tail > bare (lexical, no special-case)');
	is(main::compare_version_numbers('1beta', '1alpha'), 1, 'lexical compare of string tails');

	# Trailing-zero / segment-count asymmetry: 1.0 < 1.0.0 (the trailing
	# missing segment compares as "less than" 0). This is a quirk to be
	# aware of when normalizing version strings before compare.
	is(main::compare_version_numbers('1.0', '1.0.0'),   -1, 'shorter < longer when prefix matches');
	is(main::compare_version_numbers('1.0.0', '1.0'),    1, 'longer > shorter when prefix matches');

	# Empty / undef inputs degrade quietly to a numeric answer rather
	# than crashing. (The sub defaults undef to '' internally, so undef
	# args don't warn under -w.)
	is(main::compare_version_numbers('', '1.0'),   -1, 'empty < non-empty');
	is(main::compare_version_numbers(undef, undef), 0, 'two undefs compare equal');
};

subtest 'compare_version_numbers (operator form)' => sub {
	ok( main::compare_version_numbers('1.0', '<',  '2.0'), '1.0 <  2.0');
	ok( main::compare_version_numbers('1.0', '<=', '1.0'), '1.0 <= 1.0');
	ok( main::compare_version_numbers('1.0', '==', '1.0'), '1.0 == 1.0');
	ok( main::compare_version_numbers('2.0', '>',  '1.0'), '2.0 >  1.0');
	ok( main::compare_version_numbers('2.0', '>=', '2.0'), '2.0 >= 2.0');

	ok(!main::compare_version_numbers('1.0', '>',  '2.0'), '1.0 not >  2.0');
	ok(!main::compare_version_numbers('1.0', '==', '2.0'), '1.0 not == 2.0');

	# Numeric-not-lexical also holds through the operator form.
	ok( main::compare_version_numbers('1.10', '>', '1.9'), '1.10 > 1.9 via op');
};

done_testing();