├── .appveyor.yml ├── .gitignore ├── .travis.yml ├── LICENSE ├── META6.json ├── README.md ├── lib └── SuperMAIN.rakumod └── t ├── 00-load.rakutest ├── 01-submainopts.rakutest ├── 02-multimainopts.rakutest ├── 03-cornercases.rakutest ├── supermain-multi.raku └── supermain.raku /.appveyor.yml: -------------------------------------------------------------------------------- 1 | environment: 2 | rakudo_pkg_version: 2020.02.1-01 3 | 4 | os: Visual Studio 2017 5 | 6 | platform: x64 7 | 8 | install: 9 | - '"C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build\vcvars64.bat"' 10 | - appveyor-retry curl -sSL -o rakudo.zip https://rakudo.org/dl/rakudo/rakudo-moar-%rakudo_pkg_version%-win-x86_64.zip 11 | - 7z x rakudo.zip 12 | - del rakudo.zip 13 | - move rakudo* c:\rakudo 14 | - SET PATH=C:\rakudo\bin;C:\rakudo\share\perl6\site\bin;%PATH% 15 | - cd \ 16 | - appveyor-retry git clone https://github.com/ugexe/zef.git 17 | - cd zef 18 | - raku -I. bin/zef install . 19 | - cd %APPVEYOR_BUILD_FOLDER% 20 | - zef install --deps-only . 21 | 22 | build: off 23 | 24 | test_script: 25 | - zef install . 26 | 27 | shallow_clone: true -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # precompiled files 2 | .precomp 3 | lib/.precomp 4 | 5 | 6 | .idea/ 7 | SuperMAIN.iml 8 | projectFilesBackup*/ 9 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: generic 2 | env: 3 | global: 4 | - export PATH="/opt/rakudo-pkg/bin:/opt/rakudo-pkg/share/perl6/site/bin:$PATH" 5 | addons: 6 | apt: 7 | sources: 8 | - sourceline: 'deb https://dl.bintray.com/nxadm/rakudo-pkg-debs $(lsb_release -cs) main' 9 | key_url: 'http://keyserver.ubuntu.com/pks/lookup?search=0x379CE192D401AB61&op=get' 10 | packages: 11 | - rakudo-pkg 12 | install: 13 | - zef install . -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The Artistic License 2.0 2 | 3 | Copyright (c) 2000-2006, The Perl Foundation. 4 | 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | This license establishes the terms under which a given free software 11 | Package may be copied, modified, distributed, and/or redistributed. 12 | The intent is that the Copyright Holder maintains some artistic 13 | control over the development of that Package while still keeping the 14 | Package available as open source and free software. 15 | 16 | You are always permitted to make arrangements wholly outside of this 17 | license directly with the Copyright Holder of a given Package. If the 18 | terms of this license do not permit the full use that you propose to 19 | make of the Package, you should contact the Copyright Holder and seek 20 | a different licensing arrangement. 21 | 22 | Definitions 23 | 24 | "Copyright Holder" means the individual(s) or organization(s) 25 | named in the copyright notice for the entire Package. 26 | 27 | "Contributor" means any party that has contributed code or other 28 | material to the Package, in accordance with the Copyright Holder's 29 | procedures. 30 | 31 | "You" and "your" means any person who would like to copy, 32 | distribute, or modify the Package. 33 | 34 | "Package" means the collection of files distributed by the 35 | Copyright Holder, and derivatives of that collection and/or of 36 | those files. A given Package may consist of either the Standard 37 | Version, or a Modified Version. 38 | 39 | "Distribute" means providing a copy of the Package or making it 40 | accessible to anyone else, or in the case of a company or 41 | organization, to others outside of your company or organization. 42 | 43 | "Distributor Fee" means any fee that you charge for Distributing 44 | this Package or providing support for this Package to another 45 | party. It does not mean licensing fees. 46 | 47 | "Standard Version" refers to the Package if it has not been 48 | modified, or has been modified only in ways explicitly requested 49 | by the Copyright Holder. 50 | 51 | "Modified Version" means the Package, if it has been changed, and 52 | such changes were not explicitly requested by the Copyright 53 | Holder. 54 | 55 | "Original License" means this Artistic License as Distributed with 56 | the Standard Version of the Package, in its current version or as 57 | it may be modified by The Perl Foundation in the future. 58 | 59 | "Source" form means the source code, documentation source, and 60 | configuration files for the Package. 61 | 62 | "Compiled" form means the compiled bytecode, object code, binary, 63 | or any other form resulting from mechanical transformation or 64 | translation of the Source form. 65 | 66 | 67 | Permission for Use and Modification Without Distribution 68 | 69 | (1) You are permitted to use the Standard Version and create and use 70 | Modified Versions for any purpose without restriction, provided that 71 | you do not Distribute the Modified Version. 72 | 73 | 74 | Permissions for Redistribution of the Standard Version 75 | 76 | (2) You may Distribute verbatim copies of the Source form of the 77 | Standard Version of this Package in any medium without restriction, 78 | either gratis or for a Distributor Fee, provided that you duplicate 79 | all of the original copyright notices and associated disclaimers. At 80 | your discretion, such verbatim copies may or may not include a 81 | Compiled form of the Package. 82 | 83 | (3) You may apply any bug fixes, portability changes, and other 84 | modifications made available from the Copyright Holder. The resulting 85 | Package will still be considered the Standard Version, and as such 86 | will be subject to the Original License. 87 | 88 | 89 | Distribution of Modified Versions of the Package as Source 90 | 91 | (4) You may Distribute your Modified Version as Source (either gratis 92 | or for a Distributor Fee, and with or without a Compiled form of the 93 | Modified Version) provided that you clearly document how it differs 94 | from the Standard Version, including, but not limited to, documenting 95 | any non-standard features, executables, or modules, and provided that 96 | you do at least ONE of the following: 97 | 98 | (a) make the Modified Version available to the Copyright Holder 99 | of the Standard Version, under the Original License, so that the 100 | Copyright Holder may include your modifications in the Standard 101 | Version. 102 | 103 | (b) ensure that installation of your Modified Version does not 104 | prevent the user installing or running the Standard Version. In 105 | addition, the Modified Version must bear a name that is different 106 | from the name of the Standard Version. 107 | 108 | (c) allow anyone who receives a copy of the Modified Version to 109 | make the Source form of the Modified Version available to others 110 | under 111 | 112 | (i) the Original License or 113 | 114 | (ii) a license that permits the licensee to freely copy, 115 | modify and redistribute the Modified Version using the same 116 | licensing terms that apply to the copy that the licensee 117 | received, and requires that the Source form of the Modified 118 | Version, and of any works derived from it, be made freely 119 | available in that license fees are prohibited but Distributor 120 | Fees are allowed. 121 | 122 | 123 | Distribution of Compiled Forms of the Standard Version 124 | or Modified Versions without the Source 125 | 126 | (5) You may Distribute Compiled forms of the Standard Version without 127 | the Source, provided that you include complete instructions on how to 128 | get the Source of the Standard Version. Such instructions must be 129 | valid at the time of your distribution. If these instructions, at any 130 | time while you are carrying out such distribution, become invalid, you 131 | must provide new instructions on demand or cease further distribution. 132 | If you provide valid instructions or cease distribution within thirty 133 | days after you become aware that the instructions are invalid, then 134 | you do not forfeit any of your rights under this license. 135 | 136 | (6) You may Distribute a Modified Version in Compiled form without 137 | the Source, provided that you comply with Section 4 with respect to 138 | the Source of the Modified Version. 139 | 140 | 141 | Aggregating or Linking the Package 142 | 143 | (7) You may aggregate the Package (either the Standard Version or 144 | Modified Version) with other packages and Distribute the resulting 145 | aggregation provided that you do not charge a licensing fee for the 146 | Package. Distributor Fees are permitted, and licensing fees for other 147 | components in the aggregation are permitted. The terms of this license 148 | apply to the use and Distribution of the Standard or Modified Versions 149 | as included in the aggregation. 150 | 151 | (8) You are permitted to link Modified and Standard Versions with 152 | other works, to embed the Package in a larger work of your own, or to 153 | build stand-alone binary or bytecode versions of applications that 154 | include the Package, and Distribute the result without restriction, 155 | provided the result does not expose a direct interface to the Package. 156 | 157 | 158 | Items That are Not Considered Part of a Modified Version 159 | 160 | (9) Works (including, but not limited to, modules and scripts) that 161 | merely extend or make use of the Package, do not, by themselves, cause 162 | the Package to be a Modified Version. In addition, such works are not 163 | considered parts of the Package itself, and are not subject to the 164 | terms of this license. 165 | 166 | 167 | General Provisions 168 | 169 | (10) Any use, modification, and distribution of the Standard or 170 | Modified Versions is governed by this Artistic License. By using, 171 | modifying or distributing the Package, you accept this license. Do not 172 | use, modify, or distribute the Package, if you do not accept this 173 | license. 174 | 175 | (11) If your Modified Version has been derived from a Modified 176 | Version made by someone other than you, you are nevertheless required 177 | to ensure that your Modified Version complies with the requirements of 178 | this license. 179 | 180 | (12) This license does not grant you the right to use any trademark, 181 | service mark, tradename, or logo of the Copyright Holder. 182 | 183 | (13) This license includes the non-exclusive, worldwide, 184 | free-of-charge patent license to make, have made, use, offer to sell, 185 | sell, import and otherwise transfer the Package with respect to any 186 | patent claims licensable by the Copyright Holder that are necessarily 187 | infringed by the Package. If you institute patent litigation 188 | (including a cross-claim or counterclaim) against any party alleging 189 | that the Package constitutes direct or contributory patent 190 | infringement, then this Artistic License to you shall terminate on the 191 | date that such litigation is filed. 192 | 193 | (14) Disclaimer of Warranty: 194 | THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS 195 | IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED 196 | WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR 197 | NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL 198 | LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL 199 | BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 200 | DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF 201 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 202 | -------------------------------------------------------------------------------- /META6.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "SuperMAIN", 3 | "description": "MAIN() with superpowers", 4 | "version": "0.1.4", 5 | "perl": "6.c", 6 | "authors": [ 7 | "Claudio Ramirez " 8 | ], 9 | "auth": "github:nxadm", 10 | "depends": [], 11 | "build-depends": [], 12 | "test-depends": [], 13 | "provides": { 14 | "SuperMAIN": "lib/SuperMAIN.rakumod" 15 | }, 16 | "resources": [], 17 | "license": "Artistic-2.0", 18 | "tags": [ 19 | "MAIN", 20 | "parameters", 21 | "CLI", 22 | "Getopt", 23 | "Command", 24 | "flags" 25 | ], 26 | "api": "1", 27 | "source-url": "git://github.com/nxadm/SuperMAIN.git" 28 | } 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # SuperMAIN, Raku MAIN() with superpowers 2 | 3 | [![Build Status](https://travis-ci.org/nxadm/SuperMAIN.svg?branch=master)](https://travis-ci.org/nxadm/SuperMAIN) 4 | 5 | [MAIN](https://docs.raku.org/language/create-cli#sub_MAIN) is one of the many 6 | nice features that makes Raku a very fun language to work with. Command Line 7 | Interfaces (CLI) can be easily be created in a very intuitive way. 8 | 9 | This module adds features to MAIN without changing the syntax (or semantics). 10 | Everything works as before, just with some nice-to-haves for the users of the 11 | CLI. 12 | 13 | ## Features 14 | 15 | The following features were added to MAIN: 16 | 17 | - Allow named parameters to be used everywhere instead of only after the 18 | positional parameters (corresponds with 19 | `%SUB-MAIN-OPTS = True`): 20 | 21 | ``` 22 | $ prog.raku [--named1=] [--named2=] 23 | $ prog.raku [--named1=] [--named2=] 24 | $ prog.raku [--named1=] [--named2=] 25 | ``` 26 | 27 | - Allow spaces as separator between a named parameter and its values (the Raku 28 | default is to only accept '=' as the separator). 29 | ``` 30 | $ prog.raku [--named1=] 31 | $ prog.raku [--named1 ] 32 | ``` 33 | 34 | - Auto-alias named parameters without the need to declare an alias, e.g. to 35 | make `-n` an alias of `--named`, you need to declare the alias in the 36 | signature: 37 | 38 | ```raku 39 | sub MAIN(Str :n(:$named)) { ... } 40 | ``` 41 | 42 | With SuperMain, an alias will be automatically created to the shortest *unique* 43 | parameter identifier, e.g. for the signature 44 | 45 | ```raku 46 | sub MAIN(Str :$named, Str :$other-named )) { ... } 47 | ``` 48 | 49 | the alias "-n" and "-o" will be accepted. If MAIN already has an alias for a 50 | parameter no new alias will be created for that specific parameter. 51 | 52 | ``` 53 | $ prog.raku [--named=] [--other-named=] 54 | $ prog.raku [-n=] [-o=] 55 | $ prog.raku [--named ] [--other-named ] 56 | $ prog.raku [-n ] [-o ] 57 | ``` 58 | 59 | ## Usage 60 | 61 | Add this to the script handling the CLI: 62 | 63 | ```raku 64 | use SuperMAIN; 65 | 66 | # That's it: just use `sub MAIN` or `multi MAIN` as usual. 67 | ``` 68 | 69 | ## Installation 70 | 71 | Through the ecosystem: 72 | ``` 73 | $ zef install SuperMAIN 74 | ``` 75 | 76 | Locally: 77 | 78 | ``` 79 | $ git clone https://github.com/nxadm/SuperMAIN 80 | $ cd SuperMAIN 81 | $ zef install . 82 | ``` 83 | -------------------------------------------------------------------------------- /lib/SuperMAIN.rakumod: -------------------------------------------------------------------------------- 1 | unit module SuperMAIN; 2 | 3 | our $VERSION = '0.1.4'; 4 | 5 | # Allow named variables at any location 6 | PROCESS::<%SUB-MAIN-OPTS> = True; 7 | 8 | # Manipulate @args 9 | sub ARGS-TO-CAPTURE(&main, @args --> Capture) is export { 10 | # Passthrough 11 | return &*ARGS-TO-CAPTURE(&main, @args) unless @args; 12 | 13 | my %args-rewritten = convert-space-separator(@args); 14 | my @args-new = match-to-signatures( 15 | %args-rewritten, &main.candidates.map(*.signature).list, @args 16 | ); 17 | 18 | return &*ARGS-TO-CAPTURE(&main, @args-new); 19 | } 20 | 21 | # convert-space-separator rewrites @args allowing spaces for named parameter 22 | # values. The returned hash has 2 keys: 23 | # - args: an array of the rewritten @args. 24 | # - maybe-boolean-idx: array of indices of the rewritten @args keeps for 25 | # incorrect parameter=value combinations that may be the combination of a 26 | # boolean named and a positional parameter (that must be split). 27 | sub convert-space-separator(@args --> Hash) { 28 | my (%args-rewritten, @args-new, @maybe-boolean-idx); 29 | my $prev-named = ""; 30 | 31 | for @args -> $a { 32 | given True { 33 | # Passthrough --param=value named parameter 34 | when $a.starts-with('-') && $a.contains('=') { 35 | @args-new.push: $a; 36 | $prev-named = ""; 37 | } 38 | # Named parameter with no value attached with '='. 39 | when $a.starts-with('-') { 40 | if $prev-named ne "" { 41 | @args-new.push: $prev-named; # boolean named parameter 42 | } 43 | 44 | $prev-named = $a; 45 | } 46 | # Not a named parameter (no starting '-'). 47 | when $prev-named ne "" { 48 | # it may be a positional after a named boolean 49 | @maybe-boolean-idx.push: @args-new.elems; 50 | @args-new.push: "$prev-named=$a"; 51 | $prev-named = ""; 52 | } 53 | # Positional parameters 54 | default { 55 | @args-new.push: $a; 56 | $prev-named = ""; 57 | } 58 | } 59 | } 60 | @args-new.push: $prev-named if $prev-named ne ''; 61 | 62 | 63 | %args-rewritten = @args-new; 64 | %args-rewritten = @maybe-boolean-idx; 65 | return %args-rewritten; 66 | } 67 | 68 | # create-args-variations-with-pairs create an Array of Arrays with all the 69 | # possible args combinations to make sure named boolean parameters are not 70 | # joined to a positional parameter as a value. 71 | sub create-args-variations-with-pairs(%rewritten-args --> Array) { 72 | my @candidates; 73 | push @candidates, rewrite-args-with-pairs(%rewritten-args); 74 | my @combinations = %rewritten-args.combinations; 75 | for @combinations -> $c { 76 | next if $c.elems == 0; 77 | my @candidate = %rewritten-args.clone; 78 | my Int $move-right = 0; 79 | for $c.list -> $idx { 80 | my @parts = @candidate[$idx + $move-right].split('=',2); 81 | my $named-bool = @parts[0]; 82 | my $positional = @parts[1]; 83 | @candidate.splice: $idx + $move-right, 1, ($named-bool, $positional); 84 | $move-right++; 85 | } 86 | 87 | # Replace key=value by Pairs so we can match signatures later on 88 | push @candidates, rewrite-args-with-pairs(@candidate); 89 | } 90 | 91 | return @candidates; 92 | } 93 | 94 | # create-aliases-for-signature create a Hash with the auto-aliases as keys and 95 | # full names as values. 96 | sub create-aliases-for-signature(Signature $sig --> Hash) { 97 | my (%aliases, @to-shorten, @reserved); 98 | 99 | for $sig.params -> $p { 100 | next unless $p.named; 101 | push @reserved: | $p.named_names; 102 | if $p.named_names.elems == 1 { 103 | push @to-shorten: |$p.named_names; 104 | } 105 | } 106 | 107 | for @to-shorten.values -> $pname { 108 | my @other-params = @to-shorten.grep(none $pname); 109 | my @other-reserved = @reserved.grep(none $pname); 110 | my @chars = |$pname.comb; 111 | loop (my $i = 0; $i < @chars.elems; $i++) { 112 | my $alias = substr($pname, 0..$i); 113 | my @existing = (@other-params, @other-reserved).flat; 114 | if $alias ne $pname && ! grep { .starts-with($alias) }, @existing { 115 | %aliases{$alias} = $pname; 116 | last; 117 | } 118 | } 119 | } 120 | 121 | return %aliases; 122 | } 123 | 124 | # match-to-signatures matches the rewritten @args to signatures and returned a 125 | # valid @arg is it matches with a signature. If nothing matches, the original 126 | # args is returned. 127 | sub match-to-signatures(%args-rewritten, List $signatures, @args-orig --> Array) { 128 | my %aliases; # Key: Signature, Value: Hash with alias as key & param as value. 129 | 130 | my @args-variations = create-args-variations-with-pairs(%args-rewritten); 131 | for @args-variations -> $v { 132 | # Short circuit if a signature already matches 133 | return rewrite-args-as-cli($v.Array) if $v ~~ any $signatures; 134 | my @args-full-paramnames = $v.list; 135 | for $signatures.list -> $s { 136 | %aliases = create-aliases-for-signature($s); 137 | for $v.kv -> $i, $p { 138 | if $p ~~ Pair { 139 | if (%aliases{$p.key} :exists) { 140 | @args-full-paramnames[$i] = %aliases{$p.key} => $p.value; 141 | } 142 | next; 143 | } 144 | if $p.starts-with('-') { # boolean named param 145 | my $key = $p.subst(/^\-+/, ''); 146 | if (%aliases{$key} :exists) { 147 | @args-full-paramnames[$i] = %aliases{$key} 148 | } 149 | next; 150 | } 151 | } 152 | return rewrite-args-as-cli(@args-full-paramnames) 153 | if @args-full-paramnames ~~ $s; 154 | } 155 | } 156 | 157 | return @args-orig; # already in param=value format instead of Pairs 158 | } 159 | 160 | # rewrite-args-as-cli rewrites an args with Pairs to the CLI format of 161 | # param=value. 162 | sub rewrite-args-as-cli(@args --> Array) { 163 | my @args-new; 164 | for @args -> $a { 165 | if $a ~~ Pair { 166 | push @args-new: '--' ~ $a.key ~ '=' ~ $a.value; 167 | next; 168 | } 169 | push @args-new: $a; 170 | } 171 | return @args-new 172 | } 173 | 174 | # rewrite-args-with-pairs rewrites an args in CLI format of 175 | # param=value to Pairs. 176 | sub rewrite-args-with-pairs(@args --> Array) { 177 | my @args-new; 178 | for @args -> $a { 179 | if $a.starts-with('-') { 180 | my ($key, $value); 181 | if $a.contains('=') { 182 | my @parts = $a.split('=',2); 183 | $key = @parts[0].subst(/^\-+/, ''); 184 | $value = @parts[1]; 185 | } else { # boolean named parameter 186 | $key = $a.subst(/^\-+/, ''); 187 | $value = True; 188 | } 189 | push @args-new: $key => $value; 190 | } else { 191 | push @args-new: $a; 192 | } 193 | } 194 | return @args-new; 195 | } -------------------------------------------------------------------------------- /t/00-load.rakutest: -------------------------------------------------------------------------------- 1 | use Test; 2 | use lib 'lib'; 3 | 4 | plan 1; 5 | 6 | use-ok 'SuperMAIN'; 7 | -------------------------------------------------------------------------------- /t/01-submainopts.rakutest: -------------------------------------------------------------------------------- 1 | use Test; 2 | use lib 'lib'; 3 | 4 | # Skip test on Windows for now 5 | if $*DISTRO.is-win { 6 | note "Windows testing skipped for now"; 7 | done-testing; 8 | exit; 9 | } 10 | 11 | my $proc = run 't/supermain.raku', :out, :err; 12 | isnt $proc.exitcode, 0, "no args (exitcode)"; 13 | my $std-err = $proc.err.slurp: :close; 14 | like $std-err.chomp, /^^Usage\:/, "no args (output)"; 15 | 16 | $proc = run 't/supermain.raku', 'pos', '--named=named', 17 | '--other-named=other-named', :out, :err; 18 | is $proc.exitcode, 0, "named-anywhere"; 19 | 20 | $proc = run 't/supermain.raku', 'pos', '-named=named', 21 | '--other-named=other-named', :out, :err; 22 | is $proc.exitcode, 0, "named-anywhere, single '-'"; 23 | 24 | $proc = run 't/supermain.raku', 'pos1', '--named', 'named', 25 | '--other-named', 'other-named', '--bool', 'pos2', '-diff-bool', 26 | :out, :err; 27 | is $proc.exitcode, 0, "space separated named param"; 28 | $std-err = $proc.out.slurp: :close; 29 | like $std-err.chomp, / << POSITIONAL1\: \s+ \[pos1\] .+ >>/, "check value"; 30 | like $std-err.chomp, / << POSITIONAL2\: \s+ \[pos2\] .+ >>/, "check value"; 31 | like $std-err.chomp, / << NAMED\: \s+ \[named\] .+ >>/, "check value"; 32 | like $std-err.chomp, / << OTHER\-NAMED\: \s+ \[other\-named\] .+ >>/, "check value"; 33 | like $std-err.chomp, / << BOOL\: \s+ True >>/, "check value"; 34 | like $std-err.chomp, / << DIFF\-BOOL\: \s+ True >>/, "check value"; 35 | 36 | $proc = run 't/supermain.raku', 'pos1', '-n', 'named', '-o', 'other-named', 37 | '-b', 'pos2', '-d', :out, :err; 38 | is $proc.exitcode, 0, "auto alias"; 39 | $std-err = $proc.out.slurp: :close; 40 | like $std-err.chomp, / << POSITIONAL1\: \s+ \[pos1\] .+ >>/, "check value"; 41 | like $std-err.chomp, / << POSITIONAL2\: \s+ \[pos2\] .+ >>/, "check value"; 42 | like $std-err.chomp, / << NAMED\: \s+ \[named\] .+ >>/, "check value"; 43 | like $std-err.chomp, / << OTHER\-NAMED\: \s+ \[other\-named\] .+ >>/, "check value"; 44 | like $std-err.chomp, / << BOOL\: \s+ True >>/, "check value"; 45 | like $std-err.chomp, / << DIFF\-BOOL\: \s+ True >>/, "check value"; 46 | 47 | done-testing; 48 | -------------------------------------------------------------------------------- /t/02-multimainopts.rakutest: -------------------------------------------------------------------------------- 1 | use Test; 2 | use lib 'lib'; 3 | 4 | # Skip test on Windows for now 5 | if $*DISTRO.is-win { 6 | note "Windows testing skipped for now"; 7 | done-testing; 8 | exit; 9 | } 10 | 11 | my $proc = run 't/supermain-multi.raku', :out, :err; 12 | isnt $proc.exitcode, 0, "no args (exitcode)"; 13 | my $std-err = $proc.err.slurp: :close; 14 | like $std-err.chomp, /^^Usage\:/, "no args (output)"; 15 | 16 | $proc = run 't/supermain-multi.raku', 'pos1', 'pos2', '--named=named', 17 | '--other-named=other-named', '--diff-named=diff-named', :out, :err; 18 | is $proc.exitcode, 0, "named-anywhere"; 19 | 20 | $proc = run 't/supermain-multi.raku', 'pos1', 'pos2', '-named=named', 21 | '--other-named=other-named', '--diff-named=diff-named', :out, :err; 22 | is $proc.exitcode, 0, "named-anywhere, single '-'"; 23 | 24 | $proc = run 't/supermain-multi.raku', 'pos1', 'pos2', '--named', 'named', 25 | '--other-named', 'other-named', '--diff-named', 'diff-named', 26 | :out, :err; 27 | is $proc.exitcode, 0, "space separated named param"; 28 | my $std-out = $proc.out.slurp: :close; 29 | like $std-out.chomp, / << NAMED\: \s+ \[named\] .+ >>/, "check value"; 30 | like $std-out.chomp, / << OTHER\-NAMED\: \s+ \[other\-named\] .+ >>/, "check value"; 31 | like $std-out.chomp, / << DIFF\-NAMED\: \s+ \[diff\-named\] /, "check value"; 32 | 33 | 34 | $proc = run 't/supermain-multi.raku', 'pos1', 'pos2', '--named', 'named', 35 | '-o', 'other-named', :out, :err; 36 | is $proc.exitcode, 0, "autoalias shortest"; 37 | $std-out = $proc.out.slurp: :close; 38 | like $std-out.chomp, / << NAMED\: \s+ \[named\] .+ >>/, "check value"; 39 | like $std-out.chomp, / << OTHER\-NAMED\: \s+ \[other\-named\] /, "check value"; 40 | 41 | $proc = run 't/supermain-multi.raku', 'pos1', 'pos2', 42 | '--named', 'named', '-oth', 'other-named', '-ott', 'otter-named', 43 | :out, :err; 44 | is $proc.exitcode, 0, "autoalias multi match"; 45 | $std-out = $proc.out.slurp: :close; 46 | like $std-out.chomp, / << NAMED\: \s+ \[named\] .+ >>/, "check value"; 47 | like $std-out.chomp, / << OTHER\-NAMED\: \s+ \[other\-named\] .+ >>/, "check value"; 48 | like $std-out.chomp, / << OTTER\-NAMED\: \s+ \[otter\-named\] /, "check value"; 49 | 50 | $proc = run 't/supermain-multi.raku', 'pos1', '--bool', '-d', 'pos2', 51 | '-n', 'named', :out, :err; 52 | is $proc.exitcode, 0, "boolean order + autoalias"; 53 | $std-out = $proc.out.slurp: :close; 54 | like $std-out.chomp, / << POSITIONAL1\: \s+ \[pos1\] .+ >>/, "check value"; 55 | like $std-out.chomp, / << POSITIONAL2\: \s+ \[pos2\] .+ >>/, "check value"; 56 | like $std-out.chomp, / << NAMED\: \s+ \[named\] .+ >>/, "check value"; 57 | like $std-out.chomp, / << BOOL\: \s+ True >>/, "check value"; 58 | like $std-out.chomp, / << DIFF\-BOOL\: \s+ True >>/, "check value"; 59 | 60 | done-testing; 61 | -------------------------------------------------------------------------------- /t/03-cornercases.rakutest: -------------------------------------------------------------------------------- 1 | use Test; 2 | use lib 'lib'; 3 | 4 | # Skip test on Windows for now 5 | if $*DISTRO.is-win { 6 | note "Windows testing skipped for now"; 7 | done-testing; 8 | exit; 9 | } 10 | 11 | my $proc = run 't/supermain.raku', 'pos1', 12 | '--named=named=withequalsign', 13 | :out, :err; 14 | is $proc.exitcode, 0, "= as part of named parameter value"; 15 | my $std-out = $proc.out.slurp: :close; 16 | like $std-out.chomp, / << NAMED\: \s+ \[named\=withequalsign\] /, "check value"; 17 | 18 | $proc = run 't/supermain.raku', 'pos1', 19 | '--named=named=withequalsign=1=2=3=', 20 | :out, :err; 21 | is $proc.exitcode, 0, "multiple = as part of named parameter value"; 22 | $std-out = $proc.out.slurp: :close; 23 | like $std-out.chomp, / << NAMED\: \s+ \[named\=withequalsign\=1\=2\=3\=\] /, "check value"; 24 | 25 | $proc = run 't/supermain.raku', 'pos1', 26 | '--named', ' named-with-spaces ', :out, :err; 27 | is $proc.exitcode, 0, "named parameter value with spaces"; 28 | $std-out = $proc.out.slurp: :close; 29 | like $std-out.chomp, / << NAMED\: \s+ \[ \s named\-with\-spaces \s \] .+ /, "check value"; 30 | 31 | 32 | done-testing; 33 | -------------------------------------------------------------------------------- /t/supermain-multi.raku: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env raku 2 | use lib 'lib'; 3 | use SuperMAIN; 4 | 5 | multi sub MAIN($positional, Str :n(:$named)) { 6 | say "POSITIONAL: [$positional]" if $positional.defined; 7 | say "NAMED: [$named]" if $named.defined; 8 | } 9 | 10 | multi sub MAIN($positional, Str :n(:$named), Str :$other-named) { 11 | say "POSITIONAL: [$positional]" if $positional.defined; 12 | say "NAMED: [$named]" if $named.defined; 13 | say "OTHER-NAMED:: [$other-named]" if $other-named.defined; 14 | } 15 | 16 | multi MAIN($positional1, $positional2?, Str :n(:$named), 17 | Str :$other-named, Str :$diff-named) { 18 | say "POSITIONAL1: [$positional1]" if $positional1.defined; 19 | say "POSITIONAL2: [$positional2]" if $positional2.defined; 20 | say "NAMED: [$named]" if $named.defined; 21 | say "OTHER-NAMED: [$other-named]" if $other-named.defined; 22 | say "DIFF-NAMED: [$diff-named]" if $diff-named.defined; 23 | } 24 | 25 | multi MAIN($positional1, $positional2?, 26 | Str :n(:$named), Str :$other-named, 27 | Str :$diff-named, Str :$otterparam) { 28 | say "POSITIONAL1: [$positional1]" if $positional1.defined; 29 | say "POSITIONAL2: [$positional2]" if $positional2.defined; 30 | say "NAMED: [$named]" if $named.defined; 31 | say "OTHER-NAMED: [$other-named]" if $other-named.defined; 32 | say "DIFF-NAMED: [$diff-named]" if $diff-named.defined; 33 | say "OTTER-NAMED: [$otterparam]" if $otterparam.defined; 34 | } 35 | 36 | multi MAIN($positional1, $positional2?, Str :n(:$named), Bool :$bool, Bool :$diff-bool) { 37 | say "POSITIONAL1: [$positional1]" if $positional1.defined; 38 | say "POSITIONAL2: [$positional2]" if $positional2.defined; 39 | say "NAMED: [$named]" if $named.defined; 40 | say "BOOL: " ~ so $bool; 41 | say "DIFF-BOOL: " ~ so $diff-bool; 42 | } 43 | -------------------------------------------------------------------------------- /t/supermain.raku: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env raku 2 | use lib 'lib'; 3 | use SuperMAIN; 4 | 5 | sub MAIN($positional1, $positional2?, 6 | :n(:$named), :$other-named, 7 | Bool :$bool, Bool :$diff-bool) { 8 | say "POSITIONAL1: [$positional1]" if $positional1.defined; 9 | say "POSITIONAL2: [$positional2]" if $positional2.defined; 10 | say "NAMED: [$named]" if $named.defined; 11 | say "OTHER-NAMED: [$other-named]" if $other-named.defined;; 12 | say "BOOL: " ~ so $bool; 13 | say "DIFF-BOOL: " ~ so $diff-bool; 14 | } --------------------------------------------------------------------------------