├── .github └── workflows │ └── test.yml ├── LICENSE ├── README.md ├── ale_linters └── perl │ └── syntax_check.vim ├── config ├── default.pl └── relax.pl ├── cpanfile ├── extlib └── MarkWarnings.pm ├── lib ├── Checker.pm └── Checker │ ├── Formatter │ ├── ALE.pm │ └── JSON.pm │ ├── Home.pm │ ├── Impl │ ├── Compile.pm │ ├── Custom.pm │ ├── Misc.pm │ └── Regexp.pm │ └── Trace.pm ├── syntax-check └── t ├── basic.t ├── config └── custom.pl ├── custom-lib └── Local.pm └── file ├── alienfile ├── cpanfile ├── invalid.pl ├── not_perl_shebang ├── todo.pl ├── todo_skip.pl ├── use_fail.pl └── warn.pl /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: test 2 | 3 | on: 4 | push: 5 | branches: 6 | - '*' 7 | tags-ignore: 8 | - '*' 9 | pull_request: 10 | 11 | jobs: 12 | perl: 13 | runs-on: ubuntu-latest 14 | strategy: 15 | matrix: 16 | perl-version: 17 | - '5.8-buster' 18 | - '5.10-buster' 19 | - '5.16-buster' 20 | - 'latest' 21 | - 'threaded' 22 | container: 23 | image: perl:${{ matrix.perl-version }} 24 | steps: 25 | - uses: actions/checkout@v2 26 | - run: perl -V 27 | - run: curl -fsSL --compressed https://git.io/cpm | perl - install -g --with-develop --with-recommends --show-build-log-on-failure 28 | - run: prove -l t 29 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This software is copyright (c) 2018 by Shoichi Kaji . 2 | 3 | This is free software; you can redistribute it and/or modify it under 4 | the same terms as the Perl 5 programming language system itself. 5 | 6 | Terms of the Perl programming language system itself 7 | 8 | a) the GNU General Public License as published by the Free 9 | Software Foundation; either version 1, or (at your option) any 10 | later version, or 11 | b) the "Artistic License" 12 | 13 | --- The GNU General Public License, Version 1, February 1989 --- 14 | 15 | This software is Copyright (c) 2018 by Shoichi Kaji . 16 | 17 | This is free software, licensed under: 18 | 19 | The GNU General Public License, Version 1, February 1989 20 | 21 | GNU GENERAL PUBLIC LICENSE 22 | Version 1, February 1989 23 | 24 | Copyright (C) 1989 Free Software Foundation, Inc. 25 | 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 26 | 27 | Everyone is permitted to copy and distribute verbatim copies 28 | of this license document, but changing it is not allowed. 29 | 30 | Preamble 31 | 32 | The license agreements of most software companies try to keep users 33 | at the mercy of those companies. By contrast, our General Public 34 | License is intended to guarantee your freedom to share and change free 35 | software--to make sure the software is free for all its users. The 36 | General Public License applies to the Free Software Foundation's 37 | software and to any other program whose authors commit to using it. 38 | You can use it for your programs, too. 39 | 40 | When we speak of free software, we are referring to freedom, not 41 | price. Specifically, the General Public License is designed to make 42 | sure that you have the freedom to give away or sell copies of free 43 | software, that you receive source code or can get it if you want it, 44 | that you can change the software or use pieces of it in new free 45 | programs; and that you know you can do these things. 46 | 47 | To protect your rights, we need to make restrictions that forbid 48 | anyone to deny you these rights or to ask you to surrender the rights. 49 | These restrictions translate to certain responsibilities for you if you 50 | distribute copies of the software, or if you modify it. 51 | 52 | For example, if you distribute copies of a such a program, whether 53 | gratis or for a fee, you must give the recipients all the rights that 54 | you have. You must make sure that they, too, receive or can get the 55 | source code. And you must tell them their rights. 56 | 57 | We protect your rights with two steps: (1) copyright the software, and 58 | (2) offer you this license which gives you legal permission to copy, 59 | distribute and/or modify the software. 60 | 61 | Also, for each author's protection and ours, we want to make certain 62 | that everyone understands that there is no warranty for this free 63 | software. If the software is modified by someone else and passed on, we 64 | want its recipients to know that what they have is not the original, so 65 | that any problems introduced by others will not reflect on the original 66 | authors' reputations. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | GNU GENERAL PUBLIC LICENSE 72 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 73 | 74 | 0. This License Agreement applies to any program or other work which 75 | contains a notice placed by the copyright holder saying it may be 76 | distributed under the terms of this General Public License. The 77 | "Program", below, refers to any such program or work, and a "work based 78 | on the Program" means either the Program or any work containing the 79 | Program or a portion of it, either verbatim or with modifications. Each 80 | licensee is addressed as "you". 81 | 82 | 1. You may copy and distribute verbatim copies of the Program's source 83 | code as you receive it, in any medium, provided that you conspicuously and 84 | appropriately publish on each copy an appropriate copyright notice and 85 | disclaimer of warranty; keep intact all the notices that refer to this 86 | General Public License and to the absence of any warranty; and give any 87 | other recipients of the Program a copy of this General Public License 88 | along with the Program. You may charge a fee for the physical act of 89 | transferring a copy. 90 | 91 | 2. You may modify your copy or copies of the Program or any portion of 92 | it, and copy and distribute such modifications under the terms of Paragraph 93 | 1 above, provided that you also do the following: 94 | 95 | a) cause the modified files to carry prominent notices stating that 96 | you changed the files and the date of any change; and 97 | 98 | b) cause the whole of any work that you distribute or publish, that 99 | in whole or in part contains the Program or any part thereof, either 100 | with or without modifications, to be licensed at no charge to all 101 | third parties under the terms of this General Public License (except 102 | that you may choose to grant warranty protection to some or all 103 | third parties, at your option). 104 | 105 | c) If the modified program normally reads commands interactively when 106 | run, you must cause it, when started running for such interactive use 107 | in the simplest and most usual way, to print or display an 108 | announcement including an appropriate copyright notice and a notice 109 | that there is no warranty (or else, saying that you provide a 110 | warranty) and that users may redistribute the program under these 111 | conditions, and telling the user how to view a copy of this General 112 | Public License. 113 | 114 | d) You may charge a fee for the physical act of transferring a 115 | copy, and you may at your option offer warranty protection in 116 | exchange for a fee. 117 | 118 | Mere aggregation of another independent work with the Program (or its 119 | derivative) on a volume of a storage or distribution medium does not bring 120 | the other work under the scope of these terms. 121 | 122 | 3. You may copy and distribute the Program (or a portion or derivative of 123 | it, under Paragraph 2) in object code or executable form under the terms of 124 | Paragraphs 1 and 2 above provided that you also do one of the following: 125 | 126 | a) accompany it with the complete corresponding machine-readable 127 | source code, which must be distributed under the terms of 128 | Paragraphs 1 and 2 above; or, 129 | 130 | b) accompany it with a written offer, valid for at least three 131 | years, to give any third party free (except for a nominal charge 132 | for the cost of distribution) a complete machine-readable copy of the 133 | corresponding source code, to be distributed under the terms of 134 | Paragraphs 1 and 2 above; or, 135 | 136 | c) accompany it with the information you received as to where the 137 | corresponding source code may be obtained. (This alternative is 138 | allowed only for noncommercial distribution and only if you 139 | received the program in object code or executable form alone.) 140 | 141 | Source code for a work means the preferred form of the work for making 142 | modifications to it. For an executable file, complete source code means 143 | all the source code for all modules it contains; but, as a special 144 | exception, it need not include source code for modules which are standard 145 | libraries that accompany the operating system on which the executable 146 | file runs, or for standard header files or definitions files that 147 | accompany that operating system. 148 | 149 | 4. You may not copy, modify, sublicense, distribute or transfer the 150 | Program except as expressly provided under this General Public License. 151 | Any attempt otherwise to copy, modify, sublicense, distribute or transfer 152 | the Program is void, and will automatically terminate your rights to use 153 | the Program under this License. However, parties who have received 154 | copies, or rights to use copies, from you under this General Public 155 | License will not have their licenses terminated so long as such parties 156 | remain in full compliance. 157 | 158 | 5. By copying, distributing or modifying the Program (or any work based 159 | on the Program) you indicate your acceptance of this license to do so, 160 | and all its terms and conditions. 161 | 162 | 6. Each time you redistribute the Program (or any work based on the 163 | Program), the recipient automatically receives a license from the original 164 | licensor to copy, distribute or modify the Program subject to these 165 | terms and conditions. You may not impose any further restrictions on the 166 | recipients' exercise of the rights granted herein. 167 | 168 | 7. The Free Software Foundation may publish revised and/or new versions 169 | of the General Public License from time to time. Such new versions will 170 | be similar in spirit to the present version, but may differ in detail to 171 | address new problems or concerns. 172 | 173 | Each version is given a distinguishing version number. If the Program 174 | specifies a version number of the license which applies to it and "any 175 | later version", you have the option of following the terms and conditions 176 | either of that version or of any later version published by the Free 177 | Software Foundation. If the Program does not specify a version number of 178 | the license, you may choose any version ever published by the Free Software 179 | Foundation. 180 | 181 | 8. If you wish to incorporate parts of the Program into other free 182 | programs whose distribution conditions are different, write to the author 183 | to ask for permission. For software which is copyrighted by the Free 184 | Software Foundation, write to the Free Software Foundation; we sometimes 185 | make exceptions for this. Our decision will be guided by the two goals 186 | of preserving the free status of all derivatives of our free software and 187 | of promoting the sharing and reuse of software generally. 188 | 189 | NO WARRANTY 190 | 191 | 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 192 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 193 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 194 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 195 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 196 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 197 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 198 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 199 | REPAIR OR CORRECTION. 200 | 201 | 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 202 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 203 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 204 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 205 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 206 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 207 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 208 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 209 | POSSIBILITY OF SUCH DAMAGES. 210 | 211 | END OF TERMS AND CONDITIONS 212 | 213 | Appendix: How to Apply These Terms to Your New Programs 214 | 215 | If you develop a new program, and you want it to be of the greatest 216 | possible use to humanity, the best way to achieve this is to make it 217 | free software which everyone can redistribute and change under these 218 | terms. 219 | 220 | To do so, attach the following notices to the program. It is safest to 221 | attach them to the start of each source file to most effectively convey 222 | the exclusion of warranty; and each file should have at least the 223 | "copyright" line and a pointer to where the full notice is found. 224 | 225 | 226 | Copyright (C) 19yy 227 | 228 | This program is free software; you can redistribute it and/or modify 229 | it under the terms of the GNU General Public License as published by 230 | the Free Software Foundation; either version 1, or (at your option) 231 | any later version. 232 | 233 | This program is distributed in the hope that it will be useful, 234 | but WITHOUT ANY WARRANTY; without even the implied warranty of 235 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 236 | GNU General Public License for more details. 237 | 238 | You should have received a copy of the GNU General Public License 239 | along with this program; if not, write to the Free Software 240 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA 241 | 242 | 243 | Also add information on how to contact you by electronic and paper mail. 244 | 245 | If the program is interactive, make it output a short notice like this 246 | when it starts in an interactive mode: 247 | 248 | Gnomovision version 69, Copyright (C) 19xx name of author 249 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 250 | This is free software, and you are welcome to redistribute it 251 | under certain conditions; type `show c' for details. 252 | 253 | The hypothetical commands `show w' and `show c' should show the 254 | appropriate parts of the General Public License. Of course, the 255 | commands you use may be called something other than `show w' and `show 256 | c'; they could even be mouse-clicks or menu items--whatever suits your 257 | program. 258 | 259 | You should also get your employer (if you work as a programmer) or your 260 | school, if any, to sign a "copyright disclaimer" for the program, if 261 | necessary. Here a sample; alter the names: 262 | 263 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 264 | program `Gnomovision' (a program to direct compilers to make passes 265 | at assemblers) written by James Hacker. 266 | 267 | , 1 April 1989 268 | Ty Coon, President of Vice 269 | 270 | That's all there is to it! 271 | 272 | 273 | --- The Artistic License 1.0 --- 274 | 275 | This software is Copyright (c) 2018 by Shoichi Kaji . 276 | 277 | This is free software, licensed under: 278 | 279 | The Artistic License 1.0 280 | 281 | The Artistic License 282 | 283 | Preamble 284 | 285 | The intent of this document is to state the conditions under which a Package 286 | may be copied, such that the Copyright Holder maintains some semblance of 287 | artistic control over the development of the package, while giving the users of 288 | the package the right to use and distribute the Package in a more-or-less 289 | customary fashion, plus the right to make reasonable modifications. 290 | 291 | Definitions: 292 | 293 | - "Package" refers to the collection of files distributed by the Copyright 294 | Holder, and derivatives of that collection of files created through 295 | textual modification. 296 | - "Standard Version" refers to such a Package if it has not been modified, 297 | or has been modified in accordance with the wishes of the Copyright 298 | Holder. 299 | - "Copyright Holder" is whoever is named in the copyright or copyrights for 300 | the package. 301 | - "You" is you, if you're thinking about copying or distributing this Package. 302 | - "Reasonable copying fee" is whatever you can justify on the basis of media 303 | cost, duplication charges, time of people involved, and so on. (You will 304 | not be required to justify it to the Copyright Holder, but only to the 305 | computing community at large as a market that must bear the fee.) 306 | - "Freely Available" means that no fee is charged for the item itself, though 307 | there may be fees involved in handling the item. It also means that 308 | recipients of the item may redistribute it under the same conditions they 309 | received it. 310 | 311 | 1. You may make and give away verbatim copies of the source form of the 312 | Standard Version of this Package without restriction, provided that you 313 | duplicate all of the original copyright notices and associated disclaimers. 314 | 315 | 2. You may apply bug fixes, portability fixes and other modifications derived 316 | from the Public Domain or from the Copyright Holder. A Package modified in such 317 | a way shall still be considered the Standard Version. 318 | 319 | 3. You may otherwise modify your copy of this Package in any way, provided that 320 | you insert a prominent notice in each changed file stating how and when you 321 | changed that file, and provided that you do at least ONE of the following: 322 | 323 | a) place your modifications in the Public Domain or otherwise make them 324 | Freely Available, such as by posting said modifications to Usenet or an 325 | equivalent medium, or placing the modifications on a major archive site 326 | such as ftp.uu.net, or by allowing the Copyright Holder to include your 327 | modifications in the Standard Version of the Package. 328 | 329 | b) use the modified Package only within your corporation or organization. 330 | 331 | c) rename any non-standard executables so the names do not conflict with 332 | standard executables, which must also be provided, and provide a separate 333 | manual page for each non-standard executable that clearly documents how it 334 | differs from the Standard Version. 335 | 336 | d) make other distribution arrangements with the Copyright Holder. 337 | 338 | 4. You may distribute the programs of this Package in object code or executable 339 | form, provided that you do at least ONE of the following: 340 | 341 | a) distribute a Standard Version of the executables and library files, 342 | together with instructions (in the manual page or equivalent) on where to 343 | get the Standard Version. 344 | 345 | b) accompany the distribution with the machine-readable source of the Package 346 | with your modifications. 347 | 348 | c) accompany any non-standard executables with their corresponding Standard 349 | Version executables, giving the non-standard executables non-standard 350 | names, and clearly documenting the differences in manual pages (or 351 | equivalent), together with instructions on where to get the Standard 352 | Version. 353 | 354 | d) make other distribution arrangements with the Copyright Holder. 355 | 356 | 5. You may charge a reasonable copying fee for any distribution of this 357 | Package. You may charge any fee you choose for support of this Package. You 358 | may not charge a fee for this Package itself. However, you may distribute this 359 | Package in aggregate with other (possibly commercial) programs as part of a 360 | larger (possibly commercial) software distribution provided that you do not 361 | advertise this Package as a product of your own. 362 | 363 | 6. The scripts and library files supplied as input to or produced as output 364 | from the programs of this Package do not automatically fall under the copyright 365 | of this Package, but belong to whomever generated them, and may be sold 366 | commercially, and may be aggregated with this Package. 367 | 368 | 7. C or perl subroutines supplied by you and linked into this Package shall not 369 | be considered part of this Package. 370 | 371 | 8. The name of the Copyright Holder may not be used to endorse or promote 372 | products derived from this software without specific prior written permission. 373 | 374 | 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED 375 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF 376 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. 377 | 378 | The End 379 | 380 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Perl syntax checker [![](https://github.com/skaji/syntax-check-perl/workflows/test/badge.svg)](https://github.com/skaji/syntax-check-perl/actions) 2 | 3 | This is a Perl syntax checker, especially for [ale](https://github.com/dense-analysis/ale). 4 | 5 | ## Integrate with vim-plug and ale 6 | 7 | Here is how to integrate with [vim-plug](https://github.com/junegunn/vim-plug) and [ale](https://github.com/dense-analysis/ale). 8 | 9 | ```vim 10 | call plug#begin('~/.vim/plugged') 11 | Plug 'dense-analysis/ale' 12 | Plug 'skaji/syntax-check-perl' 13 | call plug#end() 14 | 15 | let g:ale_linters = { 'perl': ['syntax-check'] } 16 | ``` 17 | 18 | ## Configuration 19 | 20 | If you write Perl a lot, then I assume you have your own favorite for how to check Perl code. 21 | You can set config file for `syntax-check`: 22 | 23 | ```vim 24 | let g:ale_perl_syntax_check_config = expand('~/.vim/your-config.pl') 25 | 26 | " there is also my favorite, and you can use it:) 27 | let g:ale_perl_syntax_check_config = g:plug_home . '/syntax-check-perl/config/relax.pl' 28 | 29 | " add arbitrary perl executable names. defaults to "perl" 30 | let g:ale_perl_syntax_check_executable = 'my-perl' 31 | ``` 32 | 33 | The config files are written in Perl, so you can do whatever you want. :) See [default.pl](config/default.pl). 34 | 35 | ### Adding libs to @INC 36 | 37 | By default we try to add `lib` (or `blib` if appropriate), `t/lib`, `xt/lib` and `local/lib/perl5` to `@INC` when attempting 38 | to compile your code. Depending on how you work, this may not be what you 39 | want. The good news is that you can manage this via the Perl config file. See 40 | also [default.pl](config/default.pl) for more detailed information on how to do 41 | this. 42 | 43 | ## Security 44 | 45 | You should be aware that we use the `-c` flag to see if `perl` code compiles. 46 | This does not execute all of the code in a file, but it does run `BEGIN` and 47 | `CHECK` blocks. See `perl --help` and 48 | [StackOverflow](https://stackoverflow.com/a/12908487/406224). 49 | 50 | ## Debugging 51 | 52 | You can use `:ALEInfo` in `vim` to troubleshoot `Ale` plugins. Scroll to the 53 | bottom of the `:ALEInfo` output to find any errors which may have been produced 54 | by this plugin. 55 | 56 | ## Author 57 | 58 | Shoichi Kaji 59 | 60 | ## License 61 | 62 | The same as perl 63 | -------------------------------------------------------------------------------- /ale_linters/perl/syntax_check.vim: -------------------------------------------------------------------------------- 1 | " Original author: 2 | " https://github.com/w0rp/ale/blob/master/ale_linters/perl/perl.vim 3 | " Author: Vincent Lequertier 4 | " Description: This file adds support for checking perl syntax 5 | 6 | let g:ale_perl_syntax_check_executable = 7 | \ get(g:, 'ale_perl_syntax_check_executable', 'perl') 8 | 9 | let g:ale_perl_syntax_check_config = 10 | \ get(g:, 'ale_perl_syntax_check_config', g:plug_home . '/syntax-check-perl/config/default.pl') 11 | 12 | function! ale_linters#perl#syntax_check#GetConfig(buffer) abort 13 | return ale#Var(a:buffer, 'perl_syntax_check_config') 14 | endfunction 15 | 16 | function! ale_linters#perl#syntax_check#GetExecutable(buffer) abort 17 | return ale#Var(a:buffer, 'perl_syntax_check_executable') 18 | endfunction 19 | 20 | function! ale_linters#perl#syntax_check#GetCommand(buffer) abort 21 | let l:config = ale_linters#perl#syntax_check#GetConfig(a:buffer) 22 | if filereadable(l:config) 23 | return ale#Escape(ale_linters#perl#syntax_check#GetExecutable(a:buffer)) 24 | \ . ' ' . g:plug_home . '/syntax-check-perl/syntax-check' 25 | \ . ' --config ' . ale#Escape(ale_linters#perl#syntax_check#GetConfig(a:buffer)) 26 | \ . ' %s %t' 27 | else 28 | echo "[ERROR] ale plugin syntax-check-perl: Couldn't read config file " . l:config 29 | endif 30 | endfunction 31 | 32 | function! ale_linters#perl#syntax_check#Handle(buffer, lines) abort 33 | let l:pattern = '\(.\+\) at \(.\+\) line \(\d\+\)' 34 | let l:output = [] 35 | let l:basename = expand('#' . a:buffer . ':t') 36 | 37 | let l:seen = {} 38 | for l:match in ale#util#GetMatches(a:lines, l:pattern) 39 | let l:line = l:match[3] 40 | let l:file = l:match[2] 41 | let l:text = l:match[1] 42 | 43 | if (0 == match(l:text, '=MarkWarnings=') ) 44 | let l:type = 'W' 45 | let l:text = substitute(l:text, "^=MarkWarnings=" , "", "") 46 | else 47 | let l:type = 'E' 48 | endif 49 | 50 | if ale#path#IsBufferPath(a:buffer, l:file) 51 | \ && !has_key(l:seen,l:line) 52 | \ && ( 53 | \ l:text isnot# 'BEGIN failed--compilation aborted' 54 | \ || empty(l:output) 55 | \ ) 56 | call add(l:output, { 57 | \ 'lnum': l:line, 58 | \ 'text': l:text, 59 | \ 'type': l:type, 60 | \}) 61 | 62 | let l:seen[l:line] = 1 63 | endif 64 | endfor 65 | 66 | return l:output 67 | endfunction 68 | 69 | call ale#linter#Define('perl', { 70 | \ 'name': 'syntax-check', 71 | \ 'executable': function('ale_linters#perl#syntax_check#GetExecutable'), 72 | \ 'output_stream': 'both', 73 | \ 'command': function('ale_linters#perl#syntax_check#GetCommand'), 74 | \ 'callback': 'ale_linters#perl#syntax_check#Handle', 75 | \}) 76 | -------------------------------------------------------------------------------- /config/default.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | my $filename = $ENV{PERL_SYNTAX_CHECK_FILENAME} || ""; 5 | my $root = $ENV{PERL_SYNTAX_CHECK_ROOT} || ""; 6 | 7 | # must return a hash that represents configuration for syntax_check 8 | my $config = {}; 9 | 10 | __END__ 11 | 12 | =head1 CONFIGURATION EXAMPLE 13 | 14 | my $config = { 15 | 16 | # for `perl -c` configuration 17 | compile => { 18 | inc => { 19 | libs => [ 'lib', 't/custom-lib' ], 20 | replace_default_libs => 1, 21 | }, 22 | skip => [ 23 | qr/^Subroutine \S+ redefined/, 24 | ], 25 | }, 26 | 27 | # check line by regexp 28 | regexp => { 29 | check => [ 30 | qr/your common spelling mistake/, 31 | ], 32 | }, 33 | 34 | # ..and freedom! 35 | # your custom checker which takes ($line, $filename) as arguments 36 | custom => { 37 | check => [ 38 | sub { 39 | my ($line, $filename) = @_; 40 | if ( 41 | $filename =~ /my_project/ 42 | && 43 | $line =~ /TODO/ 44 | ) { 45 | return { type => 'WARN', message => 'TODO must be resolved' }; 46 | } 47 | }, 48 | ] 49 | }, 50 | }; 51 | 52 | =head2 compile 53 | 54 | The compile section defines the behaviour under which your code is run via the 55 | C<-c> flag. 56 | 57 | By default, we add C, C, C and C to C<@INC>. If you would like 58 | to add to these paths, use something like this configuration: 59 | 60 | my $config = { 61 | compile => { 62 | inc => { 63 | libs => ['foo/bar' 'my-custom-lib' ], 64 | }, 65 | }, 66 | ... 67 | }; 68 | 69 | This will give you an C<@INC> which includes: C, C, C, C, C and C 70 | 71 | If you would not like the defaults of C, C, C and C to be added 72 | to C<@INC> you can use the C key: 73 | 74 | my $config = { 75 | compile => { 76 | inc => { 77 | libs => [ 'foo/bar' 'my-custom-lib' ], 78 | replace_default_libs => 1, 79 | }, 80 | }, 81 | ... 82 | }; 83 | 84 | This will give you an C<@INC> which includes: C, and C 85 | 86 | =cut 87 | -------------------------------------------------------------------------------- /config/relax.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | my $filename = $ENV{PERL_SYNTAX_CHECK_FILENAME} || ""; 5 | my $root = $ENV{PERL_SYNTAX_CHECK_ROOT} || ""; 6 | 7 | my $config = { 8 | compile => { 9 | skip => [ 10 | qr/^Subroutine \S+ redefined/, 11 | qr/^Name "\S+" used only once/, 12 | $filename =~ /\.psgi$/ 13 | ? (qr/^Useless use of single ref constructor in void context/) 14 | : (), 15 | ], 16 | use_module => [ 17 | [ "indirect", "-M-indirect=fatal" ], 18 | ], 19 | }, 20 | regexp => { 21 | check => [ 22 | qr/^ \s* my \s* \( (.*?) \) \s* = \s* shift/x, 23 | qr/pakcage/, # no syntax check 24 | ], 25 | }, 26 | custom => { 27 | check => [ 28 | ] 29 | }, 30 | }; 31 | -------------------------------------------------------------------------------- /cpanfile: -------------------------------------------------------------------------------- 1 | recommends 'JSON::PP'; 2 | 3 | on test => sub { 4 | requires 'JSON::PP'; 5 | requires 'Capture::Tiny'; 6 | requires 'Test::Differences'; 7 | requires 'Test::Fatal'; 8 | requires 'Test::More', '0.98'; 9 | requires 'File::pushd'; 10 | }; 11 | -------------------------------------------------------------------------------- /extlib/MarkWarnings.pm: -------------------------------------------------------------------------------- 1 | package MarkWarnings; 2 | use strict; 3 | use warnings; 4 | 5 | $SIG{__WARN__} = sub { warn '=MarkWarnings=', @_ }; 6 | 7 | 1; 8 | -------------------------------------------------------------------------------- /lib/Checker.pm: -------------------------------------------------------------------------------- 1 | package Checker; 2 | use strict; 3 | use warnings; 4 | use Cwd (); 5 | use File::Basename (); 6 | use File::Spec; 7 | use Getopt::Long qw(:config no_auto_abbrev no_ignore_case bundling); 8 | use Checker::Home; 9 | 10 | sub _slurp { 11 | my $file = shift; 12 | open my $fh, "<", $file or die "$file: $!"; 13 | my @line = <$fh>; 14 | chomp @line; 15 | \@line; 16 | } 17 | 18 | # https://gist.github.com/tyru/358703 19 | sub _snake_case { 20 | my ($s) = @_; 21 | $s =~ s{(\w+)}{ 22 | ($a = $1) =~ s<(^[A-Z]|(?![a-z])[A-Z])>< 23 | "_" . lc $1 24 | >eg; 25 | substr $a, 1; 26 | }eg; 27 | $s; 28 | } 29 | 30 | 31 | sub new { 32 | my ($class, %args) = @_; 33 | my @impl = $class->_load_impl; 34 | my $root = $class->_root; 35 | bless { impl => \@impl, format => "ale", root => $root, %args }, $class; 36 | } 37 | 38 | sub _root { 39 | my $back = Cwd::getcwd; 40 | my $root = $back; 41 | for (1..10) { 42 | my $cwd = Cwd::abs_path "."; 43 | last if $cwd eq "/"; 44 | if ( 45 | grep { -e $_ } qw(t xt Makefile.PL Build.PL dist.ini minil.toml) 46 | or (-d "lib" && $cwd !~ m{/(?:t|xt)$}) 47 | ) { 48 | $root = $cwd; 49 | last; 50 | } 51 | chdir ".."; 52 | } 53 | chdir $back; 54 | return $root; 55 | } 56 | 57 | sub _load_impl { 58 | my $class = shift; 59 | my $home = Checker::Home->get; 60 | my $dir = File::Spec->catdir($home, "lib", "Checker", "Impl"); 61 | opendir my $dh, $dir or die "$dir: $!"; 62 | my @impl = map { "Checker::Impl::$_" } 63 | grep { s/\.pm$// } 64 | grep { -f File::Spec->catfile($dir, $_) } 65 | readdir $dh; 66 | closedir $dh; 67 | { 68 | local @INC = ("$home/lib", @INC); 69 | for my $impl (@impl) { 70 | eval "require $impl; 1" or die $@; 71 | } 72 | } 73 | @impl; 74 | } 75 | 76 | sub _load_config { 77 | my $self = shift; 78 | if (!File::Spec->file_name_is_absolute($self->{config_file})) { 79 | $self->{config_file} = File::Spec->catfile(Cwd::getcwd(), $self->{config_file}); 80 | } 81 | my $config = do $self->{config_file}; 82 | die "$self->{config_file}: ", $@ || $! unless $config; 83 | $self->{config} = $config; 84 | } 85 | 86 | sub _show_usage { 87 | my $self = shift; 88 | die <<"___"; 89 | Usage: $0 [options] filename [tempfile] 90 | 91 | Options: 92 | -f, --format format (ale/json), default: ale 93 | -h, --help show this help 94 | -c, --config set config file 95 | 96 | Examples: 97 | \$ $0 script.pl 98 | \$ $0 -f json script.pl 99 | ___ 100 | } 101 | 102 | sub parse_options { 103 | my ($self, @argv) = @_; 104 | local @ARGV = @argv; 105 | Getopt::Long::GetOptions( 106 | "f|format=s" => \$self->{format}, 107 | "h|help" => sub { $self->_show_usage }, 108 | "c|config=s" => \$self->{config_file}, 109 | ) or exit 1; 110 | @ARGV; 111 | } 112 | 113 | sub run { 114 | my $self = shift; 115 | my ($filename, $tempfile) = $self->parse_options(@_); 116 | $self->_show_usage unless $filename; 117 | $tempfile ||= $filename; 118 | 119 | local $ENV{PERL_SYNTAX_CHECK_FILENAME} = $filename; 120 | local $ENV{PERL_SYNTAX_CHECK_ROOT} = $self->{root}; 121 | $self->_load_config if $self->{config_file}; 122 | my @err = $self->_run($filename, $tempfile); 123 | my $formatter; 124 | if ($self->{format} eq "json") { 125 | require Checker::Formatter::JSON; 126 | $formatter = Checker::Formatter::JSON->new; 127 | } else { 128 | require Checker::Formatter::ALE; 129 | $formatter = Checker::Formatter::ALE->new($tempfile); 130 | } 131 | my $str = $formatter->format(@err); 132 | print STDERR $str if length $str; 133 | return @err ? 1 : 0; 134 | } 135 | 136 | sub _run { 137 | my ($self, $filename, $tempfile) = @_; 138 | return if $filename =~ /\b(?:cpanfile|alienfile)$/; 139 | my $lines = _slurp $tempfile; 140 | my $config = $self->{config} || {}; 141 | 142 | my @err; 143 | for my $klass (@{$self->{impl}}) { 144 | my $copy = $klass; 145 | $copy =~ s/^Checker::Impl:://; 146 | my $snake_case_klass = _snake_case $copy; 147 | my %c = ( 148 | root => $self->{root}, 149 | %{$config->{$snake_case_klass} || {}}, 150 | ); 151 | my $impl = $klass->new(%c); 152 | my @e = $impl->check($filename, $tempfile, $lines); 153 | push @err, @e if @e and defined $e[0]; 154 | } 155 | return @err; 156 | } 157 | 158 | 1; 159 | -------------------------------------------------------------------------------- /lib/Checker/Formatter/ALE.pm: -------------------------------------------------------------------------------- 1 | package Checker::Formatter::ALE; 2 | use strict; 3 | use warnings; 4 | 5 | sub new { 6 | my ($class, $file) = @_; 7 | bless { file => $file }, $class; 8 | } 9 | 10 | my $ALE_WARN = '=MarkWarnings='; 11 | 12 | sub format { 13 | my ($self, @err) = @_; 14 | 15 | my $str = ""; 16 | for my $err (@err) { 17 | my $prefix = $err->{type} eq 'WARN' ? $ALE_WARN : ''; 18 | $str .= "$prefix$err->{message} at $self->{file} line $err->{line}.\n"; 19 | } 20 | $str; 21 | } 22 | 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/Checker/Formatter/JSON.pm: -------------------------------------------------------------------------------- 1 | package Checker::Formatter::JSON; 2 | use strict; 3 | use warnings; 4 | use JSON::PP (); 5 | 6 | sub new { 7 | my ($class, $file) = @_; 8 | my $json = JSON::PP->new->canonical(1)->pretty(1)->indent_length(2)->space_before(0); 9 | bless { json => $json }, $class; 10 | } 11 | 12 | sub format { 13 | my ($self, @err) = @_; 14 | $self->{json}->encode(\@err); 15 | } 16 | 17 | 18 | 1; 19 | -------------------------------------------------------------------------------- /lib/Checker/Home.pm: -------------------------------------------------------------------------------- 1 | package Checker::Home; 2 | use strict; 3 | use warnings; 4 | use Cwd (); 5 | use File::Basename (); 6 | use File::Spec; 7 | 8 | my $HOME = Cwd::abs_path( File::Spec->catdir(File::Basename::dirname(__FILE__), "..", "..") ); 9 | 10 | sub get { $HOME } 11 | 12 | 1; 13 | -------------------------------------------------------------------------------- /lib/Checker/Impl/Compile.pm: -------------------------------------------------------------------------------- 1 | package Checker::Impl::Compile; 2 | use strict; 3 | use warnings; 4 | use Config; 5 | use Cwd qw(abs_path getcwd); 6 | use Checker::Home; 7 | 8 | sub new { 9 | my ($class, %args) = @_; 10 | bless {%args}, $class; 11 | } 12 | 13 | sub check { 14 | my ($self, $filename, $tempfile, $lines) = @_; 15 | 16 | my @cmd = (@{$self->_cmd($lines->[0])}, $tempfile); 17 | my $pid = open my $fh, "-|"; 18 | if ($pid == 0) { 19 | open STDERR, ">&", \*STDOUT; 20 | exec @cmd; 21 | exit 255; 22 | } 23 | my @err; 24 | while (my $line = <$fh>) { 25 | my $type = $line =~ s/^=MarkWarnings=// ? 'WARN' : 'ERROR'; # must s/// before checking skips 26 | next if grep { $line =~ $_ } @{ $self->{skip} || [] }; 27 | if (my ($m, $f, $l, $e) = $line =~ /^([^\n]+?) at (.+?) line (\d+)(,.*)?/) { 28 | if ($f eq $tempfile) { 29 | $e = "" unless defined $e; 30 | push @err, { type => $type, message => "$m$e", line => 0+$l, from => (ref $self) }; 31 | } 32 | } 33 | } 34 | close $fh; 35 | @err; 36 | } 37 | 38 | sub _cmd { 39 | my $self = shift; 40 | my $first_line = shift || ""; 41 | my @x = $first_line =~ /^#!/ && $first_line !~ /perl\s*$/ ? ("-x") : (); 42 | my $inc = $self->_inc; 43 | my @use_module; 44 | if (my @module = @{$self->{use_module} || []}) { 45 | local @INC = (@$inc, @INC); 46 | for my $module (@module) { 47 | my ($name, $use) = ref $module ? @$module : ($module, "-M$module"); 48 | push @use_module, $use if eval "require $name" 49 | } 50 | } 51 | 52 | my @cmd = ( 53 | $^X, 54 | (map "-I$_", @$inc), 55 | "-MMarkWarnings", 56 | @use_module, 57 | "-Mwarnings", 58 | @x, 59 | "-c", 60 | ); 61 | 62 | \@cmd; 63 | } 64 | 65 | sub _inc { 66 | my $self = shift; 67 | 68 | my @inc = ( Checker::Home->get . '/extlib' ); 69 | push @inc, @{$self->{inc}{libs}} if $self->{inc}{libs}; 70 | return \@inc if $self->{inc}{replace_default_libs}; 71 | 72 | my $root = $self->{root}; 73 | 74 | my $blib; 75 | if (-d "$root/blib/arch/auto") { 76 | if (opendir my ($dh), "$root/blib/arch/auto") { 77 | if (!!grep { $_ ne "." && $_ ne ".." } readdir $dh) { 78 | push @inc, "$root/blib/arch"; 79 | push @inc, "$root/blib/lib"; 80 | $blib++; 81 | } 82 | closedir $dh; 83 | } 84 | } 85 | push @inc, "$root/lib" if !$blib && -d "$root/lib"; 86 | push @inc, "$root/t/lib" if -d "$root/t/lib"; 87 | push @inc, "$root/xt/lib" if -d "$root/xt/lib"; 88 | push @inc, "$root/local/lib/perl5" if -d "$root/local/lib/perl5/$Config{version}"; 89 | \@inc; 90 | } 91 | 92 | 1; 93 | -------------------------------------------------------------------------------- /lib/Checker/Impl/Custom.pm: -------------------------------------------------------------------------------- 1 | package Checker::Impl::Custom; 2 | use strict; 3 | use warnings; 4 | 5 | sub new { 6 | my ($class, %args) = @_; 7 | bless { %args }, $class; 8 | } 9 | 10 | sub check { 11 | my ($self, $filename, $tempfile, $lines) = @_; 12 | my @err; 13 | for my $i (0 .. $#{$lines}) { 14 | my $line = $lines->[$i]; 15 | next if $line =~ /no syntax check$/i; 16 | if (my $err = $self->_check($line, $filename, $lines)) { 17 | push @err, { 18 | type => 'ERROR', 19 | message => 'bad line', 20 | line => $i+1, 21 | from => (ref $self), 22 | (ref $err ? %$err : (message => $err)), 23 | }; 24 | } 25 | } 26 | return @err; 27 | } 28 | 29 | sub _check { 30 | my ($self, $line, $filename, $lines) = @_; 31 | for my $check (@{ $self->{check} || []}) { 32 | my $err = eval { $check->($line, $filename, $lines) }; 33 | $err = $@ if $@; 34 | return $err if $err and $err ne 1; 35 | } 36 | return; 37 | } 38 | 39 | 1; 40 | -------------------------------------------------------------------------------- /lib/Checker/Impl/Misc.pm: -------------------------------------------------------------------------------- 1 | package Checker::Impl::Misc; 2 | use strict; 3 | use warnings; 4 | 5 | sub new { 6 | my $class = shift; 7 | bless {}, $class; 8 | } 9 | 10 | sub check { 11 | my ($self, $filename, $tempfile, $lines) = @_; 12 | my @err; 13 | push @err, $self->_package_name($filename, $tempfile, $lines); 14 | return @err; 15 | } 16 | 17 | sub _package_name { 18 | my ($self, $filename, $tempfile, $lines) = @_; 19 | my ($package) = $lines->[0] =~ /^package ([a-zA-Z0-9:_]+)/; 20 | return unless $package; 21 | my @part = split /::/, $package; 22 | my $expect = (join "/", @part) . ".pm"; 23 | if ($filename !~ /\Q$expect\E$/) { 24 | return { type => 'ERROR', message => "package name is incorrect", line => 1, from => (ref $self) }; 25 | } 26 | return; 27 | } 28 | 29 | 1; 30 | -------------------------------------------------------------------------------- /lib/Checker/Impl/Regexp.pm: -------------------------------------------------------------------------------- 1 | package Checker::Impl::Regexp; 2 | use strict; 3 | use warnings; 4 | 5 | sub new { 6 | my ($class, %args) = @_; 7 | bless {%args}, $class; 8 | } 9 | 10 | sub check { 11 | my ($self, $filename, $tempfile, $lines) = @_; 12 | 13 | my @err; 14 | for my $i (0 .. $#{$lines}) { 15 | my $line = $lines->[$i]; 16 | next if $line =~ /no syntax check$/i; 17 | if (my $message = $self->_check($line)) { 18 | push @err, { type => 'ERROR', message => $message, line => $i+1, from => (ref $self) }; 19 | } 20 | } 21 | return @err; 22 | } 23 | 24 | sub _check { 25 | my ($self, $line) = @_; 26 | for my $custom (@{ $self->{check} || [] }) { 27 | if ($line =~ $custom) { 28 | return "bad line"; 29 | } 30 | } 31 | return; 32 | } 33 | 34 | 1; 35 | -------------------------------------------------------------------------------- /lib/Checker/Trace.pm: -------------------------------------------------------------------------------- 1 | package Checker::Trace; 2 | use strict; 3 | use warnings; 4 | use Data::Dumper; 5 | use Carp 'shortmess'; 6 | use POSIX 'strftime'; 7 | use base 'Exporter'; 8 | 9 | our @EXPORT = ('trace'); 10 | 11 | my $file = $ENV{HOME} . "/.vim-syntax-check-perl.log"; 12 | my $fh; 13 | 14 | sub trace { 15 | if (!$fh) { 16 | open $fh, ">>:unix", $file or die "$file: $!"; 17 | } 18 | if (@_ == 1 and ref $_[0]) { 19 | local $Data::Dumper::Terse = 1; 20 | local $Data::Dumper::Indent = 1; 21 | local $Data::Dumper::Useqq = 1; 22 | local $Data::Dumper::Deparse = 1; 23 | local $Data::Dumper::Quotekeys = 0; 24 | local $Data::Dumper::Sortkeys = 1; 25 | trace(Dumper($_[0])); 26 | return; 27 | } 28 | for my $line (@_) { 29 | chomp $line; 30 | print {$fh} shortmess strftime("%F %T", localtime) . " $line"; 31 | } 32 | } 33 | 34 | 1; 35 | -------------------------------------------------------------------------------- /syntax-check: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use FindBin; 5 | use lib "$FindBin::Bin/lib"; 6 | use Checker; 7 | 8 | Checker->new->run(@ARGV); 9 | -------------------------------------------------------------------------------- /t/basic.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Capture::Tiny 'capture_merged'; 4 | use Checker; 5 | use Checker::Impl::Compile (); 6 | use File::Spec (); 7 | use File::Path (); 8 | use JSON::PP 'decode_json'; 9 | use File::pushd (); 10 | use Config; 11 | 12 | use Test::More; 13 | use Test::Differences qw( eq_or_diff ); 14 | use Test::Fatal qw( exception ); 15 | 16 | my $ref_warn = $] >= 5.022 ? "single ref" : "reference"; 17 | 18 | subtest basic => sub { 19 | my $checker = Checker->new; 20 | my @err; 21 | @err = $checker->_run("t/file/cpanfile", "t/file/cpanfile"); 22 | is @err, 0 or do { diag explain $_ for @err }; 23 | 24 | @err = $checker->_run("t/file/alienfile", "t/file/alienfile"); 25 | is @err, 0; 26 | 27 | @err = $checker->_run("t/file/use_fail.pl", "t/file/use_fail.pl"); 28 | is @err, 2; 29 | like $err[0]{message}, qr/Can't locate FOOOOOOOO.pm/; 30 | is $err[0]{line}, 5; 31 | 32 | @err = $checker->_run("t/file/warn.pl", "t/file/warn.pl"); 33 | is_deeply \@err, [ 34 | { 35 | from => "Checker::Impl::Compile", 36 | line => 7, 37 | message => "Subroutine foo redefined", 38 | type => "WARN", 39 | }, 40 | { 41 | from => "Checker::Impl::Compile", 42 | line => 10, 43 | message => "Useless use of $ref_warn constructor in void context", 44 | type => "WARN", 45 | }, 46 | { 47 | from => "Checker::Impl::Compile", 48 | line => 12, 49 | message => "Bareword \"oooooops\" not allowed while \"strict subs\" in use", 50 | type => "ERROR", 51 | }, 52 | ]; 53 | 54 | @err = $checker->_run("t/file/invalid.pl", "t/file/invalid.pl"); 55 | is @err, 1; 56 | is_deeply $err[0], { type => 'ERROR', message => 'syntax error, near "ff', line => 4, from => 'Checker::Impl::Compile' }; 57 | }; 58 | 59 | subtest skip => sub { 60 | my $checker = Checker->new(config => { 61 | compile => { 62 | skip => [ qr/Subroutine \S+ redefined/ ], 63 | }, 64 | }); 65 | my @err = $checker->_run("t/file/warn.pl", "t/file/warn.pl"); 66 | is_deeply \@err, [ 67 | { 68 | from => "Checker::Impl::Compile", 69 | line => 10, 70 | message => "Useless use of $ref_warn constructor in void context", 71 | type => "WARN", 72 | }, 73 | { 74 | from => "Checker::Impl::Compile", 75 | line => 12, 76 | message => "Bareword \"oooooops\" not allowed while \"strict subs\" in use", 77 | type => "ERROR", 78 | }, 79 | ]; 80 | }; 81 | 82 | subtest custom => sub { 83 | my $checker = Checker->new(config => { 84 | custom => { 85 | check => [ 86 | sub { 87 | my ($line, $filename) = @_; 88 | if ($filename =~ m{t/file/todo\.pl} 89 | && $line =~ /TODO/) { 90 | return { type => 'WARN', message => 'TODO must be resolved' }; 91 | } 92 | }, 93 | ], 94 | }, 95 | }); 96 | my @err = $checker->_run("t/file/todo.pl", "t/file/todo.pl"); 97 | is_deeply \@err, [ 98 | { 99 | from => "Checker::Impl::Custom", 100 | line => 5, 101 | message => "TODO must be resolved", 102 | type => "WARN" 103 | } 104 | ]; 105 | @err = $checker->_run("t/file/todo_skip.pl", "t/file/todo_skip.pl"); 106 | is @err, 0; 107 | }; 108 | 109 | subtest output => sub { 110 | my $checker = Checker->new; 111 | my ($merged) = capture_merged { $checker->run("t/file/alienfile", "t/file/alienfile") }; 112 | is $merged, ""; 113 | 114 | ($merged) = capture_merged { $checker->run("--format", "json", "t/file/use_fail.pl") }; 115 | my $decoded = decode_json($merged); 116 | like $decoded->[0]{message}, qr/Can't locate FOOOOOOOO.pm/; 117 | is $decoded->[0]{line}, 5; 118 | }; 119 | 120 | subtest config_file_does_not_exist => sub { 121 | my $checker = Checker->new( config_file => 'does_not_exist.pl' ); 122 | like( 123 | exception( sub { $checker->_load_config } ), 124 | qr{No such file or directory}, 'exception on config file not found' 125 | ); 126 | }; 127 | 128 | subtest custom_config_file => sub { 129 | my $checker = Checker->new( config_file => 't/config/custom.pl' ); 130 | $checker->_load_config; 131 | eq_or_diff( 132 | $checker->{config}, 133 | { 134 | compile => { 135 | inc => { 136 | libs => [ 't/custom-lib' ], 137 | replace_default_libs => 0, 138 | } 139 | } 140 | }, 141 | 'config loaded' 142 | ); 143 | 144 | my $compile 145 | = Checker::Impl::Compile->new( root => $checker->{root}, %{ $checker->{config}->{compile} } ); 146 | 147 | my @inc = @{ $compile->_inc }; 148 | eq_or_diff( 149 | _get_children( \@inc ), [ 'syntax-check-perl/extlib', 't/custom-lib', "syntax-check-perl/lib", ], 150 | 'default folders added to inc' 151 | ); 152 | 153 | my @cmd = @{ $compile->_cmd }; 154 | 155 | eq_or_diff( 156 | _get_children( [ @cmd[ 1, 2, 3 ] ] ), 157 | [ 'syntax-check-perl/extlib', 't/custom-lib', "syntax-check-perl/lib", ], 158 | 'default folders added to inc in command' 159 | ); 160 | }; 161 | 162 | subtest custom_config_file_with_replace_default_libs => sub { 163 | local $ENV{REPLACE_DEFAULT_LIBS} = 1; 164 | my $checker = Checker->new( config_file => 't/config/custom.pl' ); 165 | $checker->_load_config; 166 | eq_or_diff( 167 | $checker->{config}, 168 | { 169 | compile => { 170 | inc => { 171 | libs => ['t/custom-lib'], 172 | replace_default_libs => 1, 173 | } 174 | } 175 | }, 176 | 'config loaded' 177 | ); 178 | 179 | my $compile 180 | = Checker::Impl::Compile->new( root => $checker->{root}, %{ $checker->{config}->{compile} } ); 181 | 182 | my @inc = @{ $compile->_inc }; 183 | eq_or_diff( 184 | _get_children( \@inc ), [ 'syntax-check-perl/extlib', 't/custom-lib', ], 185 | 'folders added to inc' 186 | ); 187 | 188 | my @cmd = @{ $compile->_cmd }; 189 | 190 | eq_or_diff( 191 | _get_children( [ @cmd[ 1, 2 ] ] ), 192 | [ 'syntax-check-perl/extlib', 't/custom-lib' ], 193 | 'folders added to inc in command' 194 | ); 195 | }; 196 | 197 | subtest no_config_file => sub { 198 | my $compile 199 | = Checker::Impl::Compile->new( root => "." ); 200 | 201 | my @inc = @{ $compile->_inc }; 202 | eq_or_diff( 203 | _get_children( \@inc ), 204 | [ 'syntax-check-perl/extlib', "./lib" ], 205 | 'default folders added to inc' 206 | ); 207 | 208 | my @cmd = @{ $compile->_cmd }; 209 | eq_or_diff( 210 | _get_children( [ @cmd[ 1, 2 ] ] ), 211 | [ 'syntax-check-perl/extlib', "./lib" ], 212 | 'default folders added to inc in command' 213 | ); 214 | }; 215 | 216 | subtest default_libs => sub { 217 | my $guard = File::pushd::tempd; 218 | File::Path::mkpath $_ for "lib", "t/lib", "xt/lib", "local/lib/perl5/$Config{version}"; 219 | chdir "t"; 220 | my $compile = Checker::Impl::Compile->new(root => Checker->new->{root}); 221 | my $inc = $compile->_inc; 222 | is @$inc, 5; 223 | like $inc->[0], qr{/extlib$}; 224 | like $inc->[1], qr{/lib$}; 225 | like $inc->[2], qr{/t/lib$}; 226 | like $inc->[3], qr{/xt/lib$}; 227 | like $inc->[4], qr{/local/lib/perl5$}; 228 | }; 229 | 230 | subtest not_perl_shebang => sub { 231 | my @err = Checker->new->_run("t/file/not_perl_shebang", "t/file/not_perl_shebang"); 232 | is @err, 0; 233 | diag explain $_ for @err; 234 | }; 235 | 236 | sub _get_children { 237 | my $paths = shift; 238 | 239 | my @libs; 240 | for my $path ( @{$paths} ) { 241 | my @dirs = File::Spec->splitdir($path); 242 | push @libs, @dirs > 1 ? join '/', @dirs[-2,-1] : $dirs[0]; 243 | } 244 | 245 | # Strip -I switch from relative paths. 246 | for my $lib (@libs) { 247 | $lib =~ s{\A\-I}{}; 248 | } 249 | return \@libs; 250 | } 251 | 252 | done_testing; 253 | -------------------------------------------------------------------------------- /t/config/custom.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | return { 5 | compile => { 6 | inc => { 7 | libs => ['t/custom-lib'], 8 | replace_default_libs => $ENV{REPLACE_DEFAULT_LIBS} ? 1 : 0, 9 | } 10 | }, 11 | }; 12 | -------------------------------------------------------------------------------- /t/custom-lib/Local.pm: -------------------------------------------------------------------------------- 1 | package Local; 2 | 3 | 1; 4 | -------------------------------------------------------------------------------- /t/file/alienfile: -------------------------------------------------------------------------------- 1 | use alienfile; 2 | 3 | plugin 'PkgConfig' => ( 4 | pkg_name => 'libasyncns', 5 | ); 6 | -------------------------------------------------------------------------------- /t/file/cpanfile: -------------------------------------------------------------------------------- 1 | requires "Foo"; 2 | -------------------------------------------------------------------------------- /t/file/invalid.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | ff 3 | 4 | warn 1; 5 | -------------------------------------------------------------------------------- /t/file/not_perl_shebang: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | exec perl -x "$0" "$@" 3 | #!perl 4 | use strict; 5 | use warnings; 6 | 7 | # vim: filetype=perl 8 | -------------------------------------------------------------------------------- /t/file/todo.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | 5 | # TODO 6 | sub hoge { 7 | } 8 | -------------------------------------------------------------------------------- /t/file/todo_skip.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | 5 | # TODO 6 | sub hoge { 7 | } 8 | -------------------------------------------------------------------------------- /t/file/use_fail.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | 5 | use FOOOOOOOO; 6 | use BARRRRRRR; 7 | -------------------------------------------------------------------------------- /t/file/warn.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | 5 | sub foo { 6 | } 7 | sub foo { 8 | } 9 | 10 | sub {}; 11 | 12 | oooooops; 13 | --------------------------------------------------------------------------------