Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 596 lines (501 sloc) 16.315 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596
use v6;
use Test;
plan 152;

my $foo = "FOO";
my $bar = "BAR";

=begin description

Tests quoting constructs as defined in L<S02/Literals>

Note that non-ASCII tests are kept in quoting-unicode.t

=todo

* q:b and other interpolation levels (half-done)
* meaningful quotations (qx, rx, etc)
* interpolation of scalar, array, hash, function and closure syntaxes
* q : a d verb s // parsing

=end description

# L<S02/Bracketing Characters/bidirectional mirrorings>
{
    my $s = q{ foo bar };
    is $s, ' foo bar ', 'string using q{}';
}

{
    #?rakudo skip 'nested curlies in q{...}'
    is q{ { foo } }, ' { foo } ', 'Can nest curlies in q{ .. }';
    is q{{ab}}, 'ab', 'Unnested single curlies in q{{...}}';
    is q{{ fo} }}, ' fo} ', 'Unnested single curlies in q{{...}}';
    #?rakudo skip 'nested double curlies in q{{...}}'
    is q{{ {{ } }} }}, ' {{ } }} ', 'Can nest double curlies in q{{...}}';
}

{
    is q{\n}, '\n', 'q{..} do not interpolate \n';
    ok q{\n}.chars == 2, 'q{..} do not interpolate \n';
    is q{$x}, '$x', 'q{..} do not interpolate scalars';
    ok q{$x}.chars == 2, 'q{..} do not interpolate scalars';
}

#?pugs skip 'parsefail'
{
    is Q{\n}, '\n', 'Q{..} do not interpolate \n';
    ok Q{\n}.chars == 2, 'Q{..} do not interpolate \n';
    is Q{$x}, '$x', 'Q{..} do not interpolate scalars';
    ok Q{$x}.chars == 2, 'Q{..} do not interpolate scalars';
    is Q {\\}, '\\\\', 'Q {..} quoting';
}

#?pugs skip 'parsefail'
{
    ok Q{\\}.chars == 2, 'Q{..} do not interpolate backslashes';
}

# L<S02/Adverbs on quotes/":q" ":single" "Interpolate \\, \q and \'">
{
    my @q = ();
    @q = (q/$foo $bar/);
    is(+@q, 1, 'q// is singular');
    is(@q[0], '$foo $bar', 'single quotes are non interpolating');
};

{ # and its complement ;-)
    my @q = ();
    @q = '$foo $bar';
    is(+@q, 1, "'' is singular");
    is(@q[0], '$foo $bar', 'and did not interpolate either');
};

# L<S02/Delimiters of quoting forms/That is () have no special significance>
# non interpolating single quotes with nested parens
{
    my @q = ();
    @q = (q (($foo $bar)));
    is(+@q, 1, 'q (()) is singular');
    is(@q[0], '$foo $bar', 'and nests parens appropriately');
};

# L<S02/Delimiters of quoting forms/That is () have no special significance>
#?rakudo skip 'quoting with q (..)'
{ # non interpolating single quotes with nested parens
    my @q = ();
    @q = (q ( ($foo $bar)));
    is(+@q, 1, 'q () is singular');
    is(@q[0], ' ($foo $bar)', 'and nests parens appropriately');
};

# L<S02/Delimiters of quoting forms/Which is mandatory for parens>
{ # q() is bad
    my @q;
    sub q { @_ }
    @q = q($foo,$bar);
    is(+@q, 2, 'q() is always sub call');
};

# L<S02/C<Q> forms/:q>
#?rakudo skip 'Q:q adverbs'
#?pugs skip 'parsefail'
{ # adverb variation
    my @q = ();
    @q = (Q:q/$foo $bar/);
    is(+@q, 1, "Q:q// is singular");
    is(@q[0], '$foo $bar', "and again, non interpolating");
};

#?rakudo skip 'nested bracket quotes'
{ # nested brackets
    my @q = ();
    @q = (q[ [$foo $bar]]);
    is(+@q, 1, 'q[] is singular');
    is(@q[0], ' [$foo $bar]', 'and nests brackets appropriately');
};

{ # nested brackets
    my @q = ();
    @q = (q[[$foo $bar]]);
    is(+@q, 1, 'q[[]] is singular');
    is(@q[0], '$foo $bar', 'and nests brackets appropriately');
};

