Commit | Line | Data |
---|---|---|
af6f229e | 1 | BEGIN { |
b9e0df4c GA |
2 | if ($ENV{PERL_CORE}) { |
3 | chdir 't' if -d 't'; | |
4 | @INC = '../lib'; | |
5 | } | |
af6f229e GS |
6 | } |
7 | ||
8 | use MIME::QuotedPrint; | |
9 | ||
10 | $x70 = "x" x 70; | |
11 | ||
12 | @tests = | |
13 | ( | |
14 | # plain ascii should not be encoded | |
15 | ["quoted printable" => | |
16 | "quoted printable"], | |
17 | ||
18 | # 8-bit chars should be encoded | |
31b48da6 | 19 | ["v\xe5re kj\xe6re norske tegn b\xf8r \xe6res" => |
af6f229e GS |
20 | "v=E5re kj=E6re norske tegn b=F8r =E6res"], |
21 | ||
22 | # trailing space should be encoded | |
23 | [" " => "=20=20"], | |
24 | ["\tt\t" => "\tt=09"], | |
25 | ["test \ntest\n\t \t \n" => "test=20=20\ntest\n=09=20=09=20\n"], | |
26 | ||
27 | # "=" is special an should be decoded | |
28 | ["=\n" => "=3D\n"], | |
29 | ["\0\xff" => "=00=FF"], | |
30 | ||
31 | # Very long lines should be broken (not more than 76 chars | |
32 | ["The Quoted-Printable encoding is intended to represent data that largly consists of octets that correspond to printable characters in the ASCII character set." => | |
33 | "The Quoted-Printable encoding is intended to represent data that largly con= | |
34 | sists of octets that correspond to printable characters in the ASCII charac= | |
35 | ter set." | |
36 | ], | |
37 | ||
38 | # Long lines after short lines were broken through 2.01. | |
39 | ["short line | |
40 | In America, any boy may become president and I suppose that's just one of the risks he takes. -- Adlai Stevenson" => | |
41 | "short line | |
42 | In America, any boy may become president and I suppose that's just one of t= | |
43 | he risks he takes. -- Adlai Stevenson"], | |
44 | ||
45 | # My (roderick@argon.org) first crack at fixing that bug failed for | |
46 | # multiple long lines. | |
47 | ["College football is a game which would be much more interesting if the faculty played instead of the students, and even more interesting if the | |
48 | trustees played. There would be a great increase in broken arms, legs, and necks, and simultaneously an appreciable diminution in the loss to humanity. -- H. L. Mencken" => | |
49 | "College football is a game which would be much more interesting if the facu= | |
50 | lty played instead of the students, and even more interesting if the | |
51 | trustees played. There would be a great increase in broken arms, legs, and= | |
52 | necks, and simultaneously an appreciable diminution in the loss to humanit= | |
53 | y. -- H. L. Mencken"], | |
54 | ||
55 | # Don't break a line that's near but not over 76 chars. | |
56 | ["$x70!23" => "$x70!23"], | |
57 | ["$x70!234" => "$x70!234"], | |
58 | ["$x70!2345" => "$x70!2345"], | |
59 | ["$x70!23456" => "$x70!23456"], | |
60 | ["$x70!23\n" => "$x70!23\n"], | |
61 | ["$x70!234\n" => "$x70!234\n"], | |
62 | ["$x70!2345\n" => "$x70!2345\n"], | |
63 | ["$x70!23456\n" => "$x70!23456\n"], | |
64 | ||
65 | # Not allowed to break =XX escapes using soft line break | |
66 | ["$x70===xxxx" => "$x70=3D=\n=3D=3Dxxxx"], | |
67 | ["$x70!===xxx" => "$x70!=3D=\n=3D=3Dxxx"], | |
68 | ["$x70!!===xx" => "$x70!!=3D=\n=3D=3Dxx"], | |
69 | ["$x70!!!===x" => "$x70!!!=\n=3D=3D=3Dx"], | |
70 | # ^ | |
71 | # 70123456| | |
72 | # max | |
73 | # line width | |
74 | ); | |
75 | ||
b1387238 | 76 | $notests = @tests + 3; |
af6f229e GS |
77 | print "1..$notests\n"; |
78 | ||
79 | $testno = 0; | |
80 | for (@tests) { | |
81 | $testno++; | |
82 | ($plain, $encoded) = @$_; | |
95635e5f PP |
83 | if (ord('A') == 193) { # EBCDIC 8 bit chars are different |
84 | if ($testno == 2) { $plain =~ s/\xe5/\x47/; $plain =~ s/\xe6/\x9c/g; $plain =~ s/\xf8/\x70/; } | |
85 | if ($testno == 7) { $plain =~ s/\xff/\xdf/; } | |
86 | } | |
af6f229e GS |
87 | $x = encode_qp($plain); |
88 | if ($x ne $encoded) { | |
89 | print "Encode test failed\n"; | |
90 | print "Got: '$x'\n"; | |
91 | print "Expected: '$encoded'\n"; | |
92 | print "not ok $testno\n"; | |
93 | next; | |
94 | } | |
95 | $x = decode_qp($encoded); | |
96 | if ($x ne $plain) { | |
97 | print "Decode test failed\n"; | |
98 | print "Got: '$x'\n"; | |
99 | print "Expected: '$plain'\n"; | |
100 | print "not ok $testno\n"; | |
101 | next; | |
102 | } | |
103 | print "ok $testno\n"; | |
104 | } | |
105 | ||
106 | # Some extra testing for a case that was wrong until libwww-perl-5.09 | |
107 | print "not " unless decode_qp("foo \n\nfoo =\n\nfoo=20\n\n") eq | |
108 | "foo\n\nfoo \nfoo \n\n"; | |
109 | $testno++; print "ok $testno\n"; | |
110 | ||
111 | # Same test but with "\r\n" terminated lines | |
112 | print "not " unless decode_qp("foo \r\n\r\nfoo =\r\n\r\nfoo=20\r\n\r\n") eq | |
113 | "foo\r\n\r\nfoo \r\nfoo \r\n\r\n"; | |
114 | $testno++; print "ok $testno\n"; | |
115 | ||
b9e0df4c | 116 | print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || $@ !~ /^The Quoted-Printable encoding is only defined for bytes/); |
b1387238 | 117 | $testno++; print "ok $testno\n"; |