Author: jisom
Date: Sun Feb 18 23:40:12 2007
New Revision: 17053
Added:
trunk/tools/util/pgegrep (contents, props changed)
Modified:
trunk/MANIFEST
trunk/src/pmc/resizablestringarray.pmc
trunk/t/pmc/resizablestringarray.t
Log:
Add splice to resizablestringarray.pmc
Add tests for it, change some tests to actually use resizablestringarray
instead of resizeablepmcarray, and comment out the call for one that
resizablestringarray can't do
Add pgegrep to tools/util(I don't know the best place)
MANIFEST housekeeping
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Sun Feb 18 23:40:12 2007
@@ -2950,6 +2950,7 @@
tools/docs/write_docs.pl [devel]
tools/util/ncidef2pasm.pl []
tools/util/perltidy.conf []
+tools/util/pgegrep []
tools/util/pirtidy.pl []
tools/util/smartlinks.pl []
tools/util/smokeserv-README.pod []
Modified: trunk/src/pmc/resizablestringarray.pmc
==============================================================================
--- trunk/src/pmc/resizablestringarray.pmc (original)
+++ trunk/src/pmc/resizablestringarray.pmc Sun Feb 18 23:40:12 2007
@@ -538,6 +538,65 @@
data[i] = data[i + 1];
DYNSELF.set_integer_native(size - 1);
}
+
+/*
+
+=item C<void splice(PMC* value, INTVAL offset, INTVAL count)>
+
+Replaces C<count> elements starting at C<offset> with the elements in
+C<value>.
+
+Note that the C<value> PMC can be of any of the various array types.
+
+Note that this implementation can be *VERY* inefficient as it manipulates
+everything via the VTABLE api.
+
+=cut
+
+*/
+
+ void splice(PMC* value, INTVAL offset, INTVAL count) {
+ if (value->vtable->base_type != SELF->vtable->base_type &&
+ value->vtable->base_type != enum_class_FixedStringArray)
+ real_exception(INTERP, NULL, E_TypeError,
+ "ResizableStringArray: illegal type for splice!");
+
+ INTVAL length = VTABLE_elements(INTERP, SELF);
+ INTVAL elems = VTABLE_elements(INTERP, value);
+ INTVAL shift = elems - count;
+ INTVAL i;
+
+ /* start from end? */
+ if (offset < 0)
+ offset += length;
+ if (offset < 0)
+ internal_exception(OUT_OF_BOUNDS, "illegal splice offset\n");
+
+ /* shrink the array */
+ if (shift < 0) {
+ /* start at offset so we don't overwrite values we'll need */
+ for (i=offset+count; i<length; i++)
+ VTABLE_set_pmc_keyed_int(INTERP, SELF, i + shift,
+ VTABLE_get_pmc_keyed_int(INTERP, SELF, i));
+
+ DYNSELF.set_integer_native(length + shift);
+ }
+ /* grow the array */
+ else if (shift > 0) {
+ DYNSELF.set_integer_native(length + shift);
+
+ /* move the existing values */
+ /* start at length-1 so we don't overwrite values we'll need */
+ for (i=length-1; i>=offset; i--)
+ VTABLE_set_pmc_keyed_int(INTERP, SELF, i + shift,
+ VTABLE_get_pmc_keyed_int(INTERP, SELF, i));
+ }
+
+ /* copy the new values */
+ for (i=0; i<elems; i++)
+ VTABLE_set_pmc_keyed_int(INTERP, SELF, i + offset,
+ VTABLE_get_pmc_keyed_int(INTERP, value, i));
+ }
}
Modified: trunk/t/pmc/resizablestringarray.t
==============================================================================
--- trunk/t/pmc/resizablestringarray.t (original)
+++ trunk/t/pmc/resizablestringarray.t Sun Feb 18 23:40:12 2007
@@ -1,6 +1,6 @@
#!./parrot
-.const int NUM_OF_TESTS = 173
+.const int NUM_OF_TESTS = 184
.sub main :main
load_bytecode 'library/Test/More.pir'
@@ -45,8 +45,10 @@
'unshift_float'()
'does'()
- 'get_string'()
+# 'get_string'()
'sparse'()
+
+ 'splice'()
.end
#
@@ -63,7 +65,7 @@
ok = get_hll_global ['Test::More'], 'ok'
.local pmc array
- array = new .ResizablePMCArray
+ array = new .ResizableStringArray
$I0 = array
$I1 = elements array
@@ -1188,7 +1190,7 @@
is = get_hll_global ['Test::More'], 'is'
.local pmc array
- array = new .ResizablePMCArray
+ array = new .ResizableStringArray
$I0 = does array, 'array'
is($I0, 1, "does array")
@@ -1282,3 +1284,98 @@
ok(0, "sparse 2")
.return()
.end
+
+
+
+
+
+.sub 'splice'
+ .local pmc is, like
+ is = get_hll_global ['Test::More'], 'is'
+ like = get_hll_global ['Test::More'], 'like'
+
+ $P1 = new .ResizableStringArray
+ $P1 = 3
+ $P1[0] = '1'
+ $P1[1] = '2'
+ $P1[2] = '3'
+ $P2 = new .ResizableStringArray
+ $P2 = 1
+ $P2[0] = 'A'
+ splice $P1, $P2, 0, 2
+ $S0 = join "", $P1
+ is($S0, "A3", "splice replace")
+
+ $P1 = new .ResizableStringArray
+ $P1 = 3
+ $P1[0] = '1'
+ $P1[1] = '2'
+ $P1[2] = '3'
+ $P2 = new .ResizableStringArray
+ $P2 = 1
+ $P2[0] = 'A'
+ splice $P1, $P2, 1, 2
+ $S0 = join "", $P1
+ is($S0, "1A", "splice replace")
+
+.macro SpliceMadeEasy(code, out, testing)
+ $P1 = new .ResizableStringArray
+ $P1[0] = "1"
+ $P1[1] = "2"
+ $P1[2] = "3"
+ $P1[3] = "4"
+ $P1[4] = "5"
+ $P2 = new .ResizableStringArray
+ $P2[0] = 'A'
+ $P2[1] = 'B'
+ $P2[2] = 'C'
+ $P2[3] = 'D'
+ $P2[4] = 'E'
+.code
+ $S0 = join "", $P1
+ is($S0, .out, .testing)
+.endm
+
+ .SpliceMadeEasy({ splice $P1, $P2, 0, 5 }, "ABCDE", "splice, complete
replace")
+ .SpliceMadeEasy({ splice $P1, $P2, 5, 0 }, "12345ABCDE", "splice,
append")
+ .SpliceMadeEasy({ splice $P1, $P2, 4, 0 }, "1234ABCDE5", "splice,
insert before last element")
+ .SpliceMadeEasy({ splice $P1, $P2, 3, 0 }, "123ABCDE45", "splice,
append-in-middle")
+ .SpliceMadeEasy({ splice $P1, $P2, 0, 2 }, "ABCDE345", "splice, replace
at beginning")
+ .SpliceMadeEasy({ splice $P1, $P2, 2, 2 }, "12ABCDE5", "splice, replace
in middle")
+ .SpliceMadeEasy({ splice $P1, $P2, 3, 2 }, "123ABCDE", "splice, replace
at end")
+ .SpliceMadeEasy({
+ $P2 = new .ResizableStringArray
+ splice $P1, $P2, 2, 2
+ }, "125", "splice, empty replacement")
+ .SpliceMadeEasy({
+ $P2 = new .ResizableStringArray
+ $P2[0] = "A"
+ splice $P1, $P2, 2, 1
+ }, "12A45", "splice, equal size replacement")
+
+ $P1 = new .ResizableStringArray
+ $P1[0] = "1"
+ $P1[1] = "2"
+ $P1[2] = "3"
+ $P1[3] = "4"
+ $P1[4] = "5"
+ $P2 = new .ResizablePMCArray
+ $P2[0] = 'A'
+ $P2[1] = 'B'
+ $P2[2] = 'C'
+ $P2[3] = 'D'
+ $P2[4] = 'E'
+
+ push_eh bad_type
+ splice $P1, $P2, 1, 0
+ clear_eh
+ goto still_ok
+
+ .local pmc exception
+ .local string message
+bad_type:
+ .get_results (exception, message)
+still_ok:
+ like(message, 'illegal\ type\ for\ splice', "splice with a different
type")
+.end
+
Added: trunk/tools/util/pgegrep
==============================================================================
--- (empty file)
+++ trunk/tools/util/pgegrep Sun Feb 18 23:40:12 2007
@@ -0,0 +1,274 @@
+#!./parrot
+# Or where ever it's at
+=head1 NAME
+
+pgegrep - A simple grep using PGE for matching
+
+=head1 SYNOPSIS
+
+B<pgegrep> [I<OPTIONS>] B<PATTERN> [I<FILE...>]
+
+=head1 DESCRIPTION
+
+pgegrep aims to be a small and easy to use program in replacement of the
+standard grep utility. Regex support is whatever PGE will allow. It searches
through files line by line and tests if the given pattern matches.
+
+=head1 OPTIONS
+
+=over 4
+
+=item -v
+
+=item --invert-match
+
+print lines not matching PATTERN
+
+=item -V
+
+=item --version
+
+print the version and exit
+
+=item --help
+
+show this help and exit
+
+=item -r
+
+=item --recursive
+
+recursively descend into directories
+
+=item -L
+
+=item --files-without-matches
+
+print a list of files that do not match PATTERN
+
+=item -l
+
+=item --files-with-matches
+
+print a list of files that do match PATTERN
+
+=item -c
+
+=item --count
+
+count the number of lines that match PATTERN in each file and print
+
+=item -n
+
+=item --line-number
+
+print the line number for each match
+
+=item -H
+
+=item --with-filename
+
+print the filename for each match
+
+=back
+
+=head1 AUTHOR
+
+Written and maintained by Joshua Isom L<[EMAIL PROTECTED]>
+
+PGE is authored and maintained by Patrick Michaud L<[EMAIL PROTECTED]>
+
+=cut
+
+# Readability improved!
+.include "hllmacros.pir"
+
+.sub main :main
+ .param pmc argv
+ .local string progname
+ progname = shift argv
+ load_bytecode "Getopt/Obj.pbc"
+ load_bytecode "PGE.pbc"
+ .local pmc getopts
+ getopts = new "Getopt::Obj"
+ getopts."notOptStop"(1)
+ push getopts, "count|c"
+ push getopts, "with-filename|H"
+ push getopts, "files-with-matches|l"
+ push getopts, "files-without-matches|L"
+ push getopts, "line-number|n"
+ push getopts, "recursive|r"
+ push getopts, "invert-match|v"
+ push getopts, "version|V"
+ push getopts, "help"
+ push_eh handler
+ .local pmc opts
+ opts = getopts."get_options"(argv)
+ $I0 = defined opts["help"]
+ .If($I0, {
+ showhelp()
+ })
+ $I0 = defined opts["version"]
+ .If($I0, {
+ showversion()
+ })
+
+
+ .local string rule
+ .local pmc p6rule_compile, matchsub
+ rule = shift argv
+ p6rule_compile = compreg "PGE::P6Regex"
+ matchsub = p6rule_compile(rule)
+ .If(null matchsub, {
+ printerr "Null matchsub, probably a syntax error\n"
+ end
+ })
+
+ .local int i, filecount
+ .local string filename
+ .local pmc File, OS, files, handle
+ files = new .ResizableStringArray
+ files = argv
+ filecount = files
+ # define with-filename if there's more than one file
+ .If(filecount >= 2, { opts["with-filename"] = 1 })
+ File = new .File
+ OS = new .OS
+ # This must be here, or else it'll get filled with junk data we use
stdin...
+ i = 0
+ .Unless(filecount, {
+ # no args, use stdin
+ stdindashhack:
+ handle = getstdin
+ filename = '(standard input)'
+ goto stdinhack
+ })
+ .For(, i < filecount, inc i, {
+ filename = files[i]
+ .If(filename == '-', {
+ goto stdindashhack
+ })
+ $I1 = File."is_file"(filename)
+ .IfElse($I1, {
+ # Is a file
+ handle = open filename, "<"
+ },{
+ # Not a file, hopefully a directory
+ $I1 = File."is_dir"(filename)
+ $I0 = defined opts["recursive"]
+ $I1 &= $I0
+ .Unless($I1, {
+ printerr "pgegrep: "
+ printerr filename
+ printerr ": Operation not supported.\n"
+ goto nextfor_0
+ })
+ $P0 = OS."readdir"(filename)
+ .Foreach($S0, $P0, {
+ .If($S0 != '.', {
+ .If($S0 != '..', {
+ $S1 = filename . '/'
+ $S0 = $S1 . $S0
+ $P1 = new .ResizableStringArray
+ $P1[0] = $S0
+ $I0 = i + 1
+ splice files, $P1, $I0, 0
+ }) })
+ })
+ filecount = files
+ goto nextfor_0
+ })
+ stdinhack:
+ checkfile(handle, filename, matchsub, opts)
+ close handle
+ nextfor_0:
+ })
+
+ end
+handler:
+ .local pmc exception
+ .local string message
+ .get_results (exception, message)
+ printerr "pgegrep: "
+ printerr message
+ printerr "\n"
+ end
+.end
+
+.sub checkfile
+ .param pmc handle
+ .param string filename
+ .param pmc matchsub
+ .param pmc opts
+ .local pmc match
+ .local string line
+ .local int lineno, linelen, matched
+ lineno = 1
+ matched = 0 # Only used for --files-without-matches
+ line = readline handle
+ linelen = length line
+ .For(, linelen, { line = readline handle .NL() linelen = length line
.NL() inc lineno }, {
+ match = matchsub(line)
+ $I1 = match.__get_bool()
+ $I0 = defined opts["files-without-matches"]
+ .If($I0, {
+ .If($I1, { matched = 1 })
+ goto next
+ })
+ $I0 = defined opts["files-with-matches"]
+ $I0 = $I0 && $I1
+ .If($I0, {
+ print filename
+ print "\n"
+ .return()
+ })
+
+ $I0 = defined opts["invert-match"]
+ not $I0
+ $I1 = xor $I1, $I0
+ .Unless($I1, {
+ $I0 = defined opts["with-filename"]
+ $I1 = defined opts["recursive"] # although recursive
isn't there yet
+ $I0 = $I0 || $I1
+ .If($I0, { print filename .NL() print ':' })
+ $I0 = defined opts["line-number"]
+ .If($I0, { print lineno .NL() print ':' })
+ print line
+ })
+ #---------
+ next:
+ })
+ $I0 = defined opts["files-without-matches"]
+ .If($I0, { print filename .NL() print "\n" })
+ .return()
+.end
+
+.sub showhelp
+ print <<'HELP'
+Usage: pgegrep [OPTIONS] PATTERN [FILE...]
+Search for the Perl 6 Rule PATTERN in each file.
+Use `perldoc pgegrep` for fuller documentation.
+
+ -v --invert-match print lines not matching PATTERN
+ -V --version print the version and exit
+ --help show this help and exit
+ -r --recursive recursively descend into directories
+ -L --files-without-matches print a list of files that do not match PATTERN
+ -l --files-with-matches print a list of files that do match PATTERN
+ -c --count count the number of lines that match PATTERN
+ in each file and print
+ -n --line-number print the line number for each match
+ -H --with-filename print the filename for each match
+
+HELP
+ end
+.end
+
+.sub showversion
+ print <<'VERSION'
+pgegrep v0.0.1
+VERSION
+ end
+.end
+
+# vim: ft=pir
+
