t/op/string_cclass.t

   1 #!perl
   2 # Copyright (C) 2001-2005, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More;
   9 use Parrot::Test tests => 11;
  10 use Parrot::Config;
  11
  12 =head1 NAME
  13
  14 t/op/cclass.t - character class tests
  15
  16 =head1 SYNOPSIS
  17
  18         % prove t/op/cclass.t
  19
  20 =head1 DESCRIPTION
  21
  22 Tests find_cclass find_not_cclass, is_cclass.
  23
  24 =cut
  25
  26 pir_output_is( <<'CODE', <<'OUT', "find_cclass, ascii" );
  27 .include "cclass.pasm"
  28 .sub main :main
  29     $S0 = ascii:"test_func(1)"
  30     test( .CCLASS_WORD, $S0 )
  31
  32     $S0 = ascii:"ab\nC_X34.\0 \t!"
  33     test( .CCLASS_NUMERIC, $S0 )
  34     test( .CCLASS_LOWERCASE, $S0 )
  35     test( .CCLASS_PUNCTUATION, $S0 )
  36 .end
  37 .sub test
  38     .param int flags
  39     .param string str
  40     $I0 = 0
  41     $I2 = length str
  42 loop:
  43     $I1 = find_cclass flags, str, $I0, 100
  44     print $I1
  45     print ";"
  46     inc $I0
  47     if $I0 <= $I2 goto loop
  48 end:
  49     print "\n"
  50 .end
  51 CODE
  52 0;1;2;3;4;5;6;7;8;10;10;12;12;
  53 6;6;6;6;6;6;6;7;13;13;13;13;13;13;
  54 0;1;13;13;13;13;13;13;13;13;13;13;13;13;
  55 4;4;4;4;4;8;8;8;8;12;12;12;12;13;
  56 OUT
  57
  58 pir_output_is( <<'CODE', <<'OUT', "find_not_cclass, ascii" );
  59 .include "cclass.pasm"
  60 .sub main :main
  61     $S0 = ascii:"test_func(1)"
  62     test( .CCLASS_WORD, $S0 )
  63
  64     $S0 = ascii:"ab\nC_X34.\0 \t!"
  65     test( .CCLASS_NUMERIC, $S0 )
  66     test( .CCLASS_LOWERCASE, $S0 )
  67     test( .CCLASS_PUNCTUATION, $S0 )
  68 .end
  69 .sub test
  70     .param int flags
  71     .param string str
  72     $I0 = 0
  73     $I2 = length str
  74 loop:
  75     $I1 = find_not_cclass flags, str, $I0, 100
  76     print $I1
  77     print ";"
  78     inc $I0
  79     if $I0 <= $I2 goto loop
  80 end:
  81     print "\n"
  82 .end
  83 CODE
  84 9;9;9;9;9;9;9;9;9;9;11;11;12;
  85 0;1;2;3;4;5;8;8;8;9;10;11;12;13;
  86 2;2;2;3;4;5;6;7;8;9;10;11;12;13;
  87 0;1;2;3;5;5;6;7;9;9;10;11;13;13;
  88 OUT
  89
  90 pir_output_is( <<'CODE', <<'OUT', "find_cclass, iso-8859-1" );
  91 .include "cclass.pasm"
  92 .sub main :main
  93     $S0 = iso-8859-1:"test_func(1)"
  94     test( .CCLASS_WORD, $S0 )
  95
  96     $S0 = iso-8859-1:"ab\nC_X34.\0 \t!"
  97     test( .CCLASS_NUMERIC, $S0 )
  98     test( .CCLASS_LOWERCASE, $S0 )
  99     test( .CCLASS_PUNCTUATION, $S0 )
 100 .end
 101 .sub test
 102     .param int flags
 103     .param string str
 104     $I0 = 0
 105     $I2 = length str
 106 loop:
 107     $I1 = find_cclass flags, str, $I0, 100
 108     print $I1
 109     print ";"
 110     inc $I0
 111     if $I0 <= $I2 goto loop
 112 end:
 113     print "\n"
 114 .end
 115 CODE
 116 0;1;2;3;4;5;6;7;8;10;10;12;12;
 117 6;6;6;6;6;6;6;7;13;13;13;13;13;13;
 118 0;1;13;13;13;13;13;13;13;13;13;13;13;13;
 119 4;4;4;4;4;8;8;8;8;12;12;12;12;13;
 120 OUT
 121
 122 pir_output_is( <<'CODE', <<'OUT', "find_not_cclass, iso-8859-1" );
 123 .include "cclass.pasm"
 124 .sub main :main
 125     $S0 = iso-8859-1:"test_func(1)"
 126     test( .CCLASS_WORD, $S0 )
 127
 128     $S0 = iso-8859-1:"ab\nC_X34.\0 \t!"
 129     test( .CCLASS_NUMERIC, $S0 )
 130     test( .CCLASS_LOWERCASE, $S0 )
 131     test( .CCLASS_PUNCTUATION, $S0 )
 132 .end
 133 .sub test
 134     .param int flags
 135     .param string str
 136     $I0 = 0
 137     $I2 = length str
 138 loop:
 139     $I1 = find_not_cclass flags, str, $I0, 100
 140     print $I1
 141     print ";"
 142     inc $I0
 143     if $I0 <= $I2 goto loop
 144 end:
 145     print "\n"
 146 .end
 147 CODE
 148 9;9;9;9;9;9;9;9;9;9;11;11;12;
 149 0;1;2;3;4;5;8;8;8;9;10;11;12;13;
 150 2;2;2;3;4;5;6;7;8;9;10;11;12;13;
 151 0;1;2;3;5;5;6;7;9;9;10;11;13;13;
 152 OUT
 153
 154 pir_output_is( <<'CODE', <<'OUT', "is_cclass, ascii" );
 155 .include "cclass.pasm"
 156 .sub main :main
 157     $S1 = ascii:"ab\nC_X34.\0 \t!"
 158     test1( $S1 )
 159 .end
 160 .sub test1
 161     .param string str
 162     test2( str, .CCLASS_UPPERCASE)
 163     test2( str, .CCLASS_LOWERCASE)
 164     test2( str, .CCLASS_ALPHABETIC)
 165     test2( str, .CCLASS_NUMERIC)
 166     test2( str, .CCLASS_HEXADECIMAL)
 167     test2( str, .CCLASS_WHITESPACE)
 168     test2( str, .CCLASS_PRINTING)
 169     test2( str, .CCLASS_GRAPHICAL)
 170     test2( str, .CCLASS_BLANK)
 171     test2( str, .CCLASS_CONTROL)
 172     test2( str, .CCLASS_PUNCTUATION)
 173     test2( str, .CCLASS_ALPHANUMERIC)
 174     test2( str, .CCLASS_NEWLINE)
 175     test2( str, .CCLASS_WORD)
 176
 177     $I0 = .CCLASS_NEWLINE|.CCLASS_WHITESPACE
 178     test2( str, $I0)
 179     $I0 = .CCLASS_WHITESPACE|.CCLASS_LOWERCASE
 180     test2( str, $I0)
 181     $I0 = .CCLASS_UPPERCASE|.CCLASS_PUNCTUATION
 182     test2( str, $I0)
 183 .end
 184 .sub test2
 185     .param string str
 186     .param int code
 187
 188     $I1 = length str
 189     set $I0, 0
 190 loop:
 191     $I2 = is_cclass code, str, $I0
 192     print $I2
 193     inc $I0
 194     if $I0 <= $I1 goto loop
 195     print "\n"
 196 .end
 197 CODE
 198 00010100000000
 199 11000000000000
 200 11010100000000
 201 00000011000000
 202 11010011000000
 203 00100000001100
 204 11011111101010
 205 11011111100010
 206 00000000001100
 207 00100000010100
 208 00001000100010
 209 11010111000000
 210 00100000000000
 211 11011111000000
 212 00100000001100
 213 11100000001100
 214 00011100100010
 215 OUT
 216
 217 pir_output_is( <<'CODE', <<'OUT', "is_cclass, iso-8859-1" );
 218 .include "cclass.pasm"
 219 .sub main :main
 220     $S1 = iso-8859-1:"ab\nC_X34.\0 \t!"
 221     test1( $S1 )
 222 .end
 223 .sub test1
 224     .param string str
 225     test2( str, .CCLASS_UPPERCASE)
 226     test2( str, .CCLASS_LOWERCASE)
 227     test2( str, .CCLASS_ALPHABETIC)
 228     test2( str, .CCLASS_NUMERIC)
 229     test2( str, .CCLASS_HEXADECIMAL)
 230     test2( str, .CCLASS_WHITESPACE)
 231     test2( str, .CCLASS_PRINTING)
 232     test2( str, .CCLASS_GRAPHICAL)
 233     test2( str, .CCLASS_BLANK)
 234     test2( str, .CCLASS_CONTROL)
 235     test2( str, .CCLASS_PUNCTUATION)
 236     test2( str, .CCLASS_ALPHANUMERIC)
 237     test2( str, .CCLASS_NEWLINE)
 238     test2( str, .CCLASS_WORD)
 239
 240     $I0 = .CCLASS_NEWLINE|.CCLASS_WHITESPACE
 241     test2( str, $I0)
 242     $I0 = .CCLASS_WHITESPACE|.CCLASS_LOWERCASE
 243     test2( str, $I0)
 244     $I0 = .CCLASS_UPPERCASE|.CCLASS_PUNCTUATION
 245     test2( str, $I0)
 246 .end
 247 .sub test2
 248     .param string str
 249     .param int code
 250
 251     $I1 = length str
 252     set $I0, 0
 253 loop:
 254     $I2 = is_cclass code, str, $I0
 255     print $I2
 256     inc $I0
 257     if $I0 <= $I1 goto loop
 258     print "\n"
 259 .end
 260 CODE
 261 00010100000000
 262 11000000000000
 263 11010100000000
 264 00000011000000
 265 11010011000000
 266 00100000001100
 267 11011111101010
 268 11011111100010
 269 00000000001100
 270 00100000010100
 271 00001000100010
 272 11010111000000
 273 00100000000000
 274 11011111000000
 275 00100000001100
 276 11100000001100
 277 00011100100010
 278 OUT
 279
 280 ## setup for unicode whitespace tests
 281 ## see http://www.unicode.org/Public/UNIDATA/PropList.txt for White_Space list
 282 ## see also t/p6rules/metachars.t
 283 my $ws = {
 284     horizontal_ascii   => [qw/ \u0009 \u0020 \u00a0 /],
 285     horizontal_unicode => [
 286         qw/
 287             \u1680 \u180e \u2000 \u2001 \u2002 \u2003 \u2004 \u2005
 288             \u2006 \u2007 \u2008 \u2009 \u200a \u202f \u205f \u3000
 289             /
 290     ],
 291     vertical_ascii   => [qw/ \u000a \u000b \u000c \u000d \u0085 /],
 292     vertical_unicode => [qw/ \u2028 \u2029 /],
 293 };
 294
 295 push @{ $ws->{horizontal} } => @{ $ws->{horizontal_ascii} },
 296     @{ $ws->{horizontal_unicode} };
 297
 298 push @{ $ws->{vertical} } => @{ $ws->{vertical_ascii} },
 299     @{ $ws->{vertical_unicode} };
 300
 301 push @{ $ws->{whitespace_ascii} } => @{ $ws->{horizontal_ascii} },
 302     @{ $ws->{vertical_ascii} };
 303
 304 push @{ $ws->{whitespace_unicode} } => @{ $ws->{horizontal_unicode} },
 305     @{ $ws->{vertical_unicode} };
 306
 307 push @{ $ws->{whitespace} } => @{ $ws->{whitespace_ascii} },
 308     @{ $ws->{whitespace_unicode} };
 309
 310 sub string {
 311     my $which = shift;
 312     'unicode:"' . join( '', @{ $ws->{$which} } ) . '"';
 313 }
 314
 315 my $all_ws = string('whitespace');
 316
 317 SKIP: {
 318     skip 'unicode support unavailable' => 3
 319         unless $PConfig{has_icu};
 320     pir_output_is( <<"CODE", <<'OUT', "unicode is_cclass whitespace" );
 321 .sub main :main
 322 .include "cclass.pasm"
 323    .local int result, char, len, i
 324    .local string s
 325    s = $all_ws
 326    len = length s
 327    i = 0
 328 loop:
 329    result = is_cclass .CCLASS_WHITESPACE, s, i
 330    print result
 331    if result goto ok
 332    \$S0 = substr s, i
 333    \$I0 = ord \$S0
 334    \$P0 = new 'ResizablePMCArray'
 335    push \$P0, \$I0
 336    \$S0 = sprintf "\\nchar %#x not reported as ws\\n", \$P0
 337    print \$S0
 338 ok:
 339    inc i
 340    if i < len goto loop
 341    print "\\n"
 342 .end
 343 CODE
 344 11111111111111111111111111
 345 OUT
 346
 347     pir_output_is( <<"CODE", <<'OUT', "unicode find_ccclass whitespace" );
 348 .sub main :main
 349 .include "cclass.pasm"
 350    .local int result, char, len, i
 351    .local string s
 352    s = $all_ws
 353    s = unicode:"abc" . s
 354    len = length s
 355    result = find_cclass .CCLASS_WHITESPACE, s, 0, len
 356    print result
 357    print "\\n"
 358 .end
 359 CODE
 360 3
 361 OUT
 362
 363     pir_output_is( <<"CODE", <<'OUT', "unicode find_not_ccclass whitespace" );
 364 .sub main :main
 365 .include "cclass.pasm"
 366    .local int result, char, len, i
 367    .local string s
 368    s = $all_ws
 369    s .= unicode:"abc"
 370    len = length s
 371    result = find_not_cclass .CCLASS_WHITESPACE, s, 0, len
 372    print len
 373    print ' '
 374    print result
 375    print "\\n"
 376 .end
 377 CODE
 378 29 26
 379 OUT
 380 }
 381
 382 # The following should pass even if ICU is unavailable  (pmichaud, 2005-11-3)
 383 pir_output_is( <<"CODE", <<'OUT', "unicode 0-127 find_*_cclass whitespace" );
 384 .sub main :main
 385 .include "cclass.pasm"
 386    .local int result, char, len, i
 387    .local string s
 388    s = unicode:"abc   def"
 389    len = length s
 390    result = find_cclass .CCLASS_WHITESPACE, s, 0, len
 391    print len
 392    print ' '
 393    print result
 394    result = find_not_cclass .CCLASS_WHITESPACE, s, 3, len
 395    print ' '
 396    print result
 397    print "\\n"
 398 .end
 399 CODE
 400 9 3 6
 401 OUT
 402
 403 pir_output_is( <<'CODE', <<'OUT', "is_cclass, unicode first codepage" );
 404 .include "cclass.pasm"
 405 .sub main :main
 406     $S1 = unicode:"ab\nC_X34.\0 \t!"
 407     test1( $S1 )
 408 .end
 409 .sub test1
 410     .param string str
 411     test2( str, .CCLASS_UPPERCASE)
 412     test2( str, .CCLASS_LOWERCASE)
 413     test2( str, .CCLASS_ALPHABETIC)
 414     test2( str, .CCLASS_NUMERIC)
 415     test2( str, .CCLASS_HEXADECIMAL)
 416     test2( str, .CCLASS_WHITESPACE)
 417     test2( str, .CCLASS_PRINTING)
 418     test2( str, .CCLASS_GRAPHICAL)
 419     test2( str, .CCLASS_BLANK)
 420     test2( str, .CCLASS_CONTROL)
 421     test2( str, .CCLASS_PUNCTUATION)
 422     test2( str, .CCLASS_ALPHANUMERIC)
 423     test2( str, .CCLASS_NEWLINE)
 424     test2( str, .CCLASS_WORD)
 425
 426     $I0 = .CCLASS_NEWLINE|.CCLASS_WHITESPACE
 427     test2( str, $I0)
 428     $I0 = .CCLASS_WHITESPACE|.CCLASS_LOWERCASE
 429     test2( str, $I0)
 430     $I0 = .CCLASS_UPPERCASE|.CCLASS_PUNCTUATION
 431     test2( str, $I0)
 432 .end
 433 .sub test2
 434     .param string str
 435     .param int code
 436
 437     $I1 = length str
 438     set $I0, 0
 439 loop:
 440     $I2 = is_cclass code, str, $I0
 441     print $I2
 442     inc $I0
 443     if $I0 <= $I1 goto loop
 444     print "\n"
 445 .end
 446 CODE
 447 00010100000000
 448 11000000000000
 449 11010100000000
 450 00000011000000
 451 11010011000000
 452 00100000001100
 453 11011111101010
 454 11011111100010
 455 00000000001100
 456 00100000010100
 457 00001000100010
 458 11010111000000
 459 00100000000000
 460 11011111000000
 461 00100000001100
 462 11100000001100
 463 00011100100010
 464 OUT
 465
 466 # Local Variables:
 467 #   mode: cperl
 468 #   cperl-indent-level: 4
 469 #   fill-column: 100
 470 # End:
 471 # vim: expandtab shiftwidth=4: