Support -L command-line arg

interpreters · Nov 10, 2018 · a08718b · a08718b
1 parent e001b9d
commit a08718b
Show file tree

Hide file tree

Showing 12 changed files with 163 additions and 78 deletions.
diff --git a/MANIFEST b/MANIFEST
@@ -7,6 +7,7 @@ lib/XML/Axk/Core.pm
 lib/XML/Axk/DOM.pm
 lib/XML/Axk/L/L0.pm
 lib/XML/Axk/L/L1.pm
+lib/XML/Axk/L/LTEST.pm
 lib/XML/Axk/Language.pm
 lib/XML/Axk/Matcher/Always.pm
 lib/XML/Axk/Matcher/XPath.pm
@@ -33,11 +34,11 @@ t/ex/02.axk
 t/ex/1.axk
 t/ex/2.axk
 t/ex/ex1.xml
-t/ex/l0.axk
+t/ex/lTEST.axk
 t/ex/nutrition.xml
 t/ex/oneliner
 t/ex/xml1.axk
 t/lib/AxkTest.pm
 t/lib/AxkTest/Helpers.pm
-t/tests/T/Object/TinyDefaults.pm
-t/tests/T/XML/Axk/L1.pm
+t/tests/L1.pm
+t/tests/TinyDefaults.pm
diff --git a/lib/XML/Axk/App.pm b/lib/XML/Axk/App.pm
@@ -20,15 +20,24 @@ use constant EXIT_PARAM_ERR	=> 2;	# couldn't understand the command line
 
 # === Command line parsing ============================================== {{{1
 
-# files/scripts to load, in order.  Each element is [isfile, text].
-# Package var so we can localize it.
+# Files/scripts to load, in order.  Each element is either [isfile, text]
+# or {...} for pragmas.
+# It is a package var so we can localize it.
 our @_Sources;
 
 my $dr_save_source = sub {
     my ($which, $text) = @_;
     push @_Sources, [$which eq 'f', $text];
 }; # dr_save_source
 
