CVS commit: pkgsrc/pkgtools/lintpkgsrc/files

["Roland Illig" <rillig%netbsd.org@localhost>]

Module Name:    pkgsrc
Committed By:   rillig
Date:           Tue Aug  9 18:35:43 UTC 2022

Modified Files:
        pkgsrc/pkgtools/lintpkgsrc/files: lintpkgsrc.pl
        pkgsrc/pkgtools/lintpkgsrc/files/t: glob.t

Log Message:
lintpksrc: fix parsing of the ':S' modifier in makefiles


To generate a diff of this commit:
cvs rdiff -u -r1.57 -r1.58 pkgsrc/pkgtools/lintpkgsrc/files/lintpkgsrc.pl
cvs rdiff -u -r1.5 -r1.6 pkgsrc/pkgtools/lintpkgsrc/files/t/glob.t

Please note that diffs are not public domain; they are subject to the
copyright notices on the relevant files.

Modified files:

Index: pkgsrc/pkgtools/lintpkgsrc/files/lintpkgsrc.pl
diff -u pkgsrc/pkgtools/lintpkgsrc/files/lintpkgsrc.pl:1.57 pkgsrc/pkgtools/lintpkgsrc/files/lintpkgsrc.pl:1.58
--- pkgsrc/pkgtools/lintpkgsrc/files/lintpkgsrc.pl:1.57 Tue Aug  9 18:14:22 2022
+++ pkgsrc/pkgtools/lintpkgsrc/files/lintpkgsrc.pl      Tue Aug  9 18:35:43 2022
@@ -1,6 +1,6 @@
 #!@PERL5@
 
-# $NetBSD: lintpkgsrc.pl,v 1.57 2022/08/09 18:14:22 rillig Exp $
+# $NetBSD: lintpkgsrc.pl,v 1.58 2022/08/09 18:35:43 rillig Exp $
 
 # Written by David Brownlee <abs%netbsd.org@localhost>.
 #
