t/pmc/codestring.t

   1 #!./parrot
   2 # Copyright (C) 2006-2009, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/codestring.t - test the CodeString class
   8
   9
  10 =head1 SYNOPSIS
  11
  12     % prove t/pmc/codestring.t
  13
  14 =head1 DESCRIPTION
  15
  16 Tests the CodeString class directly.
  17
  18 =cut
  19
  20 .sub main :main
  21     .include 'test_more.pir'
  22     plan(38)
  23
  24     create_codestring()
  25     calls_to_unique()
  26     basic_emit()
  27     emit_with_pos_args()
  28     emit_with_percent_args()
  29     emit_with_named_args()
  30     emit_with_pos_and_named_args()
  31     output_global_unique_num()
  32     namespace_keys()
  33     first_char_repl_regression()
  34     ord_from_name()
  35     lineof_tests()
  36 .end
  37
  38 .sub create_codestring
  39     .local pmc code
  40     .local string s
  41     code = new ['CodeString']
  42     code = 'ok'
  43     s = code
  44     is(s, "ok", "code string creation succeeded")
  45 .end
  46
  47 .sub calls_to_unique
  48     .local pmc code
  49     .local string s
  50     code = new ['CodeString']
  51     $P1 = code.'unique'('ok ')
  52     s = $P1
  53     is(s, "ok 10", "call to unique with name")
  54     $P1 = code.'unique'()
  55     s = $P1
  56     is(s, "11", "call to unique with no params")
  57     $P1 = code.'unique'('$P')
  58     s = $P1
  59     is(s, "$P12", "call to unique with reg name")
  60 .end
  61
  62 .sub basic_emit
  63     .local pmc code
  64     code = new ['CodeString']
  65     code.'emit'('label:')
  66     code.'emit'('    say "Hello, World"')
  67     code.'emit'('    $I0 = 1')
  68     code.'emit'('    $N0 = 0.1')
  69     is(code, <<'CODE', "code string looks fine")
  70 label:
  71     say "Hello, World"
  72     $I0 = 1
  73     $N0 = 0.1
  74 CODE
  75 .end
  76
  77 .sub emit_with_pos_args
  78     .local pmc code
  79     code = new ['CodeString']
  80     code.'emit'('label_%0:', 1234)
  81     code.'emit'('    say "%0, %1"', 'Hello', 'World')
  82     code.'emit'('    %0 = %2', '$I0', 24, 48)
  83     is(code, <<'CODE', "code string with positional args looks fine")
  84 label_1234:
  85     say "Hello, World"
  86     $I0 = 48
  87 CODE
  88 .end
  89
  90 .sub emit_with_percent_args
  91     .local pmc code
  92     code = new ['CodeString']
  93     code.'emit'('label_%0:', 1234)
  94     code.'emit'('    say "%,"', 'Hello')
  95     code.'emit'('    say "%,"', 'Hello', 'World', 'of', 'Parrot')
  96     code.'emit'('    say "%%0"')
  97     is(code, <<'CODE', "code string with % args looks fine")
  98 label_1234:
  99     say "Hello"
 100     say "Hello, World, of, Parrot"
 101     say "%0"
 102 CODE
 103 .end
 104
 105 .sub emit_with_named_args
 106     .local pmc code
 107     code = new ['CodeString']
 108     code.'emit'('label_%a:', 'a'=>1234)
 109     code.'emit'('    say "%b, %c"', 'b'=>'Hello', 'c'=>'World')
 110     code.'emit'('    say "%d"', 'b'=>'Hello', 'c'=>'World')
 111     is(code, <<'CODE', "emit with named args looks fine")
 112 label_1234:
 113     say "Hello, World"
 114     say "%d"
 115 CODE
 116 .end
 117
 118 .sub emit_with_pos_and_named_args
 119     .local pmc code
 120     code = new ['CodeString']
 121     code.'emit'('label_%a:', 'a'=>1234)
 122     code.'emit'('    %0 "%b, %c"', 'say', 'print', 'b'=>'H', 'c'=>'W')
 123     code.'emit'('    say "%,, %c"', 'alpha', 'beta', 'b'=>'H', 'c'=>'W')
 124     is(code, <<'CODE', "emit with pos + named args")
 125 label_1234:
 126     say "H, W"
 127     say "alpha, beta, W"
 128 CODE
 129 .end
 130
 131 .sub output_global_unique_num
 132     .local pmc code1, code2
 133     code1 = new ['CodeString']
 134     code2 = new ['CodeString']
 135     .local string unique1, unique2
 136     unique1 = code1.'unique'()
 137     unique2 = code2.'unique'('$P')
 138     is(unique1, "13", "global unique #1 looks ok")
 139     is(unique2, "$P14", "global unique #2 looks ok")
 140 .end
 141
 142 .sub namespace_keys
 143     .local pmc code
 144     code = new ['CodeString']
 145     $S0 = code.'key'('abc')
 146     is($S0, '["abc"]', "unnested namespace key")
 147     $S0 = code.'key'('abc', 'def')
 148     is($S0, '["abc";"def"]', "nested namespace key")
 149     $P0 = split ' ', unicode:"abc def T\xe9st"
 150     $S0 = code.'key'($P0 :flat)
 151     is($S0, '["abc";"def";unicode:"T\x{e9}st"]', "flattened nested unicode ns key")
 152     $S0 = code.'key'($P0)
 153     is($S0, '["abc";"def";unicode:"T\x{e9}st"]', "nested unicode ns key")
 154     $S0 = code.'key'('_perl6', $P0)
 155     is($S0, '["_perl6";"abc";"def";unicode:"T\x{e9}st"]', "big ns key")
 156     $S0 = code.'key'('')
 157     is($S0, '[""]', "empty string namespace")
 158     $P0 = new 'ResizablePMCArray'
 159     $S0 = code.'key'($P0)
 160     is($S0, '[]', "empty array namespace")
 161     null $P0
 162     $S0 = code.'key'($P0)
 163     is($S0, '[]', "null PMC namespace")
 164 .end
 165
 166 .sub first_char_repl_regression
 167     .local pmc code
 168     null $P0
 169     code = new ['CodeString']
 170     code.'emit'('new', 'n'=>$P0)
 171     is(code, "new\n", "regression on first char repl bug looks fine")
 172 .end
 173
 174 .sub 'ord_from_name'
 175     .local pmc code
 176     load_bytecode 'config.pbc'
 177     $P0 = _config()
 178     $I0 = $P0['has_icu']
 179     if $I0 goto has_icu
 180     skip(4, 'ICU unavailable')
 181     .return ()
 182
 183   has_icu:
 184     code = new ['CodeString']
 185     $I0 = code.'charname_to_ord'('LATIN CAPITAL LETTER C')
 186     is($I0, 0x0043, "LATIN CAPITAL LETTER C")
 187     $I0 = code.'charname_to_ord'('MUSIC FLAT SIGN')
 188     is($I0, 0x266d, "MUSIC FLAT SIGN")
 189     $I0 = code.'charname_to_ord'('RECYCLING SYMBOL FOR TYPE-1 PLASTICS')
 190     is($I0, 0x2673, "RECYCLING SYMBOL FOR TYPE-1 PLASTICS")
 191     $I0 = code.'charname_to_ord'('no such symbol')
 192     is($I0, -1, 'no such symbol')
 193 .end
 194
 195 .sub 'lineof_tests'
 196     $P0 = new 'CodeString'
 197     $P0 = "0123\n5678\r0123\r\n678\n"
 198     $I0 = $P0.'lineof'(0)
 199     is($I0, 0, "lineof - beginning of string")
 200     $I0 = $P0.'lineof'(1)
 201     is($I0, 0, "lineof - char on first line")
 202     $I0 = $P0.'lineof'(4)
 203     is($I0, 0, "lineof - immediately before nl")
 204     $I0 = $P0.'lineof'(5)
 205     is($I0, 1, "lineof - immediately after nl")
 206     $I0 = $P0.'lineof'(8)
 207     is($I0, 1, "lineof - char before cr")
 208     $I0 = $P0.'lineof'(9)
 209     is($I0, 1, "lineof - immediately before cr")
 210     $I0 = $P0.'lineof'(10)
 211     is($I0, 2, "lineof - immediately after cr")
 212     $I0 = $P0.'lineof'(11)
 213     is($I0, 2, "lineof - char after cr")
 214     $I0 = $P0.'lineof'(13)
 215     is($I0, 2, "lineof - char before crnl")
 216     $I0 = $P0.'lineof'(14)
 217     is($I0, 2, "lineof - immediately before crnl")
 218     $I0 = $P0.'lineof'(15)
 219     is($I0, 3, "lineof - middle of crnl")
 220     $I0 = $P0.'lineof'(16)
 221     is($I0, 3, "lineof - immediately after crnl")
 222     $I0 = $P0.'lineof'(19)
 223     is($I0, 3, "lineof - immediately before final nl")
 224     $I0 = $P0.'lineof'(20)
 225     is($I0, 4, "lineof - immediately after final nl")
 226 .end
 227
 228
 229 # Local Variables:
 230 #   mode: pir
 231 #   fill-column: 100
 232 # End:
 233 # vim: expandtab shiftwidth=4 ft=pir: