Differential D24176 Diff 66721 autotests/input/highlight.pl6

Changeset View

Standalone View

autotests/input/highlight.pl6

This file was added.

		1		#!/usr/bin/perl6
		2
		3		use v6;
		4
		5		if True {
		6		say "Hello";
		7		}
		8
		9		if True {
		10		say "Hello"; # Bad indentation intended
		11		}
		12
		13		if True { say "Hello" }
		14
		15		if True {say "Hello"}
		16
		17		if True { say "Hello" } else { say "Goodbye" }; say "world";
		18
		19		## BEGIN Comments
		20
		21		say 1 #`( blah TODO blah
		22		here? ) 2 ;
		23		say 1 #`{{ blah TODO blah
		24		here? }} 2 ;
		25		say 1 #`[[ blah TODO blah ]
		26		here? ]] 2 ;
		27		say 1 #`««« blah TODO blah
		28		here? »»» 2 ;
		29		say 1 #` ( blah TODO blah
		30		2 ;
		31
		32		#`[
		33		This is another multi-line comment. ]
		34		my @sorted = @names.sort({ %sets{$_} }).sort({ %matches{$_} }).reverse;
		35		#`{ So is this, though it's not actually multi-line. }
		36
		37		say 'code again';
		38
		39		#`( Multiple line comments `( sub-comment )`)`
		40
		41		## END Comments
		42
		43		#`[
		44		And this is how a multi would work.
		45		That says why we do what we do below.
		46		]
		47
		48		say "No more";
		49
		50		#`{{a}a}} say ok
		51
		52		say "No more";
		53
		54		say "this is code";
		55
		56		=begin pod
		57
		58		A very simple Pod6 document
		59
		60		=end pod
		61
		62		=begin head1
		63		Top Level Heading
		64		=end head1
		65
		66		=head1 Top level heading
		67
		68		=for head1
		69		Top Level Heading
		70
		71		=cutsdads
		72
		73		=begin pod
		74
		75		=head1 This is a head1 title
		76
		77		This is a paragraph.
		78
		79		=head2 Subsection
		80		# plop
		81		Here some text for the subsection.
		82
		83		=end pod
		84
		85		=begin table :caption<My Tasks>
		86		mow lawn
		87		take out trash
		88		=end table
		89
		90		=head1 This is a heading block
		91		This is an ordinary paragraph.
		92		Its text will be squeezed and
		93		short lines filled. It is terminated by
		94		the first blank line.
		95
		96		=head2 This is another heading block
		97		This is yet another ordinary paragraph,
		98		at the first virtual column set by the
		99		previous directive
		100
		101		#\| Base class for magicians
		102		class Magician {
		103		has Int $.level;
		104		has Str @.spells;
		105		}
		106
		107		#\| Fight mechanics
		108		sub duel(Magician $a, Magician $b) {
		109		}
		110		#=«<((
		111		<Magicians only, no mortals. >
		112		Magicians only, no mortals.
		113		))>»
		114
		115		say Magician.WHY;
		116
		117		#\|<< This is an example of stringification:
		118		* Numbers turn into strings
		119		> * Regexes operate on said strings
		120		* C<with> topicalizes and places result into $_
		121		>>
		122		sub search-in-seq( Int $end, Int $number ) {
		123		with (^$end).grep( /^$number/ ) {
		124		.say for $_<>;
		125		}
		126		}
		127		#= Uses * topic * decont operator
		128
		129
		130		=head1 plop
		131		abc
		132
		133		=head1 plop
		134		=para
		135		abc
		136
		137		=head1 plop
		138		abc
		139		abc
		140
		141		=head1 plop
		142		abc
		143
		144		say 1;
		145
		146		=head1 plop
		147
		148		say 1;
		149
		150		=for head1
		151		plop
		152
		153		=for table :conf[str, 'str', "str", 1, True] :conf(str, 'str', "str", 1, True)
		154		=for table :conf<str 'str' "str" 1 True>
		155		=for table :conf{k => str, k=>'str', k=>"str", k=>1, k=>True}
		156		=for table :a :!b :42k :+s
		157		abc
		158
		159		say 2;
		160
		161		=begin a
		162		abc
		163		=end a
		164
		165		=begin b sa
		166		=end b
		167		say 2;
		168
		169		=begin a
		170		abc
		171
		172		abc
		173
		174		abc
		175		=end a
		176		say 0 ;
		177		=begin a:config{42}
		178		abc
		179
		180		=head1 The
		181		Title
		182
		183		abc
		184		=end ab
		185		say 1 ;
		186
		187		=begin b sa
		188		=end b
		189		=begin a
		190		abc
		191		=begin b
		192		abc
		193		=end b a
		194		abc
		195
		196		abc
		197		=end a
		198		say 3 ;
		199
		200		=item a
		201		=item b
		202		=begin code
		203		=item a
		204		=end code
		205
		206		=begin code
		207		=item a
		208		b
		209		=end code d
		210		=end code
		211
		212		=begin comment
		213		Here are several
		214		lines
		215		of comment
		216		=end comment
		217
		218		=begin pod
		219		=head1 acB<<I<a>>>a B<c> U<d> BB<a>
		220
		221		C<my $var = 1; say $var;>
		222		Perl 6 homepage L<https://perl6.org> L<Perl 6 homepage\|https://perl6.org>
		223		Comments L<#Comments> L<Comments\|#Comments>
		224		Perl 6 is awesome Z<Of course it is!>
		225		Perl 6 is multi-paradigmatic N<Supporting Procedural, Object Oriented, and Functional programming>
		226		Enter your name K<John Doe> E<0xBB> characters.
		227
		228		A X<hash\|hashes, definition of; associative arrays>
		229
		230		=DISCLAIMER
		231		P<http://www.MegaGigaTeraPetaCorp.com/std/disclaimer.txt>
		232
		233		A X<hash\|hashes, definition of; associative arrays>
		234		is an unordered collection of scalar values indexed by their
		235		associated string key.
		236
		237		my @names = <Foo Bar Baz>;
		238		my @upper-case-names = @names.map: { .uc } # OUTPUT: [FOO BAR BAZ]
		239
		240		=end pod
		241
		242		=begin table :caption<My Tasks>
		243		mow lawn
		244		take out trash
		245		=end table
		246
		247		=begin table :config{caption => "My Tasks"}
		248		mow lawn
		249		take out trash
		250		=end table
		251
		252
		253		say "\c999 \c999999999 \c[LATIN CAPITAL LETTER A, LATIN CAPITAL LETTER B] \c77s \c[77,22]";
		254		say "\x0 \x00 \x[0] \x[00] \x[f] \xaaa \xfffffff \xffh \x[ffff] \x[fffffff] \x[42,42]";
		255		say "\o0 \o00 \o[0] \o[00] \o[7] \o333 \o77777777 \o77h \o[333] \o[77777777] \o[42,42]";
		256
		257		say Q[A literal string] ;
		258		say ｢More plainly.｣ ;
		259		say Q ^Almost any non-word character can be a delimiter!^ ;
		260		say Q ｢｢Delimiters can be repeated/nested if they are adjacent.｣｣ ;
		261
		262		say Q (this is fine, because of space after Q) ;
		263		say Q 'and so is this' ;
		264		say Q<Make sure you <match> opening and closing delimiters> ;
		265		say Q{This is still a closing curly brace → \} ;
		266
		267		say Q;yes, this is fine; ;
		268		say Q('this is a function') ;
		269
		270		say 'Very plain';
		271		say q[This back\slash stays];
		272		say q[This back\\slash stays]; # Identical output
		273		say q{This is not a closing curly brace → \}, but this is → };
		274		say Q :q $There are no backslashes here, only lots of \$\$\$>!$;
		275		say '(Just kidding. There\'s no money in that string)';
		276		say 'No $interpolation {here}!';
		277		say Q:q!Just a literal "\n" here!;
		278		say Q:q[a\[]
		279		say Q[A literal string] ;
		280		say ｢More plainly.｣ ;
		281		say Q ^Almost any non-word character can be a delimiter!^ ;
		282		say Q ｢｢Delimiters can be repeated/nested if they are adjacent.｣｣ ;
		283
		284		say qq[My favorite color is {$n+2}!];
		285		say qq{My favorite color\- is {$n+2}!};
		286		say Q:qq{My favorite color\- is {$n+2}!};
		287		say "My $color[0].uc(
		288		) $n+$n.^name favorite color \q[1is] {$n+2}!abc&uc('a')";
		289
		290		say qqww\|a\|;
		291		say qq:w:w\|a\|;
		292		say q:a:v\|a\|;
		293
		294		say(qq:to/TERM INATOR/, 1+1);
		295		blah blah
		296		TERM INATOR
		297
		298
		299		my $don't-do-that = 1;
		300		my $piece_of_π = 3.14;
		301		my $駱駝道 = 1;
		302		my $lexical = 1;
		303		my $*dynamic1 = 10;
		304		my $*dynamic2 = 100;
		305
		306		sub say-all() {
		307		say "$lexical, $dynamic1, $dynamic2";
		308		}
		309
		310		say-all();
		311
		312		{
		313		my $lexical = 2;
		314		my $*dynamic1 = 11;
		315		$*dynamic2 = 101;
		316		}
		317
		318		my $square = 9 ** 2;
		319		my @array = 1, 2, 3; # Array variable with three elements
		320		my %hash = London => 'UK', Berlin => 'Germany';
		321
		322		class FailHash is Hash {
		323		has Bool $!final = False;
		324		multi method AT-KEY ( ::?CLASS:D: Str:D \key ){
		325		fail X::OutOfRange.new(:what("Hash key"), :got(key),
		326		:range(self.keys)) if $!final && !self.EXISTS-KEY(key);
		327		callsame
		328		}
		329
		330		method finalize() {
		331		$!final = True
		332		}
		333		}
		334
		335		my %h is FailHash = oranges => "round", bananas => "bendy";
		336
		337		say %h<oranges>;
		338		%h.finalize;
		339		say %h<cherry>;
		340		CATCH { default { put .^name, ': ', .Str } }
		341
		342		my ( @foo, $bar );
		343		@foo = ($bar) = 42, "str";
		344
		345		say anon class þ {};
		346		say anon sub þ { 42 };
		347
		348		sub a {
		349		state @x;
		350		state $l = 'A';
		351		@x.push($l++);
		352		};
		353
		354		say a for 1..6;
		355
		356		sub foo($x) {
		357		my $v = @;
		358		$v[$x] = $x;
		359		say $v;
		360		}
		361
		362		foo($_) for ^3;
		363
		364		use MONKEY-TYPING;
		365		augment class Int {
		366		method is-answer { self == 42 }
		367		}
		368		say 42.is-answer;
		369
		370		my $in = 0;
		371
		372		sub f(*@c) {
		373		(temp $in)++;
		374		"<f>\n"
		375		~ @c».indent($in).join("\n")
		376		~ (+@c ?? "\n" !! "")
		377		~ '</f>'
		378		};
		379
		380		for <ab:c d$e fgh ij*> {
		381		.say if m/<-alpha>/;
		382		}
		383
		384		for '.' {
		385		.Str.say when !.IO.d;
		386		.IO.dir()».&?BLOCK when .IO.d # lets recurse a little!
		387		}
		388
		389		use Dog:auth<Somebody>:ver<2.0>;
		390
		391		infix:<+>
		392		infix:<*>
		393		infix:«<=»
		394
		395		postfix:<²>
		396		WOW:That'sAwesome
		397		WOW:That's<<🆒>>
		398		party:sweet<16>
		399
		400		infix:<+>
		401		infix:<<+>>
		402		infix:«+»
		403		infix:['+']
		404		infix:('+')
		405
		406		my $a:b<c>:d<e> = 100;
		407		my $a:d<e>:b<c> = 200;
		408		say $a:b<c>:d<e>;
		409
		410		use Test; plan 1; constant &term:<👍> = &ok.assuming(True);
		411		👍
		412
		413		my $x = do if True { 42 };
		414
		415		say 1000000, 1_000_000, 10_00000, 100_00_00;
		416		say -2, 12345, 0xBEEF, 0o755, :3<1201>;
		417		say 1.0, 3.14159, -2.5, :3<21.0012>;
		418		say 1e0, 6.022e23, 1e-9, -2e48, 2e2i, .42;
		419		say 2.e2, .2, 0o39, 0xfF3u, 0oi, 0xi, :3<>, :23<gg ; # error
		420
		421
		422		for $size «[r/]« (260, 250, 240, 230, 220, 210)
		423		Z <EB PB TB GB MB KB> -> [\v,\suffix]
		424
		425		my $a = 32;
		426		$a += 10;
		427		$a -= 2;
		428		$a = 3;
		429		$a min= 5;
		430		$s ~= 'b';
		431
		432		sub infix:<space-concat> ($a, $b) { $a ~ " " ~ $b };
		433		my $a = 'word1';
		434		$a space-concat= 'word2';
		435
		436		my Real $a = 1/2;
		437		$a = 3.14;
		438		$a .= round;
		439
		440		my $a = True;
		441		say so $a != True;
		442		my $i = 10;
		443
		444		my $release = Date.new(:2015year, :12month, :24day);
		445		my $today = Date.today;
		446		say so $release !before $today;
		447
		448		say 4 R/ 12;
		449		say [R/] 2, 4, 16;
		450		say [RZ~] <1 2 3>,<4 5 6>
		451
		452		say (1, 2, 3) »*» 2;
		453		say (1, 2, 3, 4) »~» <a b>;
		454		say (1, 2, 3) »+« (4, 5, 6);
		455		say (&sin, &cos, &sqrt)».(0.5);
		456
		457		say @a »+=» 1;
		458		my ($a, $b, $c);
		459		(($a, $b), $c) «=» ((1, 2), 3);
		460
		461		say !« @wisdom;
		462		@a»++;
		463		say -« [[1, 2], 3];
		464
		465		@slops».?this-method-may-not-exist();
		466
		467		my %outer = 1, 2, 3 Z=> <a b c>;
		468		my %inner = 1, 2 Z=> <x z>;
		469		say %outer «~» %inner;
		470
		471		say $neighbors »>>+<<» ($p, *);
		472
		473		sub plus { $^a + $^b };
		474		say [[&plus]] 1, 2, 3;
		475
		476		my @n = [\~] 1..*;
		477		say @n[^5];
		478
		479		@l = <a b c d> Z~ 1, 2, *;
		480		say so 1 S& 2 S& 3;
		481		@a X[+=] @b;
		482		multi sub postfix:<++>($x is rw) is assoc<non>
		483		say $filename++ for 1..3;
		484		$x % $y == $x - floor($x / $y) * $y
		485		say <a a b c a d> ⊍ bag(<a a b c c>);
		486		say -« <1 2 3>
		487
		488		# This is wrong: creates a Hash of Mixes, not Mix:
		489		my Mix %mix;
		490		# Works with $ sigil:
		491		my Mix $mix;
		492		# Can be typed:
		493		my Mix[Int] $mix-of-ints;
		494
		495		my $x;
		496		my $x = 7;
		497		my Int $x = 7;
		498		my Int:D $x = 7;
		499		ndef)
		500		my Int $x where { $_ > 3 } = 7;
		501		my Int $x where * > 3 = 7;
		502
		503		$str ~~ tr:d:c!dol!wne!;
		504		$str ~~ TR:c/dol/wne/;
		505		$str ~~ s!foo!fox!;
		506		$str ~~ /foo/bar/;
		507		$str ~~ ///;
		508		$str ~~ rx/foo/bar/;
		509		$str ~~ Q :regex /foo/;
		510		$str ~~ s{b(.)r} = " d$0n";
		511		$str ~~ regex{fox}; # error
		512		$str ~~ regex {fox};
		513		rx/ ^ab /;
		514		/ ^ ab /;
		515		rx/ \d ** 2/;
		516		$str ~~ tr:d:c!dol!wne!;
		517		$str ~~ TR:c/dol/wne/;
		518		$str ~~ s!foo!fox!;
		519		$str ~~ rx/foo/;
		520		$str ~~ regex:ds {fox};
		521		$str ~~ regex{fox};
		522		my a = /a/;
		523		rx/ ^ab /;
		524		a = / ^ ab 'a' "$a" \d \n\n <:L :Script<Latin>> <:Block('Basic Latin')> /;
		525		//;
		526		rx:sigspace.\d+ < :Script +:Block "Basic Latin" + :L> #plop
		527		'-'.;
		528		rx/ \d ** 2 <[\d a d]+[\x233..\] " \c[dsds]]>/;
		529		say $str ~~ m:g/[(<[ACGT]> *: 3) \s]+ \s+ (<[A..Z a a..z \s]>+)/;
		530		say '$333' ~~ m/^^ <?[$]> . \d+ /;
		531		say '/foo/o/bar/' ~~ /\/.**!{1..10}\//;
		532		rx(a);
		533		rx (a);
		534		$str ~~ regex {fox};
		535		$str ~~ s{b(.)r} = " d$0n";
		536		if 'abc' ~~ / [a\|\|b] (c) / {
		537		say ~$0; # OUTPUT: «c␤»
		538		}
		539		if 'abc' ~~ / $<myname> = [ \w+ ] / {
		540		say ~$<myname> # OUTPUT: «abc␤»
		541		}
		542		say 'abc' ~~ / a <( b )> c/;
		543		say 'abc' ~~ / <(a <( b )> c)>/;
		544		say "abc" ~~ /a. \| ab { print "win" } /;
		545
		546		so 'hello world' ~~ m:Perl5/^hello (world)/; # OUTPUT: «True␤»
		547		so 'hello world' ~~ m/^hello (world)/; # OUTPUT: «False␤»
		548		so 'hello world' ~~ m/^ 'hello ' ('world')/; # OUTPUT: «True␤»
		549
		550		say "Abra abra CADABRA" ~~ m:exhaustive/:i a \w+ a/;
		551
		552		my regex ipv4-octet { \d ** 1..3 <?{ $/.Int <= 255 && $/.Int >= 0 }> }
		553		my regex ipv4-octet { \d ** 1..3 <?{ True }> }
		554		say 'abc' ~~ / <?before a> && . /;
		555		say 'abcdefg' ~~ rx{ abc <[email protected]ending_letters> };
		556		s:g[\d+ <?before \s* @units>] = 5 * $/;
		557
		558
		559		sub walk(\thing, *@keys) is rw {
		560		my $current := thing;
		561		for @keys -> $k {
		562		if $k ~~ Int {
		563		$current := $current[$k];
		564		}
		565		else {
		566		$current := $current{$k};
		567		}
		568		}
		569		$current;
		570		}
		571
		572		my %hash;
		573		walk(%hash, 'some', 'key', 1, 2) = 'autovivified';
		574
		575		say %hash.perl;
		576
		577		class X::WithoutLineNumber is X::AdHoc {
		578		multi method gist(X::WithoutLineNumber:D:) {
		579		$.payload
		580		}
		581		}
		582		die X::WithoutLineNumber.new(payload => "message")
		583
		584		{ return; CATCH { default { $*ERR.say: .^name, ': ', .Str } } }
		585
		586		multi sub trait_mod:<is>(Routine $r, :$export!)
		587
		588		react {
		589		whenever signal(SIGINT) {
		590		say "goodbye";
		591		done
		592		}
		593		}
		594
		595		signal(SIGINT).tap: { say "bye"; exit }; loop {}
		596
		597		method base-repeating(Rational:D: Int:D() $base = 10)
		598
		599		multi sub prefix:<-->($x is rw) is assoc<non>
		600
		601
		602		multi MAIN(Bool :$man) {
		603		run $EXECUTABLE, '--doc', $PROGRAM;
		604		}
		605
		606		for $file.lines -> $line {
		607		next unless $line; # ignore any empty lines
		608
		609		my ($pairing, $result) = $line.split(' \| ');
		610		my ($p1, $p2) = $pairing.words;
		611		my ($r1, $r2) = $result.split(':');
		612
		613		%sets{$p1} += $r1;
		614		%sets{$p2} += $r2;
		615
		616		if $r1 > $r2 {
		617		%matches{$p1}++;
		618		} else {
		619		%matches{$p2}++;
		620		}
		621		}
		622
		623		for @sorted -> $n {
		624		my $match-noun = %matches{$n} == 1 ?? 'match' !! 'matches';
		625		my $set-noun = %sets{$n} == 1 ?? 'set' !! 'sets';
		626		say "$n has won %matches{$n} $match-noun and %sets{$n} $set-noun";
		627		}
		628
		629		say "Math: { 1 + 2 }";
		630
		631		my @people = <Luke Matthew Mark>;
		632		say "The synoptics are: {@people}";
		633
		634		say "{%sets}";
		635		say "we have @flavors[0]";
		636		say "we have @flavors[]";
		637		say "we have @flavors.sort()";
		638		say "we have @flavors.sort.join(', ')";
		639
		640		my @valid-players = $file.get.words;
		641
		642		for $file.lines -> $line {
		643		my ($pairing, $result) = $line.split(' \| ');
		644		my ($p1, $p2) = $pairing.split(' ');
		645		if $p1 ∉ @valid-players {
		646		say "Warning: '$p1' is not on our list!";
		647		}
		648		if $p2 ∉ @valid-players {
		649		say "Warning: '$p2' is not on our list!";
		650		}
		651		}