Re: [patch] Hash::Util::FieldHash v1.02

Message-Id: <490839CC-BF8E-44B9-AF88-EFBE9863EDB2@mailbox.tu-berlin.de>

p4raw-id: //depot/perl@31632

diff --git a/ext/Hash/Util/FieldHash/Changes b/ext/Hash/Util/FieldHash/Changes
index dfddfb1..77f1fd9 100644 (file)
--- a/ext/Hash/Util/FieldHash/Changes
+++ b/ext/Hash/Util/FieldHash/Changes
@@ -16,8 +16,14 @@ Revision history for Perl extension Hash::Util::FieldHash.
         - Added functions id, id_2obj, register, idhash, idhashes
 
       Sun Jun 17 15:10:45 CEST 2007
-        In preparation for release
         - added tests for new functions
         - pod partially re-written to describe the multi-level
           interface
         - updated pod part of lib/Hash/Util.pm
+        - release accepted by p5p
+
+1.02 Sat Jul 14 22:38:33 CEST 2007
+        - prototype set to ($) for id()
+        - tests added for prototypes
+        - some cleanup in xs code
+        - small pod fixes

diff --git a/ext/Hash/Util/FieldHash/FieldHash.xs b/ext/Hash/Util/FieldHash/FieldHash.xs
index 98594f9..30e5cb9 100644 (file)
--- a/ext/Hash/Util/FieldHash/FieldHash.xs
+++ b/ext/Hash/Util/FieldHash/FieldHash.xs
@@ -6,9 +6,6 @@
 
 /* A Perl sub that returns a hashref to the object registry */
 #define HUF_OB_REG "Hash::Util::FieldHash::_ob_reg"
-/* Magic cookies to recognize object id's.  Hi, Eva, David */
-#define HUF_COOKIE 2805.1980
-#define HUF_REFADDR_COOKIE 1811.1976
 /* Identifier for PERL_MAGIC_ext magic */
 #define HUF_IDCACHE 0x4944
 
@@ -236,6 +233,22 @@ I32 HUF_watch_key_id(pTHX_ IV action, SV* field) {
     return 0;
 }
 
+/* see if something is a field hash */
+int HUF_get_status(HV* hash) {
+    int ans = 0;
+    if (hash && (SvTYPE(hash) == SVt_PVHV)) {
+        MAGIC* mg;
+        struct ufuncs* uf;
+        if ((mg = mg_find((SV*)hash, PERL_MAGIC_uvar)) &&
+            (uf = (struct ufuncs *)mg->mg_ptr) &&
+            (uf->uf_set == NULL)
+        ) {
+            ans = HUF_func_2mode(uf->uf_val);
+        }
+    }
+    return ans;
+}
+
 int HUF_func_2mode( I32(* val)(pTHX_ IV, SV*)) {
     int ans = 0;
     if (val == &HUF_watch_key_id)
@@ -258,22 +271,6 @@ I32(* HUF_mode_2func( int mode))(pTHX_ IV, SV*) {
     return(ans);
 }
 
-/* see if something is a field hash */
-int HUF_get_status(HV* hash) {
-    int ans = 0;
-    if (hash && (SvTYPE(hash) == SVt_PVHV)) {
-        MAGIC* mg;
-        struct ufuncs* uf;
-        if ((mg = mg_find((SV*)hash, PERL_MAGIC_uvar)) &&
-            (uf = (struct ufuncs *)mg->mg_ptr) &&
-            (uf->uf_set == NULL)
-        ) {
-            ans = HUF_func_2mode(uf->uf_val);
-        }
-    }
-    return ans;
-}
-
 /* Thread support.  These routines are called by CLONE (and nothing else) */
 
 /* Fix entries for one object in all field hashes */
@@ -375,6 +372,7 @@ OUTPUT:
 
 void
 id(SV* ref)
+PROTOTYPE: $
 PPCODE:
     if (SvROK(ref)) {
         XPUSHs(HUF_obj_id(ref));

diff --git a/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm b/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm
index ce7eb19..4e7a198 100644 (file)
--- a/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm
+++ b/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm
@@ -5,6 +5,8 @@ use strict;
 use warnings;
 use Scalar::Util qw( reftype);
 
+our $VERSION = '1.02';
+
 require Exporter;
 our @ISA = qw(Exporter);
 our %EXPORT_TAGS = (
@@ -20,8 +22,6 @@ our %EXPORT_TAGS = (
 );
 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
 
-our $VERSION = '1.01';
-
 {
     require XSLoader;
     my %ob_reg; # private object registry
@@ -847,7 +847,8 @@ value of the mode makes a difference, but that may change.
 
 =head1 AUTHOR
 
-Anno Siegel, E<lt>anno4000@zrz.tu-berlin.deE<gt>
+Anno Siegel (ANNO) wrote the xs code and the changes in perl proper
+Jerry Hedden (JDHEDDEN) made it faster
 
 =head1 COPYRIGHT AND LICENSE
 

diff --git a/ext/Hash/Util/FieldHash/t/02_function.t b/ext/Hash/Util/FieldHash/t/02_function.t
index 012ada7..6365289 100644 (file)
--- a/ext/Hash/Util/FieldHash/t/02_function.t
+++ b/ext/Hash/Util/FieldHash/t/02_function.t
@@ -280,6 +280,29 @@ BEGIN { $n_tests += 4 }
 }
 
 {
+    # prototypes in place?
+    my %proto_tab = (
+        fieldhash   => '\\%',
+        fieldhashes => '',
+        idhash      => '\\%',
+        idhashes    => '',
+        id          => '$',
+        id_2obj     => '$',
+        register    => '$@',
+    );
+
+
+    my @notfound = grep !exists $proto_tab{ $_} =>
+        @Hash::Util::FieldHash::EXPORT_OK;
+    ok @notfound == 0, "All exports in table";
+    is prototype( "Hash::Util::FieldHash::$_") || '', $proto_tab{ $_},
+        "$_ has prototype ($proto_tab{ $_})" for
+            @Hash::Util::FieldHash::EXPORT_OK;
+
+    BEGIN { $n_tests += 1 + @Hash::Util::FieldHash::EXPORT_OK }
+}
+
+{
     BEGIN { $n_tests += 1 }
     Hash::Util::FieldHash::_fieldhash \ my( %h), $fieldhash_mode;
     bless \ %h, 'abc'; # this bus-errors with a certain bug