# New Ticket Created by Steve Fink
# Please include the string: [perl #17065]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=17065 >
Apply as much or as little of this patch as you want.
- Add a few more patterns to various .cvsignore files
- Add a -e (or --eval) flag to perl6.
- Reindent a bunch of code that had too few spaces
- Make sure P6C::IMCC::code() adds a newline after every line
(I was getting two consecutive lines of code smashed together)
- redirect stdout differently
The last is somewhat puzzling. perl6 was passing "> outfile" as an
array argument to system(), which on Unix at least won't work.
However, I remember that 'perl6 --test' used to work for me, so I
don't know when this changed. (If I locally revert this patch, it
still doesn't work, so I don't think it's something I did.)
The attached patch does the redirection somewhat differently, but it's
a bit of a kludge.
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/36825/29711/a71e32/patch
Index: .cvsignore
===================================================================
RCS file: /cvs/public/parrot/languages/perl6/.cvsignore,v
retrieving revision 1.3
diff -p -u -r1.3 .cvsignore
--- .cvsignore 27 Aug 2002 08:12:40 -0000 1.3
+++ .cvsignore 7 Sep 2002 00:06:11 -0000
@@ -1,3 +1,4 @@
Makefile
Perl6grammar.pm
perl6-config
+*.tmp
Index: t/compiler/.cvsignore
===================================================================
RCS file: /cvs/public/parrot/languages/perl6/t/compiler/.cvsignore,v
retrieving revision 1.1
diff -p -u -r1.1 .cvsignore
--- t/compiler/.cvsignore 29 Jul 2002 07:58:26 -0000 1.1
+++ t/compiler/.cvsignore 7 Sep 2002 00:06:13 -0000
@@ -4,3 +4,5 @@
*.pbc
*.out
*.err
+*.warn
+*.test
Index: t/rx/.cvsignore
===================================================================
RCS file: /cvs/public/parrot/languages/perl6/t/rx/.cvsignore,v
retrieving revision 1.1
diff -p -u -r1.1 .cvsignore
--- t/rx/.cvsignore 27 Aug 2002 08:13:43 -0000 1.1
+++ t/rx/.cvsignore 7 Sep 2002 00:06:13 -0000
@@ -4,3 +4,5 @@
*.pbc
*.out
*.err
+*.warn
+*.test
Index: P6C/IMCC.pm
===================================================================
RCS file: /cvs/public/parrot/languages/perl6/P6C/IMCC.pm,v
retrieving revision 1.19
diff -p -u -r1.19 IMCC.pm
--- P6C/IMCC.pm 5 Sep 2002 16:07:50 -0000 1.19
+++ P6C/IMCC.pm 7 Sep 2002 00:07:06 -0000
@@ -223,6 +223,7 @@ parameter-passing scheme, not just this
sub code { # add code to current function
die "Code must live within a function" unless defined $curfunc;
$funcs{$curfunc}->{code} .= join "\n", @_;
+ $funcs{$curfunc}->{code} .= "\n" if @_ > 0;
}
sub fixup_label {
Index: perl6
===================================================================
RCS file: /cvs/public/parrot/languages/perl6/perl6,v
retrieving revision 1.17
diff -p -u -r1.17 perl6
--- perl6 6 Sep 2002 23:34:24 -0000 1.17
+++ perl6 7 Sep 2002 00:25:11 -0000
@@ -116,7 +118,9 @@ Parser options:
--force-grammar
Rebuild grammar even if it exists.
Misc:
- --add-main suround code by the main() function
+ -e|--eval 'command'
+ evaluate perl6 command (implies --add-main)
+ --add-main surround code by the main() function
--rule NAME start with rule NAME (default = "prog")
(only useful in interactive mode)
END
@@ -154,7 +158,7 @@ Getopt::Long::Configure(qw(bundling));
GetOptions(\%OPT,qw{
test-parser test
trace hitem tree raw-tree
- add-main rule=s grammar=s force-grammar
+ eval|e=s add-main rule=s grammar=s force-grammar
debug yydebug life-info
debug-info|g
verbose|v+
@@ -188,6 +192,7 @@ $OPT{grammar} ||= 'Perl6grammar';
$OPT{'parrot-options'} ||= '';
$OPT{verbose} = 0 unless (defined $OPT{verbose});
$OPT{tree} = 1 if $OPT{'test-parser'};
+$OPT{'add-main'} = 1 if defined $OPT{'eval'};
my $filebase = 'a'; # basename for output files.
@@ -386,14 +391,19 @@ END
$parser;
}
-sub pass1($$$) {
- my ($parser, $f, $fw) = @_;
+sub pass1($$$;$) {
+ my ($parser, $f, $fw, $expr) = @_;
my $in = '';
local $/ = undef;
verbose(1, "P6C '$f'");
- open(IN, $f) or die("Can't read '$f': $!");
- $in = <IN>;
- close(IN);
+ if ($f eq '__eval__') {
+ $in = $expr;
+ }
+ else {
+ open(IN, $f) or die("Can't read '$f': $!");
+ $in = <IN>;
+ close(IN);
+ }
verbose(2, "Parsing");
P6C::IMCC::init() unless $OPT{tree};
my $result = warnings(sub {$parser->$::rule($in,0,$f)}, $fw);
@@ -423,40 +433,41 @@ sub run {
return;
}
$ARGV[0] = '-' unless(@ARGV);
+ unshift(@ARGV, "__eval__") if defined($OPT{'eval'});
while (@ARGV) {
- my $f = shift @ARGV;
- print STDERR "processing file '$f'\n" if($OPT{verbose}>1);
- if ($f eq '-') {
- $filebase = 'a';
- } else {
- ($filebase = $f) =~ s/\.[^.]*$//;
- }
+ my $f = shift @ARGV;
+ print STDERR "processing file '$f'\n" if($OPT{verbose}>1);
+ if ($f eq '-') {
+ $filebase = 'a';
+ } else {
+ ($filebase = $f) =~ s/\.[^.]*$//;
+ }
# special, clean all generated files
- if ($OPT{clean}) {
+ if ($OPT{clean}) {
clean_files($filebase) if ($f =~ /\.p6$/ || $f eq '-');
- next;
- }
+ next;
+ }
# normal processing, passes rest of ARGV to running prog
- # run next passes
- my $fw = "$filebase.warn";
- unlink($fw);
- if ($OPT{quick} && -e "$filebase.pbc" && pbc_is_newer($filebase)) {
- pass4("$filebase.pbc", $fw);
- }
- elsif ($f =~ /\.imc$/) {
- pass2($f, $fw);
- }
- elsif ($f =~ /\.pasm$/) {
- pass3($f, $fw);
- }
- elsif ($f =~ /\.(?:pb)?c$/) {
- pass4($f, $fw);
- }
- else {
- $parser = get_parser() unless ($parser);
- pass1($parser, $f, $fw);
- }
+ # run next passes
+ my $fw = "$filebase.warn";
+ unlink($fw);
+ if ($OPT{quick} && -e "$filebase.pbc" && pbc_is_newer($filebase)) {
+ pass4("$filebase.pbc", $fw);
+ }
+ elsif ($f =~ /\.imc$/) {
+ pass2($f, $fw);
+ }
+ elsif ($f =~ /\.pasm$/) {
+ pass3($f, $fw);
+ }
+ elsif ($f =~ /\.(?:pb)?c$/) {
+ pass4($f, $fw);
+ }
+ else {
+ $parser = get_parser() unless ($parser);
+ pass1($parser, $f, $fw, $OPT{'eval'});
+ }
return;
}
}
@@ -690,9 +701,18 @@ sub pass4($$) {
my @opt = map { "-$_" } split(//, $OPT{'parrot-options'});
my $cmd = "$PARROT @opt $file @ARGV";
verbose(1, "running: $cmd");
+
+ local *SAVEOUT;
+ open(SAVEOUT, ">&STDOUT");
+ if ($ARGV[0] =~ /> (.*)/) {
+ open(STDOUT, $ARGV[0]);
+ shift(@ARGV);
+ }
if (system($PARROT, @opt, $file, @ARGV) && !$OPT{'ignore-exitcode'}) {
+ open(STDOUT, ">&SAVEOUT");
mydie($?, $cmd);
}
+ open(STDOUT, ">&SAVEOUT");
}
}
