Warning, /frameworks/syntax-highlighting/autotests/input/highlight.raku is written in an unsupported language. File is not indexed.
0001 #!/usr/bin/perl6 0002 0003 use v6; 0004 0005 if True { 0006 say "Hello"; 0007 } 0008 0009 if True { 0010 say "Hello"; # Bad indentation intended 0011 } 0012 0013 if True { say "Hello" } 0014 0015 if True {say "Hello"} 0016 0017 if True { say "Hello" } else { say "Goodbye" }; say "world"; 0018 0019 ## BEGIN Comments 0020 0021 say 1 #`( blah TODO blah 0022 here? ) 2 ; 0023 say 1 #`{{ blah TODO blah 0024 here? }} 2 ; 0025 say 1 #`[[ blah TODO blah ] 0026 here? ]] 2 ; 0027 say 1 #`««« blah TODO blah 0028 here? »»» 2 ; 0029 say 1 #` ( blah TODO blah 0030 2 ; 0031 0032 #`[ 0033 This is another multi-line comment. ] 0034 my @sorted = @names.sort({ %sets{$_} }).sort({ %matches{$_} }).reverse; 0035 #`{ So is this, though it's not actually multi-line. } 0036 0037 say 'code again'; 0038 0039 #`( Multiple line comments `( sub-comment )`)` 0040 0041 ## END Comments 0042 0043 #`[ 0044 And this is how a multi would work. 0045 That says why we do what we do below. 0046 ] 0047 0048 say "No more"; 0049 0050 #`{{a}a}} say ok 0051 0052 say "No more"; 0053 0054 say "this is code"; 0055 0056 =begin pod 0057 0058 A very simple Pod6 document 0059 0060 =end pod 0061 0062 =begin head1 0063 Top Level Heading 0064 =end head1 0065 0066 =head1 Top level heading 0067 0068 =for head1 0069 Top Level Heading 0070 0071 =cutsdads 0072 0073 =begin pod 0074 0075 =head1 This is a head1 title 0076 0077 This is a paragraph. 0078 0079 =head2 Subsection 0080 # plop 0081 Here some text for the subsection. 0082 0083 =end pod 0084 0085 =begin table :caption<My Tasks> 0086 mow lawn 0087 take out trash 0088 =end table 0089 0090 =head1 This is a heading block 0091 This is an ordinary paragraph. 0092 Its text will be squeezed and 0093 short lines filled. It is terminated by 0094 the first blank line. 0095 0096 =head2 This is another heading block 0097 This is yet another ordinary paragraph, 0098 at the first virtual column set by the 0099 previous directive 0100 0101 #| Base class for magicians 0102 class Magician { 0103 has Int $.level; 0104 has Str @.spells; 0105 } 0106 0107 #| Fight mechanics 0108 sub duel(Magician $a, Magician $b) { 0109 } 0110 #=«<(( 0111 <Magicians only, no mortals. > 0112 Magicians only, no mortals. 0113 ))>» 0114 0115 say Magician.WHY; 0116 0117 #|<< This is an example of stringification: 0118 * Numbers turn into strings 0119 > * Regexes operate on said strings 0120 * C<with> topicalizes and places result into $_ 0121 >> 0122 sub search-in-seq( Int $end, Int $number ) { 0123 with (^$end).grep( /^$number/ ) { 0124 .say for $_<>; 0125 } 0126 } 0127 #= Uses * topic * decont operator 0128 0129 0130 =head1 plop 0131 abc 0132 0133 =head1 plop 0134 =para 0135 abc 0136 0137 =head1 plop 0138 abc 0139 abc 0140 0141 =head1 plop 0142 abc 0143 0144 say 1; 0145 0146 =head1 plop 0147 0148 say 1; 0149 0150 =for head1 0151 plop 0152 0153 =for table :conf[str, 'str', "str", 1, True] :conf(str, 'str', "str", 1, True) 0154 =for table :conf<str 'str' "str" 1 True> 0155 =for table :conf{k => str, k=>'str', k=>"str", k=>1, k=>True} 0156 =for table :a :!b :42k :+s 0157 abc 0158 0159 say 2; 0160 0161 =begin a 0162 abc 0163 =end a 0164 0165 =begin b sa 0166 =end b 0167 say 2; 0168 0169 =begin a 0170 abc 0171 0172 abc 0173 0174 abc 0175 =end a 0176 say 0 ; 0177 =begin a:config{42} 0178 abc 0179 0180 =head1 The 0181 Title 0182 0183 abc 0184 =end ab 0185 say 1 ; 0186 0187 =begin b sa 0188 =end b 0189 =begin a 0190 abc 0191 =begin b 0192 abc 0193 =end b a 0194 abc 0195 0196 abc 0197 =end a 0198 say 3 ; 0199 0200 =item a 0201 =item b 0202 =begin code 0203 =item a 0204 =end code 0205 0206 =begin code 0207 =item a 0208 b 0209 =end code d 0210 =end code 0211 0212 =begin comment 0213 Here are several 0214 lines 0215 of comment 0216 =end comment 0217 0218 =begin pod 0219 =head1 acB<<I<a>>>a B<c> U<d> BB<a> 0220 0221 C<my $var = 1; say $var;> 0222 Perl 6 homepage L<https://perl6.org> L<Perl 6 homepage|https://perl6.org> 0223 Comments L<#Comments> L<Comments|#Comments> 0224 Perl 6 is awesome Z<Of course it is!> 0225 Perl 6 is multi-paradigmatic N<Supporting Procedural, Object Oriented, and Functional programming> 0226 Enter your name K<John Doe> E<0xBB> characters. 0227 0228 A X<hash|hashes, definition of; associative arrays> 0229 0230 =DISCLAIMER 0231 P<http://www.MegaGigaTeraPetaCorp.com/std/disclaimer.txt> 0232 0233 A X<hash|hashes, definition of; associative arrays> 0234 is an unordered collection of scalar values indexed by their 0235 associated string key. 0236 0237 my @names = <Foo Bar Baz>; 0238 my @upper-case-names = @names.map: { .uc } # OUTPUT: [FOO BAR BAZ] 0239 0240 =end pod 0241 0242 =begin table :caption<My Tasks> 0243 mow lawn 0244 take out trash 0245 =end table 0246 0247 =begin table :config{caption => "My Tasks"} 0248 mow lawn 0249 take out trash 0250 =end table 0251 0252 0253 say "\c999 \c999999999 \c[LATIN CAPITAL LETTER A, LATIN CAPITAL LETTER B] \c77s \c[77,22]"; 0254 say "\x0 \x00 \x[0] \x[00] \x[f] \xaaa \xfffffff \xffh \x[ffff] \x[fffffff] \x[42,42]"; 0255 say "\o0 \o00 \o[0] \o[00] \o[7] \o333 \o77777777 \o77h \o[333] \o[77777777] \o[42,42]"; 0256 0257 say Q[A literal string] ; 0258 say 「More plainly.」 ; 0259 say Q ^Almost any non-word character can be a delimiter!^ ; 0260 say Q 「「Delimiters can be repeated/nested if they are adjacent.」」 ; 0261 0262 say Q (this is fine, because of space after Q) ; 0263 say Q 'and so is this' ; 0264 say Q<Make sure you <match> opening and closing delimiters> ; 0265 say Q{This is still a closing curly brace → \} ; 0266 0267 say Q;yes, this is fine; ; 0268 say Q('this is a function') ; 0269 0270 say 'Very plain'; 0271 say q[This back\slash stays]; 0272 say q[This back\\slash stays]; # Identical output 0273 say q{This is not a closing curly brace → \}, but this is → }; 0274 say Q :q $There are no backslashes here, only lots of \$\$\$>!$; 0275 say '(Just kidding. There\'s no money in that string)'; 0276 say 'No $interpolation {here}!'; 0277 say Q:q!Just a literal "\n" here!; 0278 say Q:q[a\[] 0279 say Q[A literal string] ; 0280 say 「More plainly.」 ; 0281 say Q ^Almost any non-word character can be a delimiter!^ ; 0282 say Q 「「Delimiters can be repeated/nested if they are adjacent.」」 ; 0283 0284 say qq[My favorite color is {$n+2}!]; 0285 say qq{My favorite color\- is {$n+2}!}; 0286 say Q:qq{My favorite color\- is {$n+2}!}; 0287 say "My $color[0].uc( 0288 ) $n+$n.^name favorite color \q[1is] {$n+2}!abc&uc('a')"; 0289 0290 say qqww|a|; 0291 say qq:w:w|a|; 0292 say q:a:v|a|; 0293 0294 say(qq:to/TERM INATOR/, 1+1); 0295 blah blah 0296 TERM INATOR 0297 0298 0299 my $don't-do-that = 1; 0300 my $piece_of_π = 3.14; 0301 my $駱駝道 = 1; 0302 my $lexical = 1; 0303 my $*dynamic1 = 10; 0304 my $*dynamic2 = 100; 0305 0306 sub say-all() { 0307 say "$lexical, $*dynamic1, $*dynamic2"; 0308 } 0309 0310 say-all(); 0311 0312 { 0313 my $lexical = 2; 0314 my $*dynamic1 = 11; 0315 $*dynamic2 = 101; 0316 } 0317 0318 my $square = 9 ** 2; 0319 my @array = 1, 2, 3; # Array variable with three elements 0320 my %hash = London => 'UK', Berlin => 'Germany'; 0321 0322 class FailHash is Hash { 0323 has Bool $!final = False; 0324 multi method AT-KEY ( ::?CLASS:D: Str:D \key ){ 0325 fail X::OutOfRange.new(:what("Hash key"), :got(key), 0326 :range(self.keys)) if $!final && !self.EXISTS-KEY(key); 0327 callsame 0328 } 0329 0330 method finalize() { 0331 $!final = True 0332 } 0333 } 0334 0335 my %h is FailHash = oranges => "round", bananas => "bendy"; 0336 0337 say %h<oranges>; 0338 %h.finalize; 0339 say %h<cherry>; 0340 CATCH { default { put .^name, ': ', .Str } } 0341 0342 my ( @foo, $bar ); 0343 @foo = ($bar) = 42, "str"; 0344 0345 say anon class þ {}; 0346 say anon sub þ { 42 }; 0347 0348 sub a { 0349 state @x; 0350 state $l = 'A'; 0351 @x.push($l++); 0352 }; 0353 0354 say a for 1..6; 0355 0356 sub foo($x) { 0357 my $v = @; 0358 $v[$x] = $x; 0359 say $v; 0360 } 0361 0362 foo($_) for ^3; 0363 0364 use MONKEY-TYPING; 0365 augment class Int { 0366 method is-answer { self == 42 } 0367 } 0368 say 42.is-answer; 0369 0370 my $in = 0; 0371 0372 sub f(*@c) { 0373 (temp $in)++; 0374 "<f>\n" 0375 ~ @c».indent($in).join("\n") 0376 ~ (+@c ?? "\n" !! "") 0377 ~ '</f>' 0378 }; 0379 0380 for <ab:c d$e fgh ij*> { 0381 .say if m/<-alpha>/; 0382 } 0383 0384 for '.' { 0385 .Str.say when !.IO.d; 0386 .IO.dir()».&?BLOCK when .IO.d # lets recurse a little! 0387 } 0388 0389 use Dog:auth<Somebody>:ver<2.0>; 0390 0391 infix:<+> 0392 infix:<*> 0393 infix:«<=» 0394 0395 postfix:<²> 0396 WOW:That'sAwesome 0397 WOW:That's<<🆒>> 0398 party:sweet<16> 0399 0400 infix:<+> 0401 infix:<<+>> 0402 infix:«+» 0403 infix:['+'] 0404 infix:('+') 0405 0406 my $a:b<c>:d<e> = 100; 0407 my $a:d<e>:b<c> = 200; 0408 say $a:b<c>:d<e>; 0409 0410 use Test; plan 1; constant &term:<👍> = &ok.assuming(True); 0411 👍 0412 0413 my $x = do if True { 42 }; 0414 0415 say 1000000, 1_000_000, 10_00000, 100_00_00; 0416 say -2, 12345, 0xBEEF, 0o755, :3<1201>; 0417 say 1.0, 3.14159, -2.5, :3<21.0012>; 0418 say 1e0, 6.022e23, 1e-9, -2e48, 2e2i, .42; 0419 say 2.e2, .2, 0o39, 0xfF3u, 0oi, 0xi, :3<>, :23<gg ; # error 0420 0421 0422 for $size «[r/]« (2**60, 2**50, 2**40, 2**30, 2**20, 2**10) 0423 Z <EB PB TB GB MB KB> -> [\v,\suffix] 0424 0425 my $a = 32; 0426 $a += 10; 0427 $a -= 2; 0428 $a = 3; 0429 $a min= 5; 0430 $s ~= 'b'; 0431 0432 sub infix:<space-concat> ($a, $b) { $a ~ " " ~ $b }; 0433 my $a = 'word1'; 0434 $a space-concat= 'word2'; 0435 0436 my Real $a = 1/2; 0437 $a = 3.14; 0438 $a .= round; 0439 0440 my $a = True; 0441 say so $a != True; 0442 my $i = 10; 0443 0444 my $release = Date.new(:2015year, :12month, :24day); 0445 my $today = Date.today; 0446 say so $release !before $today; 0447 0448 say 4 R/ 12; 0449 say [R/] 2, 4, 16; 0450 say [RZ~] <1 2 3>,<4 5 6> 0451 0452 say (1, 2, 3) »*» 2; 0453 say (1, 2, 3, 4) »~» <a b>; 0454 say (1, 2, 3) »+« (4, 5, 6); 0455 say (&sin, &cos, &sqrt)».(0.5); 0456 0457 say @a »+=» 1; 0458 my ($a, $b, $c); 0459 (($a, $b), $c) «=» ((1, 2), 3); 0460 0461 say !« @wisdom; 0462 @a»++; 0463 say -« [[1, 2], 3]; 0464 0465 @slops».?this-method-may-not-exist(); 0466 0467 my %outer = 1, 2, 3 Z=> <a b c>; 0468 my %inner = 1, 2 Z=> <x z>; 0469 say %outer «~» %inner; 0470 0471 say $neighbors »>>+<<» ($p, *); 0472 0473 sub plus { $^a + $^b }; 0474 say [[&plus]] 1, 2, 3; 0475 0476 my @n = [\~] 1..*; 0477 say @n[^5]; 0478 0479 @l = <a b c d> Z~ 1, 2, *; 0480 say so 1 S& 2 S& 3; 0481 @a X[+=] @b; 0482 multi sub postfix:<++>($x is rw) is assoc<non> 0483 say $filename++ for 1..3; 0484 $x % $y == $x - floor($x / $y) * $y 0485 say <a a b c a d> ⊍ bag(<a a b c c>); 0486 say -« <1 2 3> 0487 0488 # This is wrong: creates a Hash of Mixes, not Mix: 0489 my Mix %mix; 0490 # Works with $ sigil: 0491 my Mix $mix; 0492 # Can be typed: 0493 my Mix[Int] $mix-of-ints; 0494 0495 my $x; 0496 my $x = 7; 0497 my Int $x = 7; 0498 my Int:D $x = 7; 0499 ndef) 0500 my Int $x where { $_ > 3 } = 7; 0501 my Int $x where * > 3 = 7; 0502 0503 $str ~~ tr:d:c!dol!wne!; 0504 $str ~~ TR:c/dol/wne/; 0505 $str ~~ s!foo!fox!; 0506 $str ~~ /foo/bar/; 0507 $str ~~ ///; 0508 $str ~~ rx/foo/bar/; 0509 $str ~~ Q :regex /foo/; 0510 $str ~~ s{b(.)r} = " d$0n"; 0511 $str ~~ regex{fox}; # error 0512 $str ~~ regex {fox}; 0513 rx/ ^ab /; 0514 / ^ ab /; 0515 rx/ \d ** 2/; 0516 $str ~~ tr:d:c!dol!wne!; 0517 $str ~~ TR:c/dol/wne/; 0518 $str ~~ s!foo!fox!; 0519 $str ~~ rx/foo/; 0520 $str ~~ regex:ds {fox}; 0521 $str ~~ regex{fox}; 0522 my a = /a/; 0523 rx/ ^ab /; 0524 a = / ^ ab 'a' "$a" \d \n\n <:L :Script<Latin>> <:Block('Basic Latin')> /; 0525 //; 0526 rx:sigspace.\d+ < :Script +:Block "Basic Latin" + :L> #plop 0527 '-'.; 0528 rx/ \d ** 2 <[\d a d]+[\x233..\] " \c[dsds]]>/; 0529 say $str ~~ m:g/[(<[ACGT]> **: 3) \s*]+ \s+ (<[A..Z a a..z \s]>+)/; 0530 say '$333' ~~ m/^^ <?[$]> . \d+ /; 0531 say '/foo/o/bar/' ~~ /\/.**!{1..10}\//; 0532 rx(a); 0533 rx (a); 0534 $str ~~ regex {fox}; 0535 $str ~~ s{b(.)r} = " d$0n"; 0536 if 'abc' ~~ / [a||b] (c) / { 0537 say ~$0; # OUTPUT: «c» 0538 } 0539 if 'abc' ~~ / $<myname> = [ \w+ ] / { 0540 say ~$<myname> # OUTPUT: «abc» 0541 } 0542 say 'abc' ~~ / a <( b )> c/; 0543 say 'abc' ~~ / <(a <( b )> c)>/; 0544 say "abc" ~~ /a. | ab { print "win" } /; 0545 0546 so 'hello world' ~~ m:Perl5/^hello (world)/; # OUTPUT: «True» 0547 so 'hello world' ~~ m/^hello (world)/; # OUTPUT: «False» 0548 so 'hello world' ~~ m/^ 'hello ' ('world')/; # OUTPUT: «True» 0549 0550 say "Abra abra CADABRA" ~~ m:exhaustive/:i a \w+ a/; 0551 0552 my regex ipv4-octet { \d ** 1..3 <?{ $/.Int <= 255 && $/.Int >= 0 }> } 0553 my regex ipv4-octet { \d ** 1..3 <?{ True }> } 0554 say 'abc' ~~ / <?before a> && . /; 0555 say 'abcdefg' ~~ rx{ abc <[email protected]ending_letters> }; 0556 s:g[\d+ <?before \s* @units>] = 5 * $/; 0557 0558 0559 sub walk(\thing, *@keys) is rw { 0560 my $current := thing; 0561 for @keys -> $k { 0562 if $k ~~ Int { 0563 $current := $current[$k]; 0564 } 0565 else { 0566 $current := $current{$k}; 0567 } 0568 } 0569 $current; 0570 } 0571 0572 my %hash; 0573 walk(%hash, 'some', 'key', 1, 2) = 'autovivified'; 0574 0575 say %hash.perl; 0576 0577 class X::WithoutLineNumber is X::AdHoc { 0578 multi method gist(X::WithoutLineNumber:D:) { 0579 $.payload 0580 } 0581 } 0582 die X::WithoutLineNumber.new(payload => "message") 0583 0584 { return; CATCH { default { $*ERR.say: .^name, ': ', .Str } } } 0585 0586 multi sub trait_mod:<is>(Routine $r, :$export!) 0587 0588 react { 0589 whenever signal(SIGINT) { 0590 say "goodbye"; 0591 done 0592 } 0593 } 0594 0595 signal(SIGINT).tap: { say "bye"; exit }; loop {} 0596 0597 method base-repeating(Rational:D: Int:D() $base = 10) 0598 0599 multi sub prefix:<-->($x is rw) is assoc<non> 0600 0601 0602 multi MAIN(Bool :$man) { 0603 run $*EXECUTABLE, '--doc', $*PROGRAM; 0604 } 0605 0606 for $file.lines -> $line { 0607 next unless $line; # ignore any empty lines 0608 0609 my ($pairing, $result) = $line.split(' | '); 0610 my ($p1, $p2) = $pairing.words; 0611 my ($r1, $r2) = $result.split(':'); 0612 0613 %sets{$p1} += $r1; 0614 %sets{$p2} += $r2; 0615 0616 if $r1 > $r2 { 0617 %matches{$p1}++; 0618 } else { 0619 %matches{$p2}++; 0620 } 0621 } 0622 0623 for @sorted -> $n { 0624 my $match-noun = %matches{$n} == 1 ?? 'match' !! 'matches'; 0625 my $set-noun = %sets{$n} == 1 ?? 'set' !! 'sets'; 0626 say "$n has won %matches{$n} $match-noun and %sets{$n} $set-noun"; 0627 } 0628 0629 say "Math: { 1 + 2 }"; 0630 0631 my @people = <Luke Matthew Mark>; 0632 say "The synoptics are: {@people}"; 0633 0634 say "{%sets}"; 0635 say "we have @flavors[0]"; 0636 say "we have @flavors[]"; 0637 say "we have @flavors.sort()"; 0638 say "we have @flavors.sort.join(', ')"; 0639 0640 my @valid-players = $file.get.words; 0641 0642 for $file.lines -> $line { 0643 my ($pairing, $result) = $line.split(' | '); 0644 my ($p1, $p2) = $pairing.split(' '); 0645 if $p1 ∉ @valid-players { 0646 say "Warning: '$p1' is not on our list!"; 0647 } 0648 if $p2 ∉ @valid-players { 0649 say "Warning: '$p2' is not on our list!"; 0650 } 0651 }