GDBM_File (wasRe: ext/ + -Wall)

Message-ID: <20010614203747.F98663@plum.flirble.org>

p4raw-id: //depot/perl@10599

2 files changed, 182 insertions, 125 deletions

diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm
index 310243c736..f857f3830e 100644
--- a/ext/GDBM_File/GDBM_File.pm
+++ b/ext/GDBM_File/GDBM_File.pm
@@ -46,7 +46,6 @@ our($VERSION, @ISA, @EXPORT, $AUTOLOAD);
 require Carp;
 require Tie::Hash;
 require Exporter;
-use AutoLoader;
 use XSLoader ();
 @ISA = qw(Tie::Hash Exporter);
 @EXPORT = qw(
@@ -61,29 +60,17 @@ use XSLoader ();
 	GDBM_WRITER
 );
 
-$VERSION = "1.05";
+$VERSION = "1.06";
 
 sub AUTOLOAD {
     my($constname);
     ($constname = $AUTOLOAD) =~ s/.*:://;
-    my $val = constant($constname, @_ ? $_[0] : 0);
-    if ($! != 0) {
-	if ($! =~ /Invalid/ || $!{EINVAL}) {
-	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
-	    goto &AutoLoader::AUTOLOAD;
-	}
-	else {
-	    Carp::croak("Your vendor has not defined GDBM_File macro $constname, used");
-	}
-    }
+    my ($error, $val) = constant($constname);
+    Carp::croak $error if $error;
     eval "sub $AUTOLOAD { $val }";
     goto &$AUTOLOAD;
 }
 
 XSLoader::load 'GDBM_File', $VERSION;
 
-# Preloaded methods go here.  Autoload methods go after __END__, and are
-# processed by the autosplit program.
-
 1;
-__END__
diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
index 3f18a4a28c..9654f7f0ff 100644
--- a/ext/GDBM_File/GDBM_File.xs
+++ b/ext/GDBM_File/GDBM_File.xs
@@ -76,142 +76,212 @@ output_datum(pTHX_ SV *arg, char *str, int size)
 #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
 #endif
 