# L<S02/C<Q> forms/qq:>
{ # interpolating quotes
    my @q = ();
        @q = qq/$foo $bar/;
    is(+@q, 1, 'qq// is singular');
    is(@q[0], 'FOO BAR', 'variables were interpolated');
};

{ # "" variation
    my @q = ();
        @q = "$foo $bar";
    is(+@q, 1, '"" is singular');
    is(@q[0], "FOO BAR", '"" interpolates');
};

# L<S02/C<Q> forms/:qq>
#?rakudo skip 'Q:qq adverbs'
#?pugs skip 'parsefail'
{ # adverb variation
    my @q = ();
    @q = Q:qq/$foo $bar/;
    is(+@q, 1, "Q:qq// is singular");
    is(@q[0], "FOO BAR", "blah blah interp");
};

# L<S02/Interpolating into a single-quoted string/using the \qq>
#?rakudo skip 'q[..] with variations'
{ # \qq[] constructs interpolate in q[]
    my ( @q1, @q2, @q3, @q4 ) = ();
    @q1 = q[$foo \qq[$bar]];
    is(+@q1, 1, "q[...\\qq[...]...] is singular");
    is(@q1[0], '$foo BAR', "and interpolates correctly");

    @q2 = '$foo \qq[$bar]';
    is(+@q2, 1, "'...\\qq[...]...' is singular");
    is(@q2[0], '$foo BAR', "and interpolates correctly");

    @q3 = q[$foo \q:s{$bar}];
    is(+@q3, 1, 'q[...\\q:s{...}...] is singular');
    is(@q3[0], '$foo BAR', "and interpolates correctly");

    @q4 = q{$foo \q/$bar/};
    is(+@q4, 1, 'q{...\\q/.../...} is singular');
    is(@q4[0], '$foo $bar', "and interpolates correctly");
}

# quote with \0 as delimiters, forbidden by STD
# but see L<news:20050101220112.GF25432@plum.flirble.org>
#?rakudo todo 'retriage'
#?pugs todo
{
    eval_dies_ok "(q\0foo bar\0)";
}

{ # traditional quote word
    my @q = ();
    @q = (qw/$foo $bar/);
    is(+@q, 2, "qw// is plural");
    is(@q[0], '$foo', "and non interpolating");
    is(@q[1], '$bar', "...");
};

# L<S02/Quoting forms/quote operator now has a bracketed form>
{ # angle brackets
    my @q = ();
    @q = <$foo $bar>;
    is(+@q, 2, "<> behaves the same way");
    is(@q[0], '$foo', 'for interpolation too');
    is(@q[1], '$bar', '...');
};

{ # angle brackets
    my @q = ();
    @q = < $foo $bar >;
    is(+@q, 2, "<> behaves the same way, with leading (and trailing) whitespace");
    is(@q[0], '$foo', 'for interpolation too');
    is(@q[1], '$bar', '...');
};

#?rakudo skip 'q:w'
{ # adverb variation
    my @q = ();
    @q = (q:w/$foo $bar/);
is(+@q, 2, "q:w// is like <>");
is(@q[0], '$foo', "...");
is(@q[1], '$bar', "...");
};

#?rakudo skip 'q:w'
{ # whitespace sep aration does not break quote constructor
# L<S02/Whitespace before adverbs/Whitespace is allowed between the "q" and its adverb: q :w /.../.>
my @q = ();
@q = (q :w /$foo $bar/);
is(+@q, 2, "q :w // is the same as q:w//");
is(@q[0], '$foo', "...");
is(@q[1], '$bar', "...");
};


#?rakudo skip 'quoting with adverbs'
{ # qq:w,Interpolating quote constructor with words adverb
  # L<S02/Adverbs on quotes/"Split result on words (no quote protection)">
    my (@q1, @q2) = ();
    @q1 = qq:w/$foo "gorch $bar"/;
@q2 = qq:words/$foo "gorch $bar"/;

    is(+@q1, 3, 'qq:w// correct number of elements');
    is(+@q2, 3, 'qq:words correct number of elements');

    is(~@q1, 'FOO "gorch BAR"', "explicit quote word interpolates");
    is(~@q2, 'FOO "gorch BAR"', "long form output is the same as the short");
};

