Added a warning system to Lua

The warning system is just a way for Lua to emit warnings, messages
to the programmer that do not interfere with the running program.

10 files changed, 173 insertions, 15 deletions

diff --git a/lapi.c b/lapi.c
index 2d10bb73..0f0166e5 100644
--- a/lapi.c
+++ b/lapi.c
@@ -1267,6 +1267,24 @@ LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud) {
 }
 
 
+void lua_setwarnf (lua_State *L, lua_WarnFunction f, void *ud) {
+  lua_lock(L);
+  G(L)->ud_warn = ud;
+  G(L)->warnf = f;
+  lua_unlock(L);
+}
+
+
+void lua_warning (lua_State *L, const char *msg) {
+  lua_WarnFunction wf = G(L)->warnf;
+  lua_lock(L);
+  if (wf != NULL)
+    wf(&G(L)->ud_warn, msg);
+  lua_unlock(L);
+}
+
+
+
 LUA_API void *lua_newuserdatauv (lua_State *L, size_t size, int nuvalue) {
   Udata *u;
   lua_lock(L);
diff --git a/lauxlib.c b/lauxlib.c
index 769586b6..abf923f8 100644
--- a/lauxlib.c
+++ b/lauxlib.c
@@ -986,9 +986,35 @@ static int panic (lua_State *L) {
 }
 
 
+/*
+** checks whether 'message' ends with end-of-line
+** (and therefore is the last part of a warning)
+*/
+static int islast (const char *message) {
+  size_t len = strlen(message);
+  return (len > 0 && message[len - 1] == '\n');
+}
+
+
+/*
+** Emit a warning. If '*pud' is NULL, previous message was to be
+** continued by the current one.
+*/
+static void warnf (void **pud, const char *message) {
+  if (*pud == NULL)  /* previous message was not the last? */
+    lua_writestringerror("%s", message);
+  else  /* start a new warning */
+    lua_writestringerror("Lua warning: %s", message);
+  *pud = (islast(message)) ? pud : NULL;
+}
+
+
 LUALIB_API lua_State *luaL_newstate (void) {
   lua_State *L = lua_newstate(l_alloc, NULL);
-  if (L) lua_atpanic(L, &panic);
+  if (L) {
+    lua_atpanic(L, &panic);
+    lua_setwarnf(L, warnf, L);
+  }
   return L;
 }
 
diff --git a/lbaselib.c b/lbaselib.c
index 7c0ebfec..26683a1d 100644
--- a/lbaselib.c
+++ b/lbaselib.c
@@ -43,6 +43,13 @@ static int luaB_print (lua_State *L) {
 }
 
 
+static int luaB_warn (lua_State *L) {
+  const char *msg = luaL_checkstring(L, 1);
+  lua_warning(L, msg);
+  return 0;
+}
+
+
 #define SPACECHARS	" \f\n\r\t\v"
 
 static const char *b_str2int (const char *s, int base, lua_Integer *pn) {
@@ -482,6 +489,7 @@ static const luaL_Reg base_funcs[] = {
   {"pairs", luaB_pairs},
   {"pcall", luaB_pcall},
   {"print", luaB_print},
+  {"warn", luaB_warn},
   {"rawequal", luaB_rawequal},
   {"rawlen", luaB_rawlen},
   {"rawget", luaB_rawget},
diff --git a/lstate.c b/lstate.c
index 04a9e064..b3e9ec60 100644
--- a/lstate.c
+++ b/lstate.c
@@ -365,6 +365,8 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
   L->next = NULL;
   g->frealloc = f;
   g->ud = ud;
+  g->warnf = NULL;
+  g->ud_warn = NULL;
   g->mainthread = L;
   g->seed = luai_makeseed(L);
   g->gcrunning = 0;  /* no GC while building state */
diff --git a/lstate.h b/lstate.h
index b069b390..f3793256 100644
--- a/lstate.h
+++ b/lstate.h
@@ -231,6 +231,8 @@ typedef struct global_State {
   TString *tmname[TM_N];  /* array with tag-method names */
   struct Table *mt[LUA_NUMTAGS];  /* metatables for basic types */
   TString *strcache[STRCACHE_N][STRCACHE_M];  /* cache for strings in API */
+  lua_WarnFunction warnf;  /* warning function */
+  void *ud_warn;         /* auxiliary data to 'warnf' */
 } global_State;
 
 
diff --git a/ltests.c b/ltests.c
index 0b5ed90b..5ea8b080 100644
--- a/ltests.c
+++ b/ltests.c
@@ -63,10 +63,36 @@ static void pushobject (lua_State *L, const TValue *o) {
 }
 
 
+static void badexit (void) {
+  /* avoid assertion failures when exiting */
+  l_memcontrol.numblocks = l_memcontrol.total = 0;
+  exit(EXIT_FAILURE);
+}
+
+
 static int tpanic (lua_State *L) {
   fprintf(stderr, "PANIC: unprotected error in call to Lua API (%s)\n",
                    lua_tostring(L, -1));
-  return (exit(EXIT_FAILURE), 0);  /* do not return to Lua */
+  return (badexit(), 0);  /* do not return to Lua */
+}
+
+
+static int islast (const char *message) {
+  size_t len = strlen(message);
+  return (len > 0 && message[len - 1] == '\n');
+}
+
+
+static void warnf (void **pud, const char *msg) {
+  if (*pud == NULL)  /* continuation line? */
+    printf("%s", msg);  /* print it */
+  else if (msg[0] == '*')  /* expected warning? */
+    printf("Expected Lua warning: %s", msg + 1);  /* print without the star */
+  else {  /* a real warning; should not happen during tests */
+    fprintf(stderr, "Warning in test mode (%s), aborting...\n", msg);
+    badexit();
+  }
+  *pud = islast(msg) ? pud : NULL;
 }
 
 
@@ -1405,6 +1431,10 @@ static int runC (lua_State *L, lua_State *L1, const char *pc) {
       const char *msg = getstring;
       printf("%s\n", msg);
     }
+    else if EQ("warning") {
+      const char *msg = getstring;
+      lua_warning(L1, msg);
+    }
     else if EQ("pushbool") {
       lua_pushboolean(L1, getnum);
     }
@@ -1743,6 +1773,7 @@ static void checkfinalmem (void) {
 int luaB_opentests (lua_State *L) {
   void *ud;
   lua_atpanic(L, &tpanic);
+  lua_setwarnf(L, &warnf, L);
   atexit(checkfinalmem);
   lua_assert(lua_getallocf(L, &ud) == debug_realloc);
   lua_assert(ud == cast_voidp(&l_memcontrol));
diff --git a/lua.h b/lua.h
index 95ce5a2e..a6f8268b 100644
--- a/lua.h
+++ b/lua.h
@@ -126,6 +126,13 @@ typedef int (*lua_Writer) (lua_State *L, const void *p, size_t sz, void *ud);
 typedef void * (*lua_Alloc) (void *ud, void *ptr, size_t osize, size_t nsize);
 
 
+/*
+** Type for warning functions
+*/
+typedef void (*lua_WarnFunction) (void **pud, const char *msg);
+
+
+
 
 /*
 ** generic extra include file
@@ -300,6 +307,13 @@ LUA_API int (lua_isyieldable) (lua_State *L);
 
 
 /*
+** Warning-related functions
+*/
+LUA_API void (lua_setwarnf) (lua_State *L, lua_WarnFunction f, void *ud);
+LUA_API void (lua_warning)  (lua_State *L, const char *msg);
+
+
+/*
 ** garbage-collection function and options
 */
 
diff --git a/manual/manual.of b/manual/manual.of
index 044bd09c..196ea1ef 100644
--- a/manual/manual.of
+++ b/manual/manual.of
@@ -1795,7 +1795,7 @@ Functions with any detectable difference
 (different behavior, different definition) are always different.
 Functions created at different times but with no detectable differences
 may be classified as equal or not
-(depending on internal cashing details).
+(depending on internal caching details).
 
 You can change the way that Lua compares tables and userdata
 by using the @idx{__eq} metamethod @see{metatable}.
@@ -4033,6 +4033,16 @@ for the @Q{newindex} event @see{metatable}.
 
 }
 
+@APIEntry{int lua_setiuservalue (lua_State *L, int index, int n);|
+@apii{1,0,-}
+
+Pops a value from the stack and sets it as
+the new @id{n}-th user value associated to the
+full userdata at the given index.
+Returns 0 if the userdata does not have that value.
+
+}
+
 @APIEntry{void lua_setmetatable (lua_State *L, int index);|
 @apii{1,0,-}
 
@@ -4066,13 +4076,13 @@ If @id{index} @N{is 0}, then all stack elements are removed.
 
 }
 
-@APIEntry{int lua_setiuservalue (lua_State *L, int index, int n);|
-@apii{1,0,-}
+@APIEntry{void lua_setwarnf (lua_State *L, lua_WarnFunction f, void *ud);|
+@apii{0,0,-}
 
-Pops a value from the stack and sets it as
-the new @id{n}-th user value associated to the
-full userdata at the given index.
-Returns 0 if the userdata does not have that value.
+Sets the @x{warning function} to be used by Lua to emit warnings
+@see{lua_WarnFunction}.
+The @id{ud} parameter initializes the slot @id{pud} passed to
+the warning function.
 
 }
 
@@ -4335,6 +4345,30 @@ Returns the version number of this core.
 }
 
 @APIEntry{
+typedef void (*lua_WarnFunction) (void **pud, const char *msg);|
+
+The type of @x{warning function}s, called by Lua to emit warnings.
+The first parameter is the address of a writable slot,
+constant for a given Lua state and
+initialized by @Lid{lua_setwarnf}.
+The second parameter is the warning message.
+This function should assume that
+a message not ending with an end-of-line will be
+continued by the message in the next call.
+
+}
+
+@APIEntry{
+void lua_warning (lua_State *L, const char *msg);|
+@apii{0,0,-}
+
+Emits a warning with the given message.
+A message not ending with an end-of-line should be
+continued in another call to this function.
+
+}
+
+@APIEntry{
 typedef int (*lua_Writer) (lua_State *L,
                            const void* p,
                            size_t sz,
@@ -4345,7 +4379,7 @@ Every time it produces another piece of chunk,
 @Lid{lua_dump} calls the writer,
 passing along the buffer to be written (@id{p}),
 its size (@id{sz}),
-and the @id{data} parameter supplied to @Lid{lua_dump}.
+and the @id{ud} parameter supplied to @Lid{lua_dump}.
 
 The writer returns an error code:
 @N{0 means} no errors;
@@ -6261,6 +6295,12 @@ The current value of this variable is @St{Lua 5.4}.
 
 }
 
+@LibEntry{warn (message)|
+
+Emits a warning with the given message.
+
+}
+
 @LibEntry{xpcall (f, msgh [, arg1, @Cdots])|
 
 This function is similar to @Lid{pcall},
diff --git a/testes/all.lua b/testes/all.lua
index 84ba80a6..bde4195e 100644
--- a/testes/all.lua
+++ b/testes/all.lua
@@ -5,8 +5,8 @@
 
 local version = "Lua 5.4"
 if _VERSION ~= version then
-  io.stderr:write("\nThis test suite is for ", version, ", not for ", _VERSION,
-    "\nExiting tests\n")
+  warn(string.format(
+   "This test suite is for %s, not for %s\nExiting tests\n", version, _VERSION))
   return
 end
 
@@ -190,11 +190,10 @@ assert(dofile('verybig.lua', true) == 10); collectgarbage()
 dofile('files.lua')
 
 if #msgs > 0 then
-  print("\ntests not performed:")
+  warn("*tests not performed:\n  ")
   for i=1,#msgs do
-    print(msgs[i])
+    warn(msgs[i]); warn("\n  ")
   end
-  print()
 end
 
 -- no test module should define 'debug'
@@ -220,6 +219,10 @@ local _G, showmem, print, format, clock, time, difftime, assert, open =
 local fname = T and "time-debug.txt" or "time.txt"
 local lasttime
 
+
+warn("*This is "); warn("an expected"); warn(" warning\n")
+warn("*This is"); warn(" another one\n")
+
 if not usertests then
   -- open file with time of last performed test
   local f = io.open(fname)
diff --git a/testes/api.lua b/testes/api.lua
index 6f35e132..b4d63866 100644
--- a/testes/api.lua
+++ b/testes/api.lua
@@ -111,6 +111,20 @@ do   -- testing 'rotate'
   tcheck(t, {10, 20, 30, 40})
 end
 
+
+-- testing warnings
+T.testC([[
+  warning "*This "
+  warning "warning "
+  warning "should be in a"
+  warning " single line
+"
+  warning "*This should be "
+  warning "another warning
+"
+]])
+
+
 -- testing message handlers
 do
   local f = T.makeCfunc[[