Author: Whiteknight
Date: Tue Jul 22 14:31:15 2008
New Revision: 29685
Added:
branches/gsoc_pdd09/languages/pipp/t/php/closures.t
- copied unchanged from r29684, /trunk/languages/pipp/t/php/closures.t
branches/gsoc_pdd09/languages/pipp/t/php/comments.t
- copied unchanged from r29684, /trunk/languages/pipp/t/php/comments.t
branches/gsoc_pdd09/t/compilers/imcc/syn/hll.t
- copied unchanged from r29684, /trunk/t/compilers/imcc/syn/hll.t
branches/gsoc_pdd09/t/configure/061-revision_from_cache.t
- copied unchanged from r29684,
/trunk/t/configure/061-revision_from_cache.t
Modified:
branches/gsoc_pdd09/MANIFEST
branches/gsoc_pdd09/config/auto/jit/test_exec_cygwin.in
branches/gsoc_pdd09/examples/benchmarks/float4.pir
branches/gsoc_pdd09/languages/pipp/docs/overview.pod
branches/gsoc_pdd09/languages/pipp/docs/testing.pod
branches/gsoc_pdd09/languages/pipp/src/common/php_info.pir
branches/gsoc_pdd09/languages/pipp/src/pct/grammar.pg
branches/gsoc_pdd09/languages/pipp/t/php/hello.t
branches/gsoc_pdd09/languages/pipp/t/php/info.t
branches/gsoc_pdd09/languages/tcl/README.pod
branches/gsoc_pdd09/languages/tcl/config/makefiles/root.in
branches/gsoc_pdd09/languages/tcl/lib/skipped_tests.tcl
branches/gsoc_pdd09/languages/tcl/lib/test_more.tcl
branches/gsoc_pdd09/languages/tcl/runtime/builtin/list.pir
branches/gsoc_pdd09/languages/tcl/runtime/builtin/vwait.pir
branches/gsoc_pdd09/languages/tcl/runtime/conversions.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/class/tclconst.pir
branches/gsoc_pdd09/languages/tcl/src/class/tclproc.pir
branches/gsoc_pdd09/lib/Parrot/Revision.pm
branches/gsoc_pdd09/src/inter_call.c
branches/gsoc_pdd09/t/codingstd/perlcritic.t
branches/gsoc_pdd09/t/configure/017-revision_from_cache.t
branches/gsoc_pdd09/tools/util/perlcritic.conf
Log:
[gsoc_pdd09] update to trunk r29684
Modified: branches/gsoc_pdd09/MANIFEST
==============================================================================
--- branches/gsoc_pdd09/MANIFEST (original)
+++ branches/gsoc_pdd09/MANIFEST Tue Jul 22 14:31:15 2008
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Sun Jul 20 10:24:04 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Tue Jul 22 18:07:34 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -2199,6 +2199,8 @@
languages/pipp/t/php/base64.t [pipp]
languages/pipp/t/php/basic.t [pipp]
languages/pipp/t/php/builtin.t [pipp]
+languages/pipp/t/php/closures.t [pipp]
+languages/pipp/t/php/comments.t [pipp]
languages/pipp/t/php/concat.t [pipp]
languages/pipp/t/php/constant.t [pipp]
languages/pipp/t/php/control_flow.t [pipp]
@@ -3232,6 +3234,7 @@
t/compilers/imcc/syn/errors.t []
t/compilers/imcc/syn/eval.t []
t/compilers/imcc/syn/file.t []
+t/compilers/imcc/syn/hll.t []
t/compilers/imcc/syn/keyed.t []
t/compilers/imcc/syn/labels.t []
t/compilers/imcc/syn/macro.t []
@@ -3341,6 +3344,7 @@
t/configure/058-fatal_step.t []
t/configure/059-silent.t []
t/configure/060-silent.t []
+t/configure/061-revision_from_cache.t []
t/configure/testlib/Make_VERSION_File.pm []
t/configure/testlib/Tie/Filehandle/Preempt/Stdin.pm []
t/configure/testlib/init/alpha.pm []
Modified: branches/gsoc_pdd09/config/auto/jit/test_exec_cygwin.in
==============================================================================
--- branches/gsoc_pdd09/config/auto/jit/test_exec_cygwin.in (original)
+++ branches/gsoc_pdd09/config/auto/jit/test_exec_cygwin.in Tue Jul 22
14:31:15 2008
@@ -5,6 +5,7 @@
#include <errno.h>
#include <malloc.h>
#include <unistd.h>
+#include <string.h>
#ifndef PAGE_SIZE
# define PAGE_SIZE getpagesize()
#endif
@@ -40,7 +41,7 @@
if (atoi(argv[1]))
prot |= PROT_EXEC;
- p = memalign(PAGE_SIZE, sizeof(code));
+ p = memalign(PAGE_SIZE, PAGE_SIZE);
memcpy(p, code, sizeof(code));
t = (pf) p;
Modified: branches/gsoc_pdd09/examples/benchmarks/float4.pir
==============================================================================
--- branches/gsoc_pdd09/examples/benchmarks/float4.pir (original)
+++ branches/gsoc_pdd09/examples/benchmarks/float4.pir Tue Jul 22 14:31:15 2008
@@ -9,7 +9,7 @@
=head1 DESCRIPTION
-This benchmark compares 4 different ways of defining and filling a float4
+This benchmark compares 5 different ways of defining and filling a float4
structure (a common vector length, especially for graphics).
=cut
@@ -74,6 +74,24 @@
.local pmc float4
.local int i
+ # Time named struct elements treated as array
+ float4 = new 'ManagedStruct', named_struct
+ i = count
+ start = time
+
+ named_struct_array_loop:
+ float4[0] = start
+ float4[1] = start
+ float4[2] = start
+ float4[3] = start
+ dec i
+ if i goto named_struct_array_loop
+
+ stop = time
+ elapsed = stop - start
+ print 'Array Struct: '
+ say elapsed
+
# Time struct element per array element
float4 = new 'ManagedStruct', struct
i = count
Modified: branches/gsoc_pdd09/languages/pipp/docs/overview.pod
==============================================================================
--- branches/gsoc_pdd09/languages/pipp/docs/overview.pod (original)
+++ branches/gsoc_pdd09/languages/pipp/docs/overview.pod Tue Jul 22
14:31:15 2008
@@ -29,7 +29,7 @@
=head1 Status
-36 out of 2692 tests in the PHP 5.2.0 test suite pass for the phc variant.
+20 out of 1322 tests in the PHP 5.3.0 test suite pass for the PCT variant.
=head1 Dependencies
Modified: branches/gsoc_pdd09/languages/pipp/docs/testing.pod
==============================================================================
--- branches/gsoc_pdd09/languages/pipp/docs/testing.pod (original)
+++ branches/gsoc_pdd09/languages/pipp/docs/testing.pod Tue Jul 22 14:31:15 2008
@@ -26,9 +26,9 @@
# build PHP 5.3
cd ~/devel/PHP/
- wget http://snaps.php.net/php5.3-200807061430.tar.gz
- tar xvzf php5.3-200807061430.tar.gz
- cd php5.3-200807061430/
+ wget http://snaps.php.net/php5.3-200807221230.tar.gz
+ tar xvzf php5.3-200807221230.tar.gz
+ cd php5.3-200807221230/
./configure
make
Modified: branches/gsoc_pdd09/languages/pipp/src/common/php_info.pir
==============================================================================
--- branches/gsoc_pdd09/languages/pipp/src/common/php_info.pir (original)
+++ branches/gsoc_pdd09/languages/pipp/src/common/php_info.pir Tue Jul 22
14:31:15 2008
@@ -194,7 +194,7 @@
.local int argc
argc = args
if argc goto L1
- .RETURN_STRING('5.2 on Parrot')
+ .RETURN_STRING('5.3 on Parrot')
L1:
unless argc == 1 goto L2
.local string ext
Modified: branches/gsoc_pdd09/languages/pipp/src/pct/grammar.pg
==============================================================================
--- branches/gsoc_pdd09/languages/pipp/src/pct/grammar.pg (original)
+++ branches/gsoc_pdd09/languages/pipp/src/pct/grammar.pg Tue Jul 22
14:31:15 2008
@@ -9,9 +9,11 @@
token TOP { ^ <sea_or_code>+
{*} }
# whitespace and comments
-token ws { [ \h | \v ]*
- <singlelinecomment>?
- <multilinecomment>?
+token ws { [ \h
+ | \v
+ | <singlelinecomment>
+ | <multilinecomment>
+ ]*
}
token singlelinecomment { '#' \N*
| '//' \N*
Modified: branches/gsoc_pdd09/languages/pipp/t/php/hello.t
==============================================================================
--- branches/gsoc_pdd09/languages/pipp/t/php/hello.t (original)
+++ branches/gsoc_pdd09/languages/pipp/t/php/hello.t Tue Jul 22 14:31:15 2008
@@ -18,7 +18,7 @@
use lib "$FindBin::Bin/../../lib";
# core Perl modules
-use Test::More tests => 21;
+use Test::More tests => 17;
# Parrot modules
use Parrot::Test;
@@ -181,44 +181,6 @@
END_EXPECTED
-language_output_is( 'Pipp', <<'END_CODE', <<'END_EXPECTED', 'end of line
comment #' );
-<script language="php">
-echo "Hello, World!\n"; # comment till end of line
-</script>
-END_CODE
-Hello, World!
-END_EXPECTED
-
-
-language_output_is( 'Pipp', <<'END_CODE', <<'END_EXPECTED', 'end of line
comment //' );
-<script language="php">
-echo "Hello, World!\n"; // comment till end of line
-</script>
-END_CODE
-Hello, World!
-END_EXPECTED
-
-
-language_output_is( 'Pipp', <<'END_CODE', <<'END_EXPECTED', 'single line /* */
comment' );
-<script language="php">
-echo "Hello, World!\n"; /* comment till end of line */
-</script>
-END_CODE
-Hello, World!
-END_EXPECTED
-
-
-language_output_is( 'Pipp', <<'END_CODE', <<'END_EXPECTED', 'multi line /* */
comment' );
-<script language="php">
-echo "Hello, World!\n"; /* multi
- line
- comment
-*/
-</script>
-END_CODE
-Hello, World!
-END_EXPECTED
-
language_output_is( 'Pipp', <<'END_CODE', <<'END_EXPECTED', 'script tags' );
<script language="php">
echo "Hello, World!\n";
Modified: branches/gsoc_pdd09/languages/pipp/t/php/info.t
==============================================================================
--- branches/gsoc_pdd09/languages/pipp/t/php/info.t (original)
+++ branches/gsoc_pdd09/languages/pipp/t/php/info.t Tue Jul 22 14:31:15 2008
@@ -74,7 +74,7 @@
echo phpversion(), "\n";
?>
CODE
-/^5\.2/
+/^5\.3/
OUTPUT
language_output_is( 'Pipp', <<'CODE', <<'OUTPUT', 'phpversion("ctype")' );
Modified: branches/gsoc_pdd09/languages/tcl/README.pod
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/README.pod (original)
+++ branches/gsoc_pdd09/languages/tcl/README.pod Tue Jul 22 14:31:15 2008
@@ -13,21 +13,22 @@
../../parrot tcl.pbc foo.tcl
You can also generate a faux-executable with C<make tclsh>; You could then
-run examples with simply:
+run examples with, e.g.:
- ./tclsh
+ ./tclsh example/bench.tcl
=head2 Interactive tclsh
-To run partcl interactively, type:
+To run partcl interactively, simply run the faux-executable with no args:
- make tclsh
+ ./tclsh
-in this directory.
+or, similarly, the parrot bytecode:
+ ../../parrot tcl.pbc
=head2 Command line options
-partcl supports two command line options (that are B<not> standard Tcl):
+partcl supports two command line options, neither of which are standard Tcl.
=over 4
@@ -47,9 +48,6 @@
the PIR on STDOUT. This PIR can then be compiled to parrot bytecode, or
run directly through parrot. (Works with C<-e>.).
-To pretty print the PIR that is generated, you can use the I<experimental>
-utility in C<../../tools/util/pirtidy.pl>.
-
=back
=head2 Examples
@@ -64,12 +62,14 @@
collection system. Send the results of both to the mailing list
C<[EMAIL PROTECTED]>.
-=head2 Documentation
+To run the spec test suites, type C<make tcl-test>; This will check out
+the tests from tcl's CVS repository for the 8.5.2 release and run them.
-See C<docs/> and C<TODO>
+Note that the tests are I<fudged> slightly to use our version of [test]
+As soon as we can run tcltest.tcl natively, we will.
-=head2 Tcl Version
+=head2 Documentation
-We are targeting Tcl 8.5.1.
+See C<docs/> and C<TODO>
=cut
Modified: branches/gsoc_pdd09/languages/tcl/config/makefiles/root.in
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/config/makefiles/root.in (original)
+++ branches/gsoc_pdd09/languages/tcl/config/makefiles/root.in Tue Jul 22
14:31:15 2008
@@ -158,144 +158,141 @@
t_tcl/append.t \
t_tcl/appendComp.t \
t_tcl/apply.t \
+ t_tcl/assocd.t \
+ t_tcl/async.t \
+ t_tcl/autoMkindex.t \
t_tcl/basic.t \
t_tcl/binary.t \
+ t_tcl/case.t \
+ t_tcl/chan.t \
+ t_tcl/clock.t \
t_tcl/cmdAH.t \
t_tcl/cmdIL.t \
+ t_tcl/cmdInfo.t \
t_tcl/cmdMZ.t \
- t_tcl/compExpr_old.t \
t_tcl/compExpr.t \
+ t_tcl/compExpr_old.t \
t_tcl/compile.t \
t_tcl/concat.t \
+ t_tcl/config.t \
+ t_tcl/dcall.t \
t_tcl/dict.t \
+ t_tcl/dstring.t \
+ t_tcl/encoding.t \
t_tcl/env.t \
t_tcl/error.t \
t_tcl/eval.t \
+ t_tcl/event.t \
+ t_tcl/exec.t \
t_tcl/execute.t \
- t_tcl/expr_old.t \
t_tcl/expr.t \
+ t_tcl/expr_old.t \
+ t_tcl/fCmd.t \
t_tcl/fileName.t \
- t_tcl/for_old.t \
+ t_tcl/fileSystem.t \
t_tcl/for.t \
+ t_tcl/for_old.t \
t_tcl/foreach.t \
t_tcl/format.t \
t_tcl/get.t \
- t_tcl/if_old.t \
+ t_tcl/history.t \
t_tcl/if.t \
- t_tcl/incr_old.t \
+ t_tcl/if_old.t \
t_tcl/incr.t \
+ t_tcl/incr_old.t \
+ t_tcl/indexObj.t \
t_tcl/info.t \
+ t_tcl/init.t \
+ t_tcl/interp.t \
t_tcl/ioCmd.t \
+ t_tcl/ioUtil.t \
+ t_tcl/iogt.t \
t_tcl/join.t \
t_tcl/lindex.t \
+ t_tcl/link.t \
t_tcl/linsert.t \
t_tcl/list.t \
t_tcl/listObj.t \
t_tcl/llength.t \
+ t_tcl/load.t \
t_tcl/lrange.t \
t_tcl/lrepeat.t \
t_tcl/lreplace.t \
t_tcl/lsearch.t \
t_tcl/lset.t \
t_tcl/lsetComp.t \
+ t_tcl/macOSXFCmd.t \
+ t_tcl/macOSXLoad.t \
+ t_tcl/main.t \
+ t_tcl/mathop.t \
+ t_tcl/misc.t \
+ t_tcl/msgcat.t \
t_tcl/namespace.t \
t_tcl/namespace_old.t \
+ t_tcl/notify.t \
+ t_tcl/obj.t \
+ t_tcl/opt.t \
t_tcl/package.t \
t_tcl/parse.t \
+ t_tcl/parseExpr.t \
t_tcl/parseOld.t \
+ t_tcl/pid.t \
+ t_tcl/pkg.t \
+ t_tcl/pkgMkIndex.t \
t_tcl/platform.t \
- t_tcl/proc_old.t \
t_tcl/proc.t \
+ t_tcl/proc_old.t \
t_tcl/pwd.t \
+ t_tcl/reg.t \
t_tcl/regexp.t \
t_tcl/regexpComp.t \
+ t_tcl/registry.t \
t_tcl/rename.t \
+ t_tcl/result.t \
+ t_tcl/safe.t \
t_tcl/scan.t \
t_tcl/security.t \
- t_tcl/set_old.t \
t_tcl/set.t \
+ t_tcl/set_old.t \
+ t_tcl/socket.t \
+ t_tcl/source.t \
t_tcl/split.t \
+ t_tcl/stack.t \
t_tcl/string.t \
t_tcl/stringComp.t \
t_tcl/subst.t \
t_tcl/switch.t \
- t_tcl/unknown.t \
- t_tcl/uplevel.t \
- t_tcl/upvar.t \
- t_tcl/util.t \
- t_tcl/var.t \
- t_tcl/while_old.t \
- t_tcl/while.t
-
-# These tests parse, or fail (or skip) every (or nearly every) test.
-FAILING_TCL_TESTS = \
- t_tcl/assocd.t \
- t_tcl/case.t \
- t_tcl/chan.t \
- t_tcl/clock.t \
- t_tcl/cmdInfo.t \
- t_tcl/config.t \
- t_tcl/dcall.t \
- t_tcl/dstring.t \
- t_tcl/event.t \
- t_tcl/exec.t \
- t_tcl/history.t \
- t_tcl/indexObj.t \
- t_tcl/init.t \
- t_tcl/interp.t \
- t_tcl/ioUtil.t \
- t_tcl/link.t \
- t_tcl/load.t \
- t_tcl/macOSXFCmd.t \
- t_tcl/main.t \
- t_tcl/mathop.t \
- t_tcl/misc.t \
- t_tcl/notify.t \
- t_tcl/obj.t \
- t_tcl/parseExpr.t \
- t_tcl/pid.t \
- t_tcl/pkg.t \
- t_tcl/registry.t \
- t_tcl/result.t \
- t_tcl/socket.t \
- t_tcl/source.t \
- t_tcl/stack.t \
+ t_tcl/tcltest.t \
t_tcl/thread.t \
+ t_tcl/timer.t \
t_tcl/tm.t \
t_tcl/trace.t \
t_tcl/unixFCmd.t \
t_tcl/unixFile.t \
+ t_tcl/unixInit.t \
t_tcl/unixNotfy.t \
+ t_tcl/unknown.t \
t_tcl/unload.t \
+ t_tcl/uplevel.t \
+ t_tcl/upvar.t \
t_tcl/utf.t \
+ t_tcl/util.t \
+ t_tcl/var.t \
+ t_tcl/while.t \
+ t_tcl/while_old.t \
t_tcl/winConsole.t \
t_tcl/winDde.t \
t_tcl/winFCmd.t \
+ t_tcl/winFile.t \
t_tcl/winNotify.t \
t_tcl/winPipe.t \
t_tcl/winTime.t
DYING_TCL_TESTS = \
- t_tcl/async.t \
- t_tcl/autoMkindex.t \
- t_tcl/encoding.t \
- t_tcl/fCmd.t \
- t_tcl/fileSystem.t \
t_tcl/http.t \
t_tcl/httpold.t \
t_tcl/io.t \
- t_tcl/iogt.t \
- t_tcl/msgcat.t \
- t_tcl/macOSXLoad.t \
- t_tcl/opt.t \
- t_tcl/pkgMkIndex.t \
- t_tcl/reg.t \
- t_tcl/safe.t \
- t_tcl/stringObj.t \
- t_tcl/tcltest.t \
- t_tcl/timer.t \
- t_tcl/unixInit.t \
- t_tcl/winFile.t
+ t_tcl/stringObj.t
tcl-test: t_tcl tcl.pbc
# For now, just test the ones that ``work'' with test_more
@@ -307,6 +304,7 @@
cd t && $(PERL) -e 'use Test::Harness qw($$verbose runtests) ;
$$Test::Harness::verbose=1;runtests(glob("*.t"))' && cd ..
CLEANERS = \
[EMAIL PROTECTED]@ \
tcl.pbc \
runtime/builtins.pir \
"runtime/*.pbc" \
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 22
14:31:15 2008
@@ -231,15 +231,29 @@
# stored as an array of test name -> reason pairs.
array set abort_after {
+ async-3.1 {we're too slow to or too stupid to get by hang1}
+ autoMkindex-5.2 {invalid command name "cd"}
basic-47.1 {need interp before these can work}
cmdAH-31.13 {invalid command name "cd"}
cmdMZ-5.7 {invalid command name "cleanupTests"}
+ encoding-11.4 {wrong # args: should be "string is class ?-strict?
?-failindex var? str"}
env-1.3 {can't read "env(test)" no such element in array}
event-4.2 {invalid command name "update"}
+ fCmd-1.1 {}
filename-11.13 {invalid command name "cd"}
iocmd-12.8 {invalid command name "close"}
+ iogt-1.1 {}
ioUtil-2.8 {invalid command name "cd"}
+ msgcat-0.0 {}
+ opt-1.1 {don't have the opt package available}
+ pkgMkIndex-4.2 {invalid command name "pkg_mkIndex"}
parse-19.4 {invalid command name "cleanupTests"}
- utf-1.4 {Invalid character for UTF-8 encoding}
+ reg-0.1 {invalid command name "doing"}
+ safe-1.1 {}
source-7.6 {invalid command name "cleanupTests"}
+ timer-1.1 {}
+ tcltest-1.1 {}
+ utf-1.4 {Invalid character for UTF-8 encoding}
+ unixInit-1.1 {}
+ winpipe-1.1 {}
}
Modified: branches/gsoc_pdd09/languages/tcl/lib/test_more.tcl
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/lib/test_more.tcl (original)
+++ branches/gsoc_pdd09/languages/tcl/lib/test_more.tcl Tue Jul 22 14:31:15 2008
@@ -164,7 +164,7 @@
# when we shouldn't.
proc testConstraint {args} {return 0}
-proc temporaryDirectory {args} {return 0}
+proc temporaryDirectory {args} {return .}
proc makeFile {args} {return 0}
proc removeFile {args} {return 0}
proc bytestring {args} {return 0}
@@ -174,6 +174,7 @@
proc interp {args} {return 0}
proc safeInterp {args} {return 0}
proc pid {args} {return 0}
+proc auto_load {args} {return 0}
proc child {args} {return 0}
proc child-trusted {args} {return 0}
proc makeDirectory {args} {return 0}
@@ -181,8 +182,20 @@
proc testobj {args} {return 0}
proc testsetplatform {args} {return 0}
proc testevalex {cmd} { uplevel {*}$cmd }
+proc cleanupTests {args} {return 0}
+proc PowerSet {args} {return 0}
-namespace eval tcltest {
+set auto_path {}
+
+namespace eval tcl {
+ set OptDescN 0
+}
+
+namespace eval tcltest {
set verbose 0
- proc temporaryDirectory {args} {return 0}
+ set testSingleFile 0
+ set temporaryDirectory .
+ proc temporaryDirectory {args} {return .}
+ proc testConstraint {args} {return 0}
+ proc test {args} {return [::test {*}$args]}
}
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/list.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/list.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/list.pir Tue Jul 22
14:31:15 2008
@@ -4,37 +4,9 @@
.HLL 'Tcl', 'tcl_group'
.namespace []
-# RT #56958 We should be getting a TclList as a result of :slurpy
-# The sub should be this simple:
-#
-# .sub '&list'
-# .param pmc argv :slurpy
-# .return(argv)
-# .end
-#
-# t/tcl_misc.t will fail with current parrot and the short version
-# of this sub.
-
.sub '&list'
.param pmc argv :slurpy
-
- $S0 = typeof argv
- if $S0 != 'TclList' goto fixup
.return(argv)
-
-
-fixup:
- .local pmc iter, retval
- retval = new 'TclList'
-
- iter = new 'Iterator', argv
- iter_loop:
- unless iter goto iter_end
- $P0 = shift iter
- push retval, $P0
- goto iter_loop
- iter_end:
- .return(retval)
.end
# Local Variables:
Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/vwait.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/vwait.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/vwait.pir Tue Jul 22
14:31:15 2008
@@ -8,33 +8,6 @@
argc = elements args
if argc != 1 goto badargs
-
- .local pmc __read, events
- .local string name
- __read = get_root_global ['_tcl'], '__read'
- events = get_root_global ['_tcl'], 'events'
- name = args[0]
-
-outer:
- .local pmc iter, var
- iter = new 'Iterator', events
- push_eh inner
- var = __read(name)
- pop_eh
- goto done
-
-inner:
- unless iter goto outer
- $P0 = shift iter
-
- .local pmc channel, script
- channel = $P0[0]
- script = $P0[1]
- unless $P0 goto inner
- script()
- goto inner
-
-done:
.return('')
badargs:
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 22
14:31:15 2008
@@ -48,7 +48,7 @@
.sub toDict :multi(TclList)
.param pmc list
- $P0 = __listToDict(list)
+ $P0 = listToDict(list)
copy list, $P0
.return(list)
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
22 14:31:15 2008
@@ -1,7 +1,7 @@
.HLL '_Tcl', ''
.namespace []
-.sub __listToDict
+.sub listToDict
.param pmc list
.local int sizeof_list
@@ -27,7 +27,7 @@
if $S0 == 'TclString' goto is_string
if $S0 == 'String' goto is_string
is_list:
- $P2 = __listToDict($P2)
+ $P2 = listToDict($P2)
result[$S1] = $P2
goto loop
@@ -37,7 +37,7 @@
$I0 = elements $P3
if $I0 <= 1 goto only_string
push_eh only_string
- $P3 = __listToDict($P3)
+ $P3 = listToDict($P3)
pop_eh
result[$S1] = $P3
goto loop
@@ -59,7 +59,7 @@
.local pmc list
$P0 = new 'TclString'
list = $P0.'get_list'(str)
- .return __listToDict(list)
+ .return listToDict(list)
.end
# Local Variables:
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 22
14:31:15 2008
@@ -47,13 +47,13 @@
.HLL '_Tcl', ''
.namespace []
-.sub __load_macros :load :anon
+.sub load_macros :load :anon
$P0 = compreg 'PIR'
$P0 = $P0(".sub main\n.include 'languages/tcl/src/macros.pir'\n.end")
$P0()
.end
-.sub __prepare_lib :load :anon
+.sub prepare_lib :load :anon
# Load any dependant libraries.
load_bytecode 'Getopt/Obj.pbc'
@@ -262,7 +262,7 @@
.HLL 'Tcl', ''
.namespace []
-.sub __load_stdlib :load :anon
+.sub load_stdlib :load :anon
.include 'iglobals.pasm'
.local pmc interp
interp = getinterp
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 22
14:31:15 2008
@@ -5,13 +5,13 @@
=head1 TclConst
-=head2 __class_init
+=head2 class_init
Define the attributes required for the class.
=cut
-.sub __class_init :anon :load
+.sub class_init :anon :load
$P0 = get_class 'String'
$P1 = subclass $P0, 'TclConst'
@@ -266,7 +266,7 @@
.return compiler(argnum, self)
.end
-=head2 _dump
+=head2 __dump
This method enables Data::Dumper to work on us; shouldn't need it, because
we're subclassing String...
Modified: branches/gsoc_pdd09/languages/tcl/src/class/tclproc.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/class/tclproc.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/src/class/tclproc.pir Tue Jul 22
14:31:15 2008
@@ -9,13 +9,13 @@
.cloneable()
-=head2 __class_init
+=head2 class_init
Define the attributes required for the class.
=cut
-.sub __class_init :anon :load
+.sub class_init :anon :load
$P0 = get_class 'Sub'
$P1 = subclass $P0, 'TclProc'
Modified: branches/gsoc_pdd09/lib/Parrot/Revision.pm
==============================================================================
--- branches/gsoc_pdd09/lib/Parrot/Revision.pm (original)
+++ branches/gsoc_pdd09/lib/Parrot/Revision.pm Tue Jul 22 14:31:15 2008
@@ -30,36 +30,51 @@
sub update {
my $prev = _get_revision();
my $revision = _analyze_sandbox();
- if (defined ($prev) && ($revision ne $prev)) {
- $revision = 'unknown' unless defined $revision;
- eval {
- open my $FH, ">", $cache;
- print $FH "$revision\n";
- close $FH;
- $current = $revision;
- };
+ $current = _handle_update( {
+ prev => $prev,
+ revision => $revision,
+ cache => $cache,
+ current => $current,
+ } );
+}
+
+sub _handle_update {
+ my $args = shift;
+ if (! defined $args->{revision}) {
+ $args->{revision} = 'unknown';
+ _print_to_cache($args->{cache}, $args->{revision});
+ return $args->{revision};
+ }
+ else {
+ if (defined ($args->{prev}) && ($args->{revision} ne $args->{prev})) {
+ _print_to_cache($args->{cache}, $args->{revision});
+ return $args->{revision};
+ }
+ else {
+ return $args->{current};
+ }
}
}
+sub _print_to_cache {
+ my ($cache, $revision) = @_;
+ open my $FH, ">", $cache
+ or die "Unable to open handle to $cache for writing: $!";
+ print $FH "$revision\n";
+ close $FH or die "Unable to close handle to $cache after writing: $!";
+}
+
sub _get_revision {
my $revision;
if (-f $cache) {
- eval {
- open my $FH, "<", $cache;
- chomp($revision = <$FH>);
- close $FH;
- };
- return $revision unless $@;
+ open my $FH, "<", $cache
+ or die "Unable to open $cache for reading: $!";
+ chomp($revision = <$FH>);
+ close $FH or die "Unable to close $cache after reading: $!";
}
-
- $revision = _analyze_sandbox();
-
- if (! -f $cache) {
- eval {
- open my $FH, ">", $cache;
- print $FH "$revision\n";
- close $FH;
- };
+ else {
+ $revision = _analyze_sandbox();
+ _print_to_cache($cache, $revision);
}
return $revision;
}
Modified: branches/gsoc_pdd09/src/inter_call.c
==============================================================================
--- branches/gsoc_pdd09/src/inter_call.c (original)
+++ branches/gsoc_pdd09/src/inter_call.c Tue Jul 22 14:31:15 2008
@@ -642,7 +642,8 @@
next_arg_sig(&st->dest);
if (st->dest.sig & PARROT_ARG_SLURPY_ARRAY) {
- PMC *slurped = pmc_new(interp, enum_class_ResizablePMCArray);
+ PMC *slurped = pmc_new(interp,
+ Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray));
PARROT_ASSERT((st->dest.sig & PARROT_ARG_TYPE_MASK) == PARROT_ARG_PMC);
@@ -1355,7 +1356,8 @@
/* 2nd: Positional :slurpy */
if (dest->sig & PARROT_ARG_SLURPY_ARRAY && !(dest->sig & PARROT_ARG_NAME))
{
- PMC * const array = pmc_new(interp, enum_class_ResizablePMCArray);
+ PMC * const array = pmc_new(interp,
+ Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray));
const INTVAL idx = st->dest.u.op.pc[dest->i];
PARROT_ASSERT(idx >= 0);
Modified: branches/gsoc_pdd09/t/codingstd/perlcritic.t
==============================================================================
--- branches/gsoc_pdd09/t/codingstd/perlcritic.t (original)
+++ branches/gsoc_pdd09/t/codingstd/perlcritic.t Tue Jul 22 14:31:15 2008
@@ -19,7 +19,7 @@
give_up('Test::Perl::Critic');
}
-my $minimum_version = 1.086;
+my $minimum_version = 1.090;
if ($Perl::Critic::VERSION < $minimum_version) {
give_up("Perl::Critic version $minimum_version");
}
Modified: branches/gsoc_pdd09/t/configure/017-revision_from_cache.t
==============================================================================
--- branches/gsoc_pdd09/t/configure/017-revision_from_cache.t (original)
+++ branches/gsoc_pdd09/t/configure/017-revision_from_cache.t Tue Jul 22
14:31:15 2008
@@ -20,6 +20,23 @@
my $cwd = cwd();
{
my $rev = 16000;
+ my ($cache, $libdir) = setup_cache($rev, $cwd);
+ require Parrot::Revision;
+ no warnings 'once';
+ is($Parrot::Revision::current, $rev,
+ "Got expected revision number from cache");
+ use warnings;
+ unlink qq{$libdir/Parrot/Revision.pm}
+ or croak "Unable to delete file after testing";
+ ok( chdir $cwd, "Able to change back to starting directory");
+}
+
+pass("Completed all tests in $0");
+
+##### SUBROUTINES #####
+
+sub setup_cache {
+ my ($rev, $cwd) = @_;
my $tdir = tempdir( CLEANUP => 1 );
ok( chdir $tdir, "Changed to temporary directory for testing" );
my $libdir = qq{$tdir/lib};
@@ -34,18 +51,9 @@
or croak "Unable to open $cache for writing";
print $FH qq{$rev\n};
close $FH or croak "Unable to close $cache after writing";
- require Parrot::Revision;
- no warnings 'once';
- is($Parrot::Revision::current, $rev,
- "Got expected revision number from cache");
- use warnings;
- unlink qq{$libdir/Parrot/Revision.pm}
- or croak "Unable to delete file after testing";
- ok( chdir $cwd, "Able to change back to starting directory");
+ return ($cache, $libdir);
}
-pass("Completed all tests in $0");
-
################### DOCUMENTATION ###################
=head1 NAME
Modified: branches/gsoc_pdd09/tools/util/perlcritic.conf
==============================================================================
--- branches/gsoc_pdd09/tools/util/perlcritic.conf (original)
+++ branches/gsoc_pdd09/tools/util/perlcritic.conf Tue Jul 22 14:31:15 2008
@@ -45,8 +45,6 @@
add_themes = parrot
[Subroutines::RequireFinalReturn]
-# http://rt.cpan.org/Ticket/Display.html?id=37672
-terminal_funcs = exec
add_themes = extra
[TestingAndDebugging::MisplacedShebang]
