Signed-off-by: Max Carrara <m.carr...@proxmox.com>
---
Changes v2 --> v3:
* Adapt code accordingly since path_components doesn't return a list
ref in scalar context anymore
Changes v1 --> v2:
* NEW: Split from patch 02
test/Path/Makefile | 1 +
test/Path/path_components_tests.pl | 162 +++++++++++++++++++++++++++++
2 files changed, 163 insertions(+)
create mode 100755 test/Path/path_components_tests.pl
diff --git a/test/Path/Makefile b/test/Path/Makefile
index 5998c19..3f48a38 100644
--- a/test/Path/Makefile
+++ b/test/Path/Makefile
@@ -1,4 +1,5 @@
TESTS = \
+ path_components_tests.pl \
path_is_absolute_relative_tests.pl \
diff --git a/test/Path/path_components_tests.pl
b/test/Path/path_components_tests.pl
new file mode 100755
index 0000000..cbbbc22
--- /dev/null
+++ b/test/Path/path_components_tests.pl
@@ -0,0 +1,162 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+my $path_components_cases = [
+ {
+ name => "empty path",
+ path => "",
+ components => [],
+ },
+ {
+ name => "root",
+ path => "/",
+ components => ["/"],
+ },
+ {
+ name => "current path reference",
+ path => ".",
+ components => ["."],
+ },
+ {
+ name => "parent directory reference",
+ path => "..",
+ components => [".."],
+ },
+ {
+ name => "single component, relative",
+ path => "foo",
+ components => ["foo"],
+ },
+ {
+ name => "single component, absolute",
+ path => "/foo",
+ components => ["/", "foo"],
+ },
+ {
+ name => "multiple components, relative",
+ path => "foo/bar/baz/quo/qux",
+ components => ["foo", "bar", "baz", "quo", "qux"],
+ },
+ {
+ name => "multiple components, absolute",
+ path => "/foo/bar/baz/quo/qux",
+ components => ["/", "foo", "bar", "baz", "quo", "qux"],
+ },
+ {
+ name => "multiple components,"
+ . " starting with current path reference,"
+ . " with redundant current path references",
+ path => "././foo/./bar/././baz/./././quo/././././qux/./.",
+ components => [".", "foo", "bar", "baz", "quo", "qux"],
+ },
+ {
+ name => "multiple components, with parent directory references",
+ path => "../../foo/../bar/../../baz/../../../quo/../../../../qux/../..",
+ components => [
+ "..", "..", "foo",
+ "..", "bar",
+ "..", "..", "baz",
+ "..", "..", "..", "quo",
+ "..", "..", "..", "..", "qux",
+ "..", "..",
+ ],
+ },
+ {
+ name => "multiple components, with redundant path separators",
+ path => "foo//bar///baz////quo/////qux//////",
+ components => ["foo", "bar", "baz", "quo", "qux"],
+ },
+ {
+ name => "root path, with redundant path separators",
+ path => "//////////",
+ components => ["/"],
+ },
+ {
+ name => "root path, with redundant current path references",
+ path => "/./././././././.",
+ components => ["/"],
+ },
+ {
+ name => "current path reference, with redundant path separators",
+ path => ".//////////",
+ components => ["."],
+ },
+ {
+ name => "current path reference, with redundant current path
references",
+ path => "././././././././.",
+ components => ["."],
+ },
+ {
+ name => "multiple components,"
+ . " absolute,"
+ . " with redundant path separators,"
+ . " with redundant current path references,"
+ . " with parent directory references",
+ path =>
"///././//foo//.//bar////././//.///baz//..///.././quo/./.././/qux//././/",
+ components => ["/", "foo", "bar", "baz", "..", "..", "quo", "..",
"qux"],
+ },
+ {
+ name => "path is undef",
+ path => undef,
+ components => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_components : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_components: " . $case->{name};
+
+ my $components = eval {
+ my @comps = PVE::Path::path_components($case->{path});
+ \@comps;
+ };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Failed to get components of path:\n$@");
+ return;
+ }
+
+ if (!is_deeply($components, $case->{components}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{components}));
+ diag("=== Got ===");
+ diag(explain($components));
+ }
+
+ return;
+}
+
+sub main : prototype() {
+ plan(tests => scalar($path_components_cases->@*));
+
+ for my $case ($path_components_cases->@*) {
+ eval {
+ # suppress warnings here to make output less noisy for certain
tests if necessary
+ # local $SIG{__WARN__} = sub {};
+ test_path_components($case);
+ };
+ warn "$@\n" if $@;
+ }
+
+ done_testing();
+
+ return;
+}
+
+main();
--
2.39.5
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
