From 7a7f0168d5ea434e302741492f44de80f794cffa Mon Sep 17 00:00:00 2001
From: Xavier Delaruelle <xavier.delaruelle@cea.fr>
Date: Sun, 26 Jun 2022 22:07:36 +0200
Subject: [PATCH] Move linter output report in dedicated proc

Create displayLinterOutput procedure to handle the parsing and output of
each linter messages. Current code handles specific output from Nagelfar
linter and generic error report for other programs set as linter.
---
 tcl/report.tcl.in | 67 +++++++++++++++++++++++++++++++++++++++++++++++
 tcl/subcmd.tcl.in | 61 ++++--------------------------------------
 2 files changed, 72 insertions(+), 56 deletions(-)

diff --git a/tcl/report.tcl.in b/tcl/report.tcl.in
index 00f84c9e..6dcdd4e3 100644
--- a/tcl/report.tcl.in
+++ b/tcl/report.tcl.in
@@ -1651,6 +1651,73 @@ proc displayConfig {val env_var {asked 0} {trans {}} {locked 0}} {
    return $val$defby
 }
 
+# report linter output as error/warning messages
+proc displayLinterOutput {linter output} {
+   switch -- $linter {
+      nagelfar {
+         # parsing linter output
+         set report_list {}
+         foreach line [split $output \n] {
+            set firstword [string range $line 0 [string first { } $line]-1]
+            switch -- $firstword {
+               Checking - Parsing {}
+               Line {
+                  # add message of previous line if any
+                  if {[info exists msg]} {
+                     lappend report_list $msg
+                  }
+
+                  # extract information from message line
+                  set colidx [string first : $line]
+                  set linenum [string trimleft [string range $line 5\
+                     $colidx-1]]
+                  set severity [string index $line $colidx+2]
+                  switch -- $severity {
+                     W {
+                        set severity WARNING
+                        set sgrkey wa
+                        set raisecnt 0
+                     }
+                     E {
+                        set severity ERROR
+                        set sgrkey er
+                        set raisecnt 1
+                     }
+                     default {
+                        set severity NOTICE
+                        set sgrkey in
+                        set raisecnt 0
+                     }
+                  }
+                  set msg [string range $line $colidx+4 end]
+
+                  # start recorded message properties
+                  lappend report_list $linenum $severity $sgrkey $raisecnt
+               }
+               default {
+                  # this line is continuing message started previously
+                  append msg \n[string trimleft $line]
+               }
+            }
+         }
+         # add message of last line if any
+         if {[info exists msg]} {
+            lappend report_list $msg
+            unset msg
+         }
+
+         # report messages
+         foreach {linenum severity sgrkey raisecnt mesg} $report_list {
+            reportError $mesg 0 "[format %-7s $severity] line $linenum"\
+               $sgrkey $raisecnt
+         }
+      }
+      default {
+         reportError $output
+      }
+   }
+}
+
 proc reportMlUsage {} {
    reportVersion
    report {Usage: ml [options] [command] [args ...]
diff --git a/tcl/subcmd.tcl.in b/tcl/subcmd.tcl.in
index e6c46762..54371c9e 100644
--- a/tcl/subcmd.tcl.in
+++ b/tcl/subcmd.tcl.in
@@ -2549,6 +2549,9 @@ proc cmdModuleLint {args} {
       knerror {No Tcl linter program configured}
    }
 
+   # extract linter program name
+   set linter [file rootname [file tail [lindex [getConf tcl_linter] 0]]]
+
    foreach mod $args {
       lassign [getPathToModule $mod] modfile modname modnamevr
       # error message has already been produced if mod not found or forbidden
@@ -2564,62 +2567,8 @@ proc cmdModuleLint {args} {
             knerror $errMsg
          }
 
-         # parsing linter output
-         set report_list {}
-         foreach line [split $out \n] {
-            set firstword [string range $line 0 [string first { } $line]-1]
-            switch -- $firstword {
-               Checking - Parsing {}
-               Line {
-                  # add message of previous line if any
-                  if {[info exists msg]} {
-                     lappend report_list $msg
-                  }
-
-                  # extract information from message line
-                  set colidx [string first : $line]
-                  set linenum [string trimleft [string range $line 5\
-                     $colidx-1]]
-                  set severity [string index $line $colidx+2]
-                  switch -- $severity {
-                     W {
-                        set severity WARNING
-                        set sgrkey wa
-                        set raisecnt 0
-                     }
-                     E {
-                        set severity ERROR
-                        set sgrkey er
-                        set raisecnt 1
-                     }
-                     default {
-                        set severity NOTICE
-                        set sgrkey in
-                        set raisecnt 0
-                     }
-                  }
-                  set msg [string range $line $colidx+4 end]
-
-                  # start recorded message properties
-                  lappend report_list $linenum $severity $sgrkey $raisecnt
-               }
-               default {
-                  # this line is continuing message started previously
-                  append msg \n[string trimleft $line]
-               }
-            }
-         }
-         # add message of last line if any
-         if {[info exists msg]} {
-            lappend report_list $msg
-            unset msg
-         }
-
-         # report messages
-         foreach {linenum severity sgrkey raisecnt mesg} $report_list {
-            reportError $mesg 0 "[format %-7s $severity] line $linenum"\
-               $sgrkey $raisecnt
-         }
+         # report linting messages
+         displayLinterOutput $linter $out
 
          # report all lint messages for this modulefile
          reportMsgRecord "Linting [getModuleDesignation $msgrecid {} 2]"