cvsuser 05/03/14 13:51:44
Modified: languages/parrot_compiler .cvsignore
Added: languages/parrot_compiler parrot_compiler.imc
languages/parrot_compiler/lib/Parrot/Test ParrotCompiler.pm
languages/parrot_compiler/t harness
languages/parrot_compiler/t/basic .cvsignore hello.t
Log:
This is a elaboration on using the builtin compilers.
The idea is to take code from STDIN, compile it and run the code.
There is now a minimal test suite which should also work with
"make languages-test" from the Parrot root dir.
The new PIR script 'parrot_compiler.imc' takes the long parameter 'language'.
There is a plan to make the language implementations independent from
core Parrot. This is what the test Module Parrot::Test::ParrotCompiler.pm
is also on 'languages/parrot_compiler'.
Serializing Eval PMCs seems to be not implemented at the moment.
Revision Changes Path
1.2 +1 -0 parrot/languages/parrot_compiler/.cvsignore
Index: .cvsignore
===================================================================
RCS file: /cvs/public/parrot/languages/parrot_compiler/.cvsignore,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- .cvsignore 23 Jun 2004 13:05:17 -0000 1.1
+++ .cvsignore 14 Mar 2005 21:51:41 -0000 1.2
@@ -1 +1,2 @@
Makefile
+*.pbc
1.1 parrot/languages/parrot_compiler/parrot_compiler.imc
Index: parrot_compiler.imc
===================================================================
# Copyright: 2002-2005 The Perl Foundation. All Rights Reserved.
# $Id: parrot_compiler.imc,v 1.1 2005/03/14 21:51:41 bernhard Exp $
.include "library/Getopt/Long.imc"
.sub main @MAIN
.param pmc argv
# Assemble specification for get_options
# in an array of format specifiers
.local pmc opt_spec
opt_spec = new PerlArray
push opt_spec, "language=s"
# the program name is the first element in argv
.local string program_name
program_name = shift argv
# Make a copy of argv, because this can easier be handled in get_options()
# TODO: remove need for cloning
.local pmc argv_clone
argv_clone = clone argv
.local pmc opt
( opt ) = _get_options( argv_clone, opt_spec )
# Now we do what the passed options tell
.local int is_defined
# Was '--language' passed ?
is_defined = defined opt["language"]
if is_defined goto HAS_LANGUAGE_PARAM
print "Please pass --language=<language>\n"
end
HAS_LANGUAGE_PARAM:
.local string language
language = opt["language"]
# Get the input as a string, don't care about buffer overflow yet
read S0, 1000000
# Assume that the input is PASM and compile it
compreg P1, language
compile P0, P1, S0
# Dumping the Eval PMC as a string seems to be unimplemented,
# so simple invoke it
invoke P0
.end
1.1
parrot/languages/parrot_compiler/lib/Parrot/Test/ParrotCompiler.pm
Index: ParrotCompiler.pm
===================================================================
# Copyright: 2005 The Perl Foundation. All Rights Reserved.
# $Id: ParrotCompiler.pm,v 1.1 2005/03/14 21:51:42 bernhard Exp $
use strict;
use Data::Dumper;
use File::Basename;
package Parrot::Test::ParrotCompiler;
=head1 NAME
Parrot/Test/ParrotCompiler.pm - Testing routines specific to 'ParrotCompiler'.
=head1 DESCRIPTION
Calls 'parrot_compiler.pbc'.
=head1 METHODS
=head2 new
Yet another constructor.
=cut
sub new
{
return bless {};
}
=head2 gen_output
Called in output_is(),
which gets called when language_output_is() is called in a test file.
=cut
sub gen_output
{
my $self = shift;
my ( $code, $test_no ) = @_;
# flatten filenames (don't use directories)
my $code_f = Parrot::Test::per_test( '.code', $test_no );
my $out_f = Parrot::Test::per_test( '.out', $test_no );
my $test_prog_args = $ENV{TEST_PROG_ARGS} || '';
my $cmd = "(cd $self->{relpath} && $self->{parrot}
languages/parrot_compiler/parrot_compiler.pbc $test_prog_args <
languages/$code_f)";
my $parrotdir = File::Basename::dirname( $self->{parrot} );
Parrot::Test::generate_code( $code, $parrotdir, $test_no, $code_f );
# STDERR is written into same output file
my $diag = '';
my $parrot_exit_code = Parrot::Test::_run_command( $cmd, STDOUT => $out_f,
STDERR => $out_f );
$diag .= "'$cmd' failed with exit code $parrot_exit_code." if
$parrot_exit_code;
$self->{builder}->diag( $diag ) if $diag;
return Parrot::Test::slurp_file($out_f);
}
=head2 output_is
This gets called when language_output_is() is called in a test file.
=cut
sub output_is
{
my $self = shift;
my ( $code, $expected, $desc ) = @_;
my $test_no = $self->{builder}->current_test + 1;
my $output = $self->gen_output( $code, $test_no );
my $pass = $self->{builder}->is_eq( $output, $expected, $desc );
return $pass;
}
1;
1.1 parrot/languages/parrot_compiler/t/harness
Index: harness
===================================================================
# $Id: harness,v 1.1 2005/03/14 21:51:43 bernhard Exp $
=head1 NAME
languages/parrot_compiler/t/harness - A harness for ParrotCompiler
=head1 SYNOPSIS
cd languages && perl -I../lib parrot_compiler/t/harness -files
cd languages && perl -I../lib parrot_compiler/t/harness
cd languages && perl -I../lib parrot_compiler/t/harness \
parrot_compiler/t/hello.t
=head1 DESCRIPTION
Conformant to a recent post on p6i, if I'm called with a single
argument of "-files", I just return a list of files to process.
This list is one per line, and is relative to the languages dir.
If I'm called with no args, I run all tests.
Otherwise I try to run the list of passed tests.
=cut
# pragmata
use strict;
use Cwd();
use Data::Dumper;
use File::Spec;
use Test::Harness();
my $language = 'parrot_compiler';
if ( grep { m/^-files$/ } @ARGV )
{
# Only the Makefile in 'parrot/languages' uses -file
my $dir = File::Spec->catfile( $language, 't' );
my @files = glob( File::Spec->catfile( $dir, '*/*.t' ) );
print join( "\n", @files );
print "\n" if scalar(@files);
}
else
{
my @files;
if ( scalar(@ARGV) )
{
# Someone specified tests for me to run.
@files = grep { -f $_ } @ARGV
}
else
{
( undef, undef, my $current_dir ) = File::Spec->splitpath( Cwd::getcwd()
);
if ( $current_dir eq 'languages' )
{
@files = glob( File::Spec->catfile( $language, 't', '*', '*.t' ) );
}
elsif ( $current_dir eq $language )
{
@files = glob( File::Spec->catfile( 't', '*', '*.t' ) );
}
}
Test::Harness::runtests( @files ) if scalar( @files );
}
=head1 HISTORY
Mostly taken from tcl/t/harness.
=head1 SEE ALSO
L<languages/tcl/t/harness>, L<languages/python/t/harness>
=head1 AUTHOR
[EMAIL PROTECTED]
=cut
1.1 parrot/languages/parrot_compiler/t/basic/.cvsignore
Index: .cvsignore
===================================================================
*.code
*.out
1.1 parrot/languages/parrot_compiler/t/basic/hello.t
Index: hello.t
===================================================================
# Copyright: 2005 The Perl Foundation. All Rights Reserved.
# $Id: hello.t,v 1.1 2005/03/14 21:51:44 bernhard Exp $
use strict;
use lib 'parrot_compiler/lib';
use Parrot::Test tests => 3;
use Test::More;
$ENV{TEST_PROG_ARGS} = '--language=PASM';
language_output_is( 'ParrotCompiler', <<'CODE', <<'OUT', 'Hello World in
PASM' );
print "Hello Ponie\n"
end
CODE
Hello Ponie
OUT
$ENV{TEST_PROG_ARGS} = '--language=PIR';
language_output_is( 'ParrotCompiler', <<'CODE', <<'OUT', 'Hello World in PIR'
);
.sub test @MAIN
print "Hello Cardinal\n"
.end
CODE
Hello Cardinal
OUT
TODO: {
$TODO = "Works only called as '../../parrot parrot.imc'";
$ENV{TEST_PROG_ARGS} = '--language=PAST';
language_output_is( 'ParrotCompiler', <<'CODE', <<'OUT', 'Hello World in
PAST' );
Parrot_AST(
version(Const('0.1'))
_options(
) # _options
Src_File("test 3 of t/basic/hello.t")
Py_Module(
_()
Stmts(
Py_Print(
Const('Hello Pirate')
) # Py_Print
Py_Print_nl()
) # Stmts
) # Py_Module
# end
) # Parrot_AST
CODE
Hello Pirate
OUT
};
