#!/usr/bin/perl
# ================================================================= #
#                                                                   #
#   File      : postcompile.pl                                      #
#   Purpose   : filter gcc shadow spam                              #
#                                                                   #
#   Coded by Ralf Westram (coder@reallysoft.de) in September 2007   #
#   Institute of Microbiology (Technical University Munich)         #
#   http://www.arb-home.de/                                         #
#                                                                   #
# ================================================================= #

use strict;
use warnings;

# Note: g++ must be called with -fmessage-length=0

my $show_suppressed_lines = 0;
my $show_filtered_lines   = 0;

# regexps for whole line:
my $reg_file = qr/^([^:]+):([0-9]+):(([0-9]+):)?\s/; # finds all messages
my $reg_file_noline = qr/^([^:]+):\s/; # finds all messages w/o linenumber (if not matched $reg_file)
my $reg_included = qr/^In\sfile\sincluded\sfrom\s(.*)[,:]/;
my $reg_inlined_from = qr/^\s\s+(inlined\sfrom\s.*)\sat\s(.*)[,:]/;
my $reg_included2 = qr/^\s+from\s(.*)[,:]/;
my $reg_location = qr/^[^:]+:\sIn\s(function|member\sfunction|instantiation)\s/;
my $reg_location2 = qr/^[^:]+:\sAt\stop\slevel:/;
my $reg_location3 = qr/^At\sglobal\sscope:/;
my $reg_clang_dirt = qr/^ANALYZE:\s/;

# regexps for messages:
my $reg_is_error = qr/^error:\s/i;
my $reg_is_warning = qr/^warning:\s/i;
my $reg_is_note = qr/^note:\s/i;
my $reg_is_instantiated = qr/^\s\s+instantiated\sfrom\s/;
my $reg_is_required = qr/^\s\s+required\s(from|by)\s/;
my $reg_is_optimizerMsg = qr/^(missed|optimized):\s/i;

# regexps for warning messages (for part behind 'warning: ')
my $reg_shadow_warning = qr/^declaration\sof\s.*\sshadows\s/;
my $reg_shadow_location = qr/^shadowed\s/;
my $reg_unknown_gcc_diagnostic = qr/^expected.*after\s'#pragma\sGCC\sdiagnostic'/;

# filter unwanted -Weffc++ warnings
my $filter_Weffpp = 1;
my @reg_Weffpp = (
                  qr/only\sdefines\sprivate\sconstructors\sand\shas\sno\sfriends/, # unwanted warning about singleton-class where the only instance exists as a static member of itself
                  qr/^base\sclass\s.*has\s*(a|accessible)\snon-virtual\sdestructor/,
                  qr/\sshould\sbe\sinitialized\sin\sthe\smember\sinitialization\slist/,
                  qr/boost::icl::(insert|add)_iterator<ContainerT>.*should\sreturn/, # filter boost-iterator postfix operators warnings
                  qr/^\s\sbut\sdoes\snot\s(override|declare)/, # belongs to reg_Weffpp_copyable (since gcc 10.2.0 message uses 'declare' instead of 'override')
                  qr/^\s\sor\s\'operator=/, # belongs to reg_Weffpp_copyable
                 );

my $filter_Weffpp_copyable = 0; # 1 = filter copy-ctor/op=-warning, 0 = check for Noncopyable and warn
my $reg_Weffpp_copyable = qr/'(class|struct)\s([A-Za-z_0-9:]+).*'\shas\spointer\sdata\smembers/; # occurs also if derived from 'Noncopyable'

# regexps for files:
my $reg_user_include       = qr/^\/usr\/include\//;
my $reg_HEADERLIBS_include = qr/\/HEADERLIBS\//;

my $stop_after_first_error = 0;
my $hide_warnings          = 0;

my $dump_loop_optimization  = 0;
my $check_loop_optimization = 0;
my $checked_file = undef; # contains name of sourcefile (if it shall be checked)

my $REQ_check_loop_optimization = 0; # originally requested?
my $REQ_checked_file = 0; # originally checked file

my $ARBHOME = $ENV{ARBHOME};
my $exitcode = 0;

# ----------------------------------------

