| Subject: | should ignore special subs for attributes |
Pod::Checker currently ignores some 'special' functions (like AUTOLOAD), but it doesn't ignore the special ones for implementing 'attributes' on subs and variables. These special functions are documented here:
http://search.cpan.org/~nwclark/perl-5.8.6/lib/attributes.pm
(search for _ATTRIBUTES).
I've attached a patch that adds a new regex to ignore these. While I was at it I used /x to make the big regex easier to manage, and made the parens non-capturing as a minor optimization. My patch includes new tests for the attributes stuff, and it all seems to work (including fixing a real test failure in the Catalyst::Base module).
qef
diff -Nru Pod-Coverage-0.17.orig/MANIFEST Pod-Coverage-0.17/MANIFEST
--- Pod-Coverage-0.17.orig/MANIFEST 2004-11-23 14:21:56.000000000 +0000
+++ Pod-Coverage-0.17/MANIFEST 2005-04-28 17:47:18.869673148 +0100
@@ -18,7 +18,9 @@
t/06trustme.t
t/07pod.t
t/08tie.t
+t/09attr.t
t/lib/Args.pm
+t/lib/Attr.pm
t/lib/Earle.pm
t/lib/Simple1.pm
t/lib/Simple2.pm
diff -Nru Pod-Coverage-0.17.orig/lib/Pod/Coverage.pm Pod-Coverage-0.17/lib/Pod/Coverage.pm
--- Pod-Coverage-0.17.orig/lib/Pod/Coverage.pm 2004-11-23 14:21:56.000000000 +0000
+++ Pod-Coverage-0.17/lib/Pod/Coverage.pm 2005-04-28 17:50:47.445030957 +0100
@@ -74,9 +74,14 @@
C<private> an array of regexen which define what symbols are regarded
as private (and so need not be documented) defaults to /^_/,
-/^import$/, /^DESTROY$/, /^AUTOLOAD$/, /^bootstrap$/, /^(TIE(SCALAR|ARRAY|HASH|HANDLE)|FETCH|STORE|UNTIE|FETCHSIZE|STORESIZE|POP|PUSH|SHIFT|UNSHIFT|SPLICE|DELETE|EXISTS|EXTEND|CLEAR|FIRSTKEY|NEXTKEY|PRINT|PRINTF|WRITE|READLINE|GETC|READ|CLOSE|BINMODE|OPEN|EOF|FILENO|SEEK|TELL)$/. That last big one covers all the
+/^import$/, /^DESTROY$/, /^AUTOLOAD$/, /^bootstrap$/,
+/^(TIE(SCALAR|ARRAY|HASH|HANDLE)|FETCH|STORE|UNTIE|FETCHSIZE|STORESIZE|POP|PUSH|SHIFT|UNSHIFT|SPLICE|DELETE|EXISTS|EXTEND|CLEAR|FIRSTKEY|NEXTKEY|PRINT|PRINTF|WRITE|READLINE|GETC|READ|CLOSE|BINMODE|OPEN|EOF|FILENO|SEEK|TELL)$/,
+/^(?:FETCH|MODIFY)_(?:REF|SCALAR|ARRAY|HASH|CODE|GLOB|FORMAT|IO)_ATTRIBUTES$/.
+That big one covers all the
required and optional methods for tie()d objects, as these methods are
(hardly) ever called by a user, being used internally by perl.
+Similarly the last one covers methods for implementing attributes on
+functions and variables, which are called automatically by Perl.
C<also_private> items are appended to the private list
@@ -101,7 +106,13 @@
qr/^AUTOLOAD$/,
qr/^bootstrap$/,
qr/^\(/,
- qr/^(TIE(SCALAR|ARRAY|HASH|HANDLE)|FETCH|STORE|UNTIE|FETCHSIZE|STORESIZE|POP|PUSH|SHIFT|UNSHIFT|SPLICE|DELETE|EXISTS|EXTEND|CLEAR|FIRSTKEY|NEXTKEY|PRINT|PRINTF|WRITE|READLINE|GETC|READ|CLOSE|BINMODE|OPEN|EOF|FILENO|SEEK|TELL)$/
+ qr/^(?:TIE(?:SCALAR|ARRAY|HASH|HANDLE)|
+ FETCH|STORE|UNTIE|FETCHSIZE|STORESIZE|POP|PUSH|SHIFT|UNSHIFT|
+ SPLICE|DELETE|EXISTS|EXTEND|CLEAR|FIRSTKEY|NEXTKEY|
+ PRINT|PRINTF|WRITE|READLINE|GETC|READ|CLOSE|BINMODE|OPEN|
+ EOF|FILENO|SEEK|TELL)$/x,
+ qr/^(?:FETCH|MODIFY)_
+ (?:REF|SCALAR|ARRAY|HASH|CODE|GLOB|FORMAT|IO)_ATTRIBUTES$/x,
];
push @$private, @{ $args{also_private} || [] };
my $trustme = $args{trustme} || [];
diff -Nru Pod-Coverage-0.17.orig/t/09attr.t Pod-Coverage-0.17/t/09attr.t
--- Pod-Coverage-0.17.orig/t/09attr.t 1970-01-01 01:00:00.000000000 +0100
+++ Pod-Coverage-0.17/t/09attr.t 2005-04-28 17:48:05.495924571 +0100
@@ -0,0 +1,13 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More tests => 4;
+use lib 't/lib';
+
+BEGIN {
+ use_ok( 'Pod::Coverage' );
+ use_ok( 'Pod::Coverage::ExportOnly' );
+}
+
+my $obj = new Pod::Coverage package => 'Attr';
+isa_ok( $obj, 'Pod::Coverage' );
+is($obj->coverage, 1, "yay, skipped *_ATTRIBUTES functions");
diff -Nru Pod-Coverage-0.17.orig/t/lib/Attr.pm Pod-Coverage-0.17/t/lib/Attr.pm
--- Pod-Coverage-0.17.orig/t/lib/Attr.pm 1970-01-01 01:00:00.000000000 +0100
+++ Pod-Coverage-0.17/t/lib/Attr.pm 2005-04-28 17:46:40.739011827 +0100
@@ -0,0 +1,27 @@
+package Attr;
+
+=head1 NAME
+
+Attr - stubs to make sure that *_ATTRIBUTES functions are skipped
+
+=head1 METHODS
+
+=item foo
+
+blah blah
+
+=cut
+
+sub foo {
+ print "I like pie\n";
+}
+
+sub MODIFY_CODE_ATTRIBUTES { print "foo"; }
+sub FETCH_CODE_ATTRIBUTES { print "foo"; }
+sub MODIFY_HASH_ATTRIBUTES { print "foo"; }
+sub FETCH_HASH_ATTRIBUTES { print "foo"; }
+# Others are probably possible, but attributes.pod doesn't document
+# exactly which types are allowed. If it gets these right then it
+# should be OK.
+
+1;