-static double
-constant(char *name, int arg)
-{
-    errno = 0;
-    switch (*name) {
-    case 'A':
-	break;
-    case 'B':
-	break;
-    case 'C':
-	break;
-    case 'D':
-	break;
-    case 'E':
-	break;
-    case 'F':
-	break;
-    case 'G':
-	if (strEQ(name, "GDBM_CACHESIZE"))
-#ifdef GDBM_CACHESIZE
-	    return GDBM_CACHESIZE;
+#define PERL_constant_NOTFOUND	1
+#define PERL_constant_NOTDEF	2
+#define PERL_constant_ISIV	3
+#define PERL_constant_ISNO	4
+#define PERL_constant_ISNV	5
+#define PERL_constant_ISPV	6
+#define PERL_constant_ISPVN	7
+#define PERL_constant_ISUNDEF	8
+#define PERL_constant_ISUV	9
+#define PERL_constant_ISYES	10
+
+static int
+constant (const char *name, STRLEN len, IV *iv_return) {
+  /* Initially switch on the length of the name.  */
+  /* When generated this function returned values for the list of names given
+     in this section of perl code.  Rather than manually editing these functions
+     to add or remove constants, which would result in this comment and section
+     of code becoming inaccurate, we recommend that you edit this section of
+     code, and use it to regenerate a new set of constant functions which you
+     then use to replace the originals.
+
+     Regenerate these constant functions by feeding this entire source file to
+     perl -x
+
+#!../../perl -w
+use ExtUtils::Constant qw (constant_types C_constant XS_constant);
+
+my $types = {map {($_, 1)} qw(IV)};
+my @names = (qw(GDBM_CACHESIZE GDBM_FAST GDBM_FASTMODE GDBM_INSERT GDBM_NEWDB
+	       GDBM_NOLOCK GDBM_READER GDBM_REPLACE GDBM_WRCREAT GDBM_WRITER));
+
+print constant_types(); # macro defs
+foreach (C_constant ("GDBM_File", 'constant', 'IV', $types, undef, 8, @names) ) {
+    print $_, "\n"; # C constant subs
+}
+print "#### XS Section:\n";
+print XS_constant ("GDBM_File", $types);
+__END__
+   */
+
+  switch (len) {
+  case 9:
+    if (memEQ(name, "GDBM_FAST", 9)) {
+#ifdef GDBM_FAST
+      *iv_return = GDBM_FAST;
+      return PERL_constant_ISIV;
 #else
-	    goto not_there;
+      return PERL_constant_NOTDEF;
 #endif
-	if (strEQ(name, "GDBM_FAST"))
-#ifdef GDBM_FAST
-	    return GDBM_FAST;
+    }
+    break;
+  case 10:
+    if (memEQ(name, "GDBM_NEWDB", 10)) {
+#ifdef GDBM_NEWDB
+      *iv_return = GDBM_NEWDB;
+      return PERL_constant_ISIV;
 #else
-	    goto not_there;
+      return PERL_constant_NOTDEF;
 #endif
-	if (strEQ(name, "GDBM_FASTMODE"))
-#ifdef GDBM_FASTMODE
-	    return GDBM_FASTMODE;
+    }
+    break;
+  case 11:
+    /* Names all of length 11.  */
+    /* GDBM_INSERT GDBM_NOLOCK GDBM_READER GDBM_WRITER */
+    /* Offset 6 gives the best switch position.  */
+    switch (name[6]) {
+    case 'E':
+      if (memEQ(name, "GDBM_READER", 11)) {
+      /*                     ^           */
+#ifdef GDBM_READER
+        *iv_return = GDBM_READER;
+        return PERL_constant_ISIV;
 #else
-	    goto not_there;
+        return PERL_constant_NOTDEF;
 #endif
-	if (strEQ(name, "GDBM_INSERT"))
+      }
+      break;
+    case 'N':
+      if (memEQ(name, "GDBM_INSERT", 11)) {
+      /*                     ^           */
 #ifdef GDBM_INSERT
-	    return GDBM_INSERT;
+        *iv_return = GDBM_INSERT;
+        return PERL_constant_ISIV;
 #else
-	    goto not_there;
+        return PERL_constant_NOTDEF;
 #endif
-	if (strEQ(name, "GDBM_NEWDB"))
-#ifdef GDBM_NEWDB
-	    return GDBM_NEWDB;
+      }
+      break;
+    case 'O':
+      if (memEQ(name, "GDBM_NOLOCK", 11)) {
+      /*                     ^           */
+#ifdef GDBM_NOLOCK
+        *iv_return = GDBM_NOLOCK;
+        return PERL_constant_ISIV;
 #else
-	    goto not_there;
+        return PERL_constant_NOTDEF;
 #endif
-	if (strEQ(name, "GDBM_NOLOCK"))
-#ifdef GDBM_NOLOCK
-	    return GDBM_NOLOCK;
+      }
+      break;
+    case 'R':
+      if (memEQ(name, "GDBM_WRITER", 11)) {
+      /*                     ^           */
+#ifdef GDBM_WRITER
+        *iv_return = GDBM_WRITER;
+        return PERL_constant_ISIV;
 #else
-	    goto not_there;
+        return PERL_constant_NOTDEF;
 #endif
-	if (strEQ(name, "GDBM_READER"))
-#ifdef GDBM_READER
-	    return GDBM_READER;
+      }
+      break;
+    }
+    break;
+  case 12:
+    /* Names all of length 12.  */
+    /* GDBM_REPLACE GDBM_WRCREAT */
+    /* Offset 10 gives the best switch position.  */
+    switch (name[10]) {
+    case 'A':
+      if (memEQ(name, "GDBM_WRCREAT", 12)) {
+      /*                         ^        */
+#ifdef GDBM_WRCREAT
+        *iv_return = GDBM_WRCREAT;
+        return PERL_constant_ISIV;
 #else
-	    goto not_there;
+        return PERL_constant_NOTDEF;
 #endif
-	if (strEQ(name, "GDBM_REPLACE"))
+      }
+      break;
+    case 'C':
+      if (memEQ(name, "GDBM_REPLACE", 12)) {
+      /*                         ^        */
 #ifdef GDBM_REPLACE
-	    return GDBM_REPLACE;
+        *iv_return = GDBM_REPLACE;
+        return PERL_constant_ISIV;
 #else
-	    goto not_there;
+        return PERL_constant_NOTDEF;
 #endif
-	if (strEQ(name, "GDBM_WRCREAT"))
-#ifdef GDBM_WRCREAT
-	    return GDBM_WRCREAT;
+      }
+      break;
+    }
+    break;
+  case 13:
+    if (memEQ(name, "GDBM_FASTMODE", 13)) {
+#ifdef GDBM_FASTMODE
+      *iv_return = GDBM_FASTMODE;
+      return PERL_constant_ISIV;
 #else
-	    goto not_there;
+      return PERL_constant_NOTDEF;
 #endif
-	if (strEQ(name, "GDBM_WRITER"))
-#ifdef GDBM_WRITER
-	    return GDBM_WRITER;
+    }
+    break;
+  case 14:
+    if (memEQ(name, "GDBM_CACHESIZE", 14)) {
+#ifdef GDBM_CACHESIZE
+      *iv_return = GDBM_CACHESIZE;
+      return PERL_constant_ISIV;
 #else
-	    goto not_there;
+      return PERL_constant_NOTDEF;
 #endif
-	break;
-    case 'H':
-	break;
-    case 'I':
-	break;
-    case 'J':
-	break;
-    case 'K':
-	break;
-    case 'L':
-	break;
-    case 'M':
-	break;
-    case 'N':
-	break;
-    case 'O':
-	break;
-    case 'P':
-	break;
-    case 'Q':
-	break;
-    case 'R':
-	break;
-    case 'S':
-	break;
-    case 'T':
-	break;
-    case 'U':
-	break;
-    case 'V':
-	break;
-    case 'W':
-	break;
-    case 'X':
-	break;
-    case 'Y':
-	break;
-    case 'Z':
-	break;
     }
-    errno = EINVAL;
-    return 0;
-
-    if (0) {
-        goto not_there; /* -Wall */
-    }
-
-not_there:
-    errno = ENOENT;
-    return 0;
+    break;
+  }
+  return PERL_constant_NOTFOUND;
 }
 
 MODULE = GDBM_File	PACKAGE = GDBM_File	PREFIX = gdbm_
 
-double
-constant(name,arg)
-	char *		name
-	int		arg
+void
+constant(sv)
+    PREINIT:
+	dXSTARG;
+	STRLEN		len;
+        int		type;
+	IV		iv;
+	/* NV		nv;	Uncomment this if you need to return NVs */
+	/* const char	*pv;	Uncomment this if you need to return PVs */
+    INPUT:
+	SV *		sv;
+        const char *	s = SvPV(sv, len);
+    PPCODE:
+        /* Change this to constant(s, len, &iv, &nv);
+           if you need to return both NVs and IVs */
+	type = constant(s, len, &iv);
+      /* Return 1 or 2 items. First is error message, or undef if no error.
+           Second, if present, is found value */
+        switch (type) {
+        case PERL_constant_NOTFOUND:
+          sv = sv_2mortal(newSVpvf("%s is not a valid GDBM_File macro", s));
+          PUSHs(sv);
+          break;
+        case PERL_constant_NOTDEF:
+          sv = sv_2mortal(newSVpvf(
+	    "Your vendor has not defined GDBM_File macro %s, used", s));
+          PUSHs(sv);
+          break;
+        case PERL_constant_ISIV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHi(iv);
+          break;
+        default:
+          sv = sv_2mortal(newSVpvf(
+	    "Unexpected return type %d while processing GDBM_File macro %s, used",
+               type, s));
+          PUSHs(sv);
+        }
 
 
 GDBM_File