This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/lib/croak/regcomp: Fix up for EBCDIC
[perl5.git] / t / lib / deprecate.t
index 1b66129..09b258f 100644 (file)
@@ -1,27 +1,29 @@
+#!perl -w
 use strict;
 
 BEGIN {
-       chdir 't' if -d 't';
-       chdir 'lib/deprecate' or die "Can't see lib/deprecate";
-       @INC = qw(../../../lib
-               lib/perl/arch
-               lib/perl
-               lib/site/arch
-               lib/site
-       );
+    chdir 't' if -d 't';
+    require './test.pl';
 }
 use File::Copy ();
 use File::Path ();
-use Test::More tests => 10;
+use File::Spec ();
+plan(tests => 10);
+
+my $test_dir = File::Spec->catdir(qw(lib deprecate));
+chdir $test_dir or die "Can't chdir $test_dir";
+@INC = ( File::Spec->catdir( (File::Spec->updir)x3, qw(lib)) );
 
 my %libdir = (
-       privlibexp      => 'lib/perl',
-       sitelibexp      => 'lib/site',
-       archlibexp      => 'lib/perl/arch',
-       sitearchexp     => 'lib/site/arch',
+       privlibexp      => File::Spec->catdir(qw(lib perl)),
+       sitelibexp      => File::Spec->catdir(qw(lib site)),
+       archlibexp      => File::Spec->catdir(qw(lib perl arch)),
+       sitearchexp     => File::Spec->catdir(qw(lib site arch)),
 );
 
-mkdir for 'lib', sort values %libdir;
+File::Path::make_path(values %libdir); 
+
+push @INC, @libdir{qw(archlibexp privlibexp sitearchexp sitelibexp)};
 
 our %tests = (
        privlibexp      => 1,
@@ -30,13 +32,16 @@ our %tests = (
        sitearchexp     => 0,
 );
 
+no warnings 'once';
 local %deprecate::Config = (%libdir);
 
+my $module = 'Deprecated.pm';
 for my $lib (sort keys %tests) {
     my $dir = $libdir{$lib};
-    File::Copy::copy 'Deprecated.pm', "$dir/Deprecated.pm";
+    my $pm = File::Spec->catfile($dir, $module);
+    File::Copy::copy($module, $pm);
 
-    my $warn;
+    my $warn = '';
     {   local $SIG{__WARN__} = sub { $warn .= $_[0]; };
         use warnings qw(deprecated);
 #line 1001
@@ -45,22 +50,27 @@ for my $lib (sort keys %tests) {
     }
     if( $tests{$lib} ) {
         like($warn, qr/^Deprecated\s+will\s+be\s+removed\b/, "$lib - message");
-        like($warn, qr/$0,?\s+line\s+1001\.?\n*$/, "$lib - location");
+        my $me = quotemeta($0);
+        like($warn, qr/$me,?\s+line\s+1001\.?\n*$/, "$lib - location");
     }
     else {
        ok( !$warn, "$lib - no message" );
     }
 
-    delete $INC{'Deprecated.pm'};
-    unlink "$dir/Deprecated.pm";
+    delete $INC{$module};
+    unlink_all $pm;
 }
 
+my $sub_dir = 'Optionally';
+my $opt_mod = $sub_dir .'.pm';
 for my $lib (sort keys %tests) {
-    my $dir = $libdir{$lib};
-    mkdir "$dir/Optionally";
-    File::Copy::copy 'Optionally.pm', "$dir/Optionally/Deprecated.pm";
+    my $dir = File::Spec->catdir($libdir{$lib}, $sub_dir);
+    File::Path::make_path($dir);
 
-    my $warn;
+    my $pm = File::Spec->catfile($dir, $module);
+    File::Copy::copy($opt_mod, $pm);
+
+    my $warn = '';
     {   local $SIG{__WARN__} = sub { $warn .= $_[0]; };
         use warnings qw(deprecated);
        require Optionally::Deprecated;
@@ -73,7 +83,8 @@ for my $lib (sort keys %tests) {
        ok( !$warn, "$lib - use if - no message" );
     }
 
-    delete $INC{'Optionally/Deprecated.pm'};
-    unlink "$dir/Optionally/Deprecated.pm";
+    delete $INC{"$sub_dir/$module"};
+    unlink_all $pm;
 }
-# END { File::Path::rmtree 'lib' }
+
+END { File::Path::remove_tree('lib') }