1#!perl -w 2use strict; 3 4# $Id: test.t,v 1.6 2010-06-11 20:08:57 roderick Exp $ 5# 6# Copyright (c) 1997 Roderick Schertler. All rights reserved. This 7# program is free software; you can redistribute it and/or modify it 8# under the same terms as Perl itself. 9 10BEGIN { 11 $| = 1; 12 print "1..33\n"; 13} 14 15use String::ShellQuote; 16 17my $test_num = 0; 18sub ok { 19 my ($result, @info) = @_; 20 $test_num++; 21 if ($result) { 22 print "ok $test_num\n"; 23 } 24 else { 25 print "not ok $test_num\n"; 26 print "# ", @info, "\n" if @info; 27 } 28} 29 30my $testsub; 31sub test { 32 my ($want, @args) = @_; 33 my $pid = $$; 34 my $got = eval { &$testsub(@args) }; 35 exit if $$ != $pid; 36 if ($@) { 37 chomp $@; 38 $@ =~ s/ at \S+ line \d+\.?\z//; 39 $got = "die: $@"; 40 } 41 my $from_line = (caller)[2]; 42 ok $got eq $want, 43 qq{line $from_line\n# wanted [$want]\n# got [$got]}; 44} 45 46$testsub = \&shell_quote; 47test ''; 48test q{''}, ''; 49test q{''}, undef; 50test q{foo}, qw(foo); 51test q{foo bar}, qw(foo bar); 52test q{'foo*'}, qw(foo*); 53test q{'foo bar'}, q{foo bar}; 54test q{'foo'\''bar'}, qw(foo'bar); 55test q{\''foo'}, qw('foo); 56test q{foo 'bar*'}, qw(foo bar*); 57test q{'foo'\''foo' bar 'baz'\'}, qw(foo'foo bar baz'); 58test q{'\'}, qw(\\); 59test q{\'}, qw('); 60test q{'\'\'}, qw(\'); 61test q{'a'"''"'b'}, qw(a''b); 62test q{azAZ09_!%+,-./:@^}, q{azAZ09_!%+,-./:@^}; 63test q{'foo=bar' command}, qw(foo=bar command); 64test q{'foo=bar' 'baz=quux' command}, qw(foo=bar baz=quux command); 65test 66 "die: shell_quote(): No way to quote string containing null (\\000) bytes", 67 "t\x00"; 68 69$testsub = \&shell_quote_best_effort; 70test ''; 71test q{''}, ''; 72test q{''}, undef; 73test q{'foo*'}, 'foo*'; 74test q{'foo*' asdf}, 'foo*', "as\x00df"; 75 76$testsub = \&shell_comment_quote; 77test ''; 78test qq{foo}, qq{foo}; 79test qq{foo\n#bar}, qq{foo\nbar}; 80test qq{foo\n#bar\n#baz}, qq{foo\nbar\nbaz}; 81test "die: Too many arguments to shell_comment_quote (got 2 expected 1)", 82 'foo', 'bar'; 83 84sub via_shell { 85 my @args = @_; 86 my $cmd = 'blib/script/shell-quote'; 87 my $pid = open PIPE, '-|'; 88 defined $pid 89 or return "can't fork: $!\n"; 90 if (!$pid) { 91 if (!open STDERR, '>&STDOUT') { 92 print "$0: can't dup stdout: $!\n"; 93 exit 1; 94 } 95 exec $cmd, @args 96 or die "$0: can't run $cmd: $!\n"; 97 } 98 my $r = join '', <PIPE>; 99 if (!close PIPE) { 100 $r .= "$cmd failed: " . ($! ? $! : "non-zero exit $?") . "\n"; 101 } 102 return $r; 103} 104 105if ($^O eq 'MSWin32') { 106 print "ok # skip not working on MSWin32\n" x 4; 107} else { 108 $testsub = \&via_shell; 109 test ''; 110 test qq{a\n}, 'a'; 111 test qq{''\n}, ''; 112 test qq{foo 'bar baz' '*'\n}, 'foo', 'bar baz', '*'; 113} 114