1# -*- coding: utf-8 -*- 2#-------------------------------------------------------------------------- 3# perl-test-sub-prototypes.pl 4#-------------------------------------------------------------------------- 5# compiled all relevant subroutine prototype test cases 6# 7#-------------------------------------------------------------------------- 8# Kein-Hong Man <keinhong@gmail.com> Public Domain 9#-------------------------------------------------------------------------- 10# 20151227 initial document 11#-------------------------------------------------------------------------- 12 13#-------------------------------------------------------------------------- 14# test cases for sub syntax scanner 15#-------------------------------------------------------------------------- 16# sub syntax: simple and with added module notation 17#-------------------------------------------------------------------------- 18 19sub fish($) { 123; } 20sub fish::chips($) { 123; } # module syntax 21sub fish::chips::sauce($) { 123; } # multiple module syntax 22 23sub fish :: chips :: sauce ($) { 123; } # added whitespace 24 25sub fish :: # embedded comment 26chips # embedded comment 27 :: sauce ($) { 123; } 28 29sub fish :: ($) { 123; } # incomplete or bad syntax examples 30sub fish :: 123 ($) { 123; } 31sub fish :: chips 123 ($) { 123; } 32sub 123 ($) { 123; } 33 34#-------------------------------------------------------------------------- 35# sub syntax: prototype attributes 36#-------------------------------------------------------------------------- 37 38sub fish:prototype($) { 123; } 39sub fish : prototype ($) { 123; } # added whitespace 40 41sub fish:salted($) { 123; } # wrong attribute example (must use 'prototype') 42sub fish : 123($) { 123; } # illegal attribute 43sub fish:prototype:salted($) { 123; } # wrong 'prototype' position 44sub fish:salted salt:prototype($) { 123; } # wrong attribute syntax 45 46sub fish:const:prototype($) { 123; } # extra attributes 47sub fish:const:lvalue:prototype($) { 123; } 48sub fish:const:prototype($):lvalue{ 123; } # might be legal too 49sub fish :const :prototype($) { 123; } # extra whitespace 50 51sub fish :const # embedded comment: a constant sub 52:prototype # embedded comment 53($) { 123; } 54 55#-------------------------------------------------------------------------- 56# sub syntax: mixed 57#-------------------------------------------------------------------------- 58 59sub fish::chips:prototype($) { 123; } 60sub fish::chips::sauce:prototype($) { 123; } 61sub fish ::chips ::sauce :prototype($) { 123; } # +whitespace 62 63sub fish::chips::sauce:const:prototype($) { 123; } 64sub fish::chips::sauce :const :prototype($) { 123; } # +whitespace 65 66sub fish # embedded comment 67::chips ::sauce # embedded comment 68 : const # embedded comment 69 : prototype ($) { 123; } 70 71# wrong syntax examples, parentheses must follow ':prototype' 72sub fish :prototype :const ($) { 123;} 73sub fish :prototype ::chips ($) { 123;} 74 75#-------------------------------------------------------------------------- 76# perl-test-5200delta.pl 77#-------------------------------------------------------------------------- 78# More consistent prototype parsing 79#-------------------------------------------------------------------------- 80# - whitespace now allowed, lexer now allows spaces or tabs 81 82sub foo ( $ $ ) {} 83sub foo ( ) {} # spaces/tabs empty 84sub foo ( * ) {} 85sub foo (@ ) {} 86sub foo ( %) {} 87 88# untested, should probably be \[ but scanner does not check this for now 89sub foo ( \ [ $ @ % & * ] ) {} 90 91#-------------------------------------------------------------------------- 92# perl-test-5140delta.pl 93#-------------------------------------------------------------------------- 94# new + prototype character, acts like (\[@%]) 95#-------------------------------------------------------------------------- 96 97# these samples work as before 98sub mylink ($$) # mylink $old, $new 99sub myvec ($$$) # myvec $var, $offset, 1 100sub myindex ($$;$) # myindex &getstring, "substr" 101sub mysyswrite ($$$;$) # mysyswrite $buf, 0, length($buf) - $off, $off 102sub myreverse (@) # myreverse $a, $b, $c 103sub myjoin ($@) # myjoin ":", $a, $b, $c 104sub myopen (*;$) # myopen HANDLE, $name 105sub mypipe (**) # mypipe READHANDLE, WRITEHANDLE 106sub mygrep (&@) # mygrep { /foo/ } $a, $b, $c 107sub myrand (;$) # myrand 42 108sub mytime () # mytime 109 110# backslash group notation to specify more than one allowed argument type 111sub myref (\[$@%&*]) {} 112 113sub mysub (_) # underscore can be optionally used FIXED 20151211 114 115# these uses the new '+' prototype character 116sub mypop (+) # mypop @array 117sub mysplice (+$$@) # mysplice @array, 0, 2, @pushme 118sub mykeys (+) # mykeys %{$hashref} 119 120#-------------------------------------------------------------------------- 121# perl-test-5200delta.pl 122#-------------------------------------------------------------------------- 123# Experimental Subroutine signatures (mostly works) 124#-------------------------------------------------------------------------- 125# INCLUDED FOR COMPLETENESS ONLY 126# IMPORTANT NOTE the subroutine prototypes lexing implementation has 127# no effect on subroutine signature syntax highlighting 128 129# subroutine signatures mostly looks fine except for the @ and % slurpy 130# notation which are highlighted as operators (all other parameters are 131# highlighted as vars of some sort), a minor aesthetic issue 132 133use feature 'signatures'; 134 135sub foo ($left, $right) { # mandatory positional parameters 136 return $left + $right; 137} 138sub foo ($first, $, $third) { # ignore second argument 139 return "first=$first, third=$third"; 140} 141sub foo ($left, $right = 0) { # optional parameter with default value 142 return $left + $right; 143} 144my $auto_id = 0; # default value expression, evaluated if default used only 145sub foo ($thing, $id = $auto_id++) { 146 print "$thing has ID $id"; 147} 148sub foo ($first_name, $surname, $nickname = $first_name) { # 3rd parm may depend on 1st parm 149 print "$first_name $surname is known as \"$nickname\""; 150} 151sub foo ($thing, $ = 1) { # nameless default parameter 152 print $thing; 153} 154sub foo ($thing, $=) { # (this does something, I'm not sure what...) 155 print $thing; 156} 157sub foo ($filter, @inputs) { # additional arguments (slurpy parameter) 158 print $filter->($_) foreach @inputs; 159} 160sub foo ($thing, @) { # nameless slurpy parameter FAILS for now 161 print $thing; 162} 163sub foo ($filter, %inputs) { # slurpy parameter, hash type 164 print $filter->($_, $inputs{$_}) foreach sort keys %inputs; 165} 166sub foo ($thing, %) { # nameless slurpy parm, hash type FAILS for now 167 print $thing; 168} 169sub foo () { # empty signature no arguments (styled as prototype) 170 return 123; 171} 172 173#-------------------------------------------------------------------------- 174# perl-test-5200delta.pl 175#-------------------------------------------------------------------------- 176# subs now take a prototype attribute 177#-------------------------------------------------------------------------- 178 179sub foo :prototype($) { $_[0] } 180 181sub foo :prototype($$) ($left, $right) { 182 return $left + $right; 183} 184 185sub foo : prototype($$){} # whitespace allowed 186 187# additional samples from perl-test-cases.pl with ':prototype' added: 188sub mylink :prototype($$) {} sub myvec :prototype($$$) {} 189sub myindex :prototype($$;$) {} sub mysyswrite :prototype($$$;$) {} 190sub myreverse :prototype(@) {} sub myjoin :prototype($@) {} 191sub mypop :prototype(\@) {} sub mysplice :prototype(\@$$@) {} 192sub mykeys :prototype(\%) {} sub myopen :prototype(*;$) {} 193sub mypipe :prototype(**) {} sub mygrep :prototype(&@) {} 194sub myrand :prototype($) {} sub mytime :prototype() {} 195# backslash group notation to specify more than one allowed argument type 196sub myref :prototype(\[$@%&*]) {} 197 198# additional attributes may complicate scanning for prototype syntax, 199# for example (from https://metacpan.org/pod/perlsub): 200# Lvalue subroutines 201 202my $val; 203sub canmod : lvalue { 204 $val; # or: return $val; 205} 206canmod() = 5; # assigns to $val 207 208#-------------------------------------------------------------------------- 209# perl-test-5220delta.pl 210#-------------------------------------------------------------------------- 211# New :const subroutine attribute 212#-------------------------------------------------------------------------- 213 214my $x = 54321; 215*INLINED = sub : const { $x }; 216$x++; 217 218# more examples of attributes 219# (not 5.22 stuff, but some general examples for study, useful for 220# handling subroutine signature and subroutine prototype highlighting) 221 222sub foo : lvalue ; 223 224package X; 225sub Y::z : lvalue { 1 } 226 227package X; 228sub foo { 1 } 229package Y; 230BEGIN { *bar = \&X::foo; } 231package Z; 232sub Y::bar : lvalue ; 233 234# built-in attributes for subroutines: 235lvalue method prototype(..) locked const 236 237#-------------------------------------------------------------------------- 238# end of test file 239#-------------------------------------------------------------------------- 240