[svn:parrot] r47645 - in branches/gsoc_threads: . compilers/pct/src/PAST config/gen config/gen/makefiles docs docs/pdds docs/pdds/draft docs/project examples/io ext/nqp-rx/src/stage0 include/parrot include/parrot/oplib lib/Parrot/Docs/Section lib/Parrot/Harness runtime/parrot/include runtime/parrot/library/LWP src src/interp src/io src/ops src/pmc src/runcore t/compilers/imcc/syn t/oo t/pir t/pmc t/src t/steps/auto t/tools tools/dev tools/util
Chandon at svn.parrot.org
Chandon at svn.parrot.org
Tue Jun 15 17:35:20 UTC 2010
Author: Chandon
Date: Tue Jun 15 17:35:18 2010
New Revision: 47645
URL: https://trac.parrot.org/parrot/changeset/47645
Log:
[gsoc threads] sync with trunk
Added:
branches/gsoc_threads/runtime/parrot/include/green_threads.pir (contents, props changed)
branches/gsoc_threads/t/oo/objects.t
- copied unchanged from r47644, trunk/t/oo/objects.t
branches/gsoc_threads/t/pir/timer_exit.t
- copied unchanged from r47644, trunk/t/pir/timer_exit.t
branches/gsoc_threads/t/tools/parrot_config.t
- copied unchanged from r47644, trunk/t/tools/parrot_config.t
Deleted:
branches/gsoc_threads/t/pmc/objects.t
Modified:
branches/gsoc_threads/ (props changed)
branches/gsoc_threads/.gitignore
branches/gsoc_threads/CREDITS
branches/gsoc_threads/ChangeLog
branches/gsoc_threads/DEPRECATED.pod
branches/gsoc_threads/MANIFEST
branches/gsoc_threads/MANIFEST.generated
branches/gsoc_threads/NEWS
branches/gsoc_threads/README
branches/gsoc_threads/VERSION
branches/gsoc_threads/compilers/pct/src/PAST/Compiler.pir
branches/gsoc_threads/config/gen/config_pm.pm
branches/gsoc_threads/config/gen/makefiles/root.in
branches/gsoc_threads/docs/parrothist.pod
branches/gsoc_threads/docs/pdds/draft/pdd06_pasm.pod
branches/gsoc_threads/docs/pdds/pdd28_strings.pod
branches/gsoc_threads/docs/project/release_manager_guide.pod
branches/gsoc_threads/examples/io/http.pir
branches/gsoc_threads/examples/io/httpd.pir
branches/gsoc_threads/ext/nqp-rx/src/stage0/nqp-setting.nqp
branches/gsoc_threads/include/parrot/oplib/core_ops.h
branches/gsoc_threads/include/parrot/runcore_trace.h (props changed)
branches/gsoc_threads/lib/Parrot/Docs/Section/Parrot.pm
branches/gsoc_threads/lib/Parrot/Harness/DefaultTests.pm
branches/gsoc_threads/runtime/parrot/library/LWP/UserAgent.pir
branches/gsoc_threads/src/interp/inter_create.c (props changed)
branches/gsoc_threads/src/io/io_private.h
branches/gsoc_threads/src/io/socket_unix.c
branches/gsoc_threads/src/io/socket_win32.c
branches/gsoc_threads/src/io/win32.c
branches/gsoc_threads/src/ops/core_ops.c
branches/gsoc_threads/src/pmc/scheduler.pmc
branches/gsoc_threads/src/pmc/stringhandle.pmc
branches/gsoc_threads/src/pmc/stringiterator.pmc
branches/gsoc_threads/src/pmc/timer.pmc
branches/gsoc_threads/src/runcore/cores.c (props changed)
branches/gsoc_threads/src/runcore/trace.c (props changed)
branches/gsoc_threads/src/scheduler.c
branches/gsoc_threads/t/compilers/imcc/syn/regressions.t
branches/gsoc_threads/t/pir/macro.t
branches/gsoc_threads/t/pmc/float.t
branches/gsoc_threads/t/pmc/stringbuilder.t
branches/gsoc_threads/t/pmc/stringiterator.t
branches/gsoc_threads/t/src/embed.t (props changed)
branches/gsoc_threads/t/steps/auto/warnings-01.t
branches/gsoc_threads/tools/dev/fetch_languages.pl
branches/gsoc_threads/tools/dev/mk_gitignore.pl (props changed)
branches/gsoc_threads/tools/dev/mk_inno.pl
branches/gsoc_threads/tools/dev/mk_manifest_and_skip.pl
branches/gsoc_threads/tools/dev/pprof2cg.pl
branches/gsoc_threads/tools/dev/vgp
branches/gsoc_threads/tools/util/parrot-config.pir
branches/gsoc_threads/tools/util/release.json
Modified: branches/gsoc_threads/.gitignore
==============================================================================
--- branches/gsoc_threads/.gitignore Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/.gitignore Tue Jun 15 17:35:18 2010 (r47645)
@@ -1,6 +1,6 @@
# ex: set ro:
-# $Id
-# generated by tools/dev/mk_manifest_and_skip.pl Mon May 17 15:32:39 2010 UT
+# $Id: MANIFEST.SKIP 47057 2010-05-27 15:39:08Z fperrad
+# generated by tools/dev/mk_manifest_and_skip.pl Thu May 27 15:25:37 2010 UT
#
# This file should contain a transcript of the svn:ignore properties
# of the directories in the Parrot subversion repository. (Needed for
@@ -47,6 +47,10 @@
libparrot.dll
miniparrot
myconfig
+ops2c
+ops2c.c
+ops2c.pbc
+ops2c.pir
parrot
parrot-nqp
parrot-nqp.c
@@ -102,6 +106,12 @@
compilers/imcc/imcparser.c
compilers/imcc/imcparser.h
compilers/imcc/imcparser.output
+# generated from svn:ignore of 'compilers/opsc/gen/Ops/'
+compilers/opsc/gen/Ops/*.pir
+# generated from svn:ignore of 'compilers/opsc/gen/Ops/Compiler/'
+compilers/opsc/gen/Ops/Compiler/*.pir
+# generated from svn:ignore of 'compilers/opsc/gen/Ops/Trans/'
+compilers/opsc/gen/Ops/Trans/*.pir
# generated from svn:ignore of 'compilers/pct/src/PAST/'
compilers/pct/src/PAST/*.pbc
# generated from svn:ignore of 'compilers/pct/src/PCT/'
@@ -235,6 +245,8 @@
ext/Parrot-Embed/lib/Parrot/*.obj
# generated from svn:ignore of 'ext/Parrot-Embed/t/'
ext/Parrot-Embed/t/*.pbc
+# generated from svn:ignore of 'ext/nqp-rx/src/stage0/'
+ext/nqp-rx/src/stage0/nqp-setting.pir
# generated from svn:ignore of 'include/parrot/'
include/parrot/*.tmp
include/parrot/config.h
@@ -248,11 +260,6 @@
include/parrot/platform_interface.h
include/parrot/platform_limits.h
include/parrot/vtable.h
-# generated from svn:ignore of 'include/parrot/oplib/'
-include/parrot/oplib/*_ops.h
-include/parrot/oplib/*_ops_cg*.h
-include/parrot/oplib/*_ops_switch.h
-include/parrot/oplib/ops.h
# generated from svn:ignore of 'include/pmc/'
include/pmc/*.h
# generated from svn:ignore of 'lib/'
@@ -314,6 +321,8 @@
runtime/parrot/library/Getopt/Obj.pbc
# generated from svn:ignore of 'runtime/parrot/library/HTTP/'
runtime/parrot/library/HTTP/*.pbc
+# generated from svn:ignore of 'runtime/parrot/library/LWP/'
+runtime/parrot/library/LWP/*.pbc
# generated from svn:ignore of 'runtime/parrot/library/MIME/'
runtime/parrot/library/MIME/*.pbc
# generated from svn:ignore of 'runtime/parrot/library/Math/'
@@ -582,6 +591,7 @@
# generated from svn:ignore of 't/tools/'
t/tools/*.pbc
t/tools/*.pir
+t/tools/*.stdout
t/tools/pdb.t.*
t/tools/pmc2c.*.c
t/tools/pmc2c.*.dump
Modified: branches/gsoc_threads/CREDITS
==============================================================================
--- branches/gsoc_threads/CREDITS Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/CREDITS Tue Jun 15 17:35:18 2010 (r47645)
@@ -402,7 +402,7 @@
N: Gerd Pokorra
E: pokorra at uni-siegen.de
-D: Release manager for 1.9.0 and 2.3.0
+D: Release manager for 1.9.0, 2.3.0 and 2.5.0
N: Goplat
D: Win98 and other fixes.
Modified: branches/gsoc_threads/ChangeLog
==============================================================================
--- branches/gsoc_threads/ChangeLog Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/ChangeLog Tue Jun 15 17:35:18 2010 (r47645)
@@ -1,8 +1,12 @@
#1 $Id$
+2010.06.15 Gerd
+ * Released 2.5.0
+ See NEWS for more.
+
2010.05.18 Whiteknight
- * Released 2.4.0
- See NEWS for more
+ * Released 2.4.0
+ See NEWS for more
2010.04.20 Gerd
* Released 2.3.0
@@ -157,7 +161,7 @@
See NEWS for more.
2007.3.10 coke
- * removed parakeet
+ * removed parakeet
2007.02.22 pmichaud
* Released 0.4.9
@@ -223,7 +227,7 @@
2006.07.20 audreyt
* --maintainer prerequesites are now bison 2.2+ and flex 2.5.3x
(or some such --leo)
- (at the moment code is checking for 2.0 -- ambs)
+ (at the moment code is checking for 2.0 -- ambs)
2006.07.17 chip
partial implementation of new pdd21:
@@ -236,7 +240,7 @@
See NEWS for more.
2006.06.03 leo
- * I and N registers are never cleared to 0 / 0.0 on subroutine entry
+ * I and N registers are never cleared to 0 / 0.0 on subroutine entry
2006.05.14 leo
* Released 0.4.4
@@ -250,7 +254,7 @@
See NEWS for more.
2006.03.06 leo
- * Shifted argument type bits left by 2 according to r11754
+ * Shifted argument type bits left by 2 according to r11754
change of docs/pdds/pdd03_calling_conventions.pod
* if you are creating PASM then code needs adjustment
@@ -353,7 +357,7 @@
* the usual bug fixes and improvements
2005-03-06 leo
- * Released 0.1.2
+ * Released 0.1.2
* big rewrite of string code, not yet finished but ...
* partial implementation of a generational garbage collector
* indirect register frame addressing
@@ -368,7 +372,7 @@
* and as always a lot more
2004-10-09 leo
- * Released 0.1.1
+ * Released 0.1.1
* Need Perl 5.6 now for building
* Basic AST support, PAST file parser, bits of code generation
* BigInt PMC using GMP
@@ -398,39 +402,39 @@
* ... and a lot more
2004-02-29 leo
- * Released 0.1.0
- * "Ladies and gentlemen, I give you... objects!"
- * Huge documentation overhaul
- * More supported platforms, s. PLATFORMS
- * Basic thread support for pthread based architectures
- * Basic event handling for timers and signals including:
- * PASM callbacks for NCI (native C) functions.
- * Improved platform configuration
- * COW stacks now working, stacks code redone
- * Structure handling vastly improved
- * Random PMC and rand primitives
- * Better subroutine call syntax in PIR
- * Make PIR subroutines compliant with pdd03
- * Improved profiling (DOD, GC timings)
- * Hash code improvements, incl. random key order support
- * Experimental freeze/thaw code for some PMC types
- * IO improvements for buffered layer and Win32
- * String iterators
- * String bitwise vtables
- * Many new opcodes
- * Support for JIT, where malloced memory isn't executable
- * Priority DOD scheme for objects that need timely destruction
- * Improved bytecode loading (e.g. onLoad functions)
- * Language updates: forth, Perl6/P6C, m4
- * Libraries: Getopt_Long, SDL, Dumper, Sort
- * new JAPH examples
- * Unified imcc and parrot test handling
- * Many new tests (make test reports 1386 tests)
- * Numerous bug fixes
+ * Released 0.1.0
+ * "Ladies and gentlemen, I give you... objects!"
+ * Huge documentation overhaul
+ * More supported platforms, s. PLATFORMS
+ * Basic thread support for pthread based architectures
+ * Basic event handling for timers and signals including:
+ * PASM callbacks for NCI (native C) functions.
+ * Improved platform configuration
+ * COW stacks now working, stacks code redone
+ * Structure handling vastly improved
+ * Random PMC and rand primitives
+ * Better subroutine call syntax in PIR
+ * Make PIR subroutines compliant with pdd03
+ * Improved profiling (DOD, GC timings)
+ * Hash code improvements, incl. random key order support
+ * Experimental freeze/thaw code for some PMC types
+ * IO improvements for buffered layer and Win32
+ * String iterators
+ * String bitwise vtables
+ * Many new opcodes
+ * Support for JIT, where malloced memory isn't executable
+ * Priority DOD scheme for objects that need timely destruction
+ * Improved bytecode loading (e.g. onLoad functions)
+ * Language updates: forth, Perl6/P6C, m4
+ * Libraries: Getopt_Long, SDL, Dumper, Sort
+ * new JAPH examples
+ * Unified imcc and parrot test handling
+ * Many new tests (make test reports 1386 tests)
+ * Numerous bug fixes
2003-10-31 leo
- * Released 0.0.13
+ * Released 0.0.13
* Yep thirteen - haunted by the ghost of 0.0.12
* Build imcc as parrot
* Objects more finished
@@ -453,7 +457,7 @@
* Many new tests and fixes
2003-10-22 melvin
- * imcc moved from parrot/languages/ to parrot/
+ * imcc moved from parrot/languages/ to parrot/
2003-09-20 sfink
@@ -493,7 +497,7 @@
2003-06-14 13:50 dan
* Moved the registers out of the context structure, since they
- really aren't context
+ really aren't context
* Changed the register stack frames to hold only 16 registers
rather than 32, added half-set push and pop ops, and reworked
the full set push/pops to do two half-set push/pops. Should
@@ -506,7 +510,7 @@
* Various files
Update Yet Another copyright statements to reflect the (no longer
- so) shiny new year.
+ so) shiny new year.
2003-03-11 22:06 chip
Modified: branches/gsoc_threads/DEPRECATED.pod
==============================================================================
--- branches/gsoc_threads/DEPRECATED.pod Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/DEPRECATED.pod Tue Jun 15 17:35:18 2010 (r47645)
@@ -156,15 +156,6 @@
for Sub, Exception, and related PMC types will instead be handled by
get_label and set_label.
-=item All bitwise ops [eligible in 2.1]
-
-All bitwise ops (all ops containing C<bitwise> in their names) will be provided
-by dynops. B<NOTE>: Before removing the bitwise ops, make sure that the
-equivalent dynops are available and that the major HLLs (Rakudo, Partcl, Lua,
-etc) have switched to using them.
-
-L<https://trac.parrot.org/parrot/ticket/1260>
-
=item get_results opcode order and features [eligible in 2.1]
get_results no longer used to fetch exception object.
@@ -348,6 +339,12 @@
L<https://trac.parrot.org/parrot/ticket/1628>
+=item Parrot_get_runtime_prefix [eligible in 2.7]
+
+Use Parrot_get_runtime_path instead.
+
+L<https://trac.parrot.org/parrot/ticket/1191>
+
=back
=head1 Compiler tools
Modified: branches/gsoc_threads/MANIFEST
==============================================================================
--- branches/gsoc_threads/MANIFEST Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/MANIFEST Tue Jun 15 17:35:18 2010 (r47645)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun 9 14:23:50 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Mon Jun 14 16:49:50 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -1775,6 +1775,7 @@
t/oo/names.t [test]
t/oo/new-old.t [test]
t/oo/new.t [test]
+t/oo/objects.t [test]
t/oo/ops.t [test]
t/oo/proxy.t [test]
t/oo/root_new.t [test]
@@ -1841,6 +1842,7 @@
t/pharness/04-Usage.t [test]
t/pir/macro.t [test]
t/pir/registernames.t [test]
+t/pir/timer_exit.t [test]
t/pmc/addrregistry.t [test]
t/pmc/arrayiterator.t [test]
t/pmc/bigint.t [test]
@@ -1899,7 +1901,6 @@
t/pmc/object-meths.t [test]
t/pmc/object-mro.t [test]
t/pmc/object.t [test]
-t/pmc/objects.t [test]
t/pmc/opcode.t [test]
t/pmc/oplib.t [test]
t/pmc/orderedhash.t [test]
@@ -2068,6 +2069,7 @@
t/tools/install/testlib/src/pmc/pmc_object.h [test]
t/tools/install/testlib/tools/build/ops2c.pl [test]
t/tools/install/testlib/vtable.dump [test]
+t/tools/parrot_config.t [test]
t/tools/parrot_debugger.t [test]
t/tools/pbc_disassemble.t [test]
t/tools/pbc_dump.t [test]
Modified: branches/gsoc_threads/MANIFEST.generated
==============================================================================
--- branches/gsoc_threads/MANIFEST.generated Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/MANIFEST.generated Tue Jun 15 17:35:18 2010 (r47645)
@@ -2,11 +2,11 @@
# See tools/dev/install_files.pl for documentation on the
# format of this file.
# Please re-sort this file after *EVERY* modification
-blib/lib/libparrot.2.4.0.dylib [main]lib
+blib/lib/libparrot.2.5.0.dylib [main]lib
blib/lib/libparrot.a [main]lib
blib/lib/libparrot.dylib [main]lib
blib/lib/libparrot.so [main]lib
-blib/lib/libparrot.so.2.4.0 [main]lib
+blib/lib/libparrot.so.2.5.0 [main]lib
compilers/data_json/data_json.pbc [data_json]
config/gen/call_list/opengl.in []
docs/ops/bit.pod [doc]
Modified: branches/gsoc_threads/NEWS
==============================================================================
--- branches/gsoc_threads/NEWS Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/NEWS Tue Jun 15 17:35:18 2010 (r47645)
@@ -1,42 +1,26 @@
# $Id$
New in 2.5.0
-- Platforms
- + EPEL (Extra Packages for Enterprise Linux) packages for RHEL6.beta are available
- + Building and testing on amd64/i386, with gcc/g++
- + Almost finished Parrot configure on RTEMS
-- Parrot starts to going Lorito
- Lorito is the code name for a set of planned refactors to the core opcodes.
- + The ops_pct branch has been merged into trunk. The "Stage 0" is done with it.
- for more Information about Lorito see:
- http://trac.parrot.org/parrot/wiki/Lorito
- http://trac.parrot.org/parrot/wiki/LoritoRoadmap
- Core
- + Added ByteBuffer PMC
- + Added a bunch of tests for Array PMCs
- + Modify some PMC vtable functions to reduce complexity, simplifying its coverage.
- + Deleted do-nothing custom mark in StringBuilder
- + Fixed ticket #389; subs are not entered into a namespace unless you declare them
+ + Added ByteBuffer PMC to allow direct byte manipulation
+ + Modified some PMC vtable functions to reduce complexity, simplifying coverage.
+ + Modified PAST to generate symbolic PASM constants in PIR output.
+ + General STRING API cleanups
+ + Increased test coverage of core PMCs
+ Fixed up 'exit' opcode, added CONTROL_EXIT exception type.
- + Modified PAST so that it can generate symbolic pasm constants in PIR output.
- + Fixed some substr-out-of-range errors in Regex.match
- + Various cleanups and some added functionality to NFG (Grapheme Normal Form).
- + Various parts of the STRING API are now more graceful
- + Improved implemented PAST::Pattern:
- Can match on types, children, attributes, based on iseq to a constant,
- based on true result from a closure and based on anything with an
- ACCEPTS method.
-- Tests
- + Fixed some tests that were failing because of dynops
- + Some tests for the instrument dynpmc are added
-- NQP
- + nqp-rx now supports multisubs and multimethods
+ + Experimental 'unroll' opcode renamed to 'finalize'
+- NQP-rx
+ + Added proper support for multisubs and multimethods
+ Fixed sigspace handling ** quantifier in regexes
+ Added \e strings
+ Added use of inversion lists for charclass lists in regexes
-- Languages
- + resurrected partcl
-- Miscellaneous
+- Platforms
+ + EPEL (Extra Packages for Enterprise Linux) packages for RHEL6.beta are available
+- Begin moving towards Lorito, the ops refactor to enable pervasive self-hosting and JIT compilation.
+ + All ops are now built with the self-hosted opsc compiler.
+ + For more Information about Lorito see:
+ http://trac.parrot.org/parrot/wiki/Lorito
+ http://trac.parrot.org/parrot/wiki/LoritoRoadmap
New in 2.4.0
- Core
Modified: branches/gsoc_threads/README
==============================================================================
--- branches/gsoc_threads/README Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/README Tue Jun 15 17:35:18 2010 (r47645)
@@ -1,4 +1,4 @@
-This is Parrot, version 2.4.0
+This is Parrot, version 2.5.0
------------------------------
Parrot is Copyright (C) 2001-2010, Parrot Foundation.
Modified: branches/gsoc_threads/VERSION
==============================================================================
--- branches/gsoc_threads/VERSION Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/VERSION Tue Jun 15 17:35:18 2010 (r47645)
@@ -1 +1 @@
-2.4.0
+2.5.0
Modified: branches/gsoc_threads/compilers/pct/src/PAST/Compiler.pir
==============================================================================
--- branches/gsoc_threads/compilers/pct/src/PAST/Compiler.pir Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/compilers/pct/src/PAST/Compiler.pir Tue Jun 15 17:35:18 2010 (r47645)
@@ -109,7 +109,7 @@
piropsig['shl'] = 'PP+'
piropsig['shr'] = 'PP+'
piropsig['sleep'] = 'v+'
- piropsig['splice'] = 'PPii'
+ piropsig['splice'] = '0PPii'
piropsig['split'] = 'Pss'
piropsig['sub'] = 'PP+'
piropsig['substr'] = 'Ssii'
Modified: branches/gsoc_threads/config/gen/config_pm.pm
==============================================================================
--- branches/gsoc_threads/config/gen/config_pm.pm Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/config/gen/config_pm.pm Tue Jun 15 17:35:18 2010 (r47645)
@@ -119,7 +119,11 @@
# String
$v =~ s/(["\\])/\\$1/g;
$v =~ s/\n/\\n/g;
- print {$OUT} qq( set \$P0["$k"], "$v"\n);
+ my $charset = q{};
+ if ($v =~ /[^[:ascii:]]/) {
+ $charset = 'binary:';
+ }
+ print {$OUT} qq( set \$P0["$k"], $charset"$v"\n);
}
else {
# Null
Modified: branches/gsoc_threads/config/gen/makefiles/root.in
==============================================================================
--- branches/gsoc_threads/config/gen/makefiles/root.in Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/config/gen/makefiles/root.in Tue Jun 15 17:35:18 2010 (r47645)
@@ -635,9 +635,10 @@
$(LIBRARY_DIR)/Configure/genfile.pbc: $(DYNEXT_DIR)/sys_ops$(LOAD_EXT)
-$(LIBRARY_DIR)/HTTP/Message.pbc: $(DYNEXT_DIR)/sys_ops$(LOAD_EXT)
+# Message.pbc and distutils.pbc load io_ops to work around TT #1663
+638 $(LIBRARY_DIR)/HTTP/Message.pbc: $(DYNEXT_DIR)/sys_ops$(LOAD_EXT) $(DYNEXT_DIR)/io_ops$(LOAD_EXT)
-$(LIBRARY_DIR)/distutils.pbc: $(DYNEXT_DIR)/sys_ops$(LOAD_EXT)
+$(LIBRARY_DIR)/distutils.pbc: $(DYNEXT_DIR)/sys_ops$(LOAD_EXT) $(DYNEXT_DIR)/io_ops$(LOAD_EXT)
$(LIBRARY_DIR)/pcre.pbc: $(DYNEXT_DIR)/sys_ops$(LOAD_EXT)
@@ -1798,7 +1799,7 @@
manifest_tests :
$(PERL) t/harness $(MANIFEST_TEST_FILES)
-examples_tests :
+examples_tests : test_prep
$(PERL) t/harness $(EXAMPLES_TEST_FILES)
# benchmark tests
Modified: branches/gsoc_threads/docs/parrothist.pod
==============================================================================
--- branches/gsoc_threads/docs/parrothist.pod Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/docs/parrothist.pod Tue Jun 15 17:35:18 2010 (r47645)
@@ -109,5 +109,6 @@
Gerd 2.3.0 * 2010-Apr-20 "Samoan Lory"
Whiteknight 2.4.0 2010-May-18 "Sulfer Crest"
+ Gerd 2.5.0 2010-Jun-15 "Cheops"
=cut
Modified: branches/gsoc_threads/docs/pdds/draft/pdd06_pasm.pod
==============================================================================
--- branches/gsoc_threads/docs/pdds/draft/pdd06_pasm.pod Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/docs/pdds/draft/pdd06_pasm.pod Tue Jun 15 17:35:18 2010 (r47645)
@@ -18,9 +18,7 @@
language for it for those people who may need to generate bytecode directly,
rather than indirectly through a high-level language.
-{{ NOTE: out-of-date and incomplete. It seems that it would be more
-useful as a specification of the format of PASM than as a comprehensive
-listing of all opcodes. }}
+{{ NOTE: out-of-date and incomplete. }}
=head2 Questions
@@ -84,7 +82,9 @@
PC.
All registers have a type prefix of P, S, I, or N, for PMC, string, integer,
-and number respectively.
+and number respectively. While parrot bytecode does not have a fixed limit
+on the number of registers, PASM has an implementation limit on the number of
+addressable registers of each type, currently set at 100 (0-99).
=head2 Assembly Syntax
@@ -158,7 +158,7 @@
=head2 Opcode List
-In the following list, there may be multiple (but unlisted) versions of an
+There may be multiple (but unlisted) versions of an
opcode. If an opcode takes a register that might be keyed, the keyed version
of the opcode has a _k suffix. If an opcode might take multiple types of
registers for a single parameter, the opcode function really has a _x suffix,
@@ -184,831 +184,7 @@
either a register or constant of the appropriate type (PMC, string, integer,
or number)
-=head3 Control flow
-
-The control flow opcodes check conditions and manage program flow.
-
-=over 4
-
-=item if tx, ix
-
-Check register tx. If true, branch by X.
-
-=item unless tx, ix
-
-Check register tx. If false, branch by X.
-
-=item jump tx
-
-Jump to the address held in register x (Px, Sx, or Ix).
-
-=item branch tx
-
-Branch forward or backward by the amount in register x. (X may be either Ix,
-Nx, or Px) Branch offset may also be an integer constant.
-
-=back
-
-=head3 Data manipulation
-
-These ops handle manipulating the data in registers
-
-=over 4
-
-=item new Px, iy
-
-Create a new PMC of class y stored in PMC register x.
-
-=item destroy Px
-
-Destroy the PMC in register X, leaving it undef
-
-=item set tx, ty
-
-Copies y into x. Note that strings and PMCs are referred to by pointer, so if
-you do something like:
-
- set S0, S1
-
-this will copy the pointer in S1 into S0, leaving B<both> registers pointing
-at the same string.
-
-=item exchange tx, ty
-
-Exchange the contents of registers X and Y, which must be of the same type.
-(Generally cheaper than using the stack as an intermediary when setting up
-registers for function calls)
-
-=item assign Px, ty
-
-Takes the contents of Y and assigns them into the existing PMC in X.
-
-While set just copies pointers from one register to another, assign actually
-does a value assignment, as:
-
- $foo = $bar;
-
-X's assign vtable function is invoked and it does whatever is appropriate.
-
-=item clone Px, Py
-
-=item clone Sx, xy
-
-Performs a "deeper" copy of y into x, using the vtable appropriate to the
-class of Py if cloning a PMC.
-
-=item tostring Sx, ty, Iz
-
-Take the value in register y and convert it to a string of type z, storing the
-result in string register x.
-
-=item add tx, ty, tz *
-
-Add registers y and z and store the result in register x. (x = y + z) The
-registers must all be the same type, PMC, integer, or number.
-
-=item sub tx, ty, tz *
-
-Subtract register z from register y and store the result in register x. (x = y
-- z) The registers must all be the same type, PMC, integer, or number.
-
-=item mul tx, ty, tz *
-
-Multiply register y by register z and store the results in register x. The
-registers must be the same type.
-
-=item div tx, ty, tz *
-
-Divide register y by register z, and store the result in register x.
-
-=item inc tx, nn *
-
-Increment register x by nn. nn is an integer constant. If nn is omitted,
-increment is 1.
-
-=item dec tx, nn *
-
-Decrement register x by nn. nn is an integer constant. If nn is omitted,
-decrement by 1.
-
-=item length Ix, Sy
-
-Put the length of string y into integer register x.
-
-=item concat Sx, Sy
-
-Add string y to the end of string x.
-
-=item repeat Sx, Sy, iz
-
-Copies string y z times into string x.
-
-=back
-
-=head3 Transcendental operations
-
-These opcodes handle the transcendental math functions. The destination
-register here must always be either a numeric or a PMC register.
-
-=over 4
-
-=item sin nx, ty
-
-Return the sine of the number in Y
-
-=item cos nx, ty
-
-Return the cosine of the number in Y
-
-=item tan nx, ty
-
-Return the tangent of the number in Y
-
-=item sec nx, ty
-
-Return the secant of the number in Y
-
-=item atan nx, ty
-
-Return the arctangent of Y
-
-=item atan2 nx, ty
-
-Return the result of atan2 of Y
-
-=item asin nx, ty
-
-Return the arcsine of y
-
-=item acos nx, ty
-
-Return the arccosine of y
-
-=item asec nx, ty
-
-Return the arcsecant of y
-
-=item cosh nx, ty
-
-Return the hyperbolic cosine of y
-
-=item sinh nx, ty
-
-Return the hyperbolic sine of y
-
-=item tanh nx, ty
-
-Return the hyperbolic tangent of y
-
-=item sech nx, ty
-
-Return the hyperbolic secant of y
-
-=item log2 nx, ty
-
-Return the base 2 log of y
-
-=item log10 nx, ty
-
-Return the base 10 log of y
-
-=item ln Nx, ty
-
-Return the base e log of y
-
-=item log nx, ty, tz
-
-Return the base Z log of Y
-
-=item pow nx, ty, tz
-
-Return Y to the Z power
-
-=item exp nx, ty
-
-Return e to the Y power
-
-=back
-
-=head3 Register and stack ops
-
-These opcodes deal with registers and stacks
-
-=over 4
-
-=item clearp
-
-Clean out the current set of PMC registers, setting them to NULL
-
-=item cleari
-
-Clean out the current set of I registers, setting them to 0
-
-=item clears
-
-Clean out the current set of S registers, setting them to NULL
-
-=item clearn
-
-Clean out the current set of N registers, setting them to 0
-
-=item null tx
-
-Set register X to a null value; for S and P registers, this will be NULL,
-while for I and N registers it is 0
-
-=item save tx
-
-Push register or constant X onto the generic stack
-
-=item restore tx
-
-Restore register X from the generic stack by popping off the topmost entry.
-The type of this entry must match the register type.
-
-=item entrytype Ix, iy
-
-Put the type of generic stack entry Y into integer register X
-
-=item depth Ix
-
-Get the current depth of the generic stack
-
-=item lookback tx, iy
-
-Fetch the entry that's at position Y from the top of the generic stack. This
-does not remove an entry from the stack, merely fetches the entry off it.
-
-0 is the entry at the top of the stack, 1 is the entry immediately previous to
-that, and so on. Entry -1 is the very bottom-most entry in the stack. (While
-the stack may be a tree when looked at from the bottom up, you don't have
-access to any other branches when looking this way).
-
-=back
-
-=head3 Names, pads, and globals
-
-These operations are responsible for finding names in lexical or global
-scopes, as well as storing data into those slots. A static scope is captured
-by a scratchpad. The current dynamic scope is represented by the state of the
-lexical stack (which contains scratchpads). For more detail on these ops see
-the inline POD documentation in F<ops/var.ops>.
-
-=over 4
-
-=item store_lex sx, Py
-
-=item find_lex Px, sy
-
-Instructions for storing in, and retrieving from, the scratchpad associated
-with the current context.
-
-=item find_global Px, sy, sz
-
-Find the PMC for the global variable sy from the table sz and store it in
-register X
-
-{{ DEPRECATED: op find_global was deprecated }}
-
-=item find_global Px, sy
-
-Find the PMC for the global in the default table and put it in X.
-
-{{ DEPRECATED: op find_global was deprecated }}
-
-=item find_global_table Px, sy
-
-Find the global symbol table Y and store its PMC in X
-
-=item find_global_slot ix, Py, sz
-
-Find the slot in the global table Y for the global named Z, and store its slot
-in register X.
-
-=item fetch_global Px, Py, iz
-
-Fetch the global in slot Z of the symbol table pointed to by Y
-
-=item store_global Px, sy
-
-Store X in the default global symbol table with a name of Y.
-
-{{ DEPRECATED: op store_global was deprecated }}
-
-=back
-
-=head3 Exceptions
-
-These opcodes deal with exception handling at the lowest level. Exception
-handlers are dynamically scoped, and any exception handler set in a scope will
-be removed when that scope is exited.
-
-=over 4
-
-=item set_eh Px
-
-Sets an exception handler in place. The code referred to by register Px will
-get called if an exception is thrown while the exception handler is in scope.
-
-=item pop_eh
-
-Pop the most recently placed exception off the handler stack.
-
-=item throw Px
-
-Throw an exception represented by the object in PMC register x.
-
-=item rethrow Px
-
-Only valid inside an exception handler. Rethrow the exception represented by
-the object in PMC register x. This object may have been altered by the
-exception handler.
-
-=back
-
-=head3 Object things
-
-These opcodes deal with PMCs as objects, rather than as opaque data items.
-
-=over 4
-
-=item find_method Px, Py, tz
-
-Find the method Z for object Y, and return a PMC for it in X.
-
-=item callmethod Px, ty
-
-=item set_attribute Px, ty, tz
-
-=item can Ix, Py, sz
-
-Sets X to TRUE if object Y can perform method Z; otherwise, X is set to FALSE.
-
-=item does Ix, Py, sz
-
-Sets X to TRUE if object Y can implements interface Z; otherwise, X is set to
-FALSE.
-
-=item isa Px, ty
-
-=back
-
-=head3 Module handling
-
-These opcodes deal with loading in bytecode or executable code libraries, and
-fetching info about those libraries. This is all dealing with precompiled
-bytecode or shared libraries.
-
-=over 4
-
-=item load_bytecode sx
-
-Load in the bytecode in file X. Search the library path if need be.
-
-=item load_opcode_lib sx, iy
-
-Load in the opcode library X, starting at opcode number Y. Search the path if
-needed.
-
-=item load_string_lib sx
-
-Load in the string handling library named X
-
-=item get_op_count sx
-
-Return the number of opcodes in opcode library X
-
-=item get_string_name sx
-
-Get the name of the string encoding that the library X handles
-
-=item find_string_lib sx, sy
-
-Find the string library that handles strings of type Y. Return its name in X.
-
-=back
-
-=head3 I/O operations
-
-Reads and writes read and write records, for some value of record.
-
-=over 4
-
-=item new_fh px
-
-Create a new filehandle px
-
-=item open px, sy
-
-Open the file Y on filehandle X
-
-=item read px, py, pz
-
-Issue a read on the filehandle in y, and put the result in PMC X. PMC Z is the
-sync object.
-
-=item write px, sy, pz
-
-Write the string Y to filehandle X. PMC Z is the sync object.
-
-=item wait px
-
-Wait for the I/O operation represented by sync object X to finish
-
-=item readw px, py
-
-Read from filehandle Y and put the results in PMC X. Blocks until the read
-completes.
-
-=item writew px, sy
-
-Write string Y to filehandle X, waiting for the write to complete.
-
-=item seek px, ty
-
-Seek filehandle X to position Y.
-
-=item tell tx, py
-
-Return the current position of filehandle Y and put it in X. Returns -1 for
-filehandles where this can't be determined. (Such as stream connections)
-
-=item status px, py, tz
-
-Get informational item Z for filehandle Y and put the result in X. This
-fetches things like the number of entries in the IO pipe, number of
-outstanding I/O ops, number of ops on the filehandle, and so forth.
-
-=back
-
-=head3 Threading ops
-
-=over 4
-
-=item lock Px
-
-Take out a high-level lock on the PMC in register X
-
-=item unlock Px
-
-Unlock the PMC in register X
-
-=item pushunlock Px
-
-Push an unlock request on the stack
-
-=back
-
-=head3 Interpreter ops
-
-=over 4
-
-=item newinterp Px, flags
-
-Create a new interpreter in X, using the passed flags.
-
-=item runinterp Px, iy
-
-Jump into interpreter X and run the code starting at offset Y from the current
-location. (This is temporary until we get something better)
-
-=item callout Pw, Px, sy, pz
-
-Call routine Y in interpreter x, passing it the list of parameters Z. W is a
-synchronization object returned. It can be waited on like the sync objects
-returned from async I/O routines.
-
-=item interpinfo Ix, iy
-
-Get information item Y and put it in register X. Currently defined are:
-
-=over 4
-
-=item 1 TOTAL_MEM_ALLOC
-
-The total amount of system memory allocated for later parceling out to
-Buffers. Doesn't include any housekeeping memory, memory for Buffer or PMC
-structs, or things of that nature.
-
-=item 2 GC_MARK_RUNS
-
-The total number of garbage collection mark runs that have been made.
-
-=item 3 GC_COLLECT_RUNS
-
-The total number of garbage collection sweep runs that have been made.
-
-=item 4 ACTIVE_PMCS
-
-The number of PMCs considered active. This means the GC scan hasn't noted
-them as dead.
-
-=item 5 ACTIVE_BUFFERS
-
-The number of Buffers (usually STRINGs but could be other things) considered
-active.
-
-=item 6 TOTAL_PMCS
-
-The total number of PMCs the interpreter has available. Includes both active
-and free PMCs
-
-=item 7 TOTAL_BUFFERS
-
-The total number of Buffer structs the interpreter has available.
-
-=item 8 HEADERS_ALLOC_SINCE_COLLECT
-
-The number of new Buffer header block allocations that have been made since
-the last GC mark run. (Buffers, when allocated, are allocated in chunks)
-
-=item 9 MEM_ALLOCS_SINCE_COLLECT
-
-The number of times we've requested a block of memory from the system for
-allocation to Buffers since the last time we compacted the memory heap.
-
-=back
-
-=back
-
-=head3 Garbage collection
-
-=over 4
-
-=item sweep
-
-Fire off a dead object sweep
-
-=item collect
-
-Fire off a garbage collection sweep
-
-=item pausecollect
-
-Pause the garbage collector. No collections will be done for this interpreter
-until the collector is unpaused.
-
-=item resumecollect
-
-Unpause the collector. This doesn't necessarily do a GC run, merely allows the
-interpreter to fire one off when it deems it necessary.
-
-=back
-
-=head3 Key operations
-
-Keys are used to get access to individual elements of an aggregate variable.
-This is done to allow for opaque, packed, and multidimensional aggregate
-types.
-
-A key entry may be an integer, string, or PMC. Integers are used for array
-lookups, strings for hash lookups, and PMCs for either.
-
-=over 4
-
-=item new_key Sx
-
-Create a new key structure and put a pointer to it in register X.
-
-=item clone_key Sx, ky
-
-Make a copy of the key Y and put a pointer to it in register X. Y may be
-either an S register or a constant.
-
-=item size_key Sx, iy
-
-Make the key structure X large enough to hold Y key entries
-
-=item key_size Ix, ky
-
-Put the number of elements in key Y into integer register X.
-
-=item toss_key Sx
-
-Nuke key X. Throws the structure away and invalidates the register.
-
-=item ke_type Ix, ky, iz
-
-Put the type of key Y's entry Z in register X. Current values are 0, 1, and 2
-for Integer, String, and PMC, respectively.
-
-=item ke_value tx, ky, iz
-
-Put the value from key Y, entry Z into register X.
-
-=item chop_key Sx
-
-Toss the topmost entry from key X.
-
-=item inc_key Sx, iy
-
-Increment entry Y of key X by one.
-
-=item set_key Sw, [isp]x, iy[, iz]
-
-Set key W, offset Y, to value X. If X is a PMC, then the fourth operand must
-be specified. It can have a value of 0, 1, or 2, corresponding to integer,
-string, or object. Aggregates use this to figure out how to treat the key
-entry.
-
-=back
-
-=head3 Properties
-
-Properties are a sort of runtime note attached to a PMC. Any PMC can have
-properties on it. Properties live in a flat namespace, and they are not in any
-way associated with the class of the PMC that they are attached to.
-
-Properties may be used for runtime notes on variables, or other metadata that
-may change. They are not for object attributes.
-
-=over 4
-
-=item setprop Px, sy, Pz
-
-Set the property named Y of PMC X to the PMC in Z
-
-=item getprop Px, sy, Pz
-
-Get the property named Y from PMC Z and put the result in register X. Returns
-a NULL if the property doesn't exist.
-
-=item delprop Px, sy
-
-Delete the property Y from PMC X
-
-=item prophash Px, Py
-
-Fetch the properties from Y, put them in a Hash, and put the Hash in X.
-
-=back
-
-=head3 Symbolic support for HLLs
-
-=over 4
-
-=item setline ix
-
-Sets the 'current line' marker.
-
-=item setfile sx
-
-Sets the 'current file' marker.
-
-=item setpackage sx
-
-Sets the 'current package' marker.
-
-=item getline ix
-
-Fetches the 'current line' marker.
-
-=item getfile sx
-
-Fetches the 'current file' marker.
-
-=item getpackage sx
-
-Fetches the 'current package' marker.
-
-=back
-
-=head3 Foreign library access
-
-These are the ops we use to load in and interface to non-parrot libraries.
-
-=over 4
-
-=item loadlib Px, Sy
-
-Load in the library whose name is specified by y, and put a handle to it into
-P register x.
-
-=item dlfunc Pw, Px, Sy, Sz
-
-Find a routine named Y, in library X (which you did, of course, open with
-loadlib), and put a sub PMC onto W for it. You can call this sub as if it were
-any other parrot subroutine.
-
-Z has the function signature, which tells Parrot how to build the interface
-from parrot (and parrot's calling conventions) to the calling conventions of
-the library routine. Yes, this does mean that you must know the function
-signature, but if you don't know that why the heck would you be invoking the
-function, right?
-
-The signature is a series of 1 or more characters, representing the types for
-the call. The first character is the return type, while the rest are the
-parameters. The types are:
-
-=over 4
-
-=item v
-
-Void. As a return type indicates that there I<is> no return type. As a
-parameter indicates that there are no parameters. Can't be mixed with other
-parameter types.
-
-=item c
-
-Char. This is an integer type, taken from (or put into) an I register.
-
-=item s
-
-short. An integer type, taken from 0 or put into an I register
-
-=item i
-
-int. An integer type.
-
-=item l
-
-long. An integer type. You know the drill.
-
-=item f
-
-float. F register denizen.
-
-=item d
-
-double. F register, double-precision floating point type
-
-=item p
-
-PMC thingie. A generic pointer, taken from or stuck into a PMC's data pointer.
-If this is a return type, parrot will create a new UnManagedStruct PMC type,
-which is just a generic "pointer so some damn thing or other" PMC type which
-Parrot does I<no> management of.
-
-=item t
-
-string pointer. Taken from, or stuck into, a string register. (Converted to a
-null-terminated C string before passing in)
-
-=back
-
-So the signature for, for example, this SDL routine:
-
- int SDL_BlitSurface(SDL_Surface *src,
- SDL_Rect *srcrect,
- SDL_Surface *dst,
- SDL_Rect *dstrect);
-
-would be C<ipppp>, since it returns an integer and takes four pointers.
-Presumably previous calls would have set those pointers up properly.
-
-Do note that parrot makes no guarantees as to the behaviour of the libraries,
-and currently does no type checking on the input parameters. We will fix that
-later.
-
-The generated routine follows the calling conventions in PDD03. Note that int,
-string, pmc, and float parameters are counted separately. So if you have a
-signature of C<ippiidd> the return goes into I5, and the parameters come from
-P5, P6, I5, I6, N5, and N6, respectively. A signature of C<ipdiidp> has the
-identical same set of registers used (and in the same order).
-
-=item invoke
-
-Invoke a subroutine in P0. Presumes that all the registers are set up right
-for the call. The invoked subroutine I<must> preserve any registers that are
-not explicitly return parameters or calling convention metadata parameters.
-(Such as the number of I reg parameters, for example)
-
-=back
-
-=head3 Runtime compilation
-
-These opcodes deal with runtime creation of bytecode and compilation of source
-code.
-
-=over 4
-
-=item compile Px, Py, Sz
-
-Compile source string Z, with compiler unit Y, and stick a handle to a
-subroutine for the resulting bytecode segment (already loaded into the current
-interpreter) into X.
-
-Y is a assembler/compiler object of some sort, as registered with the
-B<compreg> opcode or the Parrot_compreg function. This will be something like
-"Perl5", "Perl6", "Perl5RE", "Perl6RE", "Python", "Ruby"... you get the
-picture.
-
-Imcc registers "PASM" and "PIR" compilers automatically.
-
-This is a high-level op, with the assumption that the resulting sub will be
-called. It's the equivalent of perl 5's string eval, except for the actual
-execution of the resulting code.
-
-=item compreg Px, Sy
-
-Get a compiler for source type Y.
-
-=item compreg Sx, Py
-
-Register the sub Y as a parser/compiler function named X. It will be called
-whenever anyone invokes the compile op with the name X.
-
-=back
+L<docs/ops> for a list of current parrot opcodes,
=head2 References
Modified: branches/gsoc_threads/docs/pdds/pdd28_strings.pod
==============================================================================
--- branches/gsoc_threads/docs/pdds/pdd28_strings.pod Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/docs/pdds/pdd28_strings.pod Tue Jun 15 17:35:18 2010 (r47645)
@@ -583,7 +583,7 @@
=head4 string_make
A crippled version of a string initializer, now replaced with the full version
-C<Parrot_string_new_init>.
+C<Parrot_str_new_init>.
=head4 string_capacity
Modified: branches/gsoc_threads/docs/project/release_manager_guide.pod
==============================================================================
--- branches/gsoc_threads/docs/project/release_manager_guide.pod Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/docs/project/release_manager_guide.pod Tue Jun 15 17:35:18 2010 (r47645)
@@ -118,10 +118,23 @@
=item f
+In the two files F<src/ops/core_ops.c> and F<include/parrot/oplib/core_ops.h>
+is the function C<Parrot_DynOp_core_a_b_c>, which has a name that includes
+the version number. a_b_c is the version number. You have to update this
+version number on two places in the file F<src/ops/core_ops.c>.
+In the file F<include/parrot/oplib/core_ops.h> you have to change this line:
+
+ op_lib_t *Parrot_DynOp_core_a_b_c(PARROT_INTERP, long init);
+
+Ignore the warning to not edit this files. It is necessary to edit this files,
+so that "make" builds with the increased version number.
+
+=item g
+
Configure parrot and run C<make distro_tests>, and either fix
what those tests complain about, or fix them so they don't complain.
-=item g
+=item h
If this is a developer release, or there have been no new entries to the
F<PBC_COMPAT> file, skip this step.
@@ -142,7 +155,7 @@
built for this to work, and that this script will reconfigure and rebuild
Parrot with various primitive size options.
-=item h
+=item i
Make sure everything works:
@@ -394,7 +407,6 @@
visible at
L<http://www.google.com/calendar/render?cid=ldhctdamsgfg5a1cord52po9h8@group.calendar.google.com>.
- - Jun 15, 2010 - 2.5 - gerd
- Jul 20, 2010 - 2.6* - coke
- Aug 17, 2010 - 2.7 - ??
- Sep 21, 2010 - 2.8 - gerd
Modified: branches/gsoc_threads/examples/io/http.pir
==============================================================================
--- branches/gsoc_threads/examples/io/http.pir Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/examples/io/http.pir Tue Jun 15 17:35:18 2010 (r47645)
@@ -13,9 +13,7 @@
HTTP client, connects to WWW port and grabs a page (L<http://www.ibm.com>).
-You should be running the echo service on your box (port 7). Be sure to
-set C<PARROT_NET_DEVEL> to 1 in F<io/io_private.h> and rebuld Parrot or
-the network layer won't exist.
+You should be running the echo service on your box (port 7).
=cut
Modified: branches/gsoc_threads/examples/io/httpd.pir
==============================================================================
--- branches/gsoc_threads/examples/io/httpd.pir Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/examples/io/httpd.pir Tue Jun 15 17:35:18 2010 (r47645)
@@ -270,7 +270,6 @@
ERR_NO_SOCKET:
print "Could not open socket.\n"
- print "Did you enable PARROT_NET_DEVEL in include/io_private.h?\n"
end
ERR_bind:
print "bind failed\n"
Modified: branches/gsoc_threads/ext/nqp-rx/src/stage0/nqp-setting.nqp
==============================================================================
--- branches/gsoc_threads/ext/nqp-rx/src/stage0/nqp-setting.nqp Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/ext/nqp-rx/src/stage0/nqp-setting.nqp Tue Jun 15 17:35:18 2010 (r47645)
@@ -210,11 +210,11 @@
=begin item slurp
Returns the contents of C<$filename> as a single string.
-=end
+=end item
our sub slurp ($filename) {
- my $handle := FileHandle.new();
- $handle.open($file, 'r');
+ my $handle := pir::new__Ps('FileHandle');
+ $handle.open($filename, 'r');
my $contents := $handle.readall;
$handle.close();
$contents;
@@ -226,7 +226,7 @@
=end item
our sub spew($filename, $contents) {
- my $handle := FileHandle.new();
+ my $handle := pir::new__Ps('FileHandle');
$handle.open($filename, 'w');
$handle.print($contents);
$handle.close();
Modified: branches/gsoc_threads/include/parrot/oplib/core_ops.h
==============================================================================
--- branches/gsoc_threads/include/parrot/oplib/core_ops.h Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/include/parrot/oplib/core_ops.h Tue Jun 15 17:35:18 2010 (r47645)
@@ -20,7 +20,7 @@
#include "parrot/oplib.h"
#include "parrot/runcore_api.h"
- op_lib_t *Parrot_DynOp_core_2_4_0(PARROT_INTERP, long init);
+ op_lib_t *Parrot_DynOp_core_2_5_0(PARROT_INTERP, long init);
opcode_t * Parrot_end(opcode_t *, PARROT_INTERP);
opcode_t * Parrot_noop(opcode_t *, PARROT_INTERP);
Modified: branches/gsoc_threads/lib/Parrot/Docs/Section/Parrot.pm
==============================================================================
--- branches/gsoc_threads/lib/Parrot/Docs/Section/Parrot.pm Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/lib/Parrot/Docs/Section/Parrot.pm Tue Jun 15 17:35:18 2010 (r47645)
@@ -31,17 +31,10 @@
use Parrot::Distribution;
use Parrot::Docs::Section::Developer;
-#use Parrot::Docs::Section::Examples;
use Parrot::Docs::Section::PMCs;
-#use Parrot::Docs::Section::C;
use Parrot::Docs::Section::Ops;
-#use Parrot::Docs::Section::IMCC;
-#use Parrot::Docs::Section::Perl;
-#use Parrot::Docs::Section::Libs;
use Parrot::Docs::Section::Tools;
use Parrot::Docs::Section::Compilers;
-#use Parrot::Docs::Section::Config;
-#use Parrot::Docs::Section::Tests;
use Parrot::Docs::Section::PDDs;
use Parrot::Docs::Section::PCT_Tutorial;
@@ -74,7 +67,6 @@
'',
$self->new_item( 'Running Parrot', 'docs/running.pod'),
$self->new_item( 'Testing Parrot', 'docs/tests.pod'),
-# Parrot::Docs::Section::Examples->new,
$self->new_item( 'Developer FAQ', 'docs/gettingstarted.pod'),
$self->new_item( 'Submitting Bug Reports & Patches', 'docs/submissions.pod' ),
),
@@ -122,13 +114,6 @@
$self->new_item( 'Chapter 4 Grammar Engine', 'docs/book/pct/ch04_pge.pod'),
$self->new_item( 'Chapter 5 Grammar Actions', 'docs/book/pct/ch05_nqp.pod'),
),
-
-# Parrot::Docs::Section::C->new,
-# Parrot::Docs::Section::IMCC->new,
-# Parrot::Docs::Section::Perl->new,
-# Parrot::Docs::Section::Libs->new,
-# Parrot::Docs::Section::Tests->new,
-# Parrot::Docs::Section::Config->new,
);
}
@@ -167,38 +152,6 @@
=back
-=head1 SEE ALSO
-
-=over 4
-
-=item C<Parrot::Docs::Section::Info>
-
-=item C<Parrot::Docs::Section::Docs>
-
-=item C<Parrot::Docs::Section::Examples>
-
-=item C<Parrot::Docs::Section::PMCs>
-
-=item C<Parrot::Docs::Section::C>
-
-=item C<Parrot::Docs::Section::Ops>
-
-=item C<Parrot::Docs::Section::IMCC>
-
-=item C<Parrot::Docs::Section::Perl>
-
-=item C<Parrot::Docs::Section::Libs>
-
-=item C<Parrot::Docs::Section::Tools>
-
-=item C<Parrot::Docs::Section::Compilers>
-
-=item C<Parrot::Docs::Section::Config>
-
-=item C<Parrot::Docs::Section::Tests>
-
-=back
-
=cut
1;
Modified: branches/gsoc_threads/lib/Parrot/Harness/DefaultTests.pm
==============================================================================
--- branches/gsoc_threads/lib/Parrot/Harness/DefaultTests.pm Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/lib/Parrot/Harness/DefaultTests.pm Tue Jun 15 17:35:18 2010 (r47645)
@@ -64,6 +64,7 @@
t/op/*.t
t/pmc/*.t
t/oo/*.t
+ t/pir/*.t
t/native_pbc/*.t
);
Added: branches/gsoc_threads/runtime/parrot/include/green_threads.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_threads/runtime/parrot/include/green_threads.pir Tue Jun 15 17:35:18 2010 (r47645)
@@ -0,0 +1,104 @@
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+#=head1 green_threads.pir
+#
+#Provides an implementation of preempting green threads in pure PIR.#
+#
+#=head1 Summary
+#
+# include 'green_threads.pir'
+# gt_init()
+# gt_spawn(sub1, arg1)
+# gt_spawn(sub2, arg1, arg2)
+#
+#=head2 gt_init ()
+#
+# Initialize green threads so they'll actually work.
+#
+#=head2 gt_spawn (my_sub, ...)
+#
+# Asyncronously run my_sub(...)
+#
+#=head2 gt_exit ()
+#
+# Exit the current green thread.
+#
+#=cut
+#
+
+.include 'interpinfo.pasm'
+.include 'timer.pasm'
+
+.macro_const GT_QUANTUM 0.5
+
+.sub gt_init
+ $P0 = new 'ResizablePMCArray'
+ set_global 'gt_threads', $P0
+
+ .tailcall gt_set_timer()
+.end
+
+.sub gt_set_timer
+ $P0 = new 'FixedPMCArray', 8
+ $P0[0] = .PARROT_TIMER_NSEC
+ $P0[1] = 1.0
+ $P0[2] = .PARROT_TIMER_HANDLER
+ $P1 = get_global 'gt_resched'
+ $P0[3] = $P1
+ $P0[4] = .PARROT_TIMER_REPEAT
+ $P0[5] = 0
+ $P0[6] = .PARROT_TIMER_RUNNING
+ $P0[7] = 1
+
+ $P2 = new 'Timer', $P0
+ set_global 'gt_resched_timer', $P2
+.end
+
+.sub gt_resched
+ .local pmc threads
+ threads = get_global 'gt_threads'
+
+ $I0 = threads
+ print "In gt_resched; t = "
+ say $I0
+
+ if $I0 <= 0 goto done
+
+ $P0 = interpinfo .INTERPINFO_CURRENT_CONT
+ push threads, $P0
+
+again:
+ $P0 = shift threads
+ invokecc $P0
+
+ $I0 = threads
+ if $I0 > 0 goto again
+
+done:
+ .return()
+.end
+
+.sub gt_spawn
+ .param pmc my_sub
+ .param pmc args :slurpy
+
+ $P0 = new 'Continuation'
+ set_addr $P0, run_sub
+
+ .local pmc threads
+ threads = get_global 'gt_threads'
+ push threads, $P0
+
+ .return()
+
+run_sub:
+ my_sub(args :flat)
+ .tailcall gt_resched()
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/gsoc_threads/runtime/parrot/library/LWP/UserAgent.pir
==============================================================================
--- branches/gsoc_threads/runtime/parrot/library/LWP/UserAgent.pir Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/runtime/parrot/library/LWP/UserAgent.pir Tue Jun 15 17:35:18 2010 (r47645)
@@ -17,7 +17,6 @@
=cut
.namespace ['LWP';'UserAgent']
-.loadlib 'io_ops'
.sub '' :init :load :anon
load_bytecode 'URI.pbc'
@@ -287,17 +286,19 @@
.sub 'progress' :method
.param string status
.param pmc msg
+ .local pmc stderr
+ stderr = getstderr
$P0 = getattribute self, 'show_progress'
if null $P0 goto L1
unless $P0 goto L1
unless status == 'begin' goto L2
- printerr "** "
+ print stderr, "** "
$P0 = getattribute msg, 'method'
- printerr $P0
- printerr " "
+ print stderr, $P0
+ print stderr, " "
$P0 = getattribute msg, 'uri'
- printerr $P0
- printerr " ==> "
+ print stderr, $P0
+ print stderr, " ==> "
$N1 = time
$P0 = box $N1
setattribute self, 'progress_start', $P0
@@ -316,15 +317,15 @@
setattribute self, 'progress_lastp', $P0
setattribute self, 'progress_ani', $P0
$S0 = msg.'status_line'()
- printerr $S0
+ print stderr, $S0
$N0 =$N2 - $N1
$I0 = $N0
unless $I0 goto L4
- printerr " ("
- printerr $I0
- printerr "s)"
+ print stderr, " ("
+ print stderr, $I0
+ print stderr, "s)"
L4:
- printerr "\n"
+ print stderr, "\n"
goto L1
L3:
unless status == 'tick' goto L5
@@ -333,8 +334,8 @@
$P0 %= 4
$P1 = split '', '-\|/'
$S0 = $P1[$P0]
- printerr $S0
- printerr "\b"
+ print stderr, $S0
+ print stderr, "\b"
goto L1
L5:
$N0 = status
@@ -347,8 +348,8 @@
$S0 = $P0
if $S0 == $S1 goto L1
set $P0, $S1
- printerr $S1
- printerr "\b\b\b\b"
+ print stderr, $S1
+ print stderr, "\b\b\b\b"
L1:
.end
Modified: branches/gsoc_threads/src/io/io_private.h
==============================================================================
--- branches/gsoc_threads/src/io/io_private.h Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/src/io/io_private.h Tue Jun 15 17:35:18 2010 (r47645)
@@ -27,23 +27,19 @@
#define PARROT_IN_IO 1
#define PARROT_ASYNC_DEVEL 0
-#define PARROT_NET_DEVEL 1
#include <parrot/io.h>
-#if PARROT_NET_DEVEL
/* XXX: Parrot config is currently not probing for all headers so
* I'm sticking here rather than parrot.h
*/
-# ifdef UNIX
-# include <sys/socket.h>
-# endif
-
-# ifdef WIN32
-# include <winsock.h>
-# endif
+#ifdef UNIX
+# include <sys/socket.h>
+#endif
-#endif /* PARROT_NET_DEVEL */
+#ifdef WIN32
+# include <winsock.h>
+#endif
/* IO object flags */
#define PIO_F_READ 00000001
Modified: branches/gsoc_threads/src/io/socket_unix.c
==============================================================================
--- branches/gsoc_threads/src/io/socket_unix.c Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/src/io/socket_unix.c Tue Jun 15 17:35:18 2010 (r47645)
@@ -67,8 +67,6 @@
=head2 Networking
-Define C<PARROT_NET_DEVEL> to enable networking.
-
These could be native extensions but they probably should be here if we
wish to make them integrated with the async IO system.
@@ -110,8 +108,6 @@
}
-# if PARROT_NET_DEVEL
-
/*
=item C<INTVAL Parrot_io_socket_unix(PARROT_INTERP, PMC *s, int fam, int type,
@@ -314,13 +310,13 @@
switch (errno) {
case EINTR:
goto AGAIN;
-# ifdef EWOULDBLOCK
+# ifdef EWOULDBLOCK
case EWOULDBLOCK:
goto AGAIN;
-# else
+# else
case EAGAIN:
goto AGAIN;
-# endif
+# endif
case EPIPE:
/* XXX why close it here and not below */
close(io->os_handle);
@@ -363,13 +359,13 @@
switch (errno) {
case EINTR:
goto AGAIN;
-# ifdef EWOULDBLOCK
+# ifdef EWOULDBLOCK
case EWOULDBLOCK:
goto AGAIN;
-# else
+# else
case EAGAIN:
goto AGAIN;
-# endif
+# endif
case ECONNRESET:
/* XXX why close it on err return result is -1 anyway */
close(io->os_handle);
@@ -457,12 +453,12 @@
const int family = AF_INET;
struct sockaddr_in * const sa = (struct sockaddr_in*)VTABLE_get_pointer(interp, sockaddr);
-# ifdef PARROT_DEF_INET_ATON
+# ifdef PARROT_DEF_INET_ATON
if (inet_aton(host, &sa->sin_addr) != 0) {
-# else
+# else
/* positive retval is success */
if (inet_pton(family, host, &sa->sin_addr) > 0) {
-# endif
+# endif
/* Success converting numeric IP */
}
else {
@@ -482,7 +478,6 @@
sa->sin_family = family;
sa->sin_port = htons(port);
}
-# endif
#endif /* PIO_OS_UNIX */
Modified: branches/gsoc_threads/src/io/socket_win32.c
==============================================================================
--- branches/gsoc_threads/src/io/socket_win32.c Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/src/io/socket_win32.c Tue Jun 15 17:35:18 2010 (r47645)
@@ -51,13 +51,11 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
-# if PARROT_NET_DEVEL
-
/* Helper macros to get sockaddr_in */
-# define SOCKADDR_LOCAL(p) ((struct sockaddr_in*)VTABLE_get_pointer(interp, \
- PARROT_SOCKET((p))->local))
-# define SOCKADDR_REMOTE(p) ((struct sockaddr_in*)VTABLE_get_pointer(interp, \
- PARROT_SOCKET((p))->remote))
+# define SOCKADDR_LOCAL(p) ((struct sockaddr_in*)VTABLE_get_pointer(interp, \
+ PARROT_SOCKET((p))->local))
+# define SOCKADDR_REMOTE(p) ((struct sockaddr_in*)VTABLE_get_pointer(interp, \
+ PARROT_SOCKET((p))->remote))
/*
@@ -262,13 +260,13 @@
switch (errno) {
case WSAEINTR:
goto AGAIN;
-# ifdef WSAEWOULDBLOCK
+# ifdef WSAEWOULDBLOCK
case WSAEWOULDBLOCK:
goto AGAIN;
-# else
+# else
case WSAEAGAIN:
goto AGAIN;
-# endif
+# endif
case EPIPE:
/* XXX why close it here and not below */
close((int)io->os_handle);
@@ -311,13 +309,13 @@
switch (errno) {
case EINTR:
goto AGAIN;
-# ifdef WSAEWOULDBLOCK
+# ifdef WSAEWOULDBLOCK
case WSAEWOULDBLOCK:
goto AGAIN;
-# else
+# else
case WSAEAGAIN:
goto AGAIN;
-# endif
+# endif
case WSAECONNRESET:
/* XXX why close it on err return result is -1 anyway */
close((int)io->os_handle);
@@ -452,8 +450,6 @@
return sockaddr;
}
-# endif /* PARROT_NET_DEVEL */
-
#endif /* PIO_OS_WIN32 */
/*
Modified: branches/gsoc_threads/src/io/win32.c
==============================================================================
--- branches/gsoc_threads/src/io/win32.c Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/src/io/win32.c Tue Jun 15 17:35:18 2010 (r47645)
@@ -134,10 +134,8 @@
{
ASSERT_ARGS(Parrot_io_init_win32)
HANDLE h;
-# if PARROT_NET_DEVEL
struct WSAData sockinfo;
int ret;
-# endif
if ((h = GetStdHandle(STD_INPUT_HANDLE)) != INVALID_HANDLE_VALUE) {
_PIO_STDIN(interp) = Parrot_io_fdopen_win32(interp, PMCNULL, h, PIO_F_READ);
@@ -157,7 +155,6 @@
else {
_PIO_STDERR(interp) = PMCNULL;
}
-# if PARROT_NET_DEVEL
/* Start Winsock
* no idea where or whether destroy it
*/
@@ -167,7 +164,6 @@
WSAGetLastError());
return -4;
}
-# endif
return 0;
}
Modified: branches/gsoc_threads/src/ops/core_ops.c
==============================================================================
--- branches/gsoc_threads/src/ops/core_ops.c Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/src/ops/core_ops.c Tue Jun 15 17:35:18 2010 (r47645)
@@ -25138,7 +25138,7 @@
}
}
op_lib_t *
-Parrot_DynOp_core_2_4_0(PARROT_INTERP, long init) {
+Parrot_DynOp_core_2_5_0(PARROT_INTERP, long init) {
/* initialize and return op_lib ptr */
if (init == 1) {
@@ -25167,7 +25167,7 @@
{
PMC *const lib = Parrot_pmc_new(interp, enum_class_ParrotLibrary);
- ((Parrot_ParrotLibrary_attributes*)PMC_data(lib))->oplib_init = (void *) Parrot_DynOp_core_2_4_0;
+ ((Parrot_ParrotLibrary_attributes*)PMC_data(lib))->oplib_init = (void *) Parrot_DynOp_core_2_5_0;
dynop_register(interp, lib);
return lib;
}
Modified: branches/gsoc_threads/src/pmc/scheduler.pmc
==============================================================================
--- branches/gsoc_threads/src/pmc/scheduler.pmc Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/src/pmc/scheduler.pmc Tue Jun 15 17:35:18 2010 (r47645)
@@ -251,6 +251,7 @@
*/
VTABLE void destroy() {
Parrot_Scheduler_attributes * const core_struct = PARROT_SCHEDULER(SELF);
+ core_struct->interp->scheduler = NULL;
/* TT #946: this line is causing an order-of-destruction error
because the scheduler is being freed before its tasks.
Commenting this out till we get a real fix (although it's a hack) */
Modified: branches/gsoc_threads/src/pmc/stringhandle.pmc
==============================================================================
--- branches/gsoc_threads/src/pmc/stringhandle.pmc Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/src/pmc/stringhandle.pmc Tue Jun 15 17:35:18 2010 (r47645)
@@ -109,12 +109,9 @@
PMC * const copy = Parrot_pmc_new(INTERP, enum_class_StringHandle);
Parrot_StringHandle_attributes * const data_struct = PARROT_STRINGHANDLE(copy);
- if (old_struct->stringhandle != NULL)
- data_struct->stringhandle = old_struct->stringhandle;
- if (old_struct->mode != NULL)
- data_struct->mode = old_struct->mode;
- if (old_struct->encoding != NULL)
- data_struct->encoding = old_struct->encoding;
+ data_struct->stringhandle = old_struct->stringhandle;
+ data_struct->mode = old_struct->mode;
+ data_struct->encoding = old_struct->encoding;
data_struct->flags = old_struct->flags;
return copy;
Modified: branches/gsoc_threads/src/pmc/stringiterator.pmc
==============================================================================
--- branches/gsoc_threads/src/pmc/stringiterator.pmc Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/src/pmc/stringiterator.pmc Tue Jun 15 17:35:18 2010 (r47645)
@@ -139,19 +139,21 @@
VTABLE void set_integer_native(INTVAL value) {
Parrot_StringIterator_attributes * const attrs =
PARROT_STRINGITERATOR(SELF);
- if (value == ITERATE_FROM_START) {
+ switch (value) {
+ case ITERATE_FROM_START:
attrs->reverse = 0;
attrs->pos = 0;
attrs->length = VTABLE_elements(INTERP, attrs->string);
- }
- else if (value == ITERATE_FROM_END) {
+ break;
+ case ITERATE_FROM_END:
attrs->reverse = 1;
attrs->pos = attrs->length
= VTABLE_elements(INTERP, attrs->string);
- }
- else
+ break;
+ default:
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"Wrong direction for StringIterator");
+ }
}
/*
Modified: branches/gsoc_threads/src/pmc/timer.pmc
==============================================================================
--- branches/gsoc_threads/src/pmc/timer.pmc Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/src/pmc/timer.pmc Tue Jun 15 17:35:18 2010 (r47645)
@@ -105,7 +105,7 @@
=item C<void init_pmc(PMC *init)>
-See F<docs/pdds/pdd02_vtables.pod> for initializers.
+Takes an even-length collection of keys and values.
=cut
Modified: branches/gsoc_threads/src/scheduler.c
==============================================================================
--- branches/gsoc_threads/src/scheduler.c Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/src/scheduler.c Tue Jun 15 17:35:18 2010 (r47645)
@@ -405,7 +405,7 @@
Parrot_cx_delete_task(PARROT_INTERP, ARGIN(PMC *task))
{
ASSERT_ARGS(Parrot_cx_delete_task)
- if (interp->scheduler && !PObj_on_free_list_TEST(interp->scheduler)) {
+ if (interp->scheduler) {
const INTVAL tid = VTABLE_get_integer(interp, task);
VTABLE_delete_keyed_int(interp, interp->scheduler, tid);
}
Modified: branches/gsoc_threads/t/compilers/imcc/syn/regressions.t
==============================================================================
--- branches/gsoc_threads/t/compilers/imcc/syn/regressions.t Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/t/compilers/imcc/syn/regressions.t Tue Jun 15 17:35:18 2010 (r47645)
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 22;
+use Parrot::Test tests => 21;
pir_error_output_like( <<'CODE', <<'OUT', 'invalid get_results syntax');
.sub main :main
@@ -191,19 +191,6 @@
3
OUT
-TODO: {
- local $TODO = "works in PIR, not PASM";
-
-pasm_output_is( <<"CODE", <<'OUT', 'long register numbers in PASM (TT #1025)');
- new P$register, 'Integer'
- assign P$register, 3
- say P$register
-CODE
-3
-OUT
-
-}
-
pir_error_output_like( <<'CODE', <<'OUT', 'die in immediate, TT #629');
.sub 'foo' :immediate
die 'no'
Copied: branches/gsoc_threads/t/oo/objects.t (from r47644, trunk/t/oo/objects.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_threads/t/oo/objects.t Tue Jun 15 17:35:18 2010 (r47645, copy of r47644, trunk/t/oo/objects.t)
@@ -0,0 +1,1791 @@
+#!./parrot
+# Copyright (C) 2001-2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+t/oo/objects.t - Objects
+
+=head1 SYNOPSIS
+
+ % prove t/oo/objects.t
+
+=head1 DESCRIPTION
+
+Tests the object/class subsystem.
+
+=cut
+
+.sub main :main
+ .include 'test_more.pir'
+ .include "iglobals.pasm"
+ .include "interpinfo.pasm"
+
+ plan(194)
+
+ get_classname_from_class()
+ test_get_class()
+ test_isa()
+ does_scalar()
+ does_array()
+ new_object()
+ new_object__isa_test()
+ new_object__classname()
+ isa_subclass()
+ isa_subclass__objects()
+ test_addmethod()
+ test_addattribute()
+ addattribute_subclass()
+ addattribute_subclass__same_name()
+ set_and_get_object_attribs()
+ set_and_get_multiple_object_attribs()
+ attribute_values_are_specific_to_objects()
+ attribute_values_and_subclassing()
+ attribute_values_and_subclassing_2()
+ PMC_as_classes__overridden_mmd_methods()
+ typeof_class()
+ typeof_objects()
+ multiple_inheritance__with_attributes()
+ attributes_two_levels_of_inheritance()
+ class_op_test()
+ anon_subclass_has_no_name()
+ get_attrib_by_name()
+ get_attrib_by_name_subclass()
+ set_attrib_by_name_subclass()
+ PMC_as_classes()
+ PMC_as_classes__subclass()
+ PMC_as_classes__instantiate()
+ PMC_as_classes__methods()
+ PMC_as_classes__mmd_methods()
+ PMC_as_classes__derived_1()
+ PMC_as_classes__derived_2()
+ PMC_as_classes__derived_3()
+ subclassing_Class()
+ namespace_vs_name()
+ multiple_anon_classes()
+ subclassed_Integer_bug()
+ equality_of_subclassed_Integer()
+ short_name_attributes()
+ init_with_and_without_arg()
+ newclass_bracket_parsing()
+ verify_namespace_types()
+ verify_data_type()
+ new_keyed()
+ new_keyed_2()
+ new_keyed_3()
+ subclass_keyed()
+ test_class_name_multipart_name()
+ test_get_class_multipart_name()
+ isa_bug()
+ new_nested_ordering()
+ vtable_override_once_removed()
+ vtable_fails_for_subclasses_of_core_classes()
+ super___init_called_twice()
+ using_class_object_from_typeof_op_with_new()
+ setting_non_existent_attribute()
+ setting_non_existent_attribute_by_name()
+ getting_null_attribute()
+ getting_non_existent_attribute()
+ addparent_exceptions_1()
+ addparent_exceptions_2()
+ subclassing_a_non_existent_class()
+ anon_subclass_of_non_existent_class()
+ addattribute_duplicate()
+ wrong_way_to_create_new_objects()
+ attribute_values__subclassing_access_meths()
+ attribute_values__inherited_access_meths()
+
+ # END_OF_TESTS
+.end
+
+.sub get_classname_from_class
+ newclass $P1, "Foo5"
+ set $S0, $P1
+ is( $S0, "Foo5", "got classname Foo5" )
+
+ subclass $P2, $P1, "Bar5"
+ set $S1, $P2
+ is( $S1, "Bar5", "got subclass Bar5" )
+
+ subclass $P3, "Foo5", "Baz5"
+ set $S2, $P3
+ is( $S2, "Baz5", "got subclass Baz5" )
+.end
+
+.sub test_get_class
+ newclass $P1, "Foo6"
+ get_class $P2, "Foo6"
+ set $S2, $P2
+ is( $S2, "Foo6", 'get_class for Foo6' )
+
+ subclass $P3, $P1, "FooBar6"
+ get_class $P4, "FooBar6"
+ set $S4, $P4
+ is( $S4, 'FooBar6', 'get_class for FooBar6' )
+
+ get_class $P3, "NoSuch6"
+ isnull $I0, $P3
+ ok( $I0, "no class for 'NoSuch6'" )
+.end
+
+.sub test_isa
+ new $P1, ['Boolean']
+
+ isa $I0, $P1, "Boolean"
+ is( $I0, 1, 'Boolean isa Boolean' )
+
+ isa $I0, $P1, "Bool"
+ is( $I0, 0, 'Boolean !isa Bool' )
+
+ isa $I0, $P1, "scalar"
+ is( $I0, 1, 'Boolean isa scalar' )
+
+ isa $I0, $P1, "calar"
+ is( $I0, 0, 'Boolean !isa calar' )
+
+ isa $I0, $P1, "Integer"
+ is( $I0, 1, 'Boolean isa Integer' )
+
+ isa $I0, $P1, "Integ"
+ is( $I0, 0, 'Boolean !isa Integ' )
+
+ isa $I0, $P1, "eger"
+ is( $I0, 0, 'Boolean !isa eger' )
+
+ isa $I0, $P1, " "
+ is( $I0, 0, 'Boolean !isa " "' )
+
+ isa $I0, $P1, ""
+ is( $I0, 0, 'Boolean !isa ""' )
+
+ null $S0
+ isa $I0, $P1, $S0
+ is( $I0, 0, 'Boolean !isa null $S0' )
+
+ set $S0, "scalar"
+ isa $I0, $P1, $S0
+ is( $I0, 1, 'Boolean isa scalar $S0' )
+.end
+
+.sub does_scalar
+ new $P1, ['Boolean']
+
+ does $I0, $P1, "Boolean"
+ is( $I0, 0, 'Boolean !does Boolean' )
+
+ does $I0, $P1, "Bool"
+ is( $I0, 0, 'Boolean !does Bool' )
+
+ does $I0, $P1, "scalar"
+ is( $I0, 1, 'Boolean does scalar' )
+.end
+
+.sub does_array
+ new $P1, ['OrderedHash']
+
+ does $I0, $P1, "Boolean"
+ is( $I0, 0, 'OrderedHash !does Boolean' )
+
+ does $I0, $P1, "Bool"
+ is( $I0, 0, 'OrderedHash !does Bool' )
+
+ does $I0, $P1, "hash"
+ is( $I0, 1, 'OrderedHash does hash' )
+
+ does $I0, $P1, "array"
+ is( $I0, 1, 'OrderedHash does array' )
+.end
+
+.sub new_object
+ newclass $P1, "Foo7"
+ new $P2, "Foo7"
+ ok( 1, 'created new object from Foo7 class' )
+.end
+
+.sub new_object__isa_test
+ newclass $P1, "Foo8"
+ new $P2, $P1
+ ok( 1, 'created new object from Foo8 class' )
+
+ isa $I0, $P2, "Foo8"
+ ok( $I0, 'new object isa Foo8' )
+.end
+
+.sub new_object__classname
+ newclass $P1, "Foo9"
+ new $P2, $P1
+ set $S0, $P1 # class
+ is( $S0, "Foo9", 'new object from Foo9 class as a string is Foo9' )
+
+ typeof $S0, $P2 # object
+ is( $S0, 'Foo9', 'typeof obj is Foo9' )
+
+ class $P3, $P1
+ set $S0, $P1 # class
+ is( $S0, 'Foo9', 'class of obj is Foo9' )
+
+ typeof $S0, $P2 # object
+ is( $S0, 'Foo9', 'typeof obj is Foo9' )
+
+.end
+
+.sub isa_subclass
+ newclass $P1, "Foo10"
+ subclass $P2, $P1, "Bar10"
+
+ isa_ok( $P2, "Foo10", 'newclass isa Foo10' )
+ isa_ok( $P2, "Bar10", 'new subclass isa Bar10' )
+ isa_ok( $P2, "Foo10", 'new subclass isa parent' )
+ isa_ok( $P2, "Class", 'new subclass isa Class' )
+
+ isa $I0, $P2, "Object"
+ is( $I0, 0, 'new subclass !isa Object' )
+.end
+
+.sub isa_subclass__objects
+ newclass $P3, "Foo30"
+ subclass $P4, $P3, "Bar30"
+ $P1 = $P3.'new'()
+ $P2 = $P4.'new'()
+
+ isa_ok( $P1, "Foo30", 'obj isa its class' )
+ isa_ok( $P2, "Bar30", 'obj isa its class' )
+ isa_ok( $P2, "Foo30", 'obj isa its parent class' )
+ isa_ok( $P2, "Object", 'obj isa Object' )
+ isa_ok( $P2, "Class", 'obj isa Class' )
+.end
+
+.sub test_addmethod
+ newclass $P0, 'Foo31'
+ $P2 = get_hll_global 'sayFoo31'
+
+ # add a method BEFORE creating a Foo object
+ addmethod $P0, 'foo31', $P2
+ $P1 = new 'Foo31'
+ $P1.'foo31'()
+
+ # get a method from some other namespace
+ $P2 = get_hll_global ['Bar31'], 'sayBar31'
+
+ # add a method AFTER creating the object
+ addmethod $P0, 'bar31', $P2
+ $P1.'bar31'()
+.end
+
+.sub sayFoo31
+ ok( 1, 'called method added before creating obj' )
+.end
+
+.namespace ['Bar31']
+.sub sayBar31
+ ok( 1, 'called method added after created obj' )
+.end
+
+.namespace [] # Reset to root namespace for next test
+
+.sub test_addattribute
+ newclass $P1, "Foo11"
+
+ addattribute $P1, "foo_i"
+ ok( 1, 'addattribute did not blow up' )
+
+ set $S0, $P1
+ is( $S0, "Foo11", '$P1 is still the same class as PMC' )
+
+ # Check that we can add multiple attributes
+ set $I0, 0
+l1:
+ set $S0, $I0
+ addattribute $P1, $S0
+ inc $I0
+ lt $I0, 1000, l1
+ ok( 1, 'addattribute 1000x without blow up' )
+.end
+
+.sub addattribute_subclass
+ newclass $P1, "Foo12"
+ addattribute $P1, "foo_i"
+ ok( 1, 'addattribute to Foo12' )
+
+ subclass $P2, $P1, "Bar12"
+ addattribute $P2, "bar_i"
+ ok( 1, 'addattribute to subclass of Foo12' )
+.end
+
+.sub addattribute_subclass__same_name
+ newclass $P1, "Foo32"
+ addattribute $P1, "i"
+ addattribute $P1, "j"
+
+ subclass $P2, $P1, "Bar32"
+ addattribute $P2, "j"
+ addattribute $P2, "k"
+
+ ok( 1, 'created class and subclass and added attributes' )
+
+ .local pmc o
+ o = $P2.'new'()
+ $P0 = getattribute o, 'i'
+ is( $P0, 'Foo32.i', 'parent attrib initialized in init' )
+ $P0 = getattribute o, ['Foo32'], 'j'
+ is( $P0, 'Foo32.j', 'parent attrib initialized in init' )
+ $P0 = getattribute o, ['Bar32'], 'j'
+ is( $P0, 'Bar32.j', 'subclass attrib initialized in init' )
+ $P0 = getattribute o, 'k'
+ is( $P0, 'Bar32.k', 'subclass attrib initialized in init' )
+
+ $P0 = getattribute o, 'i'
+ is( $P0, 'Foo32.i', 'parent attrib init-ed' )
+ $P0 = getattribute o, ['Foo32'], "j"
+ is( $P0, 'Foo32.j', 'parent attrib init-ed' )
+ $P0 = getattribute o, 'j'
+ is( $P0, 'Bar32.j', 'subclass attrib returned over parent' )
+ $P0 = getattribute o, 'k'
+ is( $P0, 'Bar32.k', 'subclass attrib init-ed' )
+.end
+
+.namespace ['Bar32']
+
+.sub init :vtable :method
+ $P0 = new ['String']
+ $P0 = 'Foo32.i'
+ setattribute self, ['Foo32'], "i", $P0
+ $P0 = new ['String']
+ $P0 = 'Foo32.j'
+ setattribute self, ["Foo32"], "j", $P0
+ $P0 = new ['String']
+ $P0 = 'Bar32.j'
+ setattribute self, ["Bar32"], "j", $P0
+ $P0 = new ['String']
+ $P0 = 'Bar32.k'
+ setattribute self, ["Bar32"], "k", $P0
+.end
+
+.namespace [] # Reset to root namespace for next test
+
+.sub set_and_get_object_attribs
+ newclass $P1, "Foo13"
+ addattribute $P1, "i"
+ new $P2, $P1
+
+ new $P3, ['Integer']
+ set $P3, 1024
+ setattribute $P2, "i", $P3
+
+ new $P4, ['Integer']
+ getattribute $P4, $P2, "i"
+
+ is( $P4, 1024, 'set/get Integer attribute' )
+.end
+
+.sub set_and_get_multiple_object_attribs
+ newclass $P1, "Foo14"
+ addattribute $P1, "i"
+ addattribute $P1, "j"
+ new $P2, "Foo14"
+
+ new $P3, ['Integer']
+ set $P3, 4201
+ new $P4, ['Hash']
+ set $P4["Key"], "Value"
+
+ setattribute $P2, "i", $P3
+ setattribute $P2, "j", $P4
+
+ getattribute $P5, $P2, "i"
+ is( $P5, '4201', 'set/get Integer attribute' )
+
+ getattribute $P6, $P2, "j"
+ set $S0, $P6["Key"]
+ is( $S0, 'Value', 'set/get Hash attribute on same obj' )
+.end
+
+.sub attribute_values_are_specific_to_objects
+ newclass $P1, "Foo15"
+ addattribute $P1, "i"
+ new $P2, $P1
+ new $P3, $P1
+
+ new $P4, ['Integer']
+ set $P4, 100
+ setattribute $P2, "i", $P4
+ new $P5, ['String']
+ set $P5, "One hundred"
+ setattribute $P3, "i", $P5
+
+ getattribute $P6, $P2, "i"
+ is( $P6, 100, 'attribute value on 1st object is specific to obj' )
+
+ getattribute $P6, $P3, "i"
+ is( $P6, 'One hundred', 'attribute value on 2nd obj is specific to obj' )
+.end
+
+.sub attribute_values_and_subclassing
+ newclass $P1, "Foo16"
+ addattribute $P1, "i"
+ addattribute $P1, "j"
+ subclass $P2, $P1, "Bar16"
+ addattribute $P2, "k"
+ addattribute $P2, "l"
+
+ new $P2, "Bar16"
+ new $P3, "Bar16"
+
+ # Note that setattribute holds the actual PMC, not a copy, so
+ # in this test both attributes get the PMC from $P4, and should
+ # both have the same value, despite the C<inc>.
+ new $P4, ['Integer']
+ set $P4, 10
+ setattribute $P2, "i", $P4
+ inc $P4
+ setattribute $P2, "j", $P4
+
+ new $P5, ['Integer']
+ set $P5, 100
+ setattribute $P3, "i", $P5
+ inc $P5
+ setattribute $P3, "j", $P5
+
+ getattribute $P6, $P2, "i"
+ is( $P6, 11, 'setattrib with a PMC holds actual PMC not copy' )
+
+ getattribute $P6, $P2, "j"
+ is( $P6, 11, '...so changes to the PMC appear through the attrib' )
+
+ getattribute $P6, $P3, "i"
+ is( $P6, 101, '...and second test on new objects' )
+
+ getattribute $P6, $P3, "j"
+ is( $P6, 101, '...should have same result' )
+.end
+
+.sub attribute_values_and_subclassing_2
+ newclass $P1, "Foo17"
+ # must add attributes before object instantiation
+ addattribute $P1, ".i"
+ addattribute $P1, ".j"
+
+ subclass $P2, $P1, "Bar17"
+ addattribute $P2, ".k"
+ addattribute $P2, ".l"
+
+ # subclass is preferred for the SI case over
+ # newclass $P2, "Bar"
+ # addattrib ...
+ # addparent $P2, $P1
+ # which is suitable for adding multiple parents to one class
+
+ # instantiate a Bar object
+ new $P3, "Bar17"
+
+ # Set the attribute values
+ new $P10, ['String'] # set attribute values
+ set $P10, "i" # attribute slots have reference semantics
+ setattribute $P3, ".i", $P10 # so always put new PMCs in
+ # if you have unique values
+ new $P10, ['String']
+ set $P10, "j"
+ setattribute $P3, ".j", $P10
+
+ new $P10, ['String']
+ set $P10, "k"
+ setattribute $P3, ".k", $P10
+
+ new $P10, ['String']
+ set $P10, "l"
+ setattribute $P3, ".l", $P10
+
+ # retrieve attribs
+ getattribute $P11, $P3, ".i"
+ is( $P11, "i", 'string attribute get/set on parent' )
+
+ getattribute $P11, $P3, ".j"
+ is( $P11, "j", 'string attribute get/set on parent' )
+
+ getattribute $P11, $P3, ".k"
+ is( $P11, "k", 'string attribute get/set on subclass' )
+
+ getattribute $P11, $P3, ".l"
+ is( $P11, "l", 'string attribute get/set on subclass' )
+.end
+
+.sub PMC_as_classes__overridden_mmd_methods
+ .local pmc myint, i, j, k
+
+ get_class $P0, "Integer"
+ subclass myint, $P0, "MyInt1"
+
+ i = new 'MyInt1'
+ j = new 'MyInt1'
+ k = new 'MyInt1'
+ i = 6
+ j = 7
+ k = i + j
+
+ is( k, 13, 'added two MyInt1' )
+
+ j = new ['Integer']
+ j = 100
+ k = i + j
+
+ is( k, 106, 'added MyInt1 and an Integer' )
+.end
+
+.namespace ["MyInt1"]
+
+.sub add :multi(MyInt1, MyInt1, MyInt1)
+ .param pmc self
+ .param pmc right
+ .param pmc dest
+ ok( 1, 'in the add method' )
+ $P0 = getattribute self, ['Integer'], "proxy"
+ $I0 = $P0
+ $I1 = right
+ $I2 = $I0 + $I1
+ dest = $I2
+ .return(dest)
+.end
+
+.namespace [] # Reset to root namespace for next test
+
+.sub typeof_class
+ newclass $P0, "Foo21"
+ typeof $S0, $P0
+ is( $S0, "Class", 'typeof for a Class PMC is "Class"' )
+.end
+
+.sub typeof_objects
+ newclass $P0, "A"
+ newclass $P1, "B"
+
+ new $P0, ['A']
+ new $P1, ['B']
+
+ typeof $S0, $P0
+ typeof $S1, $P1
+
+ is( $S0, 'A', 'typeof object of class A is "A"' )
+ is( $S1, 'B', 'typeof object of class B is "B"' )
+.end
+
+.sub multiple_inheritance__with_attributes
+ newclass $P1, "Star"
+ addattribute $P1, "Spectral Type"
+
+ newclass $P2, "Company"
+ addattribute $P2, "Annual Profit"
+
+ subclass $P3, $P1, "Sun"
+ addparent $P3, $P2
+
+ new $P4, ['Sun']
+
+ new $P5, ['String']
+ set $P5, "G"
+ setattribute $P4, "Spectral Type", $P5
+
+ new $P6, ['String']
+ set $P6, "$100,000,000"
+ setattribute $P4, "Annual Profit", $P6
+
+ getattribute $P7, $P4, "Spectral Type"
+ is( $P7, 'G', 'direct parents attribute' )
+
+ getattribute $P8, $P4, "Annual Profit"
+ is( $P8, '$100,000,000', "addparent's attribute" )
+.end
+
+.sub attributes_two_levels_of_inheritance
+ newclass $P0, "Astronomical Object"
+ addattribute $P0, "Location"
+
+ subclass $P1, $P0, "Star2"
+ addattribute $P1, "Spectral Type"
+
+ newclass $P2, "Sun2"
+ addparent $P2, $P1
+ addparent $P2, $P0
+
+ new $P4, "Sun2"
+
+ new $P5, ['String']
+ set $P5, "Taurus"
+ setattribute $P4, "Location", $P5
+ getattribute $P6, $P4, "Location"
+ is( $P6, 'Taurus', 'attributes with two levels of inheritance' )
+.end
+
+.sub class_op_test
+ newclass $P0, "City1"
+ new $P1, "City1"
+
+ class $P2, $P1
+ set $S0, $P2
+ is( $S0, 'City1', 'class op works' )
+.end
+
+.sub anon_subclass_has_no_name
+ newclass $P0, "City2"
+ subclass $P1, $P0
+ set $S0, $P1
+ is( $S0, '', 'anonymous subclass has no name' )
+.end
+
+.sub get_attrib_by_name
+ newclass $P1, "Foo18"
+ addattribute $P1, "i"
+ new $P2, "Foo18"
+ new $P3, ['String']
+ set $P3, "ok"
+ setattribute $P2, "i", $P3
+
+ getattribute $P4, $P2, ["Foo18"], "i"
+ is( $P4, 'ok', 'get attrib by name' )
+.end
+
+.sub get_attrib_by_name_subclass
+ newclass $P0, "Bar19"
+ addattribute $P0, "j"
+
+ subclass $P1, $P0, "Foo19"
+ addattribute $P1, "i"
+
+ new $P2, "Foo19"
+
+ new $P3, ['String']
+ set $P3, "foo i"
+ setattribute $P2, "i", $P3
+
+ new $P3, ['String']
+ set $P3, "bar j"
+ setattribute $P2, "j", $P3
+
+ getattribute $P4, $P2, ["Foo19"], "i"
+ is( $P4, 'foo i', 'attribute from subclass get by name' )
+
+ getattribute $P4, $P2, ["Bar19"], "j"
+ is( $P4, 'bar j', 'attribute from parent class get by name' )
+.end
+
+.sub set_attrib_by_name_subclass
+ newclass $P0, "Bar20"
+ addattribute $P0, "j"
+
+ subclass $P1, $P0, "Foo20"
+ addattribute $P1, "i"
+
+ new $P2, "Foo20"
+
+ new $P3, ['String']
+ set $P3, "foo i"
+ setattribute $P2, ["Foo20"], "i", $P3
+
+ new $P3, ['String']
+ set $P3, "bar j"
+ setattribute $P2, ["Bar20"], "j", $P3
+
+ getattribute $P4, $P2, "i"
+ is( $P4, 'foo i', 'attribute from subclass set by name' )
+
+ getattribute $P4, $P2, "j"
+ is( $P4, 'bar j', 'attribute from parent class set by name' )
+.end
+
+.sub PMC_as_classes
+ get_class $P0, "Integer"
+ ok( 1, "get_class of Integer did't croak" )
+
+ get_class $P0, "Integer"
+ ok( 1, "get_class of Integer did't croak second time" )
+
+ typeof $S0, $P0
+ is( $S0, 'PMCProxy', 'typeof PMCProxy' )
+.end
+
+.sub PMC_as_classes__subclass
+ .local pmc MyInt3
+ get_class $P0, "Integer"
+ ok( 1, "get_class on Integer didn't blow up" )
+
+ subclass MyInt3, $P0, "MyInt3"
+ ok( 1, "subclassing didn't blow up" )
+
+ $S0 = typeof MyInt3
+ is( $S0, 'Class', 'new subclass is typeof Class' )
+
+ $I0 = isa MyInt3, "MyInt3"
+ ok( $I0, 'new subclass isa MyInt' )
+
+ $I0 = isa MyInt3, "Integer"
+ ok( $I0, 'new subclass isa parent class' )
+.end
+
+.sub PMC_as_classes__instantiate
+ .local pmc MyInt4
+ get_class $P0, "Integer"
+ ok( 1, 'able to get_class of Integer' )
+
+ subclass MyInt4, $P0, "MyInt4"
+ addattribute MyInt4, ".i"
+ ok( 1, 'able to addattribute to subclass' )
+
+ .local pmc i
+ i = new "MyInt4"
+ ok( 1, 'able to instantiate obj of subclass w/ attribute' )
+.end
+
+.sub PMC_as_classes__methods
+ .local pmc MyInt5
+ get_class $P0, "Integer"
+
+ subclass MyInt5, $P0, "MyInt5"
+ addattribute MyInt5, "intval"
+
+ .local pmc i, i2
+ i = new "MyInt5"
+ i2 = new ['Integer']
+ i2 = 43
+
+ i = 42 # set_integer is inherited from Integer
+ ok( 1, 'able to assign int to MyInt' )
+
+ $I0 = i # get_integer is overridden below
+ is( $I0, 42, 'get_integer is overridden for MyInt5' )
+
+ $S0 = i # get_string is overridden below
+ is( $S0, 'MyInt5(42)', 'get_string is overridden for MyInt5' )
+.end
+
+.namespace ["MyInt5"]
+
+.sub set_integer_native :vtable :method
+ .param int new_value
+ $P1 = new ['Integer']
+ $P1 = new_value
+ setattribute self, "intval", $P1
+.end
+
+.sub get_integer :vtable :method
+ $P0 = getattribute self, "intval"
+ $I0 = $P0
+ .return ($I0)
+.end
+
+.sub get_string :vtable :method
+ $P0 = getattribute self, "intval"
+ $I0 = $P0
+ $S1 = $I0
+ $S0 = "MyInt5("
+ $S0 .= $S1
+ $S0 .= ")"
+ .return ($S0)
+.end
+
+.namespace [] # Reset to root namespace for next test
+
+.sub PMC_as_classes__mmd_methods
+ .local pmc MyInt6
+ get_class $P0, "Integer"
+ subclass MyInt6, $P0, "MyInt6"
+ .local pmc i
+ .local pmc j
+ .local pmc k
+ i = new "MyInt6"
+ j = new "MyInt6"
+ k = new "MyInt6"
+ i = 6
+ j = 7
+ k = i * j
+ $I0 = k
+ is( $I0, 42, 'MyInt6 defaults to Integer class for mult' )
+
+ $S0 = k # get_string is overridden below
+ is( $S0, 'MyInt6(42)', 'get_string is overridden for MyInt6' )
+.end
+
+.namespace ["MyInt6"]
+
+.sub get_string :vtable :method
+ $I0 = self # get_integer is not overridden
+ $S1 = $I0
+ $S0 = "MyInt6("
+ $S0 .= $S1
+ $S0 .= ")"
+ .return ($S0)
+.end
+
+.namespace [] # Reset to root namespace for next test
+
+.sub PMC_as_classes__derived_1
+ .local pmc MyInt8
+ .local pmc MyInt8_2
+ get_class $P0, "Integer"
+
+ subclass MyInt8, $P0, "MyInt8"
+ addattribute MyInt8, 'intval'
+ get_class $P1, "MyInt8"
+ subclass MyInt8_2, $P1, "MyInt8_2"
+
+ .local pmc i
+ i = new "MyInt8_2"
+ $I0 = isa i, "Integer"
+ ok( $I0, 'obj isa grandparent (Integer)' )
+
+ $I0 = isa i, "MyInt8"
+ ok( $I0, 'obj isa parent (MyInt8)' )
+
+ $I0 = isa i, "MyInt8_2"
+ ok( $I0, 'obj isa its class (MyInt8_2)' )
+
+ i = 42 # set_integer is overridden below
+ $I0 = i # get_integer is overridden below
+ is( $I0, 42, 'set/get_integer overridden' )
+
+ $S0 = i # get_string is overridden below
+ is( $S0, 'MyInt8_2(42)', 'set/get_string overridden' )
+.end
+
+.namespace ["MyInt8"]
+.sub 'set_integer_native' :vtable :method
+ .param int val
+ $P1 = new ['Integer']
+ $P1 = val
+ setattribute self, "intval", $P1
+ .return ()
+.end
+.sub get_integer :vtable :method
+ $P0 = getattribute self, 'intval'
+ $I0 = $P0
+ .return ($I0)
+.end
+.sub get_string :vtable :method
+ $P0 = getattribute self, 'intval'
+ $I0 = $P0
+ $S1 = $I0
+ $S0 = typeof self
+ $S0 .= "("
+ $S0 .= $S1
+ $S0 .= ")"
+ .return ($S0)
+.end
+
+.namespace [] # Reset to root namespace for next test
+
+.sub PMC_as_classes__derived_2
+ .local pmc MyInt9
+ .local pmc MyInt9_2
+ get_class $P0, "Integer"
+
+ subclass MyInt9, $P0, "MyInt9"
+ addattribute MyInt9, 'intval'
+ get_class $P1, "MyInt9"
+ subclass MyInt9_2, $P1, "MyInt9_2"
+
+ .local pmc i
+ i = new "MyInt9_2"
+ $I0 = isa i, "Integer"
+ ok( $I0, 'obj isa grandparent (Integer)' )
+ $I0 = isa i, "MyInt9"
+ ok( $I0, 'obj isa parent (MyInt9)' )
+ $I0 = isa i, "MyInt9_2"
+ ok( $I0, 'obj isa its class (MyInt9_2)' )
+
+ i = 42 # set_integer is overridden below
+ $I0 = i # get_integer is overridden below
+ is( $I0, 43, 'set/get_integer overridden' )
+
+ $S0 = i # get_string is overridden below
+ is( $S0, 'MyInt9_2(42)', 'set/get_string overridden' )
+.end
+
+.namespace ["MyInt9_2"]
+# subclassing methods from MyInt9 is ok
+# this one changes the value a bit
+.sub get_integer :vtable :method
+ $P0 = getattribute self, 'intval'
+ $I0 = $P0
+ inc $I0 # <<<<<
+ .return ($I0)
+.end
+.namespace ["MyInt9"]
+.sub 'set_integer_native' :vtable :method
+ .param int val
+ $P1 = new ['Integer']
+ $P1 = val
+ setattribute self, "intval", $P1
+ .return ()
+.end
+.sub get_integer :vtable :method
+ $P0 = getattribute self, 'intval'
+ $I0 = $P0
+ .return ($I0)
+.end
+.sub get_string :vtable :method
+ $P0 = getattribute self, 'intval'
+ $I0 = $P0
+ $S1 = $I0
+ $S0 = typeof self
+ $S0 .= "("
+ $S0 .= $S1
+ $S0 .= ")"
+ .return ($S0)
+.end
+
+.namespace [] # Reset to root namespace for next test
+
+.sub PMC_as_classes__derived_3
+ .local pmc MyInt10
+ .local pmc MyInt10_2
+ get_class $P0, "Integer"
+
+ subclass MyInt10, $P0, "MyInt10"
+ addattribute MyInt10, 'intval'
+ get_class $P1, "MyInt10"
+ subclass MyInt10_2, $P1, "MyInt10_2"
+
+ .local pmc i
+ i = new "MyInt10_2"
+ $I0 = isa i, "Integer"
+ ok( $I0, 'obj isa grandparent (Integer)' )
+ $I0 = isa i, "MyInt10"
+ ok( $I0, 'obj isa parent (MyInt10)' )
+ $I0 = isa i, "MyInt10_2"
+ ok( $I0, 'obj isa its class (MyInt102)' )
+
+ i = 42 # set_integer is overridden below
+ $I0 = i # get_integer is overridden below
+ is( $I0, 42, 'set/get_integer overridden' )
+
+ $S0 = i # get_string is overridden below
+ is( $S0, 'MyInt10_2(42)', 'set/get_string overridden' )
+.end
+
+.namespace ["MyInt10_2"]
+.sub get_integer :vtable :method
+ $P0 = getattribute self, 'intval'
+ $I0 = $P0
+ .return ($I0)
+.end
+.sub get_string :vtable :method
+ $P0 = getattribute self, 'intval'
+ $I0 = $P0
+ $S1 = $I0
+ $S0 = typeof self
+ $S0 .= "("
+ $S0 .= $S1
+ $S0 .= ")"
+ .return ($S0)
+.end
+.namespace ['MyInt10']
+.sub 'set_integer_native' :vtable :method
+ .param int val
+ $P1 = new ['Integer']
+ $P1 = val
+ setattribute self, "intval", $P1
+ .return ()
+.end
+
+.namespace [] # Reset to root namespace for next test
+
+.sub subclassing_Class
+ .local pmc cl
+ .local pmc parent
+ parent = get_class "Class"
+ cl = subclass parent, "Foo33"
+ ok( 1, 'able to subclass Class' )
+
+ .local pmc o
+ o = new "Foo33"
+ ok( 1, 'able to instantiate subclass of Class' )
+
+ $S0 = typeof o
+ is( $S0, 'Foo33', 'object returns correct class' )
+.end
+
+.sub namespace_vs_name
+ .local pmc o, cl, f
+ newclass cl, "Foo34"
+ o = new "Foo34"
+ is( o, 'Foo34::get_string', 'found Foo34 namespace' )
+
+ o = Foo34()
+ is( o, 'Foo34', 'found global Foo34' )
+
+ f = get_global "Foo34"
+ o = f()
+ is( o, 'Foo34', 'found global Foo34 explicitly' )
+
+ f = get_global ["Foo34"], "Foo34"
+ o = f()
+ is( o, 'Foo34::Foo34', 'found method in Foo34 namespace' )
+.end
+
+.sub Foo34
+ .return("Foo34")
+.end
+
+.namespace [ "Foo34" ]
+
+.sub get_string :vtable :method
+ .return("Foo34::get_string")
+.end
+
+.sub Foo34
+ .return("Foo34::Foo34")
+.end
+
+.namespace [] # Reset to root namespace for next test
+
+.sub multiple_anon_classes
+ newclass $P0, "City3"
+ subclass $P1, $P0
+ newclass $P2, "State3"
+ subclass $P3, $P2
+ ok( 1, "multiple anon classes didn't croak (bug #33103)" )
+.end
+
+.sub subclassed_Integer_bug
+ .local pmc class
+ .local pmc a
+ .local pmc b
+
+ subclass class, "Integer", "LispInteger1"
+
+ a = new "LispInteger1"
+ b = new "LispInteger1"
+
+ a = 1
+ b = 1
+
+ set $S0, a
+ is( $S0, '1', 'subclassed Integer is 1' )
+ set $S0, b
+ is( $S0, '1', 'subclassed Integer is 1' )
+
+ a = a * b
+ set $S0, a
+ is( $S0, '1', 'multip and reasign to subclassed Integer is 1' )
+.end
+
+.sub equality_of_subclassed_Integer
+ .local pmc class
+ class = subclass "Integer", "LispInteger2"
+
+ .local pmc a
+ a = new 'LispInteger2'
+ a = 123
+
+ .local pmc b
+ b = new 'LispInteger2'
+ b = 123
+
+ $I0 = a == b
+ ok( $I0, '123 is equal to 123' )
+
+.end
+
+.sub short_name_attributes
+ newclass $P1, "Foo22"
+ addattribute $P1, "i"
+ addattribute $P1, "j"
+
+ subclass $P2, $P1, "Bar22"
+ addattribute $P2, "k"
+ addattribute $P2, "l"
+
+ new $P2, "Bar22"
+
+ # set a bunch of attribs
+ new $P4, ['Integer']
+ set $P4, 10
+ setattribute $P2, "i", $P4
+
+ new $P4, ['Integer']
+ set $P4, 11
+ setattribute $P2, "j", $P4
+
+ new $P4, ['Integer']
+ set $P4, 20
+ setattribute $P2, "k", $P4
+
+ new $P4, ['Integer']
+ set $P4, 21
+ setattribute $P2, "l", $P4
+
+ getattribute $P6, $P2, "i"
+ is( $P6, 10, '"i" getattribute on parent class attrib' )
+ getattribute $P6, $P2, "j"
+ is( $P6, 11, '"j" getattribute on parent class attrib' )
+
+ getattribute $P6, $P2, "k"
+ is( $P6, 20, '"k" getattribute on subclass attrib' )
+ getattribute $P6, $P2, "l"
+ is( $P6, 21, '"l" getattribute on subclass attrib' )
+
+ getattribute $P6, $P2, ["Foo22"], "i"
+ is( $P6, 10, '["Foo22"], "i" getattribute on parent class attrib' )
+ getattribute $P6, $P2, ["Bar22"], "k"
+ is( $P6, 20, '["Bar22"], "k" getattribute on subclass attrib' )
+.end
+
+.sub init_with_and_without_arg
+ .local pmc cl, o, h, a
+ cl = newclass "Foo35"
+ addattribute cl, "a"
+ o = cl.'new'()
+ a = getattribute o, "a"
+ is( a, 'ok 1', 'init without an arg' )
+
+ h = new ['Hash']
+ $P0 = new ['String']
+ $P0 = "ok 2"
+ h['a'] = $P0
+ o = new cl, h
+ a = getattribute o, "a"
+ is( a, 'ok 2', 'init with an arg' )
+.end
+
+.namespace ["Foo35"]
+.sub init_pmc :vtable :method
+ .param pmc args
+ $P0 = args['a']
+ setattribute self, 'a', $P0
+ .return()
+.end
+.sub init :vtable :method
+ $P0 = new ['String']
+ $P0 = "ok 1"
+ setattribute self, 'a', $P0
+.end
+
+.namespace [] # Reset to root namespace for next test
+
+.sub newclass_bracket_parsing
+ newclass $P0, ['Foo23';'Bar23']
+ ok( 1, 'newclass created with brackets' )
+.end
+
+.sub verify_namespace_types
+ newclass $P0, ['Foo24';'Bar24']
+ getinterp $P0
+ set $P1, $P0[.IGLOBALS_CLASSNAME_HASH]
+ typeof $S0, $P1
+ is( $S0, 'NameSpace', 'namespace verified' )
+
+ set $P2, $P1['Foo24']
+ typeof $S0, $P2
+ is( $S0, 'NameSpace', 'namespace verified' )
+.end
+
+.sub verify_data_type
+ newclass $P0, ['Foo25';'Bar25']
+ getinterp $P0
+ set $P1, $P0[.IGLOBALS_CLASSNAME_HASH]
+ set $P2, $P1['Foo25']
+ set $P3, $P2['Bar25']
+
+ set $I0, $P3
+ isgt $I0, $I0, 0
+ ok( $I0, 'verified datatype > 0' )
+.end
+
+# Puts init in a namespace
+.sub new_keyed
+ .local pmc cl, o, p
+ cl = newclass ['Foo36';'Bar36']
+ addattribute cl, "init_check"
+ o = cl.'new'()
+ ok( 1, 'obj successfully created' )
+
+ p = getattribute o, "init_check"
+ is( p, 999, "overridden init called")
+.end
+
+.namespace ['Foo36';'Bar36']
+
+.sub init :vtable :method
+ .local pmc p
+ p = new ['Integer']
+ p = 999
+ setattribute self, "init_check", p
+.end
+
+.namespace [] # revert to root for next test
+
+.sub new_keyed_2
+ .local pmc c1, c2, o1, o2
+ c1 = newclass ['Foo37';'Bar37']
+ c2 = newclass ['Foo37';'Fuz37']
+ o1 = c1.'new'()
+ o2 = c2.'new'()
+ ok( 1, 'objects created successfully' )
+.end
+
+.namespace ['Foo37';'Bar37']
+
+.sub init :vtable :method
+ ok( 1, '__init Bar37' )
+.end
+
+.namespace ['Foo37';'Fuz37']
+
+.sub init :vtable :method
+ ok( 1, '__init Fuz37' )
+.end
+
+.namespace [] # revert to root for next test
+
+.sub new_keyed_3
+ .local pmc c1, c2, c3, o1, o2, o3
+ c1 = newclass ['Foo38';'Bar38']
+ c2 = newclass ['Foo38';'Buz38']
+ c3 = newclass 'Foo38'
+ o1 = new ['Foo38';'Bar38']
+ o2 = new ['Foo38';'Buz38']
+ o3 = new 'Foo38'
+ ok( 1, 'objects created successfully' )
+.end
+
+.namespace ['Foo38';'Bar38']
+
+.sub init :vtable :method
+ ok( 1, '__init Bar38' )
+.end
+
+.namespace ['Foo38';'Buz38']
+
+.sub init :vtable :method
+ ok( 1, '__init Buz38' )
+.end
+
+.namespace ['Foo38']
+
+.sub init :vtable :method
+ ok( 1, '__init Foo38' )
+.end
+
+.namespace [] # revert to root for next test
+
+.sub subclass_keyed
+ .local pmc base, o1, o2
+ base = subclass 'Hash', ['Perl6-3'; 'PAST'; 'Node']
+ addattribute base, '$.source' # original source
+ addattribute base, '$.pos' # offset position
+
+ $P0 = subclass base, ['Perl6-3'; 'PAST'; 'Sub']
+ $P0 = subclass base, ['Perl6-3'; 'PAST'; 'Stmt']
+ ok( 1, 'ok 1\n' )
+
+ o1 = new ['Perl6-3'; 'PAST'; 'Sub']
+ o2 = new ['Perl6-3'; 'PAST'; 'Stmt']
+ ok( 1, 'objects created successfully' )
+.end
+
+.namespace ['Perl6-3'; 'PAST'; 'Stmt']
+
+.sub init :vtable :method
+ ok( 1, '__init Stmt' )
+.end
+
+.namespace ['Perl6-3'; 'PAST'; 'Sub']
+
+.sub init :vtable :method
+ ok( 1, '__init Sub' )
+.end
+
+.namespace [] # revert to root for next test
+
+.sub test_class_name_multipart_name
+ .local pmc base, o1
+ base = subclass 'Hash', ['Perl6'; 'PAST'; 'Node']
+ o1 = new base
+ $S0 = typeof o1
+ is( $S0, "Perl6;PAST;Node", "typeof returns object's class name" )
+.end
+
+.sub test_get_class_multipart_name
+ .local pmc base, o1
+ base = subclass 'Hash', ['Perl6a'; 'PAST'; 'Node']
+ $P0 = get_class ['Perl6a'; 'PAST'; 'Node']
+ o1 = new $P0
+ $S0 = typeof o1
+ is( $S0, 'Perl6a;PAST;Node', 'typeof returns objects created from get_class' )
+.end
+
+.sub isa_bug
+ .local pmc base, o1, o2
+ base = subclass 'Hash', ['Perl6b'; 'PAST'; 'Node']
+ $P0 = new [ 'Perl6b'; 'PAST'; 'Node' ]
+
+ $I0 = isa $P0, [ 'Perl6b'; 'PAST'; 'Node']
+ is( $I0, 1, 'obj isa the full class name' )
+
+ $I0 = isa $P0, 'Hash'
+ is( $I0, 1, 'obj isa the parent class' )
+
+ $I0 = isa $P0, 'Perl6b'
+ is( $I0, 0, 'obj !isa the first part of the class name' )
+.end
+
+.sub new_nested_ordering
+ .local pmc c1, c2, o
+ c1 = newclass ['Foo39']
+ c2 = newclass ['Foo39';'Bar39']
+ o = c2.'new'()
+ ok( 1, 'objects created successfully' )
+.end
+
+.namespace ['Foo39']
+
+.sub init :vtable :method
+ ok( 0, '__init Foo39' ) # shouldn't be called
+.end
+
+.namespace ['Foo39';'Bar39']
+
+.sub init :vtable :method
+ ok( 1, '__init Bar39' ) # should be called
+.end
+
+.namespace [] # revert to root for next test
+
+.sub vtable_override_once_removed
+ .local pmc base
+ $P0 = get_class 'Integer'
+ base = subclass $P0, 'Foo40' # create subclass 'Foo40'
+ addattribute base, '@!capt'
+
+ $P0 = subclass 'Foo40', 'Bar40' # create subclass 'Bar40'
+ $P1 = new 'Bar40' # create an instance of 'Bar40'
+
+ $S1 = $P1 # get its string representation
+ is( $S1, 'ok bar', 'get_string overridden' )
+.end
+
+.namespace [ 'Bar40' ]
+
+.sub 'get_string' :vtable :method
+ $S0 = 'ok bar'
+ .return ($S0)
+.end
+
+.namespace [] # revert to root for next test
+
+.sub vtable_fails_for_subclasses_of_core_classes
+ $P0 = subclass 'Hash', 'Foo41'
+ $P0 = subclass 'Hash', 'Bar41'
+
+ $P1 = new 'Foo41'
+ $S1 = $P1
+ is( $S1, 'Hello world', 'get_string :vtable :method' )
+
+ $P1 = new 'Bar41'
+ $S1 = $P1
+ is( $S1, 'Hello world', 'get_string :method :vtable' )
+.end
+
+.namespace [ 'Foo41' ]
+
+.sub 'get_string' :vtable :method
+ .return('Hello world')
+.end
+
+.namespace [ 'Bar41' ]
+
+.sub 'get_string' :method :vtable
+ .return('Hello world')
+.end
+
+.namespace [] # revert to root for next test
+
+.sub super___init_called_twice
+ $P0 = newclass 'Foo42'
+ $P1 = subclass $P0, 'Bar42'
+ addattribute $P1, 'i'
+
+ $P2 = $P1.'new'()
+.end
+
+.namespace [ 'Foo42' ]
+
+.sub 'init' :vtable :method
+ $P0 = getattribute self, 'i'
+ isnull $I1, $P0
+ ok( $I1, 'should be null' )
+
+ $P1 = new ['Integer']
+ setattribute self, "i", $P1 # i won't be null if init called again
+ .return ()
+.end
+
+.namespace [] # revert to root for next test
+
+.sub using_class_object_from_typeof_op_with_new
+ $P0 = newclass [ "Monkey" ; "Banana" ]
+ $P0 = $P0.'new'()
+ $S0 = $P0."ook"()
+ is( $S0, "Ook!", 'obj created from .new() class method' )
+
+ $P2 = typeof $P0
+ $P3 = new $P2
+ $S0 = $P3."ook"()
+ is( $S0, "Ook!", 'obj created from "new" called on result of typeof' )
+.end
+
+.namespace [ "Monkey" ; "Banana" ]
+.sub ook :method
+ $S1 = "Ook!"
+ .return ($S1)
+.end
+
+.namespace [] # revert to root for next test
+
+.macro exception_is ( M )
+ .local pmc exception
+ .local string message
+ .get_results (exception)
+
+ message = exception['message']
+ is( message, .M, .M )
+.endm
+
+.sub setting_non_existent_attribute
+ newclass $P1, "Foo45"
+ new $P2, $P1
+
+ new $P3, ['Integer']
+ push_eh handler
+ setattribute $P2, "bar", $P3
+ pop_eh
+ ok(0, "'No such attribute' exception not thrown")
+ goto end
+handler:
+ .exception_is( "No such attribute 'bar'" )
+end:
+.end
+
+.sub setting_non_existent_attribute_by_name
+ newclass $P1, "Foo47"
+ new $P2, $P1
+
+ new $P3, ['Integer']
+ push_eh handler
+ setattribute $P2, ["Foo47"], "no_such", $P3
+ pop_eh
+ ok(0, "'No such attribute' exception not thrown")
+ goto end
+handler:
+ .exception_is( "No such attribute 'no_such' in class 'Foo47'" )
+end:
+.end
+
+.sub getting_null_attribute
+ newclass $P1, "Foo51"
+ addattribute $P1, "i"
+ new $P2, "Foo51"
+
+ getattribute $P3, $P2, "i"
+ isnull $I0, $P3
+ is($I0, 1, "null attribute is null")
+.end
+
+.sub getting_non_existent_attribute
+ newclass $P1, "Foo52"
+ $P2 = $P1.'new'()
+
+ push_eh handler
+ getattribute $P3, $P2, "bar"
+ pop_eh
+ ok(0, "'No such attribute' exception not thrown")
+ goto end
+handler:
+ .exception_is( "No such attribute 'bar'" )
+end:
+.end
+
+.sub addparent_exceptions_1
+ newclass $P0, "Astronomical Object 2"
+ new $P1, ['String']
+ set $P1, "Not a class"
+ push_eh handler
+ addparent $P0, $P1
+ pop_eh
+ ok(0, "'Parent isn\'t a Class' exception not thrown")
+ goto end
+handler:
+ .exception_is( "Parent isn't a Class." )
+end:
+.end
+
+.sub addparent_exceptions_2
+ new $P0, ['Hash']
+ newclass $P1, "Trashcan"
+ push_eh handler
+ addparent $P0, $P1
+ pop_eh
+ ok(0, "'Only classes can be subclassed' exception not thrown")
+ goto end
+handler:
+ .exception_is( "Only classes can be subclassed" )
+end:
+.end
+
+.sub subclassing_a_non_existent_class
+ push_eh handler
+ subclass $P1, "Character", "Nemo"
+ pop_eh
+ ok(0, "nonexistent class exception not thrown")
+ goto end
+handler:
+ .exception_is( "Class 'Character' doesn't exist" )
+end:
+.end
+
+.sub anon_subclass_of_non_existent_class
+ push_eh handler
+ subclass $P1, "Character"
+ pop_eh
+ ok(0, "nonexistent class exception not thrown")
+ goto end
+handler:
+ .exception_is( "Class 'Character' doesn't exist" )
+end:
+.end
+
+.sub addattribute_duplicate
+ newclass $P1, "Foo53"
+ addattribute $P1, "i"
+ addattribute $P1, "j"
+ push_eh handler
+ addattribute $P1, "i"
+ pop_eh
+ ok(0, "attribute already exists exception not thrown")
+ goto end
+handler:
+ .exception_is( "Attribute 'i' already exists in 'Foo53'." )
+end:
+.end
+
+.sub wrong_way_to_create_new_objects
+ push_eh handler
+ new $P0, ['Object']
+ pop_eh
+ ok(0, "object instantiation exception not thrown")
+ goto end
+handler:
+ .exception_is( "Object must be created by a class." )
+end:
+.end
+
+.sub attribute_values__subclassing_access_meths
+ newclass $P1, "Foo54"
+ # must add attributes before object instantiation
+ addattribute $P1, "i"
+ addattribute $P1, "j"
+ # define attrib access functions in Foo54 namespace
+ get_global $P5, "Foo54__set"
+ addmethod $P1, "Foo54__set", $P5
+ get_global $P5, "Foo54__get"
+ addmethod $P1, "Foo54__get", $P5
+
+ subclass $P2, $P1, "Bar54"
+ addattribute $P2, "k"
+ addattribute $P2, "l"
+ get_global $P5, "Bar54__set"
+ addmethod $P2, "Bar54__set", $P5
+ get_global $P5, "Bar54__get"
+ addmethod $P2, "Bar54__get", $P5
+
+ # instantiate a Bar54 object
+ new $P13, "Bar54"
+
+ # Foo54 and Bar54 have attribute accessor methods
+ new $P5, ['String'] # set attribute values
+ set $P5, "i" # attribute slots have reference semantics
+ set_args "0,0", $P5, "i"
+ callmethodcc $P13, "Foo54__set"
+ get_results ""
+
+ new $P5, ['String']
+ set $P5, "j"
+ set_args "0,0", $P5, "j"
+ callmethodcc $P13,"Foo54__set"
+ get_results ""
+
+ new $P5, ['String']
+ set $P5, "k"
+ set_args "0,0", $P5, "k"
+ callmethodcc $P13,"Bar54__set"
+ get_results ""
+
+ new $P5, ['String']
+ set $P5, "l"
+ set_args "0,0", $P5, "l"
+ callmethodcc $P13,"Bar54__set"
+ get_results ""
+
+ # now retrieve attributes
+ set_args "0", "i"
+ callmethodcc $P13,"Foo54__get"
+ get_results "0", $P5
+ is( $P5, "i", 'got attrib i from Bar54->Foo54__get' )
+
+ set_args "0", "j"
+ callmethodcc $P13,"Foo54__get"
+ get_results "0", $P5
+ is( $P5, "j", 'got attrib j from Bar54->Foo54__get' )
+
+ set_args "0", "k"
+ callmethodcc $P13,"Bar54__get"
+ get_results "0", $P5
+ is( $P5, "k", 'got attrib k from Bar54->Bar54__get' )
+
+ set_args "0", "l"
+ callmethodcc $P13,"Bar54__get"
+ get_results "0", $P5
+ is( $P5, "l", 'got attrib l from Bar54->Bar54__get' )
+.end
+
+# set(obj: Pvalue, Iattr_idx)
+.sub Foo54__set
+ get_params "0,0", $P5, $S4
+ ok( 1, "in Foo54__set" )
+ interpinfo $P2, .INTERPINFO_CURRENT_OBJECT
+ setattribute $P2, $S4, $P5
+ set_returns ""
+ returncc
+.end
+
+# Pattr = get(obj: Iattr_idx)
+.sub Foo54__get
+ get_params "0", $S4
+ ok( 1, "in Foo54__get" )
+ interpinfo $P2, .INTERPINFO_CURRENT_OBJECT
+ getattribute $P5, $P2, $S4
+ set_returns "0", $P5
+ returncc
+.end
+
+.sub Bar54__set
+ get_params "0,0", $P5, $S4
+ interpinfo $P2, .INTERPINFO_CURRENT_OBJECT
+ ok( 1, "in Bar54__set" )
+ setattribute $P2, $S4, $P5
+ set_returns ""
+ returncc
+.end
+
+.sub Bar54__get
+ get_params "0", $S4
+ ok( 1, "in Bar54__get" )
+ interpinfo $P2, .INTERPINFO_CURRENT_OBJECT
+ getattribute $P5, $P2, $S4
+ set_returns "0", $P5
+ returncc
+.end
+
+.sub attribute_values__inherited_access_meths
+ newclass $P1, "Foo56"
+ # must add attributes before object instantiation
+ addattribute $P1, "i"
+ addattribute $P1, "j"
+ # define attrib access functions
+ get_global $P5, "set"
+ addmethod $P1, "set", $P5
+ get_global $P5, "get"
+ addmethod $P1, "get", $P5
+
+ subclass $P2, $P1, "Bar56"
+ addattribute $P2, "k"
+ addattribute $P2, "l"
+ addattribute $P2, "m"
+
+ # subclass is preferred for the SI case over
+ # newclass $P2, "Bar56"
+ # addattrib ...
+ # addparent $P2, $P1
+ # which is suitable for adding multiple parents to one class
+
+ # instantiate a Bar56 object
+ new $P2, "Bar56"
+
+ # Foo56 and Bar56 have attribute accessor methods
+ new $P5, ['String'] # set attribute values
+ set $P5, "i" # attribute slots have reference semantics
+ set_args "0,0,0", $P5, "Foo56", "i"
+ callmethodcc $P2, "set"
+
+ new $P5, ['String']
+ set $P5, "j"
+ set_args "0,0,0", $P5, "Foo56", "j"
+ callmethodcc $P2, "set"
+
+ new $P5, ['String']
+ set $P5, "k"
+ set_args "0,0,0", $P5, "Bar56", "k"
+ callmethodcc $P2, "set"
+
+ new $P5, ['String']
+ set $P5, "l"
+ set_args "0,0,0", $P5, "Bar56", "l"
+ callmethodcc $P2, "set"
+
+ new $P5, ['String']
+ set $P5, "m"
+ set_args "0,0,0", $P5, "Bar56", "m"
+ callmethodcc $P2, "set"
+
+ # now retrieve attributes
+ set_args "0,0", "Foo56", "i"
+ callmethodcc $P2, "get"
+ get_results "0", $P5
+ is( $P5, 'i', 'got attrib i from subclass through parent method' )
+
+ set_args "0,0", "Foo56", "j"
+ callmethodcc $P2, "get"
+ get_results "0", $P5
+ is( $P5, "j", 'got attrib i from subclass through parent method' )
+
+ set_args "0,0", "Bar56", "k"
+ callmethodcc $P2, "get"
+ get_results "0", $P5
+ is( $P5, "k", 'got attrib i from subclass through parent method' )
+
+ set_args "0,0", "Bar56", "l"
+ callmethodcc $P2, "get"
+ get_results "0", $P5
+ is( $P5, "l", 'got attrib i from subclass through parent method' )
+
+ set_args "0,0", "Bar56", "m"
+ callmethodcc $P2, "get"
+ get_results "0", $P5
+ is( $P5, "m", 'got attrib i from subclass through parent method' )
+.end
+
+# Foo56 provides accessor functions which Bar56 inherits
+# they take an additional classname argument SClass
+
+# set(obj: Pvalue, SClass, Sattr)
+.sub set
+ get_params "0,0,0", $P5, $S4, $S5
+ interpinfo $P2, .INTERPINFO_CURRENT_OBJECT
+ setattribute $P2, $S5, $P5
+ set_returns ""
+ returncc
+.end
+
+# Pattr = get(obj: SClass, Sattr)
+.sub get
+ get_params "0,0", $S4, $S5
+ interpinfo $P2, .INTERPINFO_CURRENT_OBJECT
+ getattribute $P5, $P2, $S5
+ set_returns "0", $P5
+ returncc
+.end
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/gsoc_threads/t/pir/macro.t
==============================================================================
--- branches/gsoc_threads/t/pir/macro.t Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/t/pir/macro.t Tue Jun 15 17:35:18 2010 (r47645)
@@ -21,14 +21,13 @@
.endm
.macro bar(x)
- ok(x, 'basic macro with argument')
+ ok(.x, 'basic macro with argument')
.endm
.macro_const PI_APPROX 4
.sub main :main
.include 'test_more.pir'
- .local int x
plan(3)
.foo()
.bar(42)
Copied: branches/gsoc_threads/t/pir/timer_exit.t (from r47644, trunk/t/pir/timer_exit.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_threads/t/pir/timer_exit.t Tue Jun 15 17:35:18 2010 (r47645, copy of r47644, trunk/t/pir/timer_exit.t)
@@ -0,0 +1,36 @@
+#!./parrot
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+.include 'timer.pasm'
+
+.sub main :main
+ say "1..1"
+
+ $P0 = new 'FixedPMCArray', 8
+ $P0[0] = .PARROT_TIMER_NSEC
+ $P0[1] = 0.1
+ $P0[2] = .PARROT_TIMER_HANDLER
+ $P1 = get_global 'got_timer'
+ $P0[3] = $P1
+ $P0[4] = .PARROT_TIMER_REPEAT
+ $P0[5] = 0
+ $P0[6] = .PARROT_TIMER_RUNNING
+ $P0[7] = 1
+
+ $P2 = new 'Timer', $P0
+ sleep 1
+ say "not ok 3"
+.end
+
+.sub got_timer
+ say "ok 1"
+ exit 0
+ say "not ok 2"
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/gsoc_threads/t/pmc/float.t
==============================================================================
--- branches/gsoc_threads/t/pmc/float.t Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/t/pmc/float.t Tue Jun 15 17:35:18 2010 (r47645)
@@ -16,7 +16,7 @@
=cut
-.const int TESTS = 159
+.const int TESTS = 161
.const num PRECISION = 0.000001
.sub 'test' :main
@@ -436,6 +436,11 @@
$P0 = -5.0
abs $P0
is($P0, 5.0, 'abs of -5.0', PRECISION)
+
+ $P0 = -6.0
+ $P1 = abs $P0
+ is($P1, 6.0, 'abs two operands from -6.0', PRECISION)
+ is($P0, -6.0, 'abs two operands source unchanged', PRECISION)
.end
.sub 'lt'
Deleted: branches/gsoc_threads/t/pmc/objects.t
==============================================================================
--- branches/gsoc_threads/t/pmc/objects.t Tue Jun 15 17:35:18 2010 (r47644)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,1791 +0,0 @@
-#!./parrot
-# Copyright (C) 2001-2010, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-t/pmc/objects.t - Objects
-
-=head1 SYNOPSIS
-
- % prove t/pmc/objects.t
-
-=head1 DESCRIPTION
-
-Tests the object/class subsystem.
-
-=cut
-
-.sub main :main
- .include 'test_more.pir'
- .include "iglobals.pasm"
- .include "interpinfo.pasm"
-
- plan(194)
-
- get_classname_from_class()
- test_get_class()
- test_isa()
- does_scalar()
- does_array()
- new_object()
- new_object__isa_test()
- new_object__classname()
- isa_subclass()
- isa_subclass__objects()
- test_addmethod()
- test_addattribute()
- addattribute_subclass()
- addattribute_subclass__same_name()
- set_and_get_object_attribs()
- set_and_get_multiple_object_attribs()
- attribute_values_are_specific_to_objects()
- attribute_values_and_subclassing()
- attribute_values_and_subclassing_2()
- PMC_as_classes__overridden_mmd_methods()
- typeof_class()
- typeof_objects()
- multiple_inheritance__with_attributes()
- attributes_two_levels_of_inheritance()
- class_op_test()
- anon_subclass_has_no_name()
- get_attrib_by_name()
- get_attrib_by_name_subclass()
- set_attrib_by_name_subclass()
- PMC_as_classes()
- PMC_as_classes__subclass()
- PMC_as_classes__instantiate()
- PMC_as_classes__methods()
- PMC_as_classes__mmd_methods()
- PMC_as_classes__derived_1()
- PMC_as_classes__derived_2()
- PMC_as_classes__derived_3()
- subclassing_Class()
- namespace_vs_name()
- multiple_anon_classes()
- subclassed_Integer_bug()
- equality_of_subclassed_Integer()
- short_name_attributes()
- init_with_and_without_arg()
- newclass_bracket_parsing()
- verify_namespace_types()
- verify_data_type()
- new_keyed()
- new_keyed_2()
- new_keyed_3()
- subclass_keyed()
- test_class_name_multipart_name()
- test_get_class_multipart_name()
- isa_bug()
- new_nested_ordering()
- vtable_override_once_removed()
- vtable_fails_for_subclasses_of_core_classes()
- super___init_called_twice()
- using_class_object_from_typeof_op_with_new()
- setting_non_existent_attribute()
- setting_non_existent_attribute_by_name()
- getting_null_attribute()
- getting_non_existent_attribute()
- addparent_exceptions_1()
- addparent_exceptions_2()
- subclassing_a_non_existent_class()
- anon_subclass_of_non_existent_class()
- addattribute_duplicate()
- wrong_way_to_create_new_objects()
- attribute_values__subclassing_access_meths()
- attribute_values__inherited_access_meths()
-
- # END_OF_TESTS
-.end
-
-.sub get_classname_from_class
- newclass $P1, "Foo5"
- set $S0, $P1
- is( $S0, "Foo5", "got classname Foo5" )
-
- subclass $P2, $P1, "Bar5"
- set $S1, $P2
- is( $S1, "Bar5", "got subclass Bar5" )
-
- subclass $P3, "Foo5", "Baz5"
- set $S2, $P3
- is( $S2, "Baz5", "got subclass Baz5" )
-.end
-
-.sub test_get_class
- newclass $P1, "Foo6"
- get_class $P2, "Foo6"
- set $S2, $P2
- is( $S2, "Foo6", 'get_class for Foo6' )
-
- subclass $P3, $P1, "FooBar6"
- get_class $P4, "FooBar6"
- set $S4, $P4
- is( $S4, 'FooBar6', 'get_class for FooBar6' )
-
- get_class $P3, "NoSuch6"
- isnull $I0, $P3
- ok( $I0, "no class for 'NoSuch6'" )
-.end
-
-.sub test_isa
- new $P1, ['Boolean']
-
- isa $I0, $P1, "Boolean"
- is( $I0, 1, 'Boolean isa Boolean' )
-
- isa $I0, $P1, "Bool"
- is( $I0, 0, 'Boolean !isa Bool' )
-
- isa $I0, $P1, "scalar"
- is( $I0, 1, 'Boolean isa scalar' )
-
- isa $I0, $P1, "calar"
- is( $I0, 0, 'Boolean !isa calar' )
-
- isa $I0, $P1, "Integer"
- is( $I0, 1, 'Boolean isa Integer' )
-
- isa $I0, $P1, "Integ"
- is( $I0, 0, 'Boolean !isa Integ' )
-
- isa $I0, $P1, "eger"
- is( $I0, 0, 'Boolean !isa eger' )
-
- isa $I0, $P1, " "
- is( $I0, 0, 'Boolean !isa " "' )
-
- isa $I0, $P1, ""
- is( $I0, 0, 'Boolean !isa ""' )
-
- null $S0
- isa $I0, $P1, $S0
- is( $I0, 0, 'Boolean !isa null $S0' )
-
- set $S0, "scalar"
- isa $I0, $P1, $S0
- is( $I0, 1, 'Boolean isa scalar $S0' )
-.end
-
-.sub does_scalar
- new $P1, ['Boolean']
-
- does $I0, $P1, "Boolean"
- is( $I0, 0, 'Boolean !does Boolean' )
-
- does $I0, $P1, "Bool"
- is( $I0, 0, 'Boolean !does Bool' )
-
- does $I0, $P1, "scalar"
- is( $I0, 1, 'Boolean does scalar' )
-.end
-
-.sub does_array
- new $P1, ['OrderedHash']
-
- does $I0, $P1, "Boolean"
- is( $I0, 0, 'OrderedHash !does Boolean' )
-
- does $I0, $P1, "Bool"
- is( $I0, 0, 'OrderedHash !does Bool' )
-
- does $I0, $P1, "hash"
- is( $I0, 1, 'OrderedHash does hash' )
-
- does $I0, $P1, "array"
- is( $I0, 1, 'OrderedHash does array' )
-.end
-
-.sub new_object
- newclass $P1, "Foo7"
- new $P2, "Foo7"
- ok( 1, 'created new object from Foo7 class' )
-.end
-
-.sub new_object__isa_test
- newclass $P1, "Foo8"
- new $P2, $P1
- ok( 1, 'created new object from Foo8 class' )
-
- isa $I0, $P2, "Foo8"
- ok( $I0, 'new object isa Foo8' )
-.end
-
-.sub new_object__classname
- newclass $P1, "Foo9"
- new $P2, $P1
- set $S0, $P1 # class
- is( $S0, "Foo9", 'new object from Foo9 class as a string is Foo9' )
-
- typeof $S0, $P2 # object
- is( $S0, 'Foo9', 'typeof obj is Foo9' )
-
- class $P3, $P1
- set $S0, $P1 # class
- is( $S0, 'Foo9', 'class of obj is Foo9' )
-
- typeof $S0, $P2 # object
- is( $S0, 'Foo9', 'typeof obj is Foo9' )
-
-.end
-
-.sub isa_subclass
- newclass $P1, "Foo10"
- subclass $P2, $P1, "Bar10"
-
- isa_ok( $P2, "Foo10", 'newclass isa Foo10' )
- isa_ok( $P2, "Bar10", 'new subclass isa Bar10' )
- isa_ok( $P2, "Foo10", 'new subclass isa parent' )
- isa_ok( $P2, "Class", 'new subclass isa Class' )
-
- isa $I0, $P2, "Object"
- is( $I0, 0, 'new subclass !isa Object' )
-.end
-
-.sub isa_subclass__objects
- newclass $P3, "Foo30"
- subclass $P4, $P3, "Bar30"
- $P1 = $P3.'new'()
- $P2 = $P4.'new'()
-
- isa_ok( $P1, "Foo30", 'obj isa its class' )
- isa_ok( $P2, "Bar30", 'obj isa its class' )
- isa_ok( $P2, "Foo30", 'obj isa its parent class' )
- isa_ok( $P2, "Object", 'obj isa Object' )
- isa_ok( $P2, "Class", 'obj isa Class' )
-.end
-
-.sub test_addmethod
- newclass $P0, 'Foo31'
- $P2 = get_hll_global 'sayFoo31'
-
- # add a method BEFORE creating a Foo object
- addmethod $P0, 'foo31', $P2
- $P1 = new 'Foo31'
- $P1.'foo31'()
-
- # get a method from some other namespace
- $P2 = get_hll_global ['Bar31'], 'sayBar31'
-
- # add a method AFTER creating the object
- addmethod $P0, 'bar31', $P2
- $P1.'bar31'()
-.end
-
-.sub sayFoo31
- ok( 1, 'called method added before creating obj' )
-.end
-
-.namespace ['Bar31']
-.sub sayBar31
- ok( 1, 'called method added after created obj' )
-.end
-
-.namespace [] # Reset to root namespace for next test
-
-.sub test_addattribute
- newclass $P1, "Foo11"
-
- addattribute $P1, "foo_i"
- ok( 1, 'addattribute did not blow up' )
-
- set $S0, $P1
- is( $S0, "Foo11", '$P1 is still the same class as PMC' )
-
- # Check that we can add multiple attributes
- set $I0, 0
-l1:
- set $S0, $I0
- addattribute $P1, $S0
- inc $I0
- lt $I0, 1000, l1
- ok( 1, 'addattribute 1000x without blow up' )
-.end
-
-.sub addattribute_subclass
- newclass $P1, "Foo12"
- addattribute $P1, "foo_i"
- ok( 1, 'addattribute to Foo12' )
-
- subclass $P2, $P1, "Bar12"
- addattribute $P2, "bar_i"
- ok( 1, 'addattribute to subclass of Foo12' )
-.end
-
-.sub addattribute_subclass__same_name
- newclass $P1, "Foo32"
- addattribute $P1, "i"
- addattribute $P1, "j"
-
- subclass $P2, $P1, "Bar32"
- addattribute $P2, "j"
- addattribute $P2, "k"
-
- ok( 1, 'created class and subclass and added attributes' )
-
- .local pmc o
- o = $P2.'new'()
- $P0 = getattribute o, 'i'
- is( $P0, 'Foo32.i', 'parent attrib initialized in init' )
- $P0 = getattribute o, ['Foo32'], 'j'
- is( $P0, 'Foo32.j', 'parent attrib initialized in init' )
- $P0 = getattribute o, ['Bar32'], 'j'
- is( $P0, 'Bar32.j', 'subclass attrib initialized in init' )
- $P0 = getattribute o, 'k'
- is( $P0, 'Bar32.k', 'subclass attrib initialized in init' )
-
- $P0 = getattribute o, 'i'
- is( $P0, 'Foo32.i', 'parent attrib init-ed' )
- $P0 = getattribute o, ['Foo32'], "j"
- is( $P0, 'Foo32.j', 'parent attrib init-ed' )
- $P0 = getattribute o, 'j'
- is( $P0, 'Bar32.j', 'subclass attrib returned over parent' )
- $P0 = getattribute o, 'k'
- is( $P0, 'Bar32.k', 'subclass attrib init-ed' )
-.end
-
-.namespace ['Bar32']
-
-.sub init :vtable :method
- $P0 = new ['String']
- $P0 = 'Foo32.i'
- setattribute self, ['Foo32'], "i", $P0
- $P0 = new ['String']
- $P0 = 'Foo32.j'
- setattribute self, ["Foo32"], "j", $P0
- $P0 = new ['String']
- $P0 = 'Bar32.j'
- setattribute self, ["Bar32"], "j", $P0
- $P0 = new ['String']
- $P0 = 'Bar32.k'
- setattribute self, ["Bar32"], "k", $P0
-.end
-
-.namespace [] # Reset to root namespace for next test
-
-.sub set_and_get_object_attribs
- newclass $P1, "Foo13"
- addattribute $P1, "i"
- new $P2, $P1
-
- new $P3, ['Integer']
- set $P3, 1024
- setattribute $P2, "i", $P3
-
- new $P4, ['Integer']
- getattribute $P4, $P2, "i"
-
- is( $P4, 1024, 'set/get Integer attribute' )
-.end
-
-.sub set_and_get_multiple_object_attribs
- newclass $P1, "Foo14"
- addattribute $P1, "i"
- addattribute $P1, "j"
- new $P2, "Foo14"
-
- new $P3, ['Integer']
- set $P3, 4201
- new $P4, ['Hash']
- set $P4["Key"], "Value"
-
- setattribute $P2, "i", $P3
- setattribute $P2, "j", $P4
-
- getattribute $P5, $P2, "i"
- is( $P5, '4201', 'set/get Integer attribute' )
-
- getattribute $P6, $P2, "j"
- set $S0, $P6["Key"]
- is( $S0, 'Value', 'set/get Hash attribute on same obj' )
-.end
-
-.sub attribute_values_are_specific_to_objects
- newclass $P1, "Foo15"
- addattribute $P1, "i"
- new $P2, $P1
- new $P3, $P1
-
- new $P4, ['Integer']
- set $P4, 100
- setattribute $P2, "i", $P4
- new $P5, ['String']
- set $P5, "One hundred"
- setattribute $P3, "i", $P5
-
- getattribute $P6, $P2, "i"
- is( $P6, 100, 'attribute value on 1st object is specific to obj' )
-
- getattribute $P6, $P3, "i"
- is( $P6, 'One hundred', 'attribute value on 2nd obj is specific to obj' )
-.end
-
-.sub attribute_values_and_subclassing
- newclass $P1, "Foo16"
- addattribute $P1, "i"
- addattribute $P1, "j"
- subclass $P2, $P1, "Bar16"
- addattribute $P2, "k"
- addattribute $P2, "l"
-
- new $P2, "Bar16"
- new $P3, "Bar16"
-
- # Note that setattribute holds the actual PMC, not a copy, so
- # in this test both attributes get the PMC from $P4, and should
- # both have the same value, despite the C<inc>.
- new $P4, ['Integer']
- set $P4, 10
- setattribute $P2, "i", $P4
- inc $P4
- setattribute $P2, "j", $P4
-
- new $P5, ['Integer']
- set $P5, 100
- setattribute $P3, "i", $P5
- inc $P5
- setattribute $P3, "j", $P5
-
- getattribute $P6, $P2, "i"
- is( $P6, 11, 'setattrib with a PMC holds actual PMC not copy' )
-
- getattribute $P6, $P2, "j"
- is( $P6, 11, '...so changes to the PMC appear through the attrib' )
-
- getattribute $P6, $P3, "i"
- is( $P6, 101, '...and second test on new objects' )
-
- getattribute $P6, $P3, "j"
- is( $P6, 101, '...should have same result' )
-.end
-
-.sub attribute_values_and_subclassing_2
- newclass $P1, "Foo17"
- # must add attributes before object instantiation
- addattribute $P1, ".i"
- addattribute $P1, ".j"
-
- subclass $P2, $P1, "Bar17"
- addattribute $P2, ".k"
- addattribute $P2, ".l"
-
- # subclass is preferred for the SI case over
- # newclass $P2, "Bar"
- # addattrib ...
- # addparent $P2, $P1
- # which is suitable for adding multiple parents to one class
-
- # instantiate a Bar object
- new $P3, "Bar17"
-
- # Set the attribute values
- new $P10, ['String'] # set attribute values
- set $P10, "i" # attribute slots have reference semantics
- setattribute $P3, ".i", $P10 # so always put new PMCs in
- # if you have unique values
- new $P10, ['String']
- set $P10, "j"
- setattribute $P3, ".j", $P10
-
- new $P10, ['String']
- set $P10, "k"
- setattribute $P3, ".k", $P10
-
- new $P10, ['String']
- set $P10, "l"
- setattribute $P3, ".l", $P10
-
- # retrieve attribs
- getattribute $P11, $P3, ".i"
- is( $P11, "i", 'string attribute get/set on parent' )
-
- getattribute $P11, $P3, ".j"
- is( $P11, "j", 'string attribute get/set on parent' )
-
- getattribute $P11, $P3, ".k"
- is( $P11, "k", 'string attribute get/set on subclass' )
-
- getattribute $P11, $P3, ".l"
- is( $P11, "l", 'string attribute get/set on subclass' )
-.end
-
-.sub PMC_as_classes__overridden_mmd_methods
- .local pmc myint, i, j, k
-
- get_class $P0, "Integer"
- subclass myint, $P0, "MyInt1"
-
- i = new 'MyInt1'
- j = new 'MyInt1'
- k = new 'MyInt1'
- i = 6
- j = 7
- k = i + j
-
- is( k, 13, 'added two MyInt1' )
-
- j = new ['Integer']
- j = 100
- k = i + j
-
- is( k, 106, 'added MyInt1 and an Integer' )
-.end
-
-.namespace ["MyInt1"]
-
-.sub add :multi(MyInt1, MyInt1, MyInt1)
- .param pmc self
- .param pmc right
- .param pmc dest
- ok( 1, 'in the add method' )
- $P0 = getattribute self, ['Integer'], "proxy"
- $I0 = $P0
- $I1 = right
- $I2 = $I0 + $I1
- dest = $I2
- .return(dest)
-.end
-
-.namespace [] # Reset to root namespace for next test
-
-.sub typeof_class
- newclass $P0, "Foo21"
- typeof $S0, $P0
- is( $S0, "Class", 'typeof for a Class PMC is "Class"' )
-.end
-
-.sub typeof_objects
- newclass $P0, "A"
- newclass $P1, "B"
-
- new $P0, ['A']
- new $P1, ['B']
-
- typeof $S0, $P0
- typeof $S1, $P1
-
- is( $S0, 'A', 'typeof object of class A is "A"' )
- is( $S1, 'B', 'typeof object of class B is "B"' )
-.end
-
-.sub multiple_inheritance__with_attributes
- newclass $P1, "Star"
- addattribute $P1, "Spectral Type"
-
- newclass $P2, "Company"
- addattribute $P2, "Annual Profit"
-
- subclass $P3, $P1, "Sun"
- addparent $P3, $P2
-
- new $P4, ['Sun']
-
- new $P5, ['String']
- set $P5, "G"
- setattribute $P4, "Spectral Type", $P5
-
- new $P6, ['String']
- set $P6, "$100,000,000"
- setattribute $P4, "Annual Profit", $P6
-
- getattribute $P7, $P4, "Spectral Type"
- is( $P7, 'G', 'direct parents attribute' )
-
- getattribute $P8, $P4, "Annual Profit"
- is( $P8, '$100,000,000', "addparent's attribute" )
-.end
-
-.sub attributes_two_levels_of_inheritance
- newclass $P0, "Astronomical Object"
- addattribute $P0, "Location"
-
- subclass $P1, $P0, "Star2"
- addattribute $P1, "Spectral Type"
-
- newclass $P2, "Sun2"
- addparent $P2, $P1
- addparent $P2, $P0
-
- new $P4, "Sun2"
-
- new $P5, ['String']
- set $P5, "Taurus"
- setattribute $P4, "Location", $P5
- getattribute $P6, $P4, "Location"
- is( $P6, 'Taurus', 'attributes with two levels of inheritance' )
-.end
-
-.sub class_op_test
- newclass $P0, "City1"
- new $P1, "City1"
-
- class $P2, $P1
- set $S0, $P2
- is( $S0, 'City1', 'class op works' )
-.end
-
-.sub anon_subclass_has_no_name
- newclass $P0, "City2"
- subclass $P1, $P0
- set $S0, $P1
- is( $S0, '', 'anonymous subclass has no name' )
-.end
-
-.sub get_attrib_by_name
- newclass $P1, "Foo18"
- addattribute $P1, "i"
- new $P2, "Foo18"
- new $P3, ['String']
- set $P3, "ok"
- setattribute $P2, "i", $P3
-
- getattribute $P4, $P2, ["Foo18"], "i"
- is( $P4, 'ok', 'get attrib by name' )
-.end
-
-.sub get_attrib_by_name_subclass
- newclass $P0, "Bar19"
- addattribute $P0, "j"
-
- subclass $P1, $P0, "Foo19"
- addattribute $P1, "i"
-
- new $P2, "Foo19"
-
- new $P3, ['String']
- set $P3, "foo i"
- setattribute $P2, "i", $P3
-
- new $P3, ['String']
- set $P3, "bar j"
- setattribute $P2, "j", $P3
-
- getattribute $P4, $P2, ["Foo19"], "i"
- is( $P4, 'foo i', 'attribute from subclass get by name' )
-
- getattribute $P4, $P2, ["Bar19"], "j"
- is( $P4, 'bar j', 'attribute from parent class get by name' )
-.end
-
-.sub set_attrib_by_name_subclass
- newclass $P0, "Bar20"
- addattribute $P0, "j"
-
- subclass $P1, $P0, "Foo20"
- addattribute $P1, "i"
-
- new $P2, "Foo20"
-
- new $P3, ['String']
- set $P3, "foo i"
- setattribute $P2, ["Foo20"], "i", $P3
-
- new $P3, ['String']
- set $P3, "bar j"
- setattribute $P2, ["Bar20"], "j", $P3
-
- getattribute $P4, $P2, "i"
- is( $P4, 'foo i', 'attribute from subclass set by name' )
-
- getattribute $P4, $P2, "j"
- is( $P4, 'bar j', 'attribute from parent class set by name' )
-.end
-
-.sub PMC_as_classes
- get_class $P0, "Integer"
- ok( 1, "get_class of Integer did't croak" )
-
- get_class $P0, "Integer"
- ok( 1, "get_class of Integer did't croak second time" )
-
- typeof $S0, $P0
- is( $S0, 'PMCProxy', 'typeof PMCProxy' )
-.end
-
-.sub PMC_as_classes__subclass
- .local pmc MyInt3
- get_class $P0, "Integer"
- ok( 1, "get_class on Integer didn't blow up" )
-
- subclass MyInt3, $P0, "MyInt3"
- ok( 1, "subclassing didn't blow up" )
-
- $S0 = typeof MyInt3
- is( $S0, 'Class', 'new subclass is typeof Class' )
-
- $I0 = isa MyInt3, "MyInt3"
- ok( $I0, 'new subclass isa MyInt' )
-
- $I0 = isa MyInt3, "Integer"
- ok( $I0, 'new subclass isa parent class' )
-.end
-
-.sub PMC_as_classes__instantiate
- .local pmc MyInt4
- get_class $P0, "Integer"
- ok( 1, 'able to get_class of Integer' )
-
- subclass MyInt4, $P0, "MyInt4"
- addattribute MyInt4, ".i"
- ok( 1, 'able to addattribute to subclass' )
-
- .local pmc i
- i = new "MyInt4"
- ok( 1, 'able to instantiate obj of subclass w/ attribute' )
-.end
-
-.sub PMC_as_classes__methods
- .local pmc MyInt5
- get_class $P0, "Integer"
-
- subclass MyInt5, $P0, "MyInt5"
- addattribute MyInt5, "intval"
-
- .local pmc i, i2
- i = new "MyInt5"
- i2 = new ['Integer']
- i2 = 43
-
- i = 42 # set_integer is inherited from Integer
- ok( 1, 'able to assign int to MyInt' )
-
- $I0 = i # get_integer is overridden below
- is( $I0, 42, 'get_integer is overridden for MyInt5' )
-
- $S0 = i # get_string is overridden below
- is( $S0, 'MyInt5(42)', 'get_string is overridden for MyInt5' )
-.end
-
-.namespace ["MyInt5"]
-
-.sub set_integer_native :vtable :method
- .param int new_value
- $P1 = new ['Integer']
- $P1 = new_value
- setattribute self, "intval", $P1
-.end
-
-.sub get_integer :vtable :method
- $P0 = getattribute self, "intval"
- $I0 = $P0
- .return ($I0)
-.end
-
-.sub get_string :vtable :method
- $P0 = getattribute self, "intval"
- $I0 = $P0
- $S1 = $I0
- $S0 = "MyInt5("
- $S0 .= $S1
- $S0 .= ")"
- .return ($S0)
-.end
-
-.namespace [] # Reset to root namespace for next test
-
-.sub PMC_as_classes__mmd_methods
- .local pmc MyInt6
- get_class $P0, "Integer"
- subclass MyInt6, $P0, "MyInt6"
- .local pmc i
- .local pmc j
- .local pmc k
- i = new "MyInt6"
- j = new "MyInt6"
- k = new "MyInt6"
- i = 6
- j = 7
- k = i * j
- $I0 = k
- is( $I0, 42, 'MyInt6 defaults to Integer class for mult' )
-
- $S0 = k # get_string is overridden below
- is( $S0, 'MyInt6(42)', 'get_string is overridden for MyInt6' )
-.end
-
-.namespace ["MyInt6"]
-
-.sub get_string :vtable :method
- $I0 = self # get_integer is not overridden
- $S1 = $I0
- $S0 = "MyInt6("
- $S0 .= $S1
- $S0 .= ")"
- .return ($S0)
-.end
-
-.namespace [] # Reset to root namespace for next test
-
-.sub PMC_as_classes__derived_1
- .local pmc MyInt8
- .local pmc MyInt8_2
- get_class $P0, "Integer"
-
- subclass MyInt8, $P0, "MyInt8"
- addattribute MyInt8, 'intval'
- get_class $P1, "MyInt8"
- subclass MyInt8_2, $P1, "MyInt8_2"
-
- .local pmc i
- i = new "MyInt8_2"
- $I0 = isa i, "Integer"
- ok( $I0, 'obj isa grandparent (Integer)' )
-
- $I0 = isa i, "MyInt8"
- ok( $I0, 'obj isa parent (MyInt8)' )
-
- $I0 = isa i, "MyInt8_2"
- ok( $I0, 'obj isa its class (MyInt8_2)' )
-
- i = 42 # set_integer is overridden below
- $I0 = i # get_integer is overridden below
- is( $I0, 42, 'set/get_integer overridden' )
-
- $S0 = i # get_string is overridden below
- is( $S0, 'MyInt8_2(42)', 'set/get_string overridden' )
-.end
-
-.namespace ["MyInt8"]
-.sub 'set_integer_native' :vtable :method
- .param int val
- $P1 = new ['Integer']
- $P1 = val
- setattribute self, "intval", $P1
- .return ()
-.end
-.sub get_integer :vtable :method
- $P0 = getattribute self, 'intval'
- $I0 = $P0
- .return ($I0)
-.end
-.sub get_string :vtable :method
- $P0 = getattribute self, 'intval'
- $I0 = $P0
- $S1 = $I0
- $S0 = typeof self
- $S0 .= "("
- $S0 .= $S1
- $S0 .= ")"
- .return ($S0)
-.end
-
-.namespace [] # Reset to root namespace for next test
-
-.sub PMC_as_classes__derived_2
- .local pmc MyInt9
- .local pmc MyInt9_2
- get_class $P0, "Integer"
-
- subclass MyInt9, $P0, "MyInt9"
- addattribute MyInt9, 'intval'
- get_class $P1, "MyInt9"
- subclass MyInt9_2, $P1, "MyInt9_2"
-
- .local pmc i
- i = new "MyInt9_2"
- $I0 = isa i, "Integer"
- ok( $I0, 'obj isa grandparent (Integer)' )
- $I0 = isa i, "MyInt9"
- ok( $I0, 'obj isa parent (MyInt9)' )
- $I0 = isa i, "MyInt9_2"
- ok( $I0, 'obj isa its class (MyInt9_2)' )
-
- i = 42 # set_integer is overridden below
- $I0 = i # get_integer is overridden below
- is( $I0, 43, 'set/get_integer overridden' )
-
- $S0 = i # get_string is overridden below
- is( $S0, 'MyInt9_2(42)', 'set/get_string overridden' )
-.end
-
-.namespace ["MyInt9_2"]
-# subclassing methods from MyInt9 is ok
-# this one changes the value a bit
-.sub get_integer :vtable :method
- $P0 = getattribute self, 'intval'
- $I0 = $P0
- inc $I0 # <<<<<
- .return ($I0)
-.end
-.namespace ["MyInt9"]
-.sub 'set_integer_native' :vtable :method
- .param int val
- $P1 = new ['Integer']
- $P1 = val
- setattribute self, "intval", $P1
- .return ()
-.end
-.sub get_integer :vtable :method
- $P0 = getattribute self, 'intval'
- $I0 = $P0
- .return ($I0)
-.end
-.sub get_string :vtable :method
- $P0 = getattribute self, 'intval'
- $I0 = $P0
- $S1 = $I0
- $S0 = typeof self
- $S0 .= "("
- $S0 .= $S1
- $S0 .= ")"
- .return ($S0)
-.end
-
-.namespace [] # Reset to root namespace for next test
-
-.sub PMC_as_classes__derived_3
- .local pmc MyInt10
- .local pmc MyInt10_2
- get_class $P0, "Integer"
-
- subclass MyInt10, $P0, "MyInt10"
- addattribute MyInt10, 'intval'
- get_class $P1, "MyInt10"
- subclass MyInt10_2, $P1, "MyInt10_2"
-
- .local pmc i
- i = new "MyInt10_2"
- $I0 = isa i, "Integer"
- ok( $I0, 'obj isa grandparent (Integer)' )
- $I0 = isa i, "MyInt10"
- ok( $I0, 'obj isa parent (MyInt10)' )
- $I0 = isa i, "MyInt10_2"
- ok( $I0, 'obj isa its class (MyInt102)' )
-
- i = 42 # set_integer is overridden below
- $I0 = i # get_integer is overridden below
- is( $I0, 42, 'set/get_integer overridden' )
-
- $S0 = i # get_string is overridden below
- is( $S0, 'MyInt10_2(42)', 'set/get_string overridden' )
-.end
-
-.namespace ["MyInt10_2"]
-.sub get_integer :vtable :method
- $P0 = getattribute self, 'intval'
- $I0 = $P0
- .return ($I0)
-.end
-.sub get_string :vtable :method
- $P0 = getattribute self, 'intval'
- $I0 = $P0
- $S1 = $I0
- $S0 = typeof self
- $S0 .= "("
- $S0 .= $S1
- $S0 .= ")"
- .return ($S0)
-.end
-.namespace ['MyInt10']
-.sub 'set_integer_native' :vtable :method
- .param int val
- $P1 = new ['Integer']
- $P1 = val
- setattribute self, "intval", $P1
- .return ()
-.end
-
-.namespace [] # Reset to root namespace for next test
-
-.sub subclassing_Class
- .local pmc cl
- .local pmc parent
- parent = get_class "Class"
- cl = subclass parent, "Foo33"
- ok( 1, 'able to subclass Class' )
-
- .local pmc o
- o = new "Foo33"
- ok( 1, 'able to instantiate subclass of Class' )
-
- $S0 = typeof o
- is( $S0, 'Foo33', 'object returns correct class' )
-.end
-
-.sub namespace_vs_name
- .local pmc o, cl, f
- newclass cl, "Foo34"
- o = new "Foo34"
- is( o, 'Foo34::get_string', 'found Foo34 namespace' )
-
- o = Foo34()
- is( o, 'Foo34', 'found global Foo34' )
-
- f = get_global "Foo34"
- o = f()
- is( o, 'Foo34', 'found global Foo34 explicitly' )
-
- f = get_global ["Foo34"], "Foo34"
- o = f()
- is( o, 'Foo34::Foo34', 'found method in Foo34 namespace' )
-.end
-
-.sub Foo34
- .return("Foo34")
-.end
-
-.namespace [ "Foo34" ]
-
-.sub get_string :vtable :method
- .return("Foo34::get_string")
-.end
-
-.sub Foo34
- .return("Foo34::Foo34")
-.end
-
-.namespace [] # Reset to root namespace for next test
-
-.sub multiple_anon_classes
- newclass $P0, "City3"
- subclass $P1, $P0
- newclass $P2, "State3"
- subclass $P3, $P2
- ok( 1, "multiple anon classes didn't croak (bug #33103)" )
-.end
-
-.sub subclassed_Integer_bug
- .local pmc class
- .local pmc a
- .local pmc b
-
- subclass class, "Integer", "LispInteger1"
-
- a = new "LispInteger1"
- b = new "LispInteger1"
-
- a = 1
- b = 1
-
- set $S0, a
- is( $S0, '1', 'subclassed Integer is 1' )
- set $S0, b
- is( $S0, '1', 'subclassed Integer is 1' )
-
- a = a * b
- set $S0, a
- is( $S0, '1', 'multip and reasign to subclassed Integer is 1' )
-.end
-
-.sub equality_of_subclassed_Integer
- .local pmc class
- class = subclass "Integer", "LispInteger2"
-
- .local pmc a
- a = new 'LispInteger2'
- a = 123
-
- .local pmc b
- b = new 'LispInteger2'
- b = 123
-
- $I0 = a == b
- ok( $I0, '123 is equal to 123' )
-
-.end
-
-.sub short_name_attributes
- newclass $P1, "Foo22"
- addattribute $P1, "i"
- addattribute $P1, "j"
-
- subclass $P2, $P1, "Bar22"
- addattribute $P2, "k"
- addattribute $P2, "l"
-
- new $P2, "Bar22"
-
- # set a bunch of attribs
- new $P4, ['Integer']
- set $P4, 10
- setattribute $P2, "i", $P4
-
- new $P4, ['Integer']
- set $P4, 11
- setattribute $P2, "j", $P4
-
- new $P4, ['Integer']
- set $P4, 20
- setattribute $P2, "k", $P4
-
- new $P4, ['Integer']
- set $P4, 21
- setattribute $P2, "l", $P4
-
- getattribute $P6, $P2, "i"
- is( $P6, 10, '"i" getattribute on parent class attrib' )
- getattribute $P6, $P2, "j"
- is( $P6, 11, '"j" getattribute on parent class attrib' )
-
- getattribute $P6, $P2, "k"
- is( $P6, 20, '"k" getattribute on subclass attrib' )
- getattribute $P6, $P2, "l"
- is( $P6, 21, '"l" getattribute on subclass attrib' )
-
- getattribute $P6, $P2, ["Foo22"], "i"
- is( $P6, 10, '["Foo22"], "i" getattribute on parent class attrib' )
- getattribute $P6, $P2, ["Bar22"], "k"
- is( $P6, 20, '["Bar22"], "k" getattribute on subclass attrib' )
-.end
-
-.sub init_with_and_without_arg
- .local pmc cl, o, h, a
- cl = newclass "Foo35"
- addattribute cl, "a"
- o = cl.'new'()
- a = getattribute o, "a"
- is( a, 'ok 1', 'init without an arg' )
-
- h = new ['Hash']
- $P0 = new ['String']
- $P0 = "ok 2"
- h['a'] = $P0
- o = new cl, h
- a = getattribute o, "a"
- is( a, 'ok 2', 'init with an arg' )
-.end
-
-.namespace ["Foo35"]
-.sub init_pmc :vtable :method
- .param pmc args
- $P0 = args['a']
- setattribute self, 'a', $P0
- .return()
-.end
-.sub init :vtable :method
- $P0 = new ['String']
- $P0 = "ok 1"
- setattribute self, 'a', $P0
-.end
-
-.namespace [] # Reset to root namespace for next test
-
-.sub newclass_bracket_parsing
- newclass $P0, ['Foo23';'Bar23']
- ok( 1, 'newclass created with brackets' )
-.end
-
-.sub verify_namespace_types
- newclass $P0, ['Foo24';'Bar24']
- getinterp $P0
- set $P1, $P0[.IGLOBALS_CLASSNAME_HASH]
- typeof $S0, $P1
- is( $S0, 'NameSpace', 'namespace verified' )
-
- set $P2, $P1['Foo24']
- typeof $S0, $P2
- is( $S0, 'NameSpace', 'namespace verified' )
-.end
-
-.sub verify_data_type
- newclass $P0, ['Foo25';'Bar25']
- getinterp $P0
- set $P1, $P0[.IGLOBALS_CLASSNAME_HASH]
- set $P2, $P1['Foo25']
- set $P3, $P2['Bar25']
-
- set $I0, $P3
- isgt $I0, $I0, 0
- ok( $I0, 'verified datatype > 0' )
-.end
-
-# Puts init in a namespace
-.sub new_keyed
- .local pmc cl, o, p
- cl = newclass ['Foo36';'Bar36']
- addattribute cl, "init_check"
- o = cl.'new'()
- ok( 1, 'obj successfully created' )
-
- p = getattribute o, "init_check"
- is( p, 999, "overridden init called")
-.end
-
-.namespace ['Foo36';'Bar36']
-
-.sub init :vtable :method
- .local pmc p
- p = new ['Integer']
- p = 999
- setattribute self, "init_check", p
-.end
-
-.namespace [] # revert to root for next test
-
-.sub new_keyed_2
- .local pmc c1, c2, o1, o2
- c1 = newclass ['Foo37';'Bar37']
- c2 = newclass ['Foo37';'Fuz37']
- o1 = c1.'new'()
- o2 = c2.'new'()
- ok( 1, 'objects created successfully' )
-.end
-
-.namespace ['Foo37';'Bar37']
-
-.sub init :vtable :method
- ok( 1, '__init Bar37' )
-.end
-
-.namespace ['Foo37';'Fuz37']
-
-.sub init :vtable :method
- ok( 1, '__init Fuz37' )
-.end
-
-.namespace [] # revert to root for next test
-
-.sub new_keyed_3
- .local pmc c1, c2, c3, o1, o2, o3
- c1 = newclass ['Foo38';'Bar38']
- c2 = newclass ['Foo38';'Buz38']
- c3 = newclass 'Foo38'
- o1 = new ['Foo38';'Bar38']
- o2 = new ['Foo38';'Buz38']
- o3 = new 'Foo38'
- ok( 1, 'objects created successfully' )
-.end
-
-.namespace ['Foo38';'Bar38']
-
-.sub init :vtable :method
- ok( 1, '__init Bar38' )
-.end
-
-.namespace ['Foo38';'Buz38']
-
-.sub init :vtable :method
- ok( 1, '__init Buz38' )
-.end
-
-.namespace ['Foo38']
-
-.sub init :vtable :method
- ok( 1, '__init Foo38' )
-.end
-
-.namespace [] # revert to root for next test
-
-.sub subclass_keyed
- .local pmc base, o1, o2
- base = subclass 'Hash', ['Perl6-3'; 'PAST'; 'Node']
- addattribute base, '$.source' # original source
- addattribute base, '$.pos' # offset position
-
- $P0 = subclass base, ['Perl6-3'; 'PAST'; 'Sub']
- $P0 = subclass base, ['Perl6-3'; 'PAST'; 'Stmt']
- ok( 1, 'ok 1\n' )
-
- o1 = new ['Perl6-3'; 'PAST'; 'Sub']
- o2 = new ['Perl6-3'; 'PAST'; 'Stmt']
- ok( 1, 'objects created successfully' )
-.end
-
-.namespace ['Perl6-3'; 'PAST'; 'Stmt']
-
-.sub init :vtable :method
- ok( 1, '__init Stmt' )
-.end
-
-.namespace ['Perl6-3'; 'PAST'; 'Sub']
-
-.sub init :vtable :method
- ok( 1, '__init Sub' )
-.end
-
-.namespace [] # revert to root for next test
-
-.sub test_class_name_multipart_name
- .local pmc base, o1
- base = subclass 'Hash', ['Perl6'; 'PAST'; 'Node']
- o1 = new base
- $S0 = typeof o1
- is( $S0, "Perl6;PAST;Node", "typeof returns object's class name" )
-.end
-
-.sub test_get_class_multipart_name
- .local pmc base, o1
- base = subclass 'Hash', ['Perl6a'; 'PAST'; 'Node']
- $P0 = get_class ['Perl6a'; 'PAST'; 'Node']
- o1 = new $P0
- $S0 = typeof o1
- is( $S0, 'Perl6a;PAST;Node', 'typeof returns objects created from get_class' )
-.end
-
-.sub isa_bug
- .local pmc base, o1, o2
- base = subclass 'Hash', ['Perl6b'; 'PAST'; 'Node']
- $P0 = new [ 'Perl6b'; 'PAST'; 'Node' ]
-
- $I0 = isa $P0, [ 'Perl6b'; 'PAST'; 'Node']
- is( $I0, 1, 'obj isa the full class name' )
-
- $I0 = isa $P0, 'Hash'
- is( $I0, 1, 'obj isa the parent class' )
-
- $I0 = isa $P0, 'Perl6b'
- is( $I0, 0, 'obj !isa the first part of the class name' )
-.end
-
-.sub new_nested_ordering
- .local pmc c1, c2, o
- c1 = newclass ['Foo39']
- c2 = newclass ['Foo39';'Bar39']
- o = c2.'new'()
- ok( 1, 'objects created successfully' )
-.end
-
-.namespace ['Foo39']
-
-.sub init :vtable :method
- ok( 0, '__init Foo39' ) # shouldn't be called
-.end
-
-.namespace ['Foo39';'Bar39']
-
-.sub init :vtable :method
- ok( 1, '__init Bar39' ) # should be called
-.end
-
-.namespace [] # revert to root for next test
-
-.sub vtable_override_once_removed
- .local pmc base
- $P0 = get_class 'Integer'
- base = subclass $P0, 'Foo40' # create subclass 'Foo40'
- addattribute base, '@!capt'
-
- $P0 = subclass 'Foo40', 'Bar40' # create subclass 'Bar40'
- $P1 = new 'Bar40' # create an instance of 'Bar40'
-
- $S1 = $P1 # get its string representation
- is( $S1, 'ok bar', 'get_string overridden' )
-.end
-
-.namespace [ 'Bar40' ]
-
-.sub 'get_string' :vtable :method
- $S0 = 'ok bar'
- .return ($S0)
-.end
-
-.namespace [] # revert to root for next test
-
-.sub vtable_fails_for_subclasses_of_core_classes
- $P0 = subclass 'Hash', 'Foo41'
- $P0 = subclass 'Hash', 'Bar41'
-
- $P1 = new 'Foo41'
- $S1 = $P1
- is( $S1, 'Hello world', 'get_string :vtable :method' )
-
- $P1 = new 'Bar41'
- $S1 = $P1
- is( $S1, 'Hello world', 'get_string :method :vtable' )
-.end
-
-.namespace [ 'Foo41' ]
-
-.sub 'get_string' :vtable :method
- .return('Hello world')
-.end
-
-.namespace [ 'Bar41' ]
-
-.sub 'get_string' :method :vtable
- .return('Hello world')
-.end
-
-.namespace [] # revert to root for next test
-
-.sub super___init_called_twice
- $P0 = newclass 'Foo42'
- $P1 = subclass $P0, 'Bar42'
- addattribute $P1, 'i'
-
- $P2 = $P1.'new'()
-.end
-
-.namespace [ 'Foo42' ]
-
-.sub 'init' :vtable :method
- $P0 = getattribute self, 'i'
- isnull $I1, $P0
- ok( $I1, 'should be null' )
-
- $P1 = new ['Integer']
- setattribute self, "i", $P1 # i won't be null if init called again
- .return ()
-.end
-
-.namespace [] # revert to root for next test
-
-.sub using_class_object_from_typeof_op_with_new
- $P0 = newclass [ "Monkey" ; "Banana" ]
- $P0 = $P0.'new'()
- $S0 = $P0."ook"()
- is( $S0, "Ook!", 'obj created from .new() class method' )
-
- $P2 = typeof $P0
- $P3 = new $P2
- $S0 = $P3."ook"()
- is( $S0, "Ook!", 'obj created from "new" called on result of typeof' )
-.end
-
-.namespace [ "Monkey" ; "Banana" ]
-.sub ook :method
- $S1 = "Ook!"
- .return ($S1)
-.end
-
-.namespace [] # revert to root for next test
-
-.macro exception_is ( M )
- .local pmc exception
- .local string message
- .get_results (exception)
-
- message = exception['message']
- is( message, .M, .M )
-.endm
-
-.sub setting_non_existent_attribute
- newclass $P1, "Foo45"
- new $P2, $P1
-
- new $P3, ['Integer']
- push_eh handler
- setattribute $P2, "bar", $P3
- pop_eh
- ok(0, "'No such attribute' exception not thrown")
- goto end
-handler:
- .exception_is( "No such attribute 'bar'" )
-end:
-.end
-
-.sub setting_non_existent_attribute_by_name
- newclass $P1, "Foo47"
- new $P2, $P1
-
- new $P3, ['Integer']
- push_eh handler
- setattribute $P2, ["Foo47"], "no_such", $P3
- pop_eh
- ok(0, "'No such attribute' exception not thrown")
- goto end
-handler:
- .exception_is( "No such attribute 'no_such' in class 'Foo47'" )
-end:
-.end
-
-.sub getting_null_attribute
- newclass $P1, "Foo51"
- addattribute $P1, "i"
- new $P2, "Foo51"
-
- getattribute $P3, $P2, "i"
- isnull $I0, $P3
- is($I0, 1, "null attribute is null")
-.end
-
-.sub getting_non_existent_attribute
- newclass $P1, "Foo52"
- $P2 = $P1.'new'()
-
- push_eh handler
- getattribute $P3, $P2, "bar"
- pop_eh
- ok(0, "'No such attribute' exception not thrown")
- goto end
-handler:
- .exception_is( "No such attribute 'bar'" )
-end:
-.end
-
-.sub addparent_exceptions_1
- newclass $P0, "Astronomical Object 2"
- new $P1, ['String']
- set $P1, "Not a class"
- push_eh handler
- addparent $P0, $P1
- pop_eh
- ok(0, "'Parent isn\'t a Class' exception not thrown")
- goto end
-handler:
- .exception_is( "Parent isn't a Class." )
-end:
-.end
-
-.sub addparent_exceptions_2
- new $P0, ['Hash']
- newclass $P1, "Trashcan"
- push_eh handler
- addparent $P0, $P1
- pop_eh
- ok(0, "'Only classes can be subclassed' exception not thrown")
- goto end
-handler:
- .exception_is( "Only classes can be subclassed" )
-end:
-.end
-
-.sub subclassing_a_non_existent_class
- push_eh handler
- subclass $P1, "Character", "Nemo"
- pop_eh
- ok(0, "nonexistent class exception not thrown")
- goto end
-handler:
- .exception_is( "Class 'Character' doesn't exist" )
-end:
-.end
-
-.sub anon_subclass_of_non_existent_class
- push_eh handler
- subclass $P1, "Character"
- pop_eh
- ok(0, "nonexistent class exception not thrown")
- goto end
-handler:
- .exception_is( "Class 'Character' doesn't exist" )
-end:
-.end
-
-.sub addattribute_duplicate
- newclass $P1, "Foo53"
- addattribute $P1, "i"
- addattribute $P1, "j"
- push_eh handler
- addattribute $P1, "i"
- pop_eh
- ok(0, "attribute already exists exception not thrown")
- goto end
-handler:
- .exception_is( "Attribute 'i' already exists in 'Foo53'." )
-end:
-.end
-
-.sub wrong_way_to_create_new_objects
- push_eh handler
- new $P0, ['Object']
- pop_eh
- ok(0, "object instantiation exception not thrown")
- goto end
-handler:
- .exception_is( "Object must be created by a class." )
-end:
-.end
-
-.sub attribute_values__subclassing_access_meths
- newclass $P1, "Foo54"
- # must add attributes before object instantiation
- addattribute $P1, "i"
- addattribute $P1, "j"
- # define attrib access functions in Foo54 namespace
- get_global $P5, "Foo54__set"
- addmethod $P1, "Foo54__set", $P5
- get_global $P5, "Foo54__get"
- addmethod $P1, "Foo54__get", $P5
-
- subclass $P2, $P1, "Bar54"
- addattribute $P2, "k"
- addattribute $P2, "l"
- get_global $P5, "Bar54__set"
- addmethod $P2, "Bar54__set", $P5
- get_global $P5, "Bar54__get"
- addmethod $P2, "Bar54__get", $P5
-
- # instantiate a Bar54 object
- new $P13, "Bar54"
-
- # Foo54 and Bar54 have attribute accessor methods
- new $P5, ['String'] # set attribute values
- set $P5, "i" # attribute slots have reference semantics
- set_args "0,0", $P5, "i"
- callmethodcc $P13, "Foo54__set"
- get_results ""
-
- new $P5, ['String']
- set $P5, "j"
- set_args "0,0", $P5, "j"
- callmethodcc $P13,"Foo54__set"
- get_results ""
-
- new $P5, ['String']
- set $P5, "k"
- set_args "0,0", $P5, "k"
- callmethodcc $P13,"Bar54__set"
- get_results ""
-
- new $P5, ['String']
- set $P5, "l"
- set_args "0,0", $P5, "l"
- callmethodcc $P13,"Bar54__set"
- get_results ""
-
- # now retrieve attributes
- set_args "0", "i"
- callmethodcc $P13,"Foo54__get"
- get_results "0", $P5
- is( $P5, "i", 'got attrib i from Bar54->Foo54__get' )
-
- set_args "0", "j"
- callmethodcc $P13,"Foo54__get"
- get_results "0", $P5
- is( $P5, "j", 'got attrib j from Bar54->Foo54__get' )
-
- set_args "0", "k"
- callmethodcc $P13,"Bar54__get"
- get_results "0", $P5
- is( $P5, "k", 'got attrib k from Bar54->Bar54__get' )
-
- set_args "0", "l"
- callmethodcc $P13,"Bar54__get"
- get_results "0", $P5
- is( $P5, "l", 'got attrib l from Bar54->Bar54__get' )
-.end
-
-# set(obj: Pvalue, Iattr_idx)
-.sub Foo54__set
- get_params "0,0", $P5, $S4
- ok( 1, "in Foo54__set" )
- interpinfo $P2, .INTERPINFO_CURRENT_OBJECT
- setattribute $P2, $S4, $P5
- set_returns ""
- returncc
-.end
-
-# Pattr = get(obj: Iattr_idx)
-.sub Foo54__get
- get_params "0", $S4
- ok( 1, "in Foo54__get" )
- interpinfo $P2, .INTERPINFO_CURRENT_OBJECT
- getattribute $P5, $P2, $S4
- set_returns "0", $P5
- returncc
-.end
-
-.sub Bar54__set
- get_params "0,0", $P5, $S4
- interpinfo $P2, .INTERPINFO_CURRENT_OBJECT
- ok( 1, "in Bar54__set" )
- setattribute $P2, $S4, $P5
- set_returns ""
- returncc
-.end
-
-.sub Bar54__get
- get_params "0", $S4
- ok( 1, "in Bar54__get" )
- interpinfo $P2, .INTERPINFO_CURRENT_OBJECT
- getattribute $P5, $P2, $S4
- set_returns "0", $P5
- returncc
-.end
-
-.sub attribute_values__inherited_access_meths
- newclass $P1, "Foo56"
- # must add attributes before object instantiation
- addattribute $P1, "i"
- addattribute $P1, "j"
- # define attrib access functions
- get_global $P5, "set"
- addmethod $P1, "set", $P5
- get_global $P5, "get"
- addmethod $P1, "get", $P5
-
- subclass $P2, $P1, "Bar56"
- addattribute $P2, "k"
- addattribute $P2, "l"
- addattribute $P2, "m"
-
- # subclass is preferred for the SI case over
- # newclass $P2, "Bar56"
- # addattrib ...
- # addparent $P2, $P1
- # which is suitable for adding multiple parents to one class
-
- # instantiate a Bar56 object
- new $P2, "Bar56"
-
- # Foo56 and Bar56 have attribute accessor methods
- new $P5, ['String'] # set attribute values
- set $P5, "i" # attribute slots have reference semantics
- set_args "0,0,0", $P5, "Foo56", "i"
- callmethodcc $P2, "set"
-
- new $P5, ['String']
- set $P5, "j"
- set_args "0,0,0", $P5, "Foo56", "j"
- callmethodcc $P2, "set"
-
- new $P5, ['String']
- set $P5, "k"
- set_args "0,0,0", $P5, "Bar56", "k"
- callmethodcc $P2, "set"
-
- new $P5, ['String']
- set $P5, "l"
- set_args "0,0,0", $P5, "Bar56", "l"
- callmethodcc $P2, "set"
-
- new $P5, ['String']
- set $P5, "m"
- set_args "0,0,0", $P5, "Bar56", "m"
- callmethodcc $P2, "set"
-
- # now retrieve attributes
- set_args "0,0", "Foo56", "i"
- callmethodcc $P2, "get"
- get_results "0", $P5
- is( $P5, 'i', 'got attrib i from subclass through parent method' )
-
- set_args "0,0", "Foo56", "j"
- callmethodcc $P2, "get"
- get_results "0", $P5
- is( $P5, "j", 'got attrib i from subclass through parent method' )
-
- set_args "0,0", "Bar56", "k"
- callmethodcc $P2, "get"
- get_results "0", $P5
- is( $P5, "k", 'got attrib i from subclass through parent method' )
-
- set_args "0,0", "Bar56", "l"
- callmethodcc $P2, "get"
- get_results "0", $P5
- is( $P5, "l", 'got attrib i from subclass through parent method' )
-
- set_args "0,0", "Bar56", "m"
- callmethodcc $P2, "get"
- get_results "0", $P5
- is( $P5, "m", 'got attrib i from subclass through parent method' )
-.end
-
-# Foo56 provides accessor functions which Bar56 inherits
-# they take an additional classname argument SClass
-
-# set(obj: Pvalue, SClass, Sattr)
-.sub set
- get_params "0,0,0", $P5, $S4, $S5
- interpinfo $P2, .INTERPINFO_CURRENT_OBJECT
- setattribute $P2, $S5, $P5
- set_returns ""
- returncc
-.end
-
-# Pattr = get(obj: SClass, Sattr)
-.sub get
- get_params "0,0", $S4, $S5
- interpinfo $P2, .INTERPINFO_CURRENT_OBJECT
- getattribute $P5, $P2, $S5
- set_returns "0", $P5
- returncc
-.end
-
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/gsoc_threads/t/pmc/stringbuilder.t
==============================================================================
--- branches/gsoc_threads/t/pmc/stringbuilder.t Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/t/pmc/stringbuilder.t Tue Jun 15 17:35:18 2010 (r47645)
@@ -25,7 +25,7 @@
test_push_pmc() # 4 tests
test_push_string_unicode() # 1 test
test_i_concatenate() # 1 test
- test_set_string_native() # 3 tests
+ test_set_string_native() # 4 tests
test_set_string_native_with_hash() # 2 tests
test_set_pmc()
test_substr()
@@ -176,6 +176,14 @@
is( $S0, "foobar", "... with appending string after")
is( $S99, "foo", "... without touching of original string")
+ # Assumed that the previous operations does not reach initial
+ # capacity of the buffer, the next test should cause a
+ # reallocation, ensuring full coverage of the set_string_native
+ # vtable function.
+ $S1 = repeat 'x', 4096
+ sb = $S1
+ $I0 = sb.'get_string_length'()
+ is( $I0, 4096, "... with a big size change")
.end
.sub 'test_set_string_native_with_hash'
Modified: branches/gsoc_threads/t/pmc/stringiterator.t
==============================================================================
--- branches/gsoc_threads/t/pmc/stringiterator.t Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/t/pmc/stringiterator.t Tue Jun 15 17:35:18 2010 (r47645)
@@ -21,13 +21,49 @@
.sub main :main
.include 'test_more.pir'
- plan(18)
+ plan(22)
+ test_clone()
+ test_elements()
iterate_forward() # 10 tests
iterate_backward() # 8 tests
+ iterate_wrong() # 1 test
.end
+.sub 'test_clone'
+ .local pmc s, it, itc
+ .local int nit, nitc
+
+ s = new ['String']
+ s = 'somestring'
+ it = iter s
+ # Get a clone and make sure both the original and the clone
+ # gets marked.
+ sweep 1
+ nit = elements it
+ itc = clone it
+ sweep 1
+ nitc = elements itc
+ is(nit, nitc, "clone has same length as original")
+.end
+
+.sub test_elements
+ .local string s
+ .local pmc ps, it
+ .local int ns, nit
+
+ s = 'someotherstring'
+ ps = new ['String']
+ ps = s
+ it = iter ps
+ ns = length s
+ nit = elements it
+ is(ns, nit, "iter elements is equal to string length")
+ nit = it
+ is(ns, nit, "iter get_integer is equal to string length")
+.end
+
.sub 'iterate_forward'
.local pmc s, it
@@ -96,6 +132,27 @@
ok($I0, "Shifting from finished iterator throws exception")
.end
+.sub 'iterate_wrong'
+ .local pmc s, it, ex
+ .local int r
+
+ s = new ['String']
+ s = 'BAZ'
+
+ it = iter s
+ push_eh catch_wrong
+ it = 42 # Let's hope we'll never have such direction
+ r = 0
+ goto dotest
+catch_wrong:
+ .get_results(ex)
+ finalize ex
+ pop_eh
+ r = 1
+dotest:
+ ok(r, "Caught wrong direction")
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: branches/gsoc_threads/t/steps/auto/warnings-01.t
==============================================================================
--- branches/gsoc_threads/t/steps/auto/warnings-01.t Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/t/steps/auto/warnings-01.t Tue Jun 15 17:35:18 2010 (r47645)
@@ -5,7 +5,7 @@
use strict;
use warnings;
-use Test::More qw(no_plan); # tests => 26;
+use Test::More tests => 18;
use Carp;
use lib qw( lib t/configure/testlib );
use_ok('config::auto::warnings');
Copied: branches/gsoc_threads/t/tools/parrot_config.t (from r47644, trunk/t/tools/parrot_config.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_threads/t/tools/parrot_config.t Tue Jun 15 17:35:18 2010 (r47645, copy of r47644, trunk/t/tools/parrot_config.t)
@@ -0,0 +1,84 @@
+#! perl
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+t/tools/parrot_config.t - test parrot_config
+
+=head1 SYNOPSIS
+
+ % prove t/tools/parrot_config.t - test parrot_config
+
+=head1 DESCRIPTION
+
+Tests the C<parrot_config> tool.
+
+=cut
+
+use strict;
+use warnings;
+use lib qw(lib);
+
+use Test::More;
+use IO::File ();
+use Parrot::Config;
+use Parrot::Test;
+use File::Spec;
+
+my ($path, $exefile);
+
+BEGIN {
+ $path = File::Spec->catfile( ".", "parrot_config" );
+ $exefile = $path . $PConfig{exe};
+ unless ( -f $exefile ) {
+ plan skip_all => "$exefile hasn't been built yet.";
+ exit(0);
+ }
+ plan tests => 3;
+}
+
+config_output_like(
+ 'pmc_names',
+ qr/\bHash\b/,
+ 'parrot_config basic sanity'
+);
+
+config_output_like(
+ 'non_existant_key',
+ qr/no such key: 'non_existant_key'/,
+ 'missing keys'
+);
+
+config_output_like(
+ 'slash has_icu',
+ qr/slash \s+ => \s+ '.' \n has_icu \s+ => \s+ '.'/x,
+ 'multiple keys'
+);
+
+=head1 HELPER SUBROUTINES
+
+=head2 dump_output_like
+
+ config_output_like($keys, /regexp/, $description);
+
+Runs parrot_config with $keys as the argument and verifies the output.
+
+=cut
+
+sub config_output_like {
+ my ($options, $snippet, $desc) = @_;
+
+ my $out = `$exefile $options`;
+
+ like( $out, $snippet, $desc );
+
+ return;
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Modified: branches/gsoc_threads/tools/dev/fetch_languages.pl
==============================================================================
--- branches/gsoc_threads/tools/dev/fetch_languages.pl Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/tools/dev/fetch_languages.pl Tue Jun 15 17:35:18 2010 (r47645)
@@ -229,8 +229,8 @@
{
name => 'pir',
- scm => 'SVN',
- repository => 'https://svn.parrot.org/languages/pir/trunk'
+ scm => 'GIT',
+ repository => 'http://github.com/bacek/pir.git'
},
{
Modified: branches/gsoc_threads/tools/dev/mk_inno.pl
==============================================================================
--- branches/gsoc_threads/tools/dev/mk_inno.pl Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/tools/dev/mk_inno.pl Tue Jun 15 17:35:18 2010 (r47645)
@@ -34,6 +34,7 @@
} if ($PConfig{has_icu});
my %dll = (
+ gccversion => [ 'libgcc_s_sjlj-1.dll' ],
HAS_GETTEXT => [ 'libintl3.dll', 'libiconv2.dll' ],
HAS_PCRE => [ 'pcre3.dll' ],
HAS_READLINE => [ 'readline5.dll' ],
Modified: branches/gsoc_threads/tools/dev/mk_manifest_and_skip.pl
==============================================================================
--- branches/gsoc_threads/tools/dev/mk_manifest_and_skip.pl Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/tools/dev/mk_manifest_and_skip.pl Tue Jun 15 17:35:18 2010 (r47645)
@@ -12,7 +12,6 @@
if (-e '.git') {
print "Sorry, this script is not compatible with git-svn\n";
- print "Patches Welcome!\n";
exit 1;
}
Modified: branches/gsoc_threads/tools/dev/pprof2cg.pl
==============================================================================
--- branches/gsoc_threads/tools/dev/pprof2cg.pl Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/tools/dev/pprof2cg.pl Tue Jun 15 17:35:18 2010 (r47645)
@@ -43,7 +43,7 @@
=cut
-main(\@ARGV);
+main(@ARGV);
=head1 INTERNAL DATA STRUCTURES
@@ -117,9 +117,11 @@
=cut
sub main {
- my $argv = shift;
+ my $filename = shift;
my $stats = {};
- my $filename = $argv->[0];
+
+ die "Usage: $0 filename\n"
+ unless defined $filename;
$stats->{global_stats}{total_time} = 0;
@@ -129,8 +131,6 @@
close($in_fh) or die "couldn't close $filename: $!";
- #print_stats($stats);
-
unless ($filename =~ s/pprof/out/) {
$filename = "$filename.out";
}
Modified: branches/gsoc_threads/tools/dev/vgp
==============================================================================
--- branches/gsoc_threads/tools/dev/vgp Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/tools/dev/vgp Tue Jun 15 17:35:18 2010 (r47645)
@@ -1,2 +1,2 @@
#! /bin/sh
-valgrind --suppressions=tools/dev/parrot.supp --num-callers=500 --leak-check=full --leak-resolution=high --show-reachable=yes ./parrot --leak-test $@
+valgrind --suppressions=tools/dev/parrot.supp --num-callers=50 --leak-check=full --leak-resolution=high --show-reachable=yes ./parrot --leak-test $@
Modified: branches/gsoc_threads/tools/util/parrot-config.pir
==============================================================================
--- branches/gsoc_threads/tools/util/parrot-config.pir Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/tools/util/parrot-config.pir Tue Jun 15 17:35:18 2010 (r47645)
@@ -92,7 +92,7 @@
.include 'stdio.pasm'
$P1 = $P0.'stdhandle'(.PIO_STDERR_FILENO)
$P1.'print'($S0)
- $P1.'print'(" [ <config-key> | --dump | --help ]\n")
+ $P1.'print'(" [ <config-key> [ <config-key> ... ] | --dump | --help ]\n")
exit 1
.end
Modified: branches/gsoc_threads/tools/util/release.json
==============================================================================
--- branches/gsoc_threads/tools/util/release.json Tue Jun 15 17:10:29 2010 (r47644)
+++ branches/gsoc_threads/tools/util/release.json Tue Jun 15 17:35:18 2010 (r47645)
@@ -1,9 +1,9 @@
{
- "release.version" : "2.4.0",
- "release.name" : "Sulfur Crest",
+ "release.version" : "2.5.0",
+ "release.name" : "Cheops",
"release.day" : "Tuesday",
- "release.date" : "18 May 2010",
- "release.nextdate" : "15 June 2010",
+ "release.date" : "15 June 2010",
+ "release.nextdate" : "20 July 2010",
"web.root" : "http://parrot.org/",
"web.source" : "download",
@@ -11,13 +11,12 @@
"web.repository" : "https://svn.parrot.org/parrot/trunk/",
"bugday.day" : "Saturday",
- "bugday.date" : "12 June 2010",
+ "bugday.date" : "17 July 2010",
"wiki.root" : "https://trac.parrot.org/parrot/wiki/",
- "wiki.bugday" : "bug_day_2010_06_12",
+ "wiki.bugday" : "bug_day_2010_07_17",
- "cpan.search" : "http://search.cpan.org/dist/parrot",
- "ftp.path" : "ftp://ftp.parrot.org/pub/parrot/releases/devel/2.4.0/",
+ "ftp.path" : "ftp://ftp.parrot.org/pub/parrot/releases/devel/2.5.0/",
"subversion.root" : "http://subversion.apache.org/",
"svk.root" : "http://svk.bestpractical.com/"
}
More information about the parrot-commits
mailing list