#?rakudo skip 'quoting with adverbs'
#?niecza todo
{ # qq:ww, interpolating L<S02/Literals/double angles do interpolate>
  # L<S02/Forcing item context/"implicit split" "shell-like fashion">
    my (@q1, @q2, @q3, @q4) = ();
    @q1 = qq:ww/$foo "gorch $bar"/;
@q2 = «$foo "gorch $bar"»; # french
@q3 = <<$foo "gorch $bar">>; # texas
@q4 = qq:quotewords/$foo "gorch $bar"/; # long

    is(+@q1, 2, 'qq:ww// correct number of elements');
    is(+@q2, 2, 'french double angle');
    is(+@q3, 2, 'texas double angle');
    is(+@q4, 2, 'long form');

    is(~@q1, 'FOO gorch BAR', "explicit quote word interpolates");
    is(~@q2, 'FOO gorch BAR', "output is the same as french");

    # L<S02/Adverbs on quotes/"the built-in «...» quoter automatically does interpolation equivalent to qq:ww/.../">
    is(~@q3, 'FOO gorch BAR', ", texas quotes");
    is(~@q4, 'FOO gorch BAR', ", and long form");
};

#?rakudo skip 'RT 65654'
{
    my $rt65654 = 'two words';
    is «a $rt65654 z».elems, 4, 'interpolate variable with spaces (French)';
    is <<a $rt65654 z>>.elems, 4, 'interpolate variable with spaces (Texas)';
}

#?rakudo skip '«...»'
#?niecza todo
{
    #L<S02/Forcing item context/"relationship" "single quotes" "double angles">
    # Pugs was having trouble with this. Fixed in r12785.
    my ($x, $y) = <a b>;
    ok(«$x $y» === <a b>, "«$x $y» interpolation works correctly");
};


# L<S02/Forcing item context/respects quotes in a shell-like fashion>
#?rakudo skip '«...»'
{ # qw, interpolating, shell quoting
    my (@q1, @q2) = ();
    my $gorch = "foo bar";

    @q1 = «$foo $gorch $bar»;
    is(+@q1, 4, "4 elements in unquoted «» list");
    is(@q1[2], "bar", '$gorch was exploded');
    is(@q1[3], "BAR", '$bar was interpolated');

    @q2 = «$foo "$gorch" '$bar'»;
    #?niecza 3 todo
    is(+@q2, 3, "3 elementes in sub quoted «» list");
    is(@q2[1], $gorch, 'second element is both parts of $gorch, interpolated');
    is(@q2[2], '$bar', 'single quoted $bar was not interpolated');
};

# L<S02/Heredocs/Heredocs are no longer written>
#?rakudo skip 'quoting with adverbs'
{ # qq:to
    my @q = ();

    @q = qq:to/FOO/;
blah
$bar
blah
$foo
FOO

is(+@q, 1, "q:to// is singular");
is(@q[0], "blah\nBAR\nblah\nFOO\n", "here doc interpolated");
};

# L<S02/Optional whitespace/Heredocs allow optional whitespace>
#?rakudo skip 'quoting with adverbs'
{ # q:to indented
my @q = ();

@q = q:to/FOO/;
blah blah
$foo
FOO

is(+@q, 1, "q:to// is singular, also when indented");
is(@q[0], "blah blah\n\$foo\n", "indentation stripped");
};

#?rakudo skip 'heredocs'
{ # q:heredoc backslash bug
        my @q = q:heredoc/FOO/
yoink\n
splort\\n
FOO
;
is(+@q, 1, "q:heredoc// is singular");
is(@q[0], "yoink\\n\nsplort\\n\n", "backslashes");
}

#?pugs skip 'parsefail'
{ # Q L<S02/Literals/No escapes at all>
my @q = ();

@q = (Q/foo\\bar$foo/);

is(+@q, 1, "Q// is singular");
is(@q[0], "foo\\\\bar\$foo", "special chars are meaningless"); # double quoting is to be more explicit
};

