Skip to content

Commit

Permalink
Merge branch 'io-adaptation' into nom
Browse files Browse the repository at this point in the history
  • Loading branch information
jnthn committed May 31, 2017
2 parents cb82760 + 837c737 commit 6a93540
Show file tree
Hide file tree
Showing 9 changed files with 40 additions and 45 deletions.
14 changes: 11 additions & 3 deletions src/Perl6/Actions.nqp
Expand Up @@ -827,7 +827,7 @@ class Perl6::Actions is HLL::Actions does STDActions {

# Emit any worries. Note that unwanting $mainline can produce worries.
if @*WORRIES {
nqp::printfh(nqp::getstderr(), $*W.group_exception().gist());
stderr().print($*W.group_exception().gist());
}

if %*COMPILING<%?OPTIONS><p> { # also covers the -np case, like Perl 5
Expand Down Expand Up @@ -1422,9 +1422,17 @@ class Perl6::Actions is HLL::Actions does STDActions {
$code := subst($code, /\s+$/, ''); # chomp!
$past := QAST::Stmts.new(:node($/),
QAST::Op.new(
:op<sayfh>,
:op<writefh>,
QAST::Op.new(:op<getstderr>),
QAST::SVal.new(:value("$id ($file line $line)\n$code"))
QAST::Op.new(
:op('encode'),
QAST::SVal.new(:value("$id ($file line $line)\n$code\n")),
QAST::SVal.new(:value('utf8')),
QAST::Op.new(
:op('callmethod'), :name('new'),
QAST::WVal.new( :value($*W.find_symbol(['Blob'])) )
)
)
),
$past
);
Expand Down
4 changes: 2 additions & 2 deletions src/Perl6/Compiler.nqp
Expand Up @@ -73,10 +73,10 @@ class Perl6::Compiler is HLL::Compiler {

my $repl-class := self.eval('REPL', :outer_ctx(nqp::null()), |%adverbs);
$p6repl := $repl-class.new(self, %adverbs);
my $stdin := nqp::getstdin();
my $stdin := stdin();
my $encoding := ~%adverbs<encoding>;
if $encoding && $encoding ne 'fixed_8' {
nqp::setencoding($stdin, $encoding);
$stdin.set-encoding($encoding);
}

$p6repl.repl-loop(:interactive(1), |%adverbs)
Expand Down
2 changes: 0 additions & 2 deletions src/Perl6/Grammar.nqp
Expand Up @@ -4577,7 +4577,6 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
$lang.clone_braid_from(self);
my $meth := $cat eq 'infix' || $cat eq 'prefix' || $cat eq 'postfix' ?? $cat ~ 'ish' !! $cat;
$meth := 'term:sym<reduce>' if $cat eq 'prefix' && $op ~~ /^ \[ .* \] $ /;
# nqp::printfh(nqp::getstderr(), "$meth $op\n");
my $cursor := $lang."$meth"();
my $match := $cursor.MATCH;
if $cursor.pos == nqp::chars($op) && (
Expand All @@ -4591,7 +4590,6 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
my $META := $match.ast;
$META := $META[0] unless $META.name;
$META.name('&METAOP_HYPER_POSTFIX') if $META.name eq '&METAOP_HYPER_POSTFIX_ARGS';
# nqp::printfh(nqp::getstderr(), $META.dump);
my $fun := $*W.compile_time_evaluate(self.MATCH,$META);
$*W.install_lexical_symbol($*W.cur_lexpad(),'&' ~ $categorical[0],$fun);
$fun.set_name($name);
Expand Down
8 changes: 4 additions & 4 deletions src/Perl6/ModuleLoader.nqp
@@ -1,9 +1,9 @@
my $DEBUG := +nqp::ifnull(nqp::atkey(nqp::getenvhash(), 'RAKUDO_MODULE_DEBUG'), 0);
sub DEBUG(*@strs) {
my $err := nqp::getstderr();
nqp::printfh($err, " " ~ nqp::getpid() ~ " RMD: ");
for @strs { nqp::printfh($err, $_) };
nqp::printfh($err, "\n");
my $err := stderr();
$err.print(" " ~ nqp::getpid() ~ " RMD: ");
for @strs { $err.print($_) };
$err.print("\n");
1;
}

Expand Down
6 changes: 3 additions & 3 deletions src/Perl6/Optimizer.nqp
Expand Up @@ -391,11 +391,11 @@ my class Problems {

# We didn't die from any Exception, so we print warnings now.
if +%!worrying {
my $err := nqp::getstderr();
nqp::sayfh($err, "WARNINGS for " ~ $*W.current_file ~ ":");
my $err := stderr();
$err.say("WARNINGS for " ~ $*W.current_file ~ ":");
my @fails;
for %!worrying {
nqp::printfh($err, $_.key ~ " (line" ~ (+$_.value == 1 ?? ' ' !! 's ') ~
$err.print($_.key ~ " (line" ~ (+$_.value == 1 ?? ' ' !! 's ') ~
join(', ', $_.value) ~ ")\n");
}
}
Expand Down
9 changes: 2 additions & 7 deletions src/core/CompUnit/Repository/FileSystem.pm
Expand Up @@ -76,13 +76,8 @@ class CompUnit::Repository::FileSystem does CompUnit::Repository::Locally does C
nqp::until(
nqp::eqaddr((my $pulled := $iter.pull-one),IterationEnd),
nqp::if(
nqp::filereadable($pulled)
&& (my $pio := nqp::open($pulled,'r')),
nqp::stmts(
nqp::setencoding($pio,'iso-8859-1'),
nqp::push_s($parts,nqp::sha1(nqp::readallfh($pio))),
nqp::closefh($pio)
)
nqp::filereadable($pulled),
nqp::push_s($parts,nqp::sha1(slurp($pulled, :enc<iso-8859-1>))),
)
),
nqp::if(
Expand Down
30 changes: 12 additions & 18 deletions src/core/Exception.pm
Expand Up @@ -338,25 +338,22 @@ do {

try {
my $v := $e.vault-backtrace;
my Mu $err := nqp::getstderr();
my Mu $err := $*ERR;

$e.backtrace; # This is where most backtraces actually happen
if $e.is-compile-time || $e.backtrace && $e.backtrace.is-runtime {
nqp::printfh($err, $e.gist);
nqp::printfh($err, "\n");
$err.say($e.gist);
if $v {
nqp::printfh($err, "Actually thrown at:\n");
nqp::printfh($err, $v.Str);
nqp::printfh($err, "\n");
$err.say("Actually thrown at:");
$err.say($v.Str);
}
}
elsif Rakudo::Internals.VERBATIM-EXCEPTION(0) {
nqp::printfh($err, $e.Str);
$err.print($e.Str);
}
else {
nqp::printfh($err, "===SORRY!===\n");
nqp::printfh($err, $e.Str);
nqp::printfh($err, "\n");
$err.say("===SORRY!===");
$err.say($e.Str);
}
Rakudo::Internals.THE_END();
CONTROL { when CX::Warn { .resume } }
Expand All @@ -375,11 +372,10 @@ do {
nqp::if(
nqp::iseq_i($type,nqp::const::CONTROL_WARN),
nqp::stmts(
(my Mu $err := nqp::getstderr),
(my Mu $err := $*ERR),
(my str $msg = nqp::getmessage($ex)),
nqp::printfh($err,nqp::if(nqp::chars($msg),$msg,"Warning")),
nqp::printfh($err, "\n"),
nqp::printfh($err, $backtrace.first-none-setting-line),
$err.say(nqp::if(nqp::chars($msg),$msg,"Warning")),
$err.print($backtrace.first-none-setting-line),
nqp::resume($ex)
)
)
Expand Down Expand Up @@ -2783,8 +2779,7 @@ my class X::CompUnit::UnsatisfiedDependency is Exception {

my class Exceptions::JSON {
method process($ex) {
nqp::printfh(
nqp::getstderr,
$*ERR.print:
Rakudo::Internals::JSON.to-json( $ex.^name => Hash.new(
(message => $ex.?message),
$ex.^attributes.grep(*.has_accessor).map: {
Expand All @@ -2795,8 +2790,7 @@ my class Exceptions::JSON {
) given $ex."$attr"()
}
}
))
);
));
False # done processing
}
}
Expand Down
2 changes: 1 addition & 1 deletion src/core/Proc.pm
Expand Up @@ -157,7 +157,7 @@ sub QX($cmd, :$cwd = $*CWD, :$env) {
);
my $result;
try {
$result = nqp::p6box_s(nqp::readallfh($pio));
$result = IO::Pipe.new(:PIO($pio)).slurp;
$status := nqp::closefh_i($pio);
}
$result.DEFINITE
Expand Down
10 changes: 5 additions & 5 deletions tools/build/gen-cat.nqp
Expand Up @@ -9,8 +9,8 @@ sub MAIN(*@ARGS) {
if @ARGS[0] eq '-f' && nqp::elems(@ARGS) >= 2 {
nqp::shift(@ARGS);
my $file := nqp::shift(@ARGS);
my $fh := open($file, :r);
while nqp::readlinefh($fh) -> $line {
my $fh := open($file, :r, :!chomp);
while $fh.get -> $line {
if $line ~~ /\S/ {
$line := subst($line, /\s+/, '', :global);
nqp::push(@ARGS, $line);
Expand All @@ -21,19 +21,19 @@ sub MAIN(*@ARGS) {
my $stderr := nqp::getstderr();
for @ARGS -> $file {
say("#line 1 SETTING::$file");
my $fh := open($file, :r);
my $fh := open($file, :r, :!chomp);
my int $in_cond := 0;
my int $in_omit := 0;
my int $line := 1;
while nqp::readlinefh($fh) -> $_ {
while $fh.get -> $_ {
if my $x := $_ ~~ / ^ '#?if' \s+ ('!')? \s* (\w+) \s* $ / {
nqp::die("Nested conditionals not supported") if $in_cond;
$in_cond := 1;
$in_omit := $x[0] && $x[1] eq $backend || !$x[0] && $x[1] ne $backend;
print("\n");
} elsif $_ ~~ /^ '#?endif' / {
unless $in_cond {
nqp::sayfh($stderr,
stderr().say(
"#?endif without matching #?if in file $file, line $line"
);
}
Expand Down

0 comments on commit 6a93540

Please sign in to comment.