Commit | Line | Data |
---|---|---|
8d063cd8 LW |
1 | #!./perl |
2 | ||
8b393137 NC |
3 | print "1..6\n"; |
4 | my $test = 0; | |
5 | ||
6 | sub failed { | |
7 | my ($got, $expected, $name) = @_; | |
8 | ||
9 | print "not ok $test - $name\n"; | |
10 | my @caller = caller(1); | |
11 | print "# Failed test at $caller[1] line $caller[2]\n"; | |
12 | if (defined $got) { | |
13 | print "# Got '$got'\n"; | |
14 | } else { | |
15 | print "# Got undef\n"; | |
16 | } | |
17 | print "# Expected $expected\n"; | |
18 | return; | |
7bbfeec9 | 19 | } |
8d063cd8 | 20 | |
8b393137 NC |
21 | sub like { |
22 | my ($got, $pattern, $name) = @_; | |
23 | $test = $test + 1; | |
24 | if (defined $got && $got =~ $pattern) { | |
25 | print "ok $test - $name\n"; | |
26 | # Principle of least surprise - maintain the expected interface, even | |
27 | # though we aren't using it here (yet). | |
28 | return 1; | |
29 | } | |
9924e635 | 30 | failed($got, $pattern, $name); |
8b393137 NC |
31 | } |
32 | ||
33 | sub is { | |
34 | my ($got, $expect, $name) = @_; | |
35 | $test = $test + 1; | |
36 | if (defined $got && $got eq $expect) { | |
37 | print "ok $test - $name\n"; | |
38 | return 1; | |
39 | } | |
9924e635 | 40 | failed($got, "'$expect'", $name); |
8b393137 NC |
41 | } |
42 | ||
43 | my $filename = "multiline$$"; | |
44 | ||
45 | END { | |
46 | 1 while unlink $filename; | |
47 | } | |
8d063cd8 | 48 | |
2d90ac95 | 49 | open(TRY,'>',$filename) || (die "Can't open $filename: $!"); |
8d063cd8 LW |
50 | |
51 | $x = 'now is the time | |
52 | for all good men | |
53 | to come to. | |
c6f14548 GS |
54 | |
55 | ||
56 | ! | |
57 | ||
8d063cd8 LW |
58 | '; |
59 | ||
60 | $y = 'now is the time' . "\n" . | |
61 | 'for all good men' . "\n" . | |
c6f14548 | 62 | 'to come to.' . "\n\n\n!\n\n"; |
8d063cd8 | 63 | |
7bbfeec9 | 64 | is($x, $y, 'test data is sane'); |
8d063cd8 | 65 | |
7bbfeec9 | 66 | print TRY $x; |
d1e4d418 | 67 | close TRY or die "Could not close: $!"; |
8d063cd8 | 68 | |
2d90ac95 | 69 | open(TRY,$filename) || (die "Can't reopen $filename: $!"); |
8d063cd8 LW |
70 | $count = 0; |
71 | $z = ''; | |
7bbfeec9 | 72 | while (<TRY>) { |
8d063cd8 LW |
73 | $z .= $_; |
74 | $count = $count + 1; | |
75 | } | |
76 | ||
7bbfeec9 | 77 | is($z, $y, 'basic multiline reading'); |
8d063cd8 | 78 | |
7bbfeec9 MS |
79 | is($count, 7, ' line count'); |
80 | is($., 7, ' $.' ); | |
8d063cd8 | 81 | |
3551ef6f CB |
82 | $out = (($^O eq 'MSWin32') || $^O eq 'NetWare') ? `type $filename` |
83 | : ($^O eq 'VMS') ? `type $filename.;0` # otherwise .LIS is assumed | |
2d90ac95 | 84 | : `cat $filename`; |
8d063cd8 | 85 | |
7bbfeec9 | 86 | like($out, qr/.*\n.*\n.*\n$/); |
bbad3607 | 87 | |
2d90ac95 | 88 | close(TRY) || (die "Can't close $filename: $!"); |
8d063cd8 | 89 | |
7bbfeec9 | 90 | is($out, $y); |