10-fyi-autom4te-trace-patterns.patch

[Akim Demaille]

I'm sorry for the noise in the patch below.  I struggled with `do' to
load files, but couldn't find a means to simulate `source'.  Simply
stated, if there is a file containing `$foo = 42', I'm unable to read
this file and have the `my $foo' variable of the caller be changed.
Lexically scoped variables and `do' seem to be incompatible.

But my tries required several renamings which somewhat pollute the
patch below.  I kept them though, as I believe the new names are
better anyway.


I have problem to understand perfectly the behavior of grep and map in
Perl.  Please, if there is a Perlspert who could explain it to me...
There are comments below describing what I'm trying to do, without any
success.  Basically, I'd like to use map for side effects, but almost
always end up using grep which seems to be better suited for what I
want to do.

This is a part of the comment included in the patch:

+  # I'm having fun with grep and map, but it's not extremely safe here...
+  # First of all, I still don't understand why I can't use `map' for
+  # instance to get @PATTERNS: `chop' thinks it's in a scalar context
+  # and returns 1 instead of `$_' :(.
+  #
+  # A potential bad bug is that the grep for $forbidden and $allowed
+  # *do modify @PATTERNS!  So when $FORBIDDEN is computed, @PATTERNS
+  # still contains the forbidden patterns, but without the leading
+  # `forbid:'.  So if some use forbids `allow:FOO', @ALLOW will receive
+  # `FOO', which is _bad_.  But since `:' is not valid in macro names,
+  # this is science fiction.
+  #
+  # Still, if someone could teach me how to write this properly... --akim
+  handle_traces ($req, "$tmp/patterns",
+                ('m4_pattern_forbid' => 'forbid:$1',
+                 'm4_pattern_allow'  => 'allow:$1'));
+  my @patterns = grep { chop } new IO::File ("$tmp/patterns")->getlines;
+  my $forbidden = join ('|', grep { s/^forbid:// } @patterns) || "^\$";
+  my $allowed   = join ('|', grep { s/^allow:// }  @patterns) || "^\$";
+  verbose "forbidden tokens: $forbidden";
+  verbose "allowed   tokens: $allowed";


Index: ChangeLog
from  Akim Demaille  <address@hidden>

        Don't rely on M4sugar outputting the patterns in files, since we
        might process the output _without_ running m4, hence without these
        files.

        * lib/m4sugar/m4sugar.m4 (m4_init): No need for `m4_tmpdir'.
        * bin/autom4te.in (@Request::includes): Remove, unused.
        (@Request::source): Rename as...
        (@Request::input): this.
        (@preselect): Add `m4_pattern_forbid' and `m4_pattern_allow'.
        (&handle_output): Fetch the patterns from the traces.
        `$forbidden' and `$allowed' are constant: use m//o.
        (&handle_m4): M4sugar no longer wants `m4_tmpdir'.
        (m4_pattern_forbid, m4_pattern_allow): Adjust for tracing only.

Index: bin/autom4te.in
--- bin/autom4te.in Sat, 04 Aug 2001 02:43:58 +0200 akim
+++ bin/autom4te.in Sat, 04 Aug 2001 11:45:16 +0200 akim
@@ -61,10 +61,8 @@
    'valid' => "\$",
    # The include path.
    'path' => '@',
-   # The set of source files.
-   'source' => '@',
-   # The set of included files.
-   'includes' => '@',
+   # The set of input files.
+   'input' => '@',
    # The set of macros currently traced.
    'macro' => '%',
   );
@@ -73,7 +71,7 @@
 # $REQUEST-OBJ
 # retrieve ($SELF, %ATTR)
 # -----------------------
-# Find a request with the same path and source.
+# Find a request with the same path and input.
 # Private.
 sub retrieve
 {
@@ -85,9 +83,9 @@ sub retrieve
       next
        if join ("\n", @{$_->path}) ne join ("\n", @{$attr{path}});

-      # Same sources.
+      # Same inputs.
       next
-       if join ("\n", @{$_->source}) ne join ("\n", @{$attr{source}});
+       if join ("\n", @{$_->input}) ne join ("\n", @{$attr{input}});

       # Found it.
       return $_;
@@ -106,9 +104,9 @@ sub register ($%)
 {
   my ($self, %attr) = @_;

-  # path and source are the only ID for a request object.
-  my $obj = $self->new ('path'   => $attr{path},
-                       'source' => $attr{source});
+  # path and input are the only ID for a request object.
+  my $obj = $self->new ('path'  => $attr{path},
+                       'input' => $attr{input});
   push @request, $obj;

   # Assign an id for cache file.
@@ -121,7 +119,7 @@ sub register ($%)
 # $REQUEST-OBJ
 # request($SELF, %REQUEST)
 # ------------------------
-# Return a request corresponding to $REQUEST{path} and $REQUEST{source},
+# Return a request corresponding to $REQUEST{path} and $REQUEST{input},
 # using a cache value if it exists.
 sub request ($%)
 {
@@ -208,20 +206,20 @@ sub save
 }


-# LOAD ($FILENAME)
-# ----------------
+# LOAD ($FILE)
+# ------------
 sub load
 {
-  my ($self, $filename) = @_;
+  my ($self, $file) = @_;

   croak "$me: cannot load a single request\n"
     if ref ($self);

-  (my $return) = do "$filename";
+  (my $return) = do "$file";

-  croak "$me: cannot parse $filename: address@hidden" if $@;
-  croak "$me: cannot do $filename: $!\n"    if $!;
-  croak "$me: cannot run $filename\n"       unless $return;
+  croak "$me: cannot parse $file: address@hidden" if $@;
+  croak "$me: cannot do $file: $!\n"    if $!;
+  croak "$me: cannot run $file\n"       unless $return;
 }


@@ -249,9 +247,11 @@ sub load
 my %trace;

 # The macros the user will want to trace in the future.
-# We need `include'.
+# We need `include' to get the included file, `m4_pattern_forbid' and
+# `m4_pattern_allow' to check the output.
+#
 # FIXME: What about `sinclude'?
-my @preselect = ('include');
+my @preselect = ('include', 'm4_pattern_allow', 'm4_pattern_forbid');

 my $output = '-';
 my @warning;
@@ -524,7 +524,6 @@ sub handle_m4 ($@)

   # Run m4.
   my $command = ("$m4"
-                . " --define m4_tmpdir=$tmp"
                 . " --define m4_warnings=$m4_warnings"
                 . ' --debug=aflq'
                 . " --error-output=$tcache" . $req->id
@@ -553,19 +552,30 @@ sub handle_output ($$)
   verbose "creating $output";

   # Load the forbidden/allowed patterns.
-  my $forbidden = "^\$";
-  if (-f "$tmp/forbidden.rx")
-    {
-      my $fh = new IO::File ("$tmp/forbidden.rx");
-      $forbidden = join ('|', grep { chop } $fh->getlines);
-    }
-  my $allowed = "^\$";
-  if (-f "$tmp/allowed.rx")
-    {
-      my $fh = new IO::File ("$tmp/allowed.rx");
-      $allowed = join ('|', grep { chop } $fh->getlines);
-    }
+  #
+  # I'm having fun with grep and map, but it's not extremely safe here...
+  # First of all, I still don't understand why I can't use `map' for
+  # instance to get @PATTERNS: `chop' thinks it's in a scalar context
+  # and returns 1 instead of `$_' :(.
+  #
+  # A potential bad bug is that the grep for $forbidden and $allowed
+  # *do modify @PATTERNS!  So when $FORBIDDEN is computed, @PATTERNS
+  # still contains the forbidden patterns, but without the leading
+  # `forbid:'.  So if some use forbids `allow:FOO', @ALLOW will receive
+  # `FOO', which is _bad_.  But since `:' is not valid in macro names,
+  # this is science fiction.
+  #
+  # Still, if someone could teach me how to write this properly... --akim
+  handle_traces ($req, "$tmp/patterns",
+                ('m4_pattern_forbid' => 'forbid:$1',
+                 'm4_pattern_allow'  => 'allow:$1'));
+  my @patterns = grep { chop } new IO::File ("$tmp/patterns")->getlines;
+  my $forbidden = join ('|', grep { s/^forbid:// } @patterns) || "^\$";
+  my $allowed   = join ('|', grep { s/^allow:// }  @patterns) || "^\$";
+  verbose "forbidden tokens: $forbidden";
+  verbose "allowed   tokens: $allowed";

+  # Read the (cached) raw M4 output, produce the actual result.
   my $out = new IO::File (">$output")
     or die "$me: cannot create $output: $!\n";
   my $in = new IO::File ($ocache . $req->id)
@@ -606,7 +616,7 @@ sub handle_output ($$)
       foreach (split (/\W+/))
        {
          $prohibited{$_} = $oline
-           if /$forbidden/ && !/$allowed/ && ! exists $prohibited{$_};
+           if /$forbidden/o && !/$allowed/o && ! exists $prohibited{$_};
        }
     }

@@ -614,7 +624,7 @@ sub handle_output ($$)
   return
     if ! %prohibited;

-  # Locate the forbidden words in the last source file.
+  # Locate the forbidden words in the last input file.
   # This is unsatisfying but...
   my $prohibited = '\b(' . join ('|', keys %prohibited) . ')\b';
   my $file = new IO::File ($ARGV[$#ARGV])
@@ -656,7 +666,7 @@ sub handle_output ($$)
 sub trace_format_to_m4 ($)
 {
   my ($format) = @_;
-  my ($underscore) = $_;
+  my $underscore = $_;
   my %escape = (# File name.
                'f' => '$1',
                # Line number.
@@ -859,6 +869,10 @@ sub handle_traces ($$%)
     or die "$me: cannot run $m4: $!\n";
   my $out = new IO::File (">$output")
     or die "$me: cannot run open $output: $!\n";
+
+  # FIXME: Hm... This is dubious: should we really transform the
+  # quadrigraphs in traces?  It might break balanced [ ] etc. in the
+  # output.
   while ($_ = $in->getline)
     {
       # It makes no sense to try to transform __oline__.
@@ -948,9 +962,9 @@ sub up_to_date_p ($)
   if -f $icache;

 # Add the new trace requests.
-my $req = Request->request ('source' => address@hidden,
-                           'path'   => address@hidden,
-                           'macro'  => [keys %trace, @preselect]);
+my $req = Request->request ('input' => address@hidden,
+                           'path'  => address@hidden,
+                           'macro' => [keys %trace, @preselect]);

 # If $REQ's cache files are not up to date, declare it invalid.
 $req->valid (0)
Index: lib/m4sugar/m4sugar.m4
--- lib/m4sugar/m4sugar.m4 Thu, 02 Aug 2001 00:45:09 +0200 akim
+++ lib/m4sugar/m4sugar.m4 Sat, 04 Aug 2001 11:44:44 +0200 akim
@@ -1204,15 +1204,14 @@ m4_define([$1],
 # ----------------------
 # Declare that no token matching the extended regular expression ERE
 # should be seen in the output but if...
-m4_define([m4_pattern_forbid],
-[m4_file_append(m4_defn([m4_tmpdir])/forbidden.rx, [$1])])
+m4_define([m4_pattern_forbid], [])


 # m4_pattern_allow(ERE)
 # ---------------------
 # ... but if that token matches the extended regular expression ERE.
-m4_define([m4_pattern_allow],
-[m4_file_append(m4_defn([m4_tmpdir])/allowed.rx, [$1])])
+# Both used via traces.
+m4_define([m4_pattern_allow], [])


 ## ----------------------------- ##
@@ -1721,11 +1720,7 @@ m4_define([m4_file_append],
 # m4_init
 # -------
 m4_define([m4_init],
-[# We need a tmp directory.
-m4_ifndef([m4_tmpdir],
-          [m4_define([m4_tmpdir], [/tmp])])
-
-# All the M4sugar macros start with `m4_', except `dnl' kept as is
+[# All the M4sugar macros start with `m4_', except `dnl' kept as is
 # for sake of simplicity.
 m4_pattern_forbid([^_?m4_])
 m4_pattern_forbid([^dnl$])