+my $dr_save_pragma = sub {
+    my ($kind, $text) = @_;
+    $kind = 'B' if $kind eq 'backend';
+    $kind = 'L' if $kind eq 'language';
+
+    push @_Sources, { $kind => $text };
+}; # dr_save_pragma
+
 my %CMDLINE_OPTS = (
     # hash from internal name to array reference of
     # [getopt-name, getopt-options, optional default-value]
@@ -37,7 +46,7 @@ my %CMDLINE_OPTS = (
     # They are listed in alphabetical order by option name,
     # lowercase before upper, although the code does not require that order.
 
-    #BACKEND => ['b', '|backend=s'],        # TODO
+    #BACKEND => ['b', '|backend=s', $dr_save_pragma],   # TODO
 
     #DUMP_VARS => ['d', '|dump-variables', false],
     #DEBUG => ['D','|debug', false],
@@ -50,7 +59,7 @@ my %CMDLINE_OPTS = (
     #INCLUDE => ['i','|include=s@'],
     #KEEP_GOING => ['k','|keep-going',false], #not in gawk
     #LIB => ['l','|load=s@'],
-    LANGUAGE => ['L','|language=s'],
+    LANGUAGE => ['L','|language=s', $dr_save_pragma],
     # --man reserved
     # OUTPUT_FILENAME => ['o','|output=s', ""], # conflict with gawk
     # OPTIMIZE => ['O','|optimize'],
@@ -162,16 +171,43 @@ sub Main {
         # they stick around as long as $core does.
 
     my $cmd_line_idx = 0;   # Number the `-e`s on the command line
-    foreach my $lrSource (@{$opts{SOURCES}}) {
-        my ($is_file, $text) = @$lrSource;
-        if($is_file) {
-            $core->load_script_file($text);
-        } else {
-            $core->load_script_text($text,
-                "(cmd line script #@{[++$cmd_line_idx]})",
-                true);  # true => add a Ln if there isn't one in the script
+    my $curr_lang = undef;  # current -L, if any.
+    #my $curr_backend = undef;  # to do
+
+    foreach my $rItem (@{$opts{SOURCES}}) {
+
+        if(ref $rItem eq 'ARRAY') {     # source file or text
+            my $lrSource = $rItem;
+            my ($is_file, $text) = @$lrSource;
+
+            if($is_file) {
+                $core->load_script_file(filename => $text,
+                    $curr_lang ? (language => $curr_lang) : ()
+                );
+
+            } else {
+                $core->load_script_text(text => $text,
+                    filename => "(cmd line script #@{[++$cmd_line_idx]})",
+                    $curr_lang ? (language => $curr_lang) :
+                        (auto_language => true)
+                        # true => add a Ln if there isn't one in the script
+                );
+            }
+
+        } else {                        # pragma
+            my $hrPragma = $rItem;
+
+            if(exists $hrPragma->{L}) {
+                $curr_lang = $hrPragma->{L};
+                #say "# Language is now $curr_lang"
+            }
+
+            if(exists $hrPragma->{B}) {
+                die 'Backend selection is not yet supported';
+            }
         }
-    } #foreach source
+
+    } #foreach source item
 
     # read from stdin if no input files specified.
     push @$lrArgs, '-' unless @$lrArgs || $opts{NO_INPUT};

diff --git a/lib/XML/Axk/Base.pm b/lib/XML/Axk/Base.pm
@@ -36,6 +36,7 @@ our %EXPORT_TAGS = (
     all => [@EXPORT, @EXPORT_OK]
 );
 
+# Uncomment for full stacktraces on all errors
 BEGIN {
     $SIG{'__DIE__'} = sub { Carp::confess(@_) } unless $SIG{'__DIE__'};
     #$Exporter::Verbose=1;

diff --git a/lib/XML/Axk/Core.pm b/lib/XML/Axk/Core.pm
@@ -72,7 +72,9 @@ my $scriptnumber = 0;
 
 =head2 load_script_file
 
-Load the named script file from disk, but do not execute it.
+Load the named script file from disk, but do not execute it.  Usage:
+
+    $core->load_script_file(filename => $name[, ...])
 
 =cut
 
@@ -81,45 +83,59 @@ Load the named script file from disk, but do not execute it.
 # @param $fn {String}   Filename to load
 sub load_script_file {
     my $self = shift;
+    my %args = @_;
 
-    my $fn = shift;
-    open(my $fh, '<', $fn) or croak("Cannot open $fn");
+    my $fn = $args{filename} or croak 'Need a filename';
+    open(my $fh, '<', $fn) or croak "Cannot open $fn";
     my $contents = do { local $/; <$fh> };
     close $fh;
 
-    $self->load_script_text($contents, $fn, false);
+    $self->load_script_text(text => $contents, filename => $fn,
+        auto_language => false);
         # false => scripts on disk MUST specify a Ln directive.  This is a
-        # design decision, so we don't have issues like Perl 5/6 or Python 2/3.
+        # design decision, so we don't have issues like Python 2/3.
 
 } #load_script_file
 
 =head2 load_script_text
 
-Load the given text, but do not execute it.
+Load the given text, but do not execute it.  Usage:
+
+    $core->load_script_text(text => $text[, filename => $name][, ...])
 
 =cut
 
 # TODO permit specifying a specific Ln?
 # @param $self
 # @param $text {String} The source text, **which load_script_text may modify.**
-# @param $fn {String}   Filename to use in debugging messages
-# @param $add_Ln {boolean, default false} If true, add a Ln directive for the
+# @param $filename {String}   Filename to use in debugging messages
+# @param $auto_language {boolean, default false} If true, add a Ln directive for the
 #           current version if there isn't one in the script.
+# @param $language {String}     If provided, the language to use for the first
+#           chunk of the text.
 sub load_script_text {
     my $self = shift;
-    my $text = shift;
-    my $fn = shift // '(command line)';
-    my $add_Ln = shift;
+    my %args = @_;
+
+    my $text = $args{text} or croak 'Need script text';
+    my $fn = $args{filename} // '(anonymous)';
+
+    my $curr_lang = $args{language};
+    my $add_Ln = $args{auto_language};
+    croak 'language and auto_language are mutually exclusive' if $curr_lang && $add_Ln;
 
     # Text to wrap around the script
     my ($leader, $trailer) = ('', '');
 
     #say "Text is $text";
-    my ($lrPieces, $has_lang) = XML::Axk::Preparse::pieces(\$text,
-        $add_Ln ? { L => {} } : undef);
+    my $hrInitialPragmas = {};
+    $hrInitialPragmas = { L => {$curr_lang ? (name => '' . $curr_lang) : ()} }
+        if $add_Ln || $curr_lang;
+
+    my ($lrPieces, $has_lang) = XML::Axk::Preparse::pieces(\$text, $hrInitialPragmas);
 
     #say "Has lang" if $has_lang;
-    unless($has_lang) {
+    unless($has_lang || $curr_lang) {
         if($add_Ln) {
             $lrPieces->[0]->{pragmas}->{L}->{digits} = 1;  # default language
         } else {

diff --git a/lib/XML/Axk/L/L0.pm b/lib/XML/Axk/L/L0.pm
@@ -1,31 +1,5 @@
-#!/usr/bin/env perl
-# XML::Axk::L::L0 - DUMMY axk language, version 0
-# Copyright (c) 2018 cxw42.  All rights reserved.  Artistic 2.
-# This is not a real axk language - it exists for testing.
+# axk L0.pm: A dummy language that fails loading.  Language "0" is reserved
+# since "0" is falsy in Perl.  Reserving this language permits using Boolean
+# tests instead of definedness tests.
 
-package XML::Axk::L::L0;
-use XML::Axk::Base;
-
-# Config
-our $C_WANT_TEXT = 1;
-
-# Packages we invoke by hand
-require XML::Axk::Language;
-
-# Import ========================================================= {{{1
-
-sub import {
-    #say "update: ",ref \&update, Dumper(\&update);
-    my $target = caller;
-    #say "XAL0 run from $target:\n", Dumper(\@_);
-    XML::Axk::Language->import(
-        target => $target
-    );
-    my $class = shift;
-    my ($fn, $lineno, $source_text) = @_;
-    #say "Got source text len ", length($source_text), " at $fn:$lineno:\n-----------------\n$source_text\n-----------------";
-} #import()
-
-#}}}1
-1;
-# vi: set ts=4 sts=4 sw=4 et ai fo-=ro foldmethod=marker fdl=1: #
+0;  # fail loading
diff --git a/lib/XML/Axk/L/LTEST.pm b/lib/XML/Axk/L/LTEST.pm
@@ -0,0 +1,31 @@
+#!/usr/bin/env perl
+# XML::Axk::L::LTEST - DUMMY axk language, version 0
+# Copyright (c) 2018 cxw42.  All rights reserved.  Artistic 2.
+# This is not a real axk language - it exists for testing.
+
+package XML::Axk::L::LTEST;
+use XML::Axk::Base;
+
+# Config
+our $C_WANT_TEXT = 1;
+
+# Packages we invoke by hand
+require XML::Axk::Language;
+
+# Import ========================================================= {{{1
+
+sub import {
+    #say "update: ",ref \&update, Dumper(\&update);
+    my $target = caller;
+    #say "XALTEST run from $target:\n", Dumper(\@_);
+    XML::Axk::Language->import(
+        target => $target
+    );
+    my $class = shift;
+    my ($fn, $lineno, $source_text) = @_;
+    #say "Got source text len ", length($source_text), " at $fn:$lineno:\n-----------------\n$source_text\n-----------------";
+} #import()
+
+#}}}1
+1;
+# vi: set ts=4 sts=4 sw=4 et ai fo-=ro foldmethod=marker fdl=1: #
diff --git a/lib/XML/Axk/Preparse.pm b/lib/XML/Axk/Preparse.pm
@@ -45,6 +45,27 @@ C<-Ln> pragma at the beginning of your script or on the axk command line.
 This is consistent with the requirement to list the version in your source
 files.
 
+=head2 Language formats
+
+Languages can either be:
+
+=over
+
+=item C<[0-9]+>
+
+A numeric language has leading 0s stripped from its name.  E.g., C<-L012>
+tries to use language C<12>.
+
+Languages 1-9 are reserved for axk's use.
+
+=item C<[a-zA-Z][a-zA-Z0-9\.]*>
+
+An alphabetic language name is used as is, except that C<.> characters are
+converted to C<::> module separators.
+
+Language names that are all upper case, and that have no C<.> characters,
+are reserved for axk's use.
+
 =cut
 
 =head1 ROUTINES
@@ -159,19 +180,19 @@ sub assemble {
             $retval .= $hrPiece->{text};
             next;
         }
-        $lang = "XML::Axk::L::L$lang";
+        my $lang_module = "XML::Axk::L::L$lang";
 
         # Does this language parse the source text itself?
         my $want_text;
-        eval "require $lang";
+        eval "require $lang_module";
         die "Can't find language $lang: $@" if $@;
         do {
             no strict 'refs';
-            $want_text = ${"${lang}::C_WANT_TEXT"};
+            $want_text = ${"${lang_module}::C_WANT_TEXT"};
         };
 
         unless($want_text) {    # Easy case: the script's code is still Perl
-            $retval .= "use $lang;\n";
+            $retval .= "use $lang_module;\n";
             $retval .= "#line $hrPiece->{start} \"$filename\"\n";
             $retval .= $hrPiece->{text};
 
@@ -180,7 +201,7 @@ sub assemble {
                 "AXK_EMBEDDED_SOURCE_DO_NOT_TYPE_THIS_YOURSELF_OR_ELSE";
 
             $retval .=
-                "use $lang \"$filename\", $hrPiece->{start}, " .
+                "use $lang_module \"$filename\", $hrPiece->{start}, " .
                 "<<'$trailer';\n";
             $retval .= $hrPiece->{text};
             $retval .= "\n$trailer\n";

diff --git a/t/02-basic-core.t b/t/02-basic-core.t
@@ -6,6 +6,7 @@ use warnings;
 use Test::More; # tests=>27;
 use Capture::Tiny 'capture_stdout';
 use File::Spec;
+use constant { true => !!1, false => !!0 };
 
 BEGIN {
     use_ok( 'XML::Axk::Core' ) || print "Bail out!\n";
@@ -19,7 +20,8 @@ sub localpath {
 # Inline script, operation at runtime ============================= {{{1
 {
     my $core = XML::Axk::Core->new();
-    $core->load_script_text('pre_all { print 42 }','filename',1);
+    $core->load_script_text(text => 'pre_all { print 42 }',
+        filename => 'filename', auto_language => true);
 
     my $out = capture_stdout { $core->run(); };
     is($out, '42', 'inline script runs');
@@ -30,7 +32,8 @@ sub localpath {
 {
     my $core = XML::Axk::Core->new();
     my $out = capture_stdout {
-        $core->load_script_text('print 42','filename',1);
+        $core->load_script_text(text => 'print 42',
+            filename => 'filename', auto_language => true);
     };
     is($out, '42', 'inline script runs load-time statements');
 
@@ -42,7 +45,7 @@ sub localpath {
 # Script on disk ================================================== {{{1
 {
     my $core = XML::Axk::Core->new();
-    $core->load_script_file(localpath 'ex/02.axk');
+    $core->load_script_file(filename => localpath('ex/02.axk'));
 
     my $out = capture_stdout { $core->run(); };
     is($out, '1337', 'on-disk script runs');
@@ -52,7 +55,7 @@ sub localpath {
 # Script with no language indicator =============================== {{{1
 {
     my $core = XML::Axk::Core->new();
-    eval { $core->load_script_file(localpath 'ex/02-noL.axk'); };
+    eval { $core->load_script_file(filename => localpath('ex/02-noL.axk')); };
     my $err = $@;
     like($err, qr/No language \(Ln\) specified/, 'detects missing Ln');
 }