Added control messages to warnings

Added the concept of control messages to the warning system, plus the
implementation of the controls "@on"/"@off" to turn warnings on/off.
Moreover, the warning system in the test library adds some other
controls to ease the test of warnings.

9 files changed, 161 insertions, 49 deletions

diff --git a/lauxlib.c b/lauxlib.c
index e3a7a577..ba1980b7 100644
--- a/lauxlib.c
+++ b/lauxlib.c
@@ -1002,29 +1002,43 @@ static int panic (lua_State *L) {
 
 
 /*
-** Emit a warning. '*previoustocont' signals whether previous message
-** was to be continued by the current one.
+** Emit a warning. '*warnstate' means:
+** 0 - warning system is off;
+** 1 - ready to start a new message;
+** 2 - previous message is to be continued.
 */
 static void warnf (void *ud, const char *message, int tocont) {
-  int *previoustocont = (int *)ud;
-  if (!*previoustocont)  /* previous message was the last? */
+  int *warnstate = (int *)ud;
+  if (*warnstate != 2 && !tocont && *message == '@') {  /* control message? */
+    if (strcmp(message + 1, "off") == 0)
+      *warnstate = 0;
+    else if (strcmp(message + 1, "on") == 0)
+      *warnstate = 1;
+    return;
+  }
+  else if (*warnstate == 0)  /* warnings off? */
+    return;
+  if (*warnstate == 1)  /* previous message was the last? */
     lua_writestringerror("%s", "Lua warning: ");  /* start a new warning */
   lua_writestringerror("%s", message);  /* write message */
-  if (!tocont)  /* is this the last part? */
+  if (tocont)  /* not the last part? */
+    *warnstate = 2;  /* to be continued */
+  else {  /* last part */
     lua_writestringerror("%s", "\n");  /* finish message with end-of-line */
-  *previoustocont = tocont;
+    *warnstate = 1;  /* ready to start a new message */
+  }
 }
 
 
 LUALIB_API lua_State *luaL_newstate (void) {
   lua_State *L = lua_newstate(l_alloc, NULL);
   if (L) {
-    int *previoustocont;  /* space for warning state */
+    int *warnstate;  /* space for warning state */
     lua_atpanic(L, &panic);
-    previoustocont = (int *)lua_newuserdatauv(L, sizeof(int), 0);
+    warnstate = (int *)lua_newuserdatauv(L, sizeof(int), 0);
     luaL_ref(L, LUA_REGISTRYINDEX);  /* make sure it won't be collected */
-    *previoustocont = 0;  /* next message starts a new warning */
-    lua_setwarnf(L, warnf, previoustocont);
+    *warnstate = 1;  /* next message starts a new warning */
+    lua_setwarnf(L, warnf, warnstate);
   }
   return L;
 }
diff --git a/lbaselib.c b/lbaselib.c
index 4724e759..c68e6d38 100644
--- a/lbaselib.c
+++ b/lbaselib.c
@@ -48,9 +48,9 @@ static int luaB_warn (lua_State *L) {
   luaL_checkstring(L, 1);  /* at least one argument */
   for (i = 2; i <= n; i++)
     luaL_checkstring(L, i);  /* make sure all arguments are strings */
-  for (i = 1; i <= n; i++)  /* compose warning */
+  for (i = 1; i < n; i++)  /* compose warning */
     lua_warning(L, lua_tostring(L, i), 1);
-  lua_warning(L, "", 0);  /* close warning */
+  lua_warning(L, lua_tostring(L, n), 0);  /* close warning */
   return 0;
 }
 
diff --git a/ltests.c b/ltests.c
index 21273ea9..fd55fc31 100644
--- a/ltests.c
+++ b/ltests.c
@@ -79,32 +79,62 @@ static int tpanic (lua_State *L) {
 
 /*
 ** Warning function for tests. Fist, it concatenates all parts of
-** a warning in buffer 'buff'. Then:
-** - messages starting with '#' are shown on standard output (used to
-** test explicit warnings);
-** - messages containing '@' are stored in global '_WARN' (used to test
-** errors that generate warnings);
+** a warning in buffer 'buff'. Then, it has three modes:
+** - 0.normal: messages starting with '#' are shown on standard output;
 ** - other messages abort the tests (they represent real warning
 ** conditions; the standard tests should not generate these conditions
-** unexpectedly).
+** unexpectedly);
+** - 1.allow: all messages are shown;
+** - 2.store: all warnings go to the global '_WARN';
 */
 static void warnf (void *ud, const char *msg, int tocont) {
   static char buff[200] = "";  /* should be enough for tests... */
+  static int onoff = 1;
+  static int mode = 0;  /* start in normal mode */
+  static int lasttocont = 0;
+  if (!lasttocont && !tocont && *msg == '@') {  /* control message? */
+    if (buff[0] != '\0')
+      badexit("Control warning during warning: %s\naborting...\n", msg);
+    if (strcmp(msg + 1, "off") == 0)
+      onoff = 0;
+    else if (strcmp(msg + 1, "on") == 0)
+      onoff = 1;
+    else if (strcmp(msg + 1, "normal") == 0)
+      mode = 0;
+    else if (strcmp(msg + 1, "allow") == 0)
+      mode = 1;
+    else if (strcmp(msg + 1, "store") == 0)
+      mode = 2;
+    else
+      badexit("Invalid control warning in test mode: %s\naborting...\n", msg);
+    return;
+  }
+  lasttocont = tocont;
   if (strlen(msg) >= sizeof(buff) - strlen(buff))
     badexit("%s", "warnf-buffer overflow");
   strcat(buff, msg);  /* add new message to current warning */
   if (!tocont) {  /* message finished? */
-    if (buff[0] == '#')  /* expected warning? */
-      printf("Expected Lua warning: %s\n", buff);  /* print it */
-    else if (strchr(buff, '@') != NULL) {  /* warning for test purposes? */
-      lua_State *L = cast(lua_State *, ud);
-      lua_unlock(L);
-      lua_pushstring(L, buff);
-      lua_setglobal(L, "_WARN");  /* assign message to global '_WARN' */
-      lua_lock(L);
-    }
-    else  /* a real warning; should not happen during tests */
-      badexit("Unexpected warning in test mode: %s\naborting...\n", buff);
+    switch (mode) {
+      case 0: {  /* normal */
+        if (buff[0] != '#' && onoff)  /* unexpected warning? */
+          badexit("Unexpected warning in test mode: %s\naborting...\n", buff);
+        /* else */ /* FALLTHROUGH */
+      }
+      case 1: {  /* allow */
+        if (onoff)
+          fprintf(stderr, "Lua warning: %s\n", buff);  /* print warning */
+        break;
+      }
+      case 2: {  /* store */
+        lua_State *L = cast(lua_State *, ud);
+        lua_unlock(L);
+        lua_pushstring(L, buff);
+        lua_setglobal(L, "_WARN");  /* assign message to global '_WARN' */
+        lua_lock(L);
+        buff[0] = '\0';  /* prepare buffer for next warning */
+        break;
+      }
+    }
     buff[0] = '\0';  /* prepare buffer for next warning */
   }
 }
diff --git a/lua.c b/lua.c
index fa534ba2..d13e203b 100644
--- a/lua.c
+++ b/lua.c
@@ -73,6 +73,7 @@ static void print_usage (const char *badoption) {
   "  -l name  require library 'name' into global 'name'\n"
   "  -v       show version information\n"
   "  -E       ignore environment variables\n"
+  "  -q       turn warnings off\n"
   "  --       stop handling options\n"
   "  -        stop handling options and execute stdin\n"
   ,
@@ -259,14 +260,18 @@ static int collectargs (char **argv, int *first) {
       case '\0':  /* '-' */
         return args;  /* script "name" is '-' */
       case 'E':
-        if (argv[i][2] != '\0')  /* extra characters after 1st? */
+        if (argv[i][2] != '\0')  /* extra characters? */
           return has_error;  /* invalid option */
         args |= has_E;
         break;
+      case 'q':
+        if (argv[i][2] != '\0')  /* extra characters? */
+          return has_error;  /* invalid option */
+        break;
       case 'i':
         args |= has_i;  /* (-i implies -v) *//* FALLTHROUGH */
       case 'v':
-        if (argv[i][2] != '\0')  /* extra characters after 1st? */
+        if (argv[i][2] != '\0')  /* extra characters? */
           return has_error;  /* invalid option */
         args |= has_v;
         break;
@@ -289,7 +294,8 @@ static int collectargs (char **argv, int *first) {
 
 
 /*
-** Processes options 'e' and 'l', which involve running Lua code.
+** Processes options 'e' and 'l', which involve running Lua code, and
+** 'q', which also affects the state.
 ** Returns 0 if some code raises an error.
 */
 static int runargs (lua_State *L, char **argv, int n) {
@@ -297,15 +303,21 @@ static int runargs (lua_State *L, char **argv, int n) {
   for (i = 1; i < n; i++) {
     int option = argv[i][1];
     lua_assert(argv[i][0] == '-');  /* already checked */
-    if (option == 'e' || option == 'l') {
-      int status;
-      const char *extra = argv[i] + 2;  /* both options need an argument */
-      if (*extra == '\0') extra = argv[++i];
-      lua_assert(extra != NULL);
-      status = (option == 'e')
-               ? dostring(L, extra, "=(command line)")
-               : dolibrary(L, extra);
-      if (status != LUA_OK) return 0;
+    switch (option) {
+      case 'e':  case 'l': {
+        int status;
+        const char *extra = argv[i] + 2;  /* both options need an argument */
+        if (*extra == '\0') extra = argv[++i];
+        lua_assert(extra != NULL);
+        status = (option == 'e')
+                 ? dostring(L, extra, "=(command line)")
+                 : dolibrary(L, extra);
+        if (status != LUA_OK) return 0;
+        break;
+      }
+      case 'q':
+        lua_warning(L, "@off", 0);  /* no warnings */
+        break;
     }
   }
   return 1;
diff --git a/manual/manual.of b/manual/manual.of
index ff27a7d4..8c71c613 100644
--- a/manual/manual.of
+++ b/manual/manual.of
@@ -4370,6 +4370,8 @@ The third parameter is a boolean that
 indicates whether the message is
 to be continued by the message in the next call.
 
+See @Lid{warn} for more details about warnings.
+
 }
 
 @APIEntry{
@@ -4380,6 +4382,8 @@ Emits a warning with the given message.
 A message in a call with @id{tocont} true should be
 continued in another call to this function.
 
+See @Lid{warn} for more details about warnings.
+
 }
 
 @APIEntry{
@@ -6355,6 +6359,16 @@ The current value of this variable is @St{Lua 5.4}.
 Emits a warning with a message composed by the concatenation
 of all its arguments (which should be strings).
 
+By convention,
+a one-piece message starting with @Char{@At}
+is intended to be a @emph{control message},
+which is a message to the warning system itself.
+In particular, the standard warning function in Lua
+recognizes the control messages @St{@At{}off},
+to stop the emission of warnings,
+and @St{@At{}on}, to (re)start the emission;
+it ignores unknown control messages.
+
 }
 
 @LibEntry{xpcall (f, msgh [, arg1, @Cdots])|
@@ -7293,7 +7307,7 @@ stored as the first capture, and therefore has @N{number 1};
 the character matching @St{.} is captured with @N{number 2},
 and the part matching @St{%s*} has @N{number 3}.
 
-As a special case, the empty capture @T{()} captures
+As a special case, the capture @T{()} captures
 the current string position (a number).
 For instance, if we apply the pattern @T{"()aa()"} on the
 string @T{"flaaap"}, there will be two captures: @N{3 and 5}.
@@ -7858,7 +7872,6 @@ they are compared as @x{unsigned integers}.
 
 }
 
-
 @sect2{iolib| @title{Input and Output Facilities}
 
 The I/O library provides two different styles for file manipulation.
@@ -8150,7 +8163,6 @@ There are three available modes:
 @item{@St{line}| line buffering.}
 }
 
-}
 For the last two cases,
 @id{size} is a hint for the size of the buffer, in bytes.
 The default is an appropriate size.
@@ -8708,6 +8720,7 @@ The options are:
 @item{@T{-i}| enters interactive mode after running @rep{script};}
 @item{@T{-v}| prints version information;}
 @item{@T{-E}| ignores environment variables;}
+@item{@T{-q}| turn warnings off;}
 @item{@T{--}| stops handling options;}
 @item{@T{-}| executes @id{stdin} as a file and stops handling options.}
 }
@@ -8733,12 +8746,13 @@ setting the values of
 @Lid{package.path} and @Lid{package.cpath}
 with the default paths defined in @id{luaconf.h}.
 
-All options are handled in order, except @T{-i} and @T{-E}.
+The options @T{-e}, @T{-l}, and @T{-q} are handled in
+the order they appear.
 For instance, an invocation like
 @verbatim{
-$ lua -e'a=1' -e 'print(a)' script.lua
+$ lua -e 'a=1' -llib1 script.lua
 }
-will first set @id{a} to 1, then print the value of @id{a},
+will first set @id{a} to 1, then require the library @id{lib1},
 and finally run the file @id{script.lua} with no arguments.
 (Here @T{$} is the shell prompt. Your prompt may be different.)
 
@@ -8798,7 +8812,8 @@ has a metamethod @idx{__tostring},
 the interpreter calls this metamethod to produce the final message.
 Otherwise, the interpreter converts the error object to a string
 and adds a stack traceback to it.
-Warnings are simply printed in the standard error output.
+When warnings are on,
+they are simply printed in the standard error output.
 
 When finishing normally,
 the interpreter closes its main Lua state
diff --git a/testes/all.lua b/testes/all.lua
index bf27f106..5d698d4b 100644
--- a/testes/all.lua
+++ b/testes/all.lua
@@ -209,6 +209,10 @@ if #msgs > 0 then
   warn("#tests not performed:\n  ", m, "\n")
 end
 
+warn("@off")
+warn("******** THIS WARNING SHOULD NOT APPEAR **********")
+warn("******** THIS WARNING ALSO SHOULD NOT APPEAR **********")
+warn("@on")
 print("(there should be two warnings now)")
 warn("#This is ", "an expected", " warning")
 warn("#This is", " another one")
diff --git a/testes/api.lua b/testes/api.lua
index f6915c3e..4f9d6717 100644
--- a/testes/api.lua
+++ b/testes/api.lua
@@ -977,6 +977,7 @@ assert(t[7] == nil)
 
 -------------------------------------------------------------------------
 do   -- testing errors during GC
+  warn("@off")
   collectgarbage("stop")
   local a = {}
   for i=1,20 do
@@ -994,6 +995,7 @@ do   -- testing errors during GC
   collectgarbage()
   assert(A == 10)  -- number of normal collections
   collectgarbage("restart")
+  warn("@on")
 end
 -------------------------------------------------------------------------
 -- test for userdata vals
diff --git a/testes/gc.lua b/testes/gc.lua
index 9ea054c1..6bdc98ca 100644
--- a/testes/gc.lua
+++ b/testes/gc.lua
@@ -369,6 +369,7 @@ if T then
     s[n] = i
   end
 
+  warn("@store")
   collectgarbage()
   assert(string.find(_WARN, "error in __gc metamethod"))
   assert(string.match(_WARN, "@(.-)@") == "expected")
@@ -383,6 +384,7 @@ if T then
   for i = 1, 10 do assert(s[i]) end
 
   getmetatable(u).__gc = nil
+  warn("@normal")
 
 end
 print '+'
@@ -475,9 +477,11 @@ end
 
 -- errors during collection
 if T then
+  warn("@store")
   u = setmetatable({}, {__gc = function () error "@expected error" end})
   u = nil
   collectgarbage()
+  warn("@normal")
 end
 
 
@@ -645,7 +649,7 @@ end
 
 -- create several objects to raise errors when collected while closing state
 if T then
-  local error, assert, find = error, assert, string.find
+  local error, assert, find, warn = error, assert, string.find, warn
   local n = 0
   local lastmsg
   local mt = {__gc = function (o)
@@ -659,7 +663,9 @@ if T then
     else
       assert(lastmsg == _WARN)  -- subsequent error messages are equal
     end
+    warn("@store")
     error"@expected warning"
+    warn("@normal")
   end}
   for i = 10, 1, -1 do
     -- create object and preserve it until the end
diff --git a/testes/main.lua b/testes/main.lua
index b224b54e..0ef4822d 100644
--- a/testes/main.lua
+++ b/testes/main.lua
@@ -221,6 +221,28 @@ assert(string.find(getoutput(), "error calling 'print'"))
 RUN('echo "io.stderr:write(1000)\ncont" | lua -e "require\'debug\'.debug()" 2> %s', out)
 checkout("lua_debug> 1000lua_debug> ")
 
+-- test warnings
+RUN('echo "io.stderr:write(1); warn[[XXX]]" | lua -q 2> %s', out)
+checkout("1")
+
+prepfile[[
+warn("@allow")               -- unknown control, ignored
+warn("@off", "XXX", "@off")  -- these are not control messages
+warn("@off")                 -- this one is
+warn("@on", "YYY", "@on")    -- not control, but warn is off
+warn("@off")                 -- keep it off
+warn("@on")                  -- restart warnings
+warn("", "@on")              -- again, no control, real warning
+warn("@on")                  -- keep it "started"
+warn("Z", "Z", "Z")          -- common warning
+]]
+RUN('lua %s 2> %s', prog, out)
+checkout[[
+Lua warning: @offXXX@off
+Lua warning: @on
+Lua warning: ZZZ
+]]
+
 -- test many arguments
 prepfile[[print(({...})[30])]]
 RUN('lua %s %s > %s', prog, string.rep(" a", 30), out)
@@ -355,8 +377,15 @@ if T then   -- test library?
   NoRun("not enough memory", "env MEMLIMIT=100 lua")
 
   -- testing 'warn'
+  warn("@store")
   warn("@123", "456", "789")
   assert(_WARN == "@123456789")
+
+  warn("zip", "", " ", "zap")
+  assert(_WARN == "zip zap")
+  warn("ZIP", "", " ", "ZAP")
+  assert(_WARN == "ZIP ZAP")
+  warn("@normal")
 end
 
 do