File: mv.pl

package info (click to toggle)
darcs 2.0.2-3
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 6,400 kB
  • ctags: 1,048
  • sloc: haskell: 24,937; perl: 9,736; sh: 3,369; ansic: 1,913; makefile: 17; xml: 14
file content (145 lines) | stat: -rw-r--r-- 4,708 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
#!/usr/bin/env perl

# Some tests for 'darcs mv'

use lib 'lib/perl';
use Test::More tests => 13;
use Test::Darcs;
use Cwd 'abs_path';
use Shell::Command;
use strict;
use Carp;

init_tmp_repo();

###

my $test_name = 'adding a directory with more than one ../ in it should work.';
mkpath('foo.d/second/third','foo.d/other') || die "mkpath failed: $!";

my $out = `ls ./foo.d/other`;
print $out;

touch './foo.d/other/date.t';
darcs qw/add -r foo.d/;

chdir 'foo.d/second/third';

my $mv_out = darcs qw!mv ../../other/date.t ../../other/date_moved.t!;
unlike($mv_out, qr/darcs failed/, $test_name);

chdir '../../../';
$test_name = 'refuses to move to an existing file';
touch 'ping';
touch 'pong';
darcs qw/add ping pong/;
like(darcs(qw( mv ping pong )), qr/already exists/,$test_name);

# case sensitivity series
# -----------------------
# these are tests designed to check out darcs behave wrt to renames 
# where the case of the file becomes important

# are we on a case sensitive file system?
my $is_case_sensitive = 1;
touch 'is_it_cs';
touch 'IS_IT_CS';
my @csStat1=stat 'is_it_cs';
my @csStat2=stat 'IS_IT_CS';
if ($csStat1[1] eq $csStat2[1]) {
  $is_case_sensitive = 0;
} 
my $already_exists = qr/already exists/;
my $no_test_cuz_insensitive = "This test can't be run becase the file system is case insensitive";

# if the new file already exists - we don't allow it
# basically the same test as mv ping pong, except we do mv ping PING
# and both ping and PING exist on the filesystem
$test_name = "case sensitivity - simply don't allow mv if new file exists";
touch 'cs-n-1'; touch 'CS-N-1';
touch 'cs-y-1'; touch 'CS-Y-1';
darcs qw/add cs-n-1 cs-y-1/;
if ($is_case_sensitive) {
  # regardless of case-ok, we do NOT want this mv at all
  like(darcs(qw( mv           cs-n-1 CS-N-1)), $already_exists, $test_name);
  like(darcs(qw( mv --case-ok cs-y-1 CS-Y-1)), $already_exists, $test_name);
} else {
  pass ( $no_test_cuz_insensitive );
  pass ( $no_test_cuz_insensitive );
}

# if the new file does not already exist - we allow it
$test_name = "case sensitivity - the new file does *not* exist";
touch 'cs-n-2'; 
touch 'cs-y-2'; 
darcs qw/add cs-n-2/;
# these mv's should be allowed regardless of flag or filesystem
unlike(darcs(qw( mv           cs-n-2 CS-N-2)), $already_exists, $test_name);
unlike(darcs(qw( mv --case-ok cs-y-2 CS-Y-2)), $already_exists, $test_name);

# parasites - do not accidentally overwrite a file just because it has a
# similar name and points to the same inode.  We want to check if a file if the
# same NAME already exists - we shouldn't care about what the actual file is!
$test_name = "case sensitivity - inode check"; 
touch 'cs-n-3'; 
touch 'cs-y-3'; 
darcs qw/add cs-n-3 cs-y-3/;
if ($^O =~ /(msys|win32)/i) {
  # afaik, windows does not support hard links
  pass ('cannot run this test -- windows does not have hard links');
  pass ('cannot run this test -- windows does not have hard links');
} elsif ($is_case_sensitive) {
  `ln cs-n-3 CS-N-3`;
  `ln cs-y-3 CS-Y-3`;
  # regardless of case-ok, we do NOT want this mv at all
  like(darcs(qw( mv           cs-n-3 CS-N-3)), $already_exists, $test_name);
  like(darcs(qw( mv --case-ok cs-y-3 CS-Y-3)), $already_exists, $test_name);
} else {
  pass ( $no_test_cuz_insensitive );
  pass ( $no_test_cuz_insensitive );
}

# parasites - we don't allow weird stuff like mv foo bar/foo just because
# we opened up some crazy exception based on foo's name
$test_name = 'refuses to move to an existing file with same name, different path';
touch 'cs-n-4'; touch 'foo.d/cs-n-4';
touch 'cs-y-4'; touch 'foo.d/cs-y-4';
darcs qw/add cs-n-4/;
# regardless of case-ok, we do NOT want this mv at all 
like(darcs(qw( mv           cs-n-4 foo.d/cs-n-4)), $already_exists, $test_name);
like(darcs(qw( mv --case-ok cs-y-4 foo.d/cs-y-4)), $already_exists, $test_name);

# ---------------------------
# end case sensitivity series

touch 'abs_path.t';
darcs qw/add abs_path.t/;

{
  my $repo_abs = abs_path();
  chomp ($repo_abs);
  my $mv_out = darcs("mv $repo_abs/abs_path.t abs_path_new.t");
  unlike($mv_out, qr/darcs failed/, 'mv should work with absolute path as a src argument.');
}

{
  my $repo_abs = abs_path();
  chomp ($repo_abs);
  my $mv_out = darcs("mv abs_path_new.t $repo_abs/abs_path.t");
  unlike($mv_out, qr/darcs failed/, 'mv should work with absolute path as a target argument.');
}

# issue608
{
   touch 'gonna_be_deleted';
   darcs "add gonna_be_deleted";
   darcs "record -am 'added doomed file'";
   rm_rf "gonna_be_deleted"; 
   darcs "record -am 'deleted file'"; 
   touch 'new_file';
   darcs "add new_file";
   my $out = darcs "mv new_file gonna_be_deleted";
   is($out, "", "darcs mv should succeed");
}