针对Perl测试脚本的操作系统特定测试

时间:2009-10-26 11:18:02

标签: perl testing winapi perl-module

是否有更优雅的方式来编写与O / S相关的测试脚本部分?

请参阅注释行下面的代码。

背景:模块 Perl :: Tags 为VIM创建标记文件。在Win32上,目录分隔符是“\”,但在其他操作系统上它是“/”。 Vim的Perl支持模块似乎非常高兴地阅读了标签文件,所以似乎没有必要修改模块。

#!/usr/bin/perl -w
use strict; use warnings;
use Data::Dumper;

use Test::More tests => 6;
use FindBin qw($Bin);

BEGIN {
  use_ok( 'Perl::Tags' );
}

my $naive_tagger = Perl::Tags::Naive->new( max_level=>1 );
ok (defined $naive_tagger, 'created Perl::Tags' );
isa_ok ($naive_tagger, 'Perl::Tags::Naive' );
isa_ok ($naive_tagger, 'Perl::Tags' );

my $result = 
    $naive_tagger->process(
        files => [ "$Bin/Test.pm" ],
        refresh=> 1
    );
ok ($result, 'processed successfully' ) or diag "RESULT $result";

# Other tests also fail because \Test.pm on Win32 vs /Test.pm on Linux/ OS X
if ( $^O =~ /MSWin32/ ) {
    like ($naive_tagger, qr{Test\t\S+\\Test.pm\t/package Test;/}       , 'package line');
} else {
    like ($naive_tagger, qr{Test\t\S+/Test.pm\t/package Test;/}       , 'package line');
}

3 个答案:

答案 0 :(得分:3)

也许你可以简单地总是使用Linux样式斜杠,因为:

  

编写必须在NT和UNIX下运行的Perl脚本时,必须注意许多重要问题。首先,存在路径名的问题。在DOS,Windows NT和Windows 95中,您使用反斜杠运算符指定路径名,而在UNIX中使用正斜杠运算符。 Win32 Perl端口允许正斜杠或反斜杠。在路径名中使用正斜杠的Perl脚本比使用反斜杠的脚本更可能是可移植的。除此之外,Perl脚本必须在字符串中使用两次反斜杠才能从Perl解释器中转义反斜杠的一个实例。驱动器号不必更改。

     

例如,可以使用以下任一方法设置以下路径名:

$myFile = "E:/users/default/datafile.txt";

$myFile = "E:\\users\\default\\datafile.txt";

(来自Perl 5 Unleashed


如果您确定无法始终使用Linux样式,则可以尝试使用CPAN模块File::SpecPath::Class。查看"CPAN Module for mixing Unix/Windows path" discussion on Perlmonks以获取更多信息。

答案 1 :(得分:3)

构建

File::SpecPath::Class是为了解决这些特定于平台的问题。

以下是您要做的事情吗?

#!/usr/bin/perl
use strict; use warnings;

use Test::More tests => 6;
use FindBin qw($Bin);
use File::Spec::Functions qw(catfile catpath rootdir);

BEGIN {
  use_ok( 'Perl::Tags' );
}

my $naive_tagger = Perl::Tags::Naive->new(max_level => 1);
ok (defined $naive_tagger, 'created Perl::Tags');
isa_ok ($naive_tagger, 'Perl::Tags::Naive');
isa_ok ($naive_tagger, 'Perl::Tags');

my $result = 
    $naive_tagger->process(
        files => [ catfile($Bin, 'Test.pm') ],
        refresh => 1
    );
ok ($result, 'processed successfully' ) or diag "RESULT $result";

my $file = catfile(rootdir, 'Test.pm');
# or $file = catpath('C:', rootdir(), 'Test.pm')
# depending on what you mean.

like($naive_tagger
    qr{Test\t\S+\Q$file\E\t/package Test;/}, 
    'package line',
);

答案 2 :(得分:0)

根据SinanÜnür的指导修改 - 如果

,则无需进行操作系统特定测试
like ($naive_tagger, qr{Test\t\S\Test.pm\t/package Test;/}       , 'package line');

替换为

like ($naive_tagger, qr{Test\t\S+\QTest.pm\E\t/package Test;/}       , 'package line');

\ Q (禁用)模式元字符,直到\ E

\ E 再次禁用模式元字符