sub detect_needLoopCheck($) {
  my ($source) = @_;
  if ($check_loop_optimization) {
    $REQ_check_loop_optimization = 1;
    $REQ_checked_file = $source;
    use Cwd;
    my $currDir = Cwd::getcwd();
    my $relDir = undef;
    if ($currDir =~ /^$ARBHOME/) { $relDir = $'; }
    if (not defined $relDir) { die "Can't detect ARBHOME-relative working directory"; }
    $relDir =~ s/^\/*//og;
    my $relfile = $relDir.'/'.$source;
    my $checked_list = $ARBHOME.'/SOURCE_TOOLS/vectorized.source';

    open(LIST,'<'.$checked_list) || die "can't read '$checked_list' (Reason: $!)";
  SEARCH: foreach (<LIST>) {
      if (not /^\s*\#/) { # ignore comments
        if (not /^\s*$/) { # ignore empty lines
          chomp($_);
          if ($relfile eq $_) {
            $checked_file = $source;
            last SEARCH;
          }
        }
      }
    }
    close(LIST);
    if (not defined $checked_file) {
      $check_loop_optimization = undef;
    }
    elsif ($dump_loop_optimization==2) {
      $dump_loop_optimization = 0; # do not dump candidates, if file is already checked
    }
  }
}

sub getModtime($) {
  my ($fileOrDir) = @_;
  my $modtime = (stat($fileOrDir))[9];
  return $modtime;
}

my %derived_from_NC = (); # key=classname, value=1/0
my $NC_save_name = $ARBHOME.'/SOURCE_TOOLS/postcompile.sav';
my $NC_loaded    = 0;
my $NC_loaded_timestamp;
my $NC_need_save = 0;

sub load_from_NC() {
  if (-f $NC_save_name) {
    $NC_loaded_timestamp = getModtime($NC_save_name);
    my $age = $NC_loaded_timestamp - time;
    if ($age<3*60) { # never load data older than 3 min
      open(NC,'<'.$NC_save_name);
      foreach (<NC>) {
        chomp;
        if (/^([01]),/o) {
          $derived_from_NC{$'} = $1;
        }
      }
      close(NC);
    }
    else {
      $NC_loaded_timestamp = 0; # epoch
    }
  }
  else {
    $NC_loaded_timestamp = 0; # epoch
  }
  $NC_loaded = 1;
}

sub save_from_NC() {
  if ($NC_need_save==1) {
    my $mt = 0;
    if (-f $NC_save_name) { $mt = getModtime($NC_save_name); }
    if ($mt>$NC_loaded_timestamp) { # changed on disk
      load_from_NC(); # does simple merge
    }
    my $NC_save_name_private = $NC_save_name.'.'.$$;
    open(NC,'>'.$NC_save_name_private);
    foreach (sort keys %derived_from_NC) {
      print NC $derived_from_NC{$_}.','.$_."\n";
    }
    close(NC);

    rename($NC_save_name_private,$NC_save_name) || die "can't rename '$NC_save_name_private' to '$NC_save_name' (Reason: $!)";
  }
}

sub advice_derived_from_Noncopyable($$$) {
  # Note: you can silence the Noncopyable-warning by
  # adding a comment containing 'Noncopyable' behind the 'class'-line
  my ($classname,$file,$linenr) = @_;

  if ($NC_loaded==0) { load_from_NC(); }
  my $is_a_NC = $derived_from_NC{$classname};
  if (defined $is_a_NC) {
    return 0; # do not warn twice
  }

  if (not -f $file) {
    die "no such file '$file'";
  }

  my $uq_classname = $classname;
  while ($uq_classname =~ /::/o) { $uq_classname = $'; } # skip namespace prefixes

  open(FILE,'<'.$file) || die "can't read '$file' (Reason: $!)";
  my $line;
  my $line_count = 0;
 LINE: while (defined($line=<FILE>)) {
    $line_count++;
    if ($line_count==$linenr) {
      if ($line =~ /(class|struct)\s+($uq_classname|$classname)(.*)Noncopyable/) {
        my $prefix = $3;
        if (not $prefix =~ /\/\//) { # if we have a comment, assume it mentions that the class is derived from a Noncopyable
          if (not $prefix =~ /virtual/) {
            print $file.':'.$linenr.': inheritance from Noncopyable should be virtual'."\n";
          }
        }
        $is_a_NC = 1;
      }
      else { $is_a_NC = 0; }
      last LINE;
    }
  }
  close(FILE);
  $derived_from_NC{$classname} = $is_a_NC;
  $NC_need_save = 1;

  return 1-$is_a_NC;
}

# results for Weffpp_warning_wanted():
my $WANTED            = 0;
my $WANTED_NO_RELATED = 1;
my $UNWANTED          = 2;

sub Weffpp_warning_wanted($$\$) {
  my ($file,$line,$warning_text_r) = @_;

  if ($filter_Weffpp==1) {
    foreach my $reg (@reg_Weffpp) {
      return $UNWANTED if ($$warning_text_r =~ $reg);
    }
    if ($$warning_text_r =~ $reg_Weffpp_copyable) {
      my $classname = $2;
      return $UNWANTED if ($filter_Weffpp_copyable==1);
      return $UNWANTED if (advice_derived_from_Noncopyable($classname,$file,$line)==0);
      $$warning_text_r = $$warning_text_r.' (and is neither derived from Noncopyable nor defines copy-ctor and op=)';
      return $WANTED_NO_RELATED;
    }
  }
  return $WANTED;
}

sub warning($\@) {
  my ($msg,$out_r) = @_;
  push @$out_r, '[postcompile/'.$$.']: '.$msg;
}

my $shadow_warning = undef;

sub store_shadow($\@) {
  my ($warn,$out_r) = @_;
  if (defined $shadow_warning) {
    warning('unprocessed shadow_warning:', @$out_r);
    push @$out_r, $shadow_warning;
  }
  $shadow_warning = $warn;
}

my $last_pushed_related = 0;

sub push_loc_and_related($$\@\@) {
  my ($location_info,$message,$related_r,$out_r) = @_;
  if (defined $location_info) {
    push @$out_r, $location_info;
  }
  push @$out_r, $message;
  $last_pushed_related = scalar(@$related_r);

  # show related info (include-notes behind rest)
  foreach (@$related_r) { if (not /included\sfrom/) { push @$out_r, $_; } }
  foreach (@$related_r) { if (/included\sfrom/) { push @$out_r, $_; } }
}

sub drop_last_pushed_relateds(\@) {
  my ($out_r) = @_;
  if ($last_pushed_related>0) {
    my $before_related = scalar(@$out_r) - $last_pushed_related - 1;
    $before_related>=0 || die "impossible (out_r-elements=".scalar(@$out_r)."; last_pushed_related=$last_pushed_related)";
    @$out_r = @$out_r[0 .. $before_related];
  }
}

sub included_from_here($) {
  my ($loc) = @_;
  return $loc.': note: included from here';
}

sub suppress($\@$) {
  my ($curr,$out_r,$as) = @_;
  if ($show_suppressed_lines==1) {
    warning('suppressed['.$as.']: '.$curr,@$out_r);
  }
  return undef;
}

sub is_system_or_builtin($) {
  my ($file) = @_;
  return (($file =~ $reg_user_include) or ($file eq '<built-in>') or ($file =~ $reg_HEADERLIBS_include));
}

sub suppress_shadow_warning_for($) {
  my ($file) = @_;
  return is_system_or_builtin($file);
}

sub compare_message_location($$) {
  my ($a,$b) = @_;
  # $a and $b are refs to array [filename location message]
  my $cmp = $$a[0] cmp $$b[0]; # compare filenames
  if ($cmp==0) {
    my ($la,$lb) = (undef,undef);
    if ($$a[1] =~ /^[0-9]+/o) { $la = $&; }
    if ($$b[1] =~ /^[0-9]+/o) { $lb = $&; }
    $cmp = $la <=> $lb; # compare line numbers
  }
  return $cmp;
}
sub compare_located_messages($$) {
  my ($a,$b) = @_;
  # $a and $b are refs to array [filename location message]
  my $cmp = compare_message_location($a,$b);
  if ($cmp==0) { $cmp = $$a[2] cmp $$b[2]; } # compare message
  return $cmp;
}

sub grep_loop_comments($\@) {
  my ($source,$hits_r) = @_;
  open(SRC,'<'.$source) || die "can't read '$source' (Reason: $!)";
  my $line;
  my $linenr = 1;
  while (defined($line=<SRC>)) {
    if ($line =~ /(LOOP_VECTORIZED|IRRELEVANT_LOOP)/o) {
      my $msg = $&.$';
      chomp($msg);
      push @$hits_r, [ $source, $linenr, $msg ];
    }
    $linenr++;
  }
  close(SRC);
}

sub numericCompilerVersion($\$) {
  my ($versionStr,$err_r) = @_;
  my $vs = $versionStr;
  $vs =~ s/\.//og; # remove dots
  if ($vs =~ /[^0-9]/o) { # check for invalid characters
    $$err_r = "version contains invalid character: '$&'";
    return undef;
  }

  my $versionNum = int($vs);
  if ($versionNum<1) {
    $$err_r = "Invalid compiler version '$versionStr'";
    return undef;
  }

  while ($versionNum<443) { # for lowest allowed version see ../Makefile@ALLOWED_gcc_VERSIONS
    # assume shortened compiler version was specified + extend it:
    # e.g. '6.3' -> 630
    #      '10'  -> 1000
    #      '4'  -> 4000 (this would be gcc 40.x)
    $versionNum = $versionNum * 10;
  }

  return $versionNum;
}

my $compilerVersion       = 'unknown'; # passed via CLI
my $compilerVersionNumber = undef; # numeric compiler version (e.g. 443 or 720 for 4.4.3 resp. 7.2.0)

sub calcVersionNumber() {
  # calculate version-number of used compiler (called if specified)
  die if defined $compilerVersionNumber;
  my $cerr = undef;
  $compilerVersionNumber = numericCompilerVersion($compilerVersion,$cerr);
  if (defined $cerr) {
    die "cannot interpret compiler version-number passed via CLI (Reason: $cerr)";
  }
}

sub compiler_allowed_by($\$) {
  my ($exclusions,$err_r) = @_;
  # checks if 'exclusions' allow global 'compilerVersionNumber'.
  # return 0 if excluded, 1 if allowed.
  # 'err_r' is set in case of errors.

  die if not defined $compilerVersionNumber;

  my @conditions = split /\s*,\s*/,$exclusions;

  my $compilerExcluded = 0;
 CHECK: foreach my $cond (@conditions) {
    my ($exclude,$rest);
    if ($cond =~ /^!/o) {
      $exclude = 1;
      $cond = $';
      ($exclude,$rest) = (1,$');
    }
    else {
      ($exclude,$rest) = (0,$cond);
    }

    $rest =~ s/\s//;

    print "cond='$cond' exclude=$exclude\n";

    my $cond_matches = 1;
    my $op = '';
  VERS: while ($rest ne '') {
      if ($rest =~ /^([<>=]*)([^<>=])/o) {
        ($op,$rest) = ($1,$2.$');
      }

      my $specVers;
      if ($rest =~ /[<>=]/o) {
        ($specVers,$rest) = ($`,$&.$');
      }
      else {
        ($specVers,$rest) = ($rest,'');
      }

      my $cerr = undef;
      my $version = numericCompilerVersion($specVers,$cerr);
      if (defined $cerr) {
        $$err_r = $cerr.' (in "'.$specVers.'")';
        return 0;
      }
      if (not defined $version) { die "internal error: version undefined, but no error reported"; }

      # document new operators in ./vectorize.README
      if    ($op eq ''  ) { if ($compilerVersionNumber != $version) { $cond_matches = 0; } }
      elsif ($op eq '<' ) { if ($compilerVersionNumber >= $version) { $cond_matches = 0; } }
      elsif ($op eq '>' ) { if ($compilerVersionNumber <= $version) { $cond_matches = 0; } }
      elsif ($op eq '<=') { if ($compilerVersionNumber >  $version) { $cond_matches = 0; } }
      elsif ($op eq '>=') { if ($compilerVersionNumber <  $version) { $cond_matches = 0; } }
      else {
        $$err_r = "unknown exclude-operator '$op' (in '$cond')";
        return 0;
      }

      print "cond_matches=$cond_matches rest='$rest'\n";
    }

    if ($cond_matches == $exclude) {
      $compilerExcluded = 1;
      last CHECK;
    }
  }

  print "compilerExcluded=$compilerExcluded\n";
  return $compilerExcluded ? 0 : 1;
}


sub parse_expected_vectorizations($\$) {
  my ($str,$err_r) = @_;

  # 'str' is rest of line behind 'LOOP_VECTORIZED'.
  # Expected syntax is described in ./vectorize.README@LOOP_VECTORIZED
  # 'err_r' gets set in case of error (caller abort when set!)
  # result is number of expected vectorizations (depends on global 'compilerVersionNumber')

  my $expected_vectorizations = 0;
  my $condition_matched       = 0;

  while (not $condition_matched and not defined $$err_r) {
    my $seen_num = 1;
    if ($str =~ /^\s*=([0-9\*\|]+)/o) { # str begins with '=<num>' or '=<num>'['|<num>']+
      my ($num,$rest) = ($1,$');
      if ($num =~ /\*/o) {
        $$err_r = "vectorization count may not contain '*' (specify explicit numbers conditionally, e.g. '=3[!>=950]=1')";
      }
      else {
        if ($num =~ /\|/o) {
          my @num_list = split /\|/, $num;
          foreach my $n (@num_list) {
            my $nn = int($n);
            if (not $nn) {
              if (not $n =~ /0/o) {
                $$err_r = "invalid count '$n' in '$str'";
              }
              else {
                $$err_r = "zero vectorization count is not useful here (consider using IRRELEVANT_LOOP)";
              }
            }
          }
          $expected_vectorizations = \@num_list;
        }
        else {
          $expected_vectorizations = int($num);
          if (not $expected_vectorizations and not $num =~ /0/o) {
            $$err_r = "invalid count '$num' in '$str'";
          }
        }
      }
      $str = $rest;
    }
    else { # no '=<num>'-prefix
      if (not $expected_vectorizations) { # first <count> -> default to 1
        $expected_vectorizations = 1;
      }
      else {
        $seen_num = 0;
      }
    }

    if ($str =~ /\s*\[([^\]]+)\]/o) { # condition follows
      # if not 'seen_num' => accept following condition as alternative (OR-operation)
      my ($cond, $rest) = ($1,$');
      if ($condition_matched) {
        $$err_r = "unexpected condition '$cond' (did you forget a '=count'-prefix?)";
      }
      else {
        my $allowed = compiler_allowed_by($cond,$$err_r);
        if (defined $$err_r) {
          ;
        }
        else {
          if ($allowed) { $condition_matched = 1; }
        }
      }
      $str = $rest;
    }
    else {
      # no condition follows -> always fulfilled
      $condition_matched = 1;
      if (not $seen_num) { $expected_vectorizations = 0; } # no condition after no count => expect failure for all compilers that did not match before
    }
  }

  return $expected_vectorizations;
}

my $trace_vectorization_success_messages = 0; # set to 1 to log messages which trigger "succeeded vectorization"
sub is_successfulVectorizationMsg($) {
  my ($msg) = @_;
  if ($msg =~ /loop\svectorized/io) {
    if ($msg =~ /not\svectorized/io) { die; return 0; }          # @@@ if this never happens -> remove
    if ($msg =~ /basic\sblock\svectorized/io) { die; return 0; } # @@@ if this never happens -> remove
    return 1;
  }
  return 0;
}

sub is_notWorthToVectorizeMsg($) {
  my ($msg) = @_;
  if ($msg =~ /cost.*worth/io) {
    return 1;
  }
  return 0;
}

sub is_loopNote($) {
  my ($msg) = @_;
  if ($msg =~ /(loop|vectorized|misalign|versioning|optab|SLP|ssa-name)/io) { return 1; }

  if ($msg =~ /bad\s(data)/io) { return 1; }
  if ($msg =~ /basic\s(block)/io) { return 1; }
  if ($msg =~ /not\s(supported)/io) { return 1; }
  if ($msg =~ /step\s(unknown)/io) { return 1; }
  if ($msg =~ /original\s(stmt)/io) { return 1; }
  if ($msg =~ /cycle\s(pattern)/io) { return 1; }
  if ($msg =~ /determine\s(dependence)/io) { return 1; }
  if ($msg =~ /consecutive\s(access)/io) { return 1; }
  if ($msg =~ /vector\s(alignment)/io) { return 1; }
  if ($msg =~ /clobbers\s(memory)/io) { return 1; }
  if ($msg =~ /cost.*worth/io) { return 1; }
  if ($msg =~ /use\s(not)\s(simple)/io) { return 1; }
  if ($msg =~ /no\s(array)\s(mode)/io) { return 1; }

  if ($msg =~ /(unsupported|unknown|unexpected)\s(pattern)/io) { return 1; }

  if ($msg =~ /interleaved.*(store)/io) { return 1; }
  if ($msg =~ /vector.*(cost)/io) { return 1; }
  if ($msg =~ /group.*too\s(large)/io) { return 1; }
  if ($msg =~ /unary\/binary\/ternary/io) { return 1; }

  return 0;
}

sub parse_input(\@) {
  my ($out_r) = @_;
  my @related = ();
  my $location_info = undef;

  my @warnout = ();
  my @errout = ();
  my @loopnote = (); # contains notes about loop-optimizations (refs to array [file line msg])

  my $did_show_previous = 0;
  my $is_error          = 0;
  my $curr_out_r = \@warnout;

 LINE: while (defined($_=<STDIN>)) {
    chomp;
    my $filter_current = 0;

    next LINE if $_ eq '';

    if ($_ =~ $reg_file) {
      my ($file,$line,$msg) = ($1,$2,$');

      if ($msg =~ $reg_is_warning) {
        my $warn_text = $';

        if ($warn_text =~ $reg_shadow_warning) {
          if (not $' =~ /this/) { # don't store this warnings (no location follows)
            store_shadow($_,@warnout);
            $_ = suppress($_,@warnout, 'shadow-this');
          }
          elsif (suppress_shadow_warning_for($file)) {
            $_ = suppress($_,@warnout, 'shadow');
            # $location_info = undef;
          }
        }
        elsif ($warn_text =~ $reg_shadow_location) {
          if (not defined $shadow_warning) { warning('no shadow_warning seen',@warnout); }
          else {
            if (suppress_shadow_warning_for($file)) {
              # don't warn about /usr/include or <built-in> shadowing
              $_ = suppress($_,@warnout, 'shadowed');
              @related = ();
              $location_info = undef;
            }
            else {
              if (defined $location_info) {
                push @warnout, $location_info;
                $location_info = undef;
              }
              push @warnout, $shadow_warning;
            }
            $shadow_warning = undef;
          }
        }
        elsif ($warn_text =~ $reg_unknown_gcc_diagnostic) {
          # filter warnings about unknown "pragma GCC diagnostic push/pop"
          die if not defined $compilerVersionNumber;
          if ($compilerVersionNumber<=447) {
            $filter_current = 1; # ignore this warning
          }
          # otherwise show (affects 4.5.x; 4.6.x accepts push/pop)
        }
        else {
          my $warn_is = Weffpp_warning_wanted($file,$line,$warn_text);
          if ($warn_is == $UNWANTED) {
            $filter_current = 1; # ignore this warning
          }
          elsif ($warn_is == $WANTED_NO_RELATED) {
            @related = (); # drop related messages
          }
          # rebuild warning (Weffpp_warning_wanted might modify the message)
          $_ = $file.':'.$line.': warning: '.$warn_text;
        }
        $is_error = 0;
        $curr_out_r = \@warnout;
      }
      elsif ($msg =~ $reg_is_error) {
        $is_error = 1;
        $curr_out_r = \@errout;
      }
      elsif ($msg =~ $reg_is_instantiated) {
        push @related, $_;
        $_ = suppress($_,@warnout, 'instanciated');
      }
      elsif ($msg =~ $reg_is_required) {
        push @related, $_;
        $_ = suppress($_,@warnout, 'required');
      }
      elsif ($msg =~ $reg_is_note) {
        my $note_after = 1; # 0->message follows note; 1->note follows message

        my $note = $';
        if (is_loopNote($note)==1) {
          push @loopnote, [ $file, $line, $msg ];
          $_ = suppress($_,@warnout, 'loop-note');
        }
        else {
          if ($note_after==1) {
            if ($did_show_previous==0) {
              if (scalar(@loopnote)>0) {
                push @loopnote, [ $file, $line, 'ASSUMING_LOOPNOTE [FIXME]: '.$msg ];
                $_ = suppress($_,@warnout, 'loop-note');
              }
              else {
                $_ = suppress($_,@warnout, 'note-of-nonshown');
              }
            }
            else {
              if ($msg =~ /in\sexpansion\sof\smacro/o) {
                drop_last_pushed_relateds(@$curr_out_r);
              }
            }
          }
          else {
            # note leads message -> store in related
            push @related, $_;
            $_ = suppress($_,@warnout, 'note');
          }
        }
      }
      elsif ($msg =~ $reg_is_optimizerMsg) { # message from optimized (gcc 9.1++)
        my $note = $';
        if (is_loopNote($note)==1) {
          push @loopnote, [ $file, $line, $msg ];
          $_ = suppress($_,@warnout, 'loop-note');
        }
        else {
          $_ = suppress($_,@warnout, 'optimizerMsg-of-nonshown');
        }
      }
    }
    elsif ($_ =~ $reg_location or $_ =~ $reg_location2 or $_ =~ $reg_location3) {
      $location_info = $_;
      $_ = suppress($_,@warnout, 'location');
    }
    elsif ($_ =~ $reg_inlined_from) {
      $_ = $2.': note: '.$1;
      push @related, $_;
      $_ = suppress($_,@warnout, 'inlined');
    }
    elsif ($_ =~ $reg_included) {
      push @related, included_from_here($1);
      $_ = suppress($_,@warnout, 'included');
    }
    elsif ($_ =~ $reg_clang_dirt) {
      $_ = undef;
    }
    elsif ($_ =~ $reg_file_noline) {
      if (/^(cc1plus|g\+\+|clang):.*error/o) {
        ; # display normally
      }
      else {
        # push @related, included_from_here($1);
        push @related, $_;
        $_ = suppress($_,@warnout, 'file-level-comment');
      }
    }
    elsif (@related) {
      if ($_ =~ $reg_included2) {
        push @related, included_from_here($1);
        $_ = suppress($_,@warnout, 'included2');
      }
    }

    if (defined $_) {
      if ($filter_current==0) {
        if ($show_suppressed_lines==1) { warning('passing: '.$_, @warnout); }
        push_loc_and_related($location_info,$_,@related,@$curr_out_r);
        $did_show_previous = 1;

        if (($is_error==1) and ($stop_after_first_error==1)) {
          @warnout = (); # drop warnings
          last LINE;
        }
      }
      else {
        die "can't filter errors (Error=$_)" if ($is_error==1);
        if ($show_filtered_lines==1) { warning('filtered: '.$_, @$curr_out_r); }
        $did_show_previous = 0;
      }
      $location_info = undef;
      @related = ();
    }
  }

  @$out_r = @errout;
  if ($hide_warnings==0) { push @$out_r, @warnout; }

  if ($dump_loop_optimization or $check_loop_optimization) {
    # description of vectorization checks available in SOURCE_TOOLS/vectorize.README

    my @loopmsg = ();
    foreach my $vref (@loopnote) {
      my ($file,$line,$msg) = @$vref;
      my $boring = 0;
      if ($msg =~ /completely\sunrolled/o) { $boring = 1; }
      if (not $boring) { push @loopmsg, $vref; }
    }

    # sort messages and count + replace duplicates
    @loopmsg = sort { compare_located_messages($a,$b); } @loopmsg;
    {
      my @undup_loopmsg = ();
      my $seenDups = 0;
      push @loopmsg, [ 'x', 0, '' ]; # append sentinel (forces proper counter for last message)
      foreach (@loopmsg) {
        my $prev = pop @undup_loopmsg;
        if (defined $prev) {
          if (compare_located_messages($prev,$_)!=0) {
            if ($seenDups>0) { $$prev[2] = $$prev[2].' ['.($seenDups+1).'x]'; } # append counter
            push @undup_loopmsg, $prev;
            $seenDups = 0;
          }
          else { $seenDups++; }
        }
        push @undup_loopmsg, $_;
      }
      pop @undup_loopmsg;
      @loopmsg = @undup_loopmsg;
    }

    my %loopfiles = map { $$_[0] => 1; } @loopmsg; # list of files for which loop-messages were found

    if ($dump_loop_optimization) {
      if (scalar(@loopmsg)) {
        push @$out_r,  "---------------------------------------- dump_loop_optimization";
        foreach my $vref (@loopmsg) {
          my ($file,$line,$msg) = @$vref;
          if ($dump_loop_optimization==1 or is_successfulVectorizationMsg($msg)==1) {
            push @$out_r, "$file:$line: note: $msg";
          }
        }
        push @$out_r,  "---------------------------------------- dump_loop_optimization [end]";
        if ((not $check_loop_optimization) and ($REQ_check_loop_optimization==1) and ($dump_loop_optimization != 2)) {
          my $vref = $loopmsg[0];
          my $loc = $$vref[0].':'.$$vref[1];
          push @$out_r,  "$loc: Warning: vectorization checks disabled in this file (need at least one vectorization-comment in ${REQ_checked_file})";
        }
      }
    }
    if ($check_loop_optimization || ($dump_loop_optimization==2)) {
      my @comments = ();

      if (defined $checked_file) {
        grep_loop_comments($checked_file, @comments);

        # read additional comments from included files:
        delete $loopfiles{$checked_file};
        foreach (keys %loopfiles) {
          my @xtra_comments = ();
          grep_loop_comments($_, @xtra_comments);
          push @comments, @xtra_comments;
        }
      }

      my $dump_comments = 0; # dump comments for debug purposes (should be disabled)
      if ($dump_loop_optimization and $dump_comments) {
        if (scalar(@comments)) {
          push @$out_r,  "---------------------------------------- dump_detected_comments";
          foreach my $cref (@comments) {
            my ($file,$line,$msg) = @$cref;
            push @$out_r, "$file:$line: $msg";
          }
          push @$out_r,  "---------------------------------------- dump_detected_comments [end]";
        }
      }

      my $errors = 0;
      foreach my $cref (@comments) {
        my $loc  = $$cref[0].':'.$$cref[1];
        my $cmsg = $$cref[2];

        my $was_vectorized          = 0;
        my $worthless_vectorization = 0;
        foreach my $vref (@loopmsg) {
          if (compare_message_location($cref,$vref)==0) {
            my $vmsg = $$vref[2];
            if (is_successfulVectorizationMsg($vmsg)==1) {
              if ($trace_vectorization_success_messages==1) {
                push @$out_r, "$loc: Note: vectorized message='$vmsg'";
              }
              if ($vmsg =~ /\[([0-9]+)x\]/o) { # vectorized multiple times (e.g. in template)
                $was_vectorized = $1;
              }
              else {
                $was_vectorized = 1;
              }
            }
            elsif (is_notWorthToVectorizeMsg($vmsg)==1) {
              $worthless_vectorization = 1;
            }
          }
        }
        if ($cmsg =~ /^LOOP_VECTORIZED/o) {
          my $rest   = $';
          my $errmsg = undef;

          # my $expected_vectorizations = compiler_allowed_by($rest,$errmsg); # check for exclusions of specific compiler versions
          my $expected_vectorizations = parse_expected_vectorizations($rest,$errmsg);

          if (defined $errmsg) {
            push @$out_r, "$loc: Error: in vectorize-condition: $errmsg";
            $errors++;
          }
          else {
            my $possibilities  = undef;
            if (ref $expected_vectorizations eq 'ARRAY') { # multiple vectorization counts will be accepted
              my $found_matching = undef;
              foreach my $ev (@$expected_vectorizations) {
                if ($ev==$was_vectorized) { $found_matching = $ev; }
              }
              $possibilities = join('|', @$expected_vectorizations);
              if (defined $found_matching) {
                $expected_vectorizations = $found_matching;
              }
              else {
                $expected_vectorizations = 0;
              }
            }

            if (not $was_vectorized) {
              if ($worthless_vectorization==1) {
                push @$out_r, "$loc: Error: possible but worthless loop vectorization rejected -> use IRRELEVANT_LOOP (compiler version=$compilerVersion)";
                $errors++;
              }
              elsif ((defined $possibilities) or ($expected_vectorizations>0)) {
                push @$out_r, "$loc: Error: loop vectorization failed (compiler version=$compilerVersion)";
                $errors++;
              }
              # otherwise silently handled like IRRELEVANT_LOOP (meant to handle '=0<cond>')
            }
            else {
              if ($expected_vectorizations==0) { # compiler excluded, but vectorization occurred
                push @$out_r, "$loc: Error: loop vectorization succeeded $was_vectorized"."x (but compiler version '$compilerVersion' excluded by condition)";
                $errors++;
              }
              elsif ((defined $possibilities) or ($expected_vectorizations>0)) { # check number of vectorizations matches
                if ($expected_vectorizations!=$was_vectorized) {
                  my $specified = defined $possibilities ? $possibilities : $expected_vectorizations;
                  push @$out_r, "$loc: Error: vectorization count mismatch (specified=$specified, found=$was_vectorized)";
                  $errors++;
                }
              }
            }
          }
        }
      }

      foreach my $vref (@loopmsg) {
        my $vmsg = $$vref[2];
        if (is_successfulVectorizationMsg($vmsg)==1) {
          my $loc  = $$vref[0].':'.$$vref[1];
          if ($trace_vectorization_success_messages==1) {
            push @$out_r, "$loc: Note: vectorized message='$vmsg'";
          }
          my $has_loop_comment = undef;
          foreach my $cref (@comments) {
            if (compare_message_location($cref,$vref)==0) {
              $has_loop_comment = $$cref[2];
            }
          }
          if (not defined $has_loop_comment) {
            push @$out_r, "$loc: Warning: Unchecked optimized loop";
            push @$out_r, "$loc: Note: Comment with LOOP_VECTORIZED to force check";
            push @$out_r, "$loc: Note: Comment with IRRELEVANT_LOOP to hide this warning";
          }
        }
      }
      if ($errors) { $exitcode = 1; }
    }
  }
}

sub die_usage($) {
  my ($err) = @_;
  print "Usage: postcompile.pl [Options] sourcefile\n";
  print "Used as compilation output filter for C/C++\n";
  print "Options:\n";
  print "    --no-warnings                 hide warnings (plus related messages)\n";
  print "    --only-first-error            show only first error\n";
  print "    --original                    pass-through\n";
  print "    --show-useless-Weff++         do not suppress useless -Weff++ warnings\n";
  print "    --hide-Noncopyable-advices    do not advice about using Noncopyable\n";
  print "    --compiler=version            needed for --check-loop-optimization (version e.g. '4.9.1')\n";
  print "    --dump-loop-optimization      dump (most) notes related to loop vectorization\n";
  print "    --loop-optimization-candi     show candidates for loop vectorization-check\n";
  print "    --check-loop-optimization     if sourcefile is listed in \$ARBHOME/SOURCE_TOOLS/vectorized.source,\n";
  print "                                  => check commented loops have been vectorized\n";

  if (defined $err) {
    die "Error in postcompile.pl: $err";
  }
}

sub set_dump_loop_optimization($) {
  my ($val) = @_;
  die if $val==0;
  if ($dump_loop_optimization==0) {
    $dump_loop_optimization = $val;
  }
  else {
    die "dump_loop_optimization already set (old=$dump_loop_optimization; new=$val)";
    # may e.g. happen when using --dump-loop-optimization AND --loop-optimization-candi
  }
}

sub main() {
  my $args = scalar(@ARGV);
  my $pass_through = 0;
  my $sourcefile = undef;
  while ($args>0) {
    my $arg = shift(@ARGV);
    if    ($arg eq '--no-warnings') { $hide_warnings = 1; }
    elsif ($arg eq '--only-first-error') { $stop_after_first_error = 1; }
    elsif ($arg eq '--original') { $pass_through = 1; }
    elsif ($arg eq '--show-useless-Weff++') { $filter_Weffpp = 0; }
    elsif ($arg eq '--hide-Noncopyable-advices') { $filter_Weffpp_copyable = 1; }
    elsif ($arg eq '--dump-loop-optimization') { set_dump_loop_optimization(1); }
    elsif ($arg eq '--loop-optimization-candi') { set_dump_loop_optimization(2); }
    elsif ($arg eq '--check-loop-optimization') { $check_loop_optimization = 1; }
    elsif ($arg =~ /^--compiler=/o) { $compilerVersion = $'; calcVersionNumber(); }
    elsif (not defined $sourcefile) { $sourcefile = $arg; }
    else {
      die_usage("Unknown argument '$arg'");
    }
    $args--;
  }

  defined $sourcefile || die_usage("missing argument 'sourcefile'");
  if (not -f $sourcefile) { die "Unknown sourcefile '$sourcefile'"; }

  eval {
    if ($pass_through==1) {
      while (defined($_=<STDIN>)) { print $_; }
    }
    else {
      my @out = ();
      detect_needLoopCheck($sourcefile);
      parse_input(@out);
      store_shadow(undef,@out);
      foreach (@out) { print "$_\n"; }
    }
  };
  my $err = $@;
  save_from_NC();
  if ($err) { die $err; }
}
main();
exit $exitcode;
