From 1b0e9a496598a7195aa14e147e98ac3f73623903 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Thu, 15 Sep 2022 23:04:25 -0400 Subject: [PATCH 1/4] Add tests for picking ver/api/auth default from META6 In support of rakudo/rakudo#5060 --- S11-modules/multi-version.t | 150 ++++++++++++++++++ packages/S11-modules/multi-version/META6.json | 20 +++ .../multi-version/lib/MultiVer.rakumod | 142 +++++++++++++++++ .../resources/MVDist/META6.json.in | 13 ++ .../resources/MVDist/bin/test-dist.raku.in | 0 .../resources/MVDist/lib/MVDist.rakumod.in | 5 + .../MVDist/lib/MVDist/Submod1.rakumod.in | 1 + .../MVDist/lib/MVDist/Submod2.rakumod.in | 1 + .../resources/TestDist/META6.json.in | 10 ++ .../resources/TestDist/bin/test-code.raku.in | 2 + spectest.data | 1 + 11 files changed, 345 insertions(+) create mode 100644 S11-modules/multi-version.t create mode 100644 packages/S11-modules/multi-version/META6.json create mode 100644 packages/S11-modules/multi-version/lib/MultiVer.rakumod create mode 100644 packages/S11-modules/multi-version/resources/MVDist/META6.json.in create mode 100644 packages/S11-modules/multi-version/resources/MVDist/bin/test-dist.raku.in create mode 100644 packages/S11-modules/multi-version/resources/MVDist/lib/MVDist.rakumod.in create mode 100644 packages/S11-modules/multi-version/resources/MVDist/lib/MVDist/Submod1.rakumod.in create mode 100644 packages/S11-modules/multi-version/resources/MVDist/lib/MVDist/Submod2.rakumod.in create mode 100644 packages/S11-modules/multi-version/resources/TestDist/META6.json.in create mode 100644 packages/S11-modules/multi-version/resources/TestDist/bin/test-code.raku.in diff --git a/S11-modules/multi-version.t b/S11-modules/multi-version.t new file mode 100644 index 0000000000..49eab35679 --- /dev/null +++ b/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 }, + { :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 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(.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..a5d9c8b528 --- /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; + 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 // 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 From aa9cf31e03e75cf0184ea7ccc9ec4022441b43a1 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 16 Sep 2022 16:20:38 -0400 Subject: [PATCH 2/4] Remove unsused variable --- packages/S11-modules/multi-version/lib/MultiVer.rakumod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages/S11-modules/multi-version/lib/MultiVer.rakumod b/packages/S11-modules/multi-version/lib/MultiVer.rakumod index a5d9c8b528..a02b42c20e 100644 --- a/packages/S11-modules/multi-version/lib/MultiVer.rakumod +++ b/packages/S11-modules/multi-version/lib/MultiVer.rakumod @@ -120,7 +120,7 @@ method run-standalone(Str:D $code is copy, :@compiler-args, Bool :$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[ + self.run: $!standalone-script, :compiler-args[ |@compiler-args, '-I' ~ $!standalone.prefix ]; From 0ef2346d4312686b00ae66ec563b41d3f18131dc Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 16 Sep 2022 16:20:57 -0400 Subject: [PATCH 3/4] Close all Proc handles Make sure we don't left behind opened in/out/err. --- S11-modules/multi-version.t | 1 + 1 file changed, 1 insertion(+) diff --git a/S11-modules/multi-version.t b/S11-modules/multi-version.t index 49eab35679..94119fd792 100644 --- a/S11-modules/multi-version.t +++ b/S11-modules/multi-version.t @@ -15,6 +15,7 @@ sub is-output(Proc:D $p, Str:D $message = "script output", *%matchers) is test-a $pattr .= slurp if $pattr ~~ IO::Handle; cmp-ok $pattr, &[~~], $matcher, $key; } + ($p."$_"() andthen .close) for ; } } From 72e988ab4bbcc3b74891607a7cb20cf919862b51 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 16 Sep 2022 17:01:33 -0400 Subject: [PATCH 4/4] Add two control tests Make sure templates expanded correctly and distribution reported by module has the version we expect. --- S11-modules/multi-version.t | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/S11-modules/multi-version.t b/S11-modules/multi-version.t index 94119fd792..32c18e9443 100644 --- a/S11-modules/multi-version.t +++ b/S11-modules/multi-version.t @@ -62,7 +62,15 @@ sub test-good(MultiVer:D $mv, @versions, :@compiler-args) is test-assertion { my $dep_spec = make_dep_spec(%good, @keys); my $st-dist = $mv.make-dist(:dist, fields => {:$dep_spec}, :standalone); subtest "with " ~ $dep_spec => { - plan 2; + 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);