[svn:parrot] r48864 - in trunk: compilers/pct/src/PCT t/compilers/pct

[pmichaud at svn.parrot.org]

Author: pmichaud
Date: Wed Sep  8 19:26:39 2010
New Revision: 48864
URL: https://trac.parrot.org/parrot/changeset/48864

Log:
[pct]:  Migrate 'lineof' method (from deprecated CodeString PMC) into PCT::HLLCompiler.

Modified:
   trunk/compilers/pct/src/PCT/HLLCompiler.pir
   trunk/t/compilers/pct/pct_hllcompiler.t

Modified: trunk/compilers/pct/src/PCT/HLLCompiler.pir
==============================================================================
--- trunk/compilers/pct/src/PCT/HLLCompiler.pir	Wed Sep  8 19:16:05 2010	(r48863)
+++ trunk/compilers/pct/src/PCT/HLLCompiler.pir	Wed Sep  8 19:26:39 2010	(r48864)
@@ -955,6 +955,70 @@
     .return ($P0)
 .end
 
+=item lineof(target, pos [, cache])
+
+Return the line number of offset C<pos> within C<target>.  The return
+value uses zero for the first line.  If C<cache> is true, then
+memoize the line offsets as a C<!lineof> property on C<target>.
+
+=cut
+
+.sub 'lineof' :method
+    .param pmc target
+    .param int pos
+    .param int cache           :optional
+    .local pmc linepos
+
+    # If we've previously cached C<linepos> for target, we use it.
+    unless cache goto linepos_build
+    linepos = getprop '!linepos', target
+    unless null linepos goto linepos_done
+
+    # calculate a new linepos array.
+  linepos_build:
+    linepos = new ['ResizableIntegerArray']
+    unless cache goto linepos_build_1
+    setprop target, '!linepos', linepos
+  linepos_build_1:
+    .local string s
+    .local int jpos, eos
+    s = target
+    eos = length s
+    jpos = 0
+    # Search for all of the newline markers in C<target>.  When we
+    # find one, mark the ending offset of the line in C<linepos>.
+  linepos_loop:
+    jpos = find_cclass .CCLASS_NEWLINE, s, jpos, eos
+    unless jpos < eos goto linepos_done
+    $I0 = ord s, jpos
+    inc jpos
+    push linepos, jpos
+    # Treat \r\n as a single logical newline.
+    if $I0 != 13 goto linepos_loop
+    $I0 = ord s, jpos
+    if $I0 != 10 goto linepos_loop
+    inc jpos
+    goto linepos_loop
+  linepos_done:
+
+    # We have C<linepos>, so now we search the array for the largest
+    # element that is not greater than C<pos>.  The index of that
+    # element is the line number to be returned.
+    # (Potential optimization: use a binary search.)
+    .local int line, count
+    count = elements linepos
+    line = 0
+  line_loop:
+    if line >= count goto line_done
+    $I0 = linepos[line]
+    if $I0 > pos goto line_done
+    inc line
+    goto line_loop
+  line_done:
+    .return (line)
+.end
+
+
 =item dumper(obj, name, options)
 
 Dump C<obj> with C<name> according to C<options>.

Modified: trunk/t/compilers/pct/pct_hllcompiler.t
==============================================================================
--- trunk/t/compilers/pct/pct_hllcompiler.t	Wed Sep  8 19:16:05 2010	(r48863)
+++ trunk/t/compilers/pct/pct_hllcompiler.t	Wed Sep  8 19:26:39 2010	(r48864)
@@ -7,7 +7,7 @@
 use warnings;
 use lib qw(t . lib ../lib ../../lib ../../../lib);
 use Test::More;
-use Parrot::Test tests => 5;
+use Parrot::Test tests => 6;
 
 pir_output_is( <<'CODE', <<'OUT', 'some of the auxiliary methods' );
 
@@ -198,6 +198,72 @@
 omgwtf!
 OUT
 
+pir_output_is( <<'CODE', <<'OUT', 'lineof method' );
+.sub 'main' :main
+    load_bytecode 'PCT/HLLCompiler.pbc'
+    'lineof_tests'()
+.end
+
+.sub 'is'
+    .param int a
+    .param int b
+    .param string message
+    if a == b goto ok
+    print "not "
+  ok:
+    print "ok\n"
+.end
+
+.sub 'lineof_tests'
+    .local pmc hll, target
+    hll = get_hll_global ['PCT'], 'HLLCompiler'
+    target = box "0123\n5678\r0123\r\n678\n"
+    $I0 = hll.'lineof'(target, 0, 1)
+    is($I0, 0, "lineof - beginning of string")
+    $I0 = hll.'lineof'(target, 1, 1)
+    is($I0, 0, "lineof - char on first line")
+    $I0 = hll.'lineof'(target, 4, 1)
+    is($I0, 0, "lineof - immediately before nl")
+    $I0 = hll.'lineof'(target, 5, 1)
+    is($I0, 1, "lineof - immediately after nl")
+    $I0 = hll.'lineof'(target, 8, 1)
+    is($I0, 1, "lineof - char before cr")
+    $I0 = hll.'lineof'(target, 9, 1)
+    is($I0, 1, "lineof - immediately before cr")
+    $I0 = hll.'lineof'(target, 10, 1)
+    is($I0, 2, "lineof - immediately after cr")
+    $I0 = hll.'lineof'(target, 11, 1)
+    is($I0, 2, "lineof - char after cr")
+    $I0 = hll.'lineof'(target, 13, 1)
+    is($I0, 2, "lineof - char before crnl")
+    $I0 = hll.'lineof'(target, 14, 1)
+    is($I0, 2, "lineof - immediately before crnl")
+    $I0 = hll.'lineof'(target, 15, 1)
+    is($I0, 3, "lineof - middle of crnl")
+    $I0 = hll.'lineof'(target, 16, 1)
+    is($I0, 3, "lineof - immediately after crnl")
+    $I0 = hll.'lineof'(target, 19, 1)
+    is($I0, 3, "lineof - immediately before final nl")
+    $I0 = hll.'lineof'(target, 20, 1)
+    is($I0, 4, "lineof - immediately after final nl")
+.end
+CODE
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+OUT
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4