bug#27718: 26.0.50; (cl-typep instance-ab 'class-a) gives wrong answer when compiled

[npostavs@users.sourceforge.net]

[-- Attachment #1: Type: text/plain, Size: 379 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> So maybe rather than hijack function-get/put in bug#27016, we should
> introduce a new "definitional put" with a corresponding `get`, and then
> use that here as well as in function-put/get.
>
> Maybe we could simply change put&get directly without introducing
> yet-another slightly different get/put?

Something like this?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-diff, Size: 2850 bytes --]

From 7645c7ff5078aa0bc937969fb1550b0f794d793e Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 22 Jul 2017 13:46:58 -0400
Subject: [PATCH] Let `put' take effect during compilation (Bug#27718)

* lisp/emacs-lisp/bytecomp.el: Use `byte-compile-function-put' to
handle `put' as well.
* src/fns.c (Fget): Consult `byte-compile-plist-environment'.
* lisp/subr.el (function-get): Let `get' take care of consuling
`byte-compile-plist-environment'.
---
 lisp/emacs-lisp/bytecomp.el |  1 +
 lisp/subr.el                |  7 +------
 src/fns.c                   | 10 ++++++++++
 3 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 4dda3bdc2b..3fead4229e 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4719,6 +4719,7 @@ (defun byte-compile-form-make-variable-buffer-local (form)
   (byte-compile-keep-pending form 'byte-compile-normal-call))
 
 (put 'function-put 'byte-hunk-handler 'byte-compile-function-put)
+(put 'put 'byte-hunk-handler 'byte-compile-function-put)
 (defun byte-compile-function-put (form)
   (pcase form
     ((and `(,op ,fun ,prop ,val)
diff --git a/lisp/subr.el b/lisp/subr.el
index 3e4a3dedf5..42b4e1c211 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2971,12 +2971,7 @@ (defun function-get (f prop &optional autoload)
 if it's an autoloaded macro."
   (let ((val nil))
     (while (and (symbolp f)
-                (null (setq val (or (plist-get
-                                     (alist-get
-                                      f (bound-and-true-p
-                                         byte-compile-plist-environment))
-                                     prop)
-                                    (get f prop))))
+                (null (setq val (get f prop)))
                 (fboundp f))
       (let ((fundef (symbol-function f)))
         (if (and autoload (autoloadp fundef)
diff --git a/src/fns.c b/src/fns.c
index d849618f2b..655422aa0f 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1987,6 +1987,14 @@ DEFUN ("get", Fget, Sget, 2, 2, 0,
   (Lisp_Object symbol, Lisp_Object propname)
 {
   CHECK_SYMBOL (symbol);
+  Lisp_Object plist_env = find_symbol_value (Qbyte_compile_plist_environment);
+  if (CONSP (plist_env))
+    {
+      Lisp_Object propval = Fplist_get (CDR (Fassq (symbol, plist_env)),
+                                        propname);
+      if (!NILP (propval))
+        return propval;
+    }
   return Fplist_get (XSYMBOL (symbol)->plist, propname);
 }
 
@@ -5125,6 +5133,8 @@ syms_of_fns (void)
   DEFSYM (Qkey_or_value, "key-or-value");
   DEFSYM (Qkey_and_value, "key-and-value");
 
+  DEFSYM (Qbyte_compile_plist_environment, "byte-compile-plist-environment");
+
   defsubr (&Ssxhash_eq);
   defsubr (&Ssxhash_eql);
   defsubr (&Ssxhash_equal);
-- 
2.11.1