[svn:parrot] r37193 - in trunk: . config/auto config/gen/makefiles docs/pdds lib/Parrot/Harness lib/Parrot/Test lib/Parrot/Test/Pod runtime/parrot/library src t/codingstd t/doc
jkeenan at svn.parrot.org
jkeenan at svn.parrot.org
Sun Mar 8 02:41:03 UTC 2009
Author: jkeenan
Date: Sun Mar 8 02:41:01 2009
New Revision: 37193
URL: https://trac.parrot.org/parrot/changeset/37193
Log:
Merge update_pod branch into trunk. This consolidates all tests of POD under
t/codingstd/ and extracts subroutines used across POD test files into
Parrot::Test::Pod and Parrot::Test::Pod::Utils. Also, this corrects POD
syntax and formatting errors detected by these tests. Cf.:
https://trac.parrot.org/parrot/ticket/292.
Added:
trunk/lib/Parrot/Test/Pod/
- copied from r37187, branches/update_pod/lib/Parrot/Test/Pod/
trunk/lib/Parrot/Test/Pod.pm
- copied unchanged from r37187, branches/update_pod/lib/Parrot/Test/Pod.pm
trunk/t/codingstd/opcode-doc.t
- copied unchanged from r37187, branches/update_pod/t/codingstd/opcode-doc.t
trunk/t/codingstd/pod_description.t
- copied unchanged from r37187, branches/update_pod/t/codingstd/pod_description.t
trunk/t/codingstd/pod_syntax.t
- copied unchanged from r37187, branches/update_pod/t/codingstd/pod_syntax.t
Replaced:
trunk/lib/Parrot/Test/Pod/Utils.pm
- copied unchanged from r37187, branches/update_pod/lib/Parrot/Test/Pod/Utils.pm
Deleted:
trunk/t/doc/
Modified:
trunk/MANIFEST
trunk/MANIFEST.SKIP
trunk/config/auto/alignptrs.pm
trunk/config/gen/makefiles/root.in
trunk/docs/pdds/pdd13_bytecode.pod
trunk/docs/pdds/pdd21_namespaces.pod
trunk/lib/Parrot/Harness/DefaultTests.pm
trunk/runtime/parrot/library/TclLibrary.pir
trunk/src/runops_cores.c
trunk/t/codingstd/pod_todo.t
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST Sun Mar 8 02:37:35 2009 (r37192)
+++ trunk/MANIFEST Sun Mar 8 02:41:01 2009 (r37193)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Sat Mar 7 19:29:03 2009 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sun Mar 8 01:52:44 2009 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -1865,6 +1865,8 @@
lib/Parrot/Test/PGE.pm [devel]lib
lib/Parrot/Test/PIR_PGE.pm [devel]lib
lib/Parrot/Test/Perl6.pm [devel]lib
+lib/Parrot/Test/Pod.pm [devel]lib
+lib/Parrot/Test/Pod/Utils.pm [devel]lib
lib/Parrot/Test/Punie.pm [devel]lib
lib/Parrot/Test/Util.pm [devel]lib
lib/Parrot/Test/Util/Runloop.pm [devel]lib
@@ -2285,11 +2287,14 @@
t/codingstd/gmt_utc.t [test]
t/codingstd/linelength.t [test]
t/codingstd/make_code_coda.t [test]
+t/codingstd/opcode-doc.t [test]
t/codingstd/pbc_compat.t [test]
t/codingstd/pccmethod_deps.t [test]
t/codingstd/pdd_format.t [test]
t/codingstd/perlcritic.t [test]
t/codingstd/pir_code_coda.t [test]
+t/codingstd/pod_description.t [test]
+t/codingstd/pod_syntax.t [test]
t/codingstd/pod_todo.t [test]
t/codingstd/svn_id.t [test]
t/codingstd/tabs.t [test]
@@ -2432,8 +2437,6 @@
t/distro/manifest.t [test]
t/distro/meta_yml.t [test]
t/distro/test_file_coverage.t [test]
-t/doc/opcode-doc.t [test]
-t/doc/pod.t [test]
t/dynoplibs/dan.t [test]
t/dynoplibs/myops.t [test]
t/dynpmc/dynlexpad.t [test]
@@ -2508,6 +2511,9 @@
t/native_pbc/string.t [test]
t/native_pbc/string_1.pbc [test]
t/native_pbc/string_2.pbc [test]
+t/native_pbc/string_3.pbc [test]
+t/native_pbc/string_4.pbc [test]
+t/native_pbc/string_6.pbc [test]
t/oo/attributes.t [test]
t/oo/composition.t [test]
t/oo/inheritance.t [test]
Modified: trunk/MANIFEST.SKIP
==============================================================================
--- trunk/MANIFEST.SKIP Sun Mar 8 02:37:35 2009 (r37192)
+++ trunk/MANIFEST.SKIP Sun Mar 8 02:41:01 2009 (r37193)
@@ -1,6 +1,6 @@
# ex: set ro:
# $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Sat Mar 7 19:22:32 2009 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sun Mar 8 01:52:44 2009 UT
#
# This file should contain a transcript of the svn:ignore properties
# of the directories in the Parrot subversion repository. (Needed for
Modified: trunk/config/auto/alignptrs.pm
==============================================================================
--- trunk/config/auto/alignptrs.pm Sun Mar 8 02:37:35 2009 (r37192)
+++ trunk/config/auto/alignptrs.pm Sun Mar 8 02:41:01 2009 (r37193)
@@ -96,7 +96,7 @@
my $self = shift;
my ($align, $result_str) = @_;
# On 8-byte ptr_alignment we cannot read 4-byte pbc's. Warn the user about it.
- # TODO: inform the user to use --64compat for parrot. Milestone v2.6
+ # TT 413: inform the user to use --64compat for parrot. Milestone v2.6
if ($align > 4) {
$result_str .= " $align byte";
$result_str .= "s\n (Warning: 4-byte pbc's cannot be read!)";
Modified: trunk/config/gen/makefiles/root.in
==============================================================================
--- trunk/config/gen/makefiles/root.in Sun Mar 8 02:37:35 2009 (r37192)
+++ trunk/config/gen/makefiles/root.in Sun Mar 8 02:41:01 2009 (r37193)
@@ -1781,7 +1781,8 @@
"test$(EXE)" \
"test.*"
$(RM_F) \
- "parrot_test_run.tar.gz"
+ "parrot_test_run.tar.gz" \
+ ".pod_examinable*.sto"
imcc-clean:
$(RM_F) \
Modified: trunk/docs/pdds/pdd13_bytecode.pod
==============================================================================
--- trunk/docs/pdds/pdd13_bytecode.pod Sun Mar 8 02:37:35 2009 (r37192)
+++ trunk/docs/pdds/pdd13_bytecode.pod Sun Mar 8 02:41:01 2009 (r37193)
@@ -193,7 +193,9 @@
that is reading the PBC file do not match these, it needs to transform the
words making up the rest of the packfile.
-=head5 Bytecode File Version Numbers
+=over 4
+
+=item * Bytecode File Version Numbers
The bytecode file version number exists to decouple the format of the bytecode
file from the version of the Parrot implementation that is reading/writing it.
@@ -233,7 +235,7 @@
MAJOR.MINOR DATE NAME DESCRIPTION
-=head4 8-byte ptr_alignment
+=back
We should be aware that some systems such as a Sparc/PPC 64-bit use strict
8-byte ptr_alignment per default, and all C<(opcode_t*)cursor++> or
@@ -423,12 +425,14 @@
All constants that are not a multiple of the word size in length must be
padded with trailing zero bytes up to a word size boundary.
-=head5 Number Constants
+=over 4
+
+=item * Number Constants
The number is stored in the format defined in the Packfile header. Any padding
that is needed will follow.
-=head5 String Constants
+=item * String Constants
String constants are stored in the following format, with offsets relative to
the start of the constant including its type.
@@ -451,13 +455,13 @@
| 5 | n | String data with trailing zero padding as required. |
+--------+--------+--------------------------------------------------------+
-=head5 PMC Constants
+=item * PMC Constants
PMCs that can be saved in packfiles as constants implement the freeze and thaw
v-table methods. Their frozen data is placed in a string, stored in the same
format as a string constant.
-=head5 Key Constants
+=item * Key Constants
Key constants are made up a number of components, where one component is a
"dimension" in the key. The number of components in the key is stored at the
@@ -493,6 +497,7 @@
{{ TODO: Figure out slice bits and document them here. }}
+=back
=head4 Fixup Segment
@@ -754,19 +759,21 @@
This PMC represents the packfile overall. It will be constructed by the VM
when reading a packfile. It implements the following methods.
-=head5 C<get_string> (v-table)
+=over 4
+
+=item * C<get_string> (v-table)
Serializes this packfile data structure into a bytestream ready to be written
to disk (that is, maps from PMCs to on-disk representation).
-=head5 C<set_string_native> (v-table)
+=item * C<set_string_native> (v-table)
Takes a string containing an entire packfile in the on-disk format, attempts
to unpack it into a tree of Packfile PMCs and sets this Packfile PMC to
represent the top of that tree (that is, maps from on-disk representation to a
tree of PMCs).
-=head5 C<get_integer_keyed_str> (v-table)
+=item * C<get_integer_keyed_str> (v-table)
Used to get data about fields in the header that have an integer value. Valid
keys are:
@@ -795,7 +802,7 @@
=back
-=head5 C<get_string_keyed_str> (v-table)
+=item * C<get_string_keyed_str> (v-table)
Used to get data about fields in the header that have a string value. Valid
keys are:
@@ -806,7 +813,7 @@
=back
-=head5 C<set_integer_keyed_str> (v-table)
+=item * C<set_integer_keyed_str> (v-table)
Used to set fields in the packfile header. Some fields are not allowed to be
written since they are determined by the VM when serializing the packfile for
@@ -833,11 +840,12 @@
v-table method). Setting an invalid uuid_type value will cause an exception
to be thrown immediately.
-=head5 C<get_directory()>
+=item * C<get_directory()>
Returns the PackfileDirectory PMC that represents the directory segment at the
start of the packfile.
+=back
=head4 PackfileSegment.pmc
@@ -845,17 +853,20 @@
abstract methods, which are to be implemented by all subclasses. They will not
be listed under the method list for other segment PMCs to save space.
-=head5 C<STRING* pack()>
+=over 4
+
+=item * C<STRING* pack()>
Packs the segment into the on-disk format and returns a string holding it.
-=head5 C<unpack(STRING*)>
+=item * C<unpack(STRING*)>
Takes the packed representation for a segment of the given type and then
unpacks it, setting this PMC to represent that segment as a result of the
unpacking. If an error occurs during the unpacking process, an exception will
be thrown.
+=back
=head4 PackfileDirectory.pmc (isa PackfileSegment)
@@ -864,38 +875,41 @@
at that position in the segments table. When indexed using a string key, it
looks for a segment of that name. It implements the following methods:
-=head5 C<elements> (v-table)
+=over 4
+
+=item * C<elements> (v-table)
Gets the number of segments listed in the directory.
-=head5 C<get_pmc_keyed_int> (v-table)
+=item * C<get_pmc_keyed_int> (v-table)
Gets a PackfileSegment PMC or an appropriate subclass of it representing the
segment at the specified index in the directory segment.
-=head5 C<get_string_keyed_int> (v-table)
+=item * C<get_string_keyed_int> (v-table)
Gets a string containing the name of the segment at the specified index in the
directory segment.
-=head5 C<get_pmc_keyed_str> (v-table)
+=item * C<get_pmc_keyed_str> (v-table)
Searches the directory for a segment with the given name and, if one exists,
returns a PackfileSegment PMC (or one of its subclasses) representing it.
-=head5 C<set_pmc_keyed_str> (v-table)
+=item * C<set_pmc_keyed_str> (v-table)
Adds a PackfileSegment PMC (or a subclass of it) to the directory with the
name specified by the key. This is the only way to add another segment to the
directory. If a segment of the given name already exists in the directory, it
will be replaced with the supplied PMC.
-=head5 C<delete_keyed_str> (v-table)
+=item * C<delete_keyed_str> (v-table)
Removes the PackfileSegment PMC from the directory which has the name
specified by the key. This is the only way to remove a segment from the
directory.
+=back
=head4 RawSegment.pmc (isa PackfileSegment)
@@ -903,23 +917,26 @@
lowest possible level of access to a segment, and covers both the default and
bytecode segment types. It implements the following methods:
-=head5 C<get_integer_keyed_int> (v-table)
+=over 4
+
+=item * C<get_integer_keyed_int> (v-table)
Reads the integer at the specified offset into the segment, excluding the data
in the common segment header but including the data making up additional
fields in the header for a specific type of segment.
-=head5 C<set_integer_keyed_int> (v-table)
+=item * C<set_integer_keyed_int> (v-table)
Stores an integer at the specified offset into the segment. Will throw an
exception if the segment is memory mapped.
-=head5 C<elements> (v-table)
+=item * C<elements> (v-table)
Gets the length of the segment in words, excluding the length of the common
segment but including the data making up additional fields in the header for a
specific type of segment.
+=back
=head4 PackfileConstantTable.pmc (isa PackfileSegment)
@@ -932,50 +949,52 @@
The PMC implements the following methods:
-=head5 C<elements> (v-table)
+=over 4
+
+=item * C<elements> (v-table)
Gets the number of constants contained in the table.
-=head5 C<get_number_keyed_int> (v-table)
+=item * C<get_number_keyed_int> (v-table)
Gets the value of the number constant at the specified index in the constants
table. If the constant at that position in the table is not a number, an
exception will be thrown.
-=head5 C<get_string_keyed_int> (v-table)
+=item * C<get_string_keyed_int> (v-table)
Gets the value of the string constant at the specified index in the constants
table. If the constant at that position in the table is not a string, an
exception will be thrown.
-=head5 C<get_pmc_keyed_int> (v-table)
+=item * C<get_pmc_keyed_int> (v-table)
Gets the value of the PMC or key constant at the specified index in the
constants table. If the constant at that position in the table is not a PMC
or key, an exception will be thrown.
-=head5 C<set_number_keyed_int> (v-table)
+=item * C<set_number_keyed_int> (v-table)
Sets the value of the number constant at the specified index in the constants
table. If the constant at that position in the table is not already a number
constant, an exception will be thrown. If it does not exist, the table will be
extended.
-=head5 C<set_string_keyed_int> (v-table)
+=item * C<set_string_keyed_int> (v-table)
Sets the value of the string constant at the specified index in the constants
table. If the constant at that position in the table is not already a string
constant, an exception will be thrown. If it does not exist, the table will be
extended.
-=head5 C<set_pmc_keyed_int> (v-table)
+=item * C<set_pmc_keyed_int> (v-table)
Sets the value of the PMC or key constant at the specified index in the
constants table. If the constant at that position in the table is not already
a PMC or key constant, an exception will be thrown. If it does not exist, the
table will be extended.
-=head5 C<int get_type(int)>
+=item * C<int get_type(int)>
Returns an integer value denoting the type of the constant at the specified
index. Possible values are:
@@ -994,6 +1013,7 @@
| 0x6B | Key Constant |
+--------+-----------------------------------------------------------------+
+=back
=head4 PackfileFixupTable.pmc (isa PackfileSegment)
@@ -1001,53 +1021,59 @@
the table is represented by a PackfileFixupEntry PMC. It implements the
following methods:
-=head5 C<elements> (v-table)
+=over 4
+
+=item * C<elements> (v-table)
Gets the number of entries in the fixup table.
-=head5 C<get_pmc_keyed_int> (v-table)
+=item * C<get_pmc_keyed_int> (v-table)
Gets a PackfileFixupEntry PMC for the fixup entry at the position given in
the key. If the index is out of range, an exception will be thrown.
-=head5 C<set_pmc_keyed_int> (v-table)
+=item * C<set_pmc_keyed_int> (v-table)
Used to add a PackfileFixupEntry PMC to the fixups table or to replace an
existing one. If the PMC that is supplied is not of type PackfileFixupEntry,
an exception will thrown.
+=back
=head4 PackfileFixupEntry.pmc
This PMC represents an entry in the fixup table. It implements the following
methods.
-=head5 C<get_string> (v-table)
+=over 4
+
+=item * C<get_string> (v-table)
Gets the label field of the fixup entry.
-=head5 C<set_string_native> (v-table)
+=item * C<set_string_native> (v-table)
Sets the label field of the fixup entry.
-=head5 C<get_integer> (v-table)
+=item * C<get_integer> (v-table)
Gets the offset field of the fixup entry.
-=head5 C<set_integer_native> (v-table)
+=item * C<set_integer_native> (v-table)
Sets the offset field of the fixup entry.
-=head5 C<int get_type()>
+=item * C<int get_type()>
Gets the type of the fixup entry. See the entries table for possible fixup
types.
-=head5 C<set_type(int)>
+=item * C<set_type(int)>
Sets the type of the fixup entry. See the entries table for possible fixup
types. Specifying an invalid type will result in an exception.
+=back
=head4 PackfileAnnotations.pmc (isa PackfileSegment)
@@ -1056,22 +1082,24 @@
(offset, key, value) entry is represented by a PackfileAnnotation PMC. The
following methods are implemented:
-=head5 C<PMC* get_key_list()>
+=over 4
+
+=item * C<PMC* get_key_list()>
Returns a PackfileAnnotationKeys PMC containing the names and types of the
annotation keys. Fetch and add to this to create a new annotation key.
-=head5 C<elements> (v-table)
+=item * C<elements> (v-table)
Gets the number of annotations in the table.
-=head5 C<get_pmc_keyed_int> (v-table)
+=item * C<get_pmc_keyed_int> (v-table)
Gets the annotation at the specified index. If there is no annotation at that
index, an exception will be thrown. The PMC that is returned will always be a
PackfileAnnotation PMC.
-=head5 C<set_pmc_keyed_int> (v-table)
+=item * C<set_pmc_keyed_int> (v-table)
Sets the annotation at the specified index. If there is no annotation at that
index, it is added to the list of annotations. An exception will be thrown
@@ -1091,87 +1119,90 @@
=back
+=back
=head4 PackfileAnnotationKeys.pmc
This PMC represents the table of keys and the type of value that is stored
against that key. It implements the following methods:
-=head5 C<get_string_keyed_int> (v-table)
+=over 4
+
+=item * C<get_string_keyed_int> (v-table)
Gets the name of the annotation key specified by the index. An exception will
be thrown if the index is out of range.
-=head5 C<set_string_keyed_int> (v-table)
+=item * C<set_string_keyed_int> (v-table)
Sets the name of the annotation key specified by the index. If there is no key
with that index currently, a key at that position in the table will be added.
-=head5 C<get_integer_keyed_int> (v-table)
+=item * C<get_integer_keyed_int> (v-table)
Gets an integer representing the type of the value that is stored with the key
at the specified index. An exception will be thrown if the index is out of
range.
-=head5 C<set_integer_keyed_int> (v-table)
+=item * C<set_integer_keyed_int> (v-table)
Sets the type of the value that is stored with the key at the specified index.
If there is no key with that index currently, a key at that position in the
table will be added.
+=back
=head4 PackfileAnnotation.pmc
This PMC represents an individual bytecode annotation entry in the annotations
segment. It implements the following methods:
-=head5 C<int get_offset()>
+=over 4
+
+=item * C<int get_offset()>
Gets the offset into the bytecode of the instruction that is being annotated.
-=head5 C<set_offset(int)>
+=item * C<set_offset(int)>
Sets the offset into the bytecode of the instruction that is being annotated.
-=head5 C<int get_key_id()>
+=item * C<int get_key_id()>
Gets the ID of the key of the annotation.
-=head5 C<int set_key_id()>
+=item * C<int set_key_id()>
Sets the ID of the key of the annotation.
-=head5 C<get_integer> (v-table)
+=item * C<get_integer> (v-table)
Gets the value of the annotation. This may be, depending upon the type of the
annotation, an integer annotation or an index into the constants table.
-=head5 C<set_integer> (v-table)
+=item * C<set_integer> (v-table)
Sets the value of the annotation. This may be, depending upon the type of the
annotation, an integer annotation or an index into the constants table.
+=back
=head2 Language Notes
None.
-
=head2 Attachments
None.
-
=head2 Footnotes
None.
-
=head2 References
None.
-
=cut
__END__
Modified: trunk/docs/pdds/pdd21_namespaces.pod
==============================================================================
--- trunk/docs/pdds/pdd21_namespaces.pod Sun Mar 8 02:37:35 2009 (r37192)
+++ trunk/docs/pdds/pdd21_namespaces.pod Sun Mar 8 02:41:01 2009 (r37193)
@@ -123,7 +123,7 @@
Parrot namespaces assist with interoperability by providing two interface
subsets: the I<untyped interface> and the I<typed interface>.
-=head5 Untyped Interface
+=head4 Untyped Interface
Each HLL may, when working with its own namespace objects, use the I<untyped
interface>, which allows direct naming in the native style of the namespace's
@@ -152,7 +152,7 @@
=back
-=head5 Typed Interface
+=head4 Typed Interface
When a given namespace's HLL is either different from the current HLL or
unknown, an HLL should generally use only the language-agnostic namespace
Modified: trunk/lib/Parrot/Harness/DefaultTests.pm
==============================================================================
--- trunk/lib/Parrot/Harness/DefaultTests.pm Sun Mar 8 02:37:35 2009 (r37192)
+++ trunk/lib/Parrot/Harness/DefaultTests.pm Sun Mar 8 02:41:01 2009 (r37193)
@@ -86,7 +86,7 @@
@developing_tests = ( 't/distro/file_metadata.t' );
# Add in all t/codingstd except for a few skips.
push @developing_tests,
- grep { ! m/(c_function_docs|fixme|pod_todo)\.t$/ }
+ grep { ! m/(c_function_docs|fixme|pod_description|pod_todo|opcode-doc)\.t$/ }
glob 't/codingstd/*.t';
sub get_default_tests {
Copied: trunk/lib/Parrot/Test/Pod.pm (from r37187, branches/update_pod/lib/Parrot/Test/Pod.pm)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/lib/Parrot/Test/Pod.pm Sun Mar 8 02:41:01 2009 (r37193, copy of r37187, branches/update_pod/lib/Parrot/Test/Pod.pm)
@@ -0,0 +1,313 @@
+# Copyright (C) 2009, The Parrot Foundation.
+# $Id$
+package Parrot::Test::Pod;
+use strict;
+use warnings;
+use Carp;
+use ExtUtils::Manifest qw(maniread);
+use Pod::Find qw(contains_pod);
+use Pod::Simple::Text;
+use Storable qw(nstore retrieve);
+use lib qw( lib );
+use Parrot::Config;
+
+our %second_analysis_subs = (
+ oreilly_summary_malformed => sub {
+ my ($files_needing_analysis, $build_dir) = @_;
+ my $sto = q{.pod_examinable_oreilly_summary_malformed.sto};
+ if ( -e $sto ) {
+ eval { $files_needing_analysis = retrieve($sto) };
+ if ($@) {
+ croak "$sto exists on disk but could not retrieve from it";
+ }
+ else {
+ return $files_needing_analysis;
+ }
+ }
+ else {
+ SECOND_FILE: foreach my $file ( keys %{ $files_needing_analysis } ) {
+ my $full_file = qq|$build_dir/$file|;
+
+ # Skip the book, because it uses extended O'Reilly-specific POD
+ if ($full_file =~ m{docs/book/}) {
+ delete $files_needing_analysis->{ $file };
+ next SECOND_FILE;
+ }
+
+ # skip POD generating scripts
+ if ($full_file =~ m/ops_summary\.pl/) {
+ delete $files_needing_analysis->{ $file };
+ next SECOND_FILE;
+ }
+
+ # skip file which includes malformed POD for
+ # other testing purposes
+ if ($full_file =~ m{
+ t/tools/dev/searchops/samples\.pm
+ |
+ languages/pod/test\.pod
+ }x
+ ) {
+ delete $files_needing_analysis->{ $file };
+ next SECOND_FILE;
+ }
+ }
+ }
+ nstore $files_needing_analysis, $sto;
+ return $files_needing_analysis;
+ },
+ no_pod_todo => sub {
+ my ($files_needing_analysis, $build_dir) = @_;
+ my $sto = q{.pod_examinable_no_pod_todo.sto};
+ if ( -e $sto ) {
+ eval { $files_needing_analysis = retrieve($sto) };
+ if ($@) {
+ croak "$sto exists on disk but could not retrieve from it";
+ }
+ else {
+ return $files_needing_analysis;
+ }
+ }
+ else {
+ SECOND_FILE: foreach my $file ( keys %{ $files_needing_analysis } ) {
+ my $full_file = qq|$build_dir/$file|;
+
+ if ($full_file =~ m/(?:pod_todo|fixme)\.t/) {
+ delete $files_needing_analysis->{ $file };
+ next SECOND_FILE;
+ }
+ if (no_pod_todo($full_file)) {
+ delete $files_needing_analysis->{ $file };
+ next SECOND_FILE;
+ }
+ }
+ }
+ nstore $files_needing_analysis, $sto;
+ return $files_needing_analysis;
+ },
+);
+
+=head1 Parrot::Test::Pod
+
+Utilities for tests which test POD.
+
+=head2 Synopsis
+
+ use Parrot::Test::Pod;
+
+=head2 Description
+
+This module provides utilities for tests in the Parrot test suite which test
+the validity of documentation written in the POD format.
+
+All subroutines herein are exported only on demand.
+
+=head2 Functions
+
+=cut
+
+# RT #44437 this should really be using src_dir instead of build_dir but it
+# does not exist (yet)
+
+sub new {
+ my $class = shift;
+ my $args = shift;
+ $args->{build_dir} = $PConfig{build_dir};
+
+ croak "Cannot run test if build_dir does not yet exist"
+ unless -d $args->{build_dir};
+ croak "Test cannot be run unless MANIFEST exists in build dir"
+ unless -f "$args->{build_dir}/MANIFEST";
+ croak "Test cannot be run unless MANIFEST exists in build dir"
+ unless -f "$args->{build_dir}/MANIFEST.generated";
+
+ $args->{manifest} = maniread("$args->{build_dir}/MANIFEST");
+ $args->{manifest_gen} = maniread("$args->{build_dir}/MANIFEST.generated");
+ return bless $args, $class;
+}
+
+=head3 C<identify_files_for_POD_testing()>
+
+B<Purpose:>
+
+Identifies files in the Parrot distribution which are likely to merit
+examination for the validity of their POD.
+
+The subroutine itself does a first pass at that process, and takes as one of
+its arguments a reference to a subroutine which does a second such pass.
+
+B<Arguments:>
+
+ $need_testing_ref = $self->identify_files_for_POD_testing( {
+ second_analysis => 'oreilly_summary_malformed',
+ } );
+
+B<Return Value:>
+
+A reference to a hash where each element's key is the path to a file deemed
+needing examination for the validity of its POD. The element's value is
+either C<1> or C<2>, depending on whether it was seen in F<MANIFEST> or
+F<MANIFEST.generated> or both.
+
+B<Comment:> The first time this subroutine is invoked, it creates a Storable
+file in the top-level Parrot directory called F<.pod_examinable.sto>. That
+file holds a hash which serves as a lookup table for files which might need
+examination for validity of their POD. When the subroutine is subsequently
+invoked, that file is read so that one scan of the directory structure is
+eliminated.
+
+=cut
+
+sub identify_files_for_POD_testing {
+ my $self = shift;
+ my $args = shift;
+ my $files_needing_analysis = {};
+
+ # Make not hard-coded.
+ my $sto = q{.pod_examinable.sto};
+ if ( -e $sto ) {
+ eval { $files_needing_analysis = retrieve($sto) };
+ if ($@) {
+ croak "$sto exists on disk but could not retrieve from it";
+ }
+ else {
+ # go to second-level analysis
+ $files_needing_analysis =
+ $second_analysis_subs{$args->{second_analysis}}(
+ $files_needing_analysis,
+ $self->{build_dir},
+ );
+ }
+ }
+ else {
+ my @files;
+ if ( scalar(@{ $self->{argv} }) ) {
+ @files = @{ $self->{argv} };
+ }
+ else {
+ print STDERR "\nFinding files with POD, this may take a minute.\n";
+ @files = (
+ keys(%{ $self->{manifest} }),
+ keys(%{ $self->{manifest_gen} })
+ );
+ }
+ $files_needing_analysis->{$_}++ for @files;
+ # https://trac.parrot.org/parrot/ticket/311
+ # Certain files will be found in both MANIFEST.generated (because
+ # they're generated by bison or flex) and MANIFEST (we have them in
+ # repository so that normal users don't have to generate them).
+ # foreach my $k (keys %$files_needing_analysis) { print STDERR
+ # "$k\t$files_needing_analysis->{$k}\n" if
+ # $files_needing_analysis->{$k} > 1; }
+
+ # do FIRST_FILE
+ FIRST_FILE: foreach my $file ( keys %{ $files_needing_analysis } ) {
+ my $full_file = qq|$self->{build_dir}/$file|;
+
+ # skip missing MANIFEST.generated files ( -e )
+ # skip binary files # (including .pbc files) ( -B )
+ # skip files that pass the -e test
+ # because they resolve the .exe variant
+ unless (-T $full_file) {
+ delete $files_needing_analysis->{ $file };
+ next FIRST_FILE;
+ }
+
+ # skip files without POD
+ unless (Pod::Find::contains_pod( $full_file, 0 )) {
+ delete $files_needing_analysis->{ $file };
+ next FIRST_FILE;
+ }
+ }
+ nstore $files_needing_analysis, $sto;
+ # go to second-level analysis
+ $files_needing_analysis =
+ $second_analysis_subs{$args->{second_analysis}}(
+ $files_needing_analysis,
+ $self->{build_dir},
+ );
+ }
+
+ return [ keys %{ $files_needing_analysis } ];
+}
+
+=head3 C<oreilly_summary_malformed()>
+
+B<Purpose:>
+
+An instance of the "second pass" type of subroutine passed to
+C<identify_files_for_POD_testing()> C<second_analysis> argument.
+
+In this instance, we omit:
+
+=over 4
+
+=item *
+
+files in F<docs/book/> that use
+extended O'Reilly-specific POD;
+
+=item *
+
+programs that generate POD; and
+
+=item *
+
+files which for other testing purposes have deliberately malformed POD.
+
+=back
+
+B<Arguments:> Two scalar arguments:
+
+=over 4
+
+=item *
+
+Reference to hash of files meriting analysis, generated in first part of
+C<identify_files_for_POD_testing()>.
+
+=item *
+
+Path to build directory (currently, the top-level Parrot directory).
+
+=back
+
+B<Return Value:>
+
+Reference to hash of files meriting analysis, I<i.e.,> the results of the
+first pass minus the results of the second pass.
+
+=cut
+
+=head2 Author
+
+James E Keenan, refactored from earlier code
+
+=cut
+
+# Pulled from Test::Pod
+sub no_pod_todo {
+ my $file = shift;
+ my $checker = Pod::Simple::Text->new;
+
+ my $text;
+ $checker->output_string( \$text );
+ $checker->parse_file($file);
+
+ # if the text contains todo items return false
+ if ( $text =~ m/TODO|FIXME|XXX/ ) {
+ return 0;
+ }
+ else {
+ return 1;
+ }
+}
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Copied: trunk/lib/Parrot/Test/Pod/Utils.pm (from r37187, branches/update_pod/lib/Parrot/Test/Pod/Utils.pm)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/lib/Parrot/Test/Pod/Utils.pm Sun Mar 8 02:41:01 2009 (r37193, copy of r37187, branches/update_pod/lib/Parrot/Test/Pod/Utils.pm)
@@ -0,0 +1,48 @@
+# Copyright (C) 2007, The Perl Foundation.
+# $Id$
+package Parrot::Test::Pod::Utils;
+use strict;
+use warnings;
+use Pod::Simple;
+use Pod::Simple::PullParser;
+our (@ISA, @EXPORT_OK);
+ at ISA = qw( Exporter );
+ at EXPORT_OK = qw(
+ file_pod_ok
+ empty_description
+);
+
+# Pulled from Test::Pod
+sub file_pod_ok {
+ my $file = shift;
+ my $checker = Pod::Simple->new;
+
+ $checker->output_string( \my $trash ); # Ignore any output
+ $checker->parse_file($file);
+
+ return !$checker->any_errata_seen;
+}
+
+sub empty_description {
+ my $file = shift;
+
+ use Pod::Simple::PullParser;
+ my $parser = Pod::Simple::PullParser->new;
+ $parser->set_source( $file );
+ my $description = $parser->get_description;
+
+ if ( $description =~ m{^\s*$}m ) {
+ return 1;
+ }
+
+ return 0;
+}
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Modified: trunk/runtime/parrot/library/TclLibrary.pir
==============================================================================
--- trunk/runtime/parrot/library/TclLibrary.pir Sun Mar 8 02:37:35 2009 (r37192)
+++ trunk/runtime/parrot/library/TclLibrary.pir Sun Mar 8 02:41:01 2009 (r37193)
@@ -113,6 +113,8 @@
f_tclinit(interp)
.end
+=over 4
+
=item _init
Performs the initialization of Tcl bridge, namely instantiates TclLibrary class
@@ -236,9 +238,6 @@
.end
-=comment
-=cut
-
#
#static SV *
#SvFromTclObj(pTHX_ Tcl_Obj *objPtr)
@@ -402,7 +401,7 @@
die message
.end
-
+=back
=head1 SEE ALSO
Modified: trunk/src/runops_cores.c
==============================================================================
--- trunk/src/runops_cores.c Sun Mar 8 02:37:35 2009 (r37192)
+++ trunk/src/runops_cores.c Sun Mar 8 02:41:01 2009 (r37193)
@@ -176,7 +176,7 @@
mechanism is used will be called after every single opcode, and some large
programs may have millions of opcodes! Every single machine instruction
that can be cut out of the dispatch mechanism could increase the execution
-speed of Parrot in a significant and noticable way. N<The dispatch mechanism
+speed of Parrot in a significant and noticable way. B<The dispatch mechanism
used by the various runcores is hardly the largest performance bottleneck in
Parrot anyway, but we like to use faster cores to shave every little bit of
speed out of the system>.
@@ -187,6 +187,8 @@
=head2 Tracing Core
+To come.
+
=head2 Profiling Core
The profiling core analyzes the performance of Parrot, and helps to
Copied: trunk/t/codingstd/opcode-doc.t (from r37187, branches/update_pod/t/codingstd/opcode-doc.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/t/codingstd/opcode-doc.t Sun Mar 8 02:41:01 2009 (r37193, copy of r37187, branches/update_pod/t/codingstd/opcode-doc.t)
@@ -0,0 +1,97 @@
+#! perl
+# Copyright (C) 2001-2005, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use lib qw( . lib ../lib ../../lib );
+use Test::More tests => 1;
+
+=head1 NAME
+
+t/perl/opcode-doc.t - check opcode documentation
+
+=head1 SYNOPSIS
+
+ % prove t/perl/opcode-doc.t
+
+=head1 DESCRIPTION
+
+Checks whether all opcodes are documented.
+
+=cut
+
+my @docerr;
+
+sub slurp {
+ my ($filename) = @_;
+
+ open my $FILE, '<', "$filename" or die "can't open '$filename' for reading";
+ my @file = <$FILE>;
+ close $FILE;
+ return @file;
+}
+
+sub analyse {
+ my ( $filename, $ops ) = @_;
+
+ my %file;
+
+ foreach my $op ( keys %$ops ) {
+ my $args = $ops->{$op};
+ next if $op =~ /^DELETED/;
+ next if $op =~ /^isgt/; # doced but rewritten
+ next if $op =~ /^isge/;
+ foreach my $arg ( keys %$args ) {
+ my $e = $args->{$arg};
+ my $val = $e->{status};
+ next if $val == 3; # doc & impl
+ $file{ $e->{def} } = "no documentation for $op($arg)" if exists $e->{def};
+ $file{ $e->{doc} } = "no definition of $op($arg)" if exists $e->{doc};
+ }
+ }
+
+ foreach my $line ( sort { $a <=> $b } keys %file ) {
+ push @docerr, "$filename:$line: $file{$line}\n";
+ }
+}
+
+sub check_op_doc {
+ my ($filename) = @_;
+
+ my @file = slurp($filename);
+ my %op;
+ my $lineno = 0;
+
+ foreach my $line (@file) {
+ ++$lineno;
+ if ( my ($item) = $line =~ /^=item\s+(.+\(.*)/ ) {
+ if ( $item =~ /^([BC])\<(.*)\>\s*\((.*?)\)/ ) {
+ print "$filename:$lineno: use B<...> instead of C<...>\n"
+ if $1 eq "C";
+ my ( $op, $args ) = ( $2, $3 );
+ $args =~ s!\s*/\*.*?\*/!!; # del C comment in args
+ $op{$op}{$args}{doc} = $lineno;
+ $op{$op}{$args}{status} |= 1;
+ }
+ }
+ elsif ( $line =~ /^(inline )?\s*op\s*(\S+)\s*\((.*?)\)/ ) {
+ $op{$2}{$3}{def} = $lineno;
+ $op{$2}{$3}{status} |= 2;
+ }
+ }
+ analyse( $filename, \%op );
+}
+
+foreach my $file (<ops/*.ops>) {
+ check_op_doc $file;
+}
+
+ok( !@docerr, 'opcode documentation' ) or diag("Opcode documentation errors:\n at docerr");
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Copied: trunk/t/codingstd/pod_description.t (from r37187, branches/update_pod/t/codingstd/pod_description.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/t/codingstd/pod_description.t Sun Mar 8 02:41:01 2009 (r37193, copy of r37187, branches/update_pod/t/codingstd/pod_description.t)
@@ -0,0 +1,89 @@
+#! perl
+# Copyright (C) 2001-2009, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use Carp;
+use Test::More;
+use lib qw( lib );
+BEGIN {
+ eval 'use Parrot::Test::Pod';
+ if ($@) {
+ plan skip_all => 'Prerequisites for Parrot::Test::Pod not satisfied';
+ exit;
+ }
+ eval 'use Parrot::Test::Pod::Utils qw(
+ file_pod_ok
+ empty_description
+ )';
+ if ($@) {
+ plan skip_all =>
+ 'Prerequisites for Parrot::Test::Pod::Utils not satisfied';
+ exit;
+ }
+}
+
+plan tests => 2;
+
+my $self = Parrot::Test::Pod->new( {
+ argv => [ @ARGV ],
+} );
+ok( defined $self, "Parrot::Test::Pod returned defined value" );
+
+my $need_testing_ref = $self->identify_files_for_POD_testing( {
+ second_analysis => 'oreilly_summary_malformed',
+} );
+
+my @empty_description;
+
+foreach my $file ( @{ $need_testing_ref } ) {
+ # check DESCRIPTION section on valid POD files
+ if ( file_pod_ok($file) and empty_description($file) ) {
+ push @empty_description, $file;
+ }
+}
+
+my $empty_description_files = join( "\n", sort @empty_description);
+my $nempty_description = scalar( @empty_description );
+
+TODO: {
+ local $TODO = "not quite done yet";
+ is(
+ $empty_description_files,
+ q{},
+ 'All Pod files have non-empty DESCRIPTION sections'
+ );
+}
+
+diag("\nFound $nempty_description files without DESCRIPTION sections.\n")
+ if $nempty_description;
+
+#################### SUBROUTINES ####################
+
+=head1 t/codingstd/pod_description.t
+
+Identify files lacking 'Description' section in their POD
+
+=head2 SYNOPSIS
+
+ # test all files
+ % prove t/codingstd/pod_description.t
+
+ # test specific files
+ % perl t/codingstd/pod_description.t perl_module.pm perl_file.pl
+
+=head2 DESCRIPTION
+
+Tests the Pod syntax for all files listed in F<MANIFEST> and
+F<MANIFEST.generated> that appear to contain Pod markup. If any files
+contain with valid POD markup lack C<DESCRIPTION> sections, list them.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Copied: trunk/t/codingstd/pod_syntax.t (from r37187, branches/update_pod/t/codingstd/pod_syntax.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/t/codingstd/pod_syntax.t Sun Mar 8 02:41:01 2009 (r37193, copy of r37187, branches/update_pod/t/codingstd/pod_syntax.t)
@@ -0,0 +1,78 @@
+#! perl
+# Copyright (C) 2001-2009, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use Carp;
+use Test::More;
+use lib qw( lib );
+BEGIN {
+ eval 'use Parrot::Test::Pod';
+ if ($@) {
+ plan skip_all => 'Prerequisites for Parrot::Test::Pod not satisfied';
+ exit;
+ }
+ eval 'use Parrot::Test::Pod::Utils qw(
+ file_pod_ok
+ )';
+}
+
+plan tests => 2;
+
+my $self = Parrot::Test::Pod->new( {
+ argv => [ @ARGV ],
+} );
+ok( defined $self, "Parrot::Test::Pod returned defined value" );
+
+my $need_testing_ref = $self->identify_files_for_POD_testing( {
+ second_analysis => 'oreilly_summary_malformed',
+} );
+
+my @failed_syntax;
+
+foreach my $file ( @{ $need_testing_ref } ) {
+ # skip files with valid POD;
+ # report whatever is not skipped
+ unless (file_pod_ok($file)) {
+ push @failed_syntax, $file;
+ }
+}
+
+my $bad_syntax_files = join( "\n", @failed_syntax );
+
+# only ok if everything passed
+is( $bad_syntax_files, q{}, 'Pod syntax correct' );
+
+diag("You should use podchecker to check the failed files.\n")
+ if $bad_syntax_files;
+
+#################### SUBROUTINES ####################
+
+=head1 NAME
+
+t/codingstd/pod_syntax.t - Pod document syntax tests
+
+=head1 SYNOPSIS
+
+ # test all files
+ % prove t/codingstd/pod_syntax.t
+
+ # test specific files
+ % perl t/codingstd/pod_syntax.t perl_module.pm perl_file.pl
+
+=head1 DESCRIPTION
+
+Tests the Pod syntax for all files listed in F<MANIFEST> and
+F<MANIFEST.generated> that appear to contain Pod markup. If any files
+contain invalid POD markup, they are reported in the test output.
+Use C<podchecker> to ferret out individual issues.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Modified: trunk/t/codingstd/pod_todo.t
==============================================================================
--- trunk/t/codingstd/pod_todo.t Sun Mar 8 02:37:35 2009 (r37192)
+++ trunk/t/codingstd/pod_todo.t Sun Mar 8 02:41:01 2009 (r37193)
@@ -2,6 +2,46 @@
# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
+use strict;
+use warnings;
+
+use Carp;
+use Test::More;
+use lib qw( lib );
+BEGIN {
+ eval 'use Parrot::Test::Pod';
+ if ($@) {
+ plan skip_all => 'Prerequisites for Parrot::Test::Pod not satisfied';
+ exit;
+ }
+}
+
+plan tests => 2;
+
+my $self = Parrot::Test::Pod->new( {
+ argv => [ @ARGV ],
+} );
+ok( defined $self, "Parrot::Test::Pod returned defined value" );
+
+my $need_testing_ref = $self->identify_files_for_POD_testing( {
+ second_analysis => 'no_pod_todo',
+} );
+
+my $bad_files = join( "\n", sort @{ $need_testing_ref } );
+my $nbad_files = scalar @{ $need_testing_ref };
+TODO: {
+ local $TODO = "not quite done yet";
+ # only ok if everything passed
+ is(
+ $bad_files,
+ q{},
+ 'No todo items found'
+ );
+}
+
+diag("\nFound $nbad_files files with 'todo', 'fixme' or 'XXX' items.\n")
+ if $nbad_files;
+
=head1 NAME
t/doc/pod_todo.t - find todo items in pod files
@@ -26,95 +66,6 @@
=cut
-use strict;
-use warnings;
-
-use lib qw( . lib ../lib ../../lib );
-
-use Test::More;
-use Parrot::Config;
-use ExtUtils::Manifest qw(maniread);
-
-use vars qw(@failed);
-
-BEGIN {
- eval 'use Pod::Find';
- if ($@) {
- plan skip_all => 'Pod::Find not installed';
- exit;
- }
- eval 'use Pod::Simple';
- if ($@) {
- plan skip_all => 'Pod::Simple not installed';
- exit;
- }
- eval 'use Pod::Simple::Text';
- if ($@) {
- plan skip_all => 'Pod::Simple::Text not installed';
- exit;
- }
-}
-
-plan tests => 1;
-
-# RT #44437 this should really be using src_dir insetad of build_dir but it
-# doesn't exist (yet)
-my $build_dir = $PConfig{build_dir};
-my $manifest = maniread("$build_dir/MANIFEST");
-my $manifest_gen = maniread("$build_dir/MANIFEST.generated");
-
-# if we have files passed in at the command line, use them
-my @files;
-if (@ARGV) {
- @files = <@ARGV>;
-}
-else {
- diag "finding files with pod, this might take a while.";
- @files = ( sort keys(%$manifest), sort keys(%$manifest_gen) );
-}
-
-foreach my $file (@files) {
- $file = "$build_dir/$file";
-
- # skip test files looking for todo items as their docs definitely contain
- # todo items: this is how they explain what they're doing.
- next if $file =~ m/pod_todo\.t|fixme\.t/;
-
- # skip binary files (including .pbc files)
- next if -B $file;
-
- # skip missing MANIFEST.generated files
- next unless -e $file;
-
- # skip files without POD
- next unless Pod::Find::contains_pod( $file, 0 );
-
- # skip files without todo items
- next if no_pod_todo($file);
- push @failed, $file;
-}
-
-my $bad_files = join( "\n", @failed );
-is( $bad_files, q{}, 'No todo items found' ); # only ok if everything passed
-
-# Pulled from Test::Pod
-sub no_pod_todo {
- my $file = shift;
- my $checker = Pod::Simple::Text->new;
-
- my $text;
- $checker->output_string( \$text );
- $checker->parse_file($file);
-
- # if the text contains todo items return false
- if ( $text =~ m/TODO|FIXME|XXX/ ) {
- return 0;
- }
- else {
- return 1;
- }
-}
-
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
More information about the parrot-commits
mailing list