1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

Merge from origin/emacs-26

8ac621b (origin/emacs-26) Document DEFUN attributes
16d0cc7 * etc/NEWS: Add an entry for auth-source-pass.
cc1702f Fix the MSDOS build
daa9e85 Improve warning and error messages
7612dd1 Adjust eieio persistence tests for expected failure
f0cf4dc Let eieio-persistent-read read what object-write has written
40ad1ff Handle possible classtype values in eieio-persistent-read
4ec935d Add new tests for eieio persistence
47917d8 * lisp/gnus/gnus-cloud.el (gnus-cloud-synced-files): Fix doc ...
e32f352 * lisp/ibuf-ext.el (ibuffer-never-search-content-mode): Fix t...
5268f30 * doc/lispref/windows.texi (Selecting Windows): Fix a typo.
143b485 * doc/lispref/internals.texi (Writing Emacs Primitives): Fix ...
4ab4551 Firm up documentation of generalized variables
a5bf099 Improve documentation of Auto-Revert mode
ed05eaa Improvements in dired.texi

Conflicts:
	etc/NEWS
This commit is contained in:
Glenn Morris 2018-03-22 07:50:37 -07:00
commit 0afb436eeb
11 changed files with 249 additions and 66 deletions

View file

@ -12,7 +12,8 @@
Dired makes an Emacs buffer containing a listing of a directory, and Dired makes an Emacs buffer containing a listing of a directory, and
optionally some of its subdirectories as well. You can use the normal optionally some of its subdirectories as well. You can use the normal
Emacs commands to move around in this buffer, and special Dired Emacs commands to move around in this buffer, and special Dired
commands to operate on the listed files. commands to operate on the listed files. Dired works with both local
and remote directories.
The Dired buffer is normally read-only, and inserting text in it is The Dired buffer is normally read-only, and inserting text in it is
not allowed (however, the Wdired mode allows that, @pxref{Wdired}). not allowed (however, the Wdired mode allows that, @pxref{Wdired}).
@ -109,8 +110,9 @@ default) means to perform the check; any other non-@code{nil} value
means to use the @samp{--dired} option; and @code{nil} means not to means to use the @samp{--dired} option; and @code{nil} means not to
use the @samp{--dired} option. use the @samp{--dired} option.
On MS-Windows and MS-DOS systems, Emacs emulates @command{ls}. On MS-Windows and MS-DOS systems, and also on some remote systems,
@xref{ls in Lisp}, for options and peculiarities of this emulation. Emacs emulates @command{ls}. @xref{ls in Lisp}, for options and
peculiarities of this emulation.
@findex dired-other-window @findex dired-other-window
@kindex C-x 4 d @kindex C-x 4 d
@ -131,10 +133,13 @@ deletes its window if the window was created just for that buffer.
@kindex C-n @r{(Dired)} @kindex C-n @r{(Dired)}
@kindex C-p @r{(Dired)} @kindex C-p @r{(Dired)}
@findex dired-next-line
@findex dired-previous-line
All the usual Emacs cursor motion commands are available in Dired All the usual Emacs cursor motion commands are available in Dired
buffers. The keys @kbd{C-n} and @kbd{C-p} are redefined to put the buffers. The keys @kbd{C-n} and @kbd{C-p} are redefined to run
cursor at the beginning of the file name on the line, rather than at @code{dired-next-line} and @code{dired-previous-line}, respectively,
the beginning of the line. and they put the cursor at the beginning of the file name on the line,
rather than at the beginning of the line.
@kindex SPC @r{(Dired)} @kindex SPC @r{(Dired)}
For extra convenience, @key{SPC} and @kbd{n} in Dired are equivalent For extra convenience, @key{SPC} and @kbd{n} in Dired are equivalent
@ -235,10 +240,11 @@ the buffer, and no files actually deleted.
You can delete empty directories just like other files, but normally You can delete empty directories just like other files, but normally
Dired cannot delete directories that are nonempty. If the variable Dired cannot delete directories that are nonempty. If the variable
@code{dired-recursive-deletes} is non-@code{nil}, then Dired can @code{dired-recursive-deletes} is non-@code{nil}, then Dired can
delete nonempty directories including all their contents. That can delete nonempty directories including all their contents. That can be
be somewhat risky. somewhat risky. If the value of the variable is @code{always}, Dired
Even if you have set @code{dired-recursive-deletes} to @code{nil}, will delete nonempty directories recursively, which is even more
you might want sometimes to delete recursively directories risky. Even if you have set @code{dired-recursive-deletes} to
@code{nil}, you might want sometimes to delete recursively directories
without being asked for confirmation for all of them. This is handy without being asked for confirmation for all of them. This is handy
when you have marked many directories for deletion and you are very when you have marked many directories for deletion and you are very
sure that all of them can safely be deleted. For every nonempty sure that all of them can safely be deleted. For every nonempty
@ -252,6 +258,9 @@ questions.
directories into the operating system's Trash, instead of deleting directories into the operating system's Trash, instead of deleting
them outright. @xref{Misc File Ops}. them outright. @xref{Misc File Ops}.
An alternative way of deleting files is to mark them with @kbd{m}
and delete with @kbd{D}, see @ref{Operating on Files}.
@node Flagging Many Files @node Flagging Many Files
@section Flagging Many Files at Once @section Flagging Many Files at Once
@cindex flagging many files for deletion (in Dired) @cindex flagging many files for deletion (in Dired)
@ -420,7 +429,9 @@ Mark the current file with @samp{*} (@code{dired-mark}). If the
region is active, mark all files in the region instead; otherwise, if region is active, mark all files in the region instead; otherwise, if
a numeric argument @var{n} is supplied, mark the next @var{n} files a numeric argument @var{n} is supplied, mark the next @var{n} files
instead, starting with the current file (if @var{n} is negative, mark instead, starting with the current file (if @var{n} is negative, mark
the previous @minus{}@var{n} files). the previous @minus{}@var{n} files). If invoked on a subdirectory
header line (@pxref{Subdirectories in Dired}), this command marks all
the files in that subdirectory.
@item * * @item * *
@kindex * * @r{(Dired)} @kindex * * @r{(Dired)}
@ -578,10 +589,10 @@ command will look in the buffer without revisiting the file, so the results
might be inconsistent with the file on disk if its contents have changed might be inconsistent with the file on disk if its contents have changed
since it was last visited. If you don't want this, you may wish to since it was last visited. If you don't want this, you may wish to
revert the files you have visited in your buffers, or to turn on revert the files you have visited in your buffers, or to turn on
@code{auto-revert} mode in those buffers, before invoking this Auto-Revert mode in those buffers, before invoking this command.
command. @xref{Reverting}. If you prefer that this command should always @xref{Reverting}. If you prefer that this command should always
revisit the file, without you having to revert the file or enable revisit the file, without you having to revert the file or enable
@code{auto-revert} mode, you might want to set Auto-Revert mode, you might want to set
@code{dired-always-read-filesystem} to non-@code{nil}. @code{dired-always-read-filesystem} to non-@code{nil}.
@item C-/ @item C-/
@ -766,7 +777,9 @@ suitable guess made using the variables @code{lpr-command} and
@item Z @item Z
Compress the specified files (@code{dired-do-compress}). If the file Compress the specified files (@code{dired-do-compress}). If the file
appears to be a compressed file already, uncompress it instead. Each appears to be a compressed file already, uncompress it instead. Each
marked file is compressed into its own archive. marked file is compressed into its own archive. This uses the
@command{gzip} program if it is available, otherwise it uses
@command{compress}.
@findex dired-do-compress-to @findex dired-do-compress-to
@kindex c @r{(Dired)} @kindex c @r{(Dired)}
@ -1048,6 +1061,9 @@ minibuffer is the file at the mark (i.e., the ordinary Emacs mark,
not a Dired mark; @pxref{Setting Mark}). Otherwise, if the file at not a Dired mark; @pxref{Setting Mark}). Otherwise, if the file at
point has a backup file (@pxref{Backup}), that is the default. point has a backup file (@pxref{Backup}), that is the default.
You could also compare files using @code{ediff-files}, see
@ref{Major Entry Points,,, ediff, Ediff User's Manual}.
@node Subdirectories in Dired @node Subdirectories in Dired
@section Subdirectories in Dired @section Subdirectories in Dired
@cindex subdirectories in Dired @cindex subdirectories in Dired
@ -1476,7 +1492,7 @@ space.
each marked file. With just @kbd{C-u} as the prefix argument, it uses each marked file. With just @kbd{C-u} as the prefix argument, it uses
file names relative to the Dired buffer's default directory. (This file names relative to the Dired buffer's default directory. (This
can still contain slashes if in a subdirectory.) As a special case, can still contain slashes if in a subdirectory.) As a special case,
if point is on a directory headerline, @kbd{w} gives you the absolute if point is on a directory header line, @kbd{w} gives you the absolute
name of that directory. Any prefix argument or marked files are name of that directory. Any prefix argument or marked files are
ignored in this case. ignored in this case.

