t/run/switches.t

   1 #!./perl -w
   2
   3 # Tests for the command-line switches
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     @INC = '../lib';
   8 }
   9
  10 require "./test.pl";
  11
  12 plan(tests => 14);
  13
  14 my $r;
  15 my @tmpfiles = ();
  16 END { unlink @tmpfiles }
  17
  18 # Tests for -0
  19
  20 $r = runperl(
  21     switches    => [ '-0', ],
  22     stdin       => 'foo\0bar\0baz\0',
  23     prog        => 'print qq(<$_>) while <>',
  24 );
  25 is( $r, "<foo\0><bar\0><baz\0>", "-0" );
  26
  27 $r = runperl(
  28     switches    => [ '-l', '-0', '-p' ],
  29     stdin       => 'foo\0bar\0baz\0',
  30     prog        => '1',
  31 );
  32 is( $r, "foo\nbar\nbaz\n", "-0 after a -l" );
  33
  34 $r = runperl(
  35     switches    => [ '-0', '-l', '-p' ],
  36     stdin       => 'foo\0bar\0baz\0',
  37     prog        => '1',
  38 );
  39 is( $r, "foo\0bar\0baz\0", "-0 before a -l" );
  40
  41 $r = runperl(
  42     switches    => [ sprintf("-0%o", ord 'x') ],
  43     stdin       => 'fooxbarxbazx',
  44     prog        => 'print qq(<$_>) while <>',
  45 );
  46 is( $r, "<foox><barx><bazx>", "-0 with octal number" );
  47
  48 $r = runperl(
  49     switches    => [ '-00', '-p' ],
  50     stdin       => 'abc\ndef\n\nghi\njkl\nmno\n\npq\n',
  51     prog        => 's/\n/-/g;$_.=q(/)',
  52 );
  53 is( $r, 'abc-def--/ghi-jkl-mno--/pq-/', '-00 (paragraph mode)' );
  54
  55 $r = runperl(
  56     switches    => [ '-0777', '-p' ],
  57     stdin       => 'abc\ndef\n\nghi\njkl\nmno\n\npq\n',
  58     prog        => 's/\n/-/g;$_.=q(/)',
  59 );
  60 is( $r, 'abc-def--ghi-jkl-mno--pq-/', '-0777 (slurp mode)' );
  61
  62 # Tests for -c
  63
  64 my $filename = 'swctest.tmp';
  65 SKIP: {
  66     open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
  67     print $f <<'SWTEST';
  68 BEGIN { print "block 1\n"; }
  69 CHECK { print "block 2\n"; }
  70 INIT  { print "block 3\n"; }
  71         print "block 4\n";
  72 END   { print "block 5\n"; }
  73 SWTEST
  74     close $f;
  75     $r = runperl(
  76         switches        => [ '-c' ],
  77         progfile        => $filename,
  78         stderr          => 1,
  79     );
  80     # Because of the stderr redirection, we can't tell reliably the order
  81     # in which the output is given
  82     ok(
  83         $r =~ /$filename syntax OK/
  84         && $r =~ /\bblock 1\b/
  85         && $r =~ /\bblock 2\b/
  86         && $r !~ /\bblock 3\b/
  87         && $r !~ /\bblock 4\b/
  88         && $r !~ /\bblock 5\b/,
  89         '-c'
  90     );
  91     push @tmpfiles, $filename;
  92 }
  93
  94 # Tests for -l
  95
  96 $r = runperl(
  97     switches    => [ sprintf("-l%o", ord 'x') ],
  98     prog        => 'print for qw/foo bar/'
  99 );
 100 is( $r, 'fooxbarx', '-l with octal number' );
 101
 102 # Tests for -s
 103
 104 $r = runperl(
 105     switches    => [ '-s' ],
 106     prog        => 'for (qw/abc def ghi/) {print defined $$_ ? $$_ : q(-)}',
 107     args        => [ '--', '-abc=2', '-def', ],
 108 );
 109 is( $r, '21-', '-s switch parsing' );
 110
 111 # Bug ID 20011106.084
 112 $filename = 'swstest.tmp';
 113 SKIP: {
 114     open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
 115     print $f <<'SWTEST';
 116 #!perl -s
 117 print $x
 118 SWTEST
 119     close $f;
 120     $r = runperl(
 121         switches    => [ '-s' ],
 122         progfile    => $filename,
 123         args        => [ '-x=foo' ],
 124     );
 125     is( $r, 'foo', '-s on the #! line' );
 126     push @tmpfiles, $filename;
 127 }
 128
 129 # Tests for -m and -M
 130
 131 $filename = 'swtest.pm';
 132 SKIP: {
 133     open my $f, ">$filename" or skip( "Can't write temp file $filename: $!",4 );
 134     print $f <<'SWTESTPM';
 135 package swtest;
 136 sub import { print map "<$_>", @_ }
 137 1;
 138 SWTESTPM
 139     close $f;
 140     $r = runperl(
 141         switches    => [ '-Mswtest' ],
 142         prog        => '1',
 143     );
 144     is( $r, '<swtest>', '-M' );
 145     $r = runperl(
 146         switches    => [ '-Mswtest=foo' ],
 147         prog        => '1',
 148     );
 149     is( $r, '<swtest><foo>', '-M with import parameter' );
 150     $r = runperl(
 151         switches    => [ '-mswtest' ],
 152         prog        => '1',
 153     );
 154     is( $r, '', '-m' );
 155     $r = runperl(
 156         switches    => [ '-mswtest=foo,bar' ],
 157         prog        => '1',
 158     );
 159     is( $r, '<swtest><foo><bar>', '-m with import parameters' );
 160     push @tmpfiles, $filename;
 161 }