Commit | Line | Data |
8d063cd8 |
1 | #!./perl |
2 | |
8b393137 |
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 |
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 |
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 |
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 |
50 | |
51 | $x = 'now is the time |
52 | for all good men |
53 | to come to. |
c6f14548 |
54 | |
55 | |
56 | ! |
57 | |
8d063cd8 |
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 |
70 | $count = 0; |
71 | $z = ''; |
7bbfeec9 |
72 | while (<TRY>) { |
8d063cd8 |
73 | $z .= $_; |
74 | $count = $count + 1; |
75 | } |
76 | |
7bbfeec9 |
77 | is($z, $y, 'basic multiline reading'); |
8d063cd8 |
78 | |
7bbfeec9 |
79 | is($count, 7, ' line count'); |
80 | is($., 7, ' $.' ); |
8d063cd8 |
81 | |
3551ef6f |
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); |