View file

@ -991,6 +991,9 @@ Auto-Revert Tail mode works also for remote files.
When a buffer is auto-reverted, a message is generated. This can be When a buffer is auto-reverted, a message is generated. This can be
suppressed by setting @code{auto-revert-verbose} to @code{nil}. suppressed by setting @code{auto-revert-verbose} to @code{nil}.
In Dired buffers (@pxref{Dired}), Auto-Revert mode refreshes the
buffer when a file is created or deleted in the buffer's directory.
@xref{VC Undo}, for commands to revert to earlier versions of files @xref{VC Undo}, for commands to revert to earlier versions of files
under version control. @xref{VC Mode Line}, for Auto Revert under version control. @xref{VC Mode Line}, for Auto Revert
peculiarities when visiting files under version control. peculiarities when visiting files under version control.

View file

@ -735,7 +735,7 @@ Lisp form. For example:
@example @example
@group @group
DEFUN ("foo", Ffoo, Sfoo, 0, UNEVALLED, DEFUN ("foo", Ffoo, Sfoo, 0, UNEVALLED, 0
"(list (read-char-by-name \"Insert character: \")\ "(list (read-char-by-name \"Insert character: \")\
(prefix-numeric-value current-prefix-arg)\ (prefix-numeric-value current-prefix-arg)\
t))", t))",
@ -768,6 +768,43 @@ the actual documentation. The others have placeholders beginning with
All the usual rules for documentation strings in Lisp code All the usual rules for documentation strings in Lisp code
(@pxref{Documentation Tips}) apply to C code documentation strings (@pxref{Documentation Tips}) apply to C code documentation strings
too. too.
The documentation string can be followed by a list of C function
attributes for the C function that implements the primitive, like
this:
@example
@group
DEFUN ("bar", Fbar, Sbar, 0, UNEVALLED, 0
doc: /* @dots{} /*
attributes: @var{attr1} @var{attr2} @dots{})
@end group
@end example
@noindent
You can specify more than a single attribute, one after the other.
Currently, only the following attributes are recognized:
@table @code
@item noreturn
Declares the C function as one that never returns. This corresponds
to the C11 keyword @code{_Noreturn} and to @w{@code{__attribute__
((__noreturn__))}} attribute of GCC (@pxref{Function Attributes,,,
gcc, Using the GNU Compiler Collection}).
@item const
Declares that the function does not examine any values except its
arguments, and has no effects except the return value. This
corresponds to @w{@code{__attribute__ ((__const__))}} attribute of
GCC.
@item noinline
This corresponds to @w{@code{__attribute__ ((__noinline__))}}
attribute of GCC, which prevents the function from being considered
for inlining. This might be needed, e.g., to countermand effects of
link-time optimizations on stack-based variables.
@end table
@end table @end table
After the call to the @code{DEFUN} macro, you must write the After the call to the @code{DEFUN} macro, you must write the
@ -850,7 +887,7 @@ defined with @code{DEFVAR_BOOL} are automatically added to the list
@code{byte-boolean-vars} used by the byte compiler. @code{byte-boolean-vars} used by the byte compiler.
@cindex defining customization variables in C @cindex defining customization variables in C
If you want to make a Lisp variables that is defined in C behave If you want to make a Lisp variable that is defined in C behave
like one declared with @code{defcustom}, add an appropriate entry to like one declared with @code{defcustom}, add an appropriate entry to
@file{cus-start.el}. @file{cus-start.el}.

View file

@ -2317,11 +2317,12 @@ Attempting to assign them any other value will result in an error:
@cindex generalized variable @cindex generalized variable
@cindex place form @cindex place form
A @dfn{generalized variable} or @dfn{place form} is one of the many places A @dfn{generalized variable} or @dfn{place form} is one of the many
in Lisp memory where values can be stored. The simplest place form is places in Lisp memory where values can be stored using the @code{setf}
a regular Lisp variable. But the @sc{car}s and @sc{cdr}s of lists, elements macro (@pxref{Setting Generalized Variables}). The simplest place
of arrays, properties of symbols, and many other locations are also form is a regular Lisp variable. But the @sc{car}s and @sc{cdr}s of
places where Lisp values are stored. lists, elements of arrays, properties of symbols, and many other
locations are also places where Lisp values get stored.
Generalized variables are analogous to lvalues in the C Generalized variables are analogous to lvalues in the C
language, where @samp{x = a[i]} gets an element from an array language, where @samp{x = a[i]} gets an element from an array
@ -2342,8 +2343,8 @@ variables. The @code{setf} form is like @code{setq}, except that it
accepts arbitrary place forms on the left side rather than just accepts arbitrary place forms on the left side rather than just
symbols. For example, @code{(setf (car a) b)} sets the car of symbols. For example, @code{(setf (car a) b)} sets the car of
@code{a} to @code{b}, doing the same operation as @code{(setcar a b)}, @code{a} to @code{b}, doing the same operation as @code{(setcar a b)},
but without having to remember two separate functions for setting and but without you having to use two separate functions for setting and
accessing every type of place. accessing this type of place.
@defmac setf [place form]@dots{} @defmac setf [place form]@dots{}
This macro evaluates @var{form} and stores it in @var{place}, which This macro evaluates @var{form} and stores it in @var{place}, which
@ -2353,18 +2354,19 @@ just as with @code{setq}. @code{setf} returns the value of the last
@var{form}. @var{form}.
@end defmac @end defmac
The following Lisp forms will work as generalized variables, and The following Lisp forms are the forms in Emacs that will work as
so may appear in the @var{place} argument of @code{setf}: generalized variables, and so may appear in the @var{place} argument
of @code{setf}:
@itemize @itemize
@item @item
A symbol naming a variable. In other words, @code{(setf x y)} is A symbol. In other words, @code{(setf x y)} is exactly equivalent to
exactly equivalent to @code{(setq x y)}, and @code{setq} itself is @code{(setq x y)}, and @code{setq} itself is strictly speaking
strictly speaking redundant given that @code{setf} exists. Many redundant given that @code{setf} exists. Most programmers will
programmers continue to prefer @code{setq} for setting simple continue to prefer @code{setq} for setting simple variables, though,
variables, though, purely for stylistic or historical reasons. for stylistic and historical reasons. The macro @code{(setf x y)}
The macro @code{(setf x y)} actually expands to @code{(setq x y)}, actually expands to @code{(setq x y)}, so there is no performance
so there is no performance penalty for using it in compiled code. penalty for using it in compiled code.
@item @item
A call to any of the following standard Lisp functions: A call to any of the following standard Lisp functions:

View file

@ -1772,7 +1772,7 @@ raise the frame or make sure input focus is directed to that frame.
@end defun @end defun
@cindex select window hook @cindex select window hook
@cindex running a hook when a windows gets selected @cindex running a hook when a window gets selected
For historical reasons, Emacs does not run a separate hook whenever a For historical reasons, Emacs does not run a separate hook whenever a
window gets selected. Applications and internal routines often window gets selected. Applications and internal routines often
temporarily select a window to perform a few actions on it. They do temporarily select a window to perform a few actions on it. They do

View file

@ -1274,6 +1274,10 @@ specialized for editing freedesktop.org desktop entries.
** New major mode 'less-css-mode' (a minor variant of 'css-mode') for ** New major mode 'less-css-mode' (a minor variant of 'css-mode') for
editing Less files. editing Less files.
+++
** New package 'auth-source-pass' integrates 'auth-source' with the
password manager password-store (http://passwordstore.org).
* Incompatible Lisp Changes in Emacs 26.1 * Incompatible Lisp Changes in Emacs 26.1

View file

@ -219,7 +219,7 @@ for CLASS. Optional ALLOW-SUBCLASS says that it is ok for
`eieio-persistent-read' to load in subclasses of class instead of `eieio-persistent-read' to load in subclasses of class instead of
being pedantic." being pedantic."
(unless class (unless class
(message "Unsafe call to `eieio-persistent-read'.")) (warn "`eieio-persistent-read' called without specifying a class"))
(when class (cl-check-type class class)) (when class (cl-check-type class class))
(let ((ret nil) (let ((ret nil)
(buffstr nil)) (buffstr nil))
@ -234,13 +234,16 @@ being pedantic."
;; the current buffer will work. ;; the current buffer will work.
(setq ret (read buffstr)) (setq ret (read buffstr))
(when (not (child-of-class-p (car ret) 'eieio-persistent)) (when (not (child-of-class-p (car ret) 'eieio-persistent))
(error "Corrupt object on disk: Unknown saved object")) (error
"Invalid object: %s is not a subclass of `eieio-persistent'"
(car ret)))
(when (and class (when (and class
(not (or (eq (car ret) class ) ; same class (not (or (eq (car ret) class) ; same class
(and allow-subclass (and allow-subclass ; subclass
(child-of-class-p (car ret) class)) ; subclasses (child-of-class-p (car ret) class)))))
))) (error
(error "Corrupt object on disk: Invalid saved class")) "Invalid object: %s is not an object of class %s nor a subclass"
(car ret) class))
(setq ret (eieio-persistent-convert-list-to-object ret)) (setq ret (eieio-persistent-convert-list-to-object ret))
(oset ret file filename)) (oset ret file filename))
(kill-buffer " *tmp eieio read*")) (kill-buffer " *tmp eieio read*"))
@ -332,7 +335,8 @@ Second, any text properties will be stripped from strings."
;; We have a predicate, but it doesn't satisfy the predicate? ;; We have a predicate, but it doesn't satisfy the predicate?
(dolist (PV (cdr proposed-value)) (dolist (PV (cdr proposed-value))
(unless (child-of-class-p (car PV) (car classtype)) (unless (child-of-class-p (car PV) (car classtype))
(error "Corrupt object on disk"))) (error "Invalid object: slot member %s does not match class %s"
(car PV) (car classtype))))
;; We have a list of objects here. Lets load them ;; We have a list of objects here. Lets load them
;; in. ;; in.
@ -349,7 +353,7 @@ Second, any text properties will be stripped from strings."
(seq-some (seq-some
(lambda (elt) (lambda (elt)
(child-of-class-p (car proposed-value) elt)) (child-of-class-p (car proposed-value) elt))
classtype)) (if (listp classtype) classtype (list classtype))))
(eieio-persistent-convert-list-to-object (eieio-persistent-convert-list-to-object
proposed-value)) proposed-value))
(t (t
@ -360,19 +364,28 @@ Second, any text properties will be stripped from strings."
((hash-table-p proposed-value) ((hash-table-p proposed-value)
(maphash (maphash
(lambda (key value) (lambda (key value)
(when (class-p (car-safe value)) (cond ((class-p (car-safe value))
(setf (gethash key proposed-value) (setf (gethash key proposed-value)
(eieio-persistent-convert-list-to-object (eieio-persistent-convert-list-to-object
value)))) value)))
((and (consp value)
(eq (car value) 'quote))
(setf (gethash key proposed-value)
(cadr value)))))
proposed-value) proposed-value)
proposed-value) proposed-value)
((vectorp proposed-value) ((vectorp proposed-value)
(dotimes (i (length proposed-value)) (dotimes (i (length proposed-value))
(when (class-p (car-safe (aref proposed-value i))) (let ((val (aref proposed-value i)))
(aset proposed-value i (cond ((class-p (car-safe val))
(eieio-persistent-convert-list-to-object (aset proposed-value i
(aref proposed-value i))))) (eieio-persistent-convert-list-to-object
(aref proposed-value i))))
((and (consp val)
(eq (car val) 'quote))
(aset proposed-value i
(cadr val))))))
proposed-value) proposed-value)
((stringp proposed-value) ((stringp proposed-value)

View file

@ -48,10 +48,14 @@
"~/.authinfo.gpg" "~/.authinfo.gpg"
"~/.gnus.el" "~/.gnus.el"
(:directory "~/News" :match ".*.SCORE\\'")) (:directory "~/News" :match ".*.SCORE\\'"))
"List of file regexps that should be kept up-to-date via the cloud." "List of files that should be kept up-to-date via the cloud.
Each element may be either a string or a property list.
The latter should have a :directory element whose value is a string,
and a :match element whose value is a regular expression to match
against the basename of files in said directory."
:group 'gnus-cloud :group 'gnus-cloud
;; FIXME this type does not match the default. Nor does the documentation. :type '(repeat (choice (string :tag "File")
:type '(repeat regexp)) (plist :tag "Property list"))))
(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip) (defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip)
"Storage method for cloud data, defaults to EPG if that's available." "Storage method for cloud data, defaults to EPG if that's available."
@ -290,6 +294,8 @@ Use old data if FORCE-OLDER is not nil."
(dolist (elem gnus-cloud-synced-files) (dolist (elem gnus-cloud-synced-files)
(cond (cond
((stringp elem) ((stringp elem)
;; This seems fragile. String comparison, with no
;; expand-file-name to resolve ~, etc.
(when (equal elem file-name) (when (equal elem file-name)
(setq matched t))) (setq matched t)))
((consp elem) ((consp elem)

View file

@ -114,7 +114,7 @@ Buffers whose name matches a regexp in this list, are not searched."
"A list of major modes ignored by `ibuffer-mark-by-content-regexp'. "A list of major modes ignored by `ibuffer-mark-by-content-regexp'.
Buffers whose major mode is in this list, are not searched." Buffers whose major mode is in this list, are not searched."
:version "26.1" :version "26.1"
:type '(repeat regexp) :type '(repeat (symbol :tag "Major mode"))
:require 'ibuf-ext :require 'ibuf-ext
:group 'ibuffer) :group 'ibuffer)

View file

@ -32,6 +32,7 @@
/^#undef DOS_NT *$/s/^.*$/#define DOS_NT/ /^#undef DOS_NT *$/s/^.*$/#define DOS_NT/
/^#undef FLOAT_CHECK_DOMAIN *$/s/^.*$/#define FLOAT_CHECK_DOMAIN/ /^#undef FLOAT_CHECK_DOMAIN *$/s/^.*$/#define FLOAT_CHECK_DOMAIN/
/^#undef HAVE_ALLOCA *$/s/^.*$/#define HAVE_ALLOCA 1/ /^#undef HAVE_ALLOCA *$/s/^.*$/#define HAVE_ALLOCA 1/
/^#undef HAVE_SBRK *$/s/^.*$/#define HAVE_SBRK 1/
/^#undef HAVE_SETITIMER *$/s/^.*$/#define HAVE_SETITIMER 1/ /^#undef HAVE_SETITIMER *$/s/^.*$/#define HAVE_SETITIMER 1/
/^#undef HAVE_STRUCT_UTIMBUF *$/s/^.*$/#define HAVE_STRUCT_UTIMBUF 1/ /^#undef HAVE_STRUCT_UTIMBUF *$/s/^.*$/#define HAVE_STRUCT_UTIMBUF 1/
/^#undef LOCALTIME_CACHE *$/s/^.*$/#define LOCALTIME_CACHE 1/ /^#undef LOCALTIME_CACHE *$/s/^.*$/#define LOCALTIME_CACHE 1/

View file

@ -1,4 +1,4 @@
;;; eieio-persist.el --- Tests for eieio-persistent class ;;; eieio-test-persist.el --- Tests for eieio-persistent class
;; Copyright (C) 2011-2018 Free Software Foundation, Inc. ;; Copyright (C) 2011-2018 Free Software Foundation, Inc.
@ -40,6 +40,17 @@ This is usually a symbol that starts with `:'."
(car tuple) (car tuple)
nil))) nil)))
(defun hash-equal (hash1 hash2)
"Compare two hash tables to see whether they are equal."
(and (= (hash-table-count hash1)
(hash-table-count hash2))
(catch 'flag
(maphash (lambda (x y)
(or (equal (gethash x hash2) y)
(throw 'flag nil)))
hash1)
(throw 'flag t))))
(defun persist-test-save-and-compare (original) (defun persist-test-save-and-compare (original)
"Compare the object ORIGINAL against the one read fromdisk." "Compare the object ORIGINAL against the one read fromdisk."
@ -49,8 +60,8 @@ This is usually a symbol that starts with `:'."
(class (eieio-object-class original)) (class (eieio-object-class original))
(fromdisk (eieio-persistent-read file class)) (fromdisk (eieio-persistent-read file class))
(cv (cl--find-class class)) (cv (cl--find-class class))
(slots (eieio--class-slots cv)) (slots (eieio--class-slots cv)))
)
(unless (object-of-class-p fromdisk class) (unless (object-of-class-p fromdisk class)
(error "Persistent class %S != original class %S" (error "Persistent class %S != original class %S"
(eieio-object-class fromdisk) (eieio-object-class fromdisk)
@ -62,18 +73,24 @@ This is usually a symbol that starts with `:'."
(origvalue (eieio-oref original oneslot)) (origvalue (eieio-oref original oneslot))
(fromdiskvalue (eieio-oref fromdisk oneslot)) (fromdiskvalue (eieio-oref fromdisk oneslot))
(initarg-p (eieio--attribute-to-initarg (initarg-p (eieio--attribute-to-initarg
(cl--find-class class) oneslot)) (cl--find-class class) oneslot)))
)
(if initarg-p (if initarg-p
(unless (equal origvalue fromdiskvalue) (unless
(cond ((and (hash-table-p origvalue) (hash-table-p fromdiskvalue))
(hash-equal origvalue fromdiskvalue))
(t (equal origvalue fromdiskvalue)))
(error "Slot %S Original Val %S != Persistent Val %S" (error "Slot %S Original Val %S != Persistent Val %S"
oneslot origvalue fromdiskvalue)) oneslot origvalue fromdiskvalue))
;; Else !initarg-p ;; Else !initarg-p
(unless (equal (cl--slot-descriptor-initform slot) fromdiskvalue) (let ((origval (cl--slot-descriptor-initform slot))
(diskval fromdiskvalue))
(unless
(cond ((and (hash-table-p origval) (hash-table-p diskval))
(hash-equal origval diskval))
(t (equal origval diskval)))
(error "Slot %S Persistent Val %S != Default Value %S" (error "Slot %S Persistent Val %S != Default Value %S"
oneslot fromdiskvalue (cl--slot-descriptor-initform slot)))) oneslot diskval origvalue))))))))
))))
;;; Simple Case ;;; Simple Case
;; ;;
@ -203,13 +220,16 @@ persistent class.")
((slot1 :initarg :slot1 ((slot1 :initarg :slot1
:type (or persistent-random-class null persist-not-persistent)) :type (or persistent-random-class null persist-not-persistent))
(slot2 :initarg :slot2 (slot2 :initarg :slot2
:type (or persist-not-persistent persist-random-class null)))) :type (or persist-not-persistent persistent-random-class null))
(slot3 :initarg :slot3
:type persistent-random-class)))
(ert-deftest eieio-test-multiple-class-slot () (ert-deftest eieio-test-multiple-class-slot ()
(let ((persist (let ((persist
(persistent-multiclass-slot (persistent-multiclass-slot
:slot1 (persistent-random-class) :slot1 (persistent-random-class)
:slot2 (persist-not-persistent) :slot2 (persist-not-persistent)
:slot3 (persistent-random-class)
:file (concat default-directory "test-ps5.pt")))) :file (concat default-directory "test-ps5.pt"))))
(unwind-protect (unwind-protect
(persist-test-save-and-compare persist) (persist-test-save-and-compare persist)
@ -235,4 +255,85 @@ persistent class.")
(persist-test-save-and-compare persist-wols) (persist-test-save-and-compare persist-wols)
(delete-file (oref persist-wols file)))) (delete-file (oref persist-wols file))))
;;; Tests targeted at popular libraries in the wild.
;; Objects inside hash tables and vectors (pcache), see bug#29220.
(defclass person ()
((name :type string :initarg :name)))
(defclass classy (eieio-persistent)
((teacher
:type person
:initarg :teacher)
(students
:initarg :students :initform (make-hash-table :test 'equal))
(janitors
:type list
:initarg :janitors)
(random-vector
:type vector
:initarg :random-vector)))
(ert-deftest eieio-test-persist-hash-and-vector ()
(let* ((jane (make-instance 'person :name "Jane"))
(bob (make-instance 'person :name "Bob"))
(hans (make-instance 'person :name "Hans"))
(dierdre (make-instance 'person :name "Dierdre"))
(class (make-instance 'classy
:teacher jane
:janitors (list [tuesday nil]
[friday nil])
:random-vector [nil]
:file (concat default-directory "classy-" emacs-version ".eieio"))))
(puthash "Bob" bob (slot-value class 'students))
(aset (slot-value class 'random-vector) 0
(make-instance 'persistent-random-class))
(unwind-protect
(persist-test-save-and-compare class)
(delete-file (oref class file)))
(aset (car (slot-value class 'janitors)) 1 hans)
(aset (nth 1 (slot-value class 'janitors)) 1 dierdre)
(unwind-protect
;; FIXME: This should not error.
(should-error (persist-test-save-and-compare class))
(delete-file (oref class file)))))
;; Extra quotation of lists inside other objects (Gnus registry), also
;; bug#29220.
(defclass eieio-container (eieio-persistent)
((alist
:initarg :alist
:type list)
(vec
:initarg :vec
:type vector)
(htab
:initarg :htab
:type hash-table)))
(ert-deftest eieio-test-persist-interior-lists ()
(let* ((thing (make-instance
'eieio-container
:vec [nil]
:htab (make-hash-table :test #'equal)
:file (concat default-directory
"container-" emacs-version ".eieio")))
(john (make-instance 'person :name "John"))
(alexie (make-instance 'person :name "Alexie"))
(alst '(("first" (one two three))
("second" (four five six)))))
(setf (slot-value thing 'alist) alst)
(puthash "alst" alst (slot-value thing 'htab))
(aset (slot-value thing 'vec) 0 alst)
(unwind-protect
(persist-test-save-and-compare thing)
(delete-file (slot-value thing 'file)))
(setf (nth 2 (cadar alst)) john
(nth 2 (cadadr alst)) alexie)
(unwind-protect
;; FIXME: Should not error.
(should-error (persist-test-save-and-compare thing))
(delete-file (slot-value thing 'file)))))
;;; eieio-test-persist.el ends here ;;; eieio-test-persist.el ends here