# L<S02/Forcing item context/"Pair" notation is also recognized inside>
{
# <<:Pair>>
my @q = <<:p(1)>>;
#?rakudo 2 todo '<< :pair(1) >> (RT 65304)'
#?niecza todo
#?pugs todo
is(@q[0].perl, (:p(1)).perl, "pair inside <<>>-quotes - simple");

@q = <<:p(1) junk>>;
#?niecza todo
#?pugs todo
is(@q[0].perl, (:p(1)).perl, "pair inside <<>>-quotes - with some junk");
is(@q[1], 'junk', "pair inside <<>>-quotes - junk preserved");

@q = <<:def>>;
#?rakudo 2 todo '<< :pair(1) >>'
#?niecza todo
#?pugs todo
is(@q[0].perl, (def => 1).perl, ":pair in <<>>-quotes with no explicit value");

@q = "(eval failed)";
try { eval '@q = <<:p<moose>>>;' };
#?niecza todo
#?pugs todo
is(@q[0].perl, (p => "moose").perl, ":pair<anglequoted>");
};

#?rakudo skip '\c97 etc'
{ # weird char escape sequences
is("\c97", "a", '\c97 is "a"');
is("\c102oo", "foo", '\c102 is "f", works next to other letters');

is("\c123", chr(123), '"\cXXX" and chr XXX are equivalent');
is("\c[12]3", chr(12) ~ "3", '\c[12]3 is the same as chr(12) concatenated with "3"');
is("\c[12] 3", chr(12) ~ " 3", 'respects spaces when interpolating a space character');
is("\c[13,10]", chr(13) ~ chr(10), 'allows multiple chars');

is("\x41", "A", 'hex interpolation - \x41 is "A"');
is("\o101", "A", 'octal interpolation - \o101 is also "A"' );

is("\c@", "\0", 'Unicode code point "@" converts correctly to "\0"');
    is("\cA", chr(1), 'Unicode "A" is #1!');
    is("\cZ", chr(26), 'Unicode "Z" is chr 26 (or \c26)');
}

{ # simple test for nested-bracket quoting, per S02
    my $hi = q<<hi>>;
    is($hi, "hi", 'q<<hi>> is "hi"');
}

#?rakudo skip 'Thinks statement not terminated properly'
is( q<< <<woot>> >>, ' <<woot>> ', 'nested <<texas>> quotes (RT #66888)' );

# L<S02/Adverbs on quotes/"for user-defined quotes">
# q:to
#?rakudo skip 'quoting with adverbs'
{
    my $t;
    $t = q:to /STREAM/;
Hello, World
STREAM

is $t, "Hello, World\n", "Testing for q:to operator.";

$t = q:to /结束/;
Hello, World
结束

is $t, "Hello, World\n", "Testing for q:to operator. (utf8)";
}

# Q
#?pugs skip 'Q'
{
my $s1 = "hello"; #OK not used
my $t1 = Q /$s1, world/;
is $t1, '$s1, world', "Testing for Q operator.";

my $s2 = "你好"; #OK not used
my $t2 = Q /$s2, 世界/;
is $t2, '$s2, 世界', "Testing for Q operator. (utf8)";
}

# q:b
#?rakudo skip 'quoting adverbs'
#?pugs skip 'parsefail'
{
    my $t = q:b /\n\n\n/;
is $t, "\n\n\n", "Testing for q:b operator.";
is q:b'\n\n', "\n\n", "Testing q:b'\\n'";
ok qb"\n\t".chars == 2, 'qb';
is Qb{a\nb}, "a\nb", 'Qb';
is Q:b{a\nb}, "a\nb", 'Q:b';
    is Qs:b{\n}, "\n", 'Qs:b';
}

# q:x
#?rakudo skip 'q:x'
{
    my $result = %*VM.perl ~~ /MSWIN32/ ?? "hello\r\n" !! "hello\n";
    is q:x/echo hello/, $result, "Testing for q:x operator.";
}
# utf8

#?rakudo skip 'q:x'
{
# 一 means "One" in Chinese.
is q:x/echo 一/, "\n", "Testing for q:x operator. (utf8)";
}

#?rakudo skip 'qq:x'
{
my $world = 'world';
is qq:x/echo hello $world/, "hello world\n", 'Testing qq:x operator';
}

#?rakudo skip 'q:x assigned to array'
#?niecza todo ':x'
#?pugs todo
{
my @two_lines = q:x/echo hello ; echo world/;
is @two_lines, ("hello\n", "world\n"), 'testing q:x assigned to array';
}

#?rakudo skip 'q:x assigned to array'
#?niecza todo ':x'
#?pugs todo
{
my $hello = 'howdy';
my @two_lines = qq:x/echo $hello ; echo world/;
is @two_lines, ("$hello\n", "world\n"), 'testing qq:x assigned to array';
}


