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