Convert Fcntl::S_IMODE to XS.

3 files changed, 21 insertions, 5 deletions

diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm
index 4032e0985d..1f6901940b 100644
--- a/ext/Fcntl/Fcntl.pm
+++ b/ext/Fcntl/Fcntl.pm
@@ -216,7 +216,6 @@ BEGIN {
 }
 
 sub S_IFMT  { @_ ? ( $_[0] & _S_IFMT() ) : _S_IFMT()  }
-sub S_IMODE { $_[0] & 07777 }
 
 sub AUTOLOAD {
     (my $constname = $AUTOLOAD) =~ s/.*:://;
diff --git a/ext/Fcntl/Fcntl.xs b/ext/Fcntl/Fcntl.xs
index 37762fed7a..2f8636621c 100644
--- a/ext/Fcntl/Fcntl.xs
+++ b/ext/Fcntl/Fcntl.xs
@@ -64,6 +64,20 @@ 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);
+
 BOOT:
     {
         CV *cv;
diff --git a/ext/Fcntl/t/mode.t b/ext/Fcntl/t/mode.t
index c156b10d5f..c7fa8d1c65 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 => 3 + 9 * @tests);
+plan(tests => 6 + 9 * @tests);
 foreach (@tests) {
     my ($type, $name, $mode) = @$_;
 
@@ -69,15 +69,18 @@ foreach (@tests) {
     }
 }
 
-{
+foreach ([S_ISREG => \&S_ISREG],
+	 [S_IMODE => \&S_IMODE],
+	) {
+    my ($name, $func) = @$_;
     my @warnings;
     my $ret;
 
     {
 	local $SIG{__WARN__} = sub { push @warnings, "@_" };
-	$ret = S_ISREG();
+	$ret = &$func();
     }
-    ok(!$ret, 'S_ISREG() is false');
+    ok(!$ret, "$name() is false");
     is(scalar @warnings, 1, '1 warning');
     like($warnings[0], qr/^Use of uninitialized value/, 'expected warning');
 }