Re: perl@10611

Message-ID: <20010616165247.O98663@plum.flirble.org>

The .xs parts, too.

p4raw-id: //depot/perl@10633

1 files changed, 2 insertions, 204 deletions

diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
index 9654f7f0ff..ffdc41b14c 100644
--- a/ext/GDBM_File/GDBM_File.xs
+++ b/ext/GDBM_File/GDBM_File.xs
@@ -76,213 +76,11 @@ output_datum(pTHX_ SV *arg, char *str, int size)
 #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
 #endif
 
-#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
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 10:
-    if (memEQ(name, "GDBM_NEWDB", 10)) {
-#ifdef GDBM_NEWDB
-      *iv_return = GDBM_NEWDB;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    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
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'N':
-      if (memEQ(name, "GDBM_INSERT", 11)) {
-      /*                     ^           */
-#ifdef GDBM_INSERT
-        *iv_return = GDBM_INSERT;
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'O':
-      if (memEQ(name, "GDBM_NOLOCK", 11)) {
-      /*                     ^           */
-#ifdef GDBM_NOLOCK
-        *iv_return = GDBM_NOLOCK;
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'R':
-      if (memEQ(name, "GDBM_WRITER", 11)) {
-      /*                     ^           */
-#ifdef GDBM_WRITER
-        *iv_return = GDBM_WRITER;
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      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
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'C':
-      if (memEQ(name, "GDBM_REPLACE", 12)) {
-      /*                         ^        */
-#ifdef GDBM_REPLACE
-        *iv_return = GDBM_REPLACE;
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    }
-    break;
-  case 13:
-    if (memEQ(name, "GDBM_FASTMODE", 13)) {
-#ifdef GDBM_FASTMODE
-      *iv_return = GDBM_FASTMODE;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 14:
-    if (memEQ(name, "GDBM_CACHESIZE", 14)) {
-#ifdef GDBM_CACHESIZE
-      *iv_return = GDBM_CACHESIZE;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  }
-  return PERL_constant_NOTFOUND;
-}
+#include "constants.c"
 
 MODULE = GDBM_File	PACKAGE = GDBM_File	PREFIX = gdbm_
 
-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);
-        }
-
+INCLUDE: constants.xs
 
 GDBM_File
 gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)