Skip to content
Browse files

initial commit

  • Loading branch information...
0 parents commit a29ef4310e3e8f9dcaf517858fb4c1f2ea60f78a @fperrad committed
7 .gitignore
@@ -0,0 +1,7 @@
+Makefile
+
+*.pbc
+gen_*.pir
+
+*.xml
+*.out
86 Configure.pl
@@ -0,0 +1,86 @@
+# Copyright (C) 2009, Parrot Foundation.
+
+=head1 NAME
+
+Configure.pl - a configure script for a high level language running on Parrot
+
+=head1 SYNOPSIS
+
+ perl Configure.pl --help
+
+ perl Configure.pl
+
+ perl Configure.pl --parrot_config=<path_to_parrot>
+
+=cut
+
+use strict;
+use warnings;
+use 5.008;
+
+use Getopt::Long qw(:config auto_help);
+
+our ( $opt_parrot_config );
+GetOptions( 'parrot_config=s' );
+
+# Get a list of parrot-configs to invoke.
+my @parrot_config_exe = $opt_parrot_config
+ ? ( $opt_parrot_config )
+ : (
+ 'parrot/parrot_config',
+ '../../parrot_config',
+ 'parrot_config',
+ );
+
+# Get configuration information from parrot_config
+my %config = read_parrot_config(@parrot_config_exe);
+unless (%config) {
+ die "Unable to locate parrot_config.";
+}
+
+# Create the Makefile using the information we just got
+create_makefiles(%config);
+
+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 "Reading configuration information from $exe\n";
+ while (<$PARROT_CONFIG>) {
+ $config{$1} = $2 if (/(\w+) => '(.*)'/);
+ }
+ close $PARROT_CONFIG;
+ last if %config;
+ }
+ }
+ %config;
+}
+
+
+# Generate Makefiles from a configuration
+sub create_makefiles {
+ my %config = @_;
+ my %makefiles = (
+ 'build/Makefile.in' => 'Makefile',
+# 'build/src/pmc/Makefile.in' => 'src/pmc/Makefile',
+# 'build/src/ops/Makefile.in' => 'src/ops/Makefile',
+ );
+ my $build_tool = $config{libdir} . $config{versiondir}
+ . '/tools/dev/gen_makefile.pl';
+
+ foreach my $template (keys %makefiles) {
+ my $makefile = $makefiles{$template};
+ print "Creating $makefile\n";
+ system($config{perl}, $build_tool, $template, $makefile);
+ }
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
16 README
@@ -0,0 +1,16 @@
+
+XML on Parrot
+=============
+
+This module contains :
+ * a SAX like parser
+ * a simple handler XmlWriter
+
+There are toys, but there demonstrate the power of PCT,
+the Parrot Compiler Toolkit.
+
+But PCT is not handly for packaging & deployment.
+
+Now, XML modules could easy implemented with Perl 6,
+because with PCT, most of the code is already Perl 6.
+
148 build/Makefile.in
@@ -0,0 +1,148 @@
+# Copyright (C) 2009, Parrot Foundation.
+
+## arguments we want to run parrot with
+PARROT_ARGS :=
+
+## configuration settings
+VERSION := @versiondir@
+BIN_DIR := @bindir@
+LIB_DIR := @libdir@$(VERSION)
+DOC_DIR := @doc_dir@$(VERSION)
+MANDIR := @mandir@$(VERSION)
+
+# Various paths
+PERL6GRAMMAR := $(LIB_DIR)/library/PGE/Perl6Grammar.pbc
+NQP := $(LIB_DIR)/languages/nqp/nqp.pbc
+PCT := $(LIB_DIR)/library/PCT.pbc
+
+## Setup some commands
+MAKE := @make_c@
+PERL := @perl@
+CAT := @cat@
+CHMOD := @chmod@
+CP := @cp@
+MKPATH := @mkpath@
+RM_F := @rm_f@
+RM_RF := @rm_rf@
+POD2MAN := pod2man
+#IF(parrot_is_shared and not(cygwin or win32)):export LD_RUN_PATH := @blib_dir@:$(LD_RUN_PATH)
+PARROT := $(BIN_DIR)/parrot@exe@
+#IF(darwin):
+#IF(darwin):# MACOSX_DEPLOYMENT_TARGET must be defined for OS X compilation/linking
+#IF(darwin):export MACOSX_DEPLOYMENT_TARGET := @osx_version@
+
+SAX_XML_SOURCES := \
+ sax/xml/gen_grammar.pir \
+ sax/xml/gen_actions.pir \
+ sax/xml/gen_builtins.pir \
+ sax/xml/xml.pir
+
+SAX_XML_BUILTINS_PIR := \
+ sax/xml/builtins/fire.pir
+
+HANDLER_XMLWRITER_SOURCES := \
+ handler/xmlwriter/gen_actions.pir \
+ handler/xmlwriter/gen_builtins.pir \
+ handler/xmlwriter/xmlwriter.pir
+
+HANDLER_XMLWRITER_BUILTINS_PIR := \
+ handler/xmlwriter/builtins/print.pir
+
+DOCS := README
+
+BUILD_CLEANUPS := \
+ "sax/xml/*.pbc" \
+ "sax/xml/gen_*.pir" \
+ "handler/xmlwriter/*.pbc" \
+ "handler/xmlwriter/gen_*.pir" \
+#IF(win32): parrot-xml.iss \
+#IF(win32): "setup-parrot-*.exe" \
+
+TEST_CLEANUPS := \
+ "t/*.xml" \
+ "t/*.out"
+
+# the default target
+build: xml.pbc sax/xml/xml.pbc handler/xmlwriter/xmlwriter.pbc
+
+all: build
+
+xml.pbc: xml.pir
+ $(PARROT) $(PARROT_ARGS) -o xml.pbc xml.pir
+
+sax/xml/xml.pbc: $(SAX_XML_SOURCES)
+ $(PARROT) $(PARROT_ARGS) -o sax/xml/xml.pbc sax/xml/xml.pir
+
+sax/xml/gen_grammar.pir: $(PERL6GRAMMAR) sax/xml/pct/grammar.pg
+ $(PARROT) $(PARROT_ARGS) $(PERL6GRAMMAR) \
+ --output=sax/xml/gen_grammar.pir \
+ sax/xml/pct/grammar.pg
+
+sax/xml/gen_actions.pir: $(NQP) sax/xml/pct/actions.pm
+ $(PARROT) $(PARROT_ARGS) $(NQP) --output=sax/xml/gen_actions.pir \
+ --target=pir sax/xml/pct/actions.pm
+
+sax/xml/gen_builtins.pir: $(SAX_XML_BUILTINS_PIR)
+ $(CAT) $(SAX_XML_BUILTINS_PIR) > sax/xml/gen_builtins.pir
+
+handler/xmlwriter/xmlwriter.pbc: $(HANDLER_XMLWRITER_SOURCES)
+ $(PARROT) $(PARROT_ARGS) -o handler/xmlwriter/xmlwriter.pbc handler/xmlwriter/xmlwriter.pir
+
+handler/xmlwriter/gen_actions.pir: $(NQP) handler/xmlwriter/pct/actions.pm
+ $(PARROT) $(PARROT_ARGS) $(NQP) --output=handler/xmlwriter/gen_actions.pir \
+ --target=pir handler/xmlwriter/pct/actions.pm
+
+handler/xmlwriter/gen_builtins.pir: $(HANDLER_XMLWRITER_BUILTINS_PIR)
+ $(CAT) $(HANDLER_XMLWRITER_BUILTINS_PIR) > handler/xmlwriter/gen_builtins.pir
+
+Makefile: build/Makefile.in
+ $(PERL) Configure.pl
+
+# This is a listing of all targets, that are meant to be called by users
+help:
+ @echo ""
+ @echo "Following targets are available for the user:"
+ @echo ""
+ @echo " build: xml.pbc xmlwriter.pbc"
+ @echo " This is the default."
+ @echo " all: xml.pbc xmlwriter.pbc"
+ @echo ""
+ @echo "Testing:"
+ @echo " test: Run the test suite."
+ @echo " testclean: Clean up test results."
+ @echo ""
+ @echo "Cleaning:"
+ @echo " clean: Basic cleaning up."
+ @echo " realclean: Removes also files generated by 'Configure.pl'"
+ @echo " distclean: Removes also anything built, in theory"
+ @echo ""
+ @echo "Misc:"
+ @echo " help: Print this help message."
+ @echo ""
+
+test: build
+ $(PERL) -I$(LIB_DIR)/tools/lib t/harness
+
+install:
+ -$(MKPATH) $(LIB_DIR)/languages/xml
+ $(CP) xml.pbc $(LIB_DIR)/languages/xml/xml.pbc
+
+uninstall:
+ $(RM_RF) $(LIB_DIR)/languages/xml
+
+testclean:
+ $(RM_F) $(TEST_CLEANUPS)
+
+clean:
+ $(RM_F) $(TEST_CLEANUPS) $(BUILD_CLEANUPS)
+
+realclean:
+ $(RM_F) $(TEST_CLEANUPS) $(BUILD_CLEANUPS) Makefile
+
+distclean: realclean
+
+# Local variables:
+# mode: makefile
+# End:
+# vim: ft=make:
+
25 handler/xmlwriter/builtins/print.pir
@@ -0,0 +1,25 @@
+# Copyright (C) 2009, Parrot Foundation.
+
+.namespace []
+
+.sub 'print'
+ .param pmc args :slurpy
+ .local pmc stream
+ stream = get_global 'Stream'
+ .local pmc iter
+ iter = new 'Iterator', args
+ iter_loop:
+ unless iter goto iter_end
+ $P0 = shift iter
+ stream.'print'($P0)
+ goto iter_loop
+ iter_end:
+ .return ()
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
64 handler/xmlwriter/pct/actions.pm
@@ -0,0 +1,64 @@
+# Copyright (C) 2009, Parrot Foundation.
+
+class Xml::Handler::XmlWriter;
+
+method start_document() {
+}
+
+method end_document() {
+}
+
+method characters( :$Data ) {
+ print( $Data );
+}
+
+method comment( :$Data ) {
+ print( '<!--', $Data, '-->' );
+}
+
+method processing_instruction( :$Target, :$Data ) {
+ print( '<?', $Target );
+ if ?$Data {
+ print( ' ', $Data );
+ }
+ print( '?>' );
+}
+
+method start_cdata() {
+}
+
+method end_cdata() {
+}
+
+method xml_decl( :$Version, :$Encoding, :$Standalone ) {
+ print( "xml_decl", " ", $Version, " ", $Encoding, " ", $Standalone );
+ print( '<?xml version="', $Version, '"' );
+ if ?$Encoding {
+ print( ' encoding="', $Encoding, '"' );
+ }
+ if ?$Standalone {
+ print( ' standalone="', $Standalone, '"' );
+ }
+ print( '?>' )
+}
+
+method start_element( :$Name, :$Attributes ) {
+ print( '<', $Name );
+ print( '>' );
+}
+
+method end_element( :$Name ) {
+ print( '</', $Name, '>' );
+}
+
+method entity_reference( :$Name, :$Value ) {
+ print( '&', $Name, ';' );
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
13 handler/xmlwriter/xmlwriter.pir
@@ -0,0 +1,13 @@
+# Copyright (C) 2009, Parrot Foundation.
+
+.namespace [ 'Xml::Handler::XmlWriter' ]
+
+.include 'handler/xmlwriter/gen_builtins.pir'
+.include 'handler/xmlwriter/gen_actions.pir'
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
19 sax/xml/builtins/fire.pir
@@ -0,0 +1,19 @@
+# Copyright (C) 2009, Parrot Foundation.
+
+.namespace []
+
+.sub 'fire'
+ .param string event
+ .param pmc args :slurpy :named
+ $P0 = get_global 'Handler'
+ $P1 = find_method $P0, event
+ $P1($P0, args :named :flat)
+ .return ()
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
136 sax/xml/pct/actions.pm
@@ -0,0 +1,136 @@
+# Copyright (C) 2009, Parrot Foundation.
+
+=begin comments
+
+Xml::Sax::Xml::Grammar::Actions - ast transformations for Xml
+
+This file contains the methods that are used by the parse grammar
+to build the PAST representation of an Xml program.
+Each method below corresponds to a rule in F<src/parser/grammar.pg>,
+and is invoked at the point where C<{*}> appears in the rule,
+with the current match object as the first argument. If the
+line containing C<{*}> also has a C<#= key> comment, then the
+value of the comment is passed as the second argument to the method.
+
+=end comments
+
+=cut
+
+class Xml::Sax::Xml::Grammar::Actions;
+
+method TOP($/) {
+ make PCT::Node.new();
+}
+
+# 1
+method document($/, $key) {
+ fire( $key );
+ make PCT::Node.new();
+}
+
+# 14
+method CharData($/) {
+ fire( 'characters',
+ :Data( $/.Str() ) );
+ make PCT::Node.new();
+}
+
+# 15
+method Comment($/) {
+ fire( 'comment',
+ :Data( $/[0] ) );
+ make PCT::Node.new();
+}
+
+# 16
+method PI($/) {
+ fire( 'processing_instruction',
+ :Target( $<PITarget> ),
+ :Data( $<Data>
+ ?? $<Data>[0]
+ !! '' ) );
+ make PCT::Node.new();
+}
+
+# 18
+method CDSect($/) {
+ fire( 'start_cdata' );
+ fire( 'characters',
+ :Data( $<CData> ) );
+ fire( 'end_cdata' );
+ make PCT::Node.new();
+}
+
+# 23
+method XMLDecl($/) {
+ fire( 'xml_decl',
+ :Version( $<VersionInfo><VersionNum> ),
+ :Encoding( $<EncodingDecl>
+ ?? $<EncodingDecl>[0]<EncName>
+ !! '' ),
+ :Standalone( $<SDDecl>
+ ?? $<SDDecl>[0]<_yes_no>
+ !! '' ) );
+ make PCT::Node.new();
+}
+
+# 40
+method STag($/) {
+ my %attr;
+ for ( $<Attribute> ) {
+ %attr{ $_<Name> } := $_<AttValue>[0];
+ }
+ fire( 'start_element',
+ :Name( $<Name> ),
+ :Attributes( %attr ) );
+ make PCT::Node.new();
+}
+
+# 42
+method ETag($/) {
+ fire( 'end_element',
+ :Name( $<Name> ) );
+ make PCT::Node.new();
+}
+
+# 44
+method EmptyElemTag($/) {
+ my %attr;
+ for ( $<Attribute> ) {
+ %attr{ $_<Name> } := $_<AttValue>[0];
+ }
+ fire( 'start_element',
+ :Name( $<Name> ),
+ :Attributes( %attr ) );
+ fire( 'end_element',
+ :Name( $<Name> ) );
+ make PCT::Node.new();
+}
+
+# 66
+method CharRef($/, $key) {
+ my $char := 'TODO';
+ fire( 'characters',
+ :Data( $char ) );
+ make PCT::Node.new();
+}
+
+# 67
+method Reference($/, $key) {
+ make $( $/{$key} );
+}
+
+# 68
+method EntityRef($/) {
+ fire( 'entity_reference',
+ :Name( $<Name> ) );
+ make PCT::Node.new();
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
251 sax/xml/pct/grammar.pg
@@ -0,0 +1,251 @@
+# Copyright (C) 2009, Parrot Foundation.
+
+=pod
+
+This is the grammar for Xml written as a sequence of Perl 6 rules.
+
+See Extensible Markup Language (XML) 1.0,
+L<http://www.w3.org/TR/2000/REC-xml-20001006>
+
+=cut
+
+grammar Xml::Sax::Xml::Grammar is PCT::Grammar;
+
+=head1 Documents
+
+=head2 Well-Formed XML Documents
+
+=cut
+
+token TOP {
+ ^ <document>
+ [ $ || <panic: 'Syntax error'> ]
+ {*}
+}
+
+# 1
+token document {
+ {*} #= start_document
+ <prolog> <element> <Misc>*
+ {*} #= end_document
+}
+
+=head2 Characters
+
+=cut
+
+# 2
+token Char {
+ <[\x9\xA\xD\x20..\xFF]>
+}
+
+=head2 Common Syntactic Construct
+
+=cut
+
+# 3
+token S {
+ <[\x20\x9\xD\xA]>+
+}
+
+# 5
+token Name {
+ <[\x41..\x5A\x61..\x7A\xC0..\xD6\xD8..\xF6\xF8..\xFF_:]>
+ <[\x41..\x5A\x61..\x7A\xC0..\xD6\xD8..\xF6\xF8..\xFF\x30..\x39.\-_:\xB7]>*
+}
+
+# 10
+token AttValue {
+ \" ( <-[<&"]>* ) \"
+ | \' ( <-[<&']>* ) \'
+}
+
+=head2 Character Data and Markup
+
+=cut
+
+# 14
+token CharData {
+ [ <!CDEnd> <-[<&]> ] *
+ {*}
+}
+
+=head2 Comments
+
+=cut
+
+# 15
+token Comment {
+ '<!--' ( [ <!_hyphen> <.Char> | '-' [ <!_hyphen> <.Char> ] ]* ) '-->'
+ {*}
+}
+
+token _hyphen {
+ '-'
+}
+
+=head2 Processing Instruction
+
+=cut
+
+# 16
+token PI {
+ '<?' <PITarget> [ <.S> $<Data>=[ <!_PI> <.Char> ]* ]? '?>'
+ {*}
+}
+
+token _PI { '?>' }
+
+# 17
+token PITarget {
+ <!_xml> <.Name>
+}
+
+token _xml { <[Xx]> <[Mm]> <[Ll]> }
+
+=head2 CDATA Sections
+
+=cut
+
+# 18
+token CDSect {
+ '<![CDATA[' <CData> <.CDEnd>
+ {*}
+}
+
+# 20
+token CData {
+ [ <!CDEnd> <.Char> ]*
+}
+
+# 21
+token CDEnd {
+ ']]>'
+}
+
+=head2 Prolog and Document Type Declaration
+
+=cut
+
+# 22
+token prolog {
+# <XMLDecl>? <Misc>* [ <doctypedecl> <Misc>* ]?
+ <XMLDecl>? <Misc>*
+}
+
+# 23
+token XMLDecl {
+ '<?xml' <VersionInfo> <EncodingDecl>? <SDDecl>? <.S>? '?>'
+ {*}
+}
+
+# 24
+token VersionInfo {
+ <.S> version <.Eq> [ \' <VersionNum> \' | \" <VersionNum> \" ]
+}
+
+# 25
+token Eq {
+ <.S>? '=' <.S>?
+}
+
+# 26
+token VersionNum {
+ <[a..zA..Z0..9_.:\-]>+
+}
+
+# 27
+token Misc {
+ <Comment>
+ | <PI>
+ | <.S>
+}
+
+=head2 Standalone Document Declaration
+
+=cut
+
+# 32
+token SDDecl {
+ <.S> standalone <.Eq> [ \' <_yes_no> \' | \" <_yes_no> \" ]
+}
+
+token _yes_no {
+ [yes|no]
+}
+
+=head1 Logical Structures
+
+=cut
+
+# 39
+token element {
+ <EmptyElemTag>
+ | <STag> <content> <ETag>
+}
+
+=head2 Start-Tags, End-Tags, and Empty-Element Tags
+
+=cut
+
+# 40
+token STag {
+ '<' <Name> [ <.S> <Attribute> ]* <.S>? '>'
+ {*}
+}
+
+# 41
+token Attribute {
+ <Name> <.Eq> <AttValue>
+}
+
+# 42
+token ETag {
+ '</' <Name> <.S>? '>'
+ {*}
+}
+
+# 43
+token content {
+ <CharData>? [ [ <element> | <Reference> | <CDSect> | <PI> | <Comment> ] <CharData>? ]*
+}
+
+# 44
+token EmptyElemTag {
+ '<' <Name> [ <.S> <Attribute> ]* <.S>? '/>'
+ {*}
+}
+
+=head1 Physical Structures
+
+=head2 Character and Entity References
+
+=cut
+
+# 66
+token CharRef {
+ '&#' ( <[0..9]>+ ) ';' {*} #= dec
+ | '&#x' ( <[0..9a..fA..F]>+ ) ';' {*} #= hex
+}
+
+# 67
+token Reference {
+ <EntityRef> {*} #= EntityRef
+ | <CharRef> {*} #= CharRef
+}
+
+# 68
+token EntityRef {
+ '&' <Name> ';'
+ {*}
+}
+
+# 80
+token EncodingDecl {
+ <.S> encoding <.Eq> [ \" <EncName> \" | \' <EncName> \' ]
+}
+
+# 81
+token EncName {
+ <[A..Za..z]> <[A..Za..z0..9._\-]>*
+}
68 sax/xml/xml.pir
@@ -0,0 +1,68 @@
+# Copyright (C) 2009, Parrot Foundation.
+
+=head1 TITLE
+
+xml.pir - A Xml compiler.
+
+=head2 Description
+
+This is the base file for the Xml compiler.
+
+This file includes the parsing and grammar rules from
+the src/ directory, loads the relevant PGE libraries,
+and registers the compiler under the name 'Xml'.
+
+=head2 Functions
+
+=over 4
+
+=item onload()
+
+Creates the Xml compiler using a C<PCT::HLLCompiler>
+object.
+
+=cut
+
+.namespace [ 'Xml::Sax::Xml::Compiler' ]
+
+.sub 'onload' :anon :load :init
+ load_bytecode 'PCT.pbc'
+
+ $P0 = get_hll_global ['PCT'], 'HLLCompiler'
+ $P1 = $P0.'new'()
+ $P1.'language'('Xml')
+ $P1.'parsegrammar'('Xml::Sax::Xml::Grammar')
+ $P1.'parseactions'('Xml::Sax::Xml::Grammar::Actions')
+ $P1.'removestage'('evalpmc')
+ $P1.'removestage'('pir')
+ $P1.'removestage'('post')
+.end
+
+=item main(args :slurpy) :main
+
+Start compilation by passing any command line C<args>
+to the Xml compiler.
+
+=cut
+
+.sub 'main' :main
+ .param pmc args
+
+ $P0 = compreg 'Xml'
+ $P1 = $P0.'command_line'(args)
+.end
+
+.include 'sax/xml/gen_builtins.pir'
+.include 'sax/xml/gen_grammar.pir'
+.include 'sax/xml/gen_actions.pir'
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
35 t/00-sanity.t
@@ -0,0 +1,35 @@
+#! perl
+# Copyright (C) 2009, Parrot Foundation.
+
+=head1 some XML examples
+
+=head2 Synopsis
+
+ % perl t/00-sanity.t
+
+=head2 Description
+
+First tests in order to check infrastructure.
+
+=cut
+
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/../../../lib", "$FindBin::Bin";
+
+use Parrot::Test tests => 1;
+use Test::More;
+
+language_output_is( 'xml', <<'CODE', <<'OUT', 'ex1' );
+<elt>content</elt>
+CODE
+<elt>content</elt>
+OUT
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
107 t/Parrot/Test/Xml.pm
@@ -0,0 +1,107 @@
+# Copyright (C) 2009, Parrot Foundation.
+
+package Parrot::Test::Xml;
+
+require Parrot::Test;
+
+=head1 Testing routines specific to 'Xml'.
+
+=head2 Description
+
+Call 'Xml'.
+
+=head2 Methods
+
+=head3 new
+
+Yet another constructor.
+
+=cut
+
+use strict;
+use warnings;
+
+use File::Spec;
+
+sub new {
+ return bless {};
+}
+
+my %language_test_map = (
+ output_is => 'is_eq',
+ output_like => 'like',
+ output_isnt => 'isnt_eq',
+);
+
+foreach my $func ( keys %language_test_map ) {
+ no strict 'refs';
+
+ *{"Parrot::Test::Xml::$func"} = sub {
+ my $self = shift;
+ my ( $code, $output, $desc, %options ) = @_;
+
+ my $count = $self->{builder}->current_test + 1;
+
+ my $params = $options{params} || q{};
+
+ # flatten filenames (don't use directories)
+ my $lang_fn = File::Spec->rel2abs( Parrot::Test::per_test( '.xml', $count ) );
+ my $out_fn = File::Spec->rel2abs( Parrot::Test::per_test( '.out', $count ) );
+ my @test_prog = (
+ "$self->{parrot} languages/xml/xml.pbc $lang_fn",
+ );
+
+ # This does not create byte code, but lua code
+ Parrot::Test::write_code_to_file( $code, $lang_fn )
+ if (defined $code);
+
+ # STDERR is written into same output file
+ my $exit_code = Parrot::Test::run_command(
+ \@test_prog,
+ CD => $self->{relpath},
+ STDOUT => $out_fn,
+ STDERR => $out_fn,
+ );
+
+ my $builder_func = $language_test_map{$func};
+
+ # set a todo-item for Test::Builder to find
+ my $call_pkg = $self->{builder}->exported_to() || '';
+
+ local *{ $call_pkg . '::TODO' } = ## no critic Variables::ProhibitConditionalDeclarations
+ \$options{todo} if defined $options{todo};
+
+ # That's the reason for: no strict 'refs';
+ my $pass =
+ $self->{builder}
+ ->$builder_func( Parrot::Test::slurp_file($out_fn), $output, $desc );
+ unless ($pass) {
+ my $diag = q{};
+ my $test_prog = join ' && ', @test_prog;
+ $diag .= "'$test_prog' failed with exit code $exit_code."
+ if $exit_code;
+ $self->{builder}->diag($diag) if $diag;
+ }
+
+ # The generated files are left in the t/* directories.
+ # Let 'make clean' and 'svn:ignore' take care of them.
+
+ return $pass;
+ }
+}
+
+=head2 History
+
+Mostly taken from F<languages/lua/t/Parrot/Test/Markdown.pm>.
+
+=cut
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
16 t/harness
@@ -0,0 +1,16 @@
+#! perl
+# Copyright (C) 2009, Parrot Foundation.
+
+use strict;
+use warnings;
+use 5.008;
+
+use Parrot::Test::Harness language => 'xml';
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
66 xml.pir
@@ -0,0 +1,66 @@
+# Copyright (C) 2009, Parrot Foundation.
+
+=head1 TITLE
+
+xml.pir - A Xml demo.
+
+=head2 Description
+
+This program demonstrates the use of the modules :
+
+=over
+
+=item Xml::Sax::Xml
+
+a XML SAX like parser
+
+=item Handler::XmlWriter
+
+a simple handler
+
+=back
+
+=cut
+
+.namespace []
+
+.sub 'onload' :anon :load :init
+ load_bytecode 'languages/xml/sax/xml/xml.pbc'
+ load_bytecode 'languages/xml/handler/xmlwriter/xmlwriter.pbc'
+.end
+
+.sub 'main' :main
+ .param pmc args
+
+ .local string filename
+ $P0 = shift args # progname
+ filename = shift args
+ .local string source
+ $P0 = new 'FileHandle'
+ source = $P0.'readall'(filename)
+ $P0.'close'()
+
+ .local pmc handler
+ handler = new ['Xml';'Handler';'XmlWriter']
+ set_global 'Handler', handler
+
+ .local pmc stream
+ stream = new 'StringHandle'
+ stream.'open'( 'xml', 'wr' )
+ set_global 'Stream', stream
+
+ .local pmc driver
+ driver = compreg 'Xml'
+ driver.'parse'(source)
+
+ $S0 = stream.'readall'()
+ stream.'close'()
+ say $S0
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+

0 comments on commit a29ef43

Please sign in to comment.
Something went wrong with that request. Please try again.