@@ -879,10 +879,10 @@ sub list_pkgsrc_pkgdirs($$) {
 # Return undef on error.
 sub glob2regex($) {
        my ($glob) = @_;
-       my (@chars, $in_alt);
-       my ($regex);
 
-       @chars = split(//, $glob);
+       my @chars = split(//, $glob);
+       my $alternative_depth = 0;
+       my $regex = '';
        while (defined($_ = shift @chars)) {
                if ($_ eq '*') {
                        $regex .= '.*';
@@ -890,37 +890,43 @@ sub glob2regex($) {
                        $regex .= '.';
                } elsif ($_ eq '+') {
                        $regex .= '\\+';
-               } elsif ($_ eq '\\') {
-                       $regex .= $_ . shift @chars;
+               } elsif ($_ eq '\\' && @chars > 0) {
+                       my $next = shift @chars;
+                       $regex .= $next =~ /\w/ ? "$next" : "\\$next";
                } elsif ($_ eq '.' || $_ eq '|') {
                        $regex .= quotemeta;
                } elsif ($_ eq '{') {
                        $regex .= '(';
-                       ++$in_alt;
+                       ++$alternative_depth;
                } elsif ($_ eq '}') {
-                       if (!$in_alt) {
+                       if ($alternative_depth == 0) {
                                # Error
                                return undef;
                        }
                        $regex .= ')';
-                       --$in_alt;
-               } elsif ($_ eq ',' && $in_alt) {
+                       --$alternative_depth;
+               } elsif ($_ eq ',' && $alternative_depth) {
                        $regex .= '|';
+               } elsif ($_ eq '[') {
+                       $regex .= '[';
+                       while (defined($_ = shift @chars)) {
+                               $regex .= $_;
+                               if ($_ eq ']') {
+                                       last;
+                               } elsif ($_ eq '\\' && @chars > 0) {
+                                       $regex .= shift @chars;
+                               }
+                       }
+                       return undef if $_ ne ']';
                } else {
                        $regex .= $_;
                }
        }
 
-       if ($in_alt) {
-               # Error
-               return undef;
-       }
-       if ($regex eq $glob) {
-               return ('');
-       }
-       if ($opt{D}) {
-               print "glob2regex: $glob -> $regex\n";
-       }
+       return undef if $alternative_depth > 0;
+       return '' if $regex eq $glob; # XXX: why?
+
+       $opt{D} and print "glob2regex: $glob -> $regex\n";
        '^' . $regex . '$';
 }
 

Index: pkgsrc/pkgtools/lintpkgsrc/files/t/glob.t
diff -u pkgsrc/pkgtools/lintpkgsrc/files/t/glob.t:1.5 pkgsrc/pkgtools/lintpkgsrc/files/t/glob.t:1.6
--- pkgsrc/pkgtools/lintpkgsrc/files/t/glob.t:1.5       Tue Aug  9 18:14:22 2022
+++ pkgsrc/pkgtools/lintpkgsrc/files/t/glob.t   Tue Aug  9 18:35:43 2022
@@ -1,4 +1,4 @@
-# $NetBSD: glob.t,v 1.5 2022/08/09 18:14:22 rillig Exp $
+# $NetBSD: glob.t,v 1.6 2022/08/09 18:35:43 rillig Exp $
 
 use strict;
 use warnings;
@@ -11,46 +11,49 @@ require('../lintpkgsrc.pl');
 sub test_glob2regex() {
 
        ok(glob2regex('*'), '^.*$');
+       ok(glob2regex('\*'), '');
 
        ok(glob2regex('?'), '^.$');
+       ok(glob2regex('\?'), '');
 
-       ok(glob2regex('[a-z]'), '');
+       # Ordinary characters in glob patterns.
+       ok(glob2regex('+'), '^\+$');
+       ok(glob2regex('\+'), '');
+       ok(glob2regex('|'), '^\|$');
+       ok(glob2regex('\|'), '');
+
+       ok(glob2regex('\.'), '');
+       ok(glob2regex('\n'), '^n$');
+       ok(glob2regex('\\\\'), '');
+       ok(glob2regex('\['), '');
+       ok(glob2regex('\{'), '');
+       ok(glob2regex('\-'), '');
 
+       ok(glob2regex('[a-z]'), '');
        ok(glob2regex('[a-z0-9]'), '');
-
        ok(glob2regex('[a-z0-9_]'), '');
-
-       # Outside of braces, the ',' is a regular character.
-       ok(glob2regex('a,b'), '');
-
-       # FIXME: Inside brackets, the '*' is a literal '*'.
-       ok(glob2regex('[*]'), '^[.*]$');
-
-       ok(glob2regex('\*'), '');
+       ok(glob2regex('[*]'), '');
 
        ok(glob2regex('*.[ch]'), '^.*\.[ch]$');
 
+       # Outside of braces, the ',' is a regular character.
+       ok(glob2regex('a,b'), '');
        ok(glob2regex('{one,two}'), '^(one|two)$');
-
        ok(glob2regex('{{thi,fou}r,fif}teen'), '^((thi|fou)r|fif)teen$');
 
        # There is an unbalanced '}' at the very end.
-       ok(glob2regex('{{thi,fou}r,fif}teen}'), undef);
-
-       ok(glob2regex('a+b|c'), '^a\+b\|c$');
+       ok(glob2regex('{four,fif}teen}'), undef);
 
+       # An escaped '[' does not start a character class.
        ok(glob2regex('a\[b*'), '^a\[b.*$');
 
-       ok(glob2regex('a\+b'), '');
-
-       ok(glob2regex('a\?b'), '');
-
-       # XXX: Depending on the exact implementation, the '\n' may be
-       # interpreted as a newline, a literal 'n' or a literal '\' 'n'.
-       ok(glob2regex('a\n*'), '^a\n.*$');
+       ok(glob2regex('a\n*'), '^an.*$');
 
        # https://gnats.netbsd.org/12996
        ok(glob2regex('libsigc++'), '^libsigc\+\+$');
+
+       my $re = 'a\nb';
+       ok("a\nb" =~ $re, 1);
 }
 
 test_glob2regex();