Fix bug with face-id after restoring from pdump

* src/xfaces.c (init_xfaces): New function.
* src/emacs.c (main) [HAVE_PDUMPER]: If dumped with pdumper,
call init_xfaces.  (Bug#34226)
* src/lisp.h (init_xfaces) [HAVE_PDUMPER]: Add prototype.

* test/lisp/faces-tests.el (faces--test-face-id): New test for
bug#34226.

diff --git a/src/emacs.c b/src/emacs.c
index 2acee8e6fea659e1b42e815cc14613196c8c4b5f..d6b8a87c72353f6d53f3e17816272f7110fea4c8 100644 (file)
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1484,6 +1484,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
   running_asynch_code = 0;
   init_random ();
 
+#ifdef HAVE_PDUMPER
+  if (dumped_with_pdumper_p ())
+    init_xfaces ();
+#endif
+
 #if defined HAVE_JSON && !defined WINDOWSNT
   init_json ();
 #endif

diff --git a/src/lisp.h b/src/lisp.h
index c5631e2845378ed8f9ef60d77d10500dc2b8359e..5159f050a490d749268e858d71fafd793c930190 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4606,6 +4606,9 @@ extern void syms_of_w32cygwinx (void);
 extern Lisp_Object Vface_alternative_font_family_alist;
 extern Lisp_Object Vface_alternative_font_registry_alist;
 extern void syms_of_xfaces (void);
+#ifdef HAVE_PDUMPER
+extern void init_xfaces (void);
+#endif
 
 #ifdef HAVE_X_WINDOWS
 /* Defined in xfns.c.  */

diff --git a/src/xfaces.c b/src/xfaces.c
index cffa89e1f39036c023ea33f81e6bc0bf348d6cd2..7facb13b76c5b7581e7a69dba083c0971ea32cf6 100644 (file)
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -6507,6 +6507,46 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
                            Initialization
  ***********************************************************************/
 
+#ifdef HAVE_PDUMPER
+/* All the faces defined during loadup are recorded in
+   face-new-frame-defaults, with the last face first in the list.  We
+   need to set next_lface_id to the next face ID number, so that any
+   new faces defined in this session will have face IDs different from
+   those defined during loadup.  We also need to set up the
+   lface_id_to_name[] array for the faces that were defined during
+   loadup.  */
+void
+init_xfaces (void)
+{
+  if (CONSP (Vface_new_frame_defaults))
+    {
+      Lisp_Object lface = XCAR (Vface_new_frame_defaults);
+      if (CONSP (lface))
+       {
+         /* The first face in the list is the last face defined
+            during loadup. Compute how many faces are there, and
+            allocate the lface_id_to_name[] array.  */
+         Lisp_Object lface_id = Fget (XCAR (lface), Qface);
+         lface_id_to_name_size = next_lface_id = XFIXNAT (lface_id) + 1;
+         lface_id_to_name = xnmalloc (next_lface_id, sizeof *lface_id_to_name);
+         /* Store the last face.  */
+         lface_id_to_name[next_lface_id - 1] = lface;
+
+         /* Store the rest of the faces.  */
+         Lisp_Object tail;
+         for (tail = XCDR (Vface_new_frame_defaults); CONSP (tail);
+              tail = XCDR (tail))
+           {
+             lface = XCAR (tail);
+             int face_id = XFIXNAT (Fget (XCAR (lface), Qface));
+             eassert (face_id < lface_id_to_name_size);
+             lface_id_to_name[face_id] = lface;
+           }
+       }
+    }
+}
+#endif
+
 void
 syms_of_xfaces (void)
 {

diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el
index 4447dd7b309d840ed1661480c47c4baf4f61bd81..f00c93cedcbd7c3139744ba63d3f9dfb60f57592 100644 (file)
--- a/test/lisp/faces-tests.el
+++ b/test/lisp/faces-tests.el
@@ -60,5 +60,14 @@
     (should (equal (background-color-at-point) "black"))
     (should (equal (foreground-color-at-point) "black"))))
 
+(ert-deftest faces--test-face-id ()
+  ;; Face ID of 0 is the 'default' face; no face should have the same ID.
+  (should (> (face-id 'faces--test1) 0))
+  ;; 'tooltip' is the last face defined by preloaded packages, so any
+  ;; face we define in Emacs should have a face ID greater than that,
+  ;; since the ID of a face is just its index in the array that maps
+  ;; face IDs to faces.
+  (should (> (face-id 'faces--test1) (face-id 'tooltip))))
+
 (provide 'faces-tests)
 ;;; faces-tests.el ends here