[svn:parrot] r47578 - in branches/gsoc_nfg: . compilers/opsc/src/Ops config/gen/makefiles examples/embed include/parrot lib/Parrot/Harness src src/call src/interp src/ops src/pmc src/runcore src/string t/dynoplibs t/native_pbc t/op t/pir t/pmc t/src tools/dev
darbelo at svn.parrot.org
darbelo at svn.parrot.org
Sat Jun 12 22:22:12 UTC 2010
Author: darbelo
Date: Sat Jun 12 22:22:10 2010
New Revision: 47578
URL: https://trac.parrot.org/parrot/changeset/47578
Log:
Sync with trunk.
Added:
branches/gsoc_nfg/src/pmc/bytebuffer.pmc
- copied unchanged from r47572, trunk/src/pmc/bytebuffer.pmc
branches/gsoc_nfg/t/dynoplibs/io-old.t
- copied unchanged from r47572, trunk/t/dynoplibs/io-old.t
branches/gsoc_nfg/t/pir/timer_exit.t
- copied unchanged from r47572, trunk/t/pir/timer_exit.t
branches/gsoc_nfg/t/pmc/bytebuffer.t
- copied unchanged from r47572, trunk/t/pmc/bytebuffer.t
Modified:
branches/gsoc_nfg/ (props changed)
branches/gsoc_nfg/MANIFEST
branches/gsoc_nfg/MANIFEST.generated
branches/gsoc_nfg/NEWS
branches/gsoc_nfg/PBC_COMPAT
branches/gsoc_nfg/compilers/opsc/src/Ops/Op.pm
branches/gsoc_nfg/config/gen/makefiles/root.in
branches/gsoc_nfg/examples/embed/cotorra.c
branches/gsoc_nfg/include/parrot/runcore_trace.h (props changed)
branches/gsoc_nfg/include/parrot/warnings.h
branches/gsoc_nfg/lib/Parrot/Harness/DefaultTests.pm
branches/gsoc_nfg/src/call/context.c
branches/gsoc_nfg/src/exceptions.c
branches/gsoc_nfg/src/interp/inter_create.c (props changed)
branches/gsoc_nfg/src/library.c
branches/gsoc_nfg/src/ops/core.ops
branches/gsoc_nfg/src/ops/core_ops.c
branches/gsoc_nfg/src/pmc/filehandle.pmc
branches/gsoc_nfg/src/pmc/fixedintegerarray.pmc
branches/gsoc_nfg/src/pmc/parrotinterpreter.pmc
branches/gsoc_nfg/src/pmc/resizableintegerarray.pmc
branches/gsoc_nfg/src/pmc/scheduler.pmc
branches/gsoc_nfg/src/pmc/stringbuilder.pmc
branches/gsoc_nfg/src/runcore/cores.c (props changed)
branches/gsoc_nfg/src/runcore/trace.c (props changed)
branches/gsoc_nfg/src/scheduler.c
branches/gsoc_nfg/src/string/api.c
branches/gsoc_nfg/src/string/grapheme.c
branches/gsoc_nfg/src/warnings.c
branches/gsoc_nfg/t/dynoplibs/io.t
branches/gsoc_nfg/t/native_pbc/annotations.pbc
branches/gsoc_nfg/t/native_pbc/integer.pbc
branches/gsoc_nfg/t/native_pbc/integer_1.pbc
branches/gsoc_nfg/t/native_pbc/number.pbc
branches/gsoc_nfg/t/native_pbc/number_1.pbc
branches/gsoc_nfg/t/native_pbc/string.pbc
branches/gsoc_nfg/t/native_pbc/string_1.pbc
branches/gsoc_nfg/t/op/annotate-old.t
branches/gsoc_nfg/t/op/calling.t
branches/gsoc_nfg/t/pmc/eval.t
branches/gsoc_nfg/t/pmc/filehandle.t
branches/gsoc_nfg/t/pmc/fixedintegerarray.t
branches/gsoc_nfg/t/pmc/float.t
branches/gsoc_nfg/t/pmc/io.t
branches/gsoc_nfg/t/pmc/objects.t
branches/gsoc_nfg/t/pmc/packfile.t
branches/gsoc_nfg/t/pmc/resizableintegerarray.t
branches/gsoc_nfg/t/pmc/stringbuilder.t
branches/gsoc_nfg/t/src/embed.t (contents, props changed)
branches/gsoc_nfg/tools/dev/mk_gitignore.pl (props changed)
Modified: branches/gsoc_nfg/MANIFEST
==============================================================================
--- branches/gsoc_nfg/MANIFEST Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/MANIFEST Sat Jun 12 22:22:10 2010 (r47578)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Sat Jun 12 17:33:33 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun 9 14:23:50 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -1352,6 +1352,7 @@
src/pmc/bigint.pmc []
src/pmc/bignum.pmc []
src/pmc/boolean.pmc []
+src/pmc/bytebuffer.pmc []
src/pmc/callcontext.pmc []
src/pmc/capture.pmc []
src/pmc/class.pmc []
@@ -1658,6 +1659,7 @@
t/dynoplibs/bit.t [test]
t/dynoplibs/debug.t [test]
t/dynoplibs/deprecated.t [test]
+t/dynoplibs/io-old.t [test]
t/dynoplibs/io.t [test]
t/dynoplibs/math.t [test]
t/dynoplibs/obscure.t [test]
@@ -1844,11 +1846,13 @@
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]
t/pmc/bignum.t [test]
t/pmc/boolean.t [test]
+t/pmc/bytebuffer.t [test]
t/pmc/callcontext.t [test]
t/pmc/capture.t [test]
t/pmc/class.t [test]
Modified: branches/gsoc_nfg/MANIFEST.generated
==============================================================================
--- branches/gsoc_nfg/MANIFEST.generated Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/MANIFEST.generated Sat Jun 12 22:22:10 2010 (r47578)
@@ -42,6 +42,7 @@
include/pmc/pmc_bigint.h [devel]include
include/pmc/pmc_bignum.h [devel]include
include/pmc/pmc_boolean.h [devel]include
+include/pmc/pmc_bytebuffer.h [devel]include
include/pmc/pmc_callcontext.h [devel]include
include/pmc/pmc_capture.h [devel]include
include/pmc/pmc_class.h [devel]include
@@ -295,7 +296,7 @@
runtime/parrot/library/TAP/Formatter.pbc [main]
runtime/parrot/library/TAP/Harness.pbc [main]
runtime/parrot/library/TAP/Parser.pbc [main]
-runtime/parrot/library/TGE.pbc [main]
+runtime/parrot/library/TGE.pbc [main]
runtime/parrot/library/Tcl/Glob.pbc [main]
runtime/parrot/library/TclLibrary.pbc [main]
runtime/parrot/library/Test/Builder.pbc [main]
@@ -336,6 +337,7 @@
src/pmc/bigint.dump [devel]src
src/pmc/bignum.dump [devel]src
src/pmc/boolean.dump [devel]src
+src/pmc/bytebuffer.dump [devel]src
src/pmc/callcontext.dump [devel]src
src/pmc/capture.dump [devel]src
src/pmc/class.dump [devel]src
Modified: branches/gsoc_nfg/NEWS
==============================================================================
--- branches/gsoc_nfg/NEWS Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/NEWS Sat Jun 12 22:22:10 2010 (r47578)
@@ -3,6 +3,41 @@
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
+ + New executable "ops2c" added; take care by packing
+- 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
+ + 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.
+ + Branch ns_func_cleanup created, will be merged after this release
+- 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
+ + Fixed sigspace handling ** quantifier in regexes
+ + Added \e strings
+ + Added use of inversion lists for charclass lists in regexes
+- Languages
+ + Resurrected partcl
New in 2.4.0
- Core
Modified: branches/gsoc_nfg/PBC_COMPAT
==============================================================================
--- branches/gsoc_nfg/PBC_COMPAT Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/PBC_COMPAT Sat Jun 12 22:22:10 2010 (r47578)
@@ -28,6 +28,7 @@
# please insert tab separated entries at the top of the list
+6.21 2010.06.09 NotFound add ByteBuffer PMC
6.20 2010.05.29 plobsing eliminate unused fixup type 'label'
6.19 2010.05.27 plobsing removed numerous core ops (TT #449)
6.18 2010.05.25 cotto removed ops.num
Modified: branches/gsoc_nfg/compilers/opsc/src/Ops/Op.pm
==============================================================================
--- branches/gsoc_nfg/compilers/opsc/src/Ops/Op.pm Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/compilers/opsc/src/Ops/Op.pm Sat Jun 12 22:22:10 2010 (r47578)
@@ -284,61 +284,54 @@
}
# Recursively process body chunks returning string.
-# Ideally bunch of multisubs, but...
-method process_body_chunk($trans, $chunk) {
- my $what := $chunk.WHAT;
- # Poor man multis...
- if $what eq 'PAST::Var()' {
- my $n := +$chunk.name;
- return $trans.access_arg( self.arg_type($n - 1), $n);
+
+our multi method process_body_chunk($trans, PAST::Var $chunk) {
+ my $n := +$chunk.name;
+ $trans.access_arg( self.arg_type($n - 1), $n);
+}
+
+our multi method process_body_chunk($trans, PAST::Op $chunk) {
+ my $type := $chunk.pasttype;
+ #say('OP ' ~ $type);
+ if $type eq 'inline' {
+ #_dumper($chunk);
+ #pir::say('RET ' ~ $chunk<inline>);
+ return $chunk.inline;
}
- elsif $what eq 'PAST::Op()' {
- my $type := $chunk.pasttype;
- #say('OP ' ~ $type);
- if $type eq 'inline' {
- #_dumper($chunk);
- #pir::say('RET ' ~ $chunk<inline>);
- return $chunk.inline;
+ elsif $type eq 'call' {
+ my $name := $chunk.name;
+ #say('NAME '~$name ~ ' ' ~ $is_next);
+ if $name eq 'OPSIZE' {
+ #say('is_next');
+ return ~self.size;
}
- elsif $type eq 'call' {
- my $name := $chunk.name;
- #say('NAME '~$name ~ ' ' ~ $is_next);
- if $name eq 'OPSIZE' {
- #say('is_next');
- return ~self.size;
- }
-
- my @children := list();
- for @($chunk) {
- @children.push(self.process_body_chunk($trans, $_));
- }
- my $children := join('', |@children);
-
- #pir::say('children ' ~ $children);
- my $ret := Q:PIR<
- $P0 = find_lex '$trans'
- $P1 = find_lex '$name'
- $S0 = $P1
- $P1 = find_lex '$children'
- %r = $P0.$S0($P1)
- >;
- #pir::say('RET ' ~ $ret);
- return $ret;
- }
- }
- elsif $what eq 'PAST::Stmts()' {
+
my @children := list();
for @($chunk) {
@children.push(self.process_body_chunk($trans, $_));
}
my $children := join('', |@children);
- return $children;
- }
- else {
- pir::die('HOLEY');
+
+ #pir::say('children ' ~ $children);
+ my $ret := Q:PIR<
+ $P0 = find_lex '$trans'
+ $P1 = find_lex '$name'
+ $S0 = $P1
+ $P1 = find_lex '$children'
+ %r = $P0.$S0($P1)
+ >;
+ #pir::say('RET ' ~ $ret);
+ return $ret;
}
}
+our multi method process_body_chunk($trans, PAST::Stmts $chunk) {
+ my @children := list();
+ for @($chunk) {
+ @children.push(self.process_body_chunk($trans, $_));
+ }
+ join('', |@children);
+}
=begin
Modified: branches/gsoc_nfg/config/gen/makefiles/root.in
==============================================================================
--- branches/gsoc_nfg/config/gen/makefiles/root.in Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/config/gen/makefiles/root.in Sat Jun 12 22:22:10 2010 (r47578)
@@ -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)
Modified: branches/gsoc_nfg/examples/embed/cotorra.c
==============================================================================
--- branches/gsoc_nfg/examples/embed/cotorra.c Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/examples/embed/cotorra.c Sat Jun 12 22:22:10 2010 (r47578)
@@ -227,18 +227,18 @@
if (stname) {
Parrot_PMC rootns = Parrot_get_root_namespace(interp);
Parrot_String parrotname = create_string(interp, "parrot");
- Parrot_PMC parrotns = Parrot_PMC_get_pmc_strkey(interp, rootns, parrotname);
+ Parrot_PMC parrotns = Parrot_PMC_get_pmc_keyed_str(interp, rootns, parrotname);
Parrot_String name = create_string(interp, stname);
- Parrot_PMC start = Parrot_PMC_get_pmc_strkey(interp, parrotns, name);
+ Parrot_PMC start = Parrot_PMC_get_pmc_keyed_str(interp, parrotns, name);
if (Parrot_pmc_is_null(interp, start))
fail("start sub not found");
if (i < argc) {
int pos;
Parrot_PMC arg = Parrot_PMC_new(interp,
Parrot_PMC_typenum(interp, "FixedStringArray"));
- Parrot_PMC_set_intval(interp, arg, argc - i);
+ Parrot_PMC_set_integer_native(interp, arg, argc - i);
for (pos = 0; i < argc; ++i, ++pos) {
- Parrot_PMC_set_string_intkey(interp, arg, pos, create_string(interp, argv[i]));
+ Parrot_PMC_set_string_keyed_int(interp, arg, pos, create_string(interp, argv[i]));
}
Parrot_ext_call(interp, start, "P->", arg);
}
Modified: branches/gsoc_nfg/include/parrot/warnings.h
==============================================================================
--- branches/gsoc_nfg/include/parrot/warnings.h Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/include/parrot/warnings.h Sat Jun 12 22:22:10 2010 (r47578)
@@ -61,12 +61,20 @@
__attribute__nonnull__(3);
PARROT_EXPORT
+void Parrot_warn_deprecated(PARROT_INTERP, ARGIN(const char *message))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
void print_pbc_location(PARROT_INTERP)
__attribute__nonnull__(1);
#define ASSERT_ARGS_Parrot_warn __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(message))
+#define ASSERT_ARGS_Parrot_warn_deprecated __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(message))
#define ASSERT_ARGS_print_pbc_location __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
Modified: branches/gsoc_nfg/lib/Parrot/Harness/DefaultTests.pm
==============================================================================
--- branches/gsoc_nfg/lib/Parrot/Harness/DefaultTests.pm Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/lib/Parrot/Harness/DefaultTests.pm Sat Jun 12 22:22:10 2010 (r47578)
@@ -64,6 +64,7 @@
t/op/*.t
t/pmc/*.t
t/oo/*.t
+ t/pir/*.t
t/native_pbc/*.t
);
Modified: branches/gsoc_nfg/src/call/context.c
==============================================================================
--- branches/gsoc_nfg/src/call/context.c Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/call/context.c Sat Jun 12 22:22:10 2010 (r47578)
@@ -518,7 +518,7 @@
ARGIN_NULLOK(PMC *old))
{
ASSERT_ARGS(Parrot_alloc_context)
- PMC *pmcctx = Parrot_pmc_new(interp, enum_class_CallContext);
+ PMC * const pmcctx = Parrot_pmc_new(interp, enum_class_CallContext);
allocate_registers(interp, pmcctx, number_regs_used);
init_context(interp, pmcctx, old);
@@ -544,7 +544,7 @@
Parrot_pcc_allocate_empty_context(PARROT_INTERP, ARGIN_NULLOK(PMC *old))
{
ASSERT_ARGS(Parrot_pcc_allocate_empty_context)
- PMC *pmcctx = Parrot_pmc_new(interp, enum_class_CallContext);
+ PMC * const pmcctx = Parrot_pmc_new(interp, enum_class_CallContext);
init_context(interp, pmcctx, old);
@@ -622,8 +622,9 @@
Parrot_clear_i(PARROT_INTERP)
{
ASSERT_ARGS(Parrot_clear_i)
+ const UINTVAL regs_used = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_INT);
UINTVAL i;
- for (i = 0; i < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_INT); ++i)
+ for (i = 0; i < regs_used; ++i)
REG_INT(interp, i) = 0;
}
@@ -643,8 +644,9 @@
Parrot_clear_s(PARROT_INTERP)
{
ASSERT_ARGS(Parrot_clear_s)
+ const UINTVAL regs_used = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_STR);
UINTVAL i;
- for (i = 0; i < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_STR); ++i)
+ for (i = 0; i < regs_used; ++i)
REG_STR(interp, i) = NULL;
}
@@ -664,8 +666,9 @@
Parrot_clear_p(PARROT_INTERP)
{
ASSERT_ARGS(Parrot_clear_p)
+ const UINTVAL regs_used = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_PMC);
UINTVAL i;
- for (i = 0; i < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_PMC); ++i)
+ for (i = 0; i < regs_used; ++i)
REG_PMC(interp, i) = PMCNULL;
}
@@ -685,8 +688,9 @@
Parrot_clear_n(PARROT_INTERP)
{
ASSERT_ARGS(Parrot_clear_n)
+ const UINTVAL regs_used = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_NUM);
UINTVAL i;
- for (i = 0; i < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_NUM); ++i)
+ for (i = 0; i < regs_used; ++i)
REG_NUM(interp, i) = 0.0;
}
Modified: branches/gsoc_nfg/src/exceptions.c
==============================================================================
--- branches/gsoc_nfg/src/exceptions.c Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/exceptions.c Sat Jun 12 22:22:10 2010 (r47578)
@@ -68,7 +68,7 @@
long error, ARGIN_NULLOK(STRING *msg))
{
ASSERT_ARGS(Parrot_ex_build_exception)
- PMC *exception = Parrot_pmc_new(interp, enum_class_Exception);
+ PMC * const exception = Parrot_pmc_new(interp, enum_class_Exception);
VTABLE_set_integer_keyed_str(interp, exception, CONST_STRING(interp, "severity"), severity);
VTABLE_set_integer_keyed_str(interp, exception, CONST_STRING(interp, "type"), error);
Modified: branches/gsoc_nfg/src/library.c
==============================================================================
--- branches/gsoc_nfg/src/library.c Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/library.c Sat Jun 12 22:22:10 2010 (r47578)
@@ -809,6 +809,7 @@
ASSERT_ARGS(Parrot_get_runtime_prefix)
char * const env = Parrot_getenv(interp, CONST_STRING(interp, "PARROT_RUNTIME"));
+ Parrot_warn_deprecated(interp, "Parrot_get_runtime_prefix is deprecated TT #1191");
if (env)
return env;
else {
Modified: branches/gsoc_nfg/src/ops/core.ops
==============================================================================
--- branches/gsoc_nfg/src/ops/core.ops Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/ops/core.ops Sat Jun 12 22:22:10 2010 (r47578)
@@ -542,6 +542,7 @@
PARROT_ERRORS_RESULT_COUNT_FLAG);
argc = VTABLE_elements(interp, signature);
+ Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), PMCNULL);
goto OFFSET(argc + 2);
}
Modified: branches/gsoc_nfg/src/ops/core_ops.c
==============================================================================
--- branches/gsoc_nfg/src/ops/core_ops.c Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/ops/core_ops.c Sat Jun 12 22:22:10 2010 (r47578)
@@ -14516,7 +14516,8 @@
Parrot_pcc_fill_params_from_op(interp, call_object, signature, raw_params,
PARROT_ERRORS_RESULT_COUNT_FLAG);
- argc = VTABLE_elements(interp, signature);return (opcode_t *)cur_opcode + argc + 2;
+ argc = VTABLE_elements(interp, signature);
+ Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), PMCNULL);return (opcode_t *)cur_opcode + argc + 2;
}
opcode_t *
@@ -14797,7 +14798,7 @@
opcode_t *dest;
opcode_t * const ret =cur_opcode + 2;
PMC * const resume = pmc_new(interp, enum_class_Continuation);
- PMC * const exception = Parrot_ex_build_exception(interp, EXCEPT_exit,
+ PMC * const exception = Parrot_ex_build_exception(interp, EXCEPT_exit,
CONTROL_EXIT, NULL);
VTABLE_set_pointer(interp, resume, ret);
@@ -14815,7 +14816,7 @@
opcode_t *dest;
opcode_t * const ret =cur_opcode + 2;
PMC * const resume = pmc_new(interp, enum_class_Continuation);
- PMC * const exception = Parrot_ex_build_exception(interp, EXCEPT_exit,
+ PMC * const exception = Parrot_ex_build_exception(interp, EXCEPT_exit,
CONTROL_EXIT, NULL);
VTABLE_set_pointer(interp, resume, ret);
Copied: branches/gsoc_nfg/src/pmc/bytebuffer.pmc (from r47572, trunk/src/pmc/bytebuffer.pmc)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_nfg/src/pmc/bytebuffer.pmc Sat Jun 12 22:22:10 2010 (r47578, copy of r47572, trunk/src/pmc/bytebuffer.pmc)
@@ -0,0 +1,353 @@
+/*
+Copyright (C) 2010, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/pmc/bytebuffer.pmc - A byte buffer
+
+=head1 DESCRIPTION
+
+C<ByteBuffer> provides a resizable byte buffer with random access to
+individual bytes and conversions from and to parrot strings.
+
+=cut
+
+*/
+
+/* HEADERIZER HFILE: none */
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+PARROT_CANNOT_RETURN_NULL
+static STRING * build_string(PARROT_INTERP,
+ ARGIN(const unsigned char *content),
+ INTVAL size,
+ ARGIN_NULLOK(const CHARSET *charset),
+ ARGIN_NULLOK(const ENCODING *encoding))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static INTVAL grow_to(INTVAL position);
+#define ASSERT_ARGS_build_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(content))
+#define ASSERT_ARGS_grow_to __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: static */
+
+pmclass ByteBuffer auto_attrs {
+ ATTR INTVAL allocated_size;
+ ATTR INTVAL size;
+ ATTR STRING *source;
+ ATTR unsigned char *content;
+
+/*
+
+=head2 Vtable functions
+
+=over 4
+
+=item C<void init()>
+
+Create an empty buffer
+
+=item C<void init_int()>
+
+Create a buffer of initial_size capacity.
+
+=item C<void mark()>
+
+Mark the source string if any.
+
+=item C<void destroy()>
+
+Free the buffer when destroying.
+
+=cut
+
+*/
+
+ VTABLE void init() {
+ PObj_custom_mark_destroy_SETALL(SELF);
+ }
+
+ VTABLE void init_int(INTVAL initial_size) {
+ unsigned char *content;
+ STATICSELF.init();
+ SET_ATTR_size(INTERP, SELF, initial_size);
+ SET_ATTR_allocated_size(INTERP, SELF, initial_size);
+ content = (unsigned char *)Parrot_gc_allocate_memory_chunk(INTERP, initial_size);
+ SET_ATTR_content(INTERP, SELF, content);
+ }
+
+ VTABLE void mark() {
+ STRING * source;
+ GET_ATTR_source(INTERP, SELF, source);
+ if (!STRING_IS_NULL(source))
+ Parrot_gc_mark_STRING_alive(INTERP, source);
+ }
+
+ VTABLE void destroy() {
+ INTVAL allocated_size;
+ GET_ATTR_allocated_size(INTERP, SELF, allocated_size);
+ if (allocated_size) {
+ unsigned char *content;
+ GET_ATTR_content(INTERP, SELF, content);
+ Parrot_gc_free_memory_chunk(INTERP, content);
+ }
+ }
+
+/*
+
+=item C<INTVAL elements()>
+
+Get current size.
+
+=cut
+
+*/
+
+ VTABLE INTVAL elements() {
+ INTVAL size;
+ GET_ATTR_size(INTERP, SELF, size);
+ return size;
+ }
+
+/*
+
+=item C<void set_string_native()>
+
+Reset the buffer with the content of the string.
+
+=cut
+
+*/
+
+ VTABLE void set_string_native(STRING *new_string) {
+ INTVAL allocated_size;
+ GET_ATTR_allocated_size(INTERP, SELF, allocated_size);
+ if (allocated_size) {
+ unsigned char *content;
+ GET_ATTR_content(INTERP, SELF, content);
+ Parrot_gc_free_memory_chunk(INTERP, content);
+ SET_ATTR_allocated_size(INTERP, SELF, 0);
+ }
+ SET_ATTR_source(INTERP, SELF, new_string);
+ SET_ATTR_size(INTERP, SELF, Parrot_str_byte_length(INTERP, new_string));
+ SET_ATTR_content(INTERP, SELF, (unsigned char *)new_string->strstart);
+ }
+
+/*
+
+=item C<INTVAL get_integer_keyed_int()>
+
+Get the value of the byte at position or 0 if out of bounds.
+
+=cut
+
+*/
+
+ VTABLE INTVAL get_integer_keyed_int(INTVAL position) {
+ INTVAL size;
+ unsigned char *content;
+ GET_ATTR_size(INTERP, SELF, size);
+ GET_ATTR_content(INTERP, SELF, content);
+ return (position >= 0 && position < size) ? content[position] : (INTVAL) 0;
+ }
+
+/*
+
+=item C<void set_integer_keyed_int()>
+
+Set the value of the byte at position.
+
+=cut
+
+*/
+
+ VTABLE void set_integer_keyed_int(INTVAL position, INTVAL value) {
+ unsigned char *content;
+ INTVAL size, allocated_size;
+ if (position < 0)
+ Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
+ "Negative position not allowed");
+
+ GET_ATTR_allocated_size(INTERP, SELF, allocated_size);
+ if (position >= allocated_size) {
+ INTVAL newsize = grow_to(position);
+ if (allocated_size == 0) {
+ INTVAL copysize = newsize;
+ STRING * source;
+ content = (unsigned char *)Parrot_gc_allocate_memory_chunk(INTERP, newsize);
+ GET_ATTR_source(INTERP, SELF, source);
+ if (!STRING_IS_NULL(source)) {
+ INTVAL srclen = Parrot_str_byte_length(INTERP, source);
+ if (srclen < copysize)
+ copysize = srclen;
+ memcpy(content, source->strstart, copysize);
+ SET_ATTR_source(INTERP, SELF, STRINGNULL);
+ }
+ }
+ else {
+ GET_ATTR_content(INTERP, SELF, content);
+ content = (unsigned char *)
+ Parrot_gc_reallocate_memory_chunk(INTERP, content, newsize);
+ }
+
+ SET_ATTR_content(INTERP, SELF, content);
+ SET_ATTR_allocated_size(INTERP, SELF, newsize);
+ }
+ else
+ GET_ATTR_content(INTERP, SELF, content);
+
+ GET_ATTR_size(INTERP, SELF, size);
+ if (position >= size) {
+ size = position + 1;
+ SET_ATTR_size(INTERP, SELF, size);
+ }
+ content[position] = value;
+ }
+
+/*
+
+=item C<PMC *get_iter()>
+
+Return a new Iterator for this PMC.
+
+=cut
+
+*/
+
+ VTABLE PMC *get_iter() {
+ return Parrot_pmc_new_init(INTERP, enum_class_ArrayIterator, SELF);
+ }
+
+/*
+
+=back
+
+=head2 Methods
+
+=over 4
+
+=item C<get_string(string charset, string encoding)>
+
+Create a string with the buffer content and the charset and encoding
+specified.
+
+=cut
+
+*/
+
+ METHOD get_string(STRING *charsetname, STRING *encodingname) {
+ STRING *result;
+ unsigned char *content;
+ INTVAL size;
+ const CHARSET *charset = Parrot_get_charset(INTERP,
+ Parrot_charset_number(INTERP, charsetname));
+ const ENCODING *encoding = Parrot_get_encoding(INTERP,
+ Parrot_encoding_number(INTERP, encodingname));
+ GET_ATTR_content(INTERP, SELF, content);
+ GET_ATTR_size(INTERP, SELF, size);
+ result = build_string(INTERP, content, size, charset, encoding);
+ RETURN(STRING *result);
+ }
+
+/*
+
+=item C<get_string_as(string as)>
+
+Create a string with the buffer content and the same charset and encoding
+as the string argument.
+
+=cut
+
+*/
+
+ METHOD get_string_as(STRING *as :optional) {
+ STRING *result;
+ unsigned char *content;
+ INTVAL size;
+ const CHARSET* charset = STRING_IS_NULL(as) ? PARROT_DEFAULT_CHARSET : as->charset;
+ const ENCODING *encoding = STRING_IS_NULL(as) ? PARROT_DEFAULT_ENCODING : as->encoding;
+ GET_ATTR_content(INTERP, SELF, content);
+ GET_ATTR_size(INTERP, SELF, size);
+ result = build_string(INTERP, content, size, charset, encoding);
+ RETURN(STRING *result);
+ }
+
+} /* pmclass end */
+
+/*
+
+=back
+
+=head2 Auxiliar functions
+
+=over 4
+
+=item C<static INTVAL grow_to(INTVAL position)>
+
+Calculate new size enough for using position and with some margin to
+decrease the number of reallocations.
+
+=item C<static STRING * build_string(PARROT_INTERP, const unsigned char
+*content, INTVAL size, const CHARSET *charset, const ENCODING *encoding)>
+
+Build a string fro the buffer content with the charset and encoding specified.
+
+=cut
+
+*/
+
+static INTVAL
+grow_to(INTVAL position)
+{
+ ASSERT_ARGS(grow_to)
+
+ const UINTVAL blocksize = 2048;
+ UINTVAL minsize = position + 1;
+ return (INTVAL) (minsize < 64 ? 64 :
+ minsize < 256 ? 256 :
+ minsize < 1024 ? 1024 :
+ ((minsize + blocksize - 1) / blocksize) * blocksize);
+}
+
+PARROT_CANNOT_RETURN_NULL
+static STRING *
+build_string(PARROT_INTERP, ARGIN(const unsigned char *content),
+ INTVAL size,
+ ARGIN_NULLOK(const CHARSET *charset),
+ ARGIN_NULLOK(const ENCODING *encoding))
+{
+ ASSERT_ARGS(build_string)
+ STRING *result;
+ if (charset == NULL)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_ENCODING,
+ "Invalid charset");
+ if (encoding == NULL)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_ENCODING,
+ "Invalid encoding");
+ result = Parrot_str_new_init(interp, (const char *)content, size, encoding, charset, 0);
+ if (!CHARSET_VALIDATE(interp, result))
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_STRING_REPRESENTATION,
+ "Invalid buffer content");
+ return result;
+}
+
+/*
+
+=back
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: branches/gsoc_nfg/src/pmc/filehandle.pmc
==============================================================================
--- branches/gsoc_nfg/src/pmc/filehandle.pmc Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/pmc/filehandle.pmc Sat Jun 12 22:22:10 2010 (r47578)
@@ -736,11 +736,12 @@
*/
- METHOD seek(INTVAL whence, INTVAL offs, INTVAL offs_overflow :optional) {
- const PIOOFF_T pio_offs = offs_overflow ?
+ METHOD seek(INTVAL whence, INTVAL offs, INTVAL offs_overflow :optional,
+ int has_overflow :opt_flag) {
+ const PIOOFF_T pio_offs = has_overflow ?
Parrot_io_make_offset32(offs_overflow, offs) :
offs;
- if (Parrot_io_seek(INTERP, SELF, pio_offs, whence))
+ if (0 > Parrot_io_seek(INTERP, SELF, pio_offs, whence))
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_PIO_ERROR, "seek failed");
}
Modified: branches/gsoc_nfg/src/pmc/fixedintegerarray.pmc
==============================================================================
--- branches/gsoc_nfg/src/pmc/fixedintegerarray.pmc Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/pmc/fixedintegerarray.pmc Sat Jun 12 22:22:10 2010 (r47578)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2009, Parrot Foundation.
+Copyright (C) 2001-2010, Parrot Foundation.
$Id$
=head1 NAME
@@ -21,8 +21,20 @@
/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+static int auxcmpfunc(const INTVAL *i, const INTVAL *j);
+#define ASSERT_ARGS_auxcmpfunc __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
+static int
+auxcmpfunc(const INTVAL *i, const INTVAL *j)
+{
+ ASSERT_ARGS(auxcmpfunc)
+ return *i - *j;
+}
+
pmclass FixedIntegerArray auto_attrs provides array {
ATTR INTVAL size; /* number of INTVALs stored in this array */
ATTR INTVAL * int_array; /* INTVALs are stored here */
@@ -492,19 +504,23 @@
SELF.set_pmc_keyed_int(k, value);
}
- METHOD sort(PMC *cmp_func) {
- INTVAL *int_array;
+ METHOD sort(PMC *cmp_func :optional) {
UINTVAL n;
INTVAL size;
GET_ATTR_size(INTERP, SELF, size);
-
n = (UINTVAL)size;
if (n > 1) {
+ INTVAL *int_array;
GET_ATTR_int_array(INTERP, SELF, int_array);
- Parrot_quicksort(INTERP, (void**)int_array, n, cmp_func);
+ if (PMC_IS_NULL(cmp_func))
+ qsort(int_array, n, sizeof (INTVAL),
+ (int (*)(const void *, const void*))auxcmpfunc);
+ else
+ Parrot_quicksort(INTERP, (void**)int_array, n, cmp_func);
}
+ RETURN(PMC *SELF);
}
/*
Modified: branches/gsoc_nfg/src/pmc/parrotinterpreter.pmc
==============================================================================
--- branches/gsoc_nfg/src/pmc/parrotinterpreter.pmc Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/pmc/parrotinterpreter.pmc Sat Jun 12 22:22:10 2010 (r47578)
@@ -844,6 +844,7 @@
METHOD stdhandle(INTVAL fileno, PMC *newhandle :optional) {
PMC * const handle = Parrot_io_stdhandle(INTERP, fileno, newhandle);
+ Parrot_warn_deprecated(INTERP, "stdhandle method is experimental");
RETURN(PMC *handle);
}
Modified: branches/gsoc_nfg/src/pmc/resizableintegerarray.pmc
==============================================================================
--- branches/gsoc_nfg/src/pmc/resizableintegerarray.pmc Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/pmc/resizableintegerarray.pmc Sat Jun 12 22:22:10 2010 (r47578)
@@ -313,8 +313,12 @@
}
VTABLE void thaw(PMC *info) {
- const INTVAL n = VTABLE_shift_integer(INTERP, info);
- const INTVAL rt = VTABLE_shift_integer(INTERP, info);
+ INTVAL n, rt;
+
+ SUPER(info);
+
+ n = VTABLE_shift_integer(INTERP, info);
+ rt = VTABLE_shift_integer(INTERP, info);
SET_ATTR_size(INTERP, SELF, 0);
SET_ATTR_resize_threshold(INTERP, SELF, rt);
Modified: branches/gsoc_nfg/src/pmc/scheduler.pmc
==============================================================================
--- branches/gsoc_nfg/src/pmc/scheduler.pmc Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/pmc/scheduler.pmc Sat Jun 12 22:22:10 2010 (r47578)
@@ -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_nfg/src/pmc/stringbuilder.pmc
==============================================================================
--- branches/gsoc_nfg/src/pmc/stringbuilder.pmc Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/pmc/stringbuilder.pmc Sat Jun 12 22:22:10 2010 (r47578)
@@ -73,32 +73,27 @@
SET_ATTR_buffer(INTERP, SELF, buffer);
- PObj_custom_mark_destroy_SETALL(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
-=item C<void mark()>
+=item C<void destroy()>
-Marks the StringBuilder as live.
+Free the buffer on destruction.
=cut
*/
- VTABLE void mark() {
- }
-
VTABLE void destroy() {
- STRING *buffer;
-
- if (!PMC_data(SELF))
- return;
-
- GET_ATTR_buffer(INTERP, SELF, buffer);
- if (buffer->_bufstart)
- mem_gc_free(INTERP, buffer->_bufstart);
- mem_gc_free(INTERP, buffer);
+ if (PMC_data(SELF)) {
+ STRING *buffer;
+ GET_ATTR_buffer(INTERP, SELF, buffer);
+ if (buffer->_bufstart)
+ mem_gc_free(INTERP, buffer->_bufstart);
+ mem_gc_free(INTERP, buffer);
+ }
}
/*
Modified: branches/gsoc_nfg/src/scheduler.c
==============================================================================
--- branches/gsoc_nfg/src/scheduler.c Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/scheduler.c Sat Jun 12 22:22:10 2010 (r47578)
@@ -403,7 +403,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_nfg/src/string/api.c
==============================================================================
--- branches/gsoc_nfg/src/string/api.c Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/string/api.c Sat Jun 12 22:22:10 2010 (r47578)
@@ -503,7 +503,8 @@
if (a->extra != NULL) {
dest->extra = clone_grapheme_table(interp, a->extra);
if (b->extra != NULL) {
- dest->extra = grow_grapheme_table(interp, a->extra, ((grapheme_table *)b->extra)->used);
+ dest->extra = grow_grapheme_table(interp, a->extra,
+ ((grapheme_table *)b->extra)->used);
merge_tables_and_fixup_string(interp, dest, b->extra, a->strlen);
}
}
Modified: branches/gsoc_nfg/src/string/grapheme.c
==============================================================================
--- branches/gsoc_nfg/src/string/grapheme.c Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/string/grapheme.c Sat Jun 12 22:22:10 2010 (r47578)
@@ -41,21 +41,23 @@
for (i = 0; i < src->used; i++) {
dst->graphemes[i].len = src->graphemes[i].len;
dst->graphemes[i].hash = src->graphemes[i].hash;
- dst->graphemes[i].codepoints = mem_gc_allocate_n_typed(interp, src->graphemes[i].len, UChar32);
+ dst->graphemes[i].codepoints =
+ mem_gc_allocate_n_typed(interp, src->graphemes[i].len, UChar32);
memcpy(dst->graphemes[i].codepoints, src->graphemes[i].codepoints,
src->graphemes[i].len * sizeof (UChar32));
}
return dst;
- }
+ }
else {
return NULL;
- }
+ }
}
grapheme_table *
grow_grapheme_table(SHIM_INTERP, grapheme_table *src, UINTVAL n)
{
+ ASSERT_ARGS(grow_grapheme_table)
return (grapheme_table *) mem_sys_realloc(src,
sizeof (grapheme_table) + (src->size + n) * sizeof (grapheme));
}
@@ -74,19 +76,20 @@
void
merge_tables_and_fixup_string(PARROT_INTERP, STRING *dest, grapheme_table *table, UINTVAL offset)
{
+ ASSERT_ARGS(merge_tables_and_fixup_string)
INTVAL i;
UChar32 *buf = (UChar32 *) dest->strstart;
UChar32 *new_codepoints;
- if (table == NULL || table->used == 0)
+ if (table == NULL || table->used == 0)
return;
- if (dest->extra == NULL) {
+ if (dest->extra == NULL) {
dest->extra = clone_grapheme_table(interp, table);
return;
}
- new_codepoints = mem_gc_allocate_n_typed(interp, table->used, UChar32);
+ new_codepoints = mem_gc_allocate_n_typed(interp, table->used, UChar32);
/* Add the new graphemes to the old table. */
for (i = 0; i < table->used; i++) {
@@ -96,7 +99,7 @@
/* And fixup the string. */
for (i = offset; i < dest->strlen; i++) {
- int32_t codepoint = buf[i];
+ int32_t codepoint = buf[i];
if (codepoint < 0)
buf[i] = new_codepoints[(-1 - codepoint)];
}
@@ -107,7 +110,7 @@
UChar32
add_grapheme(PARROT_INTERP, grapheme_table *table, grapheme *src)
{
- ASSERT_ARGS(add_grapheme_from_substr)
+ ASSERT_ARGS(add_grapheme)
int32_t i;
/* Check if it's in the table already... */
Modified: branches/gsoc_nfg/src/warnings.c
==============================================================================
--- branches/gsoc_nfg/src/warnings.c Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/src/warnings.c Sat Jun 12 22:22:10 2010 (r47578)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2009, Parrot Foundation.
+Copyright (C) 2001-2010, Parrot Foundation.
$Id$
=head1 NAME
@@ -124,6 +124,30 @@
/*
+=item C<void Parrot_warn_deprecated(PARROT_INTERP, const char *message)>
+
+Warn about use of a deprecated feature
+
+C<message> is a C string.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_warn_deprecated(PARROT_INTERP, ARGIN(const char *message))
+{
+ ASSERT_ARGS(Parrot_warn_deprecated)
+
+ if (PARROT_WARNINGS_test(interp, PARROT_WARNINGS_DEPRECATED_FLAG)) {
+ STRING *msg = Parrot_sprintf_c(interp, "WARNING: %s\n", message);
+ print_warning(interp, msg);
+ }
+}
+
+/*
+
=back
=head1 SEE ALSO
Copied: branches/gsoc_nfg/t/dynoplibs/io-old.t (from r47572, trunk/t/dynoplibs/io-old.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_nfg/t/dynoplibs/io-old.t Sat Jun 12 22:22:10 2010 (r47578, copy of r47572, trunk/t/dynoplibs/io-old.t)
@@ -0,0 +1,91 @@
+#! perl
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use lib qw( . lib ../lib ../../lib );
+
+use Test::More;
+use Parrot::Test tests => 4;
+use Parrot::Test::Util 'create_tempfile';
+
+=head1 NAME
+
+t/pmc/io.t - IO Ops
+
+=head1 SYNOPSIS
+
+ % prove t/pmc/io.t
+
+=head1 DESCRIPTION
+
+Tests the Parrot IO operations.
+
+=cut
+
+my ($FOO, $temp_file) = create_tempfile( UNLINK => 1 );
+close $FOO;
+
+pasm_error_output_like( <<"CODE", <<'OUTPUT', '32bit seek: exception (ops)' );
+.loadlib 'io_ops'
+ open P0, "$temp_file", 'w'
+ seek P0, -1, 0
+ say "error!"
+ end
+CODE
+/seek failed \(32bit\)/
+OUTPUT
+
+pasm_error_output_like( <<"CODE", <<'OUTPUT', '64bit seek: exception (ops)' );
+.loadlib 'io_ops'
+ open P0, "$temp_file", 'w'
+ seek P0, -1, -1, 0
+ say "error!"
+ end
+CODE
+/seek failed \(64bit\)/
+OUTPUT
+
+pasm_output_is( <<"CODE", <<'OUTPUT', "peek (ops)" );
+.loadlib 'io_ops'
+ open P0, "$temp_file", 'w'
+ print P0, "a line\\n"
+ close P0
+ open P0, "$temp_file", 'r'
+ peek S0, P0
+ print S0
+ peek S1, P0
+ print S1
+ print "\\n"
+ read S2, P0, 2
+ peek S3, P0
+ print S3
+ print "\\n"
+ end
+CODE
+aa
+l
+OUTPUT
+
+pasm_output_is( <<"CODE", <<'OUTPUT', "peek on an empty file (ops)" );
+.loadlib 'io_ops'
+ open P0, "$temp_file", 'w'
+ close P0
+ open P0, "$temp_file", 'r'
+ peek S0, P0
+ eq S0, "", OK1
+ print "not "
+OK1:
+ say "ok 1"
+ end
+CODE
+ok 1
+OUTPUT
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Modified: branches/gsoc_nfg/t/dynoplibs/io.t
==============================================================================
--- branches/gsoc_nfg/t/dynoplibs/io.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/dynoplibs/io.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -1,5 +1,5 @@
#!./parrot
-# Copyright (C) 2008, Parrot Foundation.
+# Copyright (C) 2008-2010, Parrot Foundation.
# $Id$
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-.const int TESTS = 5
+.const int TESTS = 12
.loadlib 'io_ops'
@@ -25,12 +25,18 @@
plan(TESTS)
+ read_on_null()
open_delegates_to_filehandle_pmc()
open_null_filename()
open_null_mode()
open_pipe_for_reading()
getfd_fdopen()
- open_pipe_for_writing() # must be last (doesn't use test_more)
+ printerr_tests()
+ stat_tests()
+
+ # must come after (these don't use test_more)
+ open_pipe_for_writing()
+ read_invalid_fh()
.end
.sub open_delegates_to_filehandle_pmc
@@ -154,7 +160,7 @@
pipe = open command, 'wp'
unless pipe goto open_pipe_for_writing_failed
- pipe.'puts'("ok 5 - open pipe for writing\n")
+ pipe.'puts'("ok 9 - open pipe for writing\n")
close pipe
.return ()
@@ -173,16 +179,97 @@
$I0 = $P0.'get_fd'()
fdopen $P1, $I0, 'w'
$I0 = defined $P1
- ok($I0, 'get_fd()/fdopen')
- close $P1
-
- getstdout $P0
- $I0 = $P0.'get_fd'()
- fdopen $P1, $I0, 'w'
- $I0 = defined $P1
ok($I0, 'fdopen - no close')
.end
+.sub 'read_on_null'
+ .const string description = "read on null PMC throws exception"
+ push_eh eh
+ null $P1
+ $S0 = read $P1, 1
+ ok(0, description)
+ goto ret
+ eh:
+ ok(1, description)
+ ret:
+ pop_eh
+ .return ()
+.end
+
+.sub 'read_invalid_fh'
+ $P0 = new ['FileHandle']
+
+ push_eh _readline_handler
+ $S0 = readline $P0
+ print "not "
+
+_readline_handler:
+ print "ok 10\n"
+ pop_eh
+
+ push_eh _read_handler
+ $S0 = read $P0, 1
+ print "not "
+
+_read_handler:
+ print "ok 11\n"
+ pop_eh
+
+ push_eh _print_handler
+ print $P0, "kill me now\n"
+ print "not "
+
+_print_handler:
+ print "ok 12\n"
+ pop_eh
+.end
+
+.sub 'printerr_tests'
+ # temporarily capture stderr
+ $P0 = getstderr
+ $P1 = new ['StringHandle']
+ $S0 = null
+ $P1.'open'($S0, 'w')
+ setstderr $P1
+
+ $P2 = new ['String']
+ $P2 = "This is a test\n"
+ printerr 10
+ printerr "\n"
+ printerr 1.0
+ printerr "\n"
+ printerr "foo"
+ printerr "\n"
+ printerr $P2
+
+ # restore stderr
+ setstderr $P0
+
+ $S0 = $P1.'readall'()
+ is($S0, <<'OUTPUT', 'printerr opcode')
+10
+1
+foo
+This is a test
+OUTPUT
+.end
+
+.sub 'stat_tests'
+ .local pmc pio
+ .local int len
+ .const string description = 'stat failed'
+ .include "stat.pasm"
+ push_eh eh
+ len = stat 'no_such_file', .STAT_FILESIZE
+ ok(0, description)
+ goto ret
+ eh:
+ ok(1, description)
+ ret:
+ pop_eh
+ .return ()
+.end
+
.namespace ["Testing"]
.sub open :method
Modified: branches/gsoc_nfg/t/native_pbc/annotations.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/gsoc_nfg/t/native_pbc/integer.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/gsoc_nfg/t/native_pbc/integer_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/gsoc_nfg/t/native_pbc/number.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/gsoc_nfg/t/native_pbc/number_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/gsoc_nfg/t/native_pbc/string.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/gsoc_nfg/t/native_pbc/string_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/gsoc_nfg/t/op/annotate-old.t
==============================================================================
--- branches/gsoc_nfg/t/op/annotate-old.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/op/annotate-old.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -1,5 +1,5 @@
#!perl
-# Copyright (C) 2009, Parrot Foundation.
+# Copyright (C) 2009-2010, Parrot Foundation.
# $Id$
use strict;
@@ -23,10 +23,6 @@
=cut
-TODO: {
- local $TODO = q|fails in fast runcore - TT #1135|
- if ($ENV{TEST_PROG_ARGS} || '') =~ /--runcore=fast/;
-
pir_error_output_like( <<CODE, <<OUTPUT, 'unhandled exception from loaded function');
.sub main :main
# Not using test more, just a quick way to pick a function
@@ -40,7 +36,6 @@
/\(foobar:42\)/
OUTPUT
-}
# Local Variables:
# mode: cperl
Modified: branches/gsoc_nfg/t/op/calling.t
==============================================================================
--- branches/gsoc_nfg/t/op/calling.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/op/calling.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -1852,9 +1852,9 @@
pasm_output_is( <<'CODE', <<'OUTPUT', "named - 5 slurpy array -> named" );
.pcc_sub main:
set_args "0, 0, 0, 0x200, 0, 0x200, 0", 10, 20, 30, 'a', 40, 'b', 50
- get_results ""
find_name P1, "foo"
invokecc P1
+ get_results ""
print "ok\n"
end
.pcc_sub foo:
Copied: branches/gsoc_nfg/t/pir/timer_exit.t (from r47572, trunk/t/pir/timer_exit.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_nfg/t/pir/timer_exit.t Sat Jun 12 22:22:10 2010 (r47578, copy of r47572, 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:
Copied: branches/gsoc_nfg/t/pmc/bytebuffer.t (from r47572, trunk/t/pmc/bytebuffer.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_nfg/t/pmc/bytebuffer.t Sat Jun 12 22:22:10 2010 (r47578, copy of r47572, trunk/t/pmc/bytebuffer.t)
@@ -0,0 +1,307 @@
+#!./parrot
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+t/pmc/bytebuffer.t - ByteBuffer PMC
+
+=head1 SYNOPSIS
+
+ % prove t/pmc/bytebuffer.t
+
+=head1 DESCRIPTION
+
+Tests C<ByteBuffer> PMC..
+
+=cut
+
+.include 'iglobals.pasm'
+.include 'iterator.pasm'
+
+.sub 'main' :main
+ .include 'test_more.pir'
+ plan(24)
+
+ test_init()
+ test_set_string()
+ test_set_byte()
+ test_get_string()
+ test_alloc()
+ test_iterate()
+ test_invalid()
+.end
+
+################################################################
+# Helper subs
+
+.sub hasicu
+ $P0 = getinterp
+ $P1 = $P0[.IGLOBALS_CONFIG_HASH]
+ $I0 = $P1['has_icu']
+ .return($I0)
+.end
+
+.sub isbigendian
+ $P0 = getinterp
+ $P1 = $P0[.IGLOBALS_CONFIG_HASH]
+ $I0 = $P1['bigendian']
+ .return($I0)
+.end
+
+################################################################
+
+.sub test_init
+ .local pmc bb
+ .local int n
+ bb = new ['ByteBuffer']
+ n = elements bb
+ is(n, 0, "size of a new buffer is 0")
+
+ bb = new ['ByteBuffer'], 42
+ n = elements bb
+ is(n, 42, "size of a new buffer with initial size is correct")
+
+.end
+
+.sub test_set_string
+ .local pmc bb
+ .local string s
+ .local int n, c
+ bb = new ['ByteBuffer']
+ s = 'Hi'
+ bb = s
+
+ # Exercise mark vtable
+ sweep 1
+
+ n = elements bb
+ is(n, 2, "size is the same as the source string bytelength")
+ n = bb[0]
+ c = ord 'H'
+ is(n, c, "first byte is the same as the source string")
+ n = bb[1]
+ c = ord 'i'
+ is(n, c, "second byte is the same as the source string")
+ n = bb[2]
+ is(n, 0, "byte out of size is 0")
+ n = bb[-1]
+ is(n, 0, "byte at negative index is 0")
+.end
+
+.sub test_set_byte
+ .local pmc bb
+ .local int n
+ bb = new ['ByteBuffer']
+ bb[255] = 42
+ n = elements bb
+ is(n, 256, "setting a byte resize empty buffer")
+
+ .local string s
+ s = 'Hi'
+ bb = s
+ bb[2] = 42
+ n = elements bb
+ is(n, 3, "setting a byte resize buffer initialized from string")
+
+ bb = new ['ByteBuffer'], 42
+ bb[41] = 9
+ n = elements bb
+ is(n, 42, "setting a byte within range does not resize")
+ bb[42] = 7
+ n = elements bb
+ is(n, 43, "setting a byte resize buffer with initial size")
+ n = bb[41]
+ is(n, 9, "resized buffer preserve old value")
+
+ push_eh catch
+ bb[-1] = 0
+ ok(0, "setting a byte with negative index should throw")
+ goto end
+catch:
+ pop_eh
+ ok(1, "setting a byte with negative index throws")
+end:
+.end
+
+.sub test_get_string
+ .local pmc bb
+ .local string s
+ .local int n
+ .local int big
+
+ bb = new ['ByteBuffer']
+ bb = binary:"abcd"
+ s = bb.'get_string'('ascii', 'fixed_8')
+ n = length s
+ is(n, 4, "getting ascii from buffer gives correct length")
+ is(s, "abcd", "getting ascii from buffer gives correct content")
+
+ $I0 = hasicu()
+ unless $I0 goto skip_it
+
+ bb = new ['ByteBuffer']
+
+ # Upper case n tilde: codepoint 0xD1, utf8 encoding 0xC3, 0x91
+ #bb = utf16:unicode:"\x{D1}"
+ # Can't do that, or the program can't be compiled without ICU.
+ # Fill the buffer with bytes instead.
+
+ # Get endianess to set the bytes in the appropiate order.
+ # *** XXX *** Need report from big endian platforms.
+ big = isbigendian()
+ if big goto isbig
+ bb[0] = 0xD1
+ bb[1] = 0x00
+ goto doit
+isbig:
+ bb[0] = 0x00
+ bb[1] = 0xD1
+doit:
+ s = bb.'get_string'('unicode', 'utf16')
+ n = length s
+ is(n, 1, "getting utf16 from buffer gives correct length")
+ n = ord s
+ is(n, 0xD1, "getting utf16 from buffer gives correct codepoint")
+ bb = new ['ByteBuffer']
+ bb[0] = 0xC3
+ bb[1] = 0x91
+ s = bb.'get_string_as'(utf8:unicode:"")
+ n = length s
+ is(n, 1, "getting utf8 from buffer gives correct length")
+ n = ord s
+ is(n, 0xD1, "getting utf8 from buffer gives correct codepoint")
+ goto end
+skip_it:
+ skip(4, "this test needs ICU")
+end:
+.end
+
+.sub test_alloc
+ # Exercise buffer reallocation building a utf16 string with the
+ # codepoints 32-8192
+ .local pmc bb
+ .local int i, big, pos, b0, b1, c
+
+ $I0 = hasicu()
+ unless $I0 goto skip_it
+
+ # Get endianess to set the bytes in the appropiate order.
+ # *** XXX *** Need report from big endian platforms.
+ big = isbigendian()
+
+ bb = new ['ByteBuffer']
+ pos = 0
+ i = 32
+loopset:
+ b0 = div i, 256
+ b1 = mod i, 256
+ if big goto setbig
+ bb[pos] = b1
+ inc pos
+ bb[pos] = b0
+ inc pos
+ goto setdone
+setbig:
+ bb[pos] = b0
+ inc pos
+ bb[pos] = b1
+ inc pos
+setdone:
+ inc i
+ if i < 8192 goto loopset
+
+ .local string s
+ s = bb.'get_string'('unicode', 'utf16')
+
+ # Check string size
+ i = length s
+ if i != 8160 goto failed
+
+ # Check string content
+ i = 32
+ pos = 0
+loopcheck:
+ c = ord s, pos
+ if c != i goto failed
+ inc pos
+ inc i
+ if i < 8192 goto loopcheck
+ ok(1, "reallocation")
+ goto end
+failed:
+ say i
+ ok(0, "reallocation")
+ goto end
+skip_it:
+ skip(1, "this test needs ICU")
+end:
+.end
+
+.sub test_iterate
+ .local pmc bb, it, arr
+ .local string s
+ s = 'abcd'
+ bb = new ['ByteBuffer']
+ bb = s
+ it = iter bb
+ it = .ITERATE_FROM_START
+ arr = new ['ResizableStringArray']
+loop:
+ unless it goto donearray
+ $I0 = shift it
+ $S0 = chr $I0
+ push arr, $S0
+ goto loop
+donearray:
+ .local string r
+ r = join '', arr
+ is(r, s, 'iterate buffer content')
+.end
+
+.sub test_invalid
+ .local pmc bb, ex
+ .local string s
+ bb = new ['ByteBuffer']
+ bb = 'something'
+ push_eh catch_charset
+ s = bb.'get_string'('***INVALID cHARsET%%%%', 'fixed_8')
+ pop_eh
+ ok(0, "get_string with invalid charset should throw")
+ goto check_encoding
+catch_charset:
+ .get_results(ex)
+ finalize ex
+ pop_eh
+ ok(1, "get_string with invalid charset throws")
+check_encoding:
+ push_eh catch_encoding
+ s = bb.'get_string'('ascii', '???INVALID eNCODING===')
+ pop_eh
+ ok(0, "get_string with invalid encoding should throw")
+ goto check_content
+catch_encoding:
+ .get_results(ex)
+ finalize ex
+ pop_eh
+ ok(1, "get_string with invalid encoding throws")
+check_content:
+ bb[0] = 128 # Out of ascii range
+ push_eh catch_content
+ s = bb.'get_string'('ascii', 'fixed_8')
+ pop_eh
+ ok(0, "get_string with invalid content should throw")
+ goto end
+catch_content:
+ .get_results(ex)
+ finalize ex
+ pop_eh
+ ok(1, "get_string with invalid content throws")
+end:
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/gsoc_nfg/t/pmc/eval.t
==============================================================================
--- branches/gsoc_nfg/t/pmc/eval.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/pmc/eval.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -66,8 +66,8 @@
concat S5, "returncc\n"
compreg P1, "PASM"
set_args "0", S5
- get_results "0", P6
invokecc P1
+ get_results "0", P6
get_global P2, "_foo"
invokecc P2
print "back\n"
Modified: branches/gsoc_nfg/t/pmc/filehandle.t
==============================================================================
--- branches/gsoc_nfg/t/pmc/filehandle.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/pmc/filehandle.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -644,7 +644,7 @@
expect 1 exit status: 1
OUTPUT
-pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "timely destruction", todo => 'TT #1659' );
+pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "timely destruction" );
.const string temp_file = '%s'
.sub main :main
interpinfo $I0, 2 # GC mark runs
Modified: branches/gsoc_nfg/t/pmc/fixedintegerarray.t
==============================================================================
--- branches/gsoc_nfg/t/pmc/fixedintegerarray.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/pmc/fixedintegerarray.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -19,7 +19,7 @@
.sub 'main' :main
.include 'test_more.pir'
- plan(35)
+ plan(36)
test_set_size()
test_reset_size()
@@ -32,6 +32,7 @@
test_get_iter()
test_equality()
test_repr()
+ test_sort()
test_new_style_init()
test_invalid_init_tt1509()
.end
@@ -271,6 +272,23 @@
is($I0, 10, "New style init creates the correct # of elements")
.end
+.sub 'test_sort'
+ .local pmc a1, a2
+ a1 = new ['FixedIntegerArray'], 3
+ a1[0] = 7
+ a1[1] = 1
+ a1[2] = 5
+
+ a2 = new ['FixedIntegerArray'], 3
+ a2[0] = 1
+ a2[1] = 5
+ a2[2] = 7
+
+ a1.'sort'()
+ $I0 = iseq a1, a2
+ is($I0, 1, 'default sort')
+.end
+
.sub test_invalid_init_tt1509
throws_substring(<<'CODE', 'FixedIntegerArray: Cannot set array size to a negative number (-10)', 'New style init does not dump core for negative array lengths')
.sub main
@@ -285,6 +303,8 @@
CODE
.end
+
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: branches/gsoc_nfg/t/pmc/float.t
==============================================================================
--- branches/gsoc_nfg/t/pmc/float.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/pmc/float.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -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'
Modified: branches/gsoc_nfg/t/pmc/io.t
==============================================================================
--- branches/gsoc_nfg/t/pmc/io.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/pmc/io.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -7,8 +7,7 @@
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 40;
-use Parrot::Test::Util 'create_tempfile';
+use Parrot::Test tests => 32;
use Parrot::Test::Util 'create_tempfile';
=head1 NAME
@@ -41,17 +40,18 @@
my (undef, $temp_file) = create_tempfile( UNLINK => 1 );
-pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "timely destruction (ops)");
-.loadlib 'io_ops'
+pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "timely destruction" );
.const string temp_file = '%s'
.sub main :main
interpinfo $I0, 2 # GC mark runs
- $P0 = open temp_file, 'w'
- needs_destroy $P0
+ $P0 = new ['FileHandle']
+ $P0.'open'(temp_file, 'w')
+ needs_destroy $P0
print $P0, "a line\n"
null $P0 # kill it
sweep 0 # a lazy GC has to close the PIO
- $P0 = open temp_file, 'r'
+ $P0 = new ['FileHandle']
+ $P0.'open'(temp_file, 'r')
$S0 = $P0.'read'(20)
print $S0
.end
@@ -59,42 +59,6 @@
a line
OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', "read on invalid fh should throw exception (ops)" );
-.loadlib 'io_ops'
-.sub main :main
- new $P0, ['FileHandle']
-
- push_eh _readline_handler
- $S0 = readline $P0
- print "not "
-
-_readline_handler:
- print "ok 1\n"
- pop_eh
-
- push_eh _read_handler
- $S0 = read $P0, 1
- print "not "
-
-_read_handler:
- print "ok 2\n"
- pop_eh
-
- push_eh _print_handler
- print $P0, "kill me now\n"
- print "not "
-
-_print_handler:
- print "ok 3\n"
- pop_eh
-
-.end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
pir_output_is( <<'CODE', <<'OUTPUT', "read on invalid fh should throw exception" );
.sub main :main
new $P0, ['FileHandle']
@@ -149,16 +113,21 @@
print $FOO "2\n1\n";
close $FOO;
-pasm_output_is( <<"CODE", <<'OUTPUT', "open and readline" );
-.loadlib 'io_ops'
- open P0, "$temp_file"
- set S0, ""
- set S1, ""
- readline S0, P0
- readline S1, P0
- print S1
- print S0
- end
+pir_output_is( sprintf( <<'CODE', $temp_file ), <<'OUTPUT', "open and readline" );
+.const string temp_file = '%s'
+.sub 'main' :main
+ $P0 = new ['FileHandle']
+ $P0.'open'(temp_file)
+
+ $S0 = ''
+ $S1 = ''
+
+ $S0 = $P0.'readline'()
+ $S1 = $P0.'readline'()
+
+ print $S1
+ print $S0
+.end
CODE
1
2
@@ -168,16 +137,21 @@
print $FOO "12\n34";
close $FOO;
-pasm_output_is( <<"CODE", <<'OUTPUT', "open and readline, no final newline" );
-.loadlib 'io_ops'
- open P0, "$temp_file"
- set S0, ""
- set S1, ""
- readline S0, P0
- readline S1, P0
- print S1
- print S0
- end
+pir_output_is( sprintf( <<'CODE', $temp_file ), <<'OUTPUT', "open and readline, no final newline" );
+.const string temp_file = '%s'
+.sub 'main' :main
+ $P0 = new ['FileHandle']
+ $P0.'open'(temp_file)
+
+ $S0 = ''
+ $S1 = ''
+
+ $S0 = $P0.'readline'()
+ $S1 = $P0.'readline'()
+
+ print $S1
+ print $S0
+.end
CODE
3412
OUTPUT
@@ -185,27 +159,30 @@
($FOO, $temp_file) = create_tempfile( UNLINK => 1 );
close $FOO;
-pasm_output_is( <<"CODE", <<'OUTPUT', "open & print" );
-.loadlib 'io_ops'
- set I0, -12
- set N0, 2.2
- set S0, "Foo"
- new P0, ['String']
- set P0, "Bar\\n"
-
- open P1, "$temp_file", "w"
- print P1, I0
- print P1, N0
- print P1, S0
- print P1, P0
- close P1
-
- open P2, "$temp_file"
- readline S1, P2
- close P2
+pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "open & print" );
+.const string temp_file = '%s'
+.sub 'main' :main
+ $I0 = -12
+ $N0 = 2.2
+ $S0 = "Foo"
+ $P0 = new ['String']
+ $P0 = "Bar\n"
+
+ $P1 = new ['FileHandle']
+ $P1.'open'(temp_file, 'w')
+ $P1.'print'($I0)
+ $P1.'print'($N0)
+ $P1.'print'($S0)
+ $P1.'print'($P0)
+ $P1.'close'()
+
+ $P2 = new ['FileHandle']
+ $P2.'open'(temp_file)
+ $S1 = $P2.'readline'()
+ $P2.'close'()
- print S1
- end
+ print $S1
+.end
CODE
-122.2FooBar
OUTPUT
@@ -214,43 +191,47 @@
close $FOO;
# write to file opened for reading
-pasm_output_is( <<"CODE", <<'OUTPUT', "3-arg open" );
-.loadlib 'io_ops'
- open P1, "$temp_file", 'w'
- print P1, "Foobar\\n"
- close P1
-
- push_eh _print_to_read_only
-
- open P2, "$temp_file", 'r'
- print P2, "baz\\n"
- say "skipped"
-
-_print_to_read_only:
- say "caught writing to file opened for reading"
- pop_eh
-
- close P2
-
- open P3, "$temp_file", 'r'
- readline S1, P3
- close P3
- print S1
+pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "3-arg open" );
+.const string temp_file = '%s'
+.sub 'main' :main
+ $P1 = new ['FileHandle']
+ $P1.'open'(temp_file, 'w')
+ $P1.'print'("Foobar\n")
+ $P1.'close'()
+ push_eh _print_to_read_only
- end
+ $P2 = new ['FileHandle']
+ $P2.'open'(temp_file, 'r')
+ $P2.'print'("baz\n")
+ say "skipped"
+
+ _print_to_read_only:
+ say "caught writing to file opened for reading"
+ pop_eh
+
+ $P2.'close'()
+
+ $P3 = new ['FileHandle']
+ $P3.'open'(temp_file, 'r')
+ $S1 = $P3.'readline'()
+ $P3.'close'()
+ print $S1
+.end
CODE
caught writing to file opened for reading
Foobar
OUTPUT
-pasm_output_is( <<"CODE", <<'OUTPUT', 'open and close' );
-.loadlib 'io_ops'
- open P1, "$temp_file", "w"
- print P1, "Hello, World!\\n"
- close P1
- say "done"
- end
+pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', 'open and close' );
+.const string temp_file = '%s'
+.sub 'main' :main
+ $P1 = new ['FileHandle']
+ $P1.'open'(temp_file, "w")
+ $P1.'print'("Hello, World!\n")
+ $P1.'close'()
+ say "done"
+.end
CODE
done
OUTPUT
@@ -259,12 +240,14 @@
Hello, World!
OUTPUT
-pasm_output_is( <<"CODE", '', 'append' );
-.loadlib 'io_ops'
- open P1, "$temp_file", 'wa'
- print P1, "Parrot flies\\n"
- close P1
- end
+pir_output_is( sprintf(<<'CODE', $temp_file), '', 'append' );
+.const string temp_file = '%s'
+.sub 'main' :main
+ $P1 = new ['FileHandle']
+ $P1.'open'(temp_file, 'wa')
+ $P1.'print'("Parrot flies\n")
+ $P1.'close'()
+.end
CODE
file_content_is( $temp_file, <<'OUTPUT', 'append file contents' );
@@ -272,12 +255,14 @@
Parrot flies
OUTPUT
-pasm_output_is( <<"CODE", '', 'write to file' );
-.loadlib 'io_ops'
- open P1, "$temp_file", 'w'
- print P1, "Parrot overwrites\\n"
- close P1
- end
+pir_output_is( sprintf(<<'CODE', $temp_file), '', 'write to file' );
+.const string temp_file = '%s'
+.sub 'main' :main
+ $P1 = new ['FileHandle']
+ $P1.'open'(temp_file, 'w')
+ $P1.'print'("Parrot overwrites\n")
+ $P1.'close'()
+.end
CODE
file_content_is( $temp_file, <<'OUTPUT', 'file contents' );
@@ -426,25 +411,6 @@
ok 3
OUT
-pasm_output_is( <<'CODE', <<'OUTPUT', 'printerr op' );
-.loadlib 'io_ops'
- new P0, ['String']
- set P0, "This is a test\n"
- printerr 10
- printerr "\n"
- printerr 1.0
- printerr "\n"
- printerr "foo"
- printerr "\n"
- printerr P0
- end
-CODE
-10
-1
-foo
-This is a test
-OUTPUT
-
pir_output_is( <<'CODE', <<'OUTPUT', 'puts method' );
.include 'stdio.pasm'
.sub main :main
@@ -483,35 +449,46 @@
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'callmethod puts' );
-.loadlib 'io_ops'
- getstderr P2 # the object
- set S0, "puts" # method
- set S5, "ok 1\n" # 2nd param
- set_args "0,0", P2, S5
- callmethodcc P2, S0
- set S5, "ok 2\n"
- set_args "0,0", P2, S5
- callmethodcc P2, S0
- end
+.include 'stdio.pasm'
+ getinterp P0 # invocant
+ set I0, .PIO_STDERR_FILENO # 1st argument
+ set_args "0,0", P0, I0
+ callmethodcc P0, "stdhandle"
+ get_results "0", P2 # STDERR
+
+ set S0, "puts" # method
+ set S5, "ok 1\n" # 2nd param
+ set_args "0,0", P2, S5
+ callmethodcc P2, S0
+
+ set S5, "ok 2\n"
+ set_args "0,0", P2, S5
+ callmethodcc P2, S0
+
+ end
CODE
ok 1
ok 2
OUTPUT
-pasm_output_is( <<"CODE", <<'OUTPUT', 'seek/tell' );
-.loadlib 'io_ops'
- open P0, "$temp_file", 'w'
- print P0, "Hello "
- tell I0, P0
- print P0, "World!"
- seek P0, I0, 0
- print P0, "Parrot!\\n"
- close P0
- say "ok 1"
- open P0, "$temp_file", 'r'
- read S0, P0, 65635
- print S0
- end
+pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', 'seek/tell' );
+.const string temp_file = '%s'
+.sub 'main' :main
+ $P0 = new ['FileHandle']
+
+ $P0.'open'(temp_file, 'w')
+ $P0.'print'("Hello ")
+ $I0 = $P0.'tell'()
+ $P0.'print'("World!")
+ $P0.'seek'(0, $I0)
+ $P0.'print'("Parrot!\n")
+ $P0.'close'()
+ say "ok 1"
+
+ $P0.'open'(temp_file, 'r')
+ $S0 = $P0.'read'(65635)
+ print $S0
+.end
CODE
ok 1
Hello Parrot!
@@ -529,16 +506,6 @@
/seek failed/
OUTPUT
-pasm_error_output_like( <<"CODE", <<'OUTPUT', '32bit seek: exception (ops)' );
-.loadlib 'io_ops'
- open P0, "$temp_file", 'w'
- seek P0, -1, 0
- say "error!"
- end
-CODE
-/seek failed \(32bit\)/
-OUTPUT
-
pir_error_output_like( sprintf(<<'CODE', $temp_file), <<'OUTPUT', '64bit seek: exception' );
.const string temp_file = '%s'
.sub main :main
@@ -551,16 +518,6 @@
/seek failed/
OUTPUT
-pasm_error_output_like( <<"CODE", <<'OUTPUT', '64bit seek: exception (ops)' );
-.loadlib 'io_ops'
- open P0, "$temp_file", 'w'
- seek P0, -1, -1, 0
- say "error!"
- end
-CODE
-/seek failed \(64bit\)/
-OUTPUT
-
pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "peek" );
.const string temp_file = '%s'
.sub main :main
@@ -586,27 +543,6 @@
l
OUTPUT
-pasm_output_is( <<"CODE", <<'OUTPUT', "peek (ops)" );
-.loadlib 'io_ops'
- open P0, "$temp_file", 'w'
- print P0, "a line\\n"
- close P0
- open P0, "$temp_file", 'r'
- peek S0, P0
- print S0
- peek S1, P0
- print S1
- print "\\n"
- read S2, P0, 2
- peek S3, P0
- print S3
- print "\\n"
- end
-CODE
-aa
-l
-OUTPUT
-
pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "peek on an empty file" );
.const string temp_file = '%s'
.sub main :main
@@ -626,21 +562,6 @@
ok 1
OUTPUT
-pasm_output_is( <<"CODE", <<'OUTPUT', "peek on an empty file (ops)" );
-.loadlib 'io_ops'
- open P0, "$temp_file", 'w'
- close P0
- open P0, "$temp_file", 'r'
- peek S0, P0
- eq S0, "", OK1
- print "not "
-OK1:
- say "ok 1"
- end
-CODE
-ok 1
-OUTPUT
-
pir_output_is( <<"CODE", <<'OUTPUT', "substr after reading from file" );
.sub _main
# Write something into a file
@@ -708,50 +629,33 @@
sub_2: 345
OUTPUT
-pir_error_output_like( <<'CODE', <<'OUT', 'read on null PMC throws exception');
-.loadlib 'io_ops'
-.sub main :main
- null $P1
- $S0 = read $P1, 1
- end
-.end
-CODE
-/read from null/
-OUT
-
($FOO, $temp_file) = create_tempfile( UNLINK => 1 );
print $FOO "T\xc3\xb6tsch\n";
close $FOO;
-pir_output_is( <<"CODE", <<"OUTPUT", "utf8 read enabled, read parts" );
-.loadlib 'io_ops'
+pir_output_is( sprintf(<<'CODE', $temp_file), <<"OUTPUT", "utf8 read enabled, read parts" );
+.const string temp_file = '%s'
.sub main :main
.local pmc pio
- .local int len
- .include "stat.pasm"
- .local string f
- f = '$temp_file'
- len = stat f, .STAT_FILESIZE
pio = new ['FileHandle']
- pio.'open'(f, 'r')
+ pio.'open'(temp_file, 'r')
pio.'encoding'("utf8")
- \$S0 = pio.'read'(2)
- len -= 2
- \$S1 = pio.'read'(len)
- \$S0 .= \$S1
+ $S0 = pio.'read'(2)
+ $S1 = pio.'read'(1024) # read the rest of the file (much shorter than 1K)
+ $S0 .= $S1
pio.'close'()
- \$I1 = charset \$S0
- \$S2 = charsetname \$I1
- say \$S2
-
- \$I1 = encoding \$S0
- \$S2 = encodingname \$I1
- say \$S2
-
- \$I1 = find_charset 'iso-8859-1'
- trans_charset \$S1, \$S0, \$I1
- print \$S1
+ $I1 = charset $S0
+ $S2 = charsetname $I1
+ say $S2
+
+ $I1 = encoding $S0
+ $S2 = encodingname $I1
+ say $S2
+
+ $I1 = find_charset 'iso-8859-1'
+ trans_charset $S1, $S0, $I1
+ print $S1
.end
CODE
unicode
@@ -807,21 +711,6 @@
ok
OUTPUT
-pir_error_output_like( <<'CODE', <<"OUTPUT", "stat failed" );
-.loadlib 'io_ops'
-.sub main :main
- .local pmc pio
- .local int len
- .include "stat.pasm"
- .local string f
- f = 'no_such_file'
- len = stat f, .STAT_FILESIZE
- print "never\n"
-.end
-CODE
-/stat failed:/
-OUTPUT
-
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
Modified: branches/gsoc_nfg/t/pmc/objects.t
==============================================================================
--- branches/gsoc_nfg/t/pmc/objects.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/pmc/objects.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -1603,46 +1603,46 @@
new $P5, ['String'] # set attribute values
set $P5, "i" # attribute slots have reference semantics
set_args "0,0", $P5, "i"
- get_results ""
callmethodcc $P13, "Foo54__set"
+ get_results ""
new $P5, ['String']
set $P5, "j"
set_args "0,0", $P5, "j"
- get_results ""
callmethodcc $P13,"Foo54__set"
+ get_results ""
new $P5, ['String']
set $P5, "k"
set_args "0,0", $P5, "k"
- get_results ""
callmethodcc $P13,"Bar54__set"
+ get_results ""
new $P5, ['String']
set $P5, "l"
set_args "0,0", $P5, "l"
- get_results ""
callmethodcc $P13,"Bar54__set"
+ get_results ""
# now retrieve attributes
set_args "0", "i"
- get_results "0", $P5
callmethodcc $P13,"Foo54__get"
+ get_results "0", $P5
is( $P5, "i", 'got attrib i from Bar54->Foo54__get' )
set_args "0", "j"
- get_results "0", $P5
callmethodcc $P13,"Foo54__get"
+ get_results "0", $P5
is( $P5, "j", 'got attrib j from Bar54->Foo54__get' )
set_args "0", "k"
- get_results "0", $P5
callmethodcc $P13,"Bar54__get"
+ get_results "0", $P5
is( $P5, "k", 'got attrib k from Bar54->Bar54__get' )
set_args "0", "l"
- get_results "0", $P5
callmethodcc $P13,"Bar54__get"
+ get_results "0", $P5
is( $P5, "l", 'got attrib l from Bar54->Bar54__get' )
.end
Modified: branches/gsoc_nfg/t/pmc/packfile.t
==============================================================================
--- branches/gsoc_nfg/t/pmc/packfile.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/pmc/packfile.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -15,6 +15,8 @@
Tests the Packfile PMC.
+If you see this tests failing after bumping PBC_COMPAT rerun tools/dev/mk_packfile_pbc.
+
=cut
.include 't/pmc/testlib/packfile_common.pir'
@@ -295,27 +297,30 @@
# Packfile.pack.
# Check that unpack-pack produce correct result.
.sub 'test_pack'
- .local string filename, first
+ .local string filename, orig
push_eh load_error
$S0 = '_filename'()
$P0 = new ['FileHandle']
$P0.'open'($S0, 'r')
- first = $P0.'readall'()
+ orig = $P0.'readall'()
.local pmc packfile
packfile = new 'Packfile'
- packfile = first
+ packfile = orig
pop_eh
- # Packed file should be exactly the same as loaded
- .local string second
+ # Loaded packfile can be from different platform/config,
+ # packing and unpacking again to avoid that differences.
+ .local string first, second
# Pack
- second = packfile
+ first = packfile
+ .local pmc packfilesecond
+ packfilesecond = new 'Packfile'
+ packfilesecond = first
+ second = packfilesecond
- $I0 = cmp first, second
- $I0 = not $I0
- todo($I0, 'pack produced same result twice: TT #1614')
+ is(first, second, 'pack produced same result twice: TT #1614')
.return()
load_error:
.get_results($P0)
@@ -325,6 +330,7 @@
.end
# Test pack/set_string unpack/get_string equivalency
+
.sub 'test_synonyms'
.local pmc pf
push_eh load_error
Modified: branches/gsoc_nfg/t/pmc/resizableintegerarray.t
==============================================================================
--- branches/gsoc_nfg/t/pmc/resizableintegerarray.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/pmc/resizableintegerarray.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -43,7 +43,7 @@
.sub main :main
.include 'test_more.pir'
- plan(46)
+ plan(47)
test_does_interfaces()
@@ -74,6 +74,7 @@
test_cant_shift_empty()
test_iterator()
test_clone()
+ test_freeze()
.end
.sub test_does_interfaces
@@ -596,6 +597,17 @@
is( $I0, 1, 'cloned is equal to original')
.end
+.sub test_freeze
+ .local pmc ria, th
+ .local string s
+ ria = new ['ResizableIntegerArray']
+ push ria, 1
+ push ria, 0x1FFFF
+ s = freeze ria
+ th = thaw s
+ is( ria, th, 'freeze/thaw copy is equal to original' )
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: branches/gsoc_nfg/t/pmc/stringbuilder.t
==============================================================================
--- branches/gsoc_nfg/t/pmc/stringbuilder.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/pmc/stringbuilder.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -21,12 +21,14 @@
.include 'test_more.pir'
test_create() # 2 tests
- test_push_string() # 9 tests
+ test_push_string()
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()
emit_with_pos_args()
emit_with_percent_args()
@@ -104,6 +106,11 @@
$I0 = sb
is( $I0, 16384, "... and capacity increased" )
+ null $S0
+ push sb, $S0
+ $I0 = sb
+ is( $I0, 16384, "push a null string does nothing" )
+
.end
.sub 'test_push_pmc'
@@ -152,7 +159,6 @@
$S0 = sb
is( $S0, "foobarbaz", "StringBuilder handles concat properly")
-
.end
.sub 'test_set_string_native'
@@ -170,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'
@@ -195,6 +209,24 @@
.end
+.sub 'test_set_pmc'
+ .local pmc sb, i
+ sb = new ["StringBuilder"]
+ i = new ["Integer"], 17
+ assign sb, i
+ $S0 = sb
+ $I0 = iseq $S0, '17'
+ is( $I0, 1, "set_pmc gives the pmc string value")
+.end
+
+.sub test_substr
+ .local pmc sb
+ sb = new ["StringBuilder"]
+ sb = 'foobar'
+ $S0 = substr sb, 2, 3
+ is( $S0, 'oba', "substr result is correct")
+.end
+
.sub emit_with_pos_args
.local pmc code
code = new ["StringBuilder"]
Modified: branches/gsoc_nfg/t/src/embed.t
==============================================================================
--- branches/gsoc_nfg/t/src/embed.t Sat Jun 12 22:11:00 2010 (r47577)
+++ branches/gsoc_nfg/t/src/embed.t Sat Jun 12 22:22:10 2010 (r47578)
@@ -8,7 +8,7 @@
use Test::More;
use Parrot::Test;
-plan tests => 9;
+plan tests => 10;
=head1 NAME
@@ -62,21 +62,30 @@
Done
OUTPUT
-c_output_is(linedirective(__LINE__) . <<'CODE', <<'OUTPUT', 'Parrot_compile_string populates the error string when an opcode is given improper arguments');
-
+my $common = linedirective(__LINE__) . <<'CODE';
#include <stdio.h>
#include <stdlib.h>
+#include <string.h>
#include "parrot/embed.h"
#include "parrot/extend.h"
-void fail(const char *msg);
+static void fail(const char *msg);
+static Parrot_String createstring(Parrot_Interp interp, const char * value);
-void fail(const char *msg)
+static void fail(const char *msg)
{
fprintf(stderr, "failed: %s\n", msg);
exit(EXIT_FAILURE);
}
+static Parrot_String createstring(Parrot_Interp interp, const char * value)
+{
+ return Parrot_new_string(interp, value, strlen(value), (const char*)NULL, 0);
+}
+
+CODE
+
+c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', 'Parrot_compile_string populates the error string when an opcode is given improper arguments');
int main(int argc, const char **argv)
{
@@ -88,7 +97,7 @@
interp = Parrot_new(NULL);
if (! interp)
fail("Cannot create parrot interpreter");
- lang = Parrot_new_string(interp, "PIR", 3, (const char*)NULL, 0);
+ lang = createstring(interp, "PIR");
func_pmc = Parrot_compile_string(interp, lang, ".sub foo\n copy\n.end", &err);
Parrot_printf(interp, "%Ss\n", err);
@@ -99,21 +108,7 @@
The opcode 'copy' (copy<0>) was not found. Check the type and number of the arguments
OUTPUT
-c_output_is(linedirective(__LINE__) . <<'CODE', <<'OUTPUT', 'Parrot_compile_string populates the error string when given invalid language string');
-
-#include <stdio.h>
-#include <stdlib.h>
-#include "parrot/embed.h"
-#include "parrot/extend.h"
-
-void fail(const char *msg);
-
-void fail(const char *msg)
-{
- fprintf(stderr, "failed: %s\n", msg);
- exit(EXIT_FAILURE);
-}
-
+c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', 'Parrot_compile_string populates the error string when given invalid language string');
int main(int argc, const char **argv)
{
@@ -125,7 +120,7 @@
interp = Parrot_new(NULL);
if (! interp)
fail("Cannot create parrot interpreter");
- lang = Parrot_new_string(interp, "Foo", 3, (const char*)NULL, 0);
+ lang = createstring(interp, "Foo");
func_pmc = Parrot_compile_string(interp, lang, "This doesn't matter", &err);
Parrot_printf(interp, "%Ss\n", err);
@@ -137,21 +132,7 @@
OUTPUT
-c_output_is(linedirective(__LINE__) . <<'CODE', <<'OUTPUT', 'Parrot_compile_string populates the error string when there is an IMCC syntax error', 'todo' => 'TT #1610 : does not properly catch IMCC errors');
-
-#include <stdio.h>
-#include <stdlib.h>
-#include "parrot/embed.h"
-#include "parrot/extend.h"
-
-void fail(const char *msg);
-
-void fail(const char *msg)
-{
- fprintf(stderr, "failed: %s\n", msg);
- exit(EXIT_FAILURE);
-}
-
+c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', 'Parrot_compile_string populates the error string when there is an IMCC syntax error', 'todo' => 'TT #1610 : does not properly catch IMCC errors');
int main(int argc, const char **argv)
{
@@ -163,7 +144,7 @@
interp = Parrot_new(NULL);
if (! interp)
fail("Cannot create parrot interpreter");
- lang = Parrot_new_string(interp, "PIR", 3, (const char*)NULL, 0);
+ lang = createstring(interp, "PIR");
func_pmc = Parrot_compile_string(interp, lang, "The sleeper must awake", &err);
Parrot_printf(interp,"Caught exception\n");
@@ -177,21 +158,7 @@
OUTPUT
-c_output_is(linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "Hello world from main" );
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#include "parrot/embed.h"
-#include "parrot/extend.h"
-
-void fail(const char *msg);
-
-void fail(const char *msg)
-{
- fprintf(stderr, "failed: %s\n", msg);
- exit(EXIT_FAILURE);
-}
+c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "Hello world from main" );
int main(void)
{
@@ -207,7 +174,7 @@
Parrot_printf(interp, "Hello, parrot\n");
/* Compile and execute a pir sub */
- compiler = Parrot_new_string(interp, "PIR", 3, (const char *)NULL, 0);
+ compiler = createstring(interp, "PIR");
code = Parrot_compile_string(interp, compiler,
".sub main :main\n"
" say 'Hello, pir'\n"
@@ -226,21 +193,7 @@
Hello, pir
OUTPUT
-c_output_is(linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "Hello world from a sub" );
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#include "parrot/embed.h"
-#include "parrot/extend.h"
-
-void fail(const char *msg);
-
-void fail(const char *msg)
-{
- fprintf(stderr, "failed: %s\n", msg);
- exit(EXIT_FAILURE);
-}
+c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "Hello world from a sub" );
int main(void)
{
@@ -260,7 +213,7 @@
fail("Cannot create parrot interpreter");
/* Compile pir code */
- compiler = Parrot_new_string(interp, "PIR", 3, (const char *)NULL, 0);
+ compiler = createstring(interp, "PIR");
code = Parrot_compile_string(interp, compiler,
".sub main :main\n"
" say 'Must not be seen!'\n"
@@ -277,10 +230,10 @@
/* Get parrot namespace */
rootns = Parrot_get_root_namespace(interp);
- parrotname = Parrot_new_string(interp, "parrot", 6, (const char *)NULL, 0);
+ parrotname = createstring(interp, "parrot");
parrotns = Parrot_PMC_get_pmc_keyed_str(interp, rootns, parrotname);
/* Get the sub */
- subname = Parrot_new_string(interp, "hello", 5, (const char *)NULL, 0);
+ subname = createstring(interp, "hello");
sub = Parrot_PMC_get_pmc_keyed_str(interp, parrotns, subname);
/* Execute it */
Parrot_ext_call(interp, sub, "->");
@@ -292,22 +245,68 @@
Hello, sub
OUTPUT
-c_output_is(linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "External sub" );
+c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "calling a sub with argument and return" );
-#include <stdio.h>
-#include <stdlib.h>
+int main(void)
+{
+ Parrot_Interp interp;
+ Parrot_String compiler;
+ Parrot_String errstr;
+ Parrot_PMC code;
+ Parrot_PMC rootns;
+ Parrot_String parrotname;
+ Parrot_PMC parrotns;
+ Parrot_String subname;
+ Parrot_PMC sub;
+ Parrot_String msg;
+ Parrot_String retstr;
-#include "parrot/embed.h"
-#include "parrot/extend.h"
+ /* Create the interpreter */
+ interp = Parrot_new(NULL);
+ if (! interp)
+ fail("Cannot create parrot interpreter");
-void fail(const char *msg);
-void hello(Parrot_Interp interp);
+ /* Compile pir code */
+ compiler = createstring(interp, "PIR");
+ code = Parrot_compile_string(interp, compiler,
+".sub main :main\n"
+" say 'Must not be seen!'\n"
+"\n"
+".end\n"
+"\n"
+".sub hello\n"
+" .param string s\n"
+" print s\n"
+" .return('world!')\n"
+"\n"
+".end\n"
+"\n",
+ &errstr
+ );
-void fail(const char *msg)
-{
- fprintf(stderr, "failed: %s\n", msg);
- exit(EXIT_FAILURE);
+ /* Get parrot namespace */
+ rootns = Parrot_get_root_namespace(interp);
+ parrotname = createstring(interp, "parrot");
+ parrotns = Parrot_PMC_get_pmc_keyed_str(interp, rootns, parrotname);
+ /* Get the sub */
+ subname = createstring(interp, "hello");
+ sub = Parrot_PMC_get_pmc_keyed_str(interp, parrotns, subname);
+
+ /* Execute it */
+ msg = createstring(interp, "Hello, ");
+ Parrot_ext_call(interp, sub, "S->S", msg, &retstr);
+ Parrot_printf(interp, "%Ss\n", retstr);
+
+ Parrot_destroy(interp);
+ return 0;
}
+CODE
+Hello, world!
+OUTPUT
+
+c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "External sub" );
+
+void hello(Parrot_Interp interp);
void hello(Parrot_Interp interp)
{
@@ -328,7 +327,7 @@
fail("Cannot create parrot interpreter");
/* Compile pir */
- compiler = Parrot_new_string(interp, "PIR", 3, (const char *)NULL, 0);
+ compiler = createstring(interp, "PIR");
code = Parrot_compile_string(interp, compiler,
".sub externcall\n"
" .param pmc ec\n"
@@ -348,23 +347,10 @@
Hello from C
OUTPUT
-c_output_is(linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "Insert external sub in namespace" );
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#include "parrot/embed.h"
-#include "parrot/extend.h"
+c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "Insert external sub in namespace" );
-void fail(const char *msg);
void hello(Parrot_Interp interp);
-void fail(const char *msg)
-{
- fprintf(stderr, "failed: %s\n", msg);
- exit(EXIT_FAILURE);
-}
-
void hello(Parrot_Interp interp)
{
Parrot_printf(interp, "Hello from C\n");
@@ -389,7 +375,7 @@
fail("Cannot create parrot interpreter");
/* Compile pir */
- compiler = Parrot_new_string(interp, "PIR", 3, (const char *)NULL, 0);
+ compiler = createstring(interp, "PIR");
code = Parrot_compile_string(interp, compiler,
".sub externcall\n"
" hello()\n"
@@ -401,10 +387,10 @@
/* Create extern sub and insert in parrot namespace */
rootns = Parrot_get_root_namespace(interp);
- parrotname = Parrot_new_string(interp, "parrot", 6, (const char *)NULL, 0);
+ parrotname = createstring(interp, "parrot");
parrotns = Parrot_PMC_get_pmc_keyed_str(interp, rootns, parrotname);
hellosub = Parrot_sub_new_from_c_func(interp, (void (*)())& hello, "vJ");
- helloname = Parrot_new_string(interp, "hello", 5, (const char *)NULL, 0);
+ helloname = createstring(interp, "hello");
Parrot_PMC_set_pmc_keyed_str(interp, parrotns, helloname, hellosub);
/* Call it */
More information about the parrot-commits
mailing list