File: copylink-script.t

package info (click to toggle)
libfile-copy-link-perl 0.200-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 180 kB
  • sloc: perl: 601; makefile: 11
file content (75 lines) | stat: -rw-r--r-- 1,903 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
#!perl
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl copylink.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;
    my $bindir = $ENV{AUTOPKGTEST_TMP} ? '/usr/bin' : './blib/script';
    require "$bindir/copylink";
}

#########################

# 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, q{>}, $file or die;
print {$fh} "text\n" or die;
close $fh            or die;

die $! if not( symlink 'file.txt', $link );
die    if not( -l $link );
die    if compare( $file, $link );

open $fh, q{>>}, $file or die;
print {$fh} "more\n"        or die;
close $fh                   or die;
not compare( $file, $link ) or die;

my $warn;
my $main;
{
    local $SIG{__WARN__} = sub { $warn .= $_[0]; };
    local @ARGV = ($link);
    $main = eval { main(); 1; };
}

ok( $main,  q{copylink script} );
ok( !$warn, q{copylink script - no warnings} ); 
ok( !( -l $link ),            q{not a link} );
ok( !compare( $file, $link ), q{compare file and copy} );

open $fh, q{>>}, $file or die;
print {$fh} qq{more\n} or die;
close $fh              or die;

compare( $file, $link ) or die;
unlink $file            or die;

ok( -e $link, q{copy not deleted} );
unlink $link or die;
ok( !( -e $link ), q{copy deleted} );

# $Id$