Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Some roles ported to module-tools

  • Loading branch information...
commit 09bf501b93c9367c270e7912f848db6560c52271 1 parent f7bb51b
@tadzik tadzik authored
Showing with 14 additions and 109 deletions.
  1. +14 −109 proof-of-concept
View
123 proof-of-concept
@@ -3,6 +3,8 @@ use v6;
use App::Pls;
use JSON::Tiny;
+use Module::Build;
+use Module::Test;
role FileBackend {
has $.filename;
@@ -139,125 +141,28 @@ sub find-files($in-dir, $pattern) {
class POC::Builder does App::Pls::Builder {
method build($project --> Result) {
my $target-dir = "cache/$project<name>";
- if $*VM<config><osname> ne 'MSWin32'
- && "$target-dir/Makefile".IO ~~ :e {
- # Already has Makefile and not running Windows -- use the Makefile
- unless run-logged( relative-to($target-dir, 'make'),
- :step('build'), :$project ) {
- return failure;
+ my $ret = success;
+ try {
+ Module::Build::build($target-dir);
+ CATCH {
+ $ret = failure;
}
}
- else {
- # No Makefile or on Windows -- roll our own `make` process
- my $binary = 'perl6';
-
- # Locate Perl 6 module files.
-
- my @module-files = find-files("$target-dir/lib", /\.pm6?$/);
- @module-files>>.=subst("$target-dir/", "");
-
- # To know the best order of compilation, we build a dependency
- # graph of all the modules in lib/. %usages_of ends up containing
- # a graph, with the keys (containing names modules) being nodes,
- # and the values (containing arrays of names) denoting directed
- # edges.
-
- my @modules = map { path-to-module-name($_) }, @module-files;
- my %usages_of;
- for @module-files -> $module-file {
- my $fh;
- my $succeeded = False;
- try {
- $fh = open($target-dir ~ '/' ~ $module-file, :r);
- $succeeded = True;
- }
- unless $succeeded {
- return failure;
- }
- my $module = path-to-module-name($module-file);
- %usages_of{$module} = [];
- for $fh.lines() {
- if /^\s* 'use' \s+ (\w+ ['::' \w+]*)/ && $0 -> $used {
- next if $used eq 'v6';
- next if $used eq 'MONKEY_TYPING';
-
- %usages_of{$module}.push(~$used);
- }
- }
- }
-
- sub path-to-module-name($path) {
- $path.subst(/^'lib/'/, '').subst(/\.pm6?$/, '')\
- .subst('/', '::', :g);
- }
-
- sub module-name-to-path($module-name, $base-path = '') {
- my $pm = 'lib/' ~ $module-name.subst('::', '/', :g) ~ '.pm';
- ($base-path ~ ($base-path ?? '/' !! '') ~ $pm).IO ~~ :e
- ?? $pm !! $pm ~ '6';
- }
-
- my @order;
-
- # According to "Introduction to Algorithms" by Cormen et al.,
- # topological sort is just a depth-first search of a graph where
- # you pay attention to the order in which you get done with the
- # dfs-visit() for each node.
-
- my %color_of = @modules X=> 'not yet visited';
- for @modules -> $module {
- if %color_of{$module} eq 'not yet visited' {
- dfs-visit($module);
- }
- }
-
- sub dfs-visit($module) {
- %color_of{$module} = 'visited';
- for %usages_of{$module}.list -> $used {
- if %color_of{$used} eq 'not yet visited' {
- dfs-visit($used);
- }
- }
- push @order, $module;
- }
-
- for @order>>.&module-name-to-path($target-dir) -> $module {
- my $command = "PERL6LIB=$target-dir/lib $binary "
- ~ "--target=PIR --output={
- $module.subst(/\.pm6?/, ".pir")} $module";
- unless run-logged( relative-to($target-dir, $command),
- :step('build'), :$project ) {
- return failure;
- }
- }
- }
-
- return success;
+ return $ret;
}
}
class POC::Tester does App::Pls::Tester {
method test($project --> Result) {
my $target-dir = "cache/$project<name>";
- if $*VM<config><osname> ne 'MSWin32'
- && "$target-dir/Makefile".IO ~~ :e {
- unless run-logged( relative-to($target-dir, "make test"),
- :step('test'), :$project ) {
- return failure;
- }
- }
- else {
- if "$target-dir/t".IO !~~ :e {
- return success;
- }
- my $command = "env PERL6LIB=`pwd`/lib prove -e 'perl6' -r t/";
- unless run-logged( relative-to($target-dir, $command),
- :step('build'), :$project ) {
- return failure;
+ my $ret = success;
+ try {
+ Module::Test::test($target-dir);
+ CATCH {
+ $ret = failure;
}
}
-
- return success;
+ return $ret;
}
}
Please sign in to comment.
Something went wrong with that request. Please try again.