arch_check.t revision 1.1.1.1 
1#!/usr/bin/perl -w
2
3use strict;
4use lib 't/lib';
5
6use TieOut;
7use Test::More 'no_plan';
8
9use Config;
10use ExtUtils::MakeMaker;
11
12ok( my $stdout = tie *STDOUT, 'TieOut' );    
13
14# Create a normalized MM object to test with
15my $mm = bless {}, "MM";
16$mm->{PERL_SRC} = 0;
17$mm->{UNINSTALLED_PERL} = 0;
18
19my $rel2abs = sub { $mm->rel2abs($mm->catfile(@_)) };
20
21ok $mm->arch_check(
22    $rel2abs->(qw(. t testdata reallylongdirectoryname arch1 Config.pm)),
23    $rel2abs->(qw(. t testdata reallylongdirectoryname arch1 Config.pm)),
24);
25
26
27# Different architecures.
28{
29    ok !$mm->arch_check(
30        $rel2abs->(qw(. t testdata reallylongdirectoryname arch1 Config.pm)),
31        $rel2abs->(qw(. t testdata reallylongdirectoryname arch2 Config.pm)),
32    );
33
34    like $stdout->read, qr{\Q
35Your perl and your Config.pm seem to have different ideas about the 
36architecture they are running on.
37Perl thinks: [arch1]
38Config says: [$Config{archname}]
39This may or may not cause problems. Please check your installation of perl 
40if you have problems building this extension.
41};
42
43}
44
45
46# Different file path separators [rt.cpan.org 46416]
47SKIP: {
48    require File::Spec;
49    skip "Win32 test", 1 unless File::Spec->isa("File::Spec::Win32");
50
51    ok $mm->arch_check(
52        "/_64/perl1004/lib/Config.pm",
53        '\\_64\\perl1004\\lib\\Config.pm',
54    );
55}
56
57
58# PERL_SRC is set, no check is done
59{
60    # Clear our log
61    $stdout->read;
62
63    local $mm->{PERL_SRC} = 1;
64    ok $mm->arch_check(
65      $rel2abs->(qw(. t testdata reallylongdirectoryname arch1 Config.pm)),
66      $rel2abs->(qw(. t testdata reallylongdirectoryname arch2 Config.pm)),
67    );
68
69    is $stdout->read, '';
70}
71
72
73# UNINSTALLED_PERL is set, no message is sent
74{
75    local $mm->{UNINSTALLED_PERL} = 1;
76    ok !$mm->arch_check(
77      $rel2abs->(qw(. t testdata reallylongdirectoryname arch1 Config.pm)),
78      $rel2abs->(qw(. t testdata reallylongdirectoryname arch2 Config.pm)),
79    );
80
81    like $stdout->read, qr{^Have .*\nWant .*$};
82}
83