Change 31632 by [EMAIL PROTECTED] on 2007/07/19 08:12:57
Subject: Re: [patch] Hash::Util::FieldHash v1.02
From: Anno Siegel <[EMAIL PROTECTED]>
Date: Sun, 15 Jul 2007 15:02:11 +0200
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/ext/Hash/Util/FieldHash/Changes#5 edit
... //depot/perl/ext/Hash/Util/FieldHash/FieldHash.xs#15 edit
... //depot/perl/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm#7 edit
... //depot/perl/ext/Hash/Util/FieldHash/t/02_function.t#8 edit
Differences ...
==== //depot/perl/ext/Hash/Util/FieldHash/Changes#5 (text) ====
Index: perl/ext/Hash/Util/FieldHash/Changes
--- perl/ext/Hash/Util/FieldHash/Changes#4~31406~ 2007-06-17
09:58:55.000000000 -0700
+++ perl/ext/Hash/Util/FieldHash/Changes 2007-07-19 01:12:57.000000000
-0700
@@ -16,8 +16,14 @@
- 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
==== //depot/perl/ext/Hash/Util/FieldHash/FieldHash.xs#15 (text) ====
Index: perl/ext/Hash/Util/FieldHash/FieldHash.xs
--- perl/ext/Hash/Util/FieldHash/FieldHash.xs#14~31429~ 2007-06-20
09:07:06.000000000 -0700
+++ perl/ext/Hash/Util/FieldHash/FieldHash.xs 2007-07-19 01:12:57.000000000
-0700
@@ -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 @@
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 @@
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 @@
void
id(SV* ref)
+PROTOTYPE: $
PPCODE:
if (SvROK(ref)) {
XPUSHs(HUF_obj_id(ref));
==== //depot/perl/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm#7 (text)
====
Index: perl/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm
--- perl/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm#6~31407~
2007-06-17 10:14:12.000000000 -0700
+++ perl/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm 2007-07-19
01:12:57.000000000 -0700
@@ -5,6 +5,8 @@
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_OK = ( @{ $EXPORT_TAGS{'all'} } );
-our $VERSION = '1.01';
-
{
require XSLoader;
my %ob_reg; # private object registry
@@ -847,7 +847,8 @@
=head1 AUTHOR
-Anno Siegel, E<lt>[EMAIL PROTECTED]<gt>
+Anno Siegel (ANNO) wrote the xs code and the changes in perl proper
+Jerry Hedden (JDHEDDEN) made it faster
=head1 COPYRIGHT AND LICENSE
==== //depot/perl/ext/Hash/Util/FieldHash/t/02_function.t#8 (text) ====
Index: perl/ext/Hash/Util/FieldHash/t/02_function.t
--- perl/ext/Hash/Util/FieldHash/t/02_function.t#7~31406~ 2007-06-17
09:58:55.000000000 -0700
+++ perl/ext/Hash/Util/FieldHash/t/02_function.t 2007-07-19
01:12:57.000000000 -0700
@@ -280,6 +280,29 @@
}
{
+ # 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
End of Patch.
