| Commit | Line | Data |
|---|
| af6f229e |
1 | BEGIN { |
| b9e0df4c |
2 | if ($ENV{PERL_CORE}) { |
| 3 | chdir 't' if -d 't'; |
| 4 | @INC = '../lib'; |
| 5 | } |
| af6f229e |
6 | } |
| 7 | |
| 8 | use MIME::QuotedPrint; |
| 9 | |
| 10 | $x70 = "x" x 70; |
| 11 | |
| df4d7026 |
12 | $IsASCII = ord('A') == 65; |
| 13 | $IsEBCDIC = ord('A') == 193; |
| 14 | |
| 15 | if ($IsASCII) { |
| 16 | |
| af6f229e |
17 | @tests = |
| 18 | ( |
| 19 | # plain ascii should not be encoded |
| 9e87bee3 |
20 | ["", ""], |
| af6f229e |
21 | ["quoted printable" => |
| 9e87bee3 |
22 | "quoted printable=\n"], |
| af6f229e |
23 | |
| 24 | # 8-bit chars should be encoded |
| 31b48da6 |
25 | ["v\xe5re kj\xe6re norske tegn b\xf8r \xe6res" => |
| 9e87bee3 |
26 | "v=E5re kj=E6re norske tegn b=F8r =E6res=\n"], |
| af6f229e |
27 | |
| 28 | # trailing space should be encoded |
| 9e87bee3 |
29 | [" " => "=20=20=\n"], |
| 30 | ["\tt\t" => "\tt=09=\n"], |
| af6f229e |
31 | ["test \ntest\n\t \t \n" => "test=20=20\ntest\n=09=20=09=20\n"], |
| 32 | |
| 33 | # "=" is special an should be decoded |
| 6a63fb82 |
34 | ["=30\n" => "=3D30\n"], |
| 9e87bee3 |
35 | ["\0\xff0" => "=00=FF0=\n"], |
| af6f229e |
36 | |
| 37 | # Very long lines should be broken (not more than 76 chars |
| 38 | ["The Quoted-Printable encoding is intended to represent data that largly consists of octets that correspond to printable characters in the ASCII character set." => |
| 39 | "The Quoted-Printable encoding is intended to represent data that largly con= |
| 40 | sists of octets that correspond to printable characters in the ASCII charac= |
| 9e87bee3 |
41 | ter set.=\n" |
| af6f229e |
42 | ], |
| 43 | |
| 44 | # Long lines after short lines were broken through 2.01. |
| 45 | ["short line |
| 46 | In America, any boy may become president and I suppose that's just one of the risks he takes. -- Adlai Stevenson" => |
| 47 | "short line |
| 48 | In America, any boy may become president and I suppose that's just one of t= |
| 9e87bee3 |
49 | he risks he takes. -- Adlai Stevenson=\n"], |
| af6f229e |
50 | |
| 51 | # My (roderick@argon.org) first crack at fixing that bug failed for |
| 52 | # multiple long lines. |
| 53 | ["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 |
| 54 | 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" => |
| 55 | "College football is a game which would be much more interesting if the facu= |
| 56 | lty played instead of the students, and even more interesting if the |
| 57 | trustees played. There would be a great increase in broken arms, legs, and= |
| 58 | necks, and simultaneously an appreciable diminution in the loss to humanit= |
| 9e87bee3 |
59 | y. -- H. L. Mencken=\n"], |
| af6f229e |
60 | |
| 61 | # Don't break a line that's near but not over 76 chars. |
| 9e87bee3 |
62 | ["$x70!23" => "$x70!23=\n"], |
| 63 | ["$x70!234" => "$x70!234=\n"], |
| 64 | ["$x70!2345" => "$x70!2345=\n"], |
| 65 | ["$x70!23456" => "$x70!23456=\n"], |
| 66 | ["$x70!234567" => "$x70!2345=\n67=\n"], |
| 67 | ["$x70!23456=" => "$x70!2345=\n6=3D=\n"], |
| af6f229e |
68 | ["$x70!23\n" => "$x70!23\n"], |
| 69 | ["$x70!234\n" => "$x70!234\n"], |
| 70 | ["$x70!2345\n" => "$x70!2345\n"], |
| 71 | ["$x70!23456\n" => "$x70!23456\n"], |
| 6a63fb82 |
72 | ["$x70!234567\n" => "$x70!2345=\n67\n"], |
| 73 | ["$x70!23456=\n" => "$x70!2345=\n6=3D\n"], |
| af6f229e |
74 | |
| 75 | # Not allowed to break =XX escapes using soft line break |
| 9e87bee3 |
76 | ["$x70===xxxxx" => "$x70=3D=\n=3D=3Dxxxxx=\n"], |
| 77 | ["$x70!===xxxx" => "$x70!=3D=\n=3D=3Dxxxx=\n"], |
| 78 | ["$x70!2===xxx" => "$x70!2=3D=\n=3D=3Dxxx=\n"], |
| 79 | ["$x70!23===xx" => "$x70!23=\n=3D=3D=3Dxx=\n"], |
| 80 | ["$x70!234===x" => "$x70!234=\n=3D=3D=3Dx=\n"], |
| 6a63fb82 |
81 | ["$x70!2=\n" => "$x70!2=3D\n"], |
| 82 | ["$x70!23=\n" => "$x70!23=\n=3D\n"], |
| 83 | ["$x70!234=\n" => "$x70!234=\n=3D\n"], |
| 84 | ["$x70!2345=\n" => "$x70!2345=\n=3D\n"], |
| 85 | ["$x70!23456=\n" => "$x70!2345=\n6=3D\n"], |
| 86 | # ^ |
| 87 | # 70123456| |
| 88 | # max |
| 89 | # line width |
| 90 | |
| 91 | # some extra special cases we have had problems with |
| 9e87bee3 |
92 | ["$x70!2=x=x" => "$x70!2=3D=\nx=3Dx=\n"], |
| 6a63fb82 |
93 | ["$x70!2345$x70!2345$x70!23456\n", "$x70!2345=\n$x70!2345=\n$x70!23456\n"], |
| 2c634edc |
94 | |
| 95 | # trailing whitespace |
| 9e87bee3 |
96 | ["foo \t ", "foo=20=09=20=\n"], |
| 97 | ["foo\t \n \t", "foo=09=20\n=20=09=\n"], |
| af6f229e |
98 | ); |
| 99 | |
| df4d7026 |
100 | } elsif ($IsEBCDIC) { |
| 101 | |
| 102 | @tests = |
| 103 | ( |
| 104 | # plain ascii should not be encoded |
| 105 | ["", ""], |
| 106 | ["quoted printable" => |
| 107 | "quoted printable=\n"], |
| 108 | |
| 109 | # 8-bit chars should be encoded |
| 110 | ["v\x47re kj\x9cre norske tegn b\x70r \x47res" => |
| 111 | "v=47re kj=9Cre norske tegn b=70r =47res=\n"], |
| 112 | |
| 113 | # trailing space should be encoded |
| 114 | [" " => "=40=40=\n"], |
| 115 | ["\tt\t" => "\tt=05=\n"], |
| 116 | ["test \ntest\n\t \t \n" => "test=40=40\ntest\n=05=40=05=40\n"], |
| 117 | |
| 118 | # "=" is special an should be decoded |
| 119 | ["=30\n" => "=7E30\n"], |
| 120 | ["\0\xff0" => "=00=FF0=\n"], |
| 121 | |
| 122 | # Very long lines should be broken (not more than 76 chars |
| 123 | ["The Quoted-Printable encoding is intended to represent data that largly consists of octets that correspond to printable characters in the ASCII character set." => |
| 124 | "The Quoted-Printable encoding is intended to represent data that largly con= |
| 125 | sists of octets that correspond to printable characters in the ASCII charac= |
| 126 | ter set.=\n" |
| 127 | ], |
| 128 | |
| 129 | # Long lines after short lines were broken through 2.01. |
| 130 | ["short line |
| 131 | In America, any boy may become president and I suppose that's just one of the risks he takes. -- Adlai Stevenson" => |
| 132 | "short line |
| 133 | In America, any boy may become president and I suppose that's just one of t= |
| 134 | he risks he takes. -- Adlai Stevenson=\n"], |
| 135 | |
| 136 | # My (roderick@argon.org) first crack at fixing that bug failed for |
| 137 | # multiple long lines. |
| 138 | ["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 |
| 139 | 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" => |
| 140 | "College football is a game which would be much more interesting if the facu= |
| 141 | lty played instead of the students, and even more interesting if the |
| 142 | trustees played. There would be a great increase in broken arms, legs, and= |
| 143 | necks, and simultaneously an appreciable diminution in the loss to humanit= |
| 144 | y. -- H. L. Mencken=\n"], |
| 145 | |
| 146 | # Don't break a line that's near but not over 76 chars. |
| 147 | ["$x70!23" => "$x70!23=\n"], |
| 148 | ["$x70!234" => "$x70!234=\n"], |
| 149 | ["$x70!2345" => "$x70!2345=\n"], |
| 150 | ["$x70!23456" => "$x70!23456=\n"], |
| 151 | ["$x70!234567" => "$x70!2345=\n67=\n"], |
| 152 | ["$x70!23456=" => "$x70!2345=\n6=7E=\n"], |
| 153 | ["$x70!23\n" => "$x70!23\n"], |
| 154 | ["$x70!234\n" => "$x70!234\n"], |
| 155 | ["$x70!2345\n" => "$x70!2345\n"], |
| 156 | ["$x70!23456\n" => "$x70!23456\n"], |
| 157 | ["$x70!234567\n" => "$x70!2345=\n67\n"], |
| 158 | ["$x70!23456=\n" => "$x70!2345=\n6=7E\n"], |
| 159 | |
| 160 | # Not allowed to break =XX escapes using soft line break |
| 161 | ["$x70===xxxxx" => "$x70=7E=\n=7E=7Exxxxx=\n"], |
| 162 | ["$x70!===xxxx" => "$x70!=7E=\n=7E=7Exxxx=\n"], |
| 163 | ["$x70!2===xxx" => "$x70!2=7E=\n=7E=7Exxx=\n"], |
| 164 | ["$x70!23===xx" => "$x70!23=\n=7E=7E=7Exx=\n"], |
| 165 | ["$x70!234===x" => "$x70!234=\n=7E=7E=7Ex=\n"], |
| 166 | ["$x70!2=\n" => "$x70!2=7E\n"], |
| 167 | ["$x70!23=\n" => "$x70!23=\n=7E\n"], |
| 168 | ["$x70!234=\n" => "$x70!234=\n=7E\n"], |
| 169 | ["$x70!2345=\n" => "$x70!2345=\n=7E\n"], |
| 170 | ["$x70!23456=\n" => "$x70!2345=\n6=7E\n"], |
| 171 | # ^ |
| 172 | # 70123456| |
| 173 | # max |
| 174 | # line width |
| 175 | |
| 176 | # some extra special cases we have had problems with |
| 177 | ["$x70!2=x=x" => "$x70!2=7E=\nx=7Ex=\n"], |
| 178 | ["$x70!2345$x70!2345$x70!23456\n", "$x70!2345=\n$x70!2345=\n$x70!23456\n"], |
| 179 | |
| 180 | # trailing whitespace |
| 181 | ["foo \t ", "foo=40=05=40=\n"], |
| 182 | ["foo\t \n \t", "foo=05=40\n=40=05=\n"], |
| 183 | ); |
| 184 | |
| 185 | } else { |
| 186 | die sprintf "Unknown character set: ord('A') == %d\n", ord('A'); |
| 187 | } |
| 188 | |
| 9e87bee3 |
189 | $notests = @tests + 16; |
| af6f229e |
190 | print "1..$notests\n"; |
| 191 | |
| 192 | $testno = 0; |
| 193 | for (@tests) { |
| 194 | $testno++; |
| 195 | ($plain, $encoded) = @$_; |
| 95635e5f |
196 | if (ord('A') == 193) { # EBCDIC 8 bit chars are different |
| 197 | if ($testno == 2) { $plain =~ s/\xe5/\x47/; $plain =~ s/\xe6/\x9c/g; $plain =~ s/\xf8/\x70/; } |
| 198 | if ($testno == 7) { $plain =~ s/\xff/\xdf/; } |
| 199 | } |
| af6f229e |
200 | $x = encode_qp($plain); |
| 201 | if ($x ne $encoded) { |
| 202 | print "Encode test failed\n"; |
| 203 | print "Got: '$x'\n"; |
| 204 | print "Expected: '$encoded'\n"; |
| 205 | print "not ok $testno\n"; |
| 206 | next; |
| 207 | } |
| 208 | $x = decode_qp($encoded); |
| 209 | if ($x ne $plain) { |
| 210 | print "Decode test failed\n"; |
| 211 | print "Got: '$x'\n"; |
| 212 | print "Expected: '$plain'\n"; |
| 213 | print "not ok $testno\n"; |
| 214 | next; |
| 215 | } |
| 216 | print "ok $testno\n"; |
| 217 | } |
| 218 | |
| df4d7026 |
219 | if ($IsASCII) { |
| 220 | |
| af6f229e |
221 | # Some extra testing for a case that was wrong until libwww-perl-5.09 |
| 222 | print "not " unless decode_qp("foo \n\nfoo =\n\nfoo=20\n\n") eq |
| 223 | "foo\n\nfoo \nfoo \n\n"; |
| 224 | $testno++; print "ok $testno\n"; |
| 225 | |
| 226 | # Same test but with "\r\n" terminated lines |
| 227 | print "not " unless decode_qp("foo \r\n\r\nfoo =\r\n\r\nfoo=20\r\n\r\n") eq |
| 6a63fb82 |
228 | "foo\n\nfoo \nfoo \n\n"; |
| af6f229e |
229 | $testno++; print "ok $testno\n"; |
| 230 | |
| 2c634edc |
231 | # Trailing whitespace |
| 232 | print "not " unless decode_qp("foo ") eq "foo "; |
| 233 | $testno++; print "ok $testno\n"; |
| 234 | |
| 235 | print "not " unless decode_qp("foo \n") eq "foo\n"; |
| 236 | $testno++; print "ok $testno\n"; |
| 237 | |
| ea0e37e4 |
238 | print "not " unless decode_qp("foo = \t\x20\nbar\t\x20\n") eq "foo bar\n"; |
| 239 | $testno++; print "ok $testno\n"; |
| 240 | |
| 241 | print "not " unless decode_qp("foo = \t\x20\r\nbar\t\x20\r\n") eq "foo bar\n"; |
| 242 | $testno++; print "ok $testno\n"; |
| 243 | |
| 244 | print "not " unless decode_qp("foo = \t\x20\n") eq "foo "; |
| 245 | $testno++; print "ok $testno\n"; |
| 246 | |
| 247 | print "not " unless decode_qp("foo = \t\x20\r\n") eq "foo "; |
| 248 | $testno++; print "ok $testno\n"; |
| 249 | |
| 250 | print "not " unless decode_qp("foo = \t\x20y\r\n") eq "foo = \t\x20y\n"; |
| 251 | $testno++; print "ok $testno\n"; |
| 252 | |
| 253 | print "not " unless decode_qp("foo =xy\n") eq "foo =xy\n"; |
| 254 | $testno++; print "ok $testno\n"; |
| 255 | |
| 2c634edc |
256 | # Test with with alternative line break |
| 257 | print "not " unless encode_qp("$x70!2345$x70\n", "***") eq "$x70!2345=***$x70***"; |
| 258 | $testno++; print "ok $testno\n"; |
| 259 | |
| 260 | # Test with no line breaks |
| 261 | print "not " unless encode_qp("$x70!2345$x70\n", "") eq "$x70!2345$x70=0A"; |
| 262 | $testno++; print "ok $testno\n"; |
| 263 | |
| 9e87bee3 |
264 | # Test binary encoding |
| 265 | print "not " unless encode_qp("foo", undef, 1) eq "foo=\n"; |
| 266 | $testno++; print "ok $testno\n"; |
| 267 | |
| 268 | print "not " unless encode_qp("foo\nbar\r\n", undef, 1) eq "foo=0Abar=0D=0A=\n"; |
| 269 | $testno++; print "ok $testno\n"; |
| 270 | |
| 271 | print "not " unless encode_qp(join("", map chr, 0..255), undef, 1) eq <<'EOT'; $testno++; print "ok $testno\n"; |
| 272 | =00=01=02=03=04=05=06=07=08=09=0A=0B=0C=0D=0E=0F=10=11=12=13=14=15=16=17=18= |
| 273 | =19=1A=1B=1C=1D=1E=1F !"#$%&'()*+,-./0123456789:;<=3D>?@ABCDEFGHIJKLMNOPQRS= |
| 274 | TUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~=7F=80=81=82=83=84=85=86=87=88= |
| 275 | =89=8A=8B=8C=8D=8E=8F=90=91=92=93=94=95=96=97=98=99=9A=9B=9C=9D=9E=9F=A0=A1= |
| 276 | =A2=A3=A4=A5=A6=A7=A8=A9=AA=AB=AC=AD=AE=AF=B0=B1=B2=B3=B4=B5=B6=B7=B8=B9=BA= |
| 277 | =BB=BC=BD=BE=BF=C0=C1=C2=C3=C4=C5=C6=C7=C8=C9=CA=CB=CC=CD=CE=CF=D0=D1=D2=D3= |
| 278 | =D4=D5=D6=D7=D8=D9=DA=DB=DC=DD=DE=DF=E0=E1=E2=E3=E4=E5=E6=E7=E8=E9=EA=EB=EC= |
| 279 | =ED=EE=EF=F0=F1=F2=F3=F4=F5=F6=F7=F8=F9=FA=FB=FC=FD=FE=FF= |
| 280 | EOT |
| 281 | |
| 6a63fb82 |
282 | print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || !$@); |
| b1387238 |
283 | $testno++; print "ok $testno\n"; |
| df4d7026 |
284 | |
| 285 | } elsif ($IsEBCDIC) { |
| 286 | |
| 287 | # Some extra testing for a case that was wrong until libwww-perl-5.05 |
| 288 | print "not " unless decode_qp("foo \n\nfoo =\n\nfoo=40\n\n") eq |
| 289 | "foo\n\nfoo \nfoo \n\n"; |
| 290 | $testno++; print "ok $testno\n"; |
| 291 | |
| 292 | # Same test but with "\r\n" terminated lines |
| 293 | print "not " unless decode_qp("foo \r\n\r\nfoo =\r\n\r\nfoo=40\r\n\r\n") eq |
| 294 | "foo\n\nfoo \nfoo \n\n"; |
| 295 | $testno++; print "ok $testno\n"; |
| 296 | |
| 297 | # Trailing whitespace |
| 298 | print "not " unless decode_qp("foo ") eq "foo "; |
| 299 | $testno++; print "ok $testno\n"; |
| 300 | |
| 301 | print "not " unless decode_qp("foo \n") eq "foo\n"; |
| 302 | $testno++; print "ok $testno\n"; |
| 303 | |
| 304 | print "not " unless decode_qp("foo = \t\x40\nbar\t\x40\n") eq "foo bar\n"; |
| 305 | $testno++; print "ok $testno\n"; |
| 306 | |
| 307 | print "not " unless decode_qp("foo = \t\x40\r\nbar\t\x40\r\n") eq "foo bar\n"; |
| 308 | $testno++; print "ok $testno\n"; |
| 309 | |
| 310 | print "not " unless decode_qp("foo = \t\x40\n") eq "foo "; |
| 311 | $testno++; print "ok $testno\n"; |
| 312 | |
| 313 | print "not " unless decode_qp("foo = \t\x40\r\n") eq "foo "; |
| 314 | $testno++; print "ok $testno\n"; |
| 315 | |
| 316 | print "not " unless decode_qp("foo = \t\x40y\r\n") eq "foo = \t\x40y\n"; |
| 317 | $testno++; print "ok $testno\n"; |
| 318 | |
| 319 | print "not " unless decode_qp("foo =xy\n") eq "foo =xy\n"; |
| 320 | $testno++; print "ok $testno\n"; |
| 321 | |
| 322 | # Test with with alternative line break |
| 323 | print "not " unless encode_qp("$x70!2345$x70\n", "***") eq "$x70!2345=***$x70***"; |
| 324 | $testno++; print "ok $testno\n"; |
| 325 | |
| 326 | # Test with no line breaks |
| 327 | print "not " unless encode_qp("$x70!2345$x70\n", "") eq "$x70!2345$x70=15"; |
| 328 | $testno++; print "ok $testno\n"; |
| 329 | |
| 330 | # Test binary encoding |
| 331 | print "not " unless encode_qp("foo", undef, 1) eq "foo=\n"; |
| 332 | $testno++; print "ok $testno\n"; |
| 333 | |
| 334 | print "not " unless encode_qp("foo\nbar\r\n", undef, 1) eq "foo=15bar=0D=15=\n"; |
| 335 | $testno++; print "ok $testno\n"; |
| 336 | |
| 337 | print "not " unless encode_qp(join("", map chr, 0..255), undef, 1) eq <<'EOT'; $testno++; print "ok $testno\n"; |
| 338 | =00=01=02=03=04=05=06=07=08=09=0A=0B=0C=0D=0E=0F=10=11=12=13=14=15=16=17=18= |
| 339 | =19=1A=1B=1C=1D=1E=1F=20=21=22=23=24=25=26=27=28=29=2A=2B=2C=2D=2E=2F=30=31= |
| 340 | =32=33=34=35=36=37=38=39=3A=3B=3C=3D=3E=3F =41=42=43=44=45=46=47=48=49=4A.<= |
| 341 | (+|&=51=52=53=54=55=56=57=58=59!$*);^-/=62=63=64=65=66=67=68=69=6A,%_>?=70= |
| 342 | =71=72=73=74=75=76=77=78`:#@'=7E"=80abcdefghi=8A=8B=8C=8D=8E=8F=90jklmnopqr= |
| 343 | =9A=9B=9C=9D=9E=9F=A0~stuvwxyz=AA=AB=AC=AD=AE=AF=B0=B1=B2=B3=B4=B5=B6=B7=B8= |
| 344 | =B9=BA=BB=BC=BD=BE=BF{ABCDEFGHI=CA=CB=CC=CD=CE=CF}JKLMNOPQR=DA=DB=DC=DD=DE= |
| 345 | =DF\=E1STUVWXYZ=EA=EB=EC=ED=EE=EF0123456789=FA=FB=FC=FD=FE=FF= |
| 346 | EOT |
| 347 | |
| 348 | print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || !$@); |
| 349 | $testno++; print "ok $testno\n"; |
| 350 | |
| 351 | } |
| 352 | |
projects / p5sagit/p5-mst-13.2.git / blame