Here's a patch with the requested conversion to Perl.
Since this program is really a Parrot developer's tool, I'm recommending
that it be moved to tools/dev/ from tools/docs/.
Much of the functionality has been extracted into subroutines imported
from lib/Parrot/SearchOps.pm. Tests of those subroutines may be found
in t/tools/dev/searchops*.t.
Since it's late (for me), I'll post other aspects of the revisions tomorrow.
Thank you very much.
kid51
Index: tools/docs/search-ops.py
===================================================================
--- tools/docs/search-ops.py (.../trunk) (revision 27802)
+++ tools/docs/search-ops.py (.../branches/searchdocs) (revision 27867)
@@ -1,97 +0,0 @@
-#!/usr/bin/python
-
-"""
-Given a valid regex (pcre style) as an argument, the script will search inside
-any *.ops file located in 'path' for an opcode name that matches, dumping both
-its arguments and its description.
-If no argument is passed, every opcode found is dumped.
-
-Example:
-> ./search-ops.py load
-
-----------------------------------------------------------------------
-File: core.ops - Parrot Core Ops (2 matches)
-----------------------------------------------------------------------
-
-load_bytecode(in STR)
-Load Parrot bytecode from file $1, and (TODO) search the library path,
-to locate the file.
-
-loadlib(out PMC, in STR)
-Load a dynamic link library named $2 and store it in $1.
-
-----------------------------------------------------------------------
-File: debug.ops (1 matches)
-----------------------------------------------------------------------
-
-debug_load(inconst STR)
-Load a Parrot source file for the current program.
-"""
-
-path = "../../src/ops/" # path to the ops source folder
-wrap_width = 70 # max chars per line
-
-import os, re
-from sys import argv, exit
-
-def wrap(text, width):
- return reduce(lambda line, word, width=width: '%s%s%s' %
- (line,
- ' \n'[(len(line)-line.rfind('\n')-1
- + len(word.split('\n',1)[0]
- ) >= width)],
- word),
- text.split(' ')
- )
-
-query = ""
-if len(argv) > 1:
- query = argv[1]
-
-try:
- query = re.compile(query)
-except:
- print "Invalid opcode regex"
- exit()
-
-path = path.replace("\\", "/")
-if len(path) > 0 and path[-1] != "/":
- path = path + "/"
-
-try:
- opFiles = os.listdir(path)
-except:
- print "Path not found"
- exit()
-
-opFiles = filter(lambda file: re.compile("\.ops$").search(file) is not None,
opFiles)
-
-matches = []
-
-for file in opFiles:
- results = []
- opsc = open(path+file, "r").read()
-
- p = re.compile("^=item\sB<(\w+)>\(([^)]+)\)\n\n(?=(.*?)\n\n)",
re.MULTILINE|re.DOTALL)
- for m in p.findall(opsc):
- if query.search(m[0]) is None:
- continue
- if re.compile("=item").match(m[2]) is not None:
- m = list(m)
- m[2] = None
- results.append(m)
-
- if len(results) > 0:
- title = re.compile("^=head1\sNAME\n\n(.*)",
re.MULTILINE).search(opsc).group(1)
- matches.append({"f": title, "rs": results})
-
-if len(matches) == 0:
- print "No matches were found"
-else:
- delim = "\n" + "-" * wrap_width + "\n"
- for v in matches:
- print "%sFile: %s (%d matches)%s" % (delim, v["f"], len(v["rs"]),
delim)
- for m in v["rs"]:
- print "%s(%s)" % tuple(m[:2])
- if m[2] is not None:
- print wrap(m[2].replace("\n", " "), wrap_width)+"\n"
\ No newline at end of file
Index: tools/dev/search-ops.pl
===================================================================
--- tools/dev/search-ops.pl (.../trunk) (revision 0)
+++ tools/dev/search-ops.pl (.../branches/searchdocs) (revision 27867)
@@ -0,0 +1,73 @@
+# perl
+# Copyright (C) 2008, The Perl Foundation.
+# $Id$
+use strict;
+use warnings;
+use Carp;
+use Getopt::Long ();
+use lib qw( ./lib );
+use Parrot::SearchOps qw(
+ search_all_ops_files
+ usage
+ help
+);
+
+my ($help, $all);
+Getopt::Long::GetOptions(
+ "help" => \$help,
+ "all" => \$all,
+) or exit 1;
+
+if ($help) {
+ help();
+ exit 0;
+}
+
+croak "You may search for only 1 ops code at a time: $!"
+ if @ARGV > 1;
+unless ($all or $ARGV[0]) {
+ usage();
+ exit 0;
+}
+
+my $pattern = $all ? q{} : $ARGV[0];
+my $wrap_width = 70;
+my $opsdir = q{src/ops};
+
+my $total_identified = search_all_ops_files(
+ $pattern, $wrap_width, $opsdir
+);
+
+print "No matches were found\n" unless $total_identified;
+exit 0;
+
+=head1 NAME
+
+tools/dev/search-ops.pl - Get descriptions of ops codes
+
+=head1 USAGE
+
+From the top-level Parrot directory,
+
+ perl tools/dev/search-ops.pl ops_pattern
+
+For help,
+
+ perl tools/dev/search-ops.pl --help
+
+To display all ops codes,
+
+ perl tools/dev/search-ops.pl --all
+
+=head1 AUTHOR
+
+James E Keenan, adapting Python program written by Bernhard Schmalhofer.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Property changes on: tools/dev/search-ops.pl
___________________________________________________________________
Name: svn:eol-style
+ native
Name: svn:keywords
+ Author Date Id Revision
Index: lib/Parrot/SearchOps.pm
===================================================================
--- lib/Parrot/SearchOps.pm (.../trunk) (revision 0)
+++ lib/Parrot/SearchOps.pm (.../branches/searchdocs) (revision 27867)
@@ -0,0 +1,230 @@
+package Parrot::SearchOps;
+# Copyright (C) 2008, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+
+use Exporter;
+use Text::Wrap;
+use lib qw( ./lib );
+use Parrot::Configure::Utils qw( _slurp );
+our @ISA = qw( Exporter );
+our @EXPORT_OK = qw(
+ search_all_ops_files
+ help
+ usage
+);
+
+sub search_all_ops_files {
+ my ($pattern, $wrap_width, $opsdir) = @_;
+ $Text::Wrap::columns = $wrap_width;
+ my @opsfiles = glob("$opsdir/*.ops");
+
+ my $total_identified = 0;
+ foreach my $f (@opsfiles) {
+ $total_identified = _search_one_ops_file(
+ $pattern, $wrap_width, $total_identified, $f,
+ );
+ }
+ return $total_identified;
+}
+
+sub _search_one_ops_file {
+ my ($pattern, $wrap_width, $total_identified, $f) = @_;
+ my @paras = split /\n{2,}/, _slurp($f);
+ my %iden_paras = ();
+ for (my $i=0; $i<=$#paras; $i++) {
+ my $j = $i+1;
+ if (
+ $paras[$i] =~ /^=item\sB<(\w*$pattern\w*)>\(([^)]*)\)/o
+ and
+ $paras[$j]
+ ) {
+ $iden_paras{$i}{op} = $1;
+ $iden_paras{$i}{args} = $2;
+ }
+ }
+ if (keys %iden_paras) {
+ my @keys = keys %iden_paras;
+ my $seen = scalar @keys;
+ $total_identified += $seen;
+ _print_name([EMAIL PROTECTED], $wrap_width, $seen);
+ my @sorted_idx = sort {$a <=> $b} @keys;
+ my %remain_paras = map {$_, 1} @keys;
+ foreach my $idx (@sorted_idx) {
+ if ($remain_paras{$idx}) {
+ my $k = _handle_indices(
+ \%iden_paras,
+ $idx,
+ \%remain_paras,
+ );
+ print fill('', '', ($paras[$k])), "\n\n";
+ }
+ }
+ }
+ return $total_identified;
+}
+
+sub _print_name {
+ my $parasref = shift;
+ my $wrap_width = shift;
+ my $count = shift;
+ NAME: for (my $i=0; $i<=$#$parasref; $i++) {
+ my $j = $i+1;
+ if ($parasref->[$i] =~ /^=head1\s+NAME/o and $parasref->[$j]) {
+ my $str = qq{\n};
+ $str .= q{-} x $wrap_width . qq{\n};
+ $str .= $parasref->[$j] .
+ q< (> .
+ $count .
+ q< > .
+ ($count > 1 ? q<matches> : q<match>) .
+ qq<)\n>;
+ $str .= q{-} x $wrap_width . qq{\n};
+ $str .= qq{\n};
+ print $str;
+ last NAME;
+ }
+ }
+}
+
+sub _handle_indices {
+ my ($identified_ref, $idx, $remaining_ref) = @_;
+ my $j = $idx + 1;
+ my $k = $j;
+ print qq{$identified_ref->{$idx}{op}($identified_ref->{$idx}{args})\n};
+ delete $remaining_ref->{$idx};
+ if (defined $identified_ref->{$j}{op} ) {
+ $k = _handle_indices(
+ $identified_ref,
+ $j,
+ $remaining_ref,
+ );
+ }
+ return $k;
+}
+
+sub usage {
+ print <<USAGE;
+ perl tools/dev/search-ops.pl [--help] [--all] ops_pattern
+USAGE
+}
+
+sub help {
+ usage();
+ print <<HELP;
+
+Given a valid Perl 5 regex as an argument, the script will search inside any
+*.ops file for an opcode name that matches, dumping both its arguments and its
+description. The program must be called from the top-level Parrot directory.
+To dump every op, call '--all' on the command line.
+
+Example:
+> perl tools/dev/search-ops.pl load
+
+----------------------------------------------------------------------
+File: core.ops - Parrot Core Ops (2 matches)
+----------------------------------------------------------------------
+
+load_bytecode(in STR)
+Load Parrot bytecode from file \$1, and (TODO) search the library path,
+to locate the file.
+
+loadlib(out PMC, in STR)
+Load a dynamic link library named \$2 and store it in \$1.
+
+----------------------------------------------------------------------
+File: debug.ops (1 match)
+----------------------------------------------------------------------
+
+debug_load(inconst STR)
+Load a Parrot source file for the current program.
+HELP
+}
+
+1;
+
+=head1 NAME
+
+Parrot::SearchOps - functions used in tools/dev/search-ops.pl
+
+=head1 SYNOPSIS
+
+ use Parrot::SearchOps qw(
+ search_all_ops_files
+ usage
+ help
+ );
+
+ $total_identified = search_all_ops_files(
+ $pattern, $wrap_width, $opsdir
+ );
+
+ usage();
+
+ help();
+
+=head1 DESCRIPTION
+
+This package provides functionality for the Perl 5 program
+F<tools/dev/search-ops.pl>, designed to replace the Python program
+F<tools/docs/search-ops.py>. It exports two subroutines on demand.
+
+=head2 C<search_all_ops_files()>
+
+B<Purpose:> Searches all F<.ops> files in F<src/ops/> for ops codes and their
+descriptions. Those that match the specified pattern are printed to STDOUT.
+
+B<Arguments:> Three scalars.
+
+=over 4
+
+=item * C<$pattern>
+
+Perl 5 regular expression. So C<concat> will be matched by both C<concat> and
+C<n_concat>.
+
+=item * $wrap_width
+
+In F<tools/dev/search-ops.pl>, this is set to C<70> characters. Can be varied
+during testing or development.
+
+=item * $opsdir
+
+In F<tools/dev/search-ops.pl>, this is set to F<src/ops/>. Can be varied
+during testing or development.
+
+=back
+
+B<Return Value:> Number of times the pattern was matched by ops codes in all
+files.
+
+=head2 C<usage()>
+
+B<Purpose:> Display usage statement for F<tools/dev/search-ops.pl>.
+
+B<Arguments:> None.
+
+C<Return Value:> Implicitly returns true upon success.
+
+=head2 C<help()>
+
+B<Purpose:> Display usage statement and more complete help message for
F<tools/dev/search-ops.pl>.
+
+B<Arguments:> None.
+
+C<Return Value:> Implicitly returns true upon success.
+
+=head1 AUTHOR
+
+James E Keenan, adapting Python program written by Bernhard Schmalhofer.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Property changes on: lib/Parrot/SearchOps.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Name: svn:keywords
+ Author Date Id Revision
Index: MANIFEST
===================================================================
--- MANIFEST (.../trunk) (revision 27802)
+++ MANIFEST (.../branches/searchdocs) (revision 27867)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Fri May 23 19:02:33 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Wed May 28 02:17:46 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -1956,6 +1956,7 @@
languages/perl6/t/fetchspec [perl6]
languages/perl6/t/harness [perl6]
languages/perl6/t/passing_spec [perl6]
+languages/perl6/t/pmc/mutable.t [perl6]
languages/pheme/MAINTAINER [pheme]
languages/pheme/MANIFEST [pheme]
languages/pheme/README [pheme]
@@ -2576,6 +2577,7 @@
lib/Parrot/Pmc2c/UtilFunctions.pm [devel]
lib/Parrot/Pmc2c/VTable.pm [devel]
lib/Parrot/Revision.pm [devel]
+lib/Parrot/SearchOps.pm [devel]
lib/Parrot/Test.pm [devel]
lib/Parrot/Test/APL.pm [devel]
lib/Parrot/Test/Cardinal.pm [devel]
@@ -3623,6 +3625,11 @@
t/stm/queue.t []
t/stm/runtime.t []
t/stress/gc.t []
+t/tools/dev/searchops-01.t []
+t/tools/dev/searchops-02.t []
+t/tools/dev/searchops-03.t []
+t/tools/dev/searchops-04.t []
+t/tools/dev/searchops/samples.pm []
t/tools/ops2cutils/01-new.t []
t/tools/ops2cutils/02-usage.t []
t/tools/ops2cutils/03-print_c_header_file.t []
@@ -3705,6 +3712,7 @@
tools/dev/pbc_to_exe_gen.pl [devel]
tools/dev/rebuild_miniparrot.pl [devel]
tools/dev/reconfigure.pl [devel]
+tools/dev/search-ops.pl [devel]
tools/dev/src-t.sh [devel]
tools/dev/svnclobber.pl [devel]
tools/dev/symlink.pl [devel]
@@ -3713,7 +3721,6 @@
tools/dev/vtablize.pl [devel]
tools/docs/func_boilerplate.pl [devel]
tools/docs/pod_errors.pl [devel]
-tools/docs/search-ops.py [devel]
tools/docs/write_docs.pl [devel]
tools/install/smoke.pl []
tools/util/crow.pir []
Index: MANIFEST.SKIP
===================================================================
--- MANIFEST.SKIP (.../trunk) (revision 27802)
+++ MANIFEST.SKIP (.../branches/searchdocs) (revision 27867)
@@ -1,6 +1,6 @@
# ex: set ro:
# $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Sat May 17 10:49:14 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sun May 25 18:03:21 2008 UT
#
# This file should contain a transcript of the svn:ignore properties
# of the directories in the Parrot subversion repository. (Needed for
@@ -990,6 +990,8 @@
^languages/perl6/src/pmc/.*\.pdb/
^languages/perl6/src/pmc/.*\.so$
^languages/perl6/src/pmc/.*\.so/
+^languages/perl6/src/pmc/mutable\.pmc$
+^languages/perl6/src/pmc/mutable\.pmc/
# generated from svn:ignore of 'languages/perl6/src/utils/'
^languages/perl6/src/utils/Makefile$
^languages/perl6/src/utils/Makefile/
Index: t/tools/dev/searchops/samples.pm
===================================================================
--- t/tools/dev/searchops/samples.pm (.../trunk) (revision 0)
+++ t/tools/dev/searchops/samples.pm (.../branches/searchdocs)
(revision 27867)
@@ -0,0 +1,347 @@
+package samples;
+# Copyright (C) 2008, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+
+use Exporter;
+our ($core, $debug, $mangled, $string);
+our @ISA = qw( Exporter );
+our @EXPORT_OK = qw($core $debug $mangled $string);
+
+
+$core = q{
+/*
+ * $Id$
+** pseudo-core.ops
+*/
+
+#include "parrot/dynext.h"
+#include "parrot/embed.h"
+#include "../interp_guts.h"
+
+VERSION = PARROT_VERSION;
+
+=head1 NAME
+
+pseudo-core.ops - Parrot Core Ops
+
+=cut
+
+=head1 DESCRIPTION
+
+=cut
+
+########################################
+
+=over 4
+
+=item B<end>()
+
+Halts the interpreter. (Must be op #0, CORE_OPS_end). See also B<exit>.
+
+=cut
+
+inline op end() :base_core :check_event :flow {
+ HALT();
+}
+
+
+########################################
+
+=item B<load_bytecode>(in STR)
+
+Load Parrot bytecode from file $1, and
+RT#42381 search the library path to locate the file.
+
+=cut
+
+inline op noop() :base_core {
+}
+
+inline op cpu_ret() {
+#ifdef __GNUC__
+# ifdef I386
+ __asm__("ret");
+# endif
+#endif
+}
+
+inline op check_events() :base_core :flow {
+ opcode_t *next = expr NEXT();
+ Parrot_cx_check_tasks(interp, interp->scheduler);
+ goto ADDRESS(next); /* force this being a branch op */
+}
+
+inline op check_events__() :internal :flow {
+ opcode_t *_this = CUR_OPCODE;
+ /* Restore op_func_table. */
+ disable_event_checking(interp);
+ Parrot_cx_handle_tasks(interp, interp->scheduler);
+ goto ADDRESS(_this); /* force this being a branch op */
+}
+
+inline op wrapper__() :internal :flow {
+ opcode_t *pc = CUR_OPCODE;
+ DO_OP(pc, interp);
+ goto ADDRESS(pc);
+}
+
+inline op prederef__() :internal :flow {
+ opcode_t *_this = CUR_OPCODE;
+ if (interp->run_core & PARROT_CGOTO_CORE) {
+ /* must be CGP then - check for events in not yet prederefed code */
+ Parrot_cx_runloop_wake(interp, interp->scheduler);
+ /* _this = CHECK_EVENTS(interp, _this); */
+ }
+ do_prederef((void**)cur_opcode, interp, op_lib.core_type);
+ goto ADDRESS(_this); /* force this being a branch op */
+}
+
+inline op reserved(inconst INT) {
+ /* reserve 1 entries */
+}
+
+inline op load_bytecode(in STR) :load_file {
+ Parrot_load_bytecode(interp, $1);
+}
+
+
+=item B<loadlib>(out PMC, in STR)
+
+Load a dynamic link library named $2 and store it in $1.
+
+=cut
+
+inline op loadlib(out PMC, in STR) {
+ $1 = Parrot_load_lib(interp, $2, NULL);
+}
+
+=back
+
+###############################################################################
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001-2008, The Perl Foundation.
+
+=head1 LICENSE
+
+This program is free software. It is subject to the same license
+as the Parrot interpreter itself.
+
+=cut
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+ };
+
+ $debug = q{
+/*
+ * $Id$
+ * Copyright (C) 2002-2008, The Perl Foundation.
+ */
+
+/*
+** pseudo-debug.ops
+*/
+
+VERSION = PARROT_VERSION;
+
+=head1 NAME
+
+pseudo-debug.ops
+
+=cut
+
+=head1 DESCRIPTION
+
+Parrot debugger
+
+=cut
+
+=head1 HISTORY
+
+Initial version by Daniel Grunblatt on 2002.5.19
+
+=cut
+
+###############################################################################
+
+=head2 Parrot debug operations
+
+=over 4
+
+
+=item B<debug_load>(inconst STR)
+
+Load a Parrot source file for the current program.
+
+=cut
+
+op debug_load(inconst STR) :base_debug {
+ char *f;
+
+ if (!(interp->pdb->state & PDB_BREAK)) {
+ f = string_to_cstring(interp, ($1));
+ PDB_load_source(interp, f);
+ string_cstring_free(f);
+ }
+}
+
+=back
+
+=cut
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+ };
+
+ $mangled = q{
+/*
+ * $Id$
+** string.ops
+*/
+
+=head1 DESCRIPTION
+
+Operations that work on strings, whether constructing, modifying
+or examining them.
+
+=over 4
+
+=item B<chopn>(inout STR, in INT)
+
+Remove n characters specified by integer $2 from the tail of string $1.
+If $2 is negative, cut the string after -$2 characters.
+
+=item B<chopn>(out STR, in STR, in INT)
+
+Remove n characters specified by integer $3 from the tail of string $2,
+and returns the characters not chopped in string $1.
+If $3 is negative, cut the string after -$3 characters.
+
+=cut
+
+inline op chopn(inout STR, in INT) :base_core {
+ string_chopn_inplace(interp, $1, $2);
+}
+
+inline op chopn(out STR, in STR, in INT) :base_core {
+ $1 = string_chopn(interp, $2, $3);
+}
+
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001-2008, The Perl Foundation.
+
+=head1 LICENSE
+
+This program is free software. It is subject to the same license
+as the Parrot interpreter itself.
+
+=cut
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+
+=head1 NAME
+};
+
+$string = q{
+/*
+ * $Id$
+** pseudo-string.ops
+*/
+
+VERSION = PARROT_VERSION;
+
+=head1 NAME
+
+pseudo-string.ops - String Operations
+
+=head1 DESCRIPTION
+
+Operations that work on strings, whether constructing, modifying
+or examining them.
+
+=over 4
+
+=cut
+
+
+=item B<concat>(inout STR, in STR)
+
+=item B<concat>(in PMC, in STR)
+
+=item B<concat>(in PMC, in PMC)
+
+Modify string $1 in place, appending string $2.
+The C<PMC> versions are MMD operations.
+
+=item B<concat>(out STR, in STR, in STR)
+
+=item B<concat>(in PMC, in PMC, in STR)
+
+=item B<concat>(in PMC, in PMC, in PMC)
+
+=item B<n_concat>(out PMC, in PMC, in STR)
+
+=item B<n_concat>(out PMC, in PMC, in PMC)
+
+Append strings $3 to string $2 and place the result into string $1.
+The C<PMC> versions are MMD operations.
+The C<n_> variants create a new PMC $1 to store the result.
+See F<src/ops/math.ops> for the general C<infix> and C<n_infix> syntax.
+
+=cut
+
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001-2008, The Perl Foundation.
+
+=head1 LICENSE
+
+This program is free software. It is subject to the same license
+as the Parrot interpreter itself.
+
+=cut
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+
+=item B<n_concat>(foobar, in PMC, in PMC)
+
+};
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Property changes on: t/tools/dev/searchops/samples.pm
___________________________________________________________________
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Index: t/tools/dev/searchops-01.t
===================================================================
--- t/tools/dev/searchops-01.t (.../trunk) (revision 0)
+++ t/tools/dev/searchops-01.t (.../branches/searchdocs) (revision 27867)
@@ -0,0 +1,93 @@
+#! perl
+# Copyright (C) 2001-2005, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use File::Temp qw( tempdir );
+use Test::More tests => 5;
+use lib qw( ./lib ./t/tools/dev/searchops );
+use IO::CaptureOutput qw( capture );
+use Parrot::SearchOps qw(
+ search_all_ops_files
+ help
+);
+use samples qw( $core $debug $mangled $string );
+
+my %samples = (
+ core => { text => $core, file => q|core.ops| },
+ debug => { text => $debug, file => q|debug.ops| },
+ mangled => { text => $mangled, file => q|mangled.ops| },
+ string => { text => $string, file => q|string.ops| },
+);
+
+{
+ my ($stdout, $stderr);
+ capture(
+ \&help,
+ \$stdout,
+ \$stderr,
+ );
+ like($stdout,
+ qr/^\s*perl\stools\/dev\/search-ops\.pl.*?ops_pattern/s,
+ "Got expected start to help message",
+ );
+ like($stdout,
+ qr/Given a valid Perl 5 regex as an argument/s,
+ "Got expected line from body of help message",
+ );
+}
+
+my $wrap_width = 70;
+my $opsdir = q{t/tools/dev/searchops};
+
+{
+ my $tdir = tempdir();
+ foreach my $g (keys %samples) {
+ open my $IN, '>', qq{$tdir/$samples{$g}{file}}
+ or die "Unable to open $samples{$g}{file} for writing";
+ print $IN $samples{$g}{text};
+ close $IN or die "Unable to close $samples{$g}{file} after writing";
+ }
+ my $pattern = q{load};
+ my $total_identified;
+ my ($stdout, $stderr);
+ capture(
+ sub { $total_identified = search_all_ops_files(
+ $pattern, $wrap_width, $tdir ); },
+ \$stdout,
+ \$stderr,
+ );
+ like($stdout,
+ qr/pseudo-core\.ops.*?\(2 matches\).*?pseudo-debug\.ops.*?\(1
match\)/s,
+ "Got expected output",
+ );
+ like($stdout,
+ qr/load_bytecode.*?loadlib.*?debug_load/s,
+ "Got expected output",
+ );
+ is($total_identified, 3, "Got expected total number of ops for $pattern");
+}
+
+=head1 NAME
+
+t/tools/dev/searchops-01.t - test subroutines used in tools/dev/search-ops.pl
+
+=head1 SYNOPSIS
+
+ % prove t/tools/dev/searchops-01.t
+
+=head1 DESCRIPTION
+
+This file tests the basic operation of Parrot::SearchOps and
+demonstrates that it will match patterns in more than one file.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
Property changes on: t/tools/dev/searchops-01.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ Author Date Id Revision
Name: Copyright
+ Copyright (C) 2001-2006, The Perl Foundation.
Name: svn:eol-style
+ native
Name: svn:keyword
+
Index: t/tools/dev/searchops-02.t
===================================================================
--- t/tools/dev/searchops-02.t (.../trunk) (revision 0)
+++ t/tools/dev/searchops-02.t (.../branches/searchdocs) (revision 27867)
@@ -0,0 +1,71 @@
+#! perl
+# Copyright (C) 2001-2005, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use File::Temp qw( tempdir );
+use Test::More tests => 2;
+use lib qw( ./lib ./t/tools/dev/searchops );
+use IO::CaptureOutput qw( capture );
+use Parrot::SearchOps qw(
+ search_all_ops_files
+);
+use samples qw( $core $debug $mangled $string );
+
+my %samples = (
+ core => { text => $core, file => q|core.ops| },
+ debug => { text => $debug, file => q|debug.ops| },
+ mangled => { text => $mangled, file => q|mangled.ops| },
+ string => { text => $string, file => q|string.ops| },
+);
+
+my $wrap_width = 70;
+my $opsdir = q{t/tools/dev/searchops};
+
+{
+ my $tdir = tempdir();
+ foreach my $g (keys %samples) {
+ open my $IN, '>', qq{$tdir/$samples{$g}{file}}
+ or die "Unable to open $samples{$g}{file} for writing";
+ print $IN $samples{$g}{text};
+ close $IN or die "Unable to close $samples{$g}{file} after writing";
+ }
+ my $pattern = q{concat};
+ my $total_identified;
+ my ($stdout, $stderr);
+ capture(
+ sub { $total_identified = search_all_ops_files(
+ $pattern, $wrap_width, $tdir ); },
+ \$stdout,
+ \$stderr,
+ );
+ unlike($stdout, qr/n_concat\(foobar/,
+ "Badly formtted entry excluded from display, as expected");
+ is($total_identified, 8, "Got expected total number of ops for $pattern");
+}
+
+=head1 NAME
+
+t/tools/dev/searchops-02.t - test subroutines used in tools/dev/search-ops.pl
+
+=head1 SYNOPSIS
+
+ % prove t/tools/dev/searchops-02.t
+
+=head1 DESCRIPTION
+
+This test demonstrates that a pattern such as C<concat> will pick up both
+C<concat> and C<n_concat> functions. It also demonstrates that an .ops file
+with a function header not followed by a description will not print the
+header.
+
+=cut
+
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Property changes on: t/tools/dev/searchops-02.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ Author Date Id Revision
Name: Copyright
+ Copyright (C) 2001-2006, The Perl Foundation.
Name: svn:eol-style
+ native
Name: svn:keyword
+
Index: t/tools/dev/searchops-03.t
===================================================================
--- t/tools/dev/searchops-03.t (.../trunk) (revision 0)
+++ t/tools/dev/searchops-03.t (.../branches/searchdocs) (revision 27867)
@@ -0,0 +1,61 @@
+#! perl
+# Copyright (C) 2001-2005, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use File::Temp qw( tempdir );
+use Test::More tests => 2;
+use lib qw( ./lib ./t/tools/dev/searchops );
+use IO::CaptureOutput qw( capture );
+use Parrot::SearchOps qw(
+ search_all_ops_files
+);
+use samples qw( $core $debug $mangled $string );
+
+my %samples = (
+ core => { text => $core, file => q|core.ops| },
+ debug => { text => $debug, file => q|debug.ops| },
+ mangled => { text => $mangled, file => q|mangled.ops| },
+ string => { text => $string, file => q|string.ops| },
+);
+
+my $wrap_width = 70;
+my $opsdir = q{t/tools/dev/searchops};
+
+{
+ my $tdir = tempdir();
+ foreach my $g (keys %samples) {
+ open my $IN, '>', qq{$tdir/$samples{$g}{file}}
+ or die "Unable to open $samples{$g}{file} for writing";
+ print $IN $samples{$g}{text};
+ close $IN or die "Unable to close $samples{$g}{file} after writing";
+ }
+ my $pattern = q{chopn};
+ my $total_identified;
+ my ($stdout, $stderr);
+ capture(
+ sub { $total_identified = search_all_ops_files(
+ $pattern, $wrap_width, $tdir ); },
+ \$stdout,
+ \$stderr,
+ );
+ unlike($stdout, qr/NAME/,
+ "Badly formtted entry excluded from display, as expected");
+ is($total_identified, 2, "Got expected total number of ops for $pattern");
+}
+
+=head1 NAME
+
+t/tools/dev/searchops-03.t - test subroutines used in tools/dev/search-ops.pl
+
+=head1 SYNOPSIS
+
+ % prove t/tools/dev/searchops-03.t
+
+=head1 DESCRIPTION
+
+This test demonstrates that an F<.ops> file with a C<=head1 NAME> paragraph not
+followed by another paragraph will not print the 'NAME' paragraph.
+
+=cut
Property changes on: t/tools/dev/searchops-03.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ Author Date Id Revision
Name: Copyright
+ Copyright (C) 2001-2006, The Perl Foundation.
Name: svn:eol-style
+ native
Name: svn:keyword
+
Index: t/tools/dev/searchops-04.t
===================================================================
--- t/tools/dev/searchops-04.t (.../trunk) (revision 0)
+++ t/tools/dev/searchops-04.t (.../branches/searchdocs) (revision 27867)
@@ -0,0 +1,58 @@
+#! perl
+# Copyright (C) 2001-2005, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use File::Temp qw( tempdir );
+use Test::More tests => 1;
+use lib qw( ./lib ./t/tools/dev/searchops );
+use IO::CaptureOutput qw( capture );
+use Parrot::SearchOps qw(
+ search_all_ops_files
+);
+use samples qw( $core $debug $mangled $string );
+
+my $wrap_width = 70;
+my $opsdir = q{t/tools/dev/searchops};
+
+my %samples = (
+ core => { text => $core, file => q|core.ops| },
+ debug => { text => $debug, file => q|debug.ops| },
+ string => { text => $string, file => q|string.ops| },
+);
+
+{
+ my $tdir = tempdir();
+ foreach my $g (keys %samples) {
+ open my $IN, '>', qq{$tdir/$samples{$g}{file}}
+ or die "Unable to open $samples{$g}{file} for writing";
+ print $IN $samples{$g}{text};
+ close $IN or die "Unable to close $samples{$g}{file} after writing";
+ }
+ my $pattern = q{};
+ my $total_identified;
+ my ($stdout, $stderr);
+ capture(
+ sub { $total_identified = search_all_ops_files(
+ $pattern, $wrap_width, $tdir ); },
+ \$stdout,
+ \$stderr,
+ );
+ is($total_identified, 12, "Got expected total number of ops for --all");
+}
+
+=head1 NAME
+
+t/tools/dev/searchops-04.t - test subroutines used in tools/dev/search-ops.pl
+
+=head1 SYNOPSIS
+
+ % prove t/tools/dev/searchops-04.t
+
+=head1 DESCRIPTION
+
+This test demonstrates what happens when the C<--all> option is provided to
+F<tools/dev/search-ops.pl>.
+
+=cut
Property changes on: t/tools/dev/searchops-04.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ Author Date Id Revision
Name: Copyright
+ Copyright (C) 2001-2006, The Perl Foundation.
Name: svn:eol-style
+ native
Name: svn:keyword
+
Index: t/doc/pod.t
===================================================================
--- t/doc/pod.t (.../trunk) (revision 27802)
+++ t/doc/pod.t (.../branches/searchdocs) (revision 27867)
@@ -83,6 +83,9 @@
# skip POD generating scripts
next if $file =~ m/ops_summary\.pl/;
+ # skip file which includes malformed POD for other testing purposes
+ next if $file =~ m{t/tools/dev/searchops/samples\.pm};
+
# skip files with valid POD
next if file_pod_ok($file);
push @failed, $file;
Property changes on: languages/perl6/t/pmc/mutable.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Index: languages/perl6/src/pmc/perl6array.pmc
===================================================================
--- languages/perl6/src/pmc/perl6array.pmc (.../trunk) (revision 27802)
+++ languages/perl6/src/pmc/perl6array.pmc (.../branches/searchdocs)
(revision 27867)
@@ -1,5 +1,5 @@
/*
-$Id:$
+$Id$
Copyright (C) 2001-2008, The Perl Foundation.
=head1 NAME
@@ -21,3 +21,11 @@
pmclass Perl6Array extends Mutable need_ext dynpmc group perl6_group {
}
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+
Index: languages/perl6/src/pmc/perl6hash.pmc
===================================================================
--- languages/perl6/src/pmc/perl6hash.pmc (.../trunk) (revision 27802)
+++ languages/perl6/src/pmc/perl6hash.pmc (.../branches/searchdocs)
(revision 27867)
@@ -1,5 +1,5 @@
/*
-$Id:$
+$Id$
Copyright (C) 2001-2008, The Perl Foundation.
=head1 NAME
@@ -21,3 +21,11 @@
pmclass Perl6Hash extends Mutable need_ext dynpmc group perl6_group {
}
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+
Index: languages/perl6/src/pmc/perl6scalar.pmc
===================================================================
--- languages/perl6/src/pmc/perl6scalar.pmc (.../trunk) (revision 27802)
+++ languages/perl6/src/pmc/perl6scalar.pmc (.../branches/searchdocs)
(revision 27867)
@@ -21,3 +21,11 @@
pmclass Perl6Scalar extends Mutable need_ext dynpmc group perl6_group {
}
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+
