diff --git a/README.md b/README.md index 0c55d78..32c7c86 100644 --- a/README.md +++ b/README.md @@ -4,23 +4,45 @@ PerlPP: Perl preprocessor Translates **Text+Perl** to **Text**. It can be used for any kind of text templating, e.g. code generation. No external modules are required, just a single file. +Requires Perl 5.10+. - Usage: perl perlpp.pl [options] [filename] - Options: - -o, --output filename Output to the file instead of STDOUT. - -s, --set name=value Set $S{name}=value in the generated code. - The hash %S always exists, but is empty - if you haven't specified any -s options. - -e, --eval expression Evaluate the expression(s) before any Perl code. - -d, --debug Don't evaluate Perl code, just write it to STDERR. - -h, --help Usage help. +PerlPP runs in two passes: it generates a Perl script from your input, and then +it runs the generated script. If you see `error at (eval ##)` +(for some number `##`), it means there was an error in the generated script. -Syntax ------- +Usage +----- -Syntax is a bit similar to PHP. -Perl code has to be included between `` tags. -There are several modes, indicated by the opening tag: + Usage: perl perlpp.pl [options] [filename] + Options: + -o, --output filename Output to the file instead of STDOUT. + -D, --define name=value Set $D{name}=value in the generated + code. The hash %D always exists, but + is empty if you haven't specified any + -D options. + Also substitutes _name_ with _value_ + in the output file. + _value_ is optional and defaults to + true. + -e, --eval statement Evaluate the statement(s) before any + Perl code of the input files. + -E, --debug Don't evaluate Perl code, just write + it to STDERR. + -s, --set name=value As -D, but gneerates into %S and does + not substitute in the text body. + -h, --help Usage help. + +In a **-D** command, the `value` must be a valid Perl value, e.g., `"foo"` +for a string. This may require you to escape quotes in the **-D** argument, +depending on your shell. E.g., if `-D foo="bar"` doesn't work, try +`-D 'foo="bar"'` (with single quotes around the whole `name=value` part). + +Syntax of the input file +------------------------ + +The syntax is a bit similar to PHP. +Perl code is included between `` tags. +There are several modes, indicated by the character after the ` because "x" is not a valid mode +The Generated Script +-------------------- + +The generated script: + +- is in its own package, named based on the input filename +- `use`s `5.010`, `strict`, and `warnings` +- provides constants `true` (=`!!1`) and `false` (=`!!0`) (with `use constant`) +- Declares `my %D` and initializes `%D` based on any **-D** options you provide + +Other than that, everything in the script comes from your input file(s). +Use the **-E** option to see the generated script. + Examples -------- @@ -108,27 +143,43 @@ So `` is effectively a shorthand for ``. Commands -------- +### Include + + -or `` (keep a whitespace between `"` and `?>`, explained further). Includes source code of another PerlPP file into this position. Note that this file can be any PerlPP input, so you can also use this to include plain text files or other literal files. +When using the long form, make sure there is whitespace between the trailing +`"` and the closing tag `?>`, as explained below under "Capturing." + +### Prefix Replaces word prefixes in the following output. In this case words like `fooSomeWord` will become `barSomeWord`. +### Macro + will run `some_perl_code;` at the time of script generation. Whatever output the perl code produces will be included verbatim in the script output. This can be used to dynamically select which files you want to include, -using +using the provided `Include()` function. For example: +has the same effect as + + + +but `$fn` can be determined programmatically. Note that it is not currently +possible to select the filename to `Include` based on defines set with **-D**, +since those do not take effect until the script has been generated. + Capturing --------- @@ -137,7 +188,7 @@ Sometimes it is great to get (capture) source text into a Perl string. "?> start of capturing ` or `That's cool, really. @@ -145,8 +196,8 @@ is the same as -Captured strings are properly escaped, and can be sequenced like in this example. -Moreover, they can be nested! +Captured strings are properly escaped, and can be sequenced like in +this example. Moreover, they can be nested! -Printed characters from the second `ABC()` call are attached to the string `'alphabet '`, -so the result will be +Printed characters from the second `ABC()` call are attached to the +string `'alphabet '`, so the result will be abcdefghijklmnopqrstuvwxyz ALPHABET @@ -169,21 +220,68 @@ so the result will be Capturing works in all modes: code, echo, or command mode. -Custom Preprocessors --------------------- +C Preprocessor Emulation +------------------------ -It's possible to create your own pre/post-processors with `PerlPP::AddPreprocessor` and `PerlPP::AddPostprocessor`. -This feature is used in [BigBenBox](https://github.com/d-ash/BigBenBox) for generating code in the C programming language. +The **-D** switch defines elements of `%D`. If you do not specify a +value, the value `true` (a constant in the generated script) will be used. +The following commands work mostly analogously to their C preprocessor +counterparts. -Future ------- +- `` +- `` +- `` +- `` +- `` +- `` +- `` (`elif` and `elseif` are synonyms) + +For example: + + + foo + + +is the same as the more verbose script: + + + foo + + +### If and Elsif + +Tests with `` and `` have two restrictions: + +- If `$D{NAME}` does not exist, the test will be `false` regardless + of the condition `...`. +- The `...` must be a valid Perl expression when + `$D{NAME}` is added to the beginning, with no + parentheses around it. + +For example, `` (note the whitespace before `?>`!) +will work fine. However, if you want to test `(FOO+1)*3`, you will need +to use the full Perl code. + +Other Features +-------------- + +### Custom Preprocessors + +It's possible to create your own pre/post-processors in a `` block +using `PerlPP::AddPreprocessor` and `PerlPP::AddPostprocessor`. +This feature is used in [BigBenBox](https://github.com/d-ash/BigBenBox) for +generating code in the C programming language. + +### Future Suggestions are welcome. -Highlighting ------------- +Highlighting in your editor +--------------------------- + +### Vim -To make PerlPP insets highlighted in Vim, add this to *~/.vimrc* +To make highlight PerlPP insets in Vim, add this to *~/.vimrc* autocmd colorscheme * hi PerlPP ctermbg=darkgrey ctermfg=lightgreen @@ -193,3 +291,9 @@ and create corresponding *~/.vim/after/syntax/FILETYPE.vim* FILETYPE can be determined with `:set ft?` +## Copyright + +Distributed under the MIT license --- see +[LICENSE.txt](LICENSE.txt) for details. +By Andrey Shubin (d-ash at Github) and Chris White (cxw42 at Github). + diff --git a/perlpp.pl b/perlpp.pl index c15bac6..b05c367 100755 --- a/perlpp.pl +++ b/perlpp.pl @@ -5,7 +5,7 @@ # http://darkness.codefu.org/wordpress/2003/03/perl-scoping/ package PerlPP; -our $VERSION = '0.2.0'; +our $VERSION = '0.3.0-alpha'; use v5.10; # provides // - http://perldoc.perl.org/perl5100delta.html use strict; @@ -31,6 +31,14 @@ package PerlPP; use constant OPENING_RE => qr/^(.*?)\Q${\(TAG_OPEN)}\E(.*)$/s; # /s states for single-line mode use constant CLOSING_RE => qr/^(.*?)\Q${\(TAG_CLOSE)}\E(.*)$/s; +use constant DEFINE_NAME_RE => + qr/^(?[[:alpha:]][[:alnum:]_]*|[[:alpha:]_][[:alnum:]_]+)$/i; + # Valid names for -D. TODO expand this to Unicode. + # Bare underscore isn't permitted because it's special in perl. +use constant DEFINE_NAME_IN_CONTEXT_RE => + qr/^(?[[:alpha:]][[:alnum:]_]*|[[:alpha:]_][[:alnum:]_]+)\s*+(?.*+)$/i; + # A valid name followed by something else. Used for, e.g., :if and :elsif. + # Modes - each output buffer has one use constant OBMODE_PLAIN => 0; # literal text, not in tag_open/tag_close use constant OBMODE_CAPTURE => 1; # same as OBMODE_PLAIN but with capturing @@ -45,12 +53,24 @@ package PerlPP; use constant OB_CONTENTS => 1; # === Globals ============================================================= -my $Package = ''; -my @Preprocessors = (); -my @Postprocessors = (); + +# Internals +my $Package = ''; # package name for the generated script my $RootSTDOUT; my $WorkingDir = '.'; -my %Prefixes = (); + +# Vars accessible to, or used by or on behalf of, :macro / :immediate code +my @Preprocessors = (); +my @Postprocessors = (); +my %Prefixes = (); # set by ExecuteCommand; used by PrepareString + +# -D definitions. -Dfoo creates $Defs{foo}==true and $Defs_repl_text{foo}==''. +my %Defs = (); # Command-line -D arguments +my $Defs_RE = false; # Regex that matches any -D name +my %Defs_repl_text = (); # Replacement text for -D names + +# -s definitions. +my %Sets = (); # Command-line -s arguments # Output-buffer stack my @OutputBuffers = (); # each entry is a two-element array @@ -143,9 +163,16 @@ sub PrepareString { my $s = shift; my $pref; + # Replace -D options. Do this before prefixes so that we don't create + # prefix matches. TODO? combine the defs and prefixes into one RE? + $s =~ s/$Defs_RE/$Defs_repl_text{$1}/g if $Defs_RE; + + # Replace prefixes foreach $pref ( keys %Prefixes ) { $s =~ s/(^|\W)\Q$pref\E/$1$Prefixes{ $pref }/g; } + + # Quote it for printing return QuoteString( $s ); } @@ -154,20 +181,79 @@ sub ExecuteCommand { my $fn; my $dir; - if ( $cmd =~ /^include\s+(?:['"](?[^'"]+)['"]|(?\S+))\s*$/i ) { + if ( $cmd =~ /^include\s++(?:['"](?[^'"]+)['"]|(?\S+))\s*$/i ) { ProcessFile( $WorkingDir . "/" . $+{fn} ); - } elsif ( $cmd =~ /^macro\s+(.*)$/si ) { + } elsif ( $cmd =~ /^macro\s++(.*+)$/si ) { StartOB(); # plain text eval( $1 ); warn $@ if $@; print "print " . PrepareString( EndOB() ) . ";\n"; - } elsif ( $cmd =~ /^immediate\s+(.*)$/si ) { + } elsif ( $cmd =~ /^immediate\s++(.*+)$/si ) { eval( $1 ); warn $@ if $@; - } elsif ( $cmd =~ /^prefix\s+(\S+)\s+(\S+)\s*$/i ) { + } elsif ( $cmd =~ /^prefix\s++(\S++)\s++(\S++)\s*+$/i ) { $Prefixes{ $1 } = $2; + # Definitions + } elsif ( $cmd =~ /^define\s++(.*+)$/i ) { # set in %D + my $test = $1; # Otherwise !~ clobbers it. + if( $test !~ DEFINE_NAME_IN_CONTEXT_RE ) { + die "Could not understand \"define\" command \"$test\"." . + " Maybe an invalid variable name?"; + } + my $nm = $+{nm}; + my $rest = $+{rest}; + + # Set the default value to true if non provided + $rest =~ s/^\s+|\s+$//g; # trim whitespace + $rest='true' if not length($rest); # default to true + + print "\$D\{$nm\} = ($rest) ;\n"; + + } elsif ( $cmd =~ /^undef\s++(?\S++)\s*+$/i ) { # clear from %D + my $nm = $+{nm}; + die "Invalid name \"$nm\" in \"undef\"" if $nm !~ DEFINE_NAME_RE; + print "\$D\{$nm\} = undef;\n"; + + # Conditionals + } elsif ( $cmd =~ /^ifdef\s++(?\S++)\s*+$/i ) { # test in %D + my $nm = $+{nm}; # Otherwise !~ clobbers it. + die "Invalid name \"$nm\" in \"ifdef\"" if $nm !~ DEFINE_NAME_RE; + print "if(defined(\$D\{$nm\})) {\n"; # Don't need exists() + + } elsif ( $cmd =~ /^ifndef\s++(?\S++)\s*+$/i ) { # test in %D + my $nm = $+{nm}; # Otherwise !~ clobbers it. + die "Invalid name \"$nm\" in \"ifdef\"" if $nm !~ DEFINE_NAME_RE; + print "if(!defined(\$D\{$nm\})) {\n"; # Don't need exists() + + } elsif ( $cmd =~ /^if\s++(.*+)$/i ) { # :if - General test of %D values + my $test = $1; # $1 =~ doesn't work for me + if( $test !~ DEFINE_NAME_IN_CONTEXT_RE ) { + die "Could not understand \"if\" command \"$test\"." . + " Maybe an invalid variable name?"; + } + my $ref="\$D\{$+{nm}\}"; + print "if(exists($ref) && ( $ref $+{rest} ) ) {\n"; + # Test exists() first so undef maps to false rather than warning. + + } elsif ( $cmd =~ /^(elsif|elseif|elif)\s++(.*+)$/ ) { # :elsif with condition + my $cmd = $1; + my $test = $2; + if( $test !~ DEFINE_NAME_IN_CONTEXT_RE ) { + die "Could not understand \"$cmd\" command \"$test\"." . + " Maybe an invalid variable name?"; + } + my $ref="\$D\{$+{nm}\}"; + print "} elsif(exists($ref) && ( $ref $+{rest} ) ) {\n"; + # Test exists() first so undef maps to false rather than warning. + + } elsif ( $cmd =~ /^else\s*+$/i ) { + print "} else {\n"; + + } elsif ( $cmd =~ /^endif\s*+$/i ) { # end of a block + print "}\n"; + } else { die "Unknown PerlPP command: ${cmd}"; } @@ -225,14 +311,14 @@ sub OnOpening { sub OnClosing { my $inside; my $insetMode; - my $plainMode = OBMODE_PLAIN; + my $nextMode = OBMODE_PLAIN; $insetMode = GetModeOfOB(); $inside = EndOB(); # contents of the inset if ( $inside =~ /"$/ ) { StartOB( $insetMode ); # restore contents of the inset print substr( $inside, 0, -1 ); - $plainMode = OBMODE_CAPTURE; + $nextMode = OBMODE_CAPTURE; } else { if ( $insetMode == OBMODE_ECHO ) { print "print ${inside};\n"; # don't wrap in (), trailing semicolon @@ -240,16 +326,18 @@ sub OnClosing { ExecuteCommand( $inside ); } elsif ( $insetMode == OBMODE_COMMENT ) { # Ignore the contents - no operation + } elsif ( $insetMode == OBMODE_CODE ) { + print "$inside\n"; # \n so you can put comments in your perl code } else { print $inside; } if ( GetModeOfOB() == OBMODE_CAPTURE ) { # if the inset is wrapped print EndOB() . " PerlPP::EndOB(); } . "; # end of do { .... } statement - $plainMode = OBMODE_CAPTURE; # back to capturing + $nextMode = OBMODE_CAPTURE; # back to capturing } } - StartOB( $plainMode ); # plain text + StartOB( $nextMode ); # plain text } #OnClosing() sub RunPerlPP { @@ -368,12 +456,13 @@ sub OutputResult { # lowercase before upper, although the code does not require that order. EVAL => ['e','|eval=s', ""], - DEBUG => ['d','|debug', false], + DEBUG => ['d','|E|debug', false], # -h and --help reserved # --man reserved # INPUT_FILENAME assigned by parse_command_line_into OUTPUT_FILENAME => ['o','|output=s', ""], - DEFS => ['s','|set=s%'], + DEFS => ['D','|define:s%'], # In %D, and text substitution + SETS => ['s','|set:s%'], # Extra data in %S, without text substitution # --usage reserved # -? reserved ); @@ -398,9 +487,9 @@ sub parse_command_line_into { ); # Get options - GetOptions($hrOptsOut, # destination hash - 'usage|?', 'h|help', 'man', - map { $_->[0] . $_->[1] } values %CMDLINE_OPTS, # options strs + GetOptions($hrOptsOut, # destination hash + 'usage|?', 'h|help', 'man', # options we handle here + map { $_->[0] . $_->[1] } values %CMDLINE_OPTS, # options strs ) or pod2usage(-verbose => 0, -exitval => EXIT_PARAM_ERR); # unknown opt @@ -411,11 +500,16 @@ sub parse_command_line_into { # Map the option names from GetOptions back to the internal names we use, # e.g., $hrOptsOut->{EVAL} from $hrOptsOut->{e}. - my %revmap = map { $CMDLINE_OPTS{$_}->[0] => $_ } keys %CMDLINE_OPTS; + my %revmap = map { $CMDLINE_OPTS{$_}->[0] => $_ } keys %CMDLINE_OPTS; for my $optname (keys %$hrOptsOut) { $hrOptsOut->{ $revmap{$optname} } = $hrOptsOut->{ $optname }; } + # Check the names of any -D flags + for my $k (keys %{$hrOptsOut->{DEFS}}) { + die "Invalid -D name \"$k\"" if $k !~ DEFINE_NAME_RE; + } + # Process other arguments. TODO? support multiple input filenames? $hrOptsOut->{INPUT_FILENAME} = $ARGV[0] // ""; @@ -426,19 +520,78 @@ sub Main { my %opts; parse_command_line_into \%opts; + # Preamble + $Package = $opts{INPUT_FILENAME}; - $Package =~ s/^([a-zA-Z_][a-zA-Z_0-9.]*).p$/$1/; - $Package =~ s/[^a-z0-9]/_/gi; + $Package =~ s/^.*?([a-z_][a-z_0-9.]*).pl?$/$1/i; + $Package =~ s/[^a-z0-9_]/_/gi; # $Package is not the whole name, so can start with a number. StartOB(); - print "package PPP_${Package};\nuse strict;\nuse warnings;\n"; + print "package PPP_${Package};\nuse 5.010;\nuse strict;\nuse warnings;\n"; + print "use constant { true => !!1, false => !!0 };\n"; - # Transfer parameters from the command line (-s) to the processed file. - # The parameters are in %S, by analogy with -s. - print "my %S = (\n"; + # Definitions + + # Transfer parameters from the command line (-D) to the processed file, + # as textual representations of expressions. + # The parameters are in %D at runtime. + print "my %D = (\n"; for my $defname (keys %{$opts{DEFS}}) { - print " $defname => ", ${$opts{DEFS}}{$defname}, ",\n"; + my $val = ${$opts{DEFS}}{$defname} // 'true'; + # just in case it's undef. "true" is the constant in this context + $val = 'true' if $val eq ''; + # "-D foo" (without a value) sets it to _true_ so + # "if($D{foo})" will work. Getopt::Long gives us '' as the + # value in that situation. + print " $defname => $val,\n"; + } + print ");\n"; + + # Save a copy for use at generation time + %Defs = map { my $v = eval(${$opts{DEFS}}{$_}); + warn "Could not evaluate -D \"$_\": $@" if $@; + $_ => ($v // true) + } + keys %{$opts{DEFS}}; + + # Set up regex for text substitution of Defs. + # Modified from http://www.perlmonks.org/?node_id=989740 by + # AnomalousMonk, http://www.perlmonks.org/?node_id=634253 + if(%{$opts{DEFS}}) { + my $rx_search = + '\b(' . (join '|', map quotemeta, keys %{$opts{DEFS}}) . ')\b'; + $Defs_RE = qr{$rx_search}; + + # Save the replacement values. If a value cannot be evaluated, + # use the name so the replacement will not change the text. + %Defs_repl_text = + map { my $v = eval(${$opts{DEFS}}{$_}); + ($@ || !defined($v)) ? ($_ => $_) : ($_ => ('' . $v)) + } + keys %{$opts{DEFS}}; + } + + # Now do SETS: -s or --set, into %S by analogy with -D and %D. + + # Save a copy for use at generation time + %Sets = map { my $v = eval(${$opts{SETS}}{$_}); + warn "Could not evaluate -s \"$_\": $@" if $@; + $_ => ($v // true) + } + keys %{$opts{SETS}}; + + # Make the copy for runtime + print "my %S = (\n"; + for my $defname (keys %{$opts{SETS}}) { + my $val = ${$opts{SETS}}{$defname}; + if(!defined($val)) { + } + $val = 'true' if $val eq ''; + # "-s foo" (without a value) sets it to _true_ so + # "if($S{foo})" will work. Getopt::Long gives us '' as the + # value in that situation. + print " $defname => $val,\n"; } print ");\n"; @@ -450,12 +603,24 @@ sub Main { my $script = EndOB(); # The generated Perl script + # --- Run it --- if ( $opts{DEBUG} ) { print $script; + } else { StartOB(); # output of the Perl script - eval( $script ); warn $@ if $@; - OutputResult( \EndOB(), $opts{OUTPUT_FILENAME} ); + my $result; # save any errors from the eval + + # TODO hide %Defs and others of our variables we don't want + # $script to access. + eval( $script ); $result=$@; + + if($result) { # Report errors to console and shell + print STDERR $result; + exit 1; + } else { # Save successful output + OutputResult( \EndOB(), $opts{OUTPUT_FILENAME} ); + } } } #Main() @@ -478,6 +643,8 @@ =head1 USAGE If no [filename] is given, input will be read from stdin. +Run C for a quick reference, or C for full docs. + =head1 OPTIONS =over @@ -486,40 +653,62 @@ =head1 OPTIONS Output to B instead of STDOUT. -=item -s, --set B=B +=item -D, --define B[=B] -In the generated script, set C<< $S{B} >> to B. -The hash C<%S> always exists, but is empty if no B<-s> options are +In the generated script, set C<< $D{B} >> to B. +The hash C<%D> always exists, but is empty if no B<-D> options are given on the command line. -Note: If your shell strips quotes, you may need to escape them. B must -be a valid Perl expression. So, under bash, this works: +The B will also be replaced with the B in the text of the file. +If B cannot be evaluated, no substitution is made for B. - perlpp -s name=\"Hello, world!\" +If you omit the B<< =value >>, the value will be the constant C +(see L, below), and no text substitution +will be performed. -The backslashes (C<\"> instead of C<">) are required to prevent bash -from removing the double-quotes. Alternatively, this works: +This also saves the value, or C, in the generation-time +hash C<< %Defs >>. This can be used, e.g., to select include filenames +depending on B<-D> arguments. - perlpp -s 'name="Hello, World"' - -with the whole argument to B<-s> in single quotes. +See L, below, for more information. =item -e, --eval B Evaluate the B before any other Perl code in the generated script. -=item -d, --debug +=item -E, --debug (or -d for backwards compatibility) Don't evaluate Perl code, just write the generated code to STDOUT. +By analogy with the C<-E> option of gcc. -=item -h, --help +=item -s, --set B[=B] + +As B<-D>, but: + +=over + +=item * -Usage help. +Does not substitute text in the body of the document; + +=item * + +Saves into C<< %Sets >> at generation time; and + +=item * + +Saves into C<< %S >> in the generated script. + +=back =item --man -Full documentation +Full documentation, viewed in your default pager if configured. + +=item -h, --help + +Usage help, printed to STDOUT. =item -?, --usage @@ -527,14 +716,58 @@ =head1 OPTIONS =back +=head1 DEFINITIONS + +B<-D> and B<-s> items may be evaluated in any order --- +do not rely on left-to-right +evaluation in the order given on the command line. + +If your shell strips quotes, you may need to escape them: B must +be a valid Perl expression. So, under bash, this works: + + perlpp -D name=\"Hello, world!\" + +The backslashes (C<\"> instead of C<">) are required to prevent bash +from removing the double-quotes. Alternatively, this works: + + perlpp -D 'name="Hello, World"' + +with the whole argument to B<-D> in single quotes. + +Also note that the space after B<-D> is optional, so + + perlpp -Dfoo + perlpp -Dbar=42 + +both work. + +=head1 THE GENERATED SCRIPT + +The code you specify in the input file is in a Perl environment with the +following definitions in place: + + package PPP_foo; + use 5.010; + use strict; + use warnings; + use constant { true => !!1, false => !!0 }; + +where B is the input filename, if any, transformed to only include +[A-Za-z0-9_]. + +This preamble requires Perl 5.10, which perlpp itself requires. +On the plus side, requring v5.10 gives you C +(the defined-or operator) and the builtin C. +The preamble also keeps you safe from some basic issues. + =head1 COPYRIGHT Code at L. Distributed under MIT license. -By Andrey Shubin (L); additional contributions by -Chris White (cxw42 at Github). +By Andrey Shubin (d-ash at Github; L) and +Chris White (cxw42 at Github; L). =cut -# vi: set ts=4 sts=0 sw=4 noet ai: # +# vi: set ts=4 sts=0 sw=4 noet ai fo-=o: # diff --git a/t/basic.t b/t/basic.t index 8c78387..dd30e59 100755 --- a/t/basic.t +++ b/t/basic.t @@ -16,6 +16,7 @@ my @testcases=( ['Foo Howdy, "world!" I\'m cool. bar'."\n", 'Foo 4 Howdy, "world!" I\'m cool. bar'."\n"], ['',''], + ['','42'], ['',''], ['#define QUUX ()', '#define QUUX (2)'], ['',"aa\nbb\ncc\ndd\n"], diff --git a/t/cmdline.t b/t/cmdline.t index 32091ee..4ec75ab 100755 --- a/t/cmdline.t +++ b/t/cmdline.t @@ -9,22 +9,91 @@ use constant CMD => 'perl perlpp.pl'; my @testcases=( # [$cmdline_options, $in (the script), $out_re (expected output), # $err_re (stderr output, if any)] + + # Debug output ['-d','',qr/^package PPP_;/], ['-d', '', qr{print\s+2\+2\s*;}], ['--debug', '', qr{print\s+2\+2\s*;}], + ['-E', '', qr{print\s+2\+2\s*;}], + + # Usage ['-h', '', qr/^Usage/], ['--help', '', qr/^Usage/], + + # Eval at start of file ['-e \'my $foo=42;\'','', qr/^42$/], ['--eval \'my $foo=42;\'','', qr/^42$/], ['-d -e \'my $foo=42;\'','', qr/^my \$foo=42;/m], ['--debug --eval \'my $foo=42;\'','', qr/^print\s+\$foo\s*;/m], - ['-s foo=1', '',qr/^1$/], - ['-s foo=\"blah\"', '',qr/^blah$/], + + # Definitions: name formats + ['-Dfoo', '',qr/^yes$/], + ['-Dfoo42', '',qr/^yes$/], + ['-Dfoo_42', '',qr/^yes$/], + ['-D_x', '',qr/^yes$/], + ['-D_1', '',qr/^yes$/], + + # Definitions with --define + ['--define foo', '',qr/^yes$/], + ['--define foo=42 --define bar=127', '',qr/^5334$/], + + # Definitions: :define/:undef + ['','yesno',qr/^yes$/], + ['','yesno',qr/^yes$/], + ['','',qr/^42$/], + ['','',qr/^ab$/], + ['-Dfoo','yesno',qr/^no$/], + + # Definitions: values + ['-Dfoo=41025.5', '',qr/^41025.5$/], + ['-D foo=2017', '',qr/^2017$/], + ['-D foo=\"blah\"', '',qr/^blah$/], # Have to escape the double-quotes so perl sees it as a string # literal instead of a bareword. - ['-s foo=42 -s bar=127', '',qr/^5334$/], - ['', '', - qr/^%S always exists even if empty$/], + ['-D foo=42 -D bar=127', '',qr/^5334$/], + ['', '', + qr/^%D always exists even if empty$/], + + # Textual substitution + ['-Dfoo=42','foo',qr/^42$/ ], + ['-Dfoo=\'"a phrase"\'','foo',qr/^a phrase$/ ], + ['-Dfoo=\"bar\"','_foo foo foobar barfoo',qr/^_foo bar foobar barfoo$/ ], + ['-Dfoo=\"bar\" --define barfoo','_foo foo foobar barfoo', + qr/^_foo bar foobar barfoo$/ ], + + # Sets, which do not textually substitute + ['-sfoo=42','foo',qr/^foo$/ ], + ['-sfoo=42','',qr/^42$/ ], + ['--set foo=42','foo',qr/^foo$/ ], + ['--set foo=42','',qr/^42$/ ], + + # Conditionals + ['-Dfoo=42','yesno',qr/^no$/ ], + ['-Dfoo=2','yesno',qr/^yes$/ ], + ['-Dfoo','yesno',qr/^no$/ ], + ['-Dfoo','yesno',qr/^yes$/ ], + # The default value is true, which compares equal to 1. + ['-Dfoo','yesno',qr/^yes$/ ], + ['','yesno',qr/^no$/ ], + ['','yesno',qr/^no$/ ], + # For consistency, all :if tests evaluate to false if the + # named variable is not defined. + + # Undefining + ['-Dfoo','yesno',qr/^no$/ ], + + # Three forms of elsif + ['', 'yesmaybeno', qr/^no$/], + ['', 'yesmaybeno', qr/^no$/], + ['', 'yesmaybeno', qr/^no$/], + + # elsif with definitions + ['-Dfoo', 'yesmaybeno', qr/^yes$/], + ['-Dfoo=1', 'yesmaybeno', qr/^yes$/], + # Automatic conversion of numeric 1 to string in "eq" context + ['-Dfoo=\\"x\\"', 'yesmaybeno', qr/^x\nmaybe$/], + ['-Dfoo=\\"y\\"', 'yesmaybeno', qr/^no$/], + ); #@testcases #plan tests => scalar @testcases; @@ -35,6 +104,7 @@ for my $lrTest (@testcases) { my ($opts, $testin, $out_re, $err_re) = @$lrTest; my ($out, $err); + #print STDERR CMD . " $opts", " <<<'", $testin, "'\n"; run3 CMD . " $opts", \$testin, \$out, \$err; if(defined $out_re) { @@ -43,6 +113,7 @@ for my $lrTest (@testcases) { if(defined $err_re) { like($err, $err_re); } + #print STDERR "$err\n"; } # foreach test diff --git a/t/macro.t b/t/macro.t new file mode 100755 index 0000000..5be997d --- /dev/null +++ b/t/macro.t @@ -0,0 +1,51 @@ +#!/usr/bin/env perl -W +# Tests of perlpp :macro and related +use strict; +use warnings; +use Test::More 'no_plan'; +use IPC::Run3; +use constant CMD => 'perl perlpp.pl'; + +(my $whereami = __FILE__) =~ s/macro\.t$//; +my $incfn = '\"' . $whereami . 'included.txt\"'; + # escape the quotes for the shell + +my @testcases=( + # [$cmdline_options, $in (the script), $out_re (expected output), + # $err_re (stderr output, if any)] + + # %Defs + ['-D foo=42', '', qr/^42/], + ['-D incfile=' . $incfn , '', + qr/^a4b/], + ['-s incfile=' . $incfn , '', + qr/^a4b/], + ['', '',qr/^128$/], + +); #@testcases + +#plan tests => scalar @testcases; +# TODO count the out_re and err_re in @testcases, since the number of +# tests is the sum of those counts. + +for my $lrTest (@testcases) { + my ($opts, $testin, $out_re, $err_re) = @$lrTest; + + my ($out, $err); + print STDERR CMD . " $opts", " <<<'", $testin, "'\n"; + run3 CMD . " $opts", \$testin, \$out, \$err; + + if(defined $out_re) { + like($out, $out_re); + } + if(defined $err_re) { + like($err, $err_re); + } + #print STDERR "$err\n"; + +} # foreach test + +# TODO test -o / --output, and processing input from files rather than stdin + +# vi: set ts=4 sts=0 sw=4 noet ai: # +