tests/mv.pl

   1 #!/usr/bin/env perl
   2
   3 # Some tests for 'darcs mv'
   4
   5 use lib 'lib/perl';
   6 use Test::More tests => 13;
   7 use Test::Darcs;
   8 use Cwd 'abs_path';
   9 use Shell::Command;
  10 use strict;
  11 use Carp;
  12
  13 init_tmp_repo();
  14
  15 ###
  16
  17 my $test_name = 'adding a directory with more than one ../ in it should work.';
  18 mkpath('foo.d/second/third','foo.d/other') || die "mkpath failed: $!";
  19
  20 my $out = `ls ./foo.d/other`;
  21 print $out;
  22
  23 touch './foo.d/other/date.t';
  24 darcs qw/add -r foo.d/;
  25
  26 chdir 'foo.d/second/third';
  27
  28 my $mv_out = darcs qw!mv ../../other/date.t ../../other/date_moved.t!;
  29 unlike($mv_out, qr/darcs failed/, $test_name);
  30
  31 chdir '../../../';
  32 $test_name = 'refuses to move to an existing file';
  33 touch 'ping';
  34 touch 'pong';
  35 darcs qw/add ping pong/;
  36 like(darcs(qw( mv ping pong )), qr/already exists/,$test_name);
  37
  38 # case sensitivity series
  39 # -----------------------
  40 # these are tests designed to check out darcs behave wrt to renames
  41 # where the case of the file becomes important
  42
  43 # are we on a case sensitive file system?
  44 my $is_case_sensitive = 1;
  45 touch 'is_it_cs';
  46 touch 'IS_IT_CS';
  47 my @csStat1=stat 'is_it_cs';
  48 my @csStat2=stat 'IS_IT_CS';
  49 if ($csStat1[1] eq $csStat2[1]) {
  50   $is_case_sensitive = 0;
  51 }
  52 my $already_exists = qr/already exists/;
  53 my $no_test_cuz_insensitive = "This test can't be run becase the file system is case insensitive";
  54
  55 # if the new file already exists - we don't allow it
  56 # basically the same test as mv ping pong, except we do mv ping PING
  57 # and both ping and PING exist on the filesystem
  58 $test_name = "case sensitivity - simply don't allow mv if new file exists";
  59 touch 'cs-n-1'; touch 'CS-N-1';
  60 touch 'cs-y-1'; touch 'CS-Y-1';
  61 darcs qw/add cs-n-1 cs-y-1/;
  62 if ($is_case_sensitive) {
  63   # regardless of case-ok, we do NOT want this mv at all
  64   like(darcs(qw( mv           cs-n-1 CS-N-1)), $already_exists, $test_name);
  65   like(darcs(qw( mv --case-ok cs-y-1 CS-Y-1)), $already_exists, $test_name);
  66 } else {
  67   pass ( $no_test_cuz_insensitive );
  68   pass ( $no_test_cuz_insensitive );
  69 }
  70
  71 # if the new file does not already exist - we allow it
  72 $test_name = "case sensitivity - the new file does *not* exist";
  73 touch 'cs-n-2';
  74 touch 'cs-y-2';
  75 darcs qw/add cs-n-2/;
  76 # these mv's should be allowed regardless of flag or filesystem
  77 unlike(darcs(qw( mv           cs-n-2 CS-N-2)), $already_exists, $test_name);
  78 unlike(darcs(qw( mv --case-ok cs-y-2 CS-Y-2)), $already_exists, $test_name);
  79
  80 # parasites - do not accidentally overwrite a file just because it has a
  81 # similar name and points to the same inode.  We want to check if a file if the
  82 # same NAME already exists - we shouldn't care about what the actual file is!
  83 $test_name = "case sensitivity - inode check";
  84 touch 'cs-n-3';
  85 touch 'cs-y-3';
  86 darcs qw/add cs-n-3 cs-y-3/;
  87 if ($^O =~ /(msys|win32)/i) {
  88   # afaik, windows does not support hard links
  89   pass ('cannot run this test -- windows does not have hard links');
  90   pass ('cannot run this test -- windows does not have hard links');
  91 } elsif ($is_case_sensitive) {
  92   `ln cs-n-3 CS-N-3`;
  93   `ln cs-y-3 CS-Y-3`;
  94   # regardless of case-ok, we do NOT want this mv at all
  95   like(darcs(qw( mv           cs-n-3 CS-N-3)), $already_exists, $test_name);
  96   like(darcs(qw( mv --case-ok cs-y-3 CS-Y-3)), $already_exists, $test_name);
  97 } else {
  98   pass ( $no_test_cuz_insensitive );
  99   pass ( $no_test_cuz_insensitive );
 100 }
 101
 102 # parasites - we don't allow weird stuff like mv foo bar/foo just because
 103 # we opened up some crazy exception based on foo's name
 104 $test_name = 'refuses to move to an existing file with same name, different path';
 105 touch 'cs-n-4'; touch 'foo.d/cs-n-4';
 106 touch 'cs-y-4'; touch 'foo.d/cs-y-4';
 107 darcs qw/add cs-n-4/;
 108 # regardless of case-ok, we do NOT want this mv at all
 109 like(darcs(qw( mv           cs-n-4 foo.d/cs-n-4)), $already_exists, $test_name);
 110 like(darcs(qw( mv --case-ok cs-y-4 foo.d/cs-y-4)), $already_exists, $test_name);
 111
 112 # ---------------------------
 113 # end case sensitivity series
 114
 115 touch 'abs_path.t';
 116 darcs qw/add abs_path.t/;
 117
 118 {
 119   my $repo_abs = abs_path();
 120   chomp ($repo_abs);
 121   my $mv_out = darcs("mv $repo_abs/abs_path.t abs_path_new.t");
 122   unlike($mv_out, qr/darcs failed/, 'mv should work with absolute path as a src argument.');
 123 }
 124
 125 {
 126   my $repo_abs = abs_path();
 127   chomp ($repo_abs);
 128   my $mv_out = darcs("mv abs_path_new.t $repo_abs/abs_path.t");
 129   unlike($mv_out, qr/darcs failed/, 'mv should work with absolute path as a target argument.');
 130 }
 131
 132 # issue608
 133 {
 134    touch 'gonna_be_deleted';
 135    darcs "add gonna_be_deleted";
 136    darcs "record -am 'added doomed file'";
 137    rm_rf "gonna_be_deleted";
 138    darcs "record -am 'deleted file'";
 139    touch 'new_file';
 140    darcs "add new_file";
 141    my $out = darcs "mv new_file gonna_be_deleted";
 142    is($out, "", "darcs mv should succeed");
 143 }
 144
 145