mirror of
https://github.com/swift-project/pilotclient.git
synced 2026-03-22 23:05:36 +08:00
75 lines
2.2 KiB
Perl
75 lines
2.2 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# Convert C++ compiler warnings into Github Actions workflow commands
|
|
#
|
|
# Copyright (C) 2020 swift Project Community / contributors
|
|
#
|
|
# This program is free software: you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation, either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Path::Class;
|
|
|
|
my %cmds;
|
|
while (<<>>)
|
|
{
|
|
chomp;
|
|
my %result = extractWarning($_);
|
|
next if not %result;
|
|
$result{file} = toRelativePath($result{file})->as_foreign('Unix');
|
|
if (exists $result{line}) {
|
|
++$cmds{"::warning file=$result{file},line=$result{line}::$result{msg}"};
|
|
} else {
|
|
++$cmds{"::warning file=$result{file}::$result{msg}"};
|
|
}
|
|
}
|
|
my @cmds = sort keys %cmds;
|
|
my $count = scalar @cmds;
|
|
print "$_\n" for @cmds;
|
|
print "::set-output name=warnings::$count\n";
|
|
|
|
sub extractWarning
|
|
{
|
|
my $line = shift;
|
|
my %result = extractGccWarning($line);
|
|
return %result if %result;
|
|
return extractMsvcWarning($line);
|
|
}
|
|
|
|
sub extractGccWarning
|
|
{
|
|
my $line = shift;
|
|
$line =~ m(^\s*(?<loc>.*?): warning: (?<msg>.*)$) or return ();
|
|
my ($loc, $msg) = @+{ qw(loc msg) };
|
|
$loc =~ m(^(?<file>.*?):(?<loc>[0-9:]+)$) or return (file => $loc, msg => $msg);
|
|
my ($file, $loc) = ($+{file}, split ':', $+{loc});
|
|
return (file => $file, line => $loc, msg => $msg);
|
|
}
|
|
|
|
sub extractMsvcWarning
|
|
{
|
|
my $line = shift;
|
|
$line =~ m(^\s*(?<loc>.*?): warning (?<msg>[A-Z]+[0-9]+: .*)$) or return ();
|
|
my ($loc, $msg) = @+{ qw(loc msg) };
|
|
$loc =~ m(^(?<file>.*)\((?<loc>[0-9,]+)\)$) or return (file => $loc, msg => $msg);
|
|
my ($file, $loc) = ($+{file}, split ',', $+{loc});
|
|
return (file => $file, line => $loc, msg => $msg);
|
|
}
|
|
|
|
sub toRelativePath
|
|
{
|
|
my $path = shift;
|
|
my $file = file($path);
|
|
return $file if $file->is_relative;
|
|
return $file->relative if dir()->absolute()->subsumes($file);
|
|
return $file;
|
|
}
|