mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-26 22:09:26 +01:00
compiler_vm: Hack to ensure gdb and prog streams are output in the correct order
This commit is contained in:
parent
d66d3d2a31
commit
aa00540c8d
@ -13,7 +13,7 @@ use warnings;
|
||||
# These are set automatically by the build/commit script
|
||||
use constant {
|
||||
BUILD_NAME => "PBot",
|
||||
BUILD_REVISION => 488,
|
||||
BUILD_REVISION => 489,
|
||||
BUILD_DATE => "2014-02-25",
|
||||
};
|
||||
|
||||
|
50
modules/compiler_vm/compiler_output_merger.pl
Executable file
50
modules/compiler_vm/compiler_output_merger.pl
Executable file
@ -0,0 +1,50 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use IPC::Open2;
|
||||
use Fcntl qw/:flock/;
|
||||
|
||||
my $outfile = '.output';
|
||||
|
||||
sub write_output {
|
||||
my ($msg) = @_;
|
||||
|
||||
print "output: writing [$msg]\n";
|
||||
|
||||
open my $fh, '>>', $outfile;
|
||||
flock $fh, LOCK_EX;
|
||||
print $fh "$msg\n";
|
||||
print "output: wrote [$msg]\n";
|
||||
close $fh;
|
||||
}
|
||||
|
||||
sub merge {
|
||||
my ($file) = @_;
|
||||
|
||||
# create empty file
|
||||
open my $fh, '>', $file;
|
||||
close $fh;
|
||||
|
||||
my ($out, $in);
|
||||
open2 $out, $in, "tail -f $file";
|
||||
print "merging $file to $outfile\n";
|
||||
while(my $line = <$out>) {
|
||||
chomp $line;
|
||||
print "$file: got [$line]\n";
|
||||
write_output $line;
|
||||
}
|
||||
}
|
||||
|
||||
my $pid = fork();
|
||||
die "fork failed: $!" if not defined $pid;
|
||||
|
||||
if($pid == 0) {
|
||||
merge '.gdb_output';
|
||||
exit;
|
||||
} else {
|
||||
merge '.prog_output';
|
||||
}
|
||||
|
||||
waitpid $pid, 0;
|
@ -19,15 +19,18 @@ my $local_vars = "";
|
||||
sub flushall;
|
||||
sub gdb;
|
||||
|
||||
use IO::Handle;
|
||||
|
||||
sub execute {
|
||||
my ($cmdline) = @_;
|
||||
my ($ret, $result);
|
||||
|
||||
open my $output_file, '>>', '.gdb_output' or die "Couldn't open .output: $!";
|
||||
$output_file->autoflush(1);
|
||||
|
||||
my ($out, $in);
|
||||
open2($out, $in, "$cmdline 2>&1");
|
||||
|
||||
open my $output_file, '>>', '.output' or die "Couldn't open .output: $!";
|
||||
|
||||
while(my $line = <$out>) {
|
||||
chomp $line;
|
||||
print "--- got: [$line]\n" if $debug >= 1;
|
||||
@ -84,7 +87,7 @@ sub execute {
|
||||
gdb $in, "break $break\n";
|
||||
gdb $in, "set width 0\n";
|
||||
gdb $in, "set height 0\n";
|
||||
gdb $in, "run < .input > .output\n";
|
||||
gdb $in, "run < .input >> .prog_output\n";
|
||||
next;
|
||||
}
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user