Add ARM files

[dh-make-perl] / dev / arm / libfile-chdir-perl / libfile-chdir-perl-0.06 / t / array.t

diff --git a/dev/arm/libfile-chdir-perl/libfile-chdir-perl-0.06/t/array.t b/dev/arm/libfile-chdir-perl/libfile-chdir-perl-0.06/t/array.t
new file mode 100644 (file)
index 0000000..541c098
--- /dev/null
+++ b/dev/arm/libfile-chdir-perl/libfile-chdir-perl-0.06/t/array.t
@@ -0,0 +1,101 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use lib qw(t/lib);
+use Test::More tests => 31;
+
+BEGIN { use_ok('File::chdir') }
+
+use Cwd;
+
+sub _catdir {
+    File::Spec->catdir(File::Spec->rootdir, @_);
+}
+
+my @cwd = grep length, File::Spec->splitdir(Cwd::abs_path);
+
+ok( tied @CWD,      '@CWD is fit to be tied' );
+
+# First, let's try unlocalized push @CWD.
+{
+    push @CWD, 't';
+    is( getcwd, _catdir(@cwd,'t'),       'unlocalized push @CWD works' );
+    ok( eq_array(\@CWD, [@cwd, 't']),    '  @CWD set' );
+    is( $CWD,   _catdir(@cwd,'t'),       '  $CWD set' );
+}
+
+is( getcwd, _catdir(@cwd,'t'),      'unlocalized @CWD unneffected by blocks' );
+ok( eq_array(\@CWD, [@cwd, 't']),   '  @CWD still set' );
+
+# reset
+@CWD = @cwd;
+
+# How about pop?
+{
+    my $popped_dir = pop @CWD;
+    my @new_cwd = @cwd[0..$#cwd-1];
+
+    is( getcwd, _catdir(@new_cwd),      'unlocalized pop @CWD works' );
+    is( $popped_dir, $cwd[-1],          '  returns popped dir' ); 
+    ok( eq_array(\@CWD, \@new_cwd),     '  @CWD set' );
+    is( $CWD,   _catdir(@new_cwd),      '  $CWD set' );
+}
+
+is( getcwd, _catdir(@cwd[0..$#cwd-1]), 
+                                  'unlocalized @CWD unneffected by blocks' );
+ok( eq_array(\@CWD, [@cwd[0..$#cwd-1]]),   '  @CWD still set' );
+
+# reset
+@CWD = @cwd;
+
+
+# splice?
+{
+    my @spliced_dirs = splice @CWD, -2;
+    my @new_cwd = @cwd[0..$#cwd-2];
+
+    is( getcwd, _catdir(@new_cwd),      'unlocalized splice @CWD works' );
+    is( @spliced_dirs, 2,               '  returns right # of dirs' );
+    ok( eq_array(\@spliced_dirs, [@cwd[-2,-1]]), "  and they're correct" );
+    ok( eq_array(\@CWD, \@new_cwd),     '  @CWD set' );
+    is( $CWD,   _catdir(@new_cwd),      '  $CWD set' );
+}
+
+is( getcwd, _catdir(@cwd[0..$#cwd-2]),
+                                    'unlocalized @CWD unneffected by blocks' );
+ok( eq_array(\@CWD, [@cwd[0..$#cwd-2]]),   '  @CWD still set' );
+
+# reset
+@CWD = @cwd;
+
+# Now an unlocalized assignment
+{
+    @CWD = (@cwd, 't');
+    is( getcwd, _catdir(@cwd,'t'),       'unlocalized @CWD works' );
+    ok( eq_array(\@CWD, [@cwd, 't']),   '  @CWD set' );
+    is( $CWD,   _catdir(@cwd,'t'),       '  $CWD set' );
+}
+
+is( getcwd, _catdir(@cwd,'t'),      'unlocalized @CWD unneffected by blocks' );
+ok( eq_array(\@CWD, [@cwd, 't']),   '  @CWD still set' );
+
+# reset
+@CWD = @cwd;
+
+eval { $#CWD = 1; };
+ok( !$@,    '$#CWD assignment is a no-op' );
+
+
+# localized assignment
+{
+    # localizing tied arrays doesn't work, perl bug. :(
+    # this is a work around.
+    local $CWD;
+    @CWD = (@cwd, 't');
+    is( getcwd, _catdir(@cwd,'t'),       'localized @CWD works' );
+    ok( eq_array(\@CWD, [@cwd, 't']),   '  @CWD set' );
+    is( $CWD,   _catdir(@cwd,'t'),       '  $CWD set' );
+}
+
+is( getcwd, _catdir(@cwd),    'localized @CWD resets cwd' );
+ok( eq_array(\@CWD, \@cwd),   '  @CWD reset' );