xref: /openbsd/gnu/usr.bin/perl/t/lib/deprecate.t (revision 5af055cd) 
1#!perl -w
2use strict;
3
4BEGIN {
5    require './test.pl';
6}
7use File::Copy ();
8use File::Path ();
9use File::Spec ();
10plan(tests => 10);
11
12my $test_dir = File::Spec->catdir(qw(lib deprecate));
13chdir $test_dir or die "Can't chdir $test_dir";
14@INC = ( File::Spec->catdir( (File::Spec->updir)x3, qw(lib)) );
15
16my %libdir = (
17	privlibexp	=> File::Spec->catdir(qw(lib perl)),
18	sitelibexp	=> File::Spec->catdir(qw(lib site)),
19	archlibexp	=> File::Spec->catdir(qw(lib perl arch)),
20	sitearchexp	=> File::Spec->catdir(qw(lib site arch)),
21);
22
23File::Path::make_path(values %libdir);
24
25push @INC, @libdir{qw(archlibexp privlibexp sitearchexp sitelibexp)};
26
27our %tests = (
28	privlibexp	=> 1,
29	sitelibexp	=> 0,
30	archlibexp	=> 1,
31	sitearchexp	=> 0,
32);
33
34no warnings 'once';
35local %deprecate::Config = (%libdir);
36
37my $module = 'Deprecated.pm';
38for my $lib (sort keys %tests) {
39    my $dir = $libdir{$lib};
40    my $pm = File::Spec->catfile($dir, $module);
41    File::Copy::copy($module, $pm);
42
43    my $warn = '';
44    {   local $SIG{__WARN__} = sub { $warn .= $_[0]; };
45        use warnings qw(deprecated);
46#line 1001
47	require Deprecated;
48#line
49    }
50    if( $tests{$lib} ) {
51        like($warn, qr/^Deprecated\s+will\s+be\s+removed\b/, "$lib - message");
52        my $me = quotemeta($0);
53        like($warn, qr/$me,?\s+line\s+1001\.?\n*$/, "$lib - location");
54    }
55    else {
56	ok( !$warn, "$lib - no message" );
57    }
58
59    delete $INC{$module};
60    unlink_all $pm;
61}
62
63my $sub_dir = 'Optionally';
64my $opt_mod = $sub_dir .'.pm';
65for my $lib (sort keys %tests) {
66    my $dir = File::Spec->catdir($libdir{$lib}, $sub_dir);
67    File::Path::make_path($dir);
68
69    my $pm = File::Spec->catfile($dir, $module);
70    File::Copy::copy($opt_mod, $pm);
71
72    my $warn = '';
73    {   local $SIG{__WARN__} = sub { $warn .= $_[0]; };
74        use warnings qw(deprecated);
75	require Optionally::Deprecated;
76    }
77    if( $tests{$lib} ) {
78        like($warn, qr/^Optionally::Deprecated\s+will\s+be\s+removed\b/,
79		"$lib - use if - message");
80    }
81    else {
82	ok( !$warn, "$lib - use if - no message" );
83    }
84
85    delete $INC{"$sub_dir/$module"};
86    unlink_all $pm;
87}
88
89END { File::Path::remove_tree('lib') }
90