Reimplement `block_given?`; ref #3841

Make `block_given?` to search for the top of the scope first.
The top of the scope means either:

* the top method body
* the enclosing class body
* the top-level

The special case is the method defined by `define_method` with a
block as in #3841. In cases like this, the method body (given by
a block) is not considered as the top of the scope. You need to use
`&block` in the block parameter if you want to know if a block is
given to the method.

This commit also changes the behavior of `MRB_PROC_SCOPE` flag.
Now it is only set if the `proc` is either a class body or a method
body defined in Ruby. It is no longer set for a block that given to
`define_method`.

src/class.c

@@ -436,7 +436,6 @@ mrb_define_method_raw(mrb_state *mrb, struct RClass *c, mrb_sym mid, struct RPro
   k = kh_put(mt, mrb, h, mid);
   kh_value(h, k) = p;
   if (p) {
-    p->flags |= MRB_PROC_SCOPE;
     p->c = NULL;
     mrb_field_write_barrier(mrb, (struct RBasic*)c, (struct RBasic*)p);
     MRB_PROC_SET_TARGET_CLASS(p, c);
@@ -453,6 +452,7 @@ mrb_define_method_id(mrb_state *mrb, struct RClass *c, mrb_sym mid, mrb_func_t f
 
   p = mrb_proc_new_cfunc(mrb, func);
   MRB_PROC_SET_TARGET_CLASS(p, c);
+  p->flags |= MRB_PROC_SCOPE;
   mrb_define_method_raw(mrb, c, mid, p);
   mrb_gc_arena_restore(mrb, ai);
 }

src/kernel.c

@@ -134,25 +134,32 @@ mrb_obj_id_m(mrb_state *mrb, mrb_value self)
 static mrb_value
 mrb_f_block_given_p_m(mrb_state *mrb, mrb_value self)
 {
-  mrb_callinfo *ci = mrb->c->ci;
+  mrb_callinfo *ci = &mrb->c->ci[-1];
+  mrb_callinfo *cibase = mrb->c->cibase;
   mrb_value *bp;
   struct RProc *p;
 
-  bp = ci->stackent + 1;
-  ci--;
-  if (ci <= mrb->c->cibase) {
+  if (ci <= cibase) {
+    /* toplevel does not have block */
     return mrb_false_value();
   }
-  /* block_given? called within block; check upper scope */
   p = ci->proc;
+  /* search method/class/module proc */
   while (p) {
     if (MRB_PROC_SCOPE_P(p)) break;
     p = p->upper;
   }
-  /* top-level does not have block slot (always false) */
   if (p == NULL) return mrb_false_value();
-  if (MRB_PROC_ENV_P(p)) {
-    struct REnv *e = MRB_PROC_ENV(p);
+  /* search ci corresponding to proc */
+  while (cibase < ci) {
+    if (ci->proc == p) break;
+    ci--;
+  }
+  if (ci == cibase) {
+    return mrb_false_value();
+  }
+  else if (ci->env) {
+    struct REnv *e = ci->env;
     int bidx;
 
     /* top-level does not have block slot (always false) */
@@ -165,9 +172,15 @@ mrb_f_block_given_p_m(mrb_state *mrb, mrb_value self)
       return mrb_false_value();
     bp = &e->stack[bidx];
   }
-  else if (ci && ci->argc > 0) {
+  else {
+    bp = ci[1].stackent+1;
+    if (ci->argc >= 0) {
       bp += ci->argc;
     }
+    else {
+      bp++;
+    }
+  }
   if (mrb_nil_p(*bp))
     return mrb_false_value();
   return mrb_true_value();
@@ -1175,7 +1188,7 @@ mrb_local_variables(mrb_state *mrb, mrb_value self)
     }
     if (!MRB_PROC_ENV_P(proc)) break;
     proc = proc->upper;
-    // if (MRB_PROC_SCOPE_P(proc)) break;
+    //if (MRB_PROC_SCOPE_P(proc)) break;
     if (!proc->c) break;
   }
 

src/vm.c

@@ -2651,6 +2651,7 @@ RETRY_TRY_BLOCK:
       }
       else {
         p = mrb_proc_new(mrb, nirep);
+        p->flags |= MRB_PROC_SCOPE;
       }
       if (c & OP_L_STRICT) p->flags |= MRB_PROC_STRICT;
       regs[a] = mrb_obj_value(p);