Bug: suspended '__le' metamethod can give wrong result

bugs

@@ -3376,6 +3376,73 @@ patch = [[
 }
 
 
+Bug{
+what = [[suspended '__le' metamethod can give wrong result]],
+report = [[Eric Zhong, 2015/04/07]],
+since = [[5.2]],
+fix = nil,
+
+example = [[
+mt = {__le = function (a,b) coroutine.yield("yield"); return a.x <= b.x end}
+t1 = setmetatable({x=1}, mt)
+t2 = {x=2}
+co = coroutine.wrap(function (a,b) return t2 <= t1 end)
+co()
+print(co())   --> true  (should be false)
+]],
+
+patch = [[
+--- lstate.h    2015/03/04 13:31:21     2.120
++++ lstate.h    2015/04/08 16:30:40
+@@ -94,6 +94,7 @@
+ #define CIST_YPCALL    (1<<4)  /* call is a yieldable protected call */
+ #define CIST_TAIL      (1<<5)  /* call was tail called */
+ #define CIST_HOOKYIELD (1<<6)  /* last hook called yielded */
++#define CIST_LEQ       (1<<7)  /* using __lt for __le */
+
+ #define isLua(ci)      ((ci)->callstatus & CIST_LUA)
+
+
+--- lvm.c       2015/03/30 15:45:01     2.238
++++ lvm.c       2015/04/09 15:30:13
+@@ -275,9 +275,14 @@
+     return l_strcmp(tsvalue(l), tsvalue(r)) <= 0;
+   else if ((res = luaT_callorderTM(L, l, r, TM_LE)) >= 0)  /* first try 'le' */
+     return res;
+-  else if ((res = luaT_callorderTM(L, r, l, TM_LT)) < 0)  /* else try 'lt' */
+-    luaG_ordererror(L, l, r);
+-  return !res;
++  else {  /* try 'lt': */
++    L->ci->callstatus |= CIST_LEQ;  /* mark it is doing 'lt' for 'le' */
++    res = luaT_callorderTM(L, r, l, TM_LT);
++    L->ci->callstatus ^= CIST_LEQ;  /* clear mark */
++    if (res < 0)
++      luaG_ordererror(L, l, r);
++    return !res;  /* result is negated */
++  }
+ }
+
+@@ -542,11 +547,11 @@
+     case OP_LE: case OP_LT: case OP_EQ: {
+       int res = !l_isfalse(L->top - 1);
+       L->top--;
+-      /* metamethod should not be called when operand is K */
+-      lua_assert(!ISK(GETARG_B(inst)));
+-      if (op == OP_LE &&  /* "<=" using "<" instead? */
+-          ttisnil(luaT_gettmbyobj(L, base + GETARG_B(inst), TM_LE)))
+-        res = !res;  /* invert result */
++      if (ci->callstatus & CIST_LEQ) {  /* "<=" using "<" instead? */
++        lua_assert(op == OP_LE);
++        ci->callstatus ^= CIST_LEQ;  /* clear mark */
++        res = !res;  /* negate result */
++      }
+       lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_JMP);
+       if (res != GETARG_A(inst))  /* condition failed? */
+         ci->u.l.savedpc++;  /* skip jump instruction */
+]]
+}
+
+
 --[=[
 Bug{
 what = [[ ]],

lstate.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.h,v 2.119 2014/10/30 18:53:28 roberto Exp roberto $
+** $Id: lstate.h,v 2.120 2015/03/04 13:31:21 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -94,6 +94,7 @@ typedef struct CallInfo {
 #define CIST_YPCALL	(1<<4)	/* call is a yieldable protected call */
 #define CIST_TAIL	(1<<5)	/* call was tail called */
 #define CIST_HOOKYIELD	(1<<6)	/* last hook called yielded */
+#define CIST_LEQ	(1<<7)  /* using __lt for __le */
 
 #define isLua(ci)	((ci)->callstatus & CIST_LUA)
 

lvm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 2.237 2015/03/07 19:30:16 roberto Exp roberto $
+** $Id: lvm.c,v 2.238 2015/03/30 15:45:01 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -262,7 +262,12 @@ int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {
 
 
 /*
-** Main operation less than or equal to; return 'l <= r'.
+** Main operation less than or equal to; return 'l <= r'. If it needs
+** a metamethod and there is no '__le', try '__lt', based on
+** l <= r iff !(r < l) (assuming a total order). If the metamethod
+** yields during this substitution, the continuation has to know
+** about it (to negate the result of r<l); bit CIST_LEQ in the call
+** status keeps that information.
 */
 int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) {
   int res;
@@ -273,11 +278,16 @@ int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) {
     return luai_numle(nl, nr);
   else if (ttisstring(l) && ttisstring(r))  /* both are strings? */
     return l_strcmp(tsvalue(l), tsvalue(r)) <= 0;
-  else if ((res = luaT_callorderTM(L, l, r, TM_LE)) >= 0)  /* first try 'le' */
+  else if ((res = luaT_callorderTM(L, l, r, TM_LE)) >= 0)  /* try 'le' */
     return res;
-  else if ((res = luaT_callorderTM(L, r, l, TM_LT)) < 0)  /* else try 'lt' */
+  else {  /* try 'lt': */
-    luaG_ordererror(L, l, r);
+    L->ci->callstatus |= CIST_LEQ;  /* mark it is doing 'lt' for 'le' */
-  return !res;
+    res = luaT_callorderTM(L, r, l, TM_LT);
+    L->ci->callstatus ^= CIST_LEQ;  /* clear mark */
+    if (res < 0)
+      luaG_ordererror(L, l, r);
+    return !res;  /* result is negated */
+  }
 }
 
 
@@ -542,11 +552,11 @@ void luaV_finishOp (lua_State *L) {
     case OP_LE: case OP_LT: case OP_EQ: {
       int res = !l_isfalse(L->top - 1);
       L->top--;
-      /* metamethod should not be called when operand is K */
+      if (ci->callstatus & CIST_LEQ) {  /* "<=" using "<" instead? */
-      lua_assert(!ISK(GETARG_B(inst)));
+        lua_assert(op == OP_LE);
-      if (op == OP_LE &&  /* "<=" using "<" instead? */
+        ci->callstatus ^= CIST_LEQ;  /* clear mark */
-          ttisnil(luaT_gettmbyobj(L, base + GETARG_B(inst), TM_LE)))
+        res = !res;  /* negate result */
-        res = !res;  /* invert result */
+      }
       lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_JMP);
       if (res != GETARG_A(inst))  /* condition failed? */
         ci->u.l.savedpc++;  /* skip jump instruction */