Author: Whiteknight
Date: Tue Jul 29 14:30:55 2008
New Revision: 29864
Added:
branches/gsoc_pdd09/docs/pdds/pdd19_pir.pod
- copied unchanged from r29862, /trunk/docs/pdds/pdd19_pir.pod
Removed:
branches/gsoc_pdd09/docs/pdds/draft/pdd19_pir.pod
Modified:
branches/gsoc_pdd09/MANIFEST
branches/gsoc_pdd09/languages/cardinal/src/classes/Object.pir
branches/gsoc_pdd09/languages/perl6/ROADMAP
branches/gsoc_pdd09/languages/perl6/src/builtins/io.pir
branches/gsoc_pdd09/languages/perl6/src/classes/IO.pir
branches/gsoc_pdd09/languages/perl6/src/classes/Object.pir
branches/gsoc_pdd09/languages/perl6/src/classes/Range.pir
branches/gsoc_pdd09/languages/perl6/src/parser/actions.pm
branches/gsoc_pdd09/languages/perl6/t/spectest_regression.data
branches/gsoc_pdd09/languages/tcl/TODO
branches/gsoc_pdd09/languages/tcl/lib/skipped_tests.tcl
branches/gsoc_pdd09/languages/tcl/runtime/builtin/array.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/binary.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/clock.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/dict.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/encoding.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/file.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/fileevent.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/for.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/info.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/join.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/lassign.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/lsearch.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/namespace.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/proc.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/regexp.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/regsub.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/string.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/subst.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/time.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/uplevel.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/upvar.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/while.pir
branches/gsoc_pdd09/languages/tcl/runtime/conversions.pir
branches/gsoc_pdd09/languages/tcl/runtime/options.pir
branches/gsoc_pdd09/languages/tcl/runtime/string_to_list.pir
branches/gsoc_pdd09/languages/tcl/runtime/tcllib.pir
branches/gsoc_pdd09/languages/tcl/src/binary.c
branches/gsoc_pdd09/languages/tcl/src/class/tclconst.pir
branches/gsoc_pdd09/languages/tcl/src/grammar/expr/past.pir
branches/gsoc_pdd09/languages/tcl/src/grammar/expr/past2pir.tg
branches/gsoc_pdd09/languages/tcl/src/pmc/tcllist.pmc
branches/gsoc_pdd09/languages/tcl/src/pmc/tclobject.pmc
branches/gsoc_pdd09/languages/tcl/src/pmc/tclstring.pmc
branches/gsoc_pdd09/languages/tcl/src/tclsh.pir
branches/gsoc_pdd09/languages/tcl/t/internals/select_option.t
branches/gsoc_pdd09/languages/tcl/t/internals/select_switches.t
branches/gsoc_pdd09/src/pmc/class.pmc
branches/gsoc_pdd09/t/doc/pod.t
Log:
[gsoc_pdd09] update to trunk r29862
Modified: branches/gsoc_pdd09/MANIFEST
==============================================================================
--- branches/gsoc_pdd09/MANIFEST (original)
+++ branches/gsoc_pdd09/MANIFEST Tue Jul 29 14:30:55 2008
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Mon Jul 28 02:54:53 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Tue Jul 29 19:45:13 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -473,7 +473,6 @@
docs/pdds/draft/pdd11_extending.pod [main]doc
docs/pdds/draft/pdd14_bignum.pod [main]doc
docs/pdds/draft/pdd16_native_call.pod [main]doc
-docs/pdds/draft/pdd19_pir.pod [main]doc
docs/pdds/draft/pdd29_compiler_tools.pod [main]doc
docs/pdds/pdd00_pdd.pod [main]doc
docs/pdds/pdd03_calling_conventions.pod [main]doc
@@ -485,6 +484,7 @@
docs/pdds/pdd15_objects.pod [main]doc
docs/pdds/pdd17_pmc.pod [main]doc
docs/pdds/pdd18_security.pod [main]doc
+docs/pdds/pdd19_pir.pod [main]doc
docs/pdds/pdd20_lexical_vars.pod [main]doc
docs/pdds/pdd21_namespaces.pod [main]doc
docs/pdds/pdd22_io.pod [main]doc
Modified: branches/gsoc_pdd09/languages/cardinal/src/classes/Object.pir
==============================================================================
--- branches/gsoc_pdd09/languages/cardinal/src/classes/Object.pir
(original)
+++ branches/gsoc_pdd09/languages/cardinal/src/classes/Object.pir Tue Jul
29 14:30:55 2008
@@ -140,7 +140,7 @@
$P0 = cardinalmeta.get_parrotclass(self)
$P1 = $P0.'new'()
$P2 = $P1.'HOW'()
- $I0 = $P2.can('initialize')
+ $I0 = $P2.can(self,'initialize')
unless $I0, no_initialize
$P2 = $P1.'initialize'(args :flat, named_args :named :flat)
no_initialize:
Modified: branches/gsoc_pdd09/languages/perl6/ROADMAP
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/ROADMAP (original)
+++ branches/gsoc_pdd09/languages/perl6/ROADMAP Tue Jul 29 14:30:55 2008
@@ -3,22 +3,21 @@
Milestones
----------
-This is a rough list of the major components to be added to Rakudo
-over the next few months:
+This is a rough list of some of the major components to be added to Rakudo.
* list context, list assignment
-* return and control exceptions
+* multi-argument return and control exceptions
* class, role, objects
* regex, token, rule, grammar
* selected libraries written in Perl 6
* modules
* I/O
-* junctions
-* hyper, reduction operators
-* lazy lists
-* slices
-* multi sub & multi-method dispatch
+* junction auto-threading
+* hyper, reduction and cross meta-operators
+* lazy lists, gather and take
+* slices and slice context
* captures and signature handling
+* multi sub & multi-method dispatch
* currying
* operator overloading
* other S09 features (typed arrays, sized types)
@@ -33,4 +32,42 @@
for people to work on some of the later milestones even if the
earlier ones aren't complete.
+In addition to the above list of major features, the following list contains
+various smaller tasks that we should accomplish to get the number of tests in
+spectest_regression that we are currently skipping down somewhat. Some of
+them are probably good if you are looking for a more gentle entry point to
+Rakudo development than some of the bigger items listed above.
+* Implement whatever (*) in array indexing: @foo[*-1]
+* Implement Rat data type
+* Implement infinite ranges
+* Implement return type co-ercion ("as") and constraint ("of")
+* Fix issues with Int type constraint when we get an Integer PMC back, and
+ similar
+* Implement {} hash composer
+* Implement prefix:<\> operator
+* Finish implementing radix notation (see S02-literals/radix.t for details)
+* Implement eqv and === operators
+* Implement .perl on code objects
+* Investigate various issues with .perl on recursive data structures (see
+ S02-names_and_variables/perl.t)
+* Make junctions in boolean context return a junction of True/False
+* Investigate junction of code object failures (S03-junctions/misc.t)
+* Implement missing infix:<xx=> operator
+* Fix modulo bugs and MMD-related bugs for += and -= (S03-operators\arith.t)
+* Implement NaN and Inf
+* Empty contextualizer @() should be same as @($/)
+* Fix MMD-related bugs in S03-operators\range.t
+* Implement inifx:<orelse>
+* Fix bugs with nested ?? !!
+* Implement state variables
+* Implement last/redo/next/continue control exceptions
+* Fix .{"key"} parsefail when (hash index into $_)
+* Finish implementing given and check/fix tests in S04-statements\given.t
+* Implement CATCH blocks
+* Implement loops and conditionals taking pointy blocks
+* Make m/.../ syntax for constructing a regex work
+* Fix problem with using Str as a type constraint or in MMD
+* Fix lambda expression parse bug when used as rvalue
+* Implement ::?CLASS
+* Implement/fix adverbial blocks
Modified: branches/gsoc_pdd09/languages/perl6/src/builtins/io.pir
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/src/builtins/io.pir (original)
+++ branches/gsoc_pdd09/languages/perl6/src/builtins/io.pir Tue Jul 29
14:30:55 2008
@@ -35,6 +35,24 @@
.end
+=item printf
+
+Parses a format string and prints formatted output according to it.
+
+=cut
+
+.sub 'printf' :method
+ .param pmc args :slurpy
+
+ args.'!flatten'()
+ $P0 = new 'Str'
+ sprintf $P0, self, args
+
+ print $P0
+ .return (1)
+.end
+
+
.sub 'use'
.param pmc module
.param pmc args :slurpy
Modified: branches/gsoc_pdd09/languages/perl6/src/classes/IO.pir
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/src/classes/IO.pir (original)
+++ branches/gsoc_pdd09/languages/perl6/src/classes/IO.pir Tue Jul 29
14:30:55 2008
@@ -62,6 +62,26 @@
.end
+=item printf
+
+Parses a format string and prints formatted output according to it.
+
+=cut
+
+.sub 'printf' :method
+ .param pmc args :slurpy
+ .local pmc PIO
+ PIO = getattribute self, "$!PIO"
+
+ args.'!flatten'()
+ $P0 = new 'Str'
+ sprintf $P0, self, args
+
+ print PIO, $P0
+ .return (1)
+.end
+
+
=item readline
Reads a line from the file handle.
@@ -90,6 +110,24 @@
.end
+=item eof
+
+Tests if we have reached the end of the file.
+
+=cut
+
+.sub 'eof' :method
+ .local pmc PIO
+ PIO = getattribute self, "$!PIO"
+ if PIO goto not_eof
+ $P0 = get_hll_global [ 'Bool' ], 'True'
+ .return ($P0)
+ not_eof:
+ $P0 = get_hll_global [ 'Bool' ], 'False'
+ .return ($P0)
+.end
+
+
=item close
Closes the file.
@@ -146,7 +184,7 @@
.return(1)
.end
-.sub shift_pmc :method :vtable
+.sub 'item' :method :vtable('shift_pmc')
.local pmc pio
$P0 = getattribute self, "$!IO"
pio = getattribute $P0, "$!PIO"
@@ -154,7 +192,11 @@
.return($P0)
.end
-.sub get_iter :method :vtable
+.sub 'get_string' :vtable
+ .return self.'item'()
+.end
+
+.sub 'get_iter' :method :vtable
.return(self)
.end
Modified: branches/gsoc_pdd09/languages/perl6/src/classes/Object.pir
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/src/classes/Object.pir (original)
+++ branches/gsoc_pdd09/languages/perl6/src/classes/Object.pir Tue Jul 29
14:30:55 2008
@@ -304,6 +304,17 @@
.return 'prefix:?'(self)
.end
+=item get_bool (vtable)
+
+Returns true if the object is defined, false otherwise.
+
+=cut
+
+.sub '' :vtable('get_bool')
+ $I0 = 'defined'(self)
+ .return ($I0)
+.end
+
=item print()
=item say()
Modified: branches/gsoc_pdd09/languages/perl6/src/classes/Range.pir
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/src/classes/Range.pir (original)
+++ branches/gsoc_pdd09/languages/perl6/src/classes/Range.pir Tue Jul 29
14:30:55 2008
@@ -50,17 +50,35 @@
=item ACCEPTS(topic)
-Determines if topic is within the range.
+Determines if topic is within the range or equal to the range.
=cut
.sub 'ACCEPTS' :method
.param pmc topic
+ $I0 = isa topic, 'Range'
+ unless $I0 goto value_in_range_check
+ $I0 = self.'from'()
+ $I1 = topic.'from'()
+ if $I0 != $I1 goto false
+ $I0 = self.'to'()
+ $I1 = topic.'to'()
+ if $I0 != $I1 goto false
+ $P0 = getattribute self, "$!from_exclusive"
+ $P1 = getattribute topic, "$!from_exclusive"
+ if $P0 != $P1 goto false
+ $P0 = getattribute self, "$!to_exclusive"
+ $P1 = getattribute topic, "$!to_exclusive"
+ if $P0 != $P1 goto false
+ goto true
+
+ value_in_range_check:
$I0 = self.'!from_test'(topic)
unless $I0 goto false
$I0 = self.'!to_test'(topic)
unless $I0 goto false
+
true:
$P0 = get_hll_global ['Bool'], 'True'
.return ($P0)
Modified: branches/gsoc_pdd09/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/src/parser/actions.pm (original)
+++ branches/gsoc_pdd09/languages/perl6/src/parser/actions.pm Tue Jul 29
14:30:55 2008
@@ -493,6 +493,19 @@
}
elsif $key eq 'method' {
$past := $($<method_def>);
+
+ # Add declaration of leixcal self.
+ $past[0].unshift(PAST::Op.new(
+ :pasttype('bind'),
+ PAST::Var.new(
+ :name('self'),
+ :scope('lexical'),
+ :isdecl(1)
+ ),
+ PAST::Op.new(:inline(" %r = self\n"))
+ ));
+
+ # Set up the block details.
$past.blocktype('method');
set_block_proto($past, 'Method');
if $<method_def><multisig> {
@@ -1344,7 +1357,11 @@
method noun($/, $key) {
my $past;
if $key eq 'self' {
- $past := PAST::Stmts.new( PAST::Op.new( :inline('%r = self'), :node(
$/ ) ) );
+ $past := PAST::Var.new(
+ :name('self'),
+ :scope('lexical'),
+ :node($/)
+ );
}
elsif $key eq 'dotty' {
# Call on $_.
@@ -2145,8 +2162,10 @@
:node($/),
:pasttype('callmethod'),
:name($name),
- PAST::Op.new(
- :inline('%r = self')
+ PAST::Var.new(
+ :name('self'),
+ :scope('lexical'),
+ :node($/)
)
);
}
Modified: branches/gsoc_pdd09/languages/perl6/t/spectest_regression.data
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/t/spectest_regression.data
(original)
+++ branches/gsoc_pdd09/languages/perl6/t/spectest_regression.data Tue Jul
29 14:30:55 2008
@@ -73,6 +73,7 @@
S12-role/attributes.t
S12-role/composition.t
S12-role/mixin.t
+S16-io/basic-open.t
S16-io/say.t
S29-any/cmp.t
S29-array/delete.t
Modified: branches/gsoc_pdd09/languages/tcl/TODO
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/TODO (original)
+++ branches/gsoc_pdd09/languages/tcl/TODO Tue Jul 29 14:30:55 2008
@@ -1,2 +1,5 @@
All bugs and todo items should be documented in partcl's issue tracker at:
http://code.google.com/p/partcl/issues/list
+
+... But not everything is: any TODO'd items in t/*.t need fixing, as do any
+spec tests that are TODO'd or SKIP'd in lib/skipped_tests.tcl
Modified: branches/gsoc_pdd09/languages/tcl/lib/skipped_tests.tcl
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/lib/skipped_tests.tcl (original)
+++ branches/gsoc_pdd09/languages/tcl/lib/skipped_tests.tcl Tue Jul 29
14:30:55 2008
@@ -29,9 +29,11 @@
} {stacktrace support} {
apply-2.[2345] apply-5.1
cmdMZ-return-2.10 cmdMZ-5.7
+ eval-2.5
if-5.3 if-6.4
incr-2.3[01]
incr-old-2.[45]
+ misc-1.2
parse-9.[12] parseOld-10.14
set-[24].1
switch-4.[15]
@@ -106,6 +108,13 @@
cmdMZ-return-2.[0123] cmdMZ-return-2.11 cmdMZ-return-3.*
} {reset $errorCode} {
cmdMZ-4.[12]
+ } {Inf support} {
+ scan-14.[12]
+ } {[scan]} {
+ scan-1.9 scan-3.[389] scan-4.8 scan-4.1[02345679] scan-4.2[3679]
+ scan-4.3[2345789] scan-4.40.[12] scan-4.4[03478] scan-4.5[0123589]
+ scan-4.6[012] scan-5.[123456789] scan-5.1[01234] scan-6.[12345678]
+ scan-7.[345] scan-8.1[0156] scan-10.2 scan-12.[45] scan-13.[56]
}
]
@@ -120,9 +129,7 @@
basic-46.1
dict-14.12 dict-17.13
error-1.3 error-2.3 error-2.6 error-4.2 error-4.3 error-4.4
- eval-2.5
iocmd-12.6
- misc-1.2
namespace-8.5 namespace-8.6 namespace-25.6 namespace-25.7 namespace-25.8
namespace-47.2 namespace-47.4 namespace-47.6 namespace-46.5
proc-old-5.13 proc-old-5.16 proc-old-7.2 proc-old-7.11 proc-old-7.12
@@ -193,7 +200,6 @@
expr-41.1 expr-45.7
expr-old-26.10b expr-old-34.11 expr-old-34.12b expr-old-34.11
expr-old-34.10
- scan-14.1 scan-14.2
} {NaN support} {
expr-22.1 expr-22.3 expr-22.5 expr-22.7 expr-22.9 expr-45.8 expr-45.9
expr-47.3
@@ -280,6 +286,8 @@
# stored as an array of test name -> reason pairs.
array set abort_after {
+ misc-1.2 {300 nearly identical failing tests that require tcltest support}
+
parseExpr-20.3 {src/string.c:1109: failed assertion 'src->encoding ==
Parrot_fixed_8_encoding_ptr'}
assocd-1.1 {}
async-1.1 {}
@@ -303,7 +311,6 @@
link-1.1 {}
macOSXFCmd-1.1 {}
mathop-1.1 {}
- misc-1.1 {}
msgcat-0.0 {}
obj-1.1 {}
opt-1.1 {don't have the opt package available}
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/array.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/array.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/array.pir Tue Jul 29
14:30:55 2008
@@ -21,7 +21,7 @@
subcommand_name = shift argv
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
options[0] = 'anymore'
options[1] = 'donesearch'
options[2] = 'exists'
@@ -403,7 +403,7 @@
iter = new 'Iterator', the_array
- retval = new 'String'
+ retval = new 'TclString'
retval = ''
check_loop:
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/binary.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/binary.pir
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/binary.pir Tue Jul
29 14:30:55 2008
@@ -13,7 +13,7 @@
subcommand_name = shift argv
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
push options, 'format'
push options, 'scan'
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/clock.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/clock.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/clock.pir Tue Jul 29
14:30:55 2008
@@ -13,7 +13,7 @@
subcommand_name = shift argv
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
push options, 'add'
push options, 'clicks'
push options, 'format'
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/dict.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/dict.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/dict.pir Tue Jul 29
14:30:55 2008
@@ -16,7 +16,7 @@
subcommand_name = shift argv
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
options[0] = 'append'
options[1] = 'create'
options[2] = 'exists'
@@ -107,7 +107,7 @@
$S2 = value
$S2 .= $S1
.local pmc stringy
- stringy = new 'String'
+ stringy = new 'TclString'
stringy = $S2
copy value, stringy
goto loop
@@ -887,8 +887,8 @@
body = pop argv
.local pmc keys,varnames
- keys = new 'ResizablePMCArray'
- varnames = new 'ResizablePMCArray'
+ keys = new 'TclList'
+ varnames = new 'TclList'
# get lists of both keys & varnames, setting the variables.
key_loop:
$I0 = elements argv
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/encoding.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/encoding.pir
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/encoding.pir Tue Jul
29 14:30:55 2008
@@ -16,7 +16,7 @@
subcommand_name = shift argv
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
push options, 'convertfrom'
push options, 'convertto'
push options, 'dirs'
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/file.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/file.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/file.pir Tue Jul 29
14:30:55 2008
@@ -13,7 +13,7 @@
subcommand_name = shift argv
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
push options, 'atime'
push options, 'attributes'
push options, 'channels'
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/fileevent.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/fileevent.pir
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/fileevent.pir Tue Jul
29 14:30:55 2008
@@ -36,7 +36,7 @@
.local pmc events
events = get_root_global ['_tcl'], 'events'
- $P0 = new 'ResizablePMCArray'
+ $P0 = new 'TclList'
push events, $P0
push $P0, channel
push $P0, script
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/for.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/for.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/for.pir Tue Jul 29
14:30:55 2008
@@ -12,6 +12,7 @@
compileTcl = get_root_global ['_tcl'], 'compileTcl'
.local pmc compileExpr
compileExpr = get_root_global ['_tcl'], 'compileExpr'
+
.local pmc a_start
a_start = argv[0]
a_start = compileTcl(a_start)
@@ -24,23 +25,22 @@
.local pmc a_command
a_command = argv[3]
a_command = compileTcl(a_command)
- .local pmc R
.local pmc temp
.local pmc toBoolean
toBoolean = get_root_global ['_tcl'], 'toBoolean'
-temp = a_start()
+ a_start()
+
loop:
-temp = a_test()
- $P0 = temp
- $I0 = toBoolean($P0)
+ temp = a_test()
+ $I0 = toBoolean(temp)
unless $I0 goto done
push_eh command_exception
-temp = a_command()
+ a_command()
pop_eh
continue:
push_eh next_exception
-temp = a_next()
+ a_next()
pop_eh
goto loop
@@ -58,9 +58,7 @@
.rethrow()
done:
- R = new 'String'
- R = ''
- .return(R)
+ .return('')
bad_args:
tcl_error 'wrong # args: should be "for start test next command"'
.end
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/info.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/info.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/info.pir Tue Jul 29
14:30:55 2008
@@ -18,7 +18,7 @@
subcommand_name = shift argv
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
push options, 'args'
push options, 'body'
push options, 'cmdcount'
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/join.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/join.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/join.pir Tue Jul 29
14:30:55 2008
@@ -1,3 +1,6 @@
+.HLL 'Tcl', 'tcl_group'
+.namespace []
+
.sub '&join'
.param pmc argv :slurpy
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/lassign.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/lassign.pir
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/lassign.pir Tue Jul
29 14:30:55 2008
@@ -29,7 +29,7 @@
if argv goto var_loop
list_empty:
- value = new 'String'
+ value = new 'TclString'
value = ''
null_loop:
unless argv goto var_end
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/lsearch.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/lsearch.pir
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/lsearch.pir Tue Jul
29 14:30:55 2008
@@ -7,7 +7,7 @@
.param pmc argv :slurpy
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
push options, 'all'
push options, 'ascii'
push options, 'decreasing'
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/namespace.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/namespace.pir
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/namespace.pir Tue Jul
29 14:30:55 2008
@@ -24,7 +24,7 @@
subcommand_name = shift argv
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
options[0] = 'children'
options[1] = 'code'
options[2] = 'current'
@@ -234,7 +234,7 @@
.local pmc call_chain, temp_call_chain
call_chain = get_root_global ['_tcl'], 'call_chain'
- temp_call_chain = new 'ResizablePMCArray'
+ temp_call_chain = new 'TclList'
set_root_global ['_tcl'], 'call_chain', temp_call_chain
.local pmc info_level
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/proc.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/proc.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/proc.pir Tue Jul 29
14:30:55 2008
@@ -36,7 +36,7 @@
.local pmc ns
.local string name
- ns = new 'ResizablePMCArray'
+ ns = new 'TclList'
name = ''
if full_name == '' goto create
@@ -240,17 +240,17 @@
$P1 = new 'TclProc'
assign $P1, $P0
- $P9 = new 'String'
+ $P9 = new 'TclString'
$P9 = $S0
setattribute $P1, 'PIR_source', $P9
- $P9 = new 'String'
+ $P9 = new 'TclString'
$P9 = 'Tcl'
setattribute $P1, 'HLL', $P9
setattribute $P1, 'HLL_source', body
- $P9 = new 'String'
+ $P9 = new 'TclString'
$P9 = args_info
setattribute $P1, 'args', $P9
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/regexp.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/regexp.pir
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/regexp.pir Tue Jul
29 14:30:55 2008
@@ -9,7 +9,7 @@
if argc < 2 goto badargs
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
push options, 'all'
push options, 'about'
push options, 'indices'
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/regsub.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/regsub.pir
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/regsub.pir Tue Jul
29 14:30:55 2008
@@ -11,7 +11,7 @@
.local string expression, target, subSpec, original_target
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
push options, 'all'
push options, 'nocase'
push options, 'expanded' # RT#40774: use tcl-regexps
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/string.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/string.pir
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/string.pir Tue Jul
29 14:30:55 2008
@@ -16,7 +16,7 @@
subcommand_name = shift argv
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
push options, 'bytelength'
push options, 'compare'
push options, 'equal'
@@ -649,7 +649,7 @@
the_string = argv[1]
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
push options, 'alnum'
push options, 'alpha'
push options, 'ascii'
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/subst.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/subst.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/subst.pir Tue Jul 29
14:30:55 2008
@@ -5,7 +5,7 @@
.param pmc argv :slurpy
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
options[0] = 'nobackslashes'
options[1] = 'nocommands'
options[2] = 'novariables'
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/time.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/time.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/time.pir Tue Jul 29
14:30:55 2008
@@ -1,3 +1,6 @@
+.HLL 'Tcl', 'tcl_group'
+.namespace []
+
.sub '&time'
.param pmc argv :slurpy
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/uplevel.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/uplevel.pir
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/uplevel.pir Tue Jul
29 14:30:55 2008
@@ -42,7 +42,7 @@
difference = call_level - $I0
.local pmc saved_call_chain
- saved_call_chain = new 'ResizablePMCArray'
+ saved_call_chain = new 'TclList'
$I0 = 0
save_chain_loop:
if $I0 == difference goto save_chain_end
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/upvar.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/upvar.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/upvar.pir Tue Jul 29
14:30:55 2008
@@ -58,7 +58,7 @@
store_var:
.local pmc saved_call_chain
- saved_call_chain = new 'ResizablePMCArray'
+ saved_call_chain = new 'TclList'
$I0 = 0
save_chain_loop:
if $I0 == difference goto save_chain_end
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/while.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/while.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/while.pir Tue Jul 29
14:30:55 2008
@@ -1,3 +1,6 @@
+.HLL 'Tcl', 'tcl_group'
+.namespace []
+
.sub '&while'
.param pmc argv :slurpy
Modified: branches/gsoc_pdd09/languages/tcl/runtime/conversions.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/conversions.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/conversions.pir Tue Jul 29
14:30:55 2008
@@ -594,14 +594,14 @@
.sub getCallLevel
.param pmc tcl_level
.local pmc parrot_level, defaulted, orig_level
- defaulted = new 'Integer'
+ defaulted = new 'TclInt'
defaulted = 0
.local pmc call_chain
.local int call_level
call_chain = get_root_global ['_tcl'], 'call_chain'
call_level = elements call_chain
- orig_level = new 'Integer'
+ orig_level = new 'TclInt'
orig_level = call_level
.local int num_length
@@ -627,7 +627,7 @@
default:
defaulted = 1
- parrot_level = new 'Integer'
+ parrot_level = new 'TclInt'
parrot_level = orig_level - 1
# fallthrough.
Modified: branches/gsoc_pdd09/languages/tcl/runtime/options.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/options.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/options.pir Tue Jul 29
14:30:55 2008
@@ -26,7 +26,7 @@
got_type_name:
.local pmc partials
- partials = new 'ResizablePMCArray'
+ partials = new 'TclList'
# is there an exact match?
@@ -211,7 +211,7 @@
# delete any processed switches from the argv
if pos <= 0 goto done
- $P1 = new 'ResizablePMCArray'
+ $P1 = new 'TclList'
splice argv, $P1, 0, pos
done:
Modified: branches/gsoc_pdd09/languages/tcl/runtime/string_to_list.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/string_to_list.pir
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/string_to_list.pir Tue Jul
29 14:30:55 2008
@@ -25,7 +25,6 @@
$S0 = typeof $P2
if $S0 == 'TclConst' goto is_string
if $S0 == 'TclString' goto is_string
- if $S0 == 'String' goto is_string
is_list:
$P2 = listToDict($P2)
result[$S1] = $P2
Modified: branches/gsoc_pdd09/languages/tcl/runtime/tcllib.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/tcllib.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/tcllib.pir Tue Jul 29
14:30:55 2008
@@ -183,19 +183,19 @@
# Eventually, we'll need to register MMD for the various Tcl PMCs
# (Presuming we don't do this from the .pmc definitions.)
- $P1 = new 'ResizablePMCArray'
+ $P1 = new 'TclList'
store_global 'info_level', $P1
- $P1 = new 'ResizablePMCArray'
+ $P1 = new 'TclList'
store_global 'events', $P1
# Global variable initialization
#version info
- $P0 = new 'String'
+ $P0 = new 'TclString'
$P0 = '0.1'
set_root_global ['tcl'], '$tcl_patchLevel', $P0
- $P0 = new 'String'
+ $P0 = new 'TclString'
$P0 = '0.1'
set_root_global ['tcl'], '$tcl_version', $P0
@@ -218,19 +218,19 @@
store_global 'channels', $P1
# Setup the id # for channels..
- $P1 = new 'Integer'
+ $P1 = new 'TclInt'
$P1 = 1
store_global 'next_channel_id', $P1
# call chain of lex pads (for upvar and uplevel)
- $P1 = new 'ResizablePMCArray'
+ $P1 = new 'TclList'
store_global 'call_chain', $P1
# Change counter: when something is compiled, it is compared to
# This counter: if the counter hasn't changed since it was compiled,
# it's safe to use the inline version (if available)
# Otherwise fallback to the interpreted version.
- $P1 = new 'Integer'
+ $P1 = new 'TclInt'
$P1 = 0
store_global 'epoch', $P1
@@ -245,7 +245,7 @@
compreg 'TCL', $P1
# Setup a global to keep a unique id for compiled subs.
- $P1 = new 'Integer'
+ $P1 = new 'TclInt'
$P1 = 0
store_global 'compiled_num', $P1
Modified: branches/gsoc_pdd09/languages/tcl/src/binary.c
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/binary.c (original)
+++ branches/gsoc_pdd09/languages/tcl/src/binary.c Tue Jul 29 14:30:55 2008
@@ -115,6 +115,8 @@
VTABLE_set_integer_native(interp, value, *n);
pos += len;
break;
+ default:
+ break;
}
(*_pos) = pos;
return value;
@@ -399,6 +401,8 @@
len = sizeof (int)/sizeof (char);
binstr = string_concat(interp, binstr, string_from_int(interp, n),
0);
break;
+ default:
+ break;
}
return binstr;
@@ -461,6 +465,8 @@
while (length-- > strlen)
binstr = string_concat(interp, binstr,
string_from_cstring(interp, " ", 1), 0);
break;
+ default:
+ break;
}
return binstr;
@@ -537,6 +543,8 @@
binstr = binary_format_string(interp, field, binstr, value,
format, &formatpos, formatlen);
break;
+ default:
+ break;
}
}
Modified: branches/gsoc_pdd09/languages/tcl/src/class/tclconst.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/class/tclconst.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/src/class/tclconst.pir Tue Jul 29
14:30:55 2008
@@ -12,6 +12,8 @@
=cut
.sub class_init :anon :load
+ # While it is tempting to inherit directly from TclString, if we do that
+ # we lose the predefined MMD is_equal that works with the existing structure.
$P0 = get_class 'String'
$P1 = subclass $P0, 'TclConst'
Modified: branches/gsoc_pdd09/languages/tcl/src/grammar/expr/past.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/grammar/expr/past.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/src/grammar/expr/past.pir Tue Jul 29
14:30:55 2008
@@ -54,7 +54,7 @@
$P0 = subclass base, 'PAST::Val'
$P0 = subclass base, 'PAST::Var'
- $P0 = new 'Integer'
+ $P0 = new 'TclInt'
store_global 'TclExpr::PAST', '$!serno', $P0
.end
@@ -73,9 +73,9 @@
=cut
.sub init :vtable
- $P0 = new 'String'
- $P1 = new 'Integer'
- $P2 = new 'ResizablePMCArray'
+ $P0 = new 'TclString'
+ $P1 = new 'TclInt'
+ $P2 = new 'TclList'
setattribute self, '$.source', $P0
setattribute self, '$.pos', $P1
Modified: branches/gsoc_pdd09/languages/tcl/src/grammar/expr/past2pir.tg
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/grammar/expr/past2pir.tg
(original)
+++ branches/gsoc_pdd09/languages/tcl/src/grammar/expr/past2pir.tg Tue Jul
29 14:30:55 2008
@@ -133,7 +133,7 @@
.local pmc return_register
pir = new 'CodeString'
- args = new 'ResizablePMCArray'
+ args = new 'TclList'
iter = node.'child_iter'()
iter_loop:
unless iter goto iter_done
@@ -168,7 +168,7 @@
.local pmc return_register
pir = new 'CodeString'
- args = new 'ResizablePMCArray'
+ args = new 'TclList'
iter = node.'child_iter'()
iter_loop:
unless iter goto iter_done
@@ -200,7 +200,7 @@
.local string reg
pir = new 'CodeString'
- args = new 'ResizablePMCArray'
+ args = new 'TclList'
children = node.'get_children'()
iter = new 'Iterator', children
@@ -306,7 +306,7 @@
.local pmc args, children, iter, pir, reg
pir = new 'CodeString'
- args = new 'ResizablePMCArray'
+ args = new 'TclList'
children = node.'get_children'()
iter = new 'Iterator', children
iter_loop:
Modified: branches/gsoc_pdd09/languages/tcl/src/pmc/tcllist.pmc
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/pmc/tcllist.pmc (original)
+++ branches/gsoc_pdd09/languages/tcl/src/pmc/tcllist.pmc Tue Jul 29
14:30:55 2008
@@ -71,7 +71,8 @@
case '}':
if (--count < 0) goto escape;
break;
-
+ default:
+ break;
}
pos++;
}
@@ -203,8 +204,6 @@
Copy the contents of other to self.
-=back
-
=cut
*/
@@ -243,9 +242,28 @@
}
}
+/*
+
+=item METHOD get_list
+
+Return a list version of ourself
+
+=cut
+
+*/
+
+ METHOD get_list() {
+ RETURN(PMC *SELF);
+ }
}
/*
+
+=back
+
+*/
+
+/*
* Local variables:
* c-file-style: "parrot"
* End:
Modified: branches/gsoc_pdd09/languages/tcl/src/pmc/tclobject.pmc
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/pmc/tclobject.pmc (original)
+++ branches/gsoc_pdd09/languages/tcl/src/pmc/tclobject.pmc Tue Jul 29
14:30:55 2008
@@ -50,6 +50,8 @@
case enum_class_Float:
type = dynpmc_TclFloat;
break;
+ default:
+ break;
}
pmc_reuse(INTERP, SELF, type, 0);
}
Modified: branches/gsoc_pdd09/languages/tcl/src/pmc/tclstring.pmc
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/pmc/tclstring.pmc (original)
+++ branches/gsoc_pdd09/languages/tcl/src/pmc/tclstring.pmc Tue Jul 29
14:30:55 2008
@@ -16,7 +16,7 @@
maps String
{
- METHOD get_list(STRING* str) {
+ METHOD get_list(STRING* str :optional) {
PMC* retval = pmc_new(INTERP, pmc_type(INTERP,
string_from_literal(INTERP, "TclList")));
INTVAL pos = -1; /* we increment before we use it */
INTVAL len; /* length of the string */
@@ -28,7 +28,7 @@
INTVAL depth; /* keep track of nested {} pairs */
if (! str)
- RETURN(PMC *SELF);
+ str = SELF.get_string();
/*
* RT#48166 This prevents a segfault; retval gets claimed before it
Modified: branches/gsoc_pdd09/languages/tcl/src/tclsh.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/tclsh.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/src/tclsh.pir Tue Jul 29 14:30:55 2008
@@ -39,7 +39,7 @@
.local int argc,retcode
.local pmc tcl_interactive
- tcl_interactive = new 'Integer'
+ tcl_interactive = new 'TclInt'
store_global '$tcl_interactive', tcl_interactive
.local pmc compileTcl
Modified: branches/gsoc_pdd09/languages/tcl/t/internals/select_option.t
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/t/internals/select_option.t
(original)
+++ branches/gsoc_pdd09/languages/tcl/t/internals/select_option.t Tue Jul
29 14:30:55 2008
@@ -49,7 +49,7 @@
# Setup options
.local pmc options
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
options[0] = 'dank'
options[1] = 'dark'
options[2] = 'dunk'
@@ -113,7 +113,7 @@
# 7
message='no comma with only two options'
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
options[0] = 'bill'
options[1] = 'bob'
push_eh eh_7
@@ -129,7 +129,7 @@
# 8
message='no comma with only two options, ambiguous'
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
options[0] = 'bill'
options[1] = 'bob'
push_eh eh_8
Modified: branches/gsoc_pdd09/languages/tcl/t/internals/select_switches.t
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/t/internals/select_switches.t
(original)
+++ branches/gsoc_pdd09/languages/tcl/t/internals/select_switches.t Tue Jul
29 14:30:55 2008
@@ -49,13 +49,13 @@
# Setup options
.local pmc options, argv
- options = new 'ResizablePMCArray'
+ options = new 'TclList'
options[0] = 'baz'
options[1] = 'bob'
options[2] = 'joe'
# 2-5
- argv = new 'ResizablePMCArray'
+ argv = new 'TclList'
argv[0] = '-joe'
argv[1] = 'what'
message='exact match, single, leftover args'
@@ -78,7 +78,7 @@
is ($S0, 'what', $S1)
# 6-8
- argv = new 'ResizablePMCArray'
+ argv = new 'TclList'
argv[0] = '-joe'
message='exact match, single, no leftover args'
$P1 = select_switches(options, argv)
@@ -96,7 +96,7 @@
is ($I1, 0, $S1)
# 9-13
- argv = new 'ResizablePMCArray'
+ argv = new 'TclList'
argv[0] = '-joe'
argv[1] = '-baz'
argv[2] = 'what'
@@ -124,7 +124,7 @@
is ($S0, 'what', $S1)
# 14-17
- argv = new 'ResizablePMCArray'
+ argv = new 'TclList'
argv[0] = '-joe'
argv[1] = '--'
argv[2] = '-bob'
@@ -148,7 +148,7 @@
is ($S0, '-bob', $S1)
# 18-22
- argv = new 'ResizablePMCArray'
+ argv = new 'TclList'
argv[0] = '-joke'
argv[1] = 'bag_o_donuts'
message='invalid option specified, no exception'
@@ -175,7 +175,7 @@
is ($S0, 'bag_o_donuts', $S1)
# 23
- argv = new 'ResizablePMCArray'
+ argv = new 'TclList'
argv[0] = '-joke'
argv[1] = 'bag_o_donuts'
message='invalid option specified, w/ exception'
@@ -193,7 +193,7 @@
is($S2, 'bad switch "-joke": must be -baz, -bob, or -joe', message)
# 24
- argv = new 'ResizablePMCArray'
+ argv = new 'TclList'
argv[0] = '-joke'
argv[1] = 'bag_o_donuts'
message='invalid option specified, w/ exception and --'
@@ -211,7 +211,7 @@
is($S2, 'bad switch "-joke": must be -baz, -bob, -joe, or --', message)
# 25
- argv = new 'ResizablePMCArray'
+ argv = new 'TclList'
argv[0] = '-joke'
argv[1] = 'bag_o_donuts'
message='invalid option specified, w/ exception, --, and override name'
@@ -231,7 +231,7 @@
# 26-29
options[2] = 'joe:s' # change this to take a value..
- argv = new 'ResizablePMCArray'
+ argv = new 'TclList'
argv[0] = '-joe'
argv[1] = 'bag_o_donuts'
argv[2] = 'what'
Modified: branches/gsoc_pdd09/src/pmc/class.pmc
==============================================================================
--- branches/gsoc_pdd09/src/pmc/class.pmc (original)
+++ branches/gsoc_pdd09/src/pmc/class.pmc Tue Jul 29 14:30:55 2008
@@ -191,6 +191,7 @@
if (name_arg->vtable->base_type == enum_class_NameSpace) {
new_namespace = name_arg;
name_arg = Parrot_ns_get_name(interp, new_namespace);
+ VTABLE_shift_string(interp, name_arg);
}
else {
PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp,
@@ -486,7 +487,7 @@
}
VTABLE void init_pmc(PMC *init_data) {
- PMC *arg;
+ PMC *arg, *ns_name;
const INTVAL arg_type = VTABLE_type(interp, init_data);
STRING * const name_str = CONST_STRING(interp, "name");
@@ -497,8 +498,8 @@
switch (arg_type) {
case enum_class_String:
case enum_class_Key:
- case enum_class_NameSpace:
case enum_class_ResizableStringArray:
+ case enum_class_NameSpace:
arg = pmc_new(interp, enum_class_Hash);
VTABLE_set_pmc_keyed_str(interp, arg, name_str, init_data);
break;
Modified: branches/gsoc_pdd09/t/doc/pod.t
==============================================================================
--- branches/gsoc_pdd09/t/doc/pod.t (original)
+++ branches/gsoc_pdd09/t/doc/pod.t Tue Jul 29 14:30:55 2008
@@ -68,15 +68,14 @@
foreach my $file (@files) {
$file = "$build_dir/$file";
- # skip missing MANIFEST.generated files
- next unless -e $file;
+ # skip missing MANIFEST.generated files ( -e )
+ # skip binary files (including .pbc files) ( -B )
+ # skip files that pass the -e test because they resolve the .exe variant
+ next unless -T $file;
# Skip the book, because it uses extended O'Reilly-specific POD
next if $file =~ m{docs/book/};
- # skip binary files (including .pbc files)
- next if -B $file;
-
# skip files without POD
next unless Pod::Find::contains_pod( $file, 0 );
