Very cool.
Leaving aside the question whether anyone *should* tell the difference between 2
and "2", here is one (untested) way to do it. (I apologize if the diff lines
wrap, I don't know how to stop Lotus Notes 4.6 from doing this.)
--- PurePerl.pm~ Fri Apr 12 00:57:59 2002
+++ PurePerl.pm Fri Apr 12 10:11:54 2002
@@ -299,11 +299,36 @@
my ($key, $type) = @_;
die "hash not supported by ".__FILE__;
}
+
+BEGIN {
+ # Set inlinable constants based on feature tests.
+ local ($@);
+ if (eval { require B; }) {
+ if (defined (&B::SVf_IOK)) {
+ B->import (qw( SVf_IOK SVf_NOK ));
+ eval ('sub HAVE_B () { 1 }');
+ }
+ else {
+ eval ('sub HAVE_B () { 1 }');
+ eval ('sub SVf_IOK () { 0x10000 }');
+ eval ('sub SVf_NOK () { 0x20000 }');
+ }
+ }
+ else {
+ eval ('sub HAVE_B () { 0 }');
+ if ($@) { eval ('sub HAVE_B { 0 }'); }
+ eval ('sub SVf_IOK; sub SVf_NOK;');
+ }
+}
sub looks_like_number {
my @new = ();
for my $thing(@_) {
if (!defined $thing or $thing eq '') {
push @new, undef;
+ }
+ elsif (HAVE_B) {
+ push @new, (B::svref_2object (\$thing)->FLAGS
+ & (SVf_IOK | SVf_NOK) ? 1 : 0);
}
elsif ($thing =~ m/^[+-]?(?:(?:\.\d+)|(?:\d+\.?\d*))(?:[eE][+-]?\d+)?/
) {
push @new, 1;
"Jeff Zucker" <[EMAIL PROTECTED]> on 04/12/2002 12:52:16 AM
To: "Tim Bunce" <[EMAIL PROTECTED]>, "dbi-dev" <[EMAIL PROTECTED]>
cc: (bcc: John Tobey/Intdata)
Subject: DBI::PurePerl -- would you believe 100%?
Attatched is a copy of PurePerl that passes 271/271 t/* subtests with
the following tests skipped:
* proxy.t -- skipped
* preparse.t -- skipped
* basics.t
* skipped 2 of the subtests on neat() which depend on
looks_like_number() telling the difference between "2"
and 2
* skipped 5 subtests depending on hash()
That's all. Everything else passes. It needs a slight patch to DBI.pm
(also attatched) to bypass the bootstrap (default=use DBI,1=enable
PurePerl only if no loadable DBI, 2-force use of PurePerl) and to not
croak if PurePerl sets $DBI::err.
It emulates dispatch() with the IMA bitmasks, KEEP_ERR, class_depth,
etc.. It does not use lasth. All of the error/state passing is through
$DBI::err and friends.
*However* it contains this line in _setup_handle():
$DBI::PurePerl::frump = $h;
The variable is not used anywhere else, it functions only to keep $h
alive after everything else is destroyed (which I *do* know is what we
want to avoid). If it is commented out, then 4 errors appear in
examp.t. subtests which use eval (150,151,166,168). All of the errors
are because the test is expecting $@ to contain something and it is
empty. I have checked, and the croak/RaiseError is working properly and
has the message $@ is expecting but $@ never gets it. Unless I keep the
handle alive with frump, then $@ works as it should. Is there any
other way to make sure $@ is propagated properly?
--
Jeff
