From 1ea70c1ec95840d1a21eef7375592e456220d70e Mon Sep 17 00:00:00 2001 From: sorear Date: Wed, 18 Aug 2010 21:49:09 +0000 Subject: [PATCH] [STDeco] Manage the syml-cache using File::Spec, don't try to build paths by hand git-svn-id: http://svn.pugscode.org/pugs@32052 c213334d-75ef-0310-aa23-eaa082d1ae64 --- src/perl6/CursorBase.pmc | 115 +++++++++++++++++++++++------------------------ src/perl6/Makefile | 12 ++--- src/perl6/README | 2 + src/perl6/std | 15 ++++--- src/perl6/viv | 15 ++++--- 5 files changed, 85 insertions(+), 74 deletions(-) diff --git a/src/perl6/CursorBase.pmc b/src/perl6/CursorBase.pmc index 88c7f97ef..920cdfe18 100644 --- a/src/perl6/CursorBase.pmc +++ b/src/perl6/CursorBase.pmc @@ -16,6 +16,8 @@ use Stash; use RE_ast; #use Carp::Always; use File::Spec; +use File::Path (); +use Config; my $TRIE = 1; my $STORABLE = 1; @@ -180,7 +182,7 @@ sub dump { ############################################################# sub sys_compile_module { - my ($self, $lib, $modfile) = @_; + my ($self, $module, $symlfile, $modfile) = @_; # should be per-module local $STD::ALL; @@ -202,11 +204,11 @@ sub sys_compile_module { local $::IN_REDUCE; local $::VAR; - $self->sys_do_compile_module("$lib/$modfile"); + $self->sys_do_compile_module($module, $symlfile, $modfile); } sub sys_do_compile_module { - my ($self, $file) = @_; + my ($self, $mod, $syml, $file) = @_; $self->parsefile($file, setting => $ENV{DEFAULT_SETTING_FOR_MODULES} // "CORE", @@ -221,56 +223,59 @@ sub sys_save_syml { my $file = $::FILE->{name}; $file = $::UNIT->{'$?LONGNAME'}; - $file =~ s/::/\//g; - $file .= $1 if $::FILE->{name} =~ /(\.pm6?)/; - $file .= '.syml'; - $file = $::TMP_PREFIX . "syml/" . $file; + my @toks = split '::', $file; + $toks[-1] .= '.syml'; + $file = File::Spec->catfile($::TMP_PREFIX, "syml", @toks); + pop @toks; + my $path = File::Spec->catdir($::TMP_PREFIX, "syml", @toks); - if ($file =~ /\//) { - my @parts = split('/',$file); - my $newfile = shift @parts; - while (@parts) { - mkdir $newfile unless -d $newfile; - $newfile .= '/' . shift @parts; - } - } - open(SETTING, ">$file") or die "Can't open new setting file $file: $!"; + File::Path::make_path($path); + + open(SETTING, ">", $file) or die "Can't open new setting file $file: $!"; print SETTING Dump($all); close SETTING; } +sub sys_get_perl6lib { + my $self = shift; + + if (not @::PERL6LIB) { + if ($CursorBase::SET_PERL6LIB) { + @::PERL6LIB = @$CursorBase::SET_PERL6LIB; + } elsif ($ENV{PERL6LIB}) { + @::PERL6LIB = split /\Q$Config::Config{path_sep}/, $ENV{PERL6LIB}; + } else { + @::PERL6LIB = qw< ./lib . >; + } + } + + @::PERL6LIB; +} + sub sys_find_module { my $self = shift; my $module = shift; my $issetting = shift; - if (not @::PERL6LIB) { - my $lib = $CursorBASE::SET_PERL6LIB || $ENV{PERL6LIB} || "./lib:."; - @::PERL6LIB = split ':', $lib; - } + my @toks = split '::', $module; + my $end = pop @toks; - my $modfile = $module; - $modfile =~ s/::/\//g; + for my $d ($self->sys_get_perl6lib) { + for my $ext (qw( .setting .pm6 .pm )) { + next if ($issetting xor ($ext eq '.setting')); - for my $d (@::PERL6LIB) { - if ($issetting) { - if (-f "$d/$modfile.setting") { - return ($d, $modfile . ".setting"); - } - next; - } - if (-f "$d/$modfile.pm6") { - return ($d, $modfile . ".pm6"); - } - elsif (-f "$d/$modfile.pm") { - { + my $file = File::Spec->catfile($d, @toks, "$end$ext"); + next unless -f $file; + + if ($ext eq '.pm') { local $/; - open PM, "$d/$modfile.pm" or next; - my $pm = ; - close PM; - next if $pm =~ /^\s*package\s+\w+\s*;/m; # ignore p5 code + open my $pm, "<", $file or next; + my $pmtx = <$pm>; + close $pm; + next if $pmtx =~ /^\s*package\s+\w+\s*;/m; # ignore p5 code } - return ($d, $modfile . ".pm"); + + return $file; } } @@ -282,17 +287,17 @@ sub sys_load_modinfo { my $self = shift; my $module = shift; - my ($lib, $modfile) = $self->sys_find_module($module, 0) - or return undef; + my @toks = split '::', $module; + $toks[-1] .= ".syml"; - my $syml = $::TMP_PREFIX . 'syml'; - mkdir $syml unless -d $syml; + my ($symlfile) = File::Spec->catfile($::TMP_PREFIX, 'syml', @toks); + my ($modfile) = $self->sys_find_module($module, 0) + or return undef; - unless (-f "$syml/$modfile.syml" and - -M "$lib/$modfile" > -M "$syml/$modfile.syml") { - $self->sys_compile_module($lib, $modfile); + unless (-f $symlfile and -M $modfile > -M $symlfile) { + $self->sys_compile_module($module, $symlfile, $modfile); } - return LoadFile("$syml/$modfile.syml"); + return LoadFile($symlfile); } sub load_lex { @@ -308,8 +313,7 @@ sub load_lex { } for my $prefix (@{$::SYML_SEARCH_PATH}) { - my $syml = $prefix . 'syml'; - my $file = "$syml/$setting.syml"; + my $file = File::Spec->catfile($prefix, 'syml', "$setting.syml"); if (-e $file) { return bless($self->_load_yaml_lex($setting,$file),'Stash'); } @@ -324,15 +328,8 @@ sub _load_yaml_lex { my $file = shift; state %LEXS; return $LEXS{$setting} if $LEXS{$setting}; - my $store = $file.".store"; - if (-f $store and -M $file and -M $file > -M $store) { - $LEXS{$setting} = retrieve($store); - } - else { - # HACK YAML::XS is horribly broken see https://rt.cpan.org/Public/Bug/Display.html?id=53278 - $LEXS{$setting} = {%{LoadFile($file)}}; - #store($LEXS{$setting}, $store); - } + # HACK YAML::XS is horribly broken see https://rt.cpan.org/Public/Bug/Display.html?id=53278 + $LEXS{$setting} = {%{LoadFile($file)}}; # say join ' ', sort keys %{ $LEXS{$setting} }; $LEXS{$setting}; } @@ -398,7 +395,7 @@ sub initparse { my $text = shift; my %args = @_; my $rule = $args{rule} // 'TOP'; - my $tmp_prefix = $args{tmp_prefix} // $CursorBase::SET_STD5PREFIX // $ENV{STD5PREFIX} // ''; + my $tmp_prefix = $args{tmp_prefix} // $CursorBase::SET_STD5PREFIX // $ENV{STD5PREFIX} // '.'; my $setting = $args{setting} // 'CORE'; my $actions = $args{actions} // ''; my $filename = $args{filename}; diff --git a/src/perl6/Makefile b/src/perl6/Makefile index bee9ec661..fd6221556 100644 --- a/src/perl6/Makefile +++ b/src/perl6/Makefile @@ -9,6 +9,8 @@ STD_SOURCE=STD.pm6 Cursor.pm6 CursorBase.pm6 lib/Stash.pm6 lib/NAME.pm6\ lib/DEBUG.pm6 CURSOR_SOURCE=Cursor.pm6 CursorBase.pm6 +STDINC=--clear-inc --inc lib --inc . + six: .stamp all: .stamp STD_P5.pmc @@ -24,21 +26,21 @@ stage2: stage2/.stamp # */.stamp indicates that the corresponding compiler is "usable" boot/.stamp: $(INVARIANT) $(addprefix boot/,$(GENERATE)) rm -rf boot/syml - ./std --boot --perl6lib lib:. CORE.setting + ./std --boot $(STDINC) CORE.setting touch boot/.stamp STD.pmc: $(STD_SOURCE) boot/.stamp $(INVARIANT) - ./viv --boot --perl6lib lib:. -5 -o STD.pm5 STD.pm6 + ./viv --boot $(STDINC) -5 -o STD.pm5 STD.pm6 perl -pe '(/^---/../^RETREE_END/) || s/^\s*//' < STD.pm5 > STD.pmc STD_P5.pmc: STD_P5.pm6 boot/.stamp $(INVARIANT) - ./viv --boot --perl6lib lib:. -5 -o STD_P5.pm5 STD_P5.pm6 + ./viv --boot $(STDINC) -5 -o STD_P5.pm5 STD_P5.pm6 perl -pe '(/^---/../^RETREE_END/) || s/^\s*//' < STD_P5.pm5 > STD_P5.pmc Cursor.pmc: $(CURSOR_SOURCE) boot/.stamp $(INVARIANT) - ./viv --boot --perl6lib lib:. -5 -o Cursor.pm5 Cursor.pm6 + ./viv --boot $(STDINC) -5 -o Cursor.pm5 Cursor.pm6 perl -pe '(/^---/../^RETREE_END/) || s/^\s*//' < Cursor.pm5 > Cursor.pmc .stamp: STD.pmc Cursor.pmc $(INVARIANT) rm -rf syml - ./std --perl6lib lib:. CORE.setting + ./std $(STDINC) CORE.setting touch .stamp reboot: .stamp diff --git a/src/perl6/README b/src/perl6/README index cda466d23..51c35649c 100644 --- a/src/perl6/README +++ b/src/perl6/README @@ -20,6 +20,8 @@ You'll need the following Perl bits to run stuff: * Moose (eg sudo apt-get install libmoose-perl) +* File::ShareDir + =head1 Running Stuff You can get started by using the Makefile command, C. This will convert diff --git a/src/perl6/std b/src/perl6/std index 1c0d8d251..9b376b72a 100755 --- a/src/perl6/std +++ b/src/perl6/std @@ -2,14 +2,19 @@ BEGIN { use FindBin; + use File::Spec; my @inc = ($FindBin::Bin); - if ($ARGV[0] eq '--boot') { + if (@ARGV >= 1 && $ARGV[0] eq '--boot') { shift @ARGV; - unshift @INC, $FindBin::Bin . "/boot"; - $CursorBase::SET_STD5PREFIX = "boot/"; + unshift @INC, File::Spec->catdir($FindBin::Bin, "boot"); + $CursorBase::SET_STD5PREFIX = "boot"; } - if (@ARGV >= 2 && $ARGV[0] eq '--perl6lib') { - $CursorBase::SET_PERL6LIB = $ARGV[1]; + if (@ARGV >= 1 && $ARGV[0] eq '--clear-inc') { + $CursorBase::SET_PERL6LIB = [ ]; + shift @ARGV; + } + while (@ARGV >= 2 && $ARGV[0] eq '--inc') { + push @$CursorBase::SET_PERL6LIB, $ARGV[1]; splice @ARGV, 0, 2; } } diff --git a/src/perl6/viv b/src/perl6/viv index a6fc49eec..b73f7a28c 100755 --- a/src/perl6/viv +++ b/src/perl6/viv @@ -37,14 +37,19 @@ are all almost certainly out. BEGIN { use FindBin; + use File::Spec; my @inc = ($FindBin::Bin); - if ($ARGV[0] eq '--boot') { + if (@ARGV >= 1 && $ARGV[0] eq '--boot') { shift @ARGV; - unshift @INC, $FindBin::Bin . "/boot"; - $CursorBase::SET_STD5PREFIX = "boot/"; + unshift @INC, File::Spec->catdir($FindBin::Bin, "boot"); + $CursorBase::SET_STD5PREFIX = "boot"; } - if (@ARGV >= 2 && $ARGV[0] eq '--perl6lib') { - $CursorBase::SET_PERL6LIB = $ARGV[1]; + if (@ARGV >= 1 && $ARGV[0] eq '--clear-inc') { + $CursorBase::SET_PERL6LIB = [ ]; + shift @ARGV; + } + while (@ARGV >= 2 && $ARGV[0] eq '--inc') { + push @$CursorBase::SET_PERL6LIB, $ARGV[1]; splice @ARGV, 0, 2; } } -- 2.11.4.GIT