Author: bernhard
Date: Tue Nov 15 14:47:26 2005
New Revision: 10005
Added:
trunk/languages/regex/lib/Parrot/
trunk/languages/regex/lib/Parrot/Test/
trunk/languages/regex/lib/Parrot/Test/Regex.pm
trunk/languages/regex/t/harness
Modified:
trunk/MANIFEST
trunk/languages/LANGUAGES.STATUS
trunk/languages/regex/t/basic/a.t
trunk/languages/regex/t/basic/alt.t
trunk/languages/regex/t/basic/backopt.t
trunk/languages/regex/t/basic/example.t
trunk/languages/regex/t/basic/group.t
trunk/languages/regex/t/basic/infinite.t
trunk/languages/regex/t/basic/literal.t
trunk/languages/regex/t/basic/ngplus.t
trunk/languages/regex/t/basic/optional.t
trunk/languages/regex/t/basic/plus.t
trunk/languages/regex/t/basic/quantindex.t
trunk/languages/regex/t/basic/regress1.t
trunk/languages/regex/t/basic/scanalt.t
trunk/languages/regex/t/basic/scanstar.t
trunk/languages/regex/t/basic/star.t
trunk/languages/regex/t/basic/staralt.t
trunk/languages/regex/test.pl
trunk/languages/testall
Log:
Introduce 'languages/regex' to smoke testing.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Tue Nov 15 14:47:26 2005
@@ -1348,6 +1348,7 @@ languages/regex/Makefile
languages/regex/README [regex]
languages/regex/README.hacking [regex]
languages/regex/docs/regex.pod [regex]
+languages/regex/lib/Parrot/Test/Regex.pm [regex]
languages/regex/lib/Regex.pm [regex]
languages/regex/lib/Regex/CodeGen.pm [regex]
languages/regex/lib/Regex/CodeGen/IMCC.pm [regex]
@@ -1385,6 +1386,7 @@ languages/regex/t/basic/scanalt.t
languages/regex/t/basic/scanstar.t [regex]
languages/regex/t/basic/star.t [regex]
languages/regex/t/basic/staralt.t [regex]
+languages/regex/t/harness [regex]
languages/regex/test.pl [regex]
languages/ruby/Changes [ruby]
languages/ruby/MANIFEST [ruby]
Modified: trunk/languages/LANGUAGES.STATUS
==============================================================================
--- trunk/languages/LANGUAGES.STATUS (original)
+++ trunk/languages/LANGUAGES.STATUS Tue Nov 15 14:47:26 2005
@@ -682,7 +682,8 @@ regex
=item Status
-Working but fairly minimal
+Working but fairly minimal.
+Part of languages smoke testing, a lot of tests failing.
=item Last verified with parrot version
Added: trunk/languages/regex/lib/Parrot/Test/Regex.pm
==============================================================================
--- (empty file)
+++ trunk/languages/regex/lib/Parrot/Test/Regex.pm Tue Nov 15 14:47:26 2005
@@ -0,0 +1,123 @@
+# $Id$
+
+require Parrot::Test;
+
+package Parrot::Test::Regex;
+
+use strict;
+
+use Data::Dumper;
+use File::Basename;
+use File::Spec::Functions;
+
+
+=head1 NAME
+
+Test/Regex.pm - Testing routines specific to 'regex'.
+
+=head1 DESCRIPTION
+
+Does the same a 'languages/regex/test.pl'
+
+=cut
+
+# FIXME: This is still probably unix-only, because the parrot binary
+# will have different names
+my $PARROT_EXE = catfile(catdir($FindBin::Bin, updir(), updir(), updir(),
updir()), "parrot");
+
+sub run_spec {
+ my ( $spec_fh ) = @_;
+
+ my $pattern = <$spec_fh>;
+ chomp($pattern);
+
+ generate_regular($pattern);
+
+ $_ = <$spec_fh>;
+ my @spec;
+ while (1) {
+ my ($input, $output);
+
+ last if ! defined $_;
+ die "INPUT: expected" if ! /^INPUT:/;
+
+ # Gather input, look for OUTPUT:
+ $input = '';
+ undef $output;
+ while (<$spec_fh>) {
+ $output = '', last if /^OUTPUT:/;
+ $input .= $_;
+ }
+ chomp($input);
+ die "EOF during INPUT section" if ! defined($output);
+
+ # Gather output
+ while (<$spec_fh>) {
+ last if /^INPUT:/;
+ $output .= $_;
+ }
+
+ push @spec, { input => $input, output => $output };
+ }
+
+ Test::More::plan( tests => scalar(@spec) );
+ foreach ( @spec ) {
+ process($_->{input}, $_->{output});
+ }
+
+ return 0;
+}
+
+sub generate_regular_imc {
+ my ($filename, $pattern) = @_;
+ open(PIR, ">$filename") or die "create $filename: $!";
+
+ my $ctx = { };
+ my $trees = Regex::expr_to_tree($pattern, $ctx, DEBUG => 0);
+
+ my $driver = Regex::Driver->new('pir', emit_main => 1);
+
+ print PIR <<"END";
+# Regular expression test
+# Generated by $0
+# Pattern >>$pattern<<
+
+END
+
+ $driver->output_header(*PIR);
+
+ for my $tree (@$trees) {
+ $driver->output_rule(*PIR, '_regex', $tree, $ctx, DEBUG => 0);
+ }
+
+ close PIR;
+}
+
+sub generate_pbc {
+ my ($imc, $pbc) = @_;
+ my $status = system("$PARROT_EXE", "-o", $pbc, $imc);
+ if (! defined($status) || $status) {
+ die "assemble failed with status " . ($? >> 8);
+ }
+}
+
+sub generate_regular {
+ my $pattern = shift;
+
+ generate_regular_imc("test.imc", $pattern);
+ generate_pbc("test.imc", "test.pbc");
+}
+
+sub process {
+ my ($input, $output) = @_;
+
+ open(TEST, "$PARROT_EXE test.pbc '$input' |");
+
+ local $/;
+ my $actual_output = <TEST>;
+ Test::More::is($actual_output, $output);
+
+ return;
+}
+
+1;
Modified: trunk/languages/regex/t/basic/a.t
==============================================================================
--- trunk/languages/regex/t/basic/a.t (original)
+++ trunk/languages/regex/t/basic/a.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,18 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+__END__
a
INPUT:
aa
Modified: trunk/languages/regex/t/basic/alt.t
==============================================================================
--- trunk/languages/regex/t/basic/alt.t (original)
+++ trunk/languages/regex/t/basic/alt.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
^a|b
INPUT:
a
Modified: trunk/languages/regex/t/basic/backopt.t
==============================================================================
--- trunk/languages/regex/t/basic/backopt.t (original)
+++ trunk/languages/regex/t/basic/backopt.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
(a+)?a
INPUT:
aa
Modified: trunk/languages/regex/t/basic/example.t
==============================================================================
--- trunk/languages/regex/t/basic/example.t (original)
+++ trunk/languages/regex/t/basic/example.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
(a*a|(aaa))a
INPUT:
xxxxxxxxaaabb
Modified: trunk/languages/regex/t/basic/group.t
==============================================================================
--- trunk/languages/regex/t/basic/group.t (original)
+++ trunk/languages/regex/t/basic/group.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
((a*)a)
INPUT:
aaa
Modified: trunk/languages/regex/t/basic/infinite.t
==============================================================================
--- trunk/languages/regex/t/basic/infinite.t (original)
+++ trunk/languages/regex/t/basic/infinite.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
(a?)*
INPUT:
bbb
Modified: trunk/languages/regex/t/basic/literal.t
==============================================================================
--- trunk/languages/regex/t/basic/literal.t (original)
+++ trunk/languages/regex/t/basic/literal.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
abc
INPUT:
ababc
Modified: trunk/languages/regex/t/basic/ngplus.t
==============================================================================
--- trunk/languages/regex/t/basic/ngplus.t (original)
+++ trunk/languages/regex/t/basic/ngplus.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
a+?
INPUT:
x
Modified: trunk/languages/regex/t/basic/optional.t
==============================================================================
--- trunk/languages/regex/t/basic/optional.t (original)
+++ trunk/languages/regex/t/basic/optional.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
a?
INPUT:
Modified: trunk/languages/regex/t/basic/plus.t
==============================================================================
--- trunk/languages/regex/t/basic/plus.t (original)
+++ trunk/languages/regex/t/basic/plus.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
a+
INPUT:
x
Modified: trunk/languages/regex/t/basic/quantindex.t
==============================================================================
--- trunk/languages/regex/t/basic/quantindex.t (original)
+++ trunk/languages/regex/t/basic/quantindex.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
(a)+
INPUT:
aaa
Modified: trunk/languages/regex/t/basic/regress1.t
==============================================================================
--- trunk/languages/regex/t/basic/regress1.t (original)
+++ trunk/languages/regex/t/basic/regress1.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
^(?:r|s)r
INPUT:
r
Modified: trunk/languages/regex/t/basic/scanalt.t
==============================================================================
--- trunk/languages/regex/t/basic/scanalt.t (original)
+++ trunk/languages/regex/t/basic/scanalt.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
a|b
INPUT:
a
Modified: trunk/languages/regex/t/basic/scanstar.t
==============================================================================
--- trunk/languages/regex/t/basic/scanstar.t (original)
+++ trunk/languages/regex/t/basic/scanstar.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
a*
INPUT:
aaax
Modified: trunk/languages/regex/t/basic/star.t
==============================================================================
--- trunk/languages/regex/t/basic/star.t (original)
+++ trunk/languages/regex/t/basic/star.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
^a*
INPUT:
aaax
Modified: trunk/languages/regex/t/basic/staralt.t
==============================================================================
--- trunk/languages/regex/t/basic/staralt.t (original)
+++ trunk/languages/regex/t/basic/staralt.t Tue Nov 15 14:47:26 2005
@@ -1,3 +1,19 @@
+# $Id$
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Parrot::Test::Regex;
+use Regex;
+use Regex::Driver;
+
+use Test::More;
+
+Parrot::Test::Regex::run_spec( \*DATA );
+
+
+__END__
a*|b
INPUT:
hello
Added: trunk/languages/regex/t/harness
==============================================================================
--- (empty file)
+++ trunk/languages/regex/t/harness Tue Nov 15 14:47:26 2005
@@ -0,0 +1,51 @@
+# $Id$
+
+=head1 NAME
+
+languages/regex/t/harness - A harness for Parrot bc
+
+=head1 SYNOPSIS
+
+ cd languages && perl -I../lib regex/t/harness --files
+
+=head1 DESCRIPTION
+
+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.
+
+=cut
+
+use strict;
+use lib '..';
+
+use Cwd();
+use Data::Dumper;
+use File::Spec;
+use Test::Harness();
+
+my $language = 'regex';
+
+if ( grep { m/^--files$/ } @ARGV ) {
+ # Only the Makefile in 'parrot/languages' uses --files
+ 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 {
+ die "Only '--files' is supported";
+}
+
+=head1 HISTORY
+
+Mostly taken from bc/t/harness.
+
+=head1 SEE ALSO
+
+ F<languages/tcl/t/harness>, F<languages/scheme/t/harness>,
F<languages/m4/t/harness>, F<languages/python/t/harness>
+
+=head1 AUTHOR
+
+Bernhard Schmalhofer - <[EMAIL PROTECTED]>
+
+=cut
Modified: trunk/languages/regex/test.pl
==============================================================================
--- trunk/languages/regex/test.pl (original)
+++ trunk/languages/regex/test.pl Tue Nov 15 14:47:26 2005
@@ -27,8 +27,9 @@ sub usage {
print <<"END";
Usage: $0 [-c|--compile] [--language=LANGUAGE]
[--optimize=PASSES|--nooptimize] <filename>
- Test files must contain a single regular expression on the first
- line. Next there should be any number of pairs of INPUT and OUTPUT
+ Test files are Perl5 source files which must contain a __END__ section.
+ Right after the __END__ there must be a single regular expression.
+ Next there should be any number of pairs of INPUT and OUTPUT
sections, where an INPUT: section begins with the string 'INPUT:' on
a line by itself, followed by some data and a newline. (The newline
is not regarded as part of the data, so add an extra one if you want
@@ -36,6 +37,7 @@ Usage: $0 [-c|--compile] [--language=LAN
Example:
+__END__
(a*a|(aaa))a
INPUT:
xxxxxxxxaaabb
Modified: trunk/languages/testall
==============================================================================
--- trunk/languages/testall (original)
+++ trunk/languages/testall Tue Nov 15 14:47:26 2005
@@ -79,7 +79,6 @@ my $html = grep { $_ eq '--html' } @ARGV
# parakeet No t/harness
# perl6 t/harness has no --files
# python needs testing
-# regex No t/harness
# ruby No t/harness
@@ -93,8 +92,10 @@ my @unified_testable_languages =
parrot_compiler
punie
scheme
+ regex
tcl
urm );
+# @unified_testable_languages = qw( regex );
my @harnesses =
grep {-f $_}
