[svn:parrot] r16964 - in trunk/languages/lua: lib t
Author: fperrad Date: Tue Feb 13 01:09:31 2007 New Revision: 16964 Modified: trunk/languages/lua/lib/luaregex.pir trunk/languages/lua/t/string.t Log: [Lua] - regex : add doc test Modified: trunk/languages/lua/lib/luaregex.pir == --- trunk/languages/lua/lib/luaregex.pir(original) +++ trunk/languages/lua/lib/luaregex.pirTue Feb 13 01:09:31 2007 @@ -10,6 +10,170 @@ See Lua 5.1 Reference Manual, section 5.4.1 Patterns, Lhttp://www.lua.org/manual/5.1/manual.html#5.4.1. +=head2 Character Class: + +A Icharacter class is used to represent a set of characters. The following +combinations are allowed in describing a character class: + +=over 4 + +=item Bx + +(where Ix is not one of the Imagic characters C^$()%.[]*+-?) represents +the character Ix itself. + +=item B. + +(a dot) represents all characters. + +=item B%a + +represents all letters. + +=item B%c + +represents all control characters. + +=item B%d + +represents all digits. + +=item B%l + +represents all lowercase letters. + +=item B%p + +represents all punctuation characters. + +=item B%s + +represents all space characters. + +=item B%u + +represents all uppercase letters. + +=item B%w + +represents all alphanumeric characters. + +=item B%x + +represents all hexadecimal digits. + +=item B%z + +represents the character with representation 0. + +=item B%x + +(where Ix is any non-alphanumeric character) represents the character Ix. +This is the standard way to escape the magic characters. Any punctuation +character (even the non magic) can be preceded by a C'%' when used to +represent itself in a pattern. + +=item B[set] + +represents the class which is the union of all characters in Iset. A range of +characters may be specified by separating the end characters of the range with +a C'-'. All classes C%x described above may also be used as components in +Iset. All other characters in Iset represent themselves. For example, +C[%w_] (or C[_%w]) represents all alphanumeric characters plus the +underscore, C[0-7] represents the octal digits, and C[0-7%l%-] represents +the octal digits plus the lowercase letters plus the C'-' character. + +The interaction between ranges and classes is not defined. Therefore, patterns +like C[%a-z] or C[a-%%] have no meaning. + +=item B[^set] + +represents the complement of Iset, where Iset is interpreted as above. + +=back + +For all classes represented by single letters (C%a, C%c, etc.), the +corresponding uppercase letter represents the complement of the class. For +instance, C%S represents all non-space characters. + +The definitions of letter, space, and other character groups depend on the +current locale. In particular, the class C[a-z] may not be equivalent to +C%l. + +=head2 Pattern Item: + +A Ipattern item may be + +=over 4 + +=item * + +a single character class, which matches any single character in the class; + +=item * + +a single character class followed by C'*', which matches 0 or more +repetitions of characters in the class. These repetition items will always +match the longest possible sequence; + +=item * + +a single character class followed by C'+', which matches 1 or more +repetitions of characters in the class. These repetition items will always +match the longest possible sequence; + +=item * + +a single character class followed by C'-', which also matches 0 or more +repetitions of characters in the class. Unlike C'*', these repetition items +will always match the Ishortest possible sequence; + +=item * + +a single character class followed by C'?', which matches 0 or 1 +occurrence of a character in the class; + +=item * + +C%n, for In between 1 and 9; such item matches a substring equal to +the in-th captured string (see below); + +=item * + +C%bxy, where Ix and Iy are two distinct characters; such item +matches strings that start with Ix, end with Iy, and where the Ix and +Iy are Ibalanced. This means that, if one reads the string from left to +right, counting I+1 for an Ix and I-1 for a Iy, the ending Iy is the +first Iy where the count reaches 0. For instance, the item C%b() matches +expressions with balanced parentheses. + +=back + +=head2 Pattern: + +A Ipattern is a sequence of pattern items. A C'^' at the beginning of a +pattern anchors the match at the beginning of the subject string. A C'$' at +the end of a pattern anchors the match at the end of the subject string. At +other positions, C'^' and C'$' have no special meaning and represent +themselves. + +=head2 Captures: + +A pattern may contain sub-patterns enclosed in parentheses; they describe +Icaptures. When a match succeeds, the substrings of the subject string that +match captures are stored (Icaptured) for future use. Captures are numbered +according to their left parentheses. For instance, in the pattern +C(a*(.)%w(%s*)), the part of the string matching Ca*(.)%w(%s*) is +stored as the first capture (and therefore has number 1); the character
[svn:parrot] r16966 - branches/buildtools/lib/Parrot/Ops2c
Author: jkeenan
Date: Tue Feb 13 05:38:26 2007
New Revision: 16966
Modified:
branches/buildtools/lib/Parrot/Ops2c/Utils.pm
Log:
Internal sub _print_coda() refactored into a method for consistency with other
such subs. All subs internal to print_c_header_file() are now methods.
Modified: branches/buildtools/lib/Parrot/Ops2c/Utils.pm
==
--- branches/buildtools/lib/Parrot/Ops2c/Utils.pm (original)
+++ branches/buildtools/lib/Parrot/Ops2c/Utils.pm Tue Feb 13 05:38:26 2007
@@ -187,13 +187,9 @@
$self-_print_preamble_header($HEADER);
-_print_run_core_func_decl_header( {
-trans = $self-{trans},
-fh = $HEADER,
-base= $self-{base},
-} );
+$self-_print_run_core_func_decl_header($HEADER);
-_print_coda($HEADER);
+$self-_print_coda($HEADER);
close $HEADER or die Unable to close handle to $self-{header}: $!;
(-e $self-{header}) or die $self-{header} not created: $!;
@@ -218,11 +214,10 @@
}
sub _print_run_core_func_decl_header {
-my $argsref = shift;
-if ( $argsref-{trans}-can(run_core_func_decl) ) {
+my ($self, $fh) = @_;
+if ( $self-{trans}-can(run_core_func_decl) ) {
my $run_core_func =
-$argsref-{trans}-run_core_func_decl($argsref-{base});
-my $fh = $argsref-{fh};
+$self-{trans}-run_core_func_decl($self-{base});
print $fh $run_core_func;\n;
} else {
return;
@@ -230,7 +225,7 @@
}
sub _print_coda {
-my $fh = shift;
+my ($self, $fh) = @_;
print $fh END_C;
/*
[svn:parrot] r16967 - in trunk/languages/tcl: runtime/builtin t
Author: smash
Date: Tue Feb 13 08:42:21 2007
New Revision: 16967
Modified:
trunk/languages/tcl/runtime/builtin/file.pir
trunk/languages/tcl/t/cmd_file.t
Log:
[tcl]
* implement [file dirname], check RT#40722 for details
+ added very simple tests
Modified: trunk/languages/tcl/runtime/builtin/file.pir
==
--- trunk/languages/tcl/runtime/builtin/file.pir(original)
+++ trunk/languages/tcl/runtime/builtin/file.pirTue Feb 13 08:42:21 2007
@@ -378,10 +378,54 @@
tcl_error 'wrong # args: should be file mtime name ?time?'
.end
-# RT#40722: Stub for test parsing
+# RT#40722: needs windows OS testing
.sub 'dirname'
- .param pmc argv
- .return(0)
+.param pmc argv
+
+.local int argc
+argc = elements argv
+if argc != 1 goto bad_args
+
+.local string filename
+filename = argv[0]
+
+.local string separator
+$P0 = get_root_global ['_tcl'], 'slash'
+separator = $P0
+
+$S0 = substr filename, -1, 1
+if $S0 != separator goto continue
+chopn filename, 1
+
+ continue:
+.local pmc array
+array = split separator, filename
+$S0 = pop array
+unless $S0 == '' goto skip
+push array, $S0
+
+ skip:
+$I0 = elements array
+if $I0 == 0 goto empty
+
+$P1 = new .ResizableStringArray
+ loop:
+unless array goto done
+$S0 = shift array
+if $S0 == '' goto loop
+push $P1, $S0
+goto loop
+
+ done:
+$S0 = join separator, $P1
+$S1 = concat separator, $S0 # guessing that this won't be needed in win
+.return($S1)
+
+ empty:
+.return('.')
+
+ bad_args:
+tcl_error 'wrong # args: should be file dirname name'
.end
# RT#40723: Stub (unixy)
Modified: trunk/languages/tcl/t/cmd_file.t
==
--- trunk/languages/tcl/t/cmd_file.t(original)
+++ trunk/languages/tcl/t/cmd_file.tTue Feb 13 08:42:21 2007
@@ -8,7 +8,7 @@
source lib/test_more.tcl
-plan 9 ;# from outer space. (HAH!)
+plan 13 ;# from outer space. (HAH!)
# [file exists]
eval_is {file exists} \
@@ -42,3 +42,18 @@
is [file rootname f..i.le.ext] f..i.le \
{[file rootname] filename with dots and extension}
+
+# [file dirname]
+eval_is {file dirname} \
+ {wrong # args: should be file dirname name} \
+ {[file dirname] too few args}
+eval_is {file dirname foo bar} \
+ {wrong # args: should be file dirname name} \
+ {[file dirname] too many args}
+
+is [file dirname .] . \
+ {[file dirname] dirname dot}
+
+is [file dirname file.ext] . \
+ {[file dirname] dirname simple file}
+
[svn:parrot] r16968 - trunk/config/init
Author: paultcochrane
Date: Tue Feb 13 09:11:42 2007
New Revision: 16968
Modified:
trunk/config/init/defaults.pm
Log:
[config] Converted TODO items into RT ticket numbers
Modified: trunk/config/init/defaults.pm
==
--- trunk/config/init/defaults.pm (original)
+++ trunk/config/init/defaults.pm Tue Feb 13 09:11:42 2007
@@ -189,9 +189,9 @@
);
# add profiling if needed
-# FIXME gcc syntax
+# RT#41497 gcc syntax
# we should have this in the hints files e.g. cc_profile
-# FIXME move profiling to it's own step
+# RT#41496 move profiling to it's own step
if ( $conf-options-get('profile') ) {
$conf-data-set(
cc_debug = -pg ,
[svn:parrot] r16971 - trunk
Author: particle Date: Tue Feb 13 12:33:07 2007 New Revision: 16971 Modified: trunk/RESPONSIBLE_PARTIES Log: [docs]: modify RESPONSIBLE_PARTIES to reflect role classifications, and add names to roles where known Modified: trunk/RESPONSIBLE_PARTIES == --- trunk/RESPONSIBLE_PARTIES (original) +++ trunk/RESPONSIBLE_PARTIES Tue Feb 13 12:33:07 2007 @@ -1,21 +1,58 @@ +# Copyright (C) 2007, The Perl Foundation. # $Id$ -This is a partial list of the folks with SVN commit access and the areas -they're directly responsible for. This does not list all the people with -SVN commit access, just those who have an area they've taken responsibility +This is a list of project roles, with a partial list of the folks who have +taken responsibility for them. This does not list all the people with +SVN commit access, just those who have a role they've taken responsibility for. -High-level architecture Allison Randal -Low-level arch Chip Salzenberg -JIT x86 Leopold Toetsch -JIT ppc Leopold Toetsch -JIT (others)? volunteer? -Configure Joshua Hoblitt -Garbage Collector ? volunteer? -IMCC PIR Leopold Toetsch, Vishal Soni -Debian packagingFlorian Ragwitz -Test suite Jerry Gay -Bytecode format and loader Jonathan Worthington +See docs/roles_responsibilities.pod for role definitions, and +languages/LANGUAGES.STATUS.pod for more language authors/maintainers. + + +Project Team + + +Architect Allison Randal + +PumpkingChip Salzenberg + +Release Manager Jerry Gay +Patrick Michaud +Matt Diephouse +Will Coleda +chromatic +Allison Randal + +Metacommitter Allison Randal +Chip Salzenberg +Jerry Gay +Jesse Vincent + + +Committers +-- + +Core Developer Leopold Toetsch (incl. JIT x86, ppc) +Jonathan Worthington (bytecode format/loader) + +Compiler Developer Leopold Toetsch (IMCC) +Vishal Soni (BCG, IMCC) +Patrick Michaud (PGE) + +High Level Language Developer Patrick Michaud (Perl 6) +Matt Diephouse (Tcl) +Will Coleda (Tcl) + +Build Manager Joshua Hoblitt + +Lead Tester Jerry Gay + +Platform Porter Florian Ragwitz (Debian) + + +Contributors + + +See CREDITS. -See also docs/roles_responsibilities.pod for role definitions, -and languages/LANGUAGES.STATUS.pod for language authors/maintainers.
[svn:parrot] r16972 - in trunk/languages/plumhead/src: antlr3 partridge
Author: bernhard
Date: Tue Feb 13 12:59:49 2007
New Revision: 16972
Modified:
trunk/languages/plumhead/src/antlr3/Plumhead.g
trunk/languages/plumhead/src/partridge/Plumhead.pg
trunk/languages/plumhead/src/partridge/PlumheadPAST.tg
Log:
[Plumhead partridge]
Slightly nicer register names.
Support for 'else' block.
Modified: trunk/languages/plumhead/src/antlr3/Plumhead.g
==
--- trunk/languages/plumhead/src/antlr3/Plumhead.g (original)
+++ trunk/languages/plumhead/src/antlr3/Plumhead.g Tue Feb 13 12:59:49 2007
@@ -95,7 +95,7 @@
: ECHO^ expression ';'!
| IF '(' relational_expression ')' '{' s1=statements '}'
( ELSE '{' s2=statements '}' - ^( IF relational_expression ^( STMTS $s1 )
^( STMTS $s2 ) )
-| - ^( IF relational_expression ^( STMTS $s1 ) )
+|- ^( IF relational_expression ^( STMTS $s1 )
)
)
| CODE_END SEA CODE_START - ^( ECHO NOQUOTE_STRING[$SEA] )
| SCALAR ASSIGN_OP^ expression ';'!
Modified: trunk/languages/plumhead/src/partridge/Plumhead.pg
==
--- trunk/languages/plumhead/src/partridge/Plumhead.pg (original)
+++ trunk/languages/plumhead/src/partridge/Plumhead.pg Tue Feb 13 12:59:49 2007
@@ -30,8 +30,9 @@
rule code{ ?CODE_START statement* ?CODE_END }
rule statement{ ECHO expression ;
- | IF ?PAREN_OPEN expression ?PAREN_CLOSE
\{ statement* \}
+ | IF ?PAREN_OPEN expression ?PAREN_CLOSE
\{ statement* \} else_clause?
}
+rule else_clause { ?ELSE \{ statement* \} }
token expression { DOUBLEQUOTE_STRING | SINGLEQUOTE_STRING |
adding_expression }
Modified: trunk/languages/plumhead/src/partridge/PlumheadPAST.tg
==
--- trunk/languages/plumhead/src/partridge/PlumheadPAST.tg (original)
+++ trunk/languages/plumhead/src/partridge/PlumheadPAST.tg Tue Feb 13
12:59:49 2007
@@ -11,9 +11,9 @@
past = new 'PAST::Block'
past.'init'( 'node' = node, 'name'='plumhead' )
-.local pmc cpast
-cpast = tree.'get'('past', node, 'Plumhead::Grammar::program')
-past.'push'(cpast)
+.local pmc past_program
+past_program = tree.'get'('past', node, 'Plumhead::Grammar::program')
+past.'push'(past_program)
.return (past)
}
@@ -73,31 +73,37 @@
iter = new .Iterator, $P0
iter_loop:
unless iter goto iter_end
-.local pmc cnode, cpast, cpast2, cpast3
+.local pmc cnode, past_expression, past_echo, past_if,
past_if_block, past_else_block
cnode = shift iter
if null cnode goto iter_loop
$P1 = cnode['ECHO']
if null $P1 goto no_echo
$P2 = cnode['expression']
if null $P2 goto iter_loop
- cpast = tree.'get'('past', $P2,
'Plumhead::Grammar::expression')
- if null cpast goto iter_loop
- cpast2 = new 'PAST::Op'
- cpast2.'init'( cpast, 'node'= node, 'name' =
'print' )
- past.'push'(cpast2)
+ past_expression = tree.'get'('past', $P2,
'Plumhead::Grammar::expression')
+ if null past_expression goto iter_loop
+ past_echo = new 'PAST::Op'
+ past_echo.'init'( past_expression, 'node'= node,
'name' = 'print' )
+ past.'push'(past_echo)
goto iter_loop
no_echo:
$P1 = cnode['IF']
if null $P1 goto no_if
$P2 = cnode['expression']
- if null $P2 goto iter_loop
- cpast = tree.'get'('past', $P2,
'Plumhead::Grammar::expression')
- if null cpast goto iter_loop
- cpast3 = tree.'get'('past', cnode,
'Plumhead::Grammar::code')
- cpast2 = new 'PAST::Op'
- cpast2.'init'( cpast, cpast3, 'node'= node,
'pasttype' = 'if' )
- past.'push'(cpast2)
- goto iter_loop
+ past_expression = tree.'get'('past', $P2,
'Plumhead::Grammar::expression')
+ if null past_expression goto iter_loop
+ # past_if_block takes care of the statement
+ past_if_block = tree.'get'('past', cnode,
'Plumhead::Grammar::code')
+ past_if = new 'PAST::Op'
+ past_if.'init'( past_expression, past_if_block, 'node'=
node, 'pasttype' = 'if' )
+
[svn:parrot] r16973 - in trunk/languages: . abc/t t
Author: bernhard
Date: Tue Feb 13 13:24:55 2007
New Revision: 16973
Added:
trunk/languages/abc/t/harness
- copied, changed from r16969, /trunk/languages/perl6/t/harness
Modified:
trunk/languages/LANGUAGES.STATUS.pod
trunk/languages/t/harness
Log:
Add 'abc' to languages smoke testing.
Modified: trunk/languages/LANGUAGES.STATUS.pod
==
--- trunk/languages/LANGUAGES.STATUS.pod(original)
+++ trunk/languages/LANGUAGES.STATUS.podTue Feb 13 13:24:55 2007
@@ -141,6 +141,7 @@
Almost complete.
A former implementation in languages/bc has been
removed in revision 16528.
+Part of languages smoke testing.
=item Last verified with parrot version
Copied: trunk/languages/abc/t/harness (from r16969,
/trunk/languages/perl6/t/harness)
==
--- /trunk/languages/perl6/t/harness(original)
+++ trunk/languages/abc/t/harness Tue Feb 13 13:24:55 2007
@@ -4,7 +4,4 @@
use FindBin;
use lib qw( . lib ../lib ../../lib ../../lib );
-use Parrot::Test::Harness language = 'perl6', compiler = 'perl6.pbc';
-
-# Set up PERL6LIB environment path so the use tests can find libraries
-$ENV{PERL6LIB} = $Bin/01-sanity;
+use Parrot::Test::Harness language = 'abc', compiler = 'abc.pbc';
Modified: trunk/languages/t/harness
==
--- trunk/languages/t/harness (original)
+++ trunk/languages/t/harness Tue Feb 13 13:24:55 2007
@@ -95,6 +95,7 @@
split( /\s*,\s*/, $languages_list )
:
qw( APL
+ abc
befunge
bf
cardinal
[svn:parrot] r16974 - in trunk: compilers/past-pm/PAST compilers/past-pm/POST examples/past runtime/parrot/library/Parrot t/compilers/past-pm
Author: allison
Date: Tue Feb 13 16:11:46 2007
New Revision: 16974
Modified:
trunk/compilers/past-pm/PAST/Compiler.pir
trunk/compilers/past-pm/POST/Compiler.pir
trunk/examples/past/01-sub.pir
trunk/runtime/parrot/library/Parrot/HLLCompiler.pir
trunk/t/compilers/past-pm/hllcompiler.t
Log:
[hllcompiler]: Refactor HLLCompiler to run a configurable list of
compilation stages, rather than a single fixed list. Make it possible to
change the grammar used to compile the OST (needed for Pheme).
Modified: trunk/compilers/past-pm/PAST/Compiler.pir
==
--- trunk/compilers/past-pm/PAST/Compiler.pir (original)
+++ trunk/compilers/past-pm/PAST/Compiler.pir Tue Feb 13 16:11:46 2007
@@ -37,21 +37,12 @@
.param pmc past
.param pmc adverbs :slurpy :named
-.local string target
-target = adverbs['target']
-target = downcase target
-if target == 'past' goto return_past
-if target == 'parse' goto return_past
-
.local pmc postgrammar, postbuilder, post
postgrammar = new 'POST::Grammar'
postbuilder = postgrammar.'apply'(past)
post = postbuilder.'get'('root')
-$P0 = compreg 'POST'
-.return $P0.'compile'(post, adverbs :flat :named)
+.return (post)
- return_past:
-.return (past)
.end
=back
Modified: trunk/compilers/past-pm/POST/Compiler.pir
==
--- trunk/compilers/past-pm/POST/Compiler.pir (original)
+++ trunk/compilers/past-pm/POST/Compiler.pir Tue Feb 13 16:11:46 2007
@@ -27,15 +27,10 @@
.param pmc post
.param pmc adverbs :slurpy :named
-.local string target
-target = adverbs['target']
-target = downcase target
-if target != 'post' goto compile_post
-.return (post)
-
- compile_post:
$I0 = isa post, 'POST::Sub'
if $I0 goto with_sub
+$S0 = typeof post
+say $S0
post = post.'new'('POST::Sub', post, 'name'='anon')
with_sub:
.local pmc code
@@ -44,13 +39,7 @@
post.'pir'()
code = get_hll_global ['POST'], '$!subpir'
-if target != 'pir' goto compile_pir
.return (code)
-
- compile_pir:
-$P0 = compreg 'PIR'
-$P0 = $P0(code)
-.return ($P0)
.end
Modified: trunk/examples/past/01-sub.pir
==
--- trunk/examples/past/01-sub.pir (original)
+++ trunk/examples/past/01-sub.pir Tue Feb 13 16:11:46 2007
@@ -3,6 +3,7 @@
.sub main :main
load_bytecode 'PAST-pm.pbc'
+load_bytecode 'Parrot/HLLCompiler.pbc'
.local pmc block
block = new 'PAST::Block'
@@ -26,11 +27,15 @@
$P1 = block.'push_new'('PAST::Op', $P0, 'name'='say')
# compile to PIR and display
-$S99 = block.'compile'('target'='pir')
+.local pmc astcompiler
+astcompiler = new 'HLLCompiler'
+astcompiler.'removestage'('parse')
+astcompiler.'removestage'('past')
+$S99 = astcompiler.'compile'(block, 'target'='pir')
print $S99
#compile to bytecode and execute
-$P99 = block.'compile'()
+$P99 = astcompiler.'compile'(block)
$P99()
.end
Modified: trunk/runtime/parrot/library/Parrot/HLLCompiler.pir
==
--- trunk/runtime/parrot/library/Parrot/HLLCompiler.pir (original)
+++ trunk/runtime/parrot/library/Parrot/HLLCompiler.pir Tue Feb 13 16:11:46 2007
@@ -17,6 +17,8 @@
$P0 = newclass [ 'HLLCompiler' ]
addattribute $P0, '$parsegrammar'
addattribute $P0, '$astgrammar'
+addattribute $P0, '$ostgrammar'
+addattribute $P0, '@stages'
addattribute $P0, '$!compsub'
.end
@@ -35,6 +37,11 @@
.include 'cclass.pasm'
+.sub '__init' :method
+$P0 = split ' ', 'parse past post pir run'
+setattribute self, '@stages', $P0
+.end
+
.sub 'attr' :method
.param string attrname
.param pmc value
@@ -73,6 +80,10 @@
Accessor for the Castgrammar attribute.
+=item ostgrammar([string grammar])
+
+Accessor for the 'ostgrammar' attribute.
+
=cut
.sub 'parsegrammar' :method
@@ -88,6 +99,37 @@
.return self.'attr'('$astgrammar', value, has_value)
.end
+.sub 'ostgrammar' :method
+.param string value:optional
+.param int has_value :opt_flag
+.return self.'attr'('$ostgrammar', value, has_value)
+.end
+
+=item removestage([string stagename])
+
+Delete a stage from the compilation process queue.
+
+=cut
+
+.sub 'removestage' :method
+.param string stagename:optional
+.param int has_stagename :opt_flag
+
+.local pmc stages, iter, newstages
+stages = getattribute self, '@stages'
+newstages = new .ResizableStringArray
+
+iter = new .Iterator, stages
+ iter_loop:
+unless iter goto iter_end
+.local pmc current
+current = shift iter
+if current == stagename goto iter_loop
+ push newstages, current
+goto
[svn:parrot] r16975 - in branches/buildtools: lib/Parrot/Ops2c tools/build
Author: jkeenan
Date: Tue Feb 13 19:03:08 2007
New Revision: 16975
Modified:
branches/buildtools/lib/Parrot/Ops2c/Utils.pm
branches/buildtools/tools/build/ops2c.pl
Log:
Began refactoring code blocks in ops2c.pl which print to the .c file into
Parrot::Ops2c::Utils::print_c_source_top(). (That name may change.) Passing
'make', but formal tests not yet written.
Modified: branches/buildtools/lib/Parrot/Ops2c/Utils.pm
==
--- branches/buildtools/lib/Parrot/Ops2c/Utils.pm (original)
+++ branches/buildtools/lib/Parrot/Ops2c/Utils.pm Tue Feb 13 19:03:08 2007
@@ -237,4 +237,250 @@
END_C
}
+sub print_c_source_top {
+my $self = shift;
+my $defines = $self-{trans}-defines();# Invoked as: ${defines}
+my $bs = $self-{base}$self-{suffix}_; # Also invoked as ${bs}
+my $opsarraytype= $self-{trans}-opsarraytype();
+
+# BEGIN printing to $SOURCE #
+open my $SOURCE, '', $self-{source}
+or die ops2c.pl: Cannot open source file '$self-{source}' for
writing: $!!\n;
+
+_print_preamble_source( {
+fh = $SOURCE,
+preamble= $self-{preamble},
+include = $self-{include},
+defines = $defines,
+bs = $bs,
+ops = $self-{ops},
+trans = $self-{trans},
+} );
+
+_print_ops_addr_decl( {
+trans = $self-{trans},
+fh = $SOURCE,
+bs = $bs,
+} );
+
+_print_run_core_func_decl_source( {
+trans = $self-{trans},
+fh = $SOURCE,
+base= $self-{base},
+} );
+
+# Iterate over the ops, appending HEADER and SOURCE fragments:
+my $op_funcs_ref;
+my $op_func_table_ref;
+my $cg_jump_table_ref;
+my $index;
+
+($index, $op_funcs_ref, $op_func_table_ref, $cg_jump_table_ref) =
+_iterate_over_ops( {
+ops = $self-{ops},
+trans = $self-{trans},
+opsarraytype= $opsarraytype,
+suffix = $self-{suffix},
+bs = $bs,
+sym_export = $self-{sym_export},
+} );
+
+my @op_funcs= @{$op_funcs_ref};
+my @op_func_table = @{$op_func_table_ref};
+my @cg_jump_table = @{$cg_jump_table_ref};
+
+_print_cg_jump_table( {
+fh = $SOURCE,
+cg_jump_table = [EMAIL PROTECTED],
+suffix = $self-{suffix},
+trans = $self-{trans},
+bs = $bs,
+} );
+
+_print_goto_opcode( {
+fh = $SOURCE,
+suffix = $self-{suffix},
+bs = $bs,
+} );
+
+_print_op_function_definitions( {
+fh = $SOURCE,
+op_funcs= [EMAIL PROTECTED],
+trans = $self-{trans},
+base= $self-{base},
+} );
+return ($SOURCE, [EMAIL PROTECTED], $bs, $index);
+}
+
+###
+
+sub _print_preamble_source {
+my $argsref = shift;
+my $fh = $argsref-{fh};
+
+print $fh $argsref-{preamble};
+print $fh END_C;
+#include $argsref-{include}
+
+$argsref-{defines}
+static op_lib_t $argsref-{bs}op_lib;
+
+END_C
+
+my $text = $argsref-{ops}-preamble($argsref-{trans});
+$text =~ s/\bops_addr\b/$argsref-{bs}ops_addr/g;
+print $fh $text;
+}
+
+sub _print_ops_addr_decl {
+my $argsref = shift;
+if ( $argsref-{trans}-can(ops_addr_decl) ) {
+my $fh = $argsref-{fh};
+print $fh $argsref-{trans}-ops_addr_decl($argsref-{bs});
+} else {
+return;
+}
+}
+
+sub _print_run_core_func_decl_source {
+my $argsref = shift;
+if ( $argsref-{trans}-can(run_core_func_decl) ) {
+my $fh = $argsref-{fh};
+print $fh $argsref-{trans}-run_core_func_decl($argsref-{base});
+print $fh \n{\n;
+print $fh $argsref-{trans}-run_core_func_start;
+} else {
+return;
+}
+}
+
+sub _iterate_over_ops {
+my $argsref = shift;
+my @op_funcs;
+my @op_func_table;
+my @cg_jump_table;
+my $index = 0;
+my ( $prev_src, $prev_index );
+
+$prev_src = '';
+foreach my $op ( $argsref-{ops}-ops ) {
+my $func_name = $op-func_name($argsref-{trans});
+my $arg_types = $argsref-{opsarraytype} *, Interp *;
+my $prototype = $argsref-{sym_export} $argsref-{opsarraytype} *
$func_name ($arg_types);
+my $args = $argsref-{opsarraytype} *cur_opcode, Interp *interp;
+my $definition;
+my $comment = '';
+my $one_op = ;
+
+if ( $argsref-{suffix} =~ /cg/ ) {
+$definition = PC_$index:;
+$comment= /* . $op-full_name() . */;
+}
+elsif ( $argsref-{suffix} =~ /switch/ ) {
+$definition = case $index:;
+$comment= /* . $op-full_name() . */;
+}
+else {
+$definition =
[svn:parrot] r16976 - branches/buildtools/t/tools/ops2cutils
Author: jkeenan
Date: Tue Feb 13 20:29:04 2007
New Revision: 16976
Added:
branches/buildtools/t/tools/ops2cutils/04-print_c_source_top.t
Log:
Created t/04-print_c_source_top.t to hold tests for
Parrot::Ops2c::Utils::print_c_source_top(): the first part of the
functionality in tools/build/ops2c.pl that prints to a .c file.
Added: branches/buildtools/t/tools/ops2cutils/04-print_c_source_top.t
==
--- (empty file)
+++ branches/buildtools/t/tools/ops2cutils/04-print_c_source_top.t Tue Feb
13 20:29:04 2007
@@ -0,0 +1,143 @@
+#! perl
+# Copyright (C) 2006, The Perl Foundation.
+# $Id: 04-print_c_source_top.t 16962 2007-02-13 03:38:24Z jkeenan $
+# 04-print_c_source_top.t
+
+use strict;
+use warnings;
+BEGIN {
+use FindBin qw($Bin);
+use Cwd qw(cwd realpath);
+realpath($Bin) =~ m{^(.*\/parrot)\/[^/]*\/[^/]*\/[^/]*$};
+our $topdir = $1;
+if (defined $topdir) {
+print \nOK: Parrot top directory located\n;
+} else {
+$topdir = realpath($Bin) . /../../..;
+}
+unshift @INC, qq{$topdir/lib};
+}
+use Test::More qw(no_plan); # tests = 26;
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Temp (qw| tempdir |);
+use_ok( 'Parrot::Ops2pm::Utils' );
+use lib ($main::topdir/t/tools/ops2cutils/testlib);
+use_ok( Capture );
+use_ok( GenerateCore, qw| generate_core | );
+
+my @srcopsfiles = qw( src/ops/core.ops src/ops/bit.ops src/ops/cmp.ops
+src/ops/debug.ops src/ops/experimental.ops src/ops/io.ops src/ops/math.ops
+src/ops/object.ops src/ops/pic.ops src/ops/pmc.ops src/ops/set.ops
+src/ops/stack.ops src/ops/stm.ops src/ops/string.ops src/ops/sys.ops
+src/ops/var.ops );
+my $num = src/ops/ops.num;
+my $skip = src/ops/ops.skip;
+
+ok(chdir $main::topdir, Positioned at top-level Parrot directory);
+my $cwd = cwd();
+my ($msg, $tie);
+
+{
+my $tdir = tempdir( CLEANUP = 1 );
+ok(chdir $tdir, 'changed to temp directory for testing');
+
+my $tlib = generate_core(
+$cwd, $tdir, [EMAIL PROTECTED], $num, $skip);
+
+ok(-d $tlib, lib directory created under tempdir);
+unshift @INC, $tlib;
+require Parrot::Ops2c::Utils;
+
+{
+local @ARGV = qw( C CGoto CGP CSwitch CPrederef );
+my $self = Parrot::Ops2c::Utils-new( {
+argv= [ @ARGV ],
+flag= { core = 1 },
+} );
+ok(defined $self,
+Constructor correctly returned when provided = 1 arguments);
+
+my $c_header_file = $self-print_c_header_file();
+ok(-e $c_header_file, $c_header_file created);
+ok(-s $c_header_file, $c_header_file has non-zero size);
+
+my ($SOURCE, $op_func_table_ref, $bs, $index) =
+$self-print_c_source_top();
+is(ref($SOURCE), q{GLOB}, Argument type is filehandle (typeglob));
+is(ref($op_func_table_ref), q{ARRAY}, Array reference noted);
+is($bs, q{core_}, 'core_' identified);
+like($index, qr/^\d+$/, \$index is numeric);
+}
+
+ok(chdir($cwd), returned to starting directory);
+}
+
+
+pass(Completed all tests in $0);
+
+sub test_single_trans_and_header {
+my $trans = shift;
+my %available = map {$_, 1} qw( C CGoto CGP CSwitch CPrederef );
+croak Bad argument $trans to test_single_trans()
+unless $available{$trans};
+
+my $self = Parrot::Ops2c::Utils-new( {
+argv= [ $trans ],
+flag= { core = 1 },
+} );
+ok(defined $self,
+Constructor correct when provided with single argument $trans);
+my $c_header_file = $self-print_c_header_file();
+ok(-e $c_header_file, $c_header_file created);
+ok(-s $c_header_file, $c_header_file has non-zero size);
+}
+
+### DOCUMENTATION ###
+
+=head1 NAME
+
+04-print_c_source_top.t - test CParrot::Ops2c::Utils::new()
+
+=head1 SYNOPSIS
+
+% prove t/tools/ops2cutils/04-print_c_source_top.t
+
+=head1 DESCRIPTION
+
+The files in this directory test the publicly callable subroutines of
+Flib/Parrot/Ops2c/Utils.pm and Flib/Parrot/Ops2c/Auxiliary.pm.
+By doing so, they test the functionality of the Fops2c.pl utility.
+That functionality has largely been extracted
+into the methods of FUtils.pm.
+
+F04-print_c_source_top.t tests whether
+CParrot::Ops2c::Utils::print_c_source_top() work properly.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+Parrot::Ops2c::Auxiliary, Fops2c.pl.
+
+=cut
+
+__END__
+
+#$VAR1 = [];
+#$VAR2 = bless( {
+# 'split_count' = 0
+# }, 'Parrot::OpTrans::CSwitch' );
+#$VAR3 = '_switch';
+#/usr/local/bin/perl tools/build/vtable_extend.pl
+#/usr/local/bin/perl tools/build/ops2c.pl CGoto --core
+#$VAR1 = [];
+#$VAR2 = bless( {}, 'Parrot::OpTrans::CGoto' );
+#$VAR3 = '_cg';
+#/usr/local/bin/perl tools/build/ops2c.pl CGP --core
+#$VAR1 = [];
+#$VAR2 = bless( {}, 'Parrot::OpTrans::CGP' );
+#$VAR3 = '_cgp';
[svn:parrot] r16977 - branches/buildtools/t/tools/ops2cutils
Author: jkeenan Date: Tue Feb 13 20:30:06 2007 New Revision: 16977 Modified: branches/buildtools/t/tools/ops2cutils/04-print_c_source_top.t (props changed) Log: Added svn:keywords Id property.
