Add tests for picking ver/api/auth default from META6

S11-modules/multi-version.t

@@ -0,0 +1,150 @@
+use Test;
+use lib $?FILE.IO.parent(2).add('packages/Test-Helpers');
+use lib $?FILE.IO.parent(2).add('packages/' ~ $?FILE.IO.parent(1).basename ~ '/multi-version/');
+use Test::Util;
+use MultiVer;
+
+plan 5;
+
+srand Date.today.DateTime.posix;
+
+sub is-output(Proc:D $p, Str:D $message = "script output", *%matchers) is test-assertion {
+    subtest $message => {
+        for %matchers.kv -> $key, $matcher {
+            my $pattr = $p."$key"();
+            $pattr .= slurp if $pattr ~~ IO::Handle;
+            cmp-ok $pattr, &[~~], $matcher, $key;
+        }
+    }
+}
+
+sub make_dep_spec(%vers, @keys) {
+    @keys.map({ ":$_\<" ~ %vers{$_} ~ ">" }).join
+}
+
+subtest "Basics" => {
+    is MultiVer.^ver, v0.0.42, "default 'ver' is picked from META6.json";
+    is MultiVer.^api, v0.1.1,  "default 'api' is picked from META6.json";
+    is MultiVer.^auth, 'ecosys:raku',  "default 'auth' is picked from META6.json";
+    is MultiVer::Foo.^ver, v0.0.2, "version can be explicitly overriden";
+    is MultiVer::Foo.^api, v0.1.1, "omitted key is still picked from META6.json";
+}
+
+# List of versions for CURFS distributions
+my @fs-versions =
+    { :api<0.0.11>, :ver<0.1.11>, :auth<fs:raku> },
+    { :api<0.0.12>, :ver<0.1.12>, :auth<fs:raku> },
+    { :api<0.0.13>, :ver<0.1.13>, :auth<fs:raku> };
+
+# List of versions for Installation distributions
+my @inst-versions =
+    { :api<0.2.11>, :ver<0.3.11>, :auth<inst:raku> },
+    { :api<0.2.12>, :ver<0.3.12>, :auth<inst:raku> },
+    { :api<0.2.13>, :ver<0.3.13>, :auth<inst:raku> };
+
+# For error testing
+my @bad-versions =
+    { :ver<99>, :message('bad version') },
+    { :api<13>, :message('bad api') },
+    { :auth<bad:one>, :message('bad auth') },
+    { :ver<0.1.12>, :api<13>, :message('ver is good but api is not') },
+    { :ver<0.112>, :api<0.0.11>, :message('api is good but ver is not') },
+    { :api<0.0.13>, :ver<0.1.13>, :auth<bad:one>, :message('both ver and api are good but not auth') },
+    ;
+
+sub test-good(MultiVer:D $mv, @versions, :@compiler-args) is test-assertion {
+    subtest "Good dependencies" => {
+        plan +@versions * 3;
+        for <ver api>.combinations(1..*) -> @keys {
+            my $code = "use MVDist;\nprint " ~ @keys.map({ qq[":$_\<", MVDist.^$_, ">"] }).join(", ") ~ ";";
+            for @versions -> %good {
+                my $dep_spec = make_dep_spec(%good, @keys);
+                my $st-dist = $mv.make-dist(:dist<TestDist>, fields => {:$dep_spec}, :standalone);
+                subtest "with " ~ $dep_spec => {
+                    plan 2;
+                    is-output
+                        $mv.run-standalone($code, :use-lib), "basic use",
+                        :out($dep_spec), :err(''), :exitcode(0);
+                    is-output
+                        $mv.run-standalone('EVAL ' ~ $code.raku ~ ';', :use-lib), "use within EVAL",
+                        :out($dep_spec), :err(''), :exitcode(0);
+                }
+            }
+        }
+    }
+}
+
+sub test-bad(MultiVer:D $mv, @versions, :@compiler-args) is test-assertion {
+    subtest "Bad dependencies" => {
+        plan +@versions;
+        for @versions -> %bad {
+            my $dep_spec = make_dep_spec(%bad, %bad.keys.grep(<api ver auth>.any));
+            my $st-dist = $mv.make-dist(:dist<TestDist>, fields => {:$dep_spec}, :standalone);
+            is-output
+                $mv.run-standalone('use MVDist;', :use-lib),
+                %bad<message> ~ " (dep.spec: $dep_spec)",
+                :out(''), :err(/"Could not find MVDist:" \w+/), :exitcode(1);
+        }
+    }
+}
+
+subtest "FileSystem repository" => {
+    plan 2;
+
+    my $mv = MultiVer.new;
+    for @fs-versions -> %fields {
+        $mv.make-dist(:%fields);
+    }
+
+    test-good($mv, @fs-versions);
+    test-bad($mv, @bad-versions);
+}
+
+subtest "Installation repository" => {
+    plan 3;
+    my $mv = MultiVer.new;
+    for @inst-versions -> %fields {
+        $mv.install-dist(:%fields);
+    }
+
+    subtest "Control" => {
+        plan 2;
+        my @installed = $mv.inst-repo.installed;
+        is +@installed, +@inst-versions, "all distros are installed";
+        ok @installed.map(*.meta<name>).all eq 'MVDist', "all installed distros are ours";
+    }
+
+    test-good($mv, @inst-versions);
+    test-bad($mv, @bad-versions);
+}
+
+subtest "Mix FileSystem and Installation" => {
+    plan 2;
+
+    my $mv = MultiVer.new;
+    for @fs-versions -> %fields {
+        $mv.make-dist(:%fields);
+    }
+    for @inst-versions -> %fields {
+        $mv.install-dist(:%fields);
+    }
+
+    test-good($mv, (@fs-versions, @inst-versions).flat);
+    test-bad($mv, @bad-versions);
+}
+
+subtest "Specification Syntax Error" => {
+    plan 2;
+    my $mv = MultiVer.new;
+
+    $mv.make-dist(fields => @fs-versions.head);
+    $mv.make-dist(:dist<TestDist>, fields => {:dep_spec(':?')}, :standalone);
+    is-output
+        $mv.run-standalone('CATCH { say .^name; }; EVAL "use MVDist;"', :use-lib), "bad spec line causes an error",
+        :out(/^"X::CompUnit::META::DependencySyntax" >>/), :err(/:i sorry .* "invalid syntax"/), :exitcode(1);
+
+    $mv.make-dist(:dist<TestDist>, fields => {:dep_spec(':api(no_ver)')}, :standalone);
+    is-output
+        $mv.run-standalone('CATCH { say .^name; }; EVAL "use MVDist;"', :use-lib), "bad spec line causes an error",
+        :out(/^"X::CompUnit::META::DependencySyntax" >>/), :err(/:i sorry .* "undeclared routine" .* no_ver/), :exitcode(1);
+}

packages/S11-modules/multi-version/META6.json

@@ -0,0 +1,20 @@
+{
+    "name": "MultiVer",
+    "api": "0.1.1",
+    "ver": "0.0.42",
+    "auth": "ecosys:raku",
+    "raku": "*",
+    "description": "Utils to test versioned distributions",
+    "provides": {
+        "MultiVer": "lib/MultiVer.rakumod"
+    },
+    "resources": [
+        "MVDist/META6.json.in",
+        "MVDist/bin/test-dist.raku.in",
+        "MVDist/lib/MVDist.rakumod.in",
+        "MVDist/lib/MVDist/Submod1.rakumod.in",
+        "MVDist/lib/MVDist/Submod2.rakumod.in",
+        "TestDist/META6.json.in",
+        "TestDist/bin/test-code.raku.in"
+    ]
+}

packages/S11-modules/multi-version/lib/MultiVer.rakumod

@@ -0,0 +1,142 @@
+use v6;
+unit class MultiVer;
+use Test::Util;
+
+class Foo:ver<0.0.2> { }
+
+has $.prefix;
+has @.distributions;
+has $.standalone;
+has $.standalone-script;
+has $.inst-dir;
+has $.inst-repo;
+has $.use-lib;
+
+submethod TWEAK {
+    $!prefix //= make-temp-dir;
+}
+
+method mksubdir(IO:D() $path) {
+    my $fullpath = $path.is-relative ?? $!prefix.add($path) !! $path;
+    return $fullpath if $fullpath.e;
+    my @path = $*SPEC.splitdir: $fullpath.resolve.relative($!prefix).IO;
+    my $subdir = $!prefix;
+    for @path -> $dir {
+        die "Can only create dirs under \$.prefix, but '" ~ $path ~ "' is outside of it" if $dir eq '..';
+        $subdir .= add($dir);
+        next if $subdir.e;
+        $subdir.mkdir;
+    }
+    $subdir
+}
+
+method rmsubdir(IO:D() $entry) {
+    return unless $entry.e;
+    if $entry.d {
+        for $entry.dir -> $subentry {
+            next if $subentry.basename eq '..' | '.';
+            if $subentry.d {
+                self.rmsubdir($subentry);
+            }
+            else {
+                $subentry.unlink;
+            }
+        }
+        $entry.rmdir;
+    }
+    else {
+        $entry.unink;
+    }
+}
+
+method make-dist(Str:D :$dist = 'MVDist', :%fields, Bool :$standalone, Bool :$include = True) {
+    my %dist-fields =
+        api => "0.0.1",
+        ver => "0.0.1",
+        auth => 'test:raku',
+        description => 'Test distribution',
+        |%fields;
+
+    my $dest-dir = $.prefix.add($dist ~ "-" ~ %dist-fields<ver>).IO;
+
+    # Remove the previous installation to guarantee no garbage is left behind.
+    self.rmsubdir($dest-dir);
+
+    for $?DISTRIBUTION.meta<resources>.grep({ .starts-with($dist ~ '/') && .ends-with('.in') }) -> IO() $tmpl {
+        my $dest-path = $dest-dir.add($*SPEC.catdir($*SPEC.splitdir($tmpl.dirname)[1..*]));
+        my $dest-file = self.mksubdir($dest-path).add($tmpl.basename.IO.extension(""));
+        my $content = %?RESOURCES{$tmpl}.slurp;
+        # Expand template's '#field#'
+        $content ~~ s:g/ '#' $<field>=[\w+?] '#' /{ %dist-fields{~$<field>} // '' }/;
+        $dest-file.spurt: $content;
+    }
+    my $distribution = CompUnit::Repository::Distribution.new(Distribution::Path.new($dest-dir));
+    if $standalone {
+        $!standalone = $distribution;
+        $!standalone-script = $dest-dir.add("bin/test-code.raku");
+    }
+    else {
+        if $include {
+            @!distributions.push: $distribution;
+            $!use-lib = Nil;
+        }
+    }
+    $distribution
+}
+
+method install-dist(Str:D :$dist = 'MVDist', :%fields) {
+    unless $!inst-dir {
+        $!inst-dir = self.mksubdir("install");
+        $!inst-repo = CompUnit::Repository::Installation.new(prefix => $!inst-dir);
+        $!use-lib = Nil;
+    }
+
+    my $distribution = self.make-dist(:$dist, :%fields, :!include);
+
+    $!inst-repo.install($distribution, :force);
+    $distribution
+}
+
+method use-libs {
+    return $_ with $!use-lib;
+    my @incs = @!distributions.map({ "use lib q<{.prefix}>;" });
+    @incs.push: "use lib q<inst#$_>;" with $!inst-dir;
+    $!use-lib = @incs.pick(*).join("\n")
+}
+
+method preserve-repo(&code) {
+    my $repo := $*REPO;
+    LEAVE PROCESS::<$REPO> := $repo;
+    &code();
+}
+
+method run(Str:D() $script, :@compiler-args) {
+    run $*EXECUTABLE.absolute, |@compiler-args, $script, :in, :out, :err
+}
+
+method run-standalone(Str:D $code is copy, :@compiler-args, Bool :$use-lib) {
+    fail "Standalone dist is not installed yet" unless $!standalone;
+    if $use-lib {
+        $code = self.use-libs ~ "\n#line 1 test-code.raku\n" ~ $code;
+    }
+    $!standalone-script.spurt: $code;
+    my $p = self.run: $!standalone-script, :compiler-args[
+        |@compiler-args,
+        '-I' ~ $!standalone.prefix
+    ];
+}
+
+method run-installed(Str:D $script-name, :@compiler-args) {
+    fail "No distribution installed yet" unless $!inst-dir;
+    my $raku-lib := %*ENV<RAKULIB> // Nil;
+    LEAVE if $raku-lib === Nil {
+            %*ENV<RAKULIB>:delete;
+        }
+        else {
+            %*ENV<RAKULIB> := $raku-lib;
+        };
+    %*ENV<RAKULIB> = 'inst#' ~ $!inst-dir;
+    self.run: $!inst-dir.add('bin/' ~ $script-name), :@compiler-args;
+}
+
+method distribution { $?DISTRIBUTION }

packages/S11-modules/multi-version/resources/MVDist/META6.json.in

@@ -0,0 +1,13 @@
+{
+    "name": "MVDist",
+    "api": "#api#",
+    "ver": "#ver#",
+    "auth": "#auth#",
+    "raku": "*",
+    "description": "#description#",
+    "provides": {
+        "MVDist": "lib/MVDist.rakumod",
+        "MVDist::Submod1": "lib/MVDist/Submod1.rakumod",
+        "MVDist::Submod2": "lib/MVDist/Submod2.rakumod"
+    }
+}

packages/S11-modules/multi-version/resources/MVDist/lib/MVDist.rakumod.in

@@ -0,0 +1,5 @@
+use v6;
+unit class MVDist;
+
+method distribution { $?DISTRIBUTION }
+method expanded-version { "#ver#" }

packages/S11-modules/multi-version/resources/MVDist/lib/MVDist/Submod1.rakumod.in

@@ -0,0 +1 @@
+unit module MVDist::Submod1;

packages/S11-modules/multi-version/resources/MVDist/lib/MVDist/Submod2.rakumod.in

@@ -0,0 +1 @@
+unit module MVDist::Submod2;

packages/S11-modules/multi-version/resources/TestDist/META6.json.in

@@ -0,0 +1,10 @@
+{
+    "name": "TestDist",
+    "ver": "0.0.1",
+    "auth": "test:raku",
+    "raku": "*",
+    "description": "Test MVDist versions",
+    "depends": [
+        "MVDist#dep_spec#"
+    ]
+}

packages/S11-modules/multi-version/resources/TestDist/bin/test-code.raku.in

@@ -0,0 +1,2 @@
+use v6;
+# This is a stub only, content of this file is not gonna be used.

spectest.data

@@ -637,6 +637,7 @@ S11-modules/importing.t
 S11-modules/lexical.t
 S11-modules/module-file.t
 S11-modules/module.t
+S11-modules/multi-version.t                 # slow
 S11-modules/need.t
 S11-modules/nested.t
 S11-modules/rakulib.t