Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 959 lines (760 sloc) 24.8 KB
#! perl
# Copyright (C) 2007-2010, Parrot Foundation.
=head1 NAME
create_language.pl -- create initial files for a new language
=head1 SYNOPSIS
% perl tools/dev/create_language.pl Xyz [path]
=head1 DESCRIPTION
This script populates a directory with files for building a
new language translator in Parrot. The first argument is the
name of the language to be built. The C<path> argument
says where to populate the directory, if not given then the
lowercase version of the language name is used.
For a language 'Xyz', this script will create the following
files and directories in C<path>:
README
Configure.pl
build/Makefile.in
build/gen_parrot.pl
src/Xyz.pir
src/Xyz/Grammar.pm
src/Xyz/Actions.pm
src/Xyz/Compiler.pm
src/Xyz/Runtime.pm
src/gen/.gitignore
t/harness
t/00-sanity.t
Any files that already exist are skipped, so this script can
be used to repopulate a language directory with omitted files.
If all goes well, after creating the language shell one can simply
change to the language directory and type
$ perl Configure.pl [--gen-parrot]
$ make
$ make test
to verify that the new language compiles and configures properly.
=cut
use strict;
use warnings;
use lib 'lib';
use File::Path;
use File::Spec;
unless (@ARGV) {
die "usage: $0 language [path]\n";
}
if ($ARGV[0] eq '--help') {
print <<HELP;
usage: $0 language [PATH]
Use perldoc $0 to read the documentation.
HELP
exit 0;
}
## determine the language we're trying to build
my $lang = $ARGV[0];
my $lclang = lc $lang;
my $uclang = uc $lang;
## the name of the script, for use in the generated README and "reverse"
my $script = $0;
## get the path from the command line, or if not supplied then
## use languages/$lclang.
my $path = $ARGV[1] || $lclang;
my $option = $ARGV[2] || '';
if ($option eq 'reverse') {
## instead of using this script to generate the files into $path,
## use the files in $path to generate a new version of this script.
open my $fh0, '<', $script or die "Unable to read $script";
while (<$fh0>) {
print $_;
last if /^__DATA__/;
}
while (<$fh0>) {
last if /^__DATA__$/;
if (/^__(.*?)__$/) {
print;
$_ = $1;
s{\@lang\@} {$lang}g;
s{\@lclang\@} {$lclang}ig;
s{\@UCLANG\@} {$uclang}ig;
open my $fh, '<', "$path/$_" or die "Unable to read $path/$_";
while (<$fh>) {
s{$lang} {\@lang\@}g;
s{$lclang} {\@lclang\@}g;
s{$uclang} {\@UCLANG\@}g;
s{$script} {\@script\@}g;
print;
}
close $fh;
}
}
print;
while (<$fh0>) { print; }
close $fh0;
exit 0;
}
## now loop through the file information (see below), substituting
## any instances of @lang@, @lclang@, @UCLANG@, and @Id@ with
## the language name or the svn id tag. If the line has the form
## __filepath__, then start a new file.
my $fh;
while (<DATA>) {
last if /^__DATA__$/;
s{\@lang\@} {$lang}g;
s{\@lclang\@} {$lclang}ig;
s{\@UCLANG\@} {$uclang}ig;
s{\@script\@} {$script}ig;
if (/^__(.*)__$/) { start_new_file("$path/$1"); }
elsif ($fh) { print $fh $_; }
}
## generate build/PARROT_REVISION
start_new_file("$path/build/PARROT_REVISION");
my $rev = '$Revision$';
$rev =~ s/^\D*(\d+)\D*$/$1/;
print $fh "$rev\n";
close($fh) if $fh;
print <<"END";
Your new language has been created in the $path directory.
To do an initial build and test of the language:
cd $path
perl Configure.pl [--gen-parrot]
make
make test
END
## we're done
1;
## this function closes any previous opened file, and determines
## if we're creating a new file. It also calls C<mkpath> to
## create any needed parent subdirectories.
sub start_new_file {
my ($filepath) = @_;
if ($fh) { close $fh; undef $fh; }
if (-e $filepath) { print "skipping $filepath\n"; return; }
my ($volume, $dir, $base) = File::Spec->splitpath($filepath);
my $filedir = File::Spec->catpath($volume, $dir);
unless (-d $filedir) {
print "creating $filedir\n";
mkpath( [ $filedir ], 0, 0777 );
}
print "creating $filepath\n";
open $fh, '>', $filepath;
}
### The section below contains the text of the files to be created.
### The name of the file to be created is given as C<__filepath__>,
### and all subsequent lines up to the next C<__filepath__> are
### placed in the file (performing substitutions on @lang@, @lclang@,
### @UCLANG@, and @Id@ as appropriate).
__DATA__
__README__
=head1 @lang@
This is @lang@, a compiler for the Parrot virtual machine.
=head2 Build requirements (installing from source)
For building @lang@ you need at least a C compiler, a C<make> utility,
and Perl 5.8 or newer. To automatically obtain and build Parrot
you also need a git client.
=head2 Building and invoking @lang@
We generally recommend downloading @lang@ directly from
[XXX: fill in this information for @lang@].
Once you have a copy of @lang@, build it as follows:
$ cd @lclang@
$ perl Configure.pl --gen-parrot
$ make
This will create a "@lclang@" or "@lclang@.exe" executable in the
current directory. Programs can then be run from the build
directory using a command like:
$ ./@lclang@ <source>
The C<--gen-parrot> option above tells Configure.pl to automatically
download and build the most appropriate version of Parrot into
a local "parrot/" subdirectory, install that Parrot into
the "parrot_install/" subdirectory, and use that for building
@lang@. It's okay to use the C<--gen-parrot> option on later
invocations of Configure.pl; the configure system will re-build
Parrot only if a newer version is needed for whatever version
of @lang@ you're working with.
You can use C<--parrot-config=/path/to/parrot_config> instead
of C<--gen-parrot> to use an already installed Parrot for building
@lang@. This installed Parrot must include its development
environment; typically this is done via Parrot's C<make install>
target or by installing prebuilt C<parrot-devel> and/or C<libparrot-dev>
packages. The version of the already installed Parrot must satisfy a
minimum specified by @lang@ -- Configure.pl will verify this for you.
Once built, @lang@'s C<make install> target will install @lang@
and its libraries into the Parrot installation that was used to
create it. Until this step is performed, the "@lclang@" executable
created by C<make> above can only be reliably run from the root of
@lang@'s build directory. After C<make install> is performed,
the installed executable can be run from any directory (as long as
the Parrot installation that was used to create it remains intact).
If the @lang@ compiler is invoked without an explicit script to
run, it enters a small interactive mode that allows statements
to be executed from the command line. Each line entered is treated
as a separate compilation unit, however (which means that subroutines
are preserved after they are defined, but variables are not).
=head2 Running the test suite
Entering C<make test> will run a test suite that comes bundled
with @lang@. This is a simple suite of tests, designed to make sure
that the compiler is basically working and that it's capable of
running a simple test harness.
If you want to run the tests in parallel, you need to install a
fairly recent version of the Perl 5 module L<Test::Harness> (3.16
works for sure).
=head2 Where to get help or answers to questions
=head2 Reporting bugs
=head2 Submitting patches
=head2 How the compiler works
See F<docs/compiler_overview.pod>.
=head1 AUTHOR
=cut
## vim: expandtab sw=4 ft=pod tw=70:
__Configure.pl__
#! perl
# Copyright (C) 2009 The Perl Foundation
use 5.008;
use strict;
use warnings;
use Getopt::Long;
use Cwd;
MAIN: {
my %options;
GetOptions(\%options, 'help!', 'parrot-config=s',
'gen-parrot!', 'gen-parrot-prefix=s', 'gen-parrot-option=s@');
# Print help if it's requested
if ($options{'help'}) {
print_help();
exit(0);
}
# Determine the revision of Parrot we require
open my $REQ, "build/PARROT_REVISION"
|| die "cannot open build/PARROT_REVISION\n";
my ($reqsvn, $reqpar) = split(' ', <$REQ>);
$reqsvn += 0;
close $REQ;
# Update/generate parrot build if needed
if ($options{'gen-parrot'}) {
my @opts = @{ $options{'gen-parrot-option'} || [] };
my $prefix = $options{'gen-parrot-prefix'} || cwd()."/parrot_install";
# parrot's Configure.pl mishandles win32 backslashes in --prefix
$prefix =~ s{\\}{/}g;
my @command = ($^X, "build/gen_parrot.pl", "--prefix=$prefix", ($^O !~ /win32/i ? "--optimize" : ()), @opts);
print "Generating Parrot ...\n";
print "@command\n\n";
system @command;
}
# Get a list of parrot-configs to invoke.
my @parrot_config_exe = qw(
parrot_install/bin/parrot_config
../../parrot_config
parrot_config
);
if (exists $options{'gen-parrot-prefix'}) {
unshift @parrot_config_exe,
$options{'gen-parrot-prefix'} . '/bin/parrot_config';
}
if ($options{'parrot-config'} && $options{'parrot-config'} ne '1') {
@parrot_config_exe = ($options{'parrot-config'});
}
# Get configuration information from parrot_config
my %config = read_parrot_config(@parrot_config_exe);
my $parrot_errors = '';
if (!%config) {
$parrot_errors .= "Unable to locate parrot_config\n";
}
elsif ($reqsvn > $config{'revision'} &&
($reqpar eq '' || version_int($reqpar) > version_int($config{'VERSION'}))) {
$parrot_errors .= "Parrot revision r$reqsvn required (currently r$config{'revision'})\n";
}
if ($parrot_errors) {
die <<"END";
===SORRY!===
$parrot_errors
To automatically checkout (svn) and build a copy of parrot r$reqsvn,
try re-running Configure.pl with the '--gen-parrot' option.
Or, use the '--parrot-config' option to explicitly specify
the location of parrot_config to be used to build @lang@.
END
}
# Verify the Parrot installation is sufficient for building @lang@
verify_parrot(%config);
# Create the Makefile using the information we just got
create_makefile(%config);
my $make = $config{'make'};
{
no warnings;
print "Cleaning up ...\n";
if (open my $CLEAN, '-|', "$make clean") {
my @slurp = <$CLEAN>;
close $CLEAN;
}
}
print <<"END";
You can now use '$make' to build @lang@.
After that, you can use '$make test' to run some local tests.
END
exit 0;
}
sub read_parrot_config {
my @parrot_config_exe = @_;
my %config = ();
for my $exe (@parrot_config_exe) {
no warnings;
if (open my $PARROT_CONFIG, '-|', "$exe --dump") {
print "\nReading configuration information from $exe ...\n";
while (<$PARROT_CONFIG>) {
if (/(\w+) => '(.*)'/) { $config{$1} = $2 }
}
close $PARROT_CONFIG or die $!;
last if %config;
}
}
return %config;
}
sub verify_parrot {
print "Verifying Parrot installation...\n";
my %config = @_;
my $PARROT_VERSION = $config{'versiondir'};
my $PARROT_BIN_DIR = $config{'bindir'};
my $PARROT_LIB_DIR = $config{'libdir'}.$PARROT_VERSION;
my $PARROT_SRC_DIR = $config{'srcdir'}.$PARROT_VERSION;
my $PARROT_INCLUDE_DIR = $config{'includedir'}.$PARROT_VERSION;
my $PARROT_TOOLS_DIR = "$PARROT_LIB_DIR/tools";
my @required_files = (
"$PARROT_BIN_DIR/parrot-nqp"
);
my @missing;
for my $reqfile (@required_files) {
push @missing, " $reqfile" unless -e $reqfile;
}
if (@missing) {
my $missing = join("\n", @missing);
die <<"END";
===SORRY!===
I'm missing some needed files from the Parrot installation:
$missing
(Perhaps you need to use Parrot's "make install" or
install the "parrot-devel" package for your system?)
END
}
}
# Generate a Makefile from a configuration
sub create_makefile {
my %config = @_;
my $maketext = slurp( 'build/Makefile.in' );
$config{'win32_libparrot_copy'} = $^O eq 'MSWin32' ? 'copy $(PARROT_BIN_DIR)\libparrot.dll .' : '';
$maketext =~ s/@(\w+)@/$config{$1}/g;
if ($^O eq 'MSWin32') {
$maketext =~ s{/}{\\}g;
$maketext =~ s{\\\*}{\\\\*}g;
$maketext =~ s{http:\S+}{ do {my $t = $&; $t =~ s'\\'/'g; $t} }eg;
}
my $outfile = 'Makefile';
print "\nCreating $outfile ...\n";
open(my $MAKEOUT, '>', $outfile) ||
die "Unable to write $outfile\n";
print {$MAKEOUT} $maketext;
close $MAKEOUT or die $!;
return;
}
sub slurp {
my $filename = shift;
open my $fh, '<', $filename or die "Unable to read $filename\n";
local $/ = undef;
my $maketext = <$fh>;
close $fh or die $!;
return $maketext;
}
sub version_int {
sprintf('%d%03d%03d', split(/\./, $_[0]))
}
# Print some help text.
sub print_help {
print <<'END';
Configure.pl - @lang@ Configure
General Options:
--help Show this text
--gen-parrot Download and build a copy of Parrot to use
--gen-parrot-option='--option=value'
Set parrot config option when using --gen-parrot
--parrot-config=(config)
Use configuration information from config
END
return;
}
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
__build/Makefile.in__
# Copyright (C) 2006-2009, The Perl Foundation.
PARROT_ARGS =
# values from parrot_config
PARROT_BIN_DIR = @bindir@
PARROT_VERSION = @versiondir@
PARROT_INCLUDE_DIR = @includedir@$(PARROT_VERSION)
PARROT_LIB_DIR = @libdir@$(PARROT_VERSION)
PARROT_SRC_DIR = @srcdir@$(PARROT_VERSION)
PARROT_LIBRARY_DIR = $(PARROT_LIB_DIR)/library
HAS_ICU = @has_icu@
CC = @cc@
CFLAGS = @ccflags@ @cc_shared@ @cc_debug@ @ccwarn@ @cg_flag@
EXE = @exe@
LD = @ld@
LDFLAGS = @ldflags@ @ld_debug@
LD_LOAD_FLAGS = @ld_load_flags@
LIBPARROT = @inst_libparrot_ldflags@
O = @o@
LOAD_EXT = @load_ext@
PERL = @perl@
CP = @cp@
MV = @mv@
RM_F = @rm_f@
MKPATH = $(PERL) -MExtUtils::Command -e mkpath
CHMOD = $(PERL) -MExtUtils::Command -e chmod
# locations of parrot resources
PARROT = $(PARROT_BIN_DIR)/parrot$(EXE)
PARROT_NQP = $(PARROT_BIN_DIR)/parrot-nqp$(EXE)
PBC_TO_EXE = $(PARROT_BIN_DIR)/pbc_to_exe$(EXE)
PARROT_TOOLS_DIR = $(PARROT_LIB_DIR)/tools
PARROT_PERL_LIB = $(PARROT_TOOLS_DIR)/lib
@UCLANG@_LANG_DIR = $(PARROT_LIB_DIR)/languages/@lclang@
@UCLANG@_EXE = @lclang@$(EXE)
@UCLANG@_PBC = @lclang@.pbc
@UCLANG@_G_PIR = src/gen/@lclang@-grammar.pir
@UCLANG@_A_PIR = src/gen/@lclang@-actions.pir
@UCLANG@_C_PIR = src/gen/@lclang@-compiler.pir
@UCLANG@_R_PIR = src/gen/@lclang@-runtime.pir
@UCLANG@_SOURCES = \
src/@lang@.pir \
$(@UCLANG@_G_PIR) \
$(@UCLANG@_A_PIR) \
$(@UCLANG@_C_PIR) \
$(@UCLANG@_R_PIR) \
CLEANUPS = \
*.manifest \
*.pdb \
*.c\
*.o\
$(@UCLANG@_EXE) \
$(@UCLANG@_PBC) \
src/gen/*.pir \
default: $(@UCLANG@_EXE)
all: $(@UCLANG@_EXE)
$(@UCLANG@_EXE) : $(@UCLANG@_SOURCES)
$(PARROT) -o $(@UCLANG@_PBC) src/@lang@.pir
$(PBC_TO_EXE) $(@UCLANG@_PBC)
$(@UCLANG@_G_PIR): src/@lang@/Grammar.pm
$(PARROT_NQP) --target=pir -o $(@UCLANG@_G_PIR) src/@lang@/Grammar.pm
$(@UCLANG@_A_PIR): src/@lang@/Actions.pm
$(PARROT_NQP) --target=pir -o $(@UCLANG@_A_PIR) src/@lang@/Actions.pm
$(@UCLANG@_C_PIR): src/@lang@/Compiler.pm
$(PARROT_NQP) --target=pir -o $(@UCLANG@_C_PIR) src/@lang@/Compiler.pm
$(@UCLANG@_R_PIR): src/@lang@/Runtime.pm
$(PARROT_NQP) --target=pir -o $(@UCLANG@_R_PIR) src/@lang@/Runtime.pm
## testing
test: $(@UCLANG@_EXE)
$(PERL) t/harness t
## installation
install: all
$(MKPATH) $(DESTDIR)$(@UCLANG@_LANG_DIR)
$(CP) $(@UCLANG@_PBC) $(DESTDIR)$(@UCLANG@_LANG_DIR)
$(CP) $(@UCLANG@_EXE) $(DESTDIR)$(PARROT_BIN_DIR)
$(CHMOD) 755 $(DESTDIR)$(PARROT_BIN_DIR)/$(@UCLANG@_EXE)
## cleaning
clean:
$(RM_F) $(CLEANUPS)
distclean: realclean
realclean: clean
$(RM_F) Makefile
testclean:
## miscellaneous targets
# a listing of all targets meant to be called by users
help:
@echo ""
@echo "Following targets are available for the user:"
@echo ""
@echo " all: $(@UCLANG@_EXE)"
@echo " This is the default."
@echo " $(@UCLANG@_EXE): The @lang@ compiler."
@echo " install: Install compiler into Parrot."
@echo ""
@echo "Testing:"
@echo " test: Run tests."
@echo ""
@echo "Cleaning:"
@echo " clean: Basic cleaning up."
@echo " distclean: Removes also anything built, in theory."
@echo " realclean: Removes also files generated by 'Configure.pl'."
@echo " testclean: Clean up test results."
@echo ""
@echo "Misc:"
@echo " help: Print this help message."
@echo ""
__build/gen_parrot.pl__
#! perl
# Copyright (C) 2009 The Perl Foundation
=head1 TITLE
gen_parrot.pl - script to obtain and build Parrot for Rakudo
=head2 SYNOPSIS
perl gen_parrot.pl [--parrot --configure=options]
=head2 DESCRIPTION
Maintains an appropriate copy of Parrot in the parrot/ subdirectory.
The revision of Parrot to be used in the build is given by the
build/PARROT_REVISION file.
=cut
use strict;
use warnings;
use 5.008;
# Work out slash character to use.
my $slash = $^O eq 'MSWin32' ? '\\' : '/';
## determine what revision of Parrot we require
open my $REQ, "build/PARROT_REVISION"
|| die "cannot open build/PARROT_REVISION\n";
my ($reqsvn, $reqpar) = split(' ', <$REQ>);
$reqsvn += 0;
close $REQ;
{
no warnings;
if (open my $REV, '-|', "parrot_install${slash}bin${slash}parrot_config revision") {
my $revision = 0+<$REV>;
close $REV;
if ($revision >= $reqsvn) {
print "Parrot r$revision already available (r$reqsvn required)\n";
exit(0);
}
}
}
print "Cloning the Parrot git repo...\n";
system(qw(git clone), qw(http://github.com/parrot/parrot.git));
chdir('parrot') or die "Can't chdir to parrot: $!";
system("git checkout $reqsvn");
# TODO: error checking
## If we have a Makefile from a previous build, do a 'make realclean'
if (-f 'Makefile') {
my %config = read_parrot_config();
my $make = $config{'make'};
if ($make) {
print "\nPerforming '$make realclean' ...\n";
system($make, "realclean");
}
}
print "\nConfiguring Parrot ...\n";
my @config_command = ($^X, 'Configure.pl', @ARGV);
print "@config_command\n";
system @config_command;
print "\nBuilding Parrot ...\n";
my %config = read_parrot_config();
my $make = $config{'make'} or exit(1);
my @make_opts;
if ($ENV{GNU_MAKE_JOBS}) {
push @make_opts, '-j', $ENV{GNU_MAKE_JOBS}
}
system($make, 'install-dev', @make_opts);
sub read_parrot_config {
my %config = ();
if (open my $CFG, "config_lib.pasm") {
while (<$CFG>) {
if (/P0\["(.*?)"], "(.*?)"/) { $config{$1} = $2 }
}
close $CFG;
}
%config;
}
__src/@lang@.pir__
.HLL '@lclang@'
.namespace []
.sub '' :anon :load :init
load_bytecode 'HLL.pbc'
.local pmc hllns, parrotns, imports
hllns = get_hll_namespace
parrotns = get_root_namespace ['parrot']
imports = split ' ', 'PAST PCT HLL Regex Hash'
parrotns.'export_to'(hllns, imports)
.end
.include 'src/gen/@lclang@-grammar.pir'
.include 'src/gen/@lclang@-actions.pir'
.include 'src/gen/@lclang@-compiler.pir'
.include 'src/gen/@lclang@-runtime.pir'
.namespace []
.sub 'main' :main
.param pmc args
$P0 = compreg '@lang@'
# Cannot tailcall here. (TT #1029)
$P1 = $P0.'command_line'(args)
.return ($P1)
.end
__src/@lang@/Grammar.pm__
=begin overview
This is the grammar for @lang@ in Perl 6 rules.
=end overview
grammar @lang@::Grammar is HLL::Grammar;
token TOP {
<statementlist>
[ $ || <.panic: "Syntax error"> ]
}
## Lexer items
# This <ws> rule treats # as "comment to eol".
token ws {
<!ww>
[ '#' \N* \n? | \s+ ]*
}
## Statements
rule statementlist { [ <statement> | <?> ] ** ';' }
rule statement {
| <statement_control>
| <EXPR>
}
proto token statement_control { <...> }
rule statement_control:sym<say> { <sym> [ <EXPR> ] ** ',' }
rule statement_control:sym<print> { <sym> [ <EXPR> ] ** ',' }
## Terms
token term:sym<integer> { <integer> }
token term:sym<quote> { <quote> }
proto token quote { <...> }
token quote:sym<'> { <?[']> <quote_EXPR: ':q'> }
token quote:sym<"> { <?["]> <quote_EXPR: ':qq'> }
## Operators
INIT {
@lang@::Grammar.O(':prec<u>, :assoc<left>', '%multiplicative');
@lang@::Grammar.O(':prec<t>, :assoc<left>', '%additive');
}
token circumfix:sym<( )> { '(' <.ws> <EXPR> ')' }
token infix:sym<*> { <sym> <O('%multiplicative, :pirop<mul>')> }
token infix:sym</> { <sym> <O('%multiplicative, :pirop<div>')> }
token infix:sym<+> { <sym> <O('%additive, :pirop<add>')> }
token infix:sym<-> { <sym> <O('%additive, :pirop<sub>')> }
__src/@lang@/Actions.pm__
class @lang@::Actions is HLL::Actions;
method TOP($/) {
make PAST::Block.new( $<statementlist>.ast , :hll<@lclang@>, :node($/) );
}
method statementlist($/) {
my $past := PAST::Stmts.new( :node($/) );
for $<statement> { $past.push( $_.ast ); }
make $past;
}
method statement($/) {
make $<statement_control> ?? $<statement_control>.ast !! $<EXPR>.ast;
}
method statement_control:sym<say>($/) {
my $past := PAST::Op.new( :name<say>, :pasttype<call>, :node($/) );
for $<EXPR> { $past.push( $_.ast ); }
make $past;
}
method statement_control:sym<print>($/) {
my $past := PAST::Op.new( :name<print>, :pasttype<call>, :node($/) );
for $<EXPR> { $past.push( $_.ast ); }
make $past;
}
method term:sym<integer>($/) { make $<integer>.ast; }
method term:sym<quote>($/) { make $<quote>.ast; }
method quote:sym<'>($/) { make $<quote_EXPR>.ast; }
method quote:sym<">($/) { make $<quote_EXPR>.ast; }
method circumfix:sym<( )>($/) { make $<EXPR>.ast; }
__src/@lang@/Compiler.pm__
class @lang@::Compiler is HLL::Compiler;
INIT {
@lang@::Compiler.language('@lang@');
@lang@::Compiler.parsegrammar(@lang@::Grammar);
@lang@::Compiler.parseactions(@lang@::Actions);
}
__src/@lang@/Runtime.pm__
# language-specific runtime functions go here
sub print(*@args) {
pir::print(pir::join('', @args));
1;
}
sub say(*@args) {
pir::say(pir::join('', @args));
1;
}
__src/gen/.gitignore__
*
__t/harness__
#! perl
use strict;
use warnings;
use FindBin;
use File::Spec;
use Getopt::Long qw(:config pass_through);
$ENV{'HARNESS_PERL'} = './@lclang@';
use Test::Harness;
$Test::Harness::switches = '';
GetOptions(
'tests-from-file=s' => \my $list_file,
'verbosity=i' => \$Test::Harness::verbose,
'jobs:3' => \my $jobs,
'icu:1' => \my $do_icu,
);
my @pass_through_options = grep m/^--?[^-]/, @ARGV;
my @files = grep m/^[^-]/, @ARGV;
my $slash = $^O eq 'MSWin32' ? '\\' : '/';
if ($list_file) {
open(my $f, '<', $list_file)
or die "Can't open file '$list_file' for reading: $!";
while (<$f>) {
next if m/^\s*#/;
next unless m/\S/;
chomp;
my ($fn, $flags) = split /\s+#\s*/;
next if ($flags && ($flags =~ m/icu/) && !$do_icu);
$fn = "t/spec/$fn" unless $fn =~ m/^t\Q$slash\Espec\Q$slash\E/;
$fn =~ s{/}{$slash}g;
if ( -r $fn ) {
push @files, $fn;
}
else {
warn "Missing test file: $fn\n";
}
}
close $f or die $!;
}
my @tfiles = map { all_in($_) } sort @files;
if (eval { require TAP::Harness; 1 }) {
my %harness_options = (
exec => ['./@lclang@'],
verbosity => 0+$Test::Harness::verbose,
jobs => $jobs || 1,
);
TAP::Harness->new( \%harness_options )->runtests(@tfiles);
}
else {
runtests(@tfiles);
}
# adapted to return only files ending in '.t'
sub all_in {
my $start = shift;
return $start unless -d $start;
my @skip = ( File::Spec->updir, File::Spec->curdir, qw( .svn CVS .git ) );
my %skip = map {($_,1)} @skip;
my @hits = ();
if ( opendir( my $dh, $start ) ) {
my @files = sort readdir $dh;
closedir $dh or die $!;
for my $file ( @files ) {
next if $skip{$file};
my $currfile = File::Spec->catfile( $start, $file );
if ( -d $currfile ) {
push( @hits, all_in( $currfile ) );
}
else {
push( @hits, $currfile ) if $currfile =~ /\.t$/;
}
}
}
else {
warn "$start: $!\n";
}
return @hits;
}
__t/00-sanity.t__
# This just checks that the basic parsing and call to builtin say() works.
say '1..4';
say 'ok 1';
say 'ok ', 2;
say 'ok ', 2 + 1;
say 'ok', ' ', 4;
__DATA__
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
Something went wrong with that request. Please try again.