master c46863d9bb 1/3: Make force-load-doc-strings work again

[Mattias Engdegård]

branch: master
commit c46863d9bb8493d0d15030df863d78b8f1738b2e
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Make force-load-doc-strings work again
    
    When load-force-doc-strings is true, read (#$ . POS) as the (unibyte)
    string referred to.  This feature was lost by mistake in the recent
    nonrecursive reader rewrite.
    
    Noticed by Stefan Monnier.
    
    * src/lread.c (get_lazy_string): New function (code mostly recycled
    from an old version).
    (read0): Detect (#$ . FIXNUM) and retrieve the string if appropriate.
    * test/src/lread-resources/lazydoc.el:
    * test/src/lread-tests.el (lread-force-load-doc-strings):
    New test.
---
 src/lread.c                         |  67 ++++++++++++++++++++++++++++++++++++
 test/src/lread-resources/lazydoc.el | Bin 0 -> 171 bytes
 test/src/lread-tests.el             |  17 +++++++++
 3 files changed, 84 insertions(+)

diff --git a/src/lread.c b/src/lread.c
index b7d8d9eeca..58fe3c5a9c 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3496,6 +3496,64 @@ skip_lazy_string (Lisp_Object readcharfun)
     skip_dyn_bytes (readcharfun, nskip);
 }
 
+static Lisp_Object
+get_lazy_string (Lisp_Object val)
+{
+  char *saved = NULL;
+  file_offset saved_position;
+  /* Get a doc string from the file we are loading.
+     If it's in saved_doc_string, get it from there.
+
+     Here, we don't know if the string is a bytecode string or a doc
+     string.  As a bytecode string must be unibyte, we always return a
+     unibyte string.  If it is actually a doc string, caller must make
+     it multibyte.  */
+
+  /* Position is negative for user variables.  */
+  EMACS_INT pos = eabs (XFIXNUM (XCDR (val)));
+  if (pos >= saved_doc_string_position
+      && pos < (saved_doc_string_position + saved_doc_string_length))
+    {
+      saved = saved_doc_string;
+      saved_position = saved_doc_string_position;
+    }
+  /* Look in prev_saved_doc_string the same way.  */
+  else if (pos >= prev_saved_doc_string_position
+          && pos < (prev_saved_doc_string_position
+                    + prev_saved_doc_string_length))
+    {
+      saved = prev_saved_doc_string;
+      saved_position = prev_saved_doc_string_position;
+    }
+  if (saved)
+    {
+      ptrdiff_t start = pos - saved_position;
+      ptrdiff_t from = start;
+      ptrdiff_t to = start;
+
+      /* Process quoting with ^A, and find the end of the string,
+        which is marked with ^_ (037).  */
+      while (saved[from] != 037)
+       {
+         int c = saved[from++];
+         if (c == 1)
+           {
+             c = saved[from++];
+             saved[to++] = (c == 1 ? c
+                            : c == '0' ? 0
+                            : c == '_' ? 037
+                            : c);
+           }
+         else
+           saved[to++] = c;
+       }
+
+      return make_unibyte_string (saved + start, to - start);
+    }
+  else
+    return get_doc_string (val, 1, 0);
+}
+
 
 /* Length of prefix only consisting of symbol constituent characters.  */
 static ptrdiff_t
@@ -4237,6 +4295,15 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
            XSETCDR (e->u.list.tail, obj);
            read_stack_pop ();
            obj = e->u.list.head;
+
+           /* Hack: immediately convert (#$ . FIXNUM) to the corresponding
+              string if load-force-doc-strings is set.  */
+           if (load_force_doc_strings
+               && BASE_EQ (XCAR (obj), Vload_file_name)
+               && !NILP (XCAR (obj))
+               && FIXNUMP (XCDR (obj)))
+             obj = get_lazy_string (obj);
+
            break;
          }
 
diff --git a/test/src/lread-resources/lazydoc.el 
b/test/src/lread-resources/lazydoc.el
new file mode 100644
index 0000000000..cb434c239b
Binary files /dev/null and b/test/src/lread-resources/lazydoc.el differ
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index f190f14781..2f25de4cc3 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -322,4 +322,21 @@ literals (Bug#20852)."
   (should-error (read-from-string "?\\\n x"))
   (should (equal (read-from-string "\"a\\\nb\"") '("ab" . 6))))
 
+(ert-deftest lread-force-load-doc-strings ()
+  ;; Verify that lazy doc strings are loaded lazily by default,
+  ;; but eagerly with `force-load-doc-strings' set.
+  (let ((file (expand-file-name "lazydoc.el" (ert-resource-directory))))
+    (fmakunbound 'lazydoc-fun)
+    (load file)
+    (let ((f (symbol-function 'lazydoc-fun)))
+      (should (byte-code-function-p f))
+      (should (equal (aref f 4) (cons file 87))))
+
+    (fmakunbound 'lazydoc-fun)
+    (let ((load-force-doc-strings t))
+      (load file)
+      (let ((f (symbol-function 'lazydoc-fun)))
+        (should (byte-code-function-p f))
+        (should (equal (aref f 4) "My little\ndoc string\nhere"))))))
+
 ;;; lread-tests.el ends here