In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b8a48bdd395a3c363c75c2dd88f351ca033b3455?hp=0c96a22802acb568889a21eca98ad406b17f4740>
- Log ----------------------------------------------------------------- commit b8a48bdd395a3c363c75c2dd88f351ca033b3455 Author: Nicholas Clark <[email protected]> Date: Mon Oct 18 21:31:10 2010 +0200 Express @Fcntl::EXPORT_OK in terms of %Fcntl::EXPORT_TAGS. This reduces quite a lot of repetition of symbol names. Note that '&SUBNAME' and 'SUBNAME' are interchangeable to Exporter. M ext/Fcntl/Fcntl.pm commit 923cc1bb816922fc7e3d923ecac3b09efc7690cc Author: Nicholas Clark <[email protected]> Date: Mon Oct 18 20:31:00 2010 +0200 Convert Fcntl::S_IFMT to XS. This removes the requirement to call XSLoader::load() at BEGIN time, which simplifies the Perl code further. M ext/Fcntl/Fcntl.pm M ext/Fcntl/Fcntl.xs M ext/Fcntl/t/mode.t commit 87eca6eccde7fa88e66a2fc2ad817978f8d1c549 Author: Nicholas Clark <[email protected]> Date: Mon Oct 18 20:10:39 2010 +0200 Convert Fcntl::S_IMODE to XS. M ext/Fcntl/Fcntl.pm M ext/Fcntl/Fcntl.xs M ext/Fcntl/t/mode.t commit 96d24b8ce2ce0411b22e29e30ee26700bb1213cf Author: Nicholas Clark <[email protected]> Date: Mon Oct 18 19:30:12 2010 +0200 Convert Fcntl::S_IS{LNK,SOCK,BLK,CHR,FIFO,WHT,ENFMT} to XS. This reduces the memory usage of Fcntl by quite a bit, as the same XSUB is used by all 9 S_IS* functions. M ext/Fcntl/Fcntl.pm M ext/Fcntl/Fcntl.xs commit efe77345f79553ebc2eff1978e461a89d4448f00 Author: Nicholas Clark <[email protected]> Date: Mon Oct 18 16:01:00 2010 +0200 Convert Fcntl::{S_ISREG,S_ISDIR} to XS. I estimate that this saves 294 bytes in Perl space (per thread, or per-process if memory pages become unshared after forking), but costs only 232 bytes in the shared object (should always remain shared between threads and processes). Oh, and it's XS code, and avoids 2 Perl subroutine calls. M ext/Fcntl/Fcntl.pm M ext/Fcntl/Fcntl.xs M ext/Fcntl/t/mode.t ----------------------------------------------------------------------- Summary of changes: ext/Fcntl/Fcntl.pm | 97 ++++++++++++++-------------------------------------- ext/Fcntl/Fcntl.xs | 87 ++++++++++++++++++++++++++++++++++++++++++++++ ext/Fcntl/t/mode.t | 25 ++++++++++++- 3 files changed, 136 insertions(+), 73 deletions(-) diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm index 58017f0..4aede8c 100644 --- a/ext/Fcntl/Fcntl.pm +++ b/ext/Fcntl/Fcntl.pm @@ -59,10 +59,31 @@ use strict; our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $AUTOLOAD); require Exporter; +require XSLoader; @ISA = qw(Exporter); -BEGIN { - $VERSION = '1.08'; -} +$VERSION = '1.09'; + +XSLoader::load(); + +# Named groups of exports +%EXPORT_TAGS = ( + 'flock' => [qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN)], + 'Fcompat' => [qw(FAPPEND FASYNC FCREAT FDEFER FDSYNC FEXCL FLARGEFILE + FNDELAY FNONBLOCK FRSYNC FSYNC FTRUNC)], + 'seek' => [qw(SEEK_SET SEEK_CUR SEEK_END)], + 'mode' => [qw(S_ISUID S_ISGID S_ISVTX S_ISTXT + _S_IFMT S_IFREG S_IFDIR S_IFLNK + S_IFSOCK S_IFBLK S_IFCHR S_IFIFO S_IFWHT S_ENFMT + S_IRUSR S_IWUSR S_IXUSR S_IRWXU + S_IRGRP S_IWGRP S_IXGRP S_IRWXG + S_IROTH S_IWOTH S_IXOTH S_IRWXO + S_IREAD S_IWRITE S_IEXEC + S_ISREG S_ISDIR S_ISLNK S_ISSOCK + S_ISBLK S_ISCHR S_ISFIFO + S_ISWHT S_ISENFMT + S_IFMT S_IMODE + )], +); # Items to export into callers namespace by default # (move infrequently used names to @EXPORT_OK below) @@ -139,7 +160,7 @@ BEGIN { ); # Other items we are prepared to export if requested -...@export_ok = qw( +...@export_ok = (qw( DN_ACCESS DN_ATTRIB DN_CREATE @@ -147,86 +168,20 @@ BEGIN { DN_MODIFY DN_MULTISHOT DN_RENAME - FAPPEND - FASYNC - FCREAT - FDEFER - FDSYNC - FEXCL - FLARGEFILE - FNDELAY - FNONBLOCK - FRSYNC - FSYNC - FTRUNC F_GETLEASE F_GETSIG F_NOTIFY F_SETLEASE F_SETSIG - LOCK_EX LOCK_MAND - LOCK_NB LOCK_READ LOCK_RW - LOCK_SH - LOCK_UN LOCK_WRITE O_IGNORE_CTTY O_NOATIME O_NOLINK O_NOTRANS - SEEK_CUR - SEEK_END - SEEK_SET - S_IFSOCK S_IFBLK S_IFCHR S_IFIFO S_IFWHT S_ENFMT - S_IREAD S_IWRITE S_IEXEC - S_IRGRP S_IWGRP S_IXGRP S_IRWXG - S_IROTH S_IWOTH S_IXOTH S_IRWXO - S_IRUSR S_IWUSR S_IXUSR S_IRWXU - S_ISUID S_ISGID S_ISVTX S_ISTXT - _S_IFMT S_IFREG S_IFDIR S_IFLNK - &S_ISREG &S_ISDIR &S_ISLNK &S_ISSOCK &S_ISBLK &S_ISCHR &S_ISFIFO - &S_ISWHT &S_ISENFMT &S_IFMT &S_IMODE -); -# Named groups of exports -%EXPORT_TAGS = ( - 'flock' => [qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN)], - 'Fcompat' => [qw(FAPPEND FASYNC FCREAT FDEFER FDSYNC FEXCL FLARGEFILE - FNDELAY FNONBLOCK FRSYNC FSYNC FTRUNC)], - 'seek' => [qw(SEEK_SET SEEK_CUR SEEK_END)], - 'mode' => [qw(S_ISUID S_ISGID S_ISVTX S_ISTXT - _S_IFMT S_IFREG S_IFDIR S_IFLNK - S_IFSOCK S_IFBLK S_IFCHR S_IFIFO S_IFWHT S_ENFMT - S_IRUSR S_IWUSR S_IXUSR S_IRWXU - S_IRGRP S_IWGRP S_IXGRP S_IRWXG - S_IROTH S_IWOTH S_IXOTH S_IRWXO - S_IREAD S_IWRITE S_IEXEC - S_ISREG S_ISDIR S_ISLNK S_ISSOCK - S_ISBLK S_ISCHR S_ISFIFO - S_ISWHT S_ISENFMT - S_IFMT S_IMODE - )], -); - -# Force the constants to become inlined -BEGIN { - require XSLoader; - XSLoader::load(); -} - -sub S_IFMT { @_ ? ( $_[0] & _S_IFMT() ) : _S_IFMT() } -sub S_IMODE { $_[0] & 07777 } - -sub S_ISREG { ( $_[0] & _S_IFMT() ) == S_IFREG() } -sub S_ISDIR { ( $_[0] & _S_IFMT() ) == S_IFDIR() } -sub S_ISLNK { ( $_[0] & _S_IFMT() ) == S_IFLNK() } -sub S_ISSOCK { ( $_[0] & _S_IFMT() ) == S_IFSOCK() } -sub S_ISBLK { ( $_[0] & _S_IFMT() ) == S_IFBLK() } -sub S_ISCHR { ( $_[0] & _S_IFMT() ) == S_IFCHR() } -sub S_ISFIFO { ( $_[0] & _S_IFMT() ) == S_IFIFO() } -sub S_ISWHT { ( $_[0] & _S_IFMT() ) == S_IFWHT() } -sub S_ISENFMT { ( $_[0] & _S_IFMT() ) == S_ENFMT() } +), map {...@{$_}} values %EXPORT_TAGS); sub AUTOLOAD { (my $constname = $AUTOLOAD) =~ s/.*:://; diff --git a/ext/Fcntl/Fcntl.xs b/ext/Fcntl/Fcntl.xs index c907c9a..a66f66e 100644 --- a/ext/Fcntl/Fcntl.xs +++ b/ext/Fcntl/Fcntl.xs @@ -33,8 +33,95 @@ --AD October 16, 1995 */ +static XS(XS_Fcntl_S_ISREG); /* prototype to pass -Wmissing-prototypes */ +static +XS(XS_Fcntl_S_ISREG) +{ + dVAR; + dXSARGS; + dXSI32; + /* Preserve the semantics of the perl code, which was: + sub S_ISREG { ( $_[0] & _S_IFMT() ) == S_IFREG() } + */ + SV *mode; + + PERL_UNUSED_VAR(cv); /* -W */ + SP -= items; + + if (items > 0) + mode = ST(0); + else { + mode = &PL_sv_undef; + EXTEND(SP, 1); + } + PUSHs(((SvUV(mode) & S_IFMT) == ix) ? &PL_sv_yes : &PL_sv_no); + PUTBACK; +} + #include "const-c.inc" MODULE = Fcntl PACKAGE = Fcntl INCLUDE: const-xs.inc + +void +S_IMODE(...) + PREINIT: + dXSTARG; + SV *mode; + PPCODE: + if (items > 0) + mode = ST(0); + else { + mode = &PL_sv_undef; + EXTEND(SP, 1); + } + PUSHu(SvUV(mode) & 07777); + +void +S_IFMT(...) + PREINIT: + dXSTARG; + PPCODE: + PUSHu(items ? (SvUV(ST(0)) & S_IFMT) : S_IFMT); + +BOOT: + { + CV *cv; +#ifdef S_IFREG + cv = newXS("Fcntl::S_ISREG", XS_Fcntl_S_ISREG, file); + XSANY.any_i32 = S_IFREG; +#endif +#ifdef S_IFDIR + cv = newXS("Fcntl::S_ISDIR", XS_Fcntl_S_ISREG, file); + XSANY.any_i32 = S_IFDIR; +#endif +#ifdef S_IFLNK + cv = newXS("Fcntl::S_ISLNK", XS_Fcntl_S_ISREG, file); + XSANY.any_i32 = S_IFLNK; +#endif +#ifdef S_IFSOCK + cv = newXS("Fcntl::S_ISSOCK", XS_Fcntl_S_ISREG, file); + XSANY.any_i32 = S_IFSOCK; +#endif +#ifdef S_IFBLK + cv = newXS("Fcntl::S_ISBLK", XS_Fcntl_S_ISREG, file); + XSANY.any_i32 = S_IFBLK; +#endif +#ifdef S_IFCHR + cv = newXS("Fcntl::S_ISCHR", XS_Fcntl_S_ISREG, file); + XSANY.any_i32 = S_IFCHR; +#endif +#ifdef S_IFIFO + cv = newXS("Fcntl::S_ISFIFO", XS_Fcntl_S_ISREG, file); + XSANY.any_i32 = S_IFIFO; +#endif +#ifdef S_IFWHT + cv = newXS("Fcntl::S_ISWHT", XS_Fcntl_S_ISREG, file); + XSANY.any_i32 = S_IFWHT; +#endif +#ifdef S_IFENFMT + cv = newXS("Fcntl::S_ISENFMT", XS_Fcntl_S_ISREG, file); + XSANY.any_i32 = S_ENFMT; +#endif + } diff --git a/ext/Fcntl/t/mode.t b/ext/Fcntl/t/mode.t index b16601e..4bec202 100644 --- a/ext/Fcntl/t/mode.t +++ b/ext/Fcntl/t/mode.t @@ -18,7 +18,7 @@ if (-c $devnull) { push @tests, ['CHR', $devnull, (stat $devnull)[2]]; } -plan(tests => 9 * @tests); +plan(tests => 34 + 6 + 9 * @tests); foreach (@tests) { my ($type, $name, $mode) = @$_; @@ -68,4 +68,25 @@ foreach (@tests) { ok(!S_ISENFMT($mode), "!S_ISENFMT $name"); } } - + +foreach ([S_ISREG => \&S_ISREG], + [S_IMODE => \&S_IMODE], + ) { + my ($name, $func) = @$_; + my @warnings; + my $ret; + + { + local $SIG{__WARN__} = sub { push @warnings, "@_" }; + $ret = &$func(); + } + ok(!$ret, "$name() is false"); + is(scalar @warnings, 1, '1 warning'); + like($warnings[0], qr/^Use of uninitialized value/, 'expected warning'); +} + +is (S_IFMT(), _S_IFMT(), 'S_IFMT()'); +is (S_IFMT(0), 0, 'S_IFMT(0)'); +for my $shift (0..31) { + is (S_IFMT(1 << $shift), ((1 << $shift) & _S_IFMT()), "S_IFMT(1 << $shift)"); +} -- Perl5 Master Repository
