on master help sign in
Add Perl test file
commitbf07b0be58d4ae7d247de04c2f7a57a851664e7a authorSaul Blanco Tejero <saul.blanco.tejero@iesjulianmarias.es> dateMon 12 Oct 2020, 13:21 (6 years ago) parenteeea537
2 files changed+314
tests/syntax-tests/highlighted/Perl/test.pl+157 tests/syntax-tests/source/Perl/test.pl+157
tests/syntax-tests/highlighted/Perl/test.plnew file+157
@@ -0,0 +1,157 @@
1+# Perl Test
2+# By saul-bt
3+# PUBLIC DOMAIN
4+
5+use strict;
6+use warnings;
7+
8+## REFERENCES ##
9+my @colors = ("red", "green", "blue");
10+
11+# '\' can be used to get a reference
12+my $colorsRef = \@colors;
13+
14+my %superHash = (
15+ "colors" => $colorsRef,
16+ # Also you can create an anonymous
17+ # array with '[]' ({} for hashes)
18+ # that returns the reference
19+ "numbers" => [1, 2, 3]
20+);
21+
22+# Now the hash stores something like
23+# this: ("colors", ARRAY(0x...),
24+# "numbers", ARRAY(0x...))
25+
26+# And you can access these arrays with:
27+print qq(@{$superHash{"colors"}}\n);
28+
29+# To print an element:
30+print qq(${$superHash{"numbers"}}[0]\n);
31+print $superHash{"colors"} -> [0], "\n";
32+
33+# Size of array:
34+print scalar @{$superHash{"colors"}};
35+
36+
37+## ARRAYS ##
38+%meh1 = (num => 0, val => 4);
39+%meh2 = (
40+ num => 1,
41+ val => 3
42+);
43+
44+@mehs = (\%meh1, \%meh2);
45+
46+print $mehs[0]{val};
47+
48+
49+## HANDLERS & HEREDOC ##
50+print "What's your name? ";
51+$name = <STDIN>;
52+chomp($name);
53+
54+print <<WELCOME;
55+
56+Hi $name, Where are you from?
57+WELCOME
58+
59+$place = <STDIN>;
60+chomp($place);
61+
62+print <<GOODBYE;
63+
64+Oh, you are $name from $place...
65+I hear that $place is a beautiful place.
66+It's nice meet people like you $name.
67+I hope to see you soon :)
68+
69+Bye $name.
70+GOODBYE
71+
72+open (content, "<", "file.txt");
73+
74+for $line (<content>) {
75+ print $line;
76+}
77+
78+print "What are you looking for? ";
79+$numResults = 0;
80+$word = <STDIN>;
81+chomp($word);
82+
83+for $line (<>) {
84+ if ($line =~ m/\b$word\b/i) {
85+ $numResults += 1;
86+ print "[$word FOUND]> $line\n";
87+ next;
88+ }
89+ print $line;
90+}
91+
92+print "\n\n=== There are $numResults coincidences ===";
93+
94+
95+## SCRIPT ARGUMENTS ##
96+$nargs = $#ARGV + 1;
97+
98+print "There are $nargs arguments:\n";
99+
100+for $arg (@ARGV) {
101+ print "- $arg\n";
102+}
103+
104+## REGEX STUFF ##
105+$string = "Perl is cool";
106+
107+if ($string =~ m/[Pp]erl/) {
108+ print "Yeah";
109+}
110+elsif ($string =~ m(perl)i) {
111+ print "Sad";
112+}
113+else {
114+ print "MEH";
115+}
116+
117+# From my dummy recreation of printf
118+sub checkTypes {
119+ my @percents = @{scalar(shift)};
120+ my @args = @{scalar(shift)};
121+ my $size = scalar(@percents);
122+
123+ foreach my $n (0..$size - 1) {
124+ my $currArg = $args[$n];
125+ my $currFormat = substr($percents[$n],-1);
126+ 
127+ $currFormat eq 's' && $currArg =~ m/^\D+$/ ||
128+ $currFormat =~ m/[dx]/ && $currArg =~ m/^\d+$/ ||
129+ $currFormat eq 'f' && $currArg =~ m/^\d+(?:\.\d+)?$/ or
130+ die "'$currArg' can't be formatted as '$currFormat'";
131+ }
132+}
133+
134+## WEIRD STUFF (JAPH) ##
135+# VMS <3
136+not exp log srand xor s qq qx xor
137+s x x length uc ord and print chr
138+ord for qw q join use sub tied qx
139+xor eval xor print qq q q xor int
140+eval lc q m cos and print chr ord
141+for qw y abs ne open tied hex exp
142+ref y m xor scalar srand print qq
143+q q xor int eval lc qq y sqrt cos
144+and print chr ord for qw x printf
145+each return local x y or print qq
146+s s and eval q s undef or oct xor
147+time xor ref print chr int ord lc
148+foreach qw y hex alarm chdir kill
149+exec return y s gt sin sort split
150+
151+@P=split//,".URRUU\c8R";@d=split//,"\nrekcah xinU / lreP rehtona tsuJ";sub p{
152+@p{"r$p","u$p"}=(P,P);pipe"r$p","u$p";++$p;($q*=2)+=$f=!fork;map{$P=$P[$f^ord
153+($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
154+close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print
155+
156+''=~('(?{'.('-)@.)@_*([]@!@/)(@)@-@),@(@@+@)'
157+^'][)@]`}`]()`@.@]@%[`}%[@`@!#@%[').',"})')
tests/syntax-tests/source/Perl/test.plnew file+157
@@ -0,0 +1,157 @@
1+# Perl Test
2+# By saul-bt
3+# PUBLIC DOMAIN
4+
5+use strict;
6+use warnings;
7+
8+## REFERENCES ##
9+my @colors = ("red", "green", "blue");
10+
11+# '\' can be used to get a reference
12+my $colorsRef = \@colors;
13+
14+my %superHash = (
15+ "colors" => $colorsRef,
16+ # Also you can create an anonymous
17+ # array with '[]' ({} for hashes)
18+ # that returns the reference
19+ "numbers" => [1, 2, 3]
20+);
21+
22+# Now the hash stores something like
23+# this: ("colors", ARRAY(0x...),
24+# "numbers", ARRAY(0x...))
25+
26+# And you can access these arrays with:
27+print qq(@{$superHash{"colors"}}\n);
28+
29+# To print an element:
30+print qq(${$superHash{"numbers"}}[0]\n);
31+print $superHash{"colors"} -> [0], "\n";
32+
33+# Size of array:
34+print scalar @{$superHash{"colors"}};
35+
36+
37+## ARRAYS ##
38+%meh1 = (num => 0, val => 4);
39+%meh2 = (
40+ num => 1,
41+ val => 3
42+);
43+
44+@mehs = (\%meh1, \%meh2);
45+
46+print $mehs[0]{val};
47+
48+
49+## HANDLERS & HEREDOC ##
50+print "What's your name? ";
51+$name = <STDIN>;
52+chomp($name);
53+
54+print <<WELCOME;
55+
56+Hi $name, Where are you from?
57+WELCOME
58+
59+$place = <STDIN>;
60+chomp($place);
61+
62+print <<GOODBYE;
63+
64+Oh, you are $name from $place...
65+I hear that $place is a beautiful place.
66+It's nice meet people like you $name.
67+I hope to see you soon :)
68+
69+Bye $name.
70+GOODBYE
71+
72+open (content, "<", "file.txt");
73+
74+for $line (<content>) {
75+ print $line;
76+}
77+
78+print "What are you looking for? ";
79+$numResults = 0;
80+$word = <STDIN>;
81+chomp($word);
82+
83+for $line (<>) {
84+ if ($line =~ m/\b$word\b/i) {
85+ $numResults += 1;
86+ print "[$word FOUND]> $line\n";
87+ next;
88+ }
89+ print $line;
90+}
91+
92+print "\n\n=== There are $numResults coincidences ===";
93+
94+
95+## SCRIPT ARGUMENTS ##
96+$nargs = $#ARGV + 1;
97+
98+print "There are $nargs arguments:\n";
99+
100+for $arg (@ARGV) {
101+ print "- $arg\n";
102+}
103+
104+## REGEX STUFF ##
105+$string = "Perl is cool";
106+
107+if ($string =~ m/[Pp]erl/) {
108+ print "Yeah";
109+}
110+elsif ($string =~ m(perl)i) {
111+ print "Sad";
112+}
113+else {
114+ print "MEH";
115+}
116+
117+# From my dummy recreation of printf
118+sub checkTypes {
119+ my @percents = @{scalar(shift)};
120+ my @args = @{scalar(shift)};
121+ my $size = scalar(@percents);
122+
123+ foreach my $n (0..$size - 1) {
124+ my $currArg = $args[$n];
125+ my $currFormat = substr($percents[$n],-1);
126+
127+ $currFormat eq 's' && $currArg =~ m/^\D+$/ ||
128+ $currFormat =~ m/[dx]/ && $currArg =~ m/^\d+$/ ||
129+ $currFormat eq 'f' && $currArg =~ m/^\d+(?:\.\d+)?$/ or
130+ die "'$currArg' can't be formatted as '$currFormat'";
131+ }
132+}
133+
134+## WEIRD STUFF (JAPH) ##
135+# VMS <3
136+not exp log srand xor s qq qx xor
137+s x x length uc ord and print chr
138+ord for qw q join use sub tied qx
139+xor eval xor print qq q q xor int
140+eval lc q m cos and print chr ord
141+for qw y abs ne open tied hex exp
142+ref y m xor scalar srand print qq
143+q q xor int eval lc qq y sqrt cos
144+and print chr ord for qw x printf
145+each return local x y or print qq
146+s s and eval q s undef or oct xor
147+time xor ref print chr int ord lc
148+foreach qw y hex alarm chdir kill
149+exec return y s gt sin sort split
150+
151+@P=split//,".URRUU\c8R";@d=split//,"\nrekcah xinU / lreP rehtona tsuJ";sub p{
152+@p{"r$p","u$p"}=(P,P);pipe"r$p","u$p";++$p;($q*=2)+=$f=!fork;map{$P=$P[$f^ord
153+($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
154+close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print
155+
156+''=~('(?{'.('-)@.)@_*([]@!@/)(@)@-@),@(@@+@)'
157+^'][)@]`}`]()`@.@]@%[`}%[@`@!#@%[').',"})')