Author: bernhard
Date: Fri May 18 12:11:14 2007
New Revision: 18585
Modified:
trunk/compilers/imcc/main.c
trunk/t/run/README
trunk/t/run/options.t
Log:
#42336: segfault happens with 'parrot --pre-process-only'
Use IMCC_INFO(interp)->yyscanner in do_pre_process(), as
the input file has been set up there.
flush() the output, in order get some output before the segfault occurs.
Add sanity tests for '-E' and '--pre-process-only' in t/run/options.t.
Modified: trunk/compilers/imcc/main.c
==============================================================================
--- trunk/compilers/imcc/main.c (original)
+++ trunk/compilers/imcc/main.c Fri May 18 12:11:14 2007
@@ -381,9 +381,9 @@
{
int c;
YYSTYPE val;
- void *yyscanner;
+ yyscan_t yyscanner;
- do_yylex_init(interp, &yyscanner);
+ yyscanner = IMCC_INFO(interp)->yyscanner;
IMCC_push_parser_state(interp);
while ((c = yylex(&val, yyscanner, interp))) {
@@ -481,6 +481,8 @@
break;
}
}
+ printf("\n");
+ fflush(stdout);
yylex_destroy(&yyscanner);
}
Modified: trunk/t/run/README
==============================================================================
--- trunk/t/run/README (original)
+++ trunk/t/run/README Fri May 18 12:11:14 2007
@@ -1,4 +1,5 @@
# Copyright (C) 2005-2007, The Perl Foundation.
# $Id$
-This directory contains tests for the stuff documented in docs/running.pod.
+This directory contains tests for the options of the 'parrot' executable,
+as documented in docs/running.pod.
Modified: trunk/t/run/options.t
==============================================================================
--- trunk/t/run/options.t (original)
+++ trunk/t/run/options.t Fri May 18 12:11:14 2007
@@ -1,5 +1,5 @@
#!perl
-# Copyright (C) 2005-2006, The Perl Foundation.
+# Copyright (C) 2005-2007, The Perl Foundation.
# $Id$
=head1 NAME
@@ -20,7 +20,7 @@
use warnings;
use lib qw( lib . ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 10;
+use Parrot::Test tests => 12;
use Parrot::Config;
use File::Temp 0.13 qw/tempfile/;
use File::Spec;
@@ -47,6 +47,21 @@
# redirect STDERR to avoid warnings
my $redir = '2>' . File::Spec->devnull;
+# --pre-process-only
+# This is just sanity testing
+# Coredumps after the output has been written are ignored
+is( `"$PARROT" -E "$first" $redir`, <<'END_EXPECTED', 'option -E' );
+.sub main :main
+print "first\n"
+.end
+END_EXPECTED
+
+is( `"$PARROT" --pre-process-only "$first" $redir`, <<'END_EXPECTED', 'option
--pre-process-only' );
+.sub main :main
+print "first\n"
+.end
+END_EXPECTED
+
# Test the trace option
is( `"$PARROT" -t "$first" $redir`, "first\n", 'option -t' );
TODO:
@@ -57,16 +72,17 @@
is( `"$PARROT" -t "$first" "$second" $redir`, "second\n", 'option -t with
flags' );
is( `"$PARROT" --trace "$first" "$second" $redir`, "second\n", 'option --trace
with flags' );
+# clean up temporary files
unlink $first;
unlink $second;
-exit;
-
sub create_pir_file {
my $word = shift;
+
my ( $fh, $filename ) = tempfile( UNLINK => 0, SUFFIX => '.pir' );
print $fh qq{.sub main :main\n\tprint "$word\\n"\n.end};
close $fh;
+
return $filename;
}
