# New Ticket Created by Sam Vilain
# Please include the string: [perl #41818]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=41818 >
Content-Type: text/plain
Content-Disposition: inline
Content-Transfer-Encoding: binary
MIME-Version: 1.0
X-Mailer: MIME-tools 5.419 (Entity 5.419)
This is a combined patch submission which I made using a script that
munged output from `git-format-patch HEAD~4`.
The patches are:
- [t/op] pin/unpin op test by smash
t/op/string-mem.t | 55
+++++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 55 insertions(+), 0 deletions(-)
create mode 100644 t/op/string-mem.t
- Convert t/ops/string-mem.t to use Test/More.pir
t/op/string-mem.t | 76
++++++++++++++++++++++++++++++++++++++++++++++------
1 files changed, 67 insertions(+), 9 deletions(-)
- Segment t/op/string-mem.t test
t/op/string-mem.t | 15 ++++++++++++---
1 files changed, 12 insertions(+), 3 deletions(-)
- t/op/string-mem.t: add test for a couple of stringinfo calls
t/op/string-mem.t | 37 ++++++++++++++++++++++++++++++++++++-
1 files changed, 36 insertions(+), 1 deletions(-)
Content-Type: text/x-patch; name="t-op-pin-unpin-op-test-by-smash.patch"
Content-Disposition: inline; filename="t-op-pin-unpin-op-test-by-smash.patch"
Content-Transfer-Encoding: binary
Content-Description: [PATCH] [t/op] pin/unpin op test by smash
MIME-Version: 1.0
X-Mailer: MIME-tools 5.419 (Entity 5.419)
[t/op] pin/unpin op test by smash
---
t/op/string-mem.t | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 55 insertions(+), 0 deletions(-)
create mode 100644 t/op/string-mem.t
diff --git a/t/op/string-mem.t b/t/op/string-mem.t
new file mode 100644
index 0000000..e5c38ed
--- /dev/null
+++ b/t/op/string-mem.t
@@ -0,0 +1,55 @@
+.sub main :main
+ .local int init, before, after
+ .include 'stringinfo.pasm'
+ .include 'interpinfo.pasm'
+
+ $S0 = 'life'
+ $S1 = 'life'
+ $S2 = 'life'
+ $S3 = 'life'
+ $S4 = 'life'
+ $S5 = 'life'
+ $S6 = 'love'
+ $S7 = 'life'
+ $S8 = 'life'
+ $S9 = 'life'
+
+ pin $S6
+ null $S0
+ null $S1
+ null $S2
+ null $S3
+ null $S4
+ null $S5
+ null $S7
+ null $S8
+ null $S9
+
+ init = stringinfo $S6, .STRINGINFO_STRSTART
+
+ $I0 = interpinfo .INTERPINFO_COLLECT_RUNS
+ loop1:
+ collect
+ $I1 = interpinfo .INTERPINFO_COLLECT_RUNS
+ eq $I0, $I1, loop1
+
+ before = stringinfo $S6, .STRINGINFO_STRSTART
+ unpin $S6
+
+ $I0 = interpinfo .INTERPINFO_COLLECT_RUNS
+ loop2:
+ collect
+ $I1 = interpinfo .INTERPINFO_COLLECT_RUNS
+ eq $I0, $I1, loop1
+
+ after = stringinfo $S6, .STRINGINFO_STRSTART
+
+ $S0 = 'ok'
+ eq init, before, next
+ $S0 = 'nok'
+ next:
+ ne before, after, ok
+ $S0 = 'nok'
+ ok:
+ print $S0
+.end
--
1.5.0.2.21.gdcde2
Content-Type: text/x-patch;
name="Convert-t-ops-string-mem.t-to-use-Test-More.pir.patch"
Content-Disposition: inline;
filename="Convert-t-ops-string-mem.t-to-use-Test-More.pir.patch"
Content-Transfer-Encoding: binary
Content-Description: [PATCH] Convert t/ops/string-mem.t to use Test/More.pir
MIME-Version: 1.0
X-Mailer: MIME-tools 5.419 (Entity 5.419)
Convert t/ops/string-mem.t to use Test/More.pir
---
t/op/string-mem.t | 76 ++++++++++++++++++++++++++++++++++++++++++++++------
1 files changed, 67 insertions(+), 9 deletions(-)
diff --git a/t/op/string-mem.t b/t/op/string-mem.t
index e5c38ed..bc39387 100644
--- a/t/op/string-mem.t
+++ b/t/op/string-mem.t
@@ -1,8 +1,51 @@
-.sub main :main
+#!./parrot
+# Copyright (C) 2007, The Perl Foundation.
+# $Id$
+
+=head1 NAME
+
+t/op/string-mem.t - test memory representation related string operations
+
+
+=head1 SYNOPSIS
+
+ % prove t/op/string-mem.t
+
+=head1 DESCRIPTION
+
+Tests string ops related to low-level representation of strings, such as:
+
+=over
+
+=item *
+
+stringinfo
+
+=item *
+
+pin/unpin
+
+=back
+
+=cut
+
+.include "hllmacros.pir"
+
+.sub _main :main
+ load_bytecode 'library/Test/More.pir'
+
+ .local pmc _
+ .IMPORT( 'Test::More', 'plan', _ )
+ .IMPORT( 'Test::More', 'ok', _ )
+ .IMPORT( 'Test::More', 'is', _ )
+ .IMPORT( 'Test::More', 'isnt', _ )
+
.local int init, before, after
.include 'stringinfo.pasm'
.include 'interpinfo.pasm'
+ plan(2)
+
$S0 = 'life'
$S1 = 'life'
$S2 = 'life'
@@ -44,12 +87,27 @@
after = stringinfo $S6, .STRINGINFO_STRSTART
- $S0 = 'ok'
- eq init, before, next
- $S0 = 'nok'
- next:
- ne before, after, ok
- $S0 = 'nok'
- ok:
- print $S0
+ is( init, before, "pin/collect didn't change memory address" )
+ $I0 = cmp after, before
+ print "# init: "
+ $S0 = init
+ print init
+ print ", before: "
+ $S0 = before
+ print before
+ print ", after: "
+ $S0 = after
+ print after
+ print ", cmp: "
+ $S0 = $I0
+ say $S0
+ ok( $I0, "location of string changed by unpin/collect" )
+
.end
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
--
1.5.0.2.21.gdcde2
Content-Type: text/x-patch; name="Segment-t-op-string-mem.t-test.patch"
Content-Disposition: inline; filename="Segment-t-op-string-mem.t-test.patch"
Content-Transfer-Encoding: binary
Content-Description: [PATCH] Segment t/op/string-mem.t test
MIME-Version: 1.0
X-Mailer: MIME-tools 5.419 (Entity 5.419)
Segment t/op/string-mem.t test
---
t/op/string-mem.t | 15 ++++++++++++---
1 files changed, 12 insertions(+), 3 deletions(-)
diff --git a/t/op/string-mem.t b/t/op/string-mem.t
index bc39387..ddb4139 100644
--- a/t/op/string-mem.t
+++ b/t/op/string-mem.t
@@ -30,21 +30,30 @@ pin/unpin
=cut
.include "hllmacros.pir"
+.include 'stringinfo.pasm'
+.include 'interpinfo.pasm'
+
+.const int TESTS = 2
.sub _main :main
load_bytecode 'library/Test/More.pir'
.local pmc _
.IMPORT( 'Test::More', 'plan', _ )
+ plan(TESTS)
+
+ test_pin_unpin()
+.end
+
+.sub test_pin_unpin
+
+ .local pmc _
.IMPORT( 'Test::More', 'ok', _ )
.IMPORT( 'Test::More', 'is', _ )
.IMPORT( 'Test::More', 'isnt', _ )
.local int init, before, after
- .include 'stringinfo.pasm'
- .include 'interpinfo.pasm'
- plan(2)
$S0 = 'life'
$S1 = 'life'
--
1.5.0.2.21.gdcde2
Content-Type: text/x-patch;
name="t-op-string-mem.t-add-test-for-a-couple-of-stringin.patch"
Content-Disposition: inline;
filename="t-op-string-mem.t-add-test-for-a-couple-of-stringin.patch"
Content-Transfer-Encoding: binary
Content-Description: [PATCH] t/op/string-mem.t: add test for a couple of
stringinfo calls
MIME-Version: 1.0
X-Mailer: MIME-tools 5.419 (Entity 5.419)
t/op/string-mem.t: add test for a couple of stringinfo calls
Test that we can see how COW strings behave using the stringinfo
opcode.
---
t/op/string-mem.t | 37 ++++++++++++++++++++++++++++++++++++-
1 files changed, 36 insertions(+), 1 deletions(-)
diff --git a/t/op/string-mem.t b/t/op/string-mem.t
index ddb4139..57fe583 100644
--- a/t/op/string-mem.t
+++ b/t/op/string-mem.t
@@ -33,7 +33,7 @@ pin/unpin
.include 'stringinfo.pasm'
.include 'interpinfo.pasm'
-.const int TESTS = 2
+.const int TESTS = 7
.sub _main :main
load_bytecode 'library/Test/More.pir'
@@ -42,6 +42,7 @@ pin/unpin
.IMPORT( 'Test::More', 'plan', _ )
plan(TESTS)
+ test_stringinfo()
test_pin_unpin()
.end
@@ -114,6 +115,40 @@ pin/unpin
.end
+.sub test_stringinfo
+ .local pmc _
+ .IMPORT( 'Test::More', 'ok', _ )
+ .IMPORT( 'Test::More', 'is', _ )
+ .IMPORT( 'Test::More', 'isnt', _ )
+
+ $S1 = "Hello, world"
+ $S0 = $S1
+ $I0 = stringinfo $S0, .STRINGINFO_STRSTART
+ $I1 = stringinfo $S1, .STRINGINFO_STRSTART
+ is($I0, $I1, "stringinfo - test STRSTART can see COW in action")
+
+ $I0 = stringinfo $S0, .STRINGINFO_HEADER
+ $I1 = stringinfo $S1, .STRINGINFO_HEADER
+ is($I0, $I1, "stringinfo - STRHEADER on full COW strings keeps same value")
+
+ $S2 = substr $S0, 7
+ is($S2, "world", "sanity check")
+ $I4 = stringinfo $S0, .STRINGINFO_STRSTART
+ $I2 = stringinfo $S2, .STRINGINFO_STRSTART
+ $I3 = $I2 - $I4
+ is($I3, 7, "stringinfo - STRSTART can see COW in action")
+
+ $I2 = stringinfo $S2, .STRINGINFO_HEADER
+ isnt($I0, $I2, "stringinfo - STRHEADER on different COW strings same
value")
+
+
+.end
+
+#.constant STRINGINFO_STRSTART 2
+#.constant STRINGINFO_BUFLEN 3
+#.constant STRINGINFO_FLAGS 4
+#.constant STRINGINFO_BUFUSED 5
+#.constant STRINGINFO_STRLEN 6
# Local Variables:
# mode: pir
--
1.5.0.2.21.gdcde2
