Author: ambs
Date: Wed Jan 11 11:35:58 2006
New Revision: 11098
Modified:
trunk/src/classes/os.pmc
trunk/t/pmc/os.t
Log:
OS.pmc - added is_link and is_dir tests
os.t - tests is_link
These (and probably other) functions will migrate to file.pmc soon.
Modified: trunk/src/classes/os.pmc
==============================================================================
--- trunk/src/classes/os.pmc (original)
+++ trunk/src/classes/os.pmc Wed Jan 11 11:35:58 2006
@@ -408,6 +408,9 @@ previous one).
it makes the named directory the new root directory for all further
pathnames that begin with a "/" by your process and all its children.
+B<NOTE>: perl restricts this operation to superusers. It might be a good
+idea to do the same with parrot.
+
=cut
*/
@@ -426,6 +429,63 @@ pathnames that begin with a "/" by your
#endif
}
+
+
+/*
+
+=item C<INTVAL is_dir(STRING* path)>
+
+Returns a true value (1) if the supplied path is a directory.
+
+=cut
+
+*/
+
+ METHOD INTVAL is_dir(STRING *path) {
+ struct stat info;
+ char *cpath = string_to_cstring(interpreter, path);
+ int error = stat(cpath, &info);
+ if (error) {
+ char *errmsg = strerror(errno);
+ real_exception(interpreter, NULL, E_SystemError, errmsg);
+ }
+
+ if (S_ISDIR(info.st_mode)) {
+ return 1;
+ } else {
+ return 0;
+ }
+ }
+
+
+
+
+/*
+
+=item C<INTVAL is_link(STRING* path)>
+
+Returns a true value (1) if the supplied path is a link.
+
+=cut
+
+*/
+
+ METHOD INTVAL is_link(STRING *path) {
+ struct stat info;
+ char *cpath = string_to_cstring(interpreter, path);
+ int error = stat(cpath, &info);
+ if (error) {
+ char *errmsg = strerror(errno);
+ real_exception(interpreter, NULL, E_SystemError, errmsg);
+ }
+
+ if (S_ISLNK(info.st_mode)) {
+ return 1;
+ } else {
+ return 0;
+ }
+ }
+
}
/*
Modified: trunk/t/pmc/os.t
==============================================================================
--- trunk/t/pmc/os.t (original)
+++ trunk/t/pmc/os.t Wed Jan 11 11:35:58 2006
@@ -6,7 +6,7 @@ use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 9;
+use Parrot::Test tests => 10;
use Parrot::Config;
use Cwd;
use File::Spec;
@@ -114,10 +114,27 @@ $xpto
$cwd
OUT
+# test is_dir
+mkdir "xpto" unless -d "xpto";
+pir_output_is(<<'CODE', <<"OUT", "Test rm call in a directory");
+.sub main :main
+ $P1 = new .OS
+ $S1 = "xpto"
+ $I1 = $P1."is_dir"($S1)
-# Test remove on a directory
+ if $I1 goto ok
+ print "not "
+ok:
+ print "ok\n"
+ end
+.end
+CODE
+ok
+OUT
+
+# Test remove on a directory
mkdir "xpto" unless -d "xpto";
pir_output_is(<<'CODE', <<"OUT", "Test rm call in a directory");
