Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Initial IO::Path sanitation of CompUnit and friends
  • Loading branch information
lizmat committed Nov 30, 2014
1 parent c73c0b1 commit 54d2711
Show file tree
Hide file tree
Showing 3 changed files with 45 additions and 45 deletions.
52 changes: 26 additions & 26 deletions src/core/CompUnit.pm
@@ -1,21 +1,21 @@
class CompUnit {
has Lock $!lock;
has Str $.from;
has Str $.name;
has Str $.extension;
has Str $.precomp-ext;
has IO::Path $.path;
has Str $!WHICH;
has Bool $.has-source;
has Bool $.has-precomp;
has Bool $.is-loaded;
has Lock $!lock;
has Str $.from;
has Str $.name;
has Str $.extension;
has Str $.precomp-ext;
has Str $.abspath;
has Str $!WHICH;
has Bool $.has-source;
has Bool $.has-precomp;
has Bool $.is-loaded;

my Lock $global = Lock.new;
my $default-from = 'Perl6';
my %instances;

method new(CompUnit:U:
$path,
$abspath,
:$name is copy,
:$extension is copy,
:$from = $default-from,
Expand All @@ -26,18 +26,18 @@ class CompUnit {
# set name / extension if not already given
if !$name or !$extension.defined {
my IO::Spec $SPEC := $*SPEC;
$name ||= $SPEC.basename($path);
$extension ||= $SPEC.extension($name);
$name ||= MAKE-BASENAME($abspath);
$extension ||= MAKE-EXT($name);
}

# sanity test
my $precomp-ext = $*VM.precomp-ext;
$has-source //= ?$path.IO.f;
$has-precomp //= ?"$path.$precomp-ext".IO.f;
$has-source //= FILETEST-E($abspath);
$has-precomp //= FILETEST-E("$abspath.$precomp-ext");
return Nil unless $has-source or $has-precomp;

$global.protect( { %instances{$path} //= self.bless(
:path(IO::Path.new-from-absolute-path($path)),
$global.protect( { %instances{$abspath} //= self.bless(
:$abspath,
:lock(Lock.new),
:$name,
:$extension,
Expand All @@ -49,9 +49,9 @@ class CompUnit {
) } );
}

multi method WHICH(CompUnit:D:) { $!WHICH //= "{self.^name}|$!path.abspath()" }
multi method Str(CompUnit:D: --> Str) { $!path.abspath }
multi method gist(CompUnit:D: --> Str) { "{self.name}:{$!path.abspath}" }
multi method WHICH(CompUnit:D:) { $!WHICH //= "{self.^name}|$!abspath" }
multi method Str(CompUnit:D: --> Str) { $!abspath }
multi method gist(CompUnit:D: --> Str) { "$!name:$!abspath" }

method key(CompUnit:D: --> Str) {
$!has-precomp ?? $!precomp-ext !! $!extension;
Expand Down Expand Up @@ -103,19 +103,19 @@ class CompUnit {
} );
}

method precomp-path(CompUnit:D: --> Str) { "$!path.$!precomp-ext" }
method precomp-path(CompUnit:D: --> Str) { "$!abspath.$!precomp-ext" }

method precomp(CompUnit:D: $out = self.precomp-path, :$force --> Bool) {
die "Cannot pre-compile an already pre-compiled file: $!path"
die "Cannot pre-compile an already pre-compiled file: $!abspath"
if $.has-precomp;
die "Cannot pre-compile over an existing file: $out"
if !$force and $out.IO.e;
if !$force and FILETEST-E($out);
my Mu $opts := nqp::atkey(%*COMPILING, '%?OPTIONS');
my $lle = !nqp::isnull($opts) && !nqp::isnull(nqp::atkey($opts, 'll-exception'))
?? ' --ll-exception'
!! '';
my Bool $result = ?shell(
"$*EXECUTABLE$lle --target={$*VM.precomp-target} --output=$out $!path"
"$*EXECUTABLE$lle --target={$*VM.precomp-target} --output=$out $!abspath"
);

$!has-precomp = $result if $out eq self.precomp-path;
Expand All @@ -128,10 +128,10 @@ multi postcircumfix:<{ }> (CompUnit:D \c, "provides" ) {
my % = (
c.name => {
pm => {
file => c.path
file => c.abspath
},
c.key => {
file => c.has-precomp ?? c.precomp-path !! c.path
file => c.has-precomp ?? c.precomp-path !! c.abspath
}
}
);
Expand Down
21 changes: 11 additions & 10 deletions src/core/CompUnitRepo/Local/File.pm
Expand Up @@ -28,8 +28,7 @@ class CompUnitRepo::Local::File does CompUnitRepo::Locally {
# sorry, cannot handle this one
return () unless %extensions.exists_key($from);

my $dir-sep := $*SPEC.dir-sep;
my $base := $!IO.abspath ~ $dir-sep ~ $name.subst(:g, "::", $dir-sep) ~ '.';
my $base := $!IO.abspath ~ "/" ~ $name.subst(:g, "::", "/") ~ '.';
if %seen{$base} -> $found {
return $found;
}
Expand All @@ -39,21 +38,23 @@ class CompUnitRepo::Local::File does CompUnitRepo::Locally {
# have extensions to check
if %extensions{$from} -> @extensions {
for @extensions -> $extension {
my $path = $base ~ $extension;
my $abspath = $base ~ $extension;
return %seen{$base} = CompUnit.new(
$path, :$name, :$extension, :has-source
) if IO::Path.new-from-absolute-path($path).f;
$abspath, :$name, :$extension, :has-source
) if FILETEST-E($abspath) && FILETEST-F($abspath);

$abspath = $abspath ~ '.' ~ $precomp-ext;
return %seen{$base} = CompUnit.new(
$path, :$name, :$extension, :!has-source, :has-precomp
) if IO::Path.new-from-absolute-path($path ~ '.' ~ $precomp-ext).f;
$abspath, :$name, :$extension, :!has-source, :has-precomp
) if FILETEST-E($abspath) && FILETEST-F($abspath);
}
}

# no extensions to check, just check compiled version
elsif $base ~ $precomp-ext -> $path {
elsif $base ~ $precomp-ext -> $abspath {
return %seen{$base} = CompUnit.new(
$path, :$name, :extension(''), :!has-source, :has-precomp
) if IO::Path.new-from-absolute-path($path).f;
$abspath, :$name, :extension(''), :!has-source, :has-precomp
) if FILETEST-E($abspath) && FILETEST-F($abspath);
}

# alas
Expand Down
17 changes: 8 additions & 9 deletions src/core/CompUnitRepo/Locally.pm
@@ -1,17 +1,16 @@
role CompUnitRepo::Locally {
has Lock $!lock;
has IO::Path $.IO;
has Str $.WHICH;
has Lock $!lock;
has IO::Dir $.IO;
has Str $.WHICH;

my %instances;

method new(CompUnitRepo::Locally: $dir) {
my $abspath := $*SPEC.rel2abs($dir);
my $IO := IO::Path.new-from-absolute-path($abspath);
return Nil unless $IO.d and $IO.r;
my $IO := CHANGE-DIRECTORY($dir,$*CWD,&FILETEST-R);
return Nil unless $IO;

%instances{$abspath} //=
self.bless(:$IO,:lock(Lock.new),:WHICH(self.^name ~ '|' ~ $abspath));
%instances{$IO.abspath} //=
self.bless(:$IO,:lock(Lock.new),:WHICH(self.^name ~ '|' ~ $IO.abspath));
}

multi method Str(CompUnitRepo::Locally:D:) { $!IO.abspath }
Expand All @@ -23,7 +22,7 @@ role CompUnitRepo::Locally {
}

method path(CompUnitRepo::Locally:D:) {
DEPRECATED( 'IO', |<2014.11 2015.11> );
DEPRECATED('IO', |<2014.11 2015.11>);
$!IO;
}

Expand Down

0 comments on commit 54d2711

Please sign in to comment.