console compiler: exit with error status on serious warnings

Non-serious warnings do not cause an error exit status. We can enable that
behavior later with a flag if desired.

Issue #1373

Author: cgay

documentation/release-notes/source/2022.1.rst

@@ -32,6 +32,10 @@ Compiler
   the :file:`sbin` (static executables binary) directory of the
   personal-root.
 
+* To aid in scripting tasks the ``dylan-compiler`` and ``dylan-environment``
+  executables now return an error exit status if any serious warnings are
+  generated.
+
 Tooling
 =======
 

sources/environment/commands/build.dylan

@@ -205,7 +205,7 @@ end command-line build;
 
 define method do-execute-command
     (context :: <environment-context>, command :: <build-project-command>)
- => ()
+ => (exit-code :: <integer>)
   let project = command.%project | context.context-project;
   let messages = if (command.%verbose?) #"internal" else #"external" end;
   let stream = context.context-server.server-output-stream;
@@ -217,7 +217,14 @@ define method do-execute-command
       else
         curry(note-build-progress, context, #f)
       end;
+  let serious-warnings? = #f;
   block ()
+    local method warning-callback (warning)
+            note-compiler-warning(context, warning);
+            if (instance?(warning, <serious-compiler-warning-object>))
+              serious-warnings? := #t;
+            end;
+          end;
     if (build-project
           (project,
            process-subprojects?: command.%subprojects?,
@@ -228,7 +235,7 @@ define method do-execute-command
            output:               command.%output,
            dispatch-coloring:    command.%dispatch-coloring,
            progress-callback:    progress-callback,
-           warning-callback:     curry(note-compiler-warning, context),
+           warning-callback:     warning-callback,
            error-handler:        curry(compiler-condition-handler, context)))
       if (command.%link?)
         let project-context = context.context-project-context;
@@ -247,10 +254,16 @@ define method do-execute-command
            progress-callback:    progress-callback,
            error-handler:        curry(compiler-condition-handler, context))
       end;
-      message(context, "Build of '%s' completed", project.project-name)
+      message(context, "Build of '%s' completed", project.project-name);
+      if (serious-warnings?)
+        $error-exit-code
+      else
+        $success-exit-code
+      end
     else
-      message(context, "Build of '%s' aborted",   project.project-name)
-    end;
+      message(context, "Build of '%s' aborted",   project.project-name);
+      $error-exit-code
+    end
   exception (error :: <file-system-error>)
     command-error("%s", error)
   end

sources/environment/commands/command-line.dylan

@@ -8,6 +8,9 @@ Warranty:  Distributed WITHOUT WARRANTY OF ANY KIND
 
 /// Useful constants
 
+define constant $success-exit-code = 0;
+define constant $error-exit-code   = -1;
+
 define constant $whitespace                 = #[' ', '\t', '\n'];
 define constant $quote-characters           = #['\'', '"'];
 

sources/environment/commands/module.dylan

@@ -86,7 +86,9 @@ define module command-lines
          command-line-loop,
          display-command-prompt,
          execute-command-line,
-         execute-server-command;
+         execute-server-command,
+         $error-exit-code,
+         $success-exit-code;
 
   // Command line user interface
   export command-line-choose-file,

sources/environment/console/command-line.dylan

@@ -77,9 +77,9 @@ end class <basic-main-command>;
 
 define method execute-main-command
     (context :: <server-context>, command :: <basic-main-command>)
- => (status-code :: <integer>)
-  local method run
-            (class :: subclass(<command>), #rest arguments) => ()
+ => (exit-code :: <integer>)
+  local method run (class :: subclass(<command>), #rest arguments)
+                => (#rest values)
           let command = apply(make, class, server: context, arguments);
           execute-command(command)
         end method run;
@@ -96,21 +96,25 @@ define method execute-main-command
     run(<open-project-command>, file: filename)
   end;
   let build? = command.%build?;
+  let exit-code = #f;
   if (build? | command.%compile?)
-    run(<build-project-command>,
-        clean?:      command.%clean?,
-        link?:       #f,
-        release?:    command.%release?,
-        verbose?:    command.%verbose?,
-        subprojects: command.%subprojects?,
-        output:      begin
-                       let output = make(<stretchy-object-vector>);
-                       if (command.%assemble?) add!(output, #"assembler") end;
-                       if (command.%dfm?) add!(output, #"dfm") end;
-                       if (command.%harp?) add!(output, #"harp") end;
-                       output
-                     end,
-        dispatch-coloring: command.%dispatch-coloring)
+    // The build command returns an error status for serious warnings. This
+    // makes it possible for scripting to abort on serious warnings.
+    exit-code
+      := run(<build-project-command>,
+             clean?:      command.%clean?,
+             link?:       #f,
+             release?:    command.%release?,
+             verbose?:    command.%verbose?,
+             subprojects: command.%subprojects?,
+             output:      begin
+                            let output = make(<stretchy-object-vector>);
+                            if (command.%assemble?) add!(output, #"assembler") end;
+                            if (command.%dfm?) add!(output, #"dfm") end;
+                            if (command.%harp?) add!(output, #"harp") end;
+                            output
+                          end,
+             dispatch-coloring: command.%dispatch-coloring);
   end;
   if (build? | command.%link?)
     let target = command.%target;
@@ -123,7 +127,7 @@ define method execute-main-command
         subprojects: command.%subprojects?,
         unify?:      command.%unify?)
   end;
-  $success-exit-code;
+  exit-code | $success-exit-code
 end method execute-main-command;
 
 define method execute-main-loop

sources/environment/console/start.dylan

@@ -6,8 +6,6 @@ Copyright:    Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
 License:      See License.txt in this distribution for details.
 Warranty:     Distributed WITHOUT WARRANTY OF ANY KIND
 
-define constant $success-exit-code = 0;
-define constant $error-exit-code   = -1;
 
 define function main
     (arguments :: <string>)