mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-30 07:59:42 +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
|
# These are set automatically by the build/commit script
|
||||||
use constant {
|
use constant {
|
||||||
BUILD_NAME => "PBot",
|
BUILD_NAME => "PBot",
|
||||||
BUILD_REVISION => 488,
|
BUILD_REVISION => 489,
|
||||||
BUILD_DATE => "2014-02-25",
|
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 flushall;
|
||||||
sub gdb;
|
sub gdb;
|
||||||
|
|
||||||
|
use IO::Handle;
|
||||||
|
|
||||||
sub execute {
|
sub execute {
|
||||||
my ($cmdline) = @_;
|
my ($cmdline) = @_;
|
||||||
my ($ret, $result);
|
my ($ret, $result);
|
||||||
|
|
||||||
|
open my $output_file, '>>', '.gdb_output' or die "Couldn't open .output: $!";
|
||||||
|
$output_file->autoflush(1);
|
||||||
|
|
||||||
my ($out, $in);
|
my ($out, $in);
|
||||||
open2($out, $in, "$cmdline 2>&1");
|
open2($out, $in, "$cmdline 2>&1");
|
||||||
|
|
||||||
open my $output_file, '>>', '.output' or die "Couldn't open .output: $!";
|
|
||||||
|
|
||||||
while(my $line = <$out>) {
|
while(my $line = <$out>) {
|
||||||
chomp $line;
|
chomp $line;
|
||||||
print "--- got: [$line]\n" if $debug >= 1;
|
print "--- got: [$line]\n" if $debug >= 1;
|
||||||
@ -84,7 +87,7 @@ sub execute {
|
|||||||
gdb $in, "break $break\n";
|
gdb $in, "break $break\n";
|
||||||
gdb $in, "set width 0\n";
|
gdb $in, "set width 0\n";
|
||||||
gdb $in, "set height 0\n";
|
gdb $in, "set height 0\n";
|
||||||
gdb $in, "run < .input > .output\n";
|
gdb $in, "run < .input >> .prog_output\n";
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user