[svn:parrot] r11132 - in trunk: src/classes t/pmc

[ambs]

Author: ambs
Date: Thu Jan 12 13:29:09 2006
New Revision: 11132

Modified:
   trunk/src/classes/file.pmc
   trunk/t/pmc/file.t
   trunk/t/pmc/os.t
Log:
File.t - test is_link
File.pmc - correct is_link which was borked


Modified: trunk/src/classes/file.pmc
==============================================================================
--- trunk/src/classes/file.pmc  (original)
+++ trunk/src/classes/file.pmc  Thu Jan 12 13:29:09 2006
@@ -115,11 +115,11 @@ Returns a true value (1) if the supplied
 
     METHOD INTVAL is_link(STRING *path) {
 #ifdef WIN32
-    return 0;
+        return 0;
 #else
         struct stat info;
         char *cpath = string_to_cstring(interpreter, path);
-        int error = stat(cpath, &info);
+        int error = lstat(cpath, &info);
         if (error) {
             char *errmsg = strerror(errno);
             real_exception(interpreter, NULL, E_SystemError, errmsg);

Modified: trunk/t/pmc/file.t
==============================================================================
--- trunk/t/pmc/file.t  (original)
+++ trunk/t/pmc/file.t  Thu Jan 12 13:29:09 2006
@@ -6,7 +6,7 @@ use strict;
 use warnings;
 use lib qw( . lib ../lib ../../lib );
 use Test::More;
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 4;
 use Parrot::Config;
 use Cwd;
 use File::Spec;
@@ -33,11 +33,12 @@ END {
   # XXX - FIXME - Use Tempfir
 
   # Clean up environment on exit
-  unlink "otpx" if -f "otpx";
-  rmdir "xpto"  if -d "xpto";
+  unlink  "otpx" if -f "otpx";
+  unlink "lotpx" if -l "lotpx";
+  rmdir  "xpto"  if -d "xpto";
+  unlink "xptol" if -l "xptol";
 }
 
-
 mkdir "xpto" unless -d "xpto";
 open X, ">otpx" or die $!;
 print X "xpto";
@@ -75,8 +76,8 @@ ok 2
 OUT
 
 
-# test is_dir
-pir_output_is(<<'CODE', <<"OUT", "Test is_dir");
+# test is_file
+pir_output_is(<<'CODE', <<"OUT", "Test is_file");
 .sub main :main
         $P1 = new .File
 
@@ -106,3 +107,71 @@ ok 1
 ok 2
 OUT
 
+
+SKIP: {
+    skip "Links not available under Windows", 1 if $MSWin32;
+
+    symlink "otpx", "lotpx";
+
+    # test is_link
+    pir_output_is(<<'CODE', <<"OUT", "Test is_link with links to files");
+.sub main :main
+        $P1 = new .File
+
+        $S1 = "lotpx"
+        $I1 = $P1."is_link"($S1)
+
+        if $I1 goto ok1
+        print "not "
+ok1:
+        print "ok 1\n"
+
+        $S1 = "otpx"
+        $I1 = $P1."is_link"($S1)
+        $I1 = !$I1
+        if $I1 goto ok2
+        print "not "
+ok2:
+        print "ok 2\n"
+        end
+.end
+CODE
+ok 1
+ok 2
+OUT
+
+}
+
+SKIP: {
+    skip "Links not available under Windows", 1 if $MSWin32;
+
+    symlink "xpto", "xptol";
+
+    # test is_link
+    pir_output_is(<<'CODE', <<"OUT", "Test is_link with links to directories");
+.sub main :main
+        $P1 = new .File
+
+        $S1 = "xptol"
+        $I1 = $P1."is_link"($S1)
+
+        if $I1 goto ok1
+        print "not "
+ok1:
+        print "ok 1\n"
+
+        $S1 = "xpto"
+        $I1 = $P1."is_link"($S1)
+        $I1 = !$I1
+        if $I1 goto ok2
+        print "not "
+ok2:
+        print "ok 2\n"
+        end
+.end
+CODE
+ok 1
+ok 2
+OUT
+
+}

Modified: trunk/t/pmc/os.t
==============================================================================
--- trunk/t/pmc/os.t    (original)
+++ trunk/t/pmc/os.t    Thu Jan 12 13:29:09 2006
@@ -292,7 +292,7 @@ CODE
 ok
 OUT
 
-  ok(-l "xpto", "symlink was really created"); 
+  ok(-l "xpto", "symlink was really created");
   unlink "xpto" if -f "xpto"
 }
 
@@ -317,7 +317,7 @@ CODE
 ok
 OUT
 
-  my (undef, undef, undef, $nl) = stat("MANIFEST");
+  my $nl = [ stat("MANIFEST") ] -> [ 3 ];
   ok( $nl > 1, "hard link was really created");
   unlink "xpto" if -f "xpto"
 }