From: Nicholas Clark Date: Sun, 17 Jun 2001 00:16:05 +0000 (+0100) Subject: Re: [PATCH] Re: perl@10611 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=72f7b9a1041f8cd00a817b387850fef64f11d90e;p=p5sagit%2Fp5-mst-13.2.git Re: [PATCH] Re: perl@10611 Message-ID: <20010617001605.V98663@plum.flirble.org> p4raw-id: //depot/perl@10648 --- diff --git a/ext/Fcntl/Fcntl.xs b/ext/Fcntl/Fcntl.xs index bac741c..9f167d0 100644 --- a/ext/Fcntl/Fcntl.xs +++ b/ext/Fcntl/Fcntl.xs @@ -33,1407 +33,8 @@ --AD October 16, 1995 */ -#define PERL_constant_NOTFOUND 1 -#define PERL_constant_NOTDEF 2 -#define PERL_constant_ISIV 3 -#define PERL_constant_ISNV 4 -#define PERL_constant_ISPV 5 -#define PERL_constant_ISPVN 6 -#define PERL_constant_ISUV 7 - -#ifndef NVTYPE -typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */ -#endif - -static int -constant_5 (const char *name, IV *iv_return) { - /* Names all of length 5. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - FEXCL FSYNC O_RAW */ - /* Offset 2 gives the best switch position. */ - switch (name[2]) { - case 'R': - if (memEQ(name, "O_RAW", 5)) { - /* ^ */ -#ifdef O_RAW - *iv_return = O_RAW; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'X': - if (memEQ(name, "FEXCL", 5)) { - /* ^ */ -#ifdef FEXCL - *iv_return = FEXCL; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'Y': - if (memEQ(name, "FSYNC", 5)) { - /* ^ */ -#ifdef FSYNC - *iv_return = FSYNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_6 (const char *name, IV *iv_return) { - /* Names all of length 6. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - FASYNC FCREAT FDEFER FDSYNC FRSYNC FTRUNC O_EXCL O_RDWR O_RSRC O_SYNC - O_TEXT */ - /* Offset 3 gives the best switch position. */ - switch (name[3]) { - case 'D': - if (memEQ(name, "O_RDWR", 6)) { - /* ^ */ -#ifdef O_RDWR - *iv_return = O_RDWR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'E': - if (memEQ(name, "FCREAT", 6)) { - /* ^ */ -#ifdef FCREAT - *iv_return = FCREAT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "O_TEXT", 6)) { - /* ^ */ -#ifdef O_TEXT - *iv_return = O_TEXT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'F': - if (memEQ(name, "FDEFER", 6)) { - /* ^ */ -#ifdef FDEFER - *iv_return = FDEFER; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "O_RSRC", 6)) { - /* ^ */ -#ifdef O_RSRC - *iv_return = O_RSRC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'U': - if (memEQ(name, "FTRUNC", 6)) { - /* ^ */ -#ifdef FTRUNC - *iv_return = FTRUNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'X': - if (memEQ(name, "O_EXCL", 6)) { - /* ^ */ -#ifdef O_EXCL - *iv_return = O_EXCL; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'Y': - if (memEQ(name, "FASYNC", 6)) { - /* ^ */ -#ifdef FASYNC - *iv_return = FASYNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "FDSYNC", 6)) { - /* ^ */ -#ifdef FDSYNC - *iv_return = FDSYNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "FRSYNC", 6)) { - /* ^ */ -#ifdef FRSYNC - *iv_return = FRSYNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "O_SYNC", 6)) { - /* ^ */ -#ifdef O_SYNC - *iv_return = O_SYNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_7 (const char *name, IV *iv_return) { - /* Names all of length 7. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - FAPPEND FNDELAY F_DUPFD F_EXLCK F_FSYNC F_GETFD F_GETFL F_GETLK F_NODNY - F_POSIX F_RDACC F_RDDNY F_RDLCK F_RWACC F_RWDNY F_SETFD F_SETFL F_SETLK - F_SHARE F_SHLCK F_UNLCK F_WRACC F_WRDNY F_WRLCK LOCK_EX LOCK_NB LOCK_SH - LOCK_UN O_ALIAS O_ASYNC O_CREAT O_DEFER O_DSYNC O_RSYNC O_TRUNC S_ENFMT - S_IEXEC S_IFBLK S_IFCHR S_IFDIR S_IFIFO S_IFLNK S_IFREG S_IFWHT S_IREAD - S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISTXT S_ISUID - S_ISVTX S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR _S_IFMT */ - /* Offset 4 gives the best switch position. */ - switch (name[4]) { - case 'A': - if (memEQ(name, "F_RDACC", 7)) { - /* ^ */ -#ifdef F_RDACC - *iv_return = F_RDACC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_RWACC", 7)) { - /* ^ */ -#ifdef F_RWACC - *iv_return = F_RWACC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_SHARE", 7)) { - /* ^ */ -#ifdef F_SHARE - *iv_return = F_SHARE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_WRACC", 7)) { - /* ^ */ -#ifdef F_WRACC - *iv_return = F_WRACC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'B': - if (memEQ(name, "S_IFBLK", 7)) { - /* ^ */ -#ifdef S_IFBLK - *iv_return = S_IFBLK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'C': - if (memEQ(name, "S_IFCHR", 7)) { - /* ^ */ -#ifdef S_IFCHR - *iv_return = S_IFCHR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'D': - if (memEQ(name, "F_NODNY", 7)) { - /* ^ */ -#ifdef F_NODNY - *iv_return = F_NODNY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_RDDNY", 7)) { - /* ^ */ -#ifdef F_RDDNY - *iv_return = F_RDDNY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_RWDNY", 7)) { - /* ^ */ -#ifdef F_RWDNY - *iv_return = F_RWDNY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_WRDNY", 7)) { - /* ^ */ -#ifdef F_WRDNY - *iv_return = F_WRDNY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IFDIR", 7)) { - /* ^ */ -#ifdef S_IFDIR - *iv_return = S_IFDIR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'E': - if (memEQ(name, "FAPPEND", 7)) { - /* ^ */ -#ifdef FAPPEND - *iv_return = FAPPEND; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "O_CREAT", 7)) { - /* ^ */ -#ifdef O_CREAT - *iv_return = O_CREAT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IREAD", 7)) { - /* ^ */ -#ifdef S_IREAD - *iv_return = S_IREAD; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'F': - if (memEQ(name, "O_DEFER", 7)) { - /* ^ */ -#ifdef O_DEFER - *iv_return = O_DEFER; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_ENFMT", 7)) { - /* ^ */ -#ifdef S_ENFMT - *iv_return = S_ENFMT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "_S_IFMT", 7)) { - /* ^ */ -#ifdef S_IFMT - *iv_return = S_IFMT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'G': - if (memEQ(name, "S_IRGRP", 7)) { - /* ^ */ -#ifdef S_IRGRP - *iv_return = S_IRGRP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_ISGID", 7)) { - /* ^ */ -#ifdef S_ISGID - *iv_return = S_ISGID; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IWGRP", 7)) { - /* ^ */ -#ifdef S_IWGRP - *iv_return = S_IWGRP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IXGRP", 7)) { - /* ^ */ -#ifdef S_IXGRP - *iv_return = S_IXGRP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'I': - if (memEQ(name, "O_ALIAS", 7)) { - /* ^ */ -#ifdef O_ALIAS - *iv_return = O_ALIAS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IFIFO", 7)) { - /* ^ */ -#ifdef S_IFIFO - *iv_return = S_IFIFO; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'L': - if (memEQ(name, "FNDELAY", 7)) { - /* ^ */ -#ifdef FNDELAY - *iv_return = FNDELAY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_EXLCK", 7)) { - /* ^ */ -#ifdef F_EXLCK - *iv_return = F_EXLCK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_RDLCK", 7)) { - /* ^ */ -#ifdef F_RDLCK - *iv_return = F_RDLCK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_SHLCK", 7)) { - /* ^ */ -#ifdef F_SHLCK - *iv_return = F_SHLCK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_UNLCK", 7)) { - /* ^ */ -#ifdef F_UNLCK - *iv_return = F_UNLCK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_WRLCK", 7)) { - /* ^ */ -#ifdef F_WRLCK - *iv_return = F_WRLCK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IFLNK", 7)) { - /* ^ */ -#ifdef S_IFLNK - *iv_return = S_IFLNK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "S_IROTH", 7)) { - /* ^ */ -#ifdef S_IROTH - *iv_return = S_IROTH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IWOTH", 7)) { - /* ^ */ -#ifdef S_IWOTH - *iv_return = S_IWOTH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IXOTH", 7)) { - /* ^ */ -#ifdef S_IXOTH - *iv_return = S_IXOTH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "F_DUPFD", 7)) { - /* ^ */ -#ifdef F_DUPFD - *iv_return = F_DUPFD; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'R': - if (memEQ(name, "S_IFREG", 7)) { - /* ^ */ -#ifdef S_IFREG - *iv_return = S_IFREG; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "F_POSIX", 7)) { - /* ^ */ -#ifdef F_POSIX - *iv_return = F_POSIX; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'T': - if (memEQ(name, "F_GETFD", 7)) { - /* ^ */ -#ifdef F_GETFD - *iv_return = F_GETFD; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_GETFL", 7)) { - /* ^ */ -#ifdef F_GETFL - *iv_return = F_GETFL; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_GETLK", 7)) { - /* ^ */ -#ifdef F_GETLK - *iv_return = F_GETLK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_SETFD", 7)) { - /* ^ */ -#ifdef F_SETFD - *iv_return = F_SETFD; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_SETFL", 7)) { - /* ^ */ -#ifdef F_SETFL - *iv_return = F_SETFL; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_SETLK", 7)) { - /* ^ */ -#ifdef F_SETLK - *iv_return = F_SETLK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_ISTXT", 7)) { - /* ^ */ -#ifdef S_ISTXT - *iv_return = S_ISTXT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'U': - if (memEQ(name, "O_TRUNC", 7)) { - /* ^ */ -#ifdef O_TRUNC - *iv_return = O_TRUNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IRUSR", 7)) { - /* ^ */ -#ifdef S_IRUSR - *iv_return = S_IRUSR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_ISUID", 7)) { - /* ^ */ -#ifdef S_ISUID - *iv_return = S_ISUID; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IWUSR", 7)) { - /* ^ */ -#ifdef S_IWUSR - *iv_return = S_IWUSR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IXUSR", 7)) { - /* ^ */ -#ifdef S_IXUSR - *iv_return = S_IXUSR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'V': - if (memEQ(name, "S_ISVTX", 7)) { - /* ^ */ -#ifdef S_ISVTX - *iv_return = S_ISVTX; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'W': - if (memEQ(name, "S_IFWHT", 7)) { - /* ^ */ -#ifdef S_IFWHT - *iv_return = S_IFWHT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IRWXG", 7)) { - /* ^ */ -#ifdef S_IRWXG - *iv_return = S_IRWXG; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IRWXO", 7)) { - /* ^ */ -#ifdef S_IRWXO - *iv_return = S_IRWXO; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "S_IRWXU", 7)) { - /* ^ */ -#ifdef S_IRWXU - *iv_return = S_IRWXU; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'X': - if (memEQ(name, "S_IEXEC", 7)) { - /* ^ */ -#ifdef S_IEXEC - *iv_return = S_IEXEC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'Y': - if (memEQ(name, "F_FSYNC", 7)) { - /* ^ */ -#ifdef F_FSYNC - *iv_return = F_FSYNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "O_ASYNC", 7)) { - /* ^ */ -#ifdef O_ASYNC - *iv_return = O_ASYNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "O_DSYNC", 7)) { - /* ^ */ -#ifdef O_DSYNC - *iv_return = O_DSYNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "O_RSYNC", 7)) { - /* ^ */ -#ifdef O_RSYNC - *iv_return = O_RSYNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case '_': - if (memEQ(name, "LOCK_EX", 7)) { - /* ^ */ -#ifdef LOCK_EX - *iv_return = LOCK_EX; - return PERL_constant_ISIV; -#else - *iv_return = 2; - return PERL_constant_ISIV; -#endif - } - if (memEQ(name, "LOCK_NB", 7)) { - /* ^ */ -#ifdef LOCK_NB - *iv_return = LOCK_NB; - return PERL_constant_ISIV; -#else - *iv_return = 4; - return PERL_constant_ISIV; -#endif - } - if (memEQ(name, "LOCK_SH", 7)) { - /* ^ */ -#ifdef LOCK_SH - *iv_return = LOCK_SH; - return PERL_constant_ISIV; -#else - *iv_return = 1; - return PERL_constant_ISIV; -#endif - } - if (memEQ(name, "LOCK_UN", 7)) { - /* ^ */ -#ifdef LOCK_UN - *iv_return = LOCK_UN; - return PERL_constant_ISIV; -#else - *iv_return = 8; - return PERL_constant_ISIV; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_8 (const char *name, IV *iv_return) { - /* Names all of length 8. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - F_COMPAT F_DUP2FD F_FREESP F_GETOWN F_SETLKW F_SETOWN O_APPEND O_BINARY - O_DIRECT O_EXLOCK O_NDELAY O_NOCTTY O_RANDOM O_RDONLY O_SHLOCK O_WRONLY - SEEK_CUR SEEK_END SEEK_SET S_IFSOCK S_IWRITE */ - /* Offset 3 gives the best switch position. */ - switch (name[3]) { - case 'A': - if (memEQ(name, "O_RANDOM", 8)) { - /* ^ */ -#ifdef O_RANDOM - *iv_return = O_RANDOM; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'D': - if (memEQ(name, "O_NDELAY", 8)) { - /* ^ */ -#ifdef O_NDELAY - *iv_return = O_NDELAY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "O_RDONLY", 8)) { - /* ^ */ -#ifdef O_RDONLY - *iv_return = O_RDONLY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'E': - if (memEQ(name, "F_GETOWN", 8)) { - /* ^ */ -#ifdef F_GETOWN - *iv_return = F_GETOWN; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_SETLKW", 8)) { - /* ^ */ -#ifdef F_SETLKW - *iv_return = F_SETLKW; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "F_SETOWN", 8)) { - /* ^ */ -#ifdef F_SETOWN - *iv_return = F_SETOWN; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'F': - if (memEQ(name, "S_IFSOCK", 8)) { - /* ^ */ -#ifdef S_IFSOCK - *iv_return = S_IFSOCK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'H': - if (memEQ(name, "O_SHLOCK", 8)) { - /* ^ */ -#ifdef O_SHLOCK - *iv_return = O_SHLOCK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'I': - if (memEQ(name, "O_BINARY", 8)) { - /* ^ */ -#ifdef O_BINARY - *iv_return = O_BINARY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "O_DIRECT", 8)) { - /* ^ */ -#ifdef O_DIRECT - *iv_return = O_DIRECT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'K': - if (memEQ(name, "SEEK_CUR", 8)) { - /* ^ */ -#ifdef SEEK_CUR - *iv_return = SEEK_CUR; - return PERL_constant_ISIV; -#else - *iv_return = 1; - return PERL_constant_ISIV; -#endif - } - if (memEQ(name, "SEEK_END", 8)) { - /* ^ */ -#ifdef SEEK_END - *iv_return = SEEK_END; - return PERL_constant_ISIV; -#else - *iv_return = 2; - return PERL_constant_ISIV; -#endif - } - if (memEQ(name, "SEEK_SET", 8)) { - /* ^ */ -#ifdef SEEK_SET - *iv_return = SEEK_SET; - return PERL_constant_ISIV; -#else - *iv_return = 0; - return PERL_constant_ISIV; -#endif - } - break; - case 'O': - if (memEQ(name, "F_COMPAT", 8)) { - /* ^ */ -#ifdef F_COMPAT - *iv_return = F_COMPAT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "O_NOCTTY", 8)) { - /* ^ */ -#ifdef O_NOCTTY - *iv_return = O_NOCTTY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "O_APPEND", 8)) { - /* ^ */ -#ifdef O_APPEND - *iv_return = O_APPEND; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'R': - if (memEQ(name, "F_FREESP", 8)) { - /* ^ */ -#ifdef F_FREESP - *iv_return = F_FREESP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "O_WRONLY", 8)) { - /* ^ */ -#ifdef O_WRONLY - *iv_return = O_WRONLY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'U': - if (memEQ(name, "F_DUP2FD", 8)) { - /* ^ */ -#ifdef F_DUP2FD - *iv_return = F_DUP2FD; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'W': - if (memEQ(name, "S_IWRITE", 8)) { - /* ^ */ -#ifdef S_IWRITE - *iv_return = S_IWRITE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'X': - if (memEQ(name, "O_EXLOCK", 8)) { - /* ^ */ -#ifdef O_EXLOCK - *iv_return = O_EXLOCK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_9 (const char *name, IV *iv_return) { - /* Names all of length 9. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - FNONBLOCK F_ALLOCSP F_FSYNC64 F_GETLK64 F_SETLK64 F_UNSHARE O_ACCMODE */ - /* Offset 2 gives the best switch position. */ - switch (name[2]) { - case 'A': - if (memEQ(name, "F_ALLOCSP", 9)) { - /* ^ */ -#ifdef F_ALLOCSP - *iv_return = F_ALLOCSP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "O_ACCMODE", 9)) { - /* ^ */ -#ifdef O_ACCMODE - *iv_return = O_ACCMODE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'F': - if (memEQ(name, "F_FSYNC64", 9)) { - /* ^ */ -#ifdef F_FSYNC64 - *iv_return = F_FSYNC64; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'G': - if (memEQ(name, "F_GETLK64", 9)) { - /* ^ */ -#ifdef F_GETLK64 - *iv_return = F_GETLK64; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "FNONBLOCK", 9)) { - /* ^ */ -#ifdef FNONBLOCK - *iv_return = FNONBLOCK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "F_SETLK64", 9)) { - /* ^ */ -#ifdef F_SETLK64 - *iv_return = F_SETLK64; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'U': - if (memEQ(name, "F_UNSHARE", 9)) { - /* ^ */ -#ifdef F_UNSHARE - *iv_return = F_UNSHARE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_10 (const char *name, IV *iv_return) { - /* Names all of length 10. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - FD_CLOEXEC FLARGEFILE F_FREESP64 F_SETLKW64 O_NOFOLLOW O_NONBLOCK */ - /* Offset 4 gives the best switch position. */ - switch (name[4]) { - case 'E': - if (memEQ(name, "F_FREESP64", 10)) { - /* ^ */ -#ifdef F_FREESP64 - *iv_return = F_FREESP64; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'F': - if (memEQ(name, "O_NOFOLLOW", 10)) { - /* ^ */ -#ifdef O_NOFOLLOW - *iv_return = O_NOFOLLOW; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'G': - if (memEQ(name, "FLARGEFILE", 10)) { - /* ^ */ -#ifdef FLARGEFILE - *iv_return = FLARGEFILE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'L': - if (memEQ(name, "FD_CLOEXEC", 10)) { - /* ^ */ -#ifdef FD_CLOEXEC - *iv_return = FD_CLOEXEC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "O_NONBLOCK", 10)) { - /* ^ */ -#ifdef O_NONBLOCK - *iv_return = O_NONBLOCK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'T': - if (memEQ(name, "F_SETLKW64", 10)) { - /* ^ */ -#ifdef F_SETLKW64 - *iv_return = F_SETLKW64; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_11 (const char *name, IV *iv_return) { - /* Names all of length 11. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - F_ALLOCSP64 O_DIRECTORY O_LARGEFILE O_NOINHERIT O_TEMPORARY */ - /* Offset 5 gives the best switch position. */ - switch (name[5]) { - case 'E': - if (memEQ(name, "O_DIRECTORY", 11)) { - /* ^ */ -#ifdef O_DIRECTORY - *iv_return = O_DIRECTORY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'G': - if (memEQ(name, "O_LARGEFILE", 11)) { - /* ^ */ -#ifdef O_LARGEFILE - *iv_return = O_LARGEFILE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "O_NOINHERIT", 11)) { - /* ^ */ -#ifdef O_NOINHERIT - *iv_return = O_NOINHERIT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "F_ALLOCSP64", 11)) { - /* ^ */ -#ifdef F_ALLOCSP64 - *iv_return = F_ALLOCSP64; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "O_TEMPORARY", 11)) { - /* ^ */ -#ifdef O_TEMPORARY - *iv_return = O_TEMPORARY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -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 = {IV => 1}; -my @names = (qw(FAPPEND FASYNC FCREAT FDEFER FDSYNC FD_CLOEXEC FEXCL FLARGEFILE - FNDELAY FNONBLOCK FRSYNC FSYNC FTRUNC F_ALLOCSP F_ALLOCSP64 - F_COMPAT F_DUP2FD F_DUPFD F_EXLCK F_FREESP F_FREESP64 F_FSYNC - F_FSYNC64 F_GETFD F_GETFL F_GETLK F_GETLK64 F_GETOWN F_NODNY - F_POSIX F_RDACC F_RDDNY F_RDLCK F_RWACC F_RWDNY F_SETFD F_SETFL - F_SETLK F_SETLK64 F_SETLKW F_SETLKW64 F_SETOWN F_SHARE F_SHLCK - F_UNLCK F_UNSHARE F_WRACC F_WRDNY F_WRLCK O_ACCMODE O_ALIAS - O_APPEND O_ASYNC O_BINARY O_CREAT O_DEFER O_DIRECT O_DIRECTORY - O_DSYNC O_EXCL O_EXLOCK O_LARGEFILE O_NDELAY O_NOCTTY O_NOFOLLOW - O_NOINHERIT O_NONBLOCK O_RANDOM O_RAW O_RDONLY O_RDWR O_RSRC - O_RSYNC O_SEQUENTIAL O_SHLOCK O_SYNC O_TEMPORARY O_TEXT O_TRUNC - O_WRONLY S_ENFMT S_IEXEC S_IFBLK S_IFCHR S_IFDIR S_IFIFO S_IFLNK - S_IFREG S_IFSOCK S_IFWHT S_IREAD S_IRGRP S_IROTH S_IRUSR S_IRWXG - S_IRWXO S_IRWXU S_ISGID S_ISTXT S_ISUID S_ISVTX S_IWGRP S_IWOTH - S_IWRITE S_IWUSR S_IXGRP S_IXOTH S_IXUSR), - {name=>"LOCK_EX", type=>"IV", default=>["IV", "2"]}, - {name=>"LOCK_NB", type=>"IV", default=>["IV", "4"]}, - {name=>"LOCK_SH", type=>"IV", default=>["IV", "1"]}, - {name=>"LOCK_UN", type=>"IV", default=>["IV", "8"]}, - {name=>"SEEK_CUR", type=>"IV", default=>["IV", "1"]}, - {name=>"SEEK_END", type=>"IV", default=>["IV", "2"]}, - {name=>"SEEK_SET", type=>"IV", default=>["IV", "0"]}, - {name=>"_S_IFMT", type=>"IV", macro=>"S_IFMT", value=>"S_IFMT"}); - -print constant_types(); # macro defs -foreach (C_constant ("Fcntl", 'constant', 'IV', $types, undef, undef, @names) ) { - print $_, "\n"; # C constant subs -} -print "#### XS Section:\n"; -print XS_constant ("Fcntl", $types); -__END__ - */ - - switch (len) { - case 5: - return constant_5 (name, iv_return); - break; - case 6: - return constant_6 (name, iv_return); - break; - case 7: - return constant_7 (name, iv_return); - break; - case 8: - return constant_8 (name, iv_return); - break; - case 9: - return constant_9 (name, iv_return); - break; - case 10: - return constant_10 (name, iv_return); - break; - case 11: - return constant_11 (name, iv_return); - break; - case 12: - if (memEQ(name, "O_SEQUENTIAL", 12)) { -#ifdef O_SEQUENTIAL - *iv_return = O_SEQUENTIAL; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} +#include "constants.c" MODULE = Fcntl PACKAGE = Fcntl -void -constant(sv) - PREINIT: -#ifdef dXSTARG - dXSTARG; /* Faster if we have it. */ -#else - dTARGET; -#endif - 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 Fcntl macro", s)); - PUSHs(sv); - break; - case PERL_constant_NOTDEF: - sv = sv_2mortal(newSVpvf( - "Your vendor has not defined Fcntl macro %s, used", s)); - PUSHs(sv); - break; - case PERL_constant_ISIV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHi(iv); - break; - /* Uncomment this if you need to return UVs - case PERL_constant_ISUV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHu((UV)iv); - break; */ - default: - sv = sv_2mortal(newSVpvf( - "Unexpected return type %d while processing Fcntl macro %s used", - type, s)); - PUSHs(sv); - } +INCLUDE: constants.xs \ No newline at end of file diff --git a/ext/Fcntl/Makefile.PL b/ext/Fcntl/Makefile.PL index 0346373..030c8b4 100644 --- a/ext/Fcntl/Makefile.PL +++ b/ext/Fcntl/Makefile.PL @@ -1,8 +1,37 @@ use ExtUtils::MakeMaker; +use ExtUtils::Constant 0.07 'WriteConstants'; WriteMakefile( NAME => 'Fcntl', MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'Fcntl.pm', + realclean => {FILES=> 'constants.c constants.xs'}, ); +my @names = (qw(FAPPEND FASYNC FCREAT FDEFER FDSYNC FD_CLOEXEC FEXCL FLARGEFILE + FNDELAY FNONBLOCK FRSYNC FSYNC FTRUNC F_ALLOCSP F_ALLOCSP64 + F_COMPAT F_DUP2FD F_DUPFD F_EXLCK F_FREESP F_FREESP64 F_FSYNC + F_FSYNC64 F_GETFD F_GETFL F_GETLK F_GETLK64 F_GETOWN F_NODNY + F_POSIX F_RDACC F_RDDNY F_RDLCK F_RWACC F_RWDNY F_SETFD F_SETFL + F_SETLK F_SETLK64 F_SETLKW F_SETLKW64 F_SETOWN F_SHARE F_SHLCK + F_UNLCK F_UNSHARE F_WRACC F_WRDNY F_WRLCK O_ACCMODE O_ALIAS + O_APPEND O_ASYNC O_BINARY O_CREAT O_DEFER O_DIRECT O_DIRECTORY + O_DSYNC O_EXCL O_EXLOCK O_LARGEFILE O_NDELAY O_NOCTTY O_NOFOLLOW + O_NOINHERIT O_NONBLOCK O_RANDOM O_RAW O_RDONLY O_RDWR O_RSRC + O_RSYNC O_SEQUENTIAL O_SHLOCK O_SYNC O_TEMPORARY O_TEXT O_TRUNC + O_WRONLY S_ENFMT S_IEXEC S_IFBLK S_IFCHR S_IFDIR S_IFIFO S_IFLNK + S_IFREG S_IFSOCK S_IFWHT S_IREAD S_IRGRP S_IROTH S_IRUSR S_IRWXG + S_IRWXO S_IRWXU S_ISGID S_ISTXT S_ISUID S_ISVTX S_IWGRP S_IWOTH + S_IWRITE S_IWUSR S_IXGRP S_IXOTH S_IXUSR), + {name=>"LOCK_SH", default=>["IV", "1"]}, + {name=>"LOCK_EX", default=>["IV", "2"]}, + {name=>"LOCK_NB", default=>["IV", "4"]}, + {name=>"LOCK_UN", default=>["IV", "8"]}, + {name=>"SEEK_SET", default=>["IV", "0"]}, + {name=>"SEEK_CUR", default=>["IV", "1"]}, + {name=>"SEEK_END", default=>["IV", "2"]}, + {name=>"_S_IFMT", macro=>"S_IFMT", value=>"S_IFMT"}); +WriteConstants( + NAME => 'Fcntl', + NAMES => \@names, +); diff --git a/ext/File/Glob/Glob.pm b/ext/File/Glob/Glob.pm index 78a8fb4..cad8131 100644 --- a/ext/File/Glob/Glob.pm +++ b/ext/File/Glob/Glob.pm @@ -6,7 +6,7 @@ our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, use XSLoader (); -@ISA = qw(Exporter AutoLoader); +@ISA = qw(Exporter); # NOTE: The glob() export is only here for compatibility with 5.6.0. # csh_glob() should not be used directly, unless you know what you're doing. @@ -56,7 +56,7 @@ use XSLoader (); ) ], ); -$VERSION = '1.0'; +$VERSION = '1.01'; sub import { require Exporter; @@ -84,17 +84,10 @@ sub AUTOLOAD { my $constname; ($constname = $AUTOLOAD) =~ s/.*:://; - my $val = constant($constname, @_ ? $_[0] : 0); - if ($! != 0) { - if ($! =~ /Invalid/ || $!{EINVAL}) { - require AutoLoader; - $AutoLoader::AUTOLOAD = $AUTOLOAD; - goto &AutoLoader::AUTOLOAD; - } - else { - require Carp; - Carp::croak("Your vendor has not defined File::Glob macro $constname"); - } + my ($error, $val) = constant($constname); + if ($error) { + require Carp; + Carp::croak($error); } eval "sub $AUTOLOAD { $val }"; goto &$AUTOLOAD; @@ -105,7 +98,7 @@ XSLoader::load 'File::Glob', $VERSION; # Preloaded methods go here. sub GLOB_ERROR { - return constant('GLOB_ERROR', 0); + return (constant('GLOB_ERROR'))[1]; } sub GLOB_CSH () { diff --git a/ext/File/Glob/Glob.xs b/ext/File/Glob/Glob.xs index ce03ef8..85ddf02 100644 --- a/ext/File/Glob/Glob.xs +++ b/ext/File/Glob/Glob.xs @@ -7,159 +7,7 @@ /* XXX: need some thread awareness */ static int GLOB_ERROR = 0; -static double -constant(char *name, int arg) -{ - errno = 0; - if (strlen(name) <= 5) - goto not_there; - switch (*(name+5)) { - case 'A': - if (strEQ(name, "GLOB_ABEND")) -#ifdef GLOB_ABEND - return GLOB_ABEND; -#else - goto not_there; -#endif - if (strEQ(name, "GLOB_ALPHASORT")) -#ifdef GLOB_ALPHASORT - return GLOB_ALPHASORT; -#else - goto not_there; -#endif - if (strEQ(name, "GLOB_ALTDIRFUNC")) -#ifdef GLOB_ALTDIRFUNC - return GLOB_ALTDIRFUNC; -#else - goto not_there; -#endif - break; - case 'B': - if (strEQ(name, "GLOB_BRACE")) -#ifdef GLOB_BRACE - return GLOB_BRACE; -#else - goto not_there; -#endif - break; - case 'C': - break; - case 'D': - break; - case 'E': - if (strEQ(name, "GLOB_ERR")) -#ifdef GLOB_ERR - return GLOB_ERR; -#else - goto not_there; -#endif - if (strEQ(name, "GLOB_ERROR")) - return GLOB_ERROR; - break; - case 'F': - break; - case 'G': - break; - case 'H': - break; - case 'I': - break; - case 'J': - break; - case 'K': - break; - case 'L': - if (strEQ(name, "GLOB_LIMIT")) -#ifdef GLOB_LIMIT - return GLOB_LIMIT; -#else - goto not_there; -#endif - break; - case 'M': - if (strEQ(name, "GLOB_MARK")) -#ifdef GLOB_MARK - return GLOB_MARK; -#else - goto not_there; -#endif - break; - case 'N': - if (strEQ(name, "GLOB_NOCASE")) -#ifdef GLOB_NOCASE - return GLOB_NOCASE; -#else - goto not_there; -#endif - if (strEQ(name, "GLOB_NOCHECK")) -#ifdef GLOB_NOCHECK - return GLOB_NOCHECK; -#else - goto not_there; -#endif - if (strEQ(name, "GLOB_NOMAGIC")) -#ifdef GLOB_NOMAGIC - return GLOB_NOMAGIC; -#else - goto not_there; -#endif - if (strEQ(name, "GLOB_NOSORT")) -#ifdef GLOB_NOSORT - return GLOB_NOSORT; -#else - goto not_there; -#endif - if (strEQ(name, "GLOB_NOSPACE")) -#ifdef GLOB_NOSPACE - return GLOB_NOSPACE; -#else - goto not_there; -#endif - break; - case 'O': - break; - case 'P': - break; - case 'Q': - if (strEQ(name, "GLOB_QUOTE")) -#ifdef GLOB_QUOTE - return GLOB_QUOTE; -#else - goto not_there; -#endif - break; - case 'R': - break; - case 'S': - break; - case 'T': - if (strEQ(name, "GLOB_TILDE")) -#ifdef GLOB_TILDE - return GLOB_TILDE; -#else - goto not_there; -#endif - break; - case 'U': - break; - case 'V': - break; - case 'W': - break; - case 'X': - break; - case 'Y': - break; - case 'Z': - break; - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} +#include "constants.c" #ifdef WIN32 #define errfunc NULL @@ -207,8 +55,4 @@ PPCODE: bsd_globfree(&pglob); } -double -constant(name,arg) - char *name - int arg -PROTOTYPE: $$ +INCLUDE: constants.xs diff --git a/ext/File/Glob/Makefile.PL b/ext/File/Glob/Makefile.PL index 98781c9..b73a0c4 100644 --- a/ext/File/Glob/Makefile.PL +++ b/ext/File/Glob/Makefile.PL @@ -1,9 +1,11 @@ use ExtUtils::MakeMaker; +use ExtUtils::Constant 0.08 'WriteConstants'; WriteMakefile( NAME => 'File::Glob', VERSION_FROM => 'Glob.pm', MAN3PODS => {}, # Pods will be built by installman. OBJECT => 'bsd_glob$(OBJ_EXT) Glob$(OBJ_EXT)', + realclean => {FILES=> 'constants.c constants.xs'}, ## uncomment for glob debugging (will cause make test to fail) # DEFINE => '-DGLOB_DEBUG', @@ -19,3 +21,12 @@ sub MY::cflags { } $inherited; } + +WriteConstants( + NAME => 'File::Glob', + NAMES => [qw(GLOB_ABEND GLOB_ALPHASORT GLOB_ALTDIRFUNC GLOB_BRACE GLOB_ERR + GLOB_LIMIT GLOB_MARK GLOB_NOCASE GLOB_NOCHECK GLOB_NOMAGIC + GLOB_NOSORT GLOB_NOSPACE GLOB_QUOTE GLOB_TILDE), + {name=>"GLOB_ERROR", macro=>1}], + BREAKOUT_AT => 8, +); diff --git a/lib/ExtUtils/Constant.pm b/lib/ExtUtils/Constant.pm index 7bb3a64..03f42e9 100644 --- a/lib/ExtUtils/Constant.pm +++ b/lib/ExtUtils/Constant.pm @@ -1,6 +1,6 @@ package ExtUtils::Constant; use vars qw (@ISA $VERSION %XS_Constant %XS_TypeSet @EXPORT_OK %EXPORT_TAGS); -$VERSION = '0.07'; +$VERSION = '0.08'; =head1 NAME @@ -308,7 +308,7 @@ sub return_clause ($$$$$$$$$) { ##ifdef thingy if (ref $macro) { $clause = $macro->[0]; - } else { + } elsif ($macro ne "1") { $clause = "#ifdef $macro\n"; } @@ -317,23 +317,25 @@ sub return_clause ($$$$$$$$$) { $clause .= assign ($indent, $type, $pre, $post, ref $value ? @$value : $value); - ##else - $clause .= "#else\n"; + if (ref $macro or $macro ne "1") { + ##else + $clause .= "#else\n"; - # return PERL_constant_NOTDEF; - if (!defined $default) { - $clause .= "${indent}return PERL_constant_NOTDEF;\n"; - } else { - my @default = ref $default ? @$default : $default; - $type = shift @default; - $clause .= assign ($indent, $type, $def_pre, $def_post, @default); - } + # return PERL_constant_NOTDEF; + if (!defined $default) { + $clause .= "${indent}return PERL_constant_NOTDEF;\n"; + } else { + my @default = ref $default ? @$default : $default; + $type = shift @default; + $clause .= assign ($indent, $type, $def_pre, $def_post, @default); + } - ##endif - if (ref $macro) { - $clause .= $macro->[1]; - } else { - $clause .= "#endif\n"; + ##endif + if (ref $macro) { + $clause .= $macro->[1]; + } else { + $clause .= "#endif\n"; + } } return $clause } @@ -427,9 +429,8 @@ sub switch_clause { =item params WHAT An internal function. I should be a hashref of types the constant -function will return. I returns the list of flags C<$use_iv, $use_nv, -$use_pv, $use_sv> to show which combination of pointers will be needed in the -C argument list. +function will return. I returns a hashref keyed IV NV PV SV to show +which combination of pointers will be needed in the C argument list. =cut @@ -438,11 +439,12 @@ sub params { foreach (sort keys %$what) { warn "ExtUtils::Constant doesn't know how to handle values of type $_" unless defined $XS_Constant{$_}; } - my $use_iv = $what->{IV} || $what->{UV} || $what->{PVN}; - my $use_nv = $what->{NV}; - my $use_pv = $what->{PV} || $what->{PVN}; - my $use_sv = $what->{SV}; - return ($use_iv, $use_nv, $use_pv, $use_sv); + my $params = {}; + $params->{IV} = 1 if $what->{IV} || $what->{UV} || $what->{PVN}; + $params->{NV} = 1 if $what->{NV}; + $params->{PV} = 1 if $what->{PV} || $what->{PVN}; + $params->{SV} = 1 if $what->{SV}; + return $params; } =item dump_names @@ -588,6 +590,9 @@ pre-processor constructions such as to be used to determine if a constant is to be defined. +A "macro" 1 signals that the constant is always defined, so the C<#if>/C<#endif> +test is omitted. + =item default Default value to use (instead of Cing with "your vendor has not @@ -654,64 +659,66 @@ example C for names 5 characters long. The default I is sub C_constant { my ($package, $subname, $default_type, $what, $indent, $breakout, @items) = @_; - my $namelen; - if (ref $breakout) { - $namelen = $$breakout; - } else { - $breakout ||= 3; - } $package ||= 'Foo'; $subname ||= 'constant'; # I'm not using this. But a hashref could be used for full formatting without # breaking this API # $indent ||= 0; - $default_type ||= 'IV'; - if (!ref $what) { - # Convert line of the form IV,UV,NV to hash - $what = {map {$_ => 1} split /,\s*/, ($what || '')}; - # Figure out what types we're dealing with, and assign all unknowns to the - # default type - } - my %items; - foreach (@items) { - my $name; - if (ref $_) { - my $orig = $_; - # Make a copy which is a normalised version of the ref passed in. - $name = $_->{name}; - my ($type, $macro, $value) = @$_{qw (type macro value)}; - $type ||= $default_type; - $what->{$type} = 1; - $_ = {name=>$name, type=>$type}; - - undef $macro if defined $macro and $macro eq $name; - $_->{macro} = $macro if defined $macro; - undef $value if defined $value and $value eq $name; - $_->{value} = $value if defined $value; - foreach my $key (qw(default pre post def_pre def_post)) { - my $value = $orig->{$key}; - $_->{$key} = $value if defined $value; - # warn "$key $value"; - } - } else { - $name = $_; - $_ = {name=>$_, type=>$default_type}; - $what->{$default_type} = 1; + + my ($namelen, $items); + if (ref $breakout) { + # We are called recursively. We trust @items to be normalised, $what to + # be a hashref, and pinch %$items from our parent to save recalculation. + ($namelen, $items) = @$breakout; + } else { + $breakout ||= 3; + $default_type ||= 'IV'; + if (!ref $what) { + # Convert line of the form IV,UV,NV to hash + $what = {map {$_ => 1} split /,\s*/, ($what || '')}; + # Figure out what types we're dealing with, and assign all unknowns to the + # default type } - warn "ExtUtils::Constant doesn't know how to handle values of type $_ used in macro $name" unless defined $XS_Constant{$_->{type}}; - if (exists $items{$name}) { - die "Multiple definitions for macro $name"; + foreach (@items) { + my $name; + if (ref $_) { + my $orig = $_; + # Make a copy which is a normalised version of the ref passed in. + $name = $_->{name}; + my ($type, $macro, $value) = @$_{qw (type macro value)}; + $type ||= $default_type; + $what->{$type} = 1; + $_ = {name=>$name, type=>$type}; + + undef $macro if defined $macro and $macro eq $name; + $_->{macro} = $macro if defined $macro; + undef $value if defined $value and $value eq $name; + $_->{value} = $value if defined $value; + foreach my $key (qw(default pre post def_pre def_post)) { + my $value = $orig->{$key}; + $_->{$key} = $value if defined $value; + # warn "$key $value"; + } + } else { + $name = $_; + $_ = {name=>$_, type=>$default_type}; + $what->{$default_type} = 1; + } + warn "ExtUtils::Constant doesn't know how to handle values of type $_ used in macro $name" unless defined $XS_Constant{$_->{type}}; + if (exists $items->{$name}) { + die "Multiple definitions for macro $name"; + } + $items->{$name} = $_; } - $items{$name} = $_; } - my ($use_iv, $use_nv, $use_pv, $use_sv) = params ($what); + my $params = params ($what); my ($body, @subs) = "static int\n$subname (pTHX_ const char *name"; $body .= ", STRLEN len" unless defined $namelen; - $body .= ", IV *iv_return" if $use_iv; - $body .= ", NV *nv_return" if $use_nv; - $body .= ", const char **pv_return" if $use_pv; - $body .= ", SV **sv_return" if $use_sv; + $body .= ", IV *iv_return" if $params->{IV}; + $body .= ", NV *nv_return" if $params->{NV}; + $body .= ", const char **pv_return" if $params->{PV}; + $body .= ", SV **sv_return" if $params->{SV}; $body .= ") {\n"; if (defined $namelen) { @@ -719,7 +726,7 @@ sub C_constant { my $comment = 'When generated this function returned values for the list' . ' of names given here. However, subsequent manual editing may have' . ' added or removed some.'; - $body .= switch_clause (2, $comment, $namelen, \%items, @items); + $body .= switch_clause (2, $comment, $namelen, $items, @items); } else { # We are the top level. $body .= " /* Initially switch on the length of the name. */\n"; @@ -746,15 +753,22 @@ sub C_constant { $default, $pre, $post, $def_pre, $def_post); $body .= " }\n"; } elsif (@{$by_length[$i]} < $breakout) { - $body .= switch_clause (4, '', $i, \%items, @{$by_length[$i]}); + $body .= switch_clause (4, '', $i, $items, @{$by_length[$i]}); } else { - push @subs, C_constant ($package, "${subname}_$i", $default_type, - $what, $indent, \$i, @{$by_length[$i]}); + # Only use the minimal set of parameters actually needed by the types + # of the names of this length. + my $what = {}; + foreach (@{$by_length[$i]}) { + $what->{$_->{type}} = 1; + } + $params = params ($what); + push @subs, C_constant ($package, "${subname}_$i", $default_type, $what, + $indent, [$i, $items], @{$by_length[$i]}); $body .= " return ${subname}_$i (aTHX_ name"; - $body .= ", iv_return" if $use_iv; - $body .= ", nv_return" if $use_nv; - $body .= ", pv_return" if $use_pv; - $body .= ", sv_return" if $use_sv; + $body .= ", iv_return" if $params->{IV}; + $body .= ", nv_return" if $params->{NV}; + $body .= ", pv_return" if $params->{PV}; + $body .= ", sv_return" if $params->{SV}; $body .= ");\n"; } $body .= " break;\n"; @@ -797,7 +811,7 @@ sub XS_constant { # Convert line of the form IV,UV,NV to hash $what = {map {$_ => 1} split /,\s*/, ($what)}; } - my ($use_iv, $use_nv, $use_pv, $use_sv) = params ($what); + my $params = params ($what); my $type; my $xs = <<"EOT"; @@ -813,17 +827,17 @@ $subname(sv) int type; EOT - if ($use_iv) { + if ($params->{IV}) { $xs .= " IV iv;\n"; } else { $xs .= " /* IV\t\tiv;\tUncomment this if you need to return IVs */\n"; } - if ($use_nv) { + if ($params->{NV}) { $xs .= " NV nv;\n"; } else { $xs .= " /* NV\t\tnv;\tUncomment this if you need to return NVs */\n"; } - if ($use_pv) { + if ($params->{PV}) { $xs .= " const char *pv;\n"; } else { $xs .= @@ -837,17 +851,17 @@ EOT PPCODE: EOT - if ($use_iv xor $use_nv) { + if ($params->{IV} xor $params->{NV}) { $xs .= << "EOT"; /* Change this to $C_subname(aTHX_ s, len, &iv, &nv); if you need to return both NVs and IVs */ EOT } $xs .= " type = $C_subname(aTHX_ s, len"; - $xs .= ', &iv' if $use_iv; - $xs .= ', &nv' if $use_nv; - $xs .= ', &pv' if $use_pv; - $xs .= ', &sv' if $use_sv; + $xs .= ', &iv' if $params->{IV}; + $xs .= ', &nv' if $params->{NV}; + $xs .= ', &pv' if $params->{PV}; + $xs .= ', &sv' if $params->{SV}; $xs .= ");\n"; $xs .= << "EOT"; diff --git a/t/lib/extutils.t b/t/lib/extutils.t index f59e233..50a9fe4 100644 --- a/t/lib/extutils.t +++ b/t/lib/extutils.t @@ -1,6 +1,6 @@ #!./perl -w -print "1..26\n"; +print "1..27\n"; BEGIN { chdir 't' if -d 't'; @@ -55,8 +55,7 @@ my @names = ("FIVE", {name=>"OK6", type=>"PV",}, value=>['"not ok 7\\n\\0ok 7\\n"', 15]}, {name => "FARTHING", type=>"NV"}, {name => "NOT_ZERO", type=>"UV", value=>"~(UV)0"}, - {name => "OPEN", type=>"PV", value=>'"/*"', - macro=>["#if 1\n", "#endif\n"]}, + {name => "OPEN", type=>"PV", value=>'"/*"', macro=>1}, {name => "CLOSE", type=>"PV", value=>'"*/"', macro=>["#if 1\n", "#endif\n"]}, {name => "ANSWER", default=>["UV", 42]}, "NOTDEF", @@ -321,6 +320,17 @@ if (\$rfc1149 != 1149) { } else { print "ok 21\n"; } + +EOT + +print FH <<'EOT'; +# test macro=>1 +my $open = OPEN; +if ($open eq '/*') { + print "ok 22\n"; +} else { + print "not ok 22 # \$open='$open'\n"; +} EOT close FH or die "close $testpl: $!\n"; @@ -397,7 +407,7 @@ if ($Config{usedl}) { } } -my $test = 22; +my $test = 23; my $maketest = "$make test"; print "# make = '$maketest'\n"; $makeout = `$maketest`;