# New Ticket Created by William Orr
# Please include the string: [perl #84966]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=84966 >
I implemented several of the file test methods listed here:
https://github.com/perl6/specs/blob/master/S32-setting-library/IO.pod
Additionally, I reimplemented IO.l in Perl6 rather than pir, and I
changed the behaviour of IO.f so that it actually matched the spec
(devices aren't normal files).
Patch also submitted as github pull request.
>From ef513564a171d724d602216e48f235779753d509 Mon Sep 17 00:00:00 2001
From: William Orr <w...@worrbase.com>
Date: Fri, 25 Feb 2011 23:44:27 -0500
Subject: [PATCH] Added nodev requirement to IO.f
- spec says that regular files can be neither devices or directories
Added R(), W(), X()
Added O() and o()
Changed IO.l implementation to Perl6 instead of pir
Implemented u() g() and k()
---
src/core/IO.pm | 60 +++++++++++++++++++++++++++++++++++++++++++++----------
1 files changed, 49 insertions(+), 11 deletions(-)
diff --git a/src/core/IO.pm b/src/core/IO.pm
index 12d1550..f1b91ab 100644
--- a/src/core/IO.pm
+++ b/src/core/IO.pm
@@ -147,26 +147,64 @@ class IO is Cool {
$.stat.exists;
}
multi method f() {
- self.e ?? !$.stat.isdir !! Bool;
+ self.e ?? (!$.stat.isdir and !$.stat.isdev) !! Bool;
}
multi method s() {
self.e ?? $.stat.size !! Any;
}
+ multi method R() {
+ ?pir::new__PS('OS').can_read($.path);
+ }
+
+ multi method W() {
+ ?pir::new__PS('OS').can_write($.path);
+ }
+
+ multi method X() {
+ ?pir::new__PS('OS').can_execute($.path);
+ }
+
+ # These are clones of the above functions since parrot can't determine
+ # the effective uid yet
+ multi method r() {
+ ?pir::new__PS('OS').can_read($.path);
+ }
+
+ multi method w() {
+ ?pir::new__PS('OS').can_write($.path);
+ }
+
+ multi method x() {
+ ?pir::new__PS('OS').can_execute($.path);
+ }
+
multi method l() {
- my $fn = $.path;
- ? Q:PIR{
- .local pmc filename, file
- filename = find_lex '$fn'
- $S0 = filename
-
- file = root_new ['parrot';'File']
- $I0 = file.'is_link'($S0)
- %r = box $I0
- }
+ $.stat.islnk;
+ }
+
+ multi method O() {
+ pir::new__PS('OS').get_user_id() ~~ $.stat.uid;
}
+ # Can't get effective uid in parrot
+ multi method o() {
+ pir::new__PS('OS').get_user_id() ~~ $.stat.uid;
+ }
+
+ multi method u() {
+ ?($.stat.permissions +& 0o4000);
+ }
+
+ multi method g() {
+ ?($.stat.permissions +& 0o2000);
+ }
+
+ multi method k() {
+ ?($.stat.permissions +& 0o1000);
+ }
+
multi method z() {
$.e && $.s == 0;
}
--
1.7.3.4
