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
|
#!perl
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl safecopylink.t'
use strict;
use warnings;
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More;
BEGIN {
require './t/can_symlink.pl';
if ( !can_symlink() ) {
plan skip_all => skip_symlink_message();
}
plan tests => 6;
use_ok( 'File::Copy::Link', qw(safecopylink) );
}
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
use File::Compare;
use File::Temp qw(tempdir);
use File::Spec;
my $dir = tempdir();
my $file = File::Spec->catfile( $dir, 'file.txt' );
my $link = File::Spec->catfile( $dir, 'link.lnk' );
open my $fh, ">", $file or die;
print $fh "text\n" or die;
close $fh or die;
die
unless symlink( 'file.txt', $link ) && -l $link && !compare( $file, $link );
open $fh, ">>", $file or die;
print $fh "more\n" or die;
close $fh or die;
not compare( $file, $link ) or die;
ok( safecopylink($link), "safecopylink" );
ok( !( -l $link ), "not a link" );
ok( !compare( $file, $link ), "compare file and copy" );
open $fh, ">>", $file or die;
print $fh "more\n" or die;
close $fh or die;
compare( $file, $link ) or die;
unlink $file or die;
ok( -e $link, "copy not deleted" );
unlink $link or die;
ok( !( -e $link ), "copy deleted" );
# $Id$
|