# L<S02/Adverbs on quotes/"Interpolate % vars">
# q:h
#?rakudo skip 'quoting adverbs'
#?niecza todo
{
    # Pugs can't parse q:h currently.
    my %t = (a => "perl", b => "rocks");
    my $s;
    $s = q:h /%t<>/;
is $s, ~%t, "Testing for q:h operator.";
}

# q:f
#?rakudo skip 'quoting adverbs'
#?niecza skip '& escape'
{
my sub f { "hello" };
my $t = q:f /&f(), world/;
is $t, f() ~ ", world", "Testing for q:f operator.";

sub f_utf8 { "你好" };
$t = q:f /&f_utf8(), 世界/;
    is $t, f_utf8() ~ ", 世界", "Testing for q:f operator. (utf8)";
}

# q:c
#?rakudo skip 'quoting adverbs'
{
    my sub f { "hello" };
    my $t = q:c /{f}, world/;
is $t, f() ~ ", world", "Testing for q:c operator.";
}

# q:a
#?rakudo skip 'quoting adverbs'
{
my @t = qw/a b c/;
my $s = q:a /@t[]/;
is $s, ~@t, "Testing for q:a operator.";
}

# q:s
#?rakudo skip 'quoting adverbs'
{
    my $s = "someone is laughing";
    my $t = q:s /$s/;
is $t, $s, "Testing for q:s operator.";

$s = "有人在笑";
$t = q:s /$s/;
is $t, $s, "Testing for q:s operator. (utf8)";
}

# multiple quoting modes
#?rakudo skip 'quoting adverbs'
{
my $s = 'string';
my @a = <arr1 arr2>;
my %h = (foo => 'bar'); #OK not used
is(q:s:a'$s@a[]%h', $s ~ @a ~ '%h', 'multiple modifiers interpolate only what is expected');
}

# shorthands:
#?rakudo skip 'quoting adverbs'
#?niecza skip '& escape, zen slices'
#?pugs skip 'parsefail'
{
    my $alpha = 'foo';
    my $beta = 'bar';
    my @delta = <baz qux>;
    my %gamma = (abc => 123);
    sub zeta {42};

    is(qw[a b], <a b>, 'qw');
    is(qww[$alpha $beta], <foo bar>, 'qww');
    is(qq[$alpha $beta], 'foo bar', 'qq');
    is(Qs[$alpha @delta[] %gamma<>], 'foo @delta %gamma', 'Qs');
    is(Qa[$alpha @delta[] %gamma<>], '$alpha ' ~ @delta ~ ' %gamma', 'Qa');
    is(Qh[$alpha @delta[] %gamma<>], '$alpha @delta ' ~ %gamma, 'Qh');
    is(Qf[$alpha &zeta()], '$alpha 42', 'Qf');
    is(Qb[$alpha\t$beta], '$alpha $beta', 'Qb');
    is(Qc[{1+1}], 2, 'Qc');
}

# L<S02/Backslashing/All other quoting forms (including standard single quotes)>
{
    is('test\\', "test\\", "backslashes at end of single quoted string");
    is 'a\\b\''.chars, 4, 'backslash and single quote';
}

{
    isa_ok rx/foo/, Regex, 'rx/.../';
    isa_ok rx{foo}, Regex, 'rx{...}';
    isa_ok rx:i{foo}, Regex, 'rx:i{...}';
    isa_ok rx:ignorecase{foo}, Regex, 'rx:i{...}';
    isa_ok rx:s{foo}, Regex, 'rx:i{...}';
    isa_ok rx:sigspace{foo}, Regex, 'rx:i{...}';
    #?pugs todo
    eval_dies_ok 'rx:unknown{foo}', 'rx:unknown dies';
    #?pugs todo
    eval_dies_ok 'rx:g{foo}', 'g does not make sense on rx//';
}

{
    my $var = 'world';
    is qx/echo world/.chomp, "world", 'qx';
    #?pugs skip 'multi ok'
    is qqx/echo $var/.chomp, "world", 'qqx';
    # RT #78874
    is qx/echo world/.trans('wd' => 'WD'), "WorlD\n", "qx doesn't return a Parrot string";
}

done;

# vim: ft=perl6
Something went wrong with that request. Please try again.