diff --git a/S11-modules/multi-version.t b/S11-modules/multi-version.t new file mode 100644 index 0000000000..32c18e9443 --- /dev/null +++ b/S11-modules/multi-version.t @@ -0,0 +1,159 @@ +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; + } + ($p."$_"() andthen .close) for ; + } +} + +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 }, + { :api<0.0.12>, :ver<0.1.12>, :auth }, + { :api<0.0.13>, :ver<0.1.13>, :auth }; + +# List of versions for Installation distributions +my @inst-versions = + { :api<0.2.11>, :ver<0.3.11>, :auth }, + { :api<0.2.12>, :ver<0.3.12>, :auth }, + { :api<0.2.13>, :ver<0.3.13>, :auth }; + +# For error testing +my @bad-versions = + { :ver<99>, :message('bad version') }, + { :api<13>, :message('bad api') }, + { :auth, :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, :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 .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, fields => {:$dep_spec}, :standalone); + subtest "with " ~ $dep_spec => { + plan 4; + is-output + $mv.run-standalone('use MVDist; print MVDist.expanded-version', :use-lib), + "template expanded correctly", + :out(%good), :err(''), :exitcode(0); + is-output + $mv.run-standalone('use MVDist; print MVDist.distribution.meta', :use-lib), + "dustrubution version", + :out(%good), :err(''), :exitcode(0); + 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(.any)); + my $st-dist = $mv.make-dist(:dist, fields => {:$dep_spec}, :standalone); + is-output + $mv.run-standalone('use MVDist;', :use-lib), + %bad ~ " (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).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, 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, 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); +} \ No newline at end of file diff --git a/packages/S11-modules/multi-version/META6.json b/packages/S11-modules/multi-version/META6.json new file mode 100644 index 0000000000..35b9e63173 --- /dev/null +++ b/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" + ] +} \ No newline at end of file diff --git a/packages/S11-modules/multi-version/lib/MultiVer.rakumod b/packages/S11-modules/multi-version/lib/MultiVer.rakumod new file mode 100644 index 0000000000..a02b42c20e --- /dev/null +++ b/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).IO; + + # Remove the previous installation to guarantee no garbage is left behind. + self.rmsubdir($dest-dir); + + for $?DISTRIBUTION.meta.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/ '#' $=[\w+?] '#' /{ %dist-fields{~$} // '' }/; + $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;" 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; + 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 // Nil; + LEAVE if $raku-lib === Nil { + %*ENV:delete; + } + else { + %*ENV := $raku-lib; + }; + %*ENV = 'inst#' ~ $!inst-dir; + self.run: $!inst-dir.add('bin/' ~ $script-name), :@compiler-args; +} + +method distribution { $?DISTRIBUTION } \ No newline at end of file diff --git a/packages/S11-modules/multi-version/resources/MVDist/META6.json.in b/packages/S11-modules/multi-version/resources/MVDist/META6.json.in new file mode 100644 index 0000000000..34f82ba0f8 --- /dev/null +++ b/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" + } +} \ No newline at end of file diff --git a/packages/S11-modules/multi-version/resources/MVDist/bin/test-dist.raku.in b/packages/S11-modules/multi-version/resources/MVDist/bin/test-dist.raku.in new file mode 100644 index 0000000000..e69de29bb2 diff --git a/packages/S11-modules/multi-version/resources/MVDist/lib/MVDist.rakumod.in b/packages/S11-modules/multi-version/resources/MVDist/lib/MVDist.rakumod.in new file mode 100644 index 0000000000..3252fc4556 --- /dev/null +++ b/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#" } \ No newline at end of file diff --git a/packages/S11-modules/multi-version/resources/MVDist/lib/MVDist/Submod1.rakumod.in b/packages/S11-modules/multi-version/resources/MVDist/lib/MVDist/Submod1.rakumod.in new file mode 100644 index 0000000000..cc372c99ac --- /dev/null +++ b/packages/S11-modules/multi-version/resources/MVDist/lib/MVDist/Submod1.rakumod.in @@ -0,0 +1 @@ +unit module MVDist::Submod1; \ No newline at end of file diff --git a/packages/S11-modules/multi-version/resources/MVDist/lib/MVDist/Submod2.rakumod.in b/packages/S11-modules/multi-version/resources/MVDist/lib/MVDist/Submod2.rakumod.in new file mode 100644 index 0000000000..9c5717a72b --- /dev/null +++ b/packages/S11-modules/multi-version/resources/MVDist/lib/MVDist/Submod2.rakumod.in @@ -0,0 +1 @@ +unit module MVDist::Submod2; \ No newline at end of file diff --git a/packages/S11-modules/multi-version/resources/TestDist/META6.json.in b/packages/S11-modules/multi-version/resources/TestDist/META6.json.in new file mode 100644 index 0000000000..e26c206549 --- /dev/null +++ b/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#" + ] +} \ No newline at end of file diff --git a/packages/S11-modules/multi-version/resources/TestDist/bin/test-code.raku.in b/packages/S11-modules/multi-version/resources/TestDist/bin/test-code.raku.in new file mode 100644 index 0000000000..e19ce13745 --- /dev/null +++ b/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. \ No newline at end of file diff --git a/spectest.data b/spectest.data index 44ba9523fe..0623a0f11f 100644 --- a/spectest.data +++ b/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