This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
take Rafael's fixes for mlint
authorH.Merijn Brand - Tux <h.m.brand@xs4all.nl>
Sat, 13 May 2017 13:47:32 +0000 (15:47 +0200)
committerH.Merijn Brand - Tux <h.m.brand@xs4all.nl>
Sat, 13 May 2017 13:47:32 +0000 (15:47 +0200)
bin/mlint

index f003eb0..ffab401 100755 (executable)
--- a/bin/mlint
+++ b/bin/mlint
@@ -298,6 +298,48 @@ sub init_extraction {
 sub end_extraction {
 }
 
+# Process the command line of ?MAKE: lines
+sub p_make_command {
+       local ($_) = @_;
+       my $where = "\"$file\", line $. (?MAKE:)";
+       unless (s/^\t+//) {
+               warn "$where: command line must start with a leading TAB character.\n";
+               s/^\s+//;                               # Remove spaces and continue
+       }
+       return unless s/^-?pick\b//;
+       # Validate the special "pick" make command, processed internally
+       # by metaconfig.
+       my %valid = map { $_ => 1 } qw(
+               add add.Config_sh add.Null
+               c_h_weed cm_h_weed close.Config_sh
+               prepend weed wipe
+
+       );
+       my $cmd;
+       $cmd = $1 if s/^\s+(\S+)//;
+       unless (defined $cmd) {
+               warn "$where: pick needs a command argument.\n";
+               return;
+       }
+       $wiped_unit++ if $cmd eq 'wipe';
+       warn "$where: unknown pick command '$cmd'.\n" unless $valid{$cmd};
+       s/^\s+//;
+       unless (s/^\$\@//) {
+               warn "$where: third pick argument must be \$\@\n";
+               return;
+       }
+       s/^\s+//;
+       my $target;
+       $target = $1 if s/^(\S+)//;
+       unless (defined $target) {
+               warn "$where: fourth pick argument is missing\n";
+               return;
+       }
+       return if $target =~ m|^\./|;
+       warn "$where: weird fourth argument '$target' to pick.\n"
+               unless $target =~ /^\w+$/;
+}
+
 # Process the ?MAKE: line
 sub p_make {
        local($_) = @_;
@@ -305,7 +347,7 @@ sub p_make {
        local(@dep);                                    # Dependencies
        local($where) = "\"$file\", line $. (?MAKE:)";
        unless (/^[\w+ ]*:/) {
-               $wiped_unit++ if /^\t+-pick\s+wipe\b/;
+               &p_make_command;
                return;                                         # We only want the main dependency rule
        }
        warn "$where: ignoring duplicate dependency listing line.\n"