develooper Front page | perl.cvs.parrot | Postings from November 2008

[svn:parrot] r32620 - in trunk: . lib/Parrot/Test t/compilers/pct

From:
bernhard
Date:
November 13, 2008 08:38
Subject:
[svn:parrot] r32620 - in trunk: . lib/Parrot/Test t/compilers/pct
Message ID:
20081113163845.91F5DCB9AF@x12.develooper.com
Author: bernhard
Date: Thu Nov 13 08:38:44 2008
New Revision: 32620

Added:
   trunk/t/compilers/pct/sample.txt   (contents, props changed)
Modified:
   trunk/MANIFEST
   trunk/lib/Parrot/Test/Util.pm
   trunk/t/compilers/pct/complete_workflow.t

Log:
[PCT] A first stab at complete_workflow.t.
PAST generation is still broken.


Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST	(original)
+++ trunk/MANIFEST	Thu Nov 13 08:38:44 2008
@@ -1,7 +1,7 @@
 # ex: set ro:
 # $Id$
 #
-# generated by tools/dev/mk_manifest_and_skip.pl Thu Nov 13 13:02:29 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Thu Nov 13 16:13:53 2008 UT
 #
 # See tools/dev/install_files.pl for documentation on the
 # format of this file.
@@ -3209,6 +3209,7 @@
 t/compilers/pct/past.t                                      []
 t/compilers/pct/pct_hllcompiler.t                           []
 t/compilers/pct/post.t                                      []
+t/compilers/pct/sample.txt                                  []
 t/compilers/pct/script.source                               []
 t/compilers/pge/00-basic.t                                  []
 t/compilers/pge/02-match.t                                  []

Modified: trunk/lib/Parrot/Test/Util.pm
==============================================================================
--- trunk/lib/Parrot/Test/Util.pm	(original)
+++ trunk/lib/Parrot/Test/Util.pm	Thu Nov 13 08:38:44 2008
@@ -17,12 +17,10 @@
 This module provides basic utilities for Parrot test scripts. So far, there's
 only one utility, C<create_tempfile>, which must be requested for import.
 
-
 =head1 AUTHOR
 
 Written by Jerry Gay.
 
-
 =cut
 
 package Parrot::Test::Util;
@@ -52,10 +50,11 @@
 
 sub create_tempfile {
         my ($filehandle, $filename) = &tempfile;
+
         $filename =~ s/\\/\//g;
-        return ( $filehandle, $filename );
-}
 
+        return ($filehandle, $filename);
+}
 
 =back
 

Modified: trunk/t/compilers/pct/complete_workflow.t
==============================================================================
--- trunk/t/compilers/pct/complete_workflow.t	(original)
+++ trunk/t/compilers/pct/complete_workflow.t	Thu Nov 13 08:38:44 2008
@@ -9,7 +9,8 @@
 
 use Cwd qw(cwd);
 use Data::Dumper;
-use Test::More tests => 1;
+use Test::More;
+use Parrot::Test tests => 7;
 
 use Parrot::Test::Util 'create_tempfile';
 use Parrot::Config;
@@ -36,32 +37,98 @@
 my $BUILD_DIR     = $PConfig{build_dir};
 my $TEST_DIR      = "$BUILD_DIR/t/compilers/pct";
 my $PARROT        = "$BUILD_DIR/parrot$PConfig{exe}";
-my $PERL5         = $PConfig{perl};
-my $PARROT_DYNEXT = "$BUILD_DIR/runtime/parrot/dynext";
 my $PGE_LIBRARY   = "$BUILD_DIR/runtime/parrot/library/PGE";
 my $PERL6GRAMMAR  = "$PGE_LIBRARY/Perl6Grammar.pbc";
 my $NQP           = "$BUILD_DIR/compilers/nqp/nqp.pbc";
-my $PCT           = "$BUILD_DIR/runtime/parrot/library/PCT.pbc";
 
 # set up a file with the grammar
-#my ($PG, $pg_fn) = create_tempfile( SUFFIX => '.pg', DIR => $TEST_DIR );
-my ($PG, $pg_fn) = create_tempfile( SUFFIX => '.pg', DIR => cwd(), UNLINK => 1 );
+my ($PG, $pg_fn) = create_tempfile( SUFFIX => '.pg', DIR => $TEST_DIR, UNLINK => 1 );
 print $PG <<'END_PG';
 # DO NOT EDIT.
 # This file was generated by t/compilers/pct/complete_workflow.t
 
-grammar TestGrammar;
+grammar TestGrammar::Grammar is PCT::Grammar;
 
-token apply { ^<op>$ }
-token op    { test <?ws> <val> <?ws> }
-token val   { thingy }
+token TOP   { 'thingy' }
 END_PG
 
-ok( 'dummy' );
+ok( $pg_fn, 'got name of grammar file' );
+ok( -e $pg_fn, 'grammar file exists' );
 #diag( Dumper( \%PConfig ) );
 
+# compile the grammar
+( my $gen_grammar_fn = $pg_fn ) =~s/pg$/pir/;
+system( $PARROT, $PERL6GRAMMAR, "--output=$gen_grammar_fn", $pg_fn );
+ok( -e $gen_grammar_fn, 'generated parser exists' );
+
+# set up a file with the actions
+my ($PM, $pm_fn) = create_tempfile( SUFFIX => '.pm', DIR => $TEST_DIR, UNLINK => 1 );
+print $PM <<'END_PM';
+# DO NOT EDIT.
+# This file was generated by t/compilers/pct/complete_workflow.t
+
+class TestGrammar::Grammar::Actions;
 
+method TOP($/) {
+    my $past  := PAST::Stmts.new( 
+                     PAST::Op.new(
+                         PAST::Val.new(
+                             :value( ~$/ ),
+                             :returns('thingy')
+                         ),
+                         :pirop('say'),
+                         :pasttype('pirop')
+                     ) 
+                 );
+
+    make $past;
+}
+END_PM
+
+ok( $pm_fn, 'got name of action file' );
+ok( -e $pm_fn, 'action file exists' );
+#diag( Dumper( \%PConfig ) );
 
+# compile the grammar
+( my $gen_actions_fn = $pm_fn ) =~s/nqp$/pir/;
+system( $PARROT, $NQP, "--output=$gen_actions_fn", "--target=pir", $pm_fn );
+ok( -e $gen_actions_fn, 'generated parser exists' );
+
+
+my $driver_pir = <<'CODE';
+.namespace [ 'TestGrammar'; 'Compiler' ]
+
+.sub 'onload' :anon :load :init
+    load_bytecode 'PCT.pbc'
+.end
+
+.sub 'main' :main
+    #.param pmc args
+    .local pmc args
+    args = new 'ResizableStringArray'
+    push args, "command"
+    push args, "--target=parse"
+    push args, "t/compilers/pct/sample.txt"
+    #push args, "thingy"
+
+    $P0 = new ['PCT'; 'HLLCompiler']
+    $P0.'language'('TestGrammar')
+    $P0.'parsegrammar'('TestGrammar::Grammar')
+    $P0.'parseactions'('TestGrammar::Grammar::Actions')
+
+    $P1 = $P0.'command_line'(args)
+
+    .return()
+.end
+
+CODE
+
+$driver_pir .= "\n.include '$gen_grammar_fn'";
+$driver_pir .= "\n.include '$gen_actions_fn'";
+
+pir_output_is( $driver_pir, <<'OUT', 'workflow, parse only' ); 
+"parse" => PMC 'TestGrammar;Grammar' => "thingy" @ 0
+OUT
 
 
 =head1 AUTHOR

Added: trunk/t/compilers/pct/sample.txt
==============================================================================
--- (empty file)
+++ trunk/t/compilers/pct/sample.txt	Thu Nov 13 08:38:44 2008
@@ -0,0 +1 @@
+thingy



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About