diff options
| author | Po Lu | 2021-12-03 14:07:40 +0800 |
|---|---|---|
| committer | Po Lu | 2021-12-03 14:07:40 +0800 |
| commit | 57a9bf8d4186878a59750e2f0bef3ca3b526e8ef (patch) | |
| tree | e728bd25939ba8866b3a5c76db9a464cee359a34 | |
| parent | f17d0dfb3e61b2b271e012b9b17aac657f6ee09f (diff) | |
| parent | 1afa295aed81357fddf9694bfe68ed0e6d159a2d (diff) | |
| download | emacs-57a9bf8d4186878a59750e2f0bef3ca3b526e8ef.tar.gz emacs-57a9bf8d4186878a59750e2f0bef3ca3b526e8ef.zip | |
Merge remote-tracking branch 'origin/master' into feature/pgtk
| -rw-r--r-- | CONTRIBUTE | 26 | ||||
| -rwxr-xr-x | admin/diff-tar-files | 4 | ||||
| -rw-r--r-- | admin/make-tarball.txt | 33 | ||||
| -rw-r--r-- | lib-src/Makefile.in | 4 | ||||
| -rw-r--r-- | lisp/pixel-scroll.el | 74 | ||||
| -rw-r--r-- | lisp/tab-bar.el | 7 | ||||
| -rw-r--r-- | src/alloc.c | 20 | ||||
| -rw-r--r-- | src/comp.c | 18 | ||||
| -rw-r--r-- | src/comp.h | 10 | ||||
| -rw-r--r-- | src/data.c | 10 | ||||
| -rw-r--r-- | src/eval.c | 23 | ||||
| -rw-r--r-- | src/fileio.c | 4 | ||||
| -rw-r--r-- | src/lisp.h | 16 | ||||
| -rw-r--r-- | src/lread.c | 12 | ||||
| -rw-r--r-- | src/pdumper.c | 40 | ||||
| -rw-r--r-- | test/lisp/tab-bar-tests.el | 51 |
16 files changed, 232 insertions, 120 deletions
diff --git a/CONTRIBUTE b/CONTRIBUTE index 5740004637b..7c3421ed75a 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE | |||
| @@ -185,20 +185,26 @@ ChangeLog file, where they can be corrected. It saves time to get | |||
| 185 | them right the first time, so here are guidelines for formatting them: | 185 | them right the first time, so here are guidelines for formatting them: |
| 186 | 186 | ||
| 187 | - Start with a single unindented summary line explaining the change; | 187 | - Start with a single unindented summary line explaining the change; |
| 188 | do not end this line with a period. If that line starts with a | 188 | do not end this line with a period. If possible, try to keep the |
| 189 | semicolon and a space "; ", the commit message will be ignored when | 189 | summary line to 50 characters or fewer; this is for compatibility |
| 190 | generating the ChangeLog file. Use this for minor commits that do | 190 | with certain Git commands that print that line in width-constrained |
| 191 | not need separate ChangeLog entries, such as changes in etc/NEWS. | 191 | contexts. |
| 192 | 192 | ||
| 193 | - After the summary line, there should be an empty line, then | 193 | If the summary line starts with a semicolon and a space "; ", the |
| 194 | unindented ChangeLog entries. | 194 | commit message will be ignored when generating the ChangeLog file. |
| 195 | Use this for minor commits that do not need separate ChangeLog | ||
| 196 | entries, such as changes in etc/NEWS. | ||
| 197 | |||
| 198 | - After the summary line, there should be an empty line. | ||
| 199 | |||
| 200 | - Unindented ChangeLog entries normally come next. However, if the | ||
| 201 | commit couldn't be properly summarized in the brief summary line, | ||
| 202 | you can put a paragraph (after the empty line and before the | ||
| 203 | individual ChangeLog entries) that further describes the commit. | ||
| 195 | 204 | ||
| 196 | - Limit lines in commit messages to 78 characters, unless they consist | 205 | - Limit lines in commit messages to 78 characters, unless they consist |
| 197 | of a single word of at most 140 characters; this is enforced by a | 206 | of a single word of at most 140 characters; this is enforced by a |
| 198 | commit hook. It's nicer to limit the summary line to 50 characters; | 207 | commit hook. |
| 199 | this isn't enforced. If the change can't be summarized so briefly, | ||
| 200 | add a paragraph after the empty line and before the individual file | ||
| 201 | descriptions. | ||
| 202 | 208 | ||
| 203 | - If only a single file is changed, the summary line can be the normal | 209 | - If only a single file is changed, the summary line can be the normal |
| 204 | file first line (starting with the asterisk). Then there is no | 210 | file first line (starting with the asterisk). Then there is no |
diff --git a/admin/diff-tar-files b/admin/diff-tar-files index cdcc512ae6b..2fe15401d0d 100755 --- a/admin/diff-tar-files +++ b/admin/diff-tar-files | |||
| @@ -35,7 +35,7 @@ old_tmp=/tmp/old.$$ | |||
| 35 | new_tmp=/tmp/new.$$ | 35 | new_tmp=/tmp/new.$$ |
| 36 | trap "rm -f $old_tmp $new_tmp; exit 1" 1 2 15 | 36 | trap "rm -f $old_tmp $new_tmp; exit 1" 1 2 15 |
| 37 | 37 | ||
| 38 | tar tzf "$old_tar" | sed -e 's,^[^/]*,,' | sort > $old_tmp | 38 | tar tf "$old_tar" | sed -e 's,^[^/]*,,' | sort > $old_tmp |
| 39 | tar tzf "$new_tar" | sed -e 's,^[^/]*,,' | sort > $new_tmp | 39 | tar tf "$new_tar" | sed -e 's,^[^/]*,,' | sort > $new_tmp |
| 40 | diff -u $old_tmp $new_tmp | 40 | diff -u $old_tmp $new_tmp |
| 41 | rm -f $new_tmp $old_tmp | 41 | rm -f $new_tmp $old_tmp |
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt index 22276080c5d..872cb00ca28 100644 --- a/admin/make-tarball.txt +++ b/admin/make-tarball.txt | |||
| @@ -5,7 +5,7 @@ Instructions to create pretest or release tarballs. -*- coding: utf-8 -*- | |||
| 5 | 5 | ||
| 6 | Steps to take before starting on the first pretest in any release sequence: | 6 | Steps to take before starting on the first pretest in any release sequence: |
| 7 | 7 | ||
| 8 | 0. The release branch (e.g. emacs-26) should already have been made | 8 | 0. The release branch (e.g. emacs-28) should already have been made |
| 9 | and you should use it for all that follows. Diffs from this | 9 | and you should use it for all that follows. Diffs from this |
| 10 | branch should be going to the emacs-diffs mailing list. | 10 | branch should be going to the emacs-diffs mailing list. |
| 11 | 11 | ||
| @@ -14,12 +14,13 @@ Steps to take before starting on the first pretest in any release sequence: | |||
| 14 | 14 | ||
| 15 | 2. Consider increasing the value of the variable | 15 | 2. Consider increasing the value of the variable |
| 16 | 'customize-changed-options-previous-release' in cus-edit.el to | 16 | 'customize-changed-options-previous-release' in cus-edit.el to |
| 17 | refer to a newer version of Emacs. (This is probably needed only | 17 | refer to a newer version of Emacs. (This is now done when cutting |
| 18 | when preparing the first pretest for a major Emacs release.) | 18 | the release branch, see admin/release-branch.txt.) |
| 19 | Commit cus-edit.el if changed. | 19 | Commit cus-edit.el if changed. |
| 20 | 20 | ||
| 21 | 3. Remove any old pretests from https://alpha.gnu.org/gnu/emacs/pretest. | 21 | 3. Remove any old pretests from https://alpha.gnu.org/gnu/emacs/pretest. |
| 22 | You can use 'gnupload --delete' (see below for more gnupload details). | 22 | You can use 'gnupload --delete' (see below for more gnupload details). |
| 23 | (We currently don't bother with this.) | ||
| 23 | 24 | ||
| 24 | General steps (for each step, check for possible errors): | 25 | General steps (for each step, check for possible errors): |
| 25 | 26 | ||
| @@ -89,7 +90,7 @@ General steps (for each step, check for possible errors): | |||
| 89 | admin/release-process must be completed. | 90 | admin/release-process must be completed. |
| 90 | 91 | ||
| 91 | Set the version number to that of the actual release (commit in | 92 | Set the version number to that of the actual release (commit in |
| 92 | one, as described above). Pick a date about a week from now when | 93 | one, as described above). Pick a date about a week from now when |
| 93 | you intend to make the release. Use M-x add-release-logs to add | 94 | you intend to make the release. Use M-x add-release-logs to add |
| 94 | entries to etc/HISTORY and the ChangeLog file. It's best not to | 95 | entries to etc/HISTORY and the ChangeLog file. It's best not to |
| 95 | commit these files until the release is actually made. Merge the | 96 | commit these files until the release is actually made. Merge the |
| @@ -163,8 +164,15 @@ General steps (for each step, check for possible errors): | |||
| 163 | 164 | ||
| 164 | If this is the first pretest of a major release, just comparing | 165 | If this is the first pretest of a major release, just comparing |
| 165 | with the previous release may overlook many new files. You can try | 166 | with the previous release may overlook many new files. You can try |
| 166 | something like 'find . | sort' in a clean repository, and compare the | 167 | something like 'find . | sort' in a clean repository, and |
| 167 | results against the new tar contents. | 168 | compare the results against the new tar contents. Another |
| 169 | alternative is using something like: | ||
| 170 | |||
| 171 | tar cf - emacs-NEW | tar t -C /tmp | grep -Ev "\.(o|d)$" | sort | ||
| 172 | |||
| 173 | Where emacs-NEW is the directory containing your clean repository. | ||
| 174 | The output of this command might be easier to compare to the | ||
| 175 | tarball than the one you get from find. | ||
| 168 | 176 | ||
| 169 | 7. tar -xf emacs-NEW.tar; cd emacs-NEW | 177 | 7. tar -xf emacs-NEW.tar; cd emacs-NEW |
| 170 | ./configure --prefix=/tmp/emacs && make check && make install | 178 | ./configure --prefix=/tmp/emacs && make check && make install |
| @@ -194,6 +202,14 @@ General steps (for each step, check for possible errors): | |||
| 194 | git tag -a TAG -m "Emacs TAG" SHA1 | 202 | git tag -a TAG -m "Emacs TAG" SHA1 |
| 195 | git push --tags | 203 | git push --tags |
| 196 | 204 | ||
| 205 | In the past, we were not always consistent with the annotation | ||
| 206 | (i.e. -m "Emacs TAG"). The preferred format is like this for a | ||
| 207 | pretest, release candidate and final release: | ||
| 208 | |||
| 209 | git tag -a emacs-28.0.90 -m "Emacs 28.0.90 pretest" | ||
| 210 | git tag -a emacs-28.1-rc1 -m "Emacs 28.1 RC1" | ||
| 211 | git tag -a emacs-28.1 -m "Emacs 28.1 release" | ||
| 212 | |||
| 197 | 9. Decide what compression schemes to offer. | 213 | 9. Decide what compression schemes to offer. |
| 198 | For a release, at least gz and xz: | 214 | For a release, at least gz and xz: |
| 199 | gzip --best --no-name -c emacs-NEW.tar > emacs-NEW.tar.gz | 215 | gzip --best --no-name -c emacs-NEW.tar > emacs-NEW.tar.gz |
| @@ -256,6 +272,11 @@ General steps (for each step, check for possible errors): | |||
| 256 | because replies that invariably are not announcements also get | 272 | because replies that invariably are not announcements also get |
| 257 | sent out as if they were.) | 273 | sent out as if they were.) |
| 258 | 274 | ||
| 275 | To create the included SHA1 and SHA256 checksums, run: | ||
| 276 | |||
| 277 | sha1sum emacs-NEW.tar.xz | ||
| 278 | sha256sum emacs-NEW.tar.xz | ||
| 279 | |||
| 259 | 12. After a release, update the Emacs pages as described below. | 280 | 12. After a release, update the Emacs pages as described below. |
| 260 | 281 | ||
| 261 | 13. Bump the Emacs version on the release branch. | 282 | 13. Bump the Emacs version on the release branch. |
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index d062e78366f..c07b678839c 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in | |||
| @@ -195,6 +195,8 @@ LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ | |||
| 195 | LIB_GETRANDOM = @LIB_GETRANDOM@ | 195 | LIB_GETRANDOM = @LIB_GETRANDOM@ |
| 196 | ## Whatever libraries are needed for euidaccess | 196 | ## Whatever libraries are needed for euidaccess |
| 197 | LIB_EACCESS=@LIB_EACCESS@ | 197 | LIB_EACCESS=@LIB_EACCESS@ |
| 198 | ## Libraries needed for file_has_acl | ||
| 199 | LIB_HAS_ACL=@LIB_HAS_ACL@ | ||
| 198 | ## empty or -lwsock2 for MinGW | 200 | ## empty or -lwsock2 for MinGW |
| 199 | LIB_WSOCK32=@LIB_WSOCK32@ | 201 | LIB_WSOCK32=@LIB_WSOCK32@ |
| 200 | 202 | ||
| @@ -418,7 +420,7 @@ pop.o: ${srcdir}/pop.c ${srcdir}/pop.h ${srcdir}/../lib/min-max.h $(config_h) | |||
| 418 | emacsclient${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(config_h) | 420 | emacsclient${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(config_h) |
| 419 | $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $< \ | 421 | $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $< \ |
| 420 | $(NTLIB) $(LOADLIBES) \ | 422 | $(NTLIB) $(LOADLIBES) \ |
| 421 | $(LIB_WSOCK32) $(LIB_EACCESS) $(LIBS_ECLIENT) -o $@ | 423 | $(LIB_WSOCK32) $(LIB_EACCESS) $(LIB_HAS_ACL) $(LIBS_ECLIENT) -o $@ |
| 422 | 424 | ||
| 423 | emacsclientw${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(CLIENTRES) $(config_h) | 425 | emacsclientw${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(CLIENTRES) $(config_h) |
| 424 | $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $(CLIENTRES) -mwindows $< \ | 426 | $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $(CLIENTRES) -mwindows $< \ |
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 3c764ff65ab..1c2d95613e5 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el | |||
| @@ -121,8 +121,14 @@ This is only effective if supported by your mouse or touchpad." | |||
| 121 | :type 'float | 121 | :type 'float |
| 122 | :version "29.1") | 122 | :version "29.1") |
| 123 | 123 | ||
| 124 | (defcustom pixel-scroll-precision-momentum-factor 0.95 | 124 | (defcustom pixel-scroll-precision-momentum-min-velocity 10.0 |
| 125 | "Factor by which to reduce scroll velocity on each momentum scroll" | 125 | "The minimum scrolled pixels per second before momentum scrolling starts." |
| 126 | :group 'mouse | ||
| 127 | :type 'float | ||
| 128 | :version "29.1") | ||
| 129 | |||
| 130 | (defcustom pixel-scroll-precision-initial-velocity-factor 0.25 | ||
| 131 | "Factor applied to the initial velocity before momentum scrolling begins." | ||
| 126 | :group 'mouse | 132 | :group 'mouse |
| 127 | :type 'float | 133 | :type 'float |
| 128 | :version "29.1") | 134 | :version "29.1") |
| @@ -524,8 +530,13 @@ It is a vector of the form [ VELOCITY TIME ]." | |||
| 524 | (defun pixel-scroll-accumulate-velocity (delta) | 530 | (defun pixel-scroll-accumulate-velocity (delta) |
| 525 | "Accumulate DELTA into the current window's kinetic scroll state." | 531 | "Accumulate DELTA into the current window's kinetic scroll state." |
| 526 | (let* ((state (pixel-scroll-kinetic-state)) | 532 | (let* ((state (pixel-scroll-kinetic-state)) |
| 533 | (ring (aref state 0)) | ||
| 527 | (time (aref state 1))) | 534 | (time (aref state 1))) |
| 528 | (when (and time (> (- (float-time) time) 0.5)) | 535 | (when (or (and time (> (- (float-time) time) 0.5)) |
| 536 | (and (not (ring-empty-p ring)) | ||
| 537 | (not (eq (< delta 0) | ||
| 538 | (< (cdr (ring-ref ring 0)) | ||
| 539 | 0))))) | ||
| 529 | (aset state 0 (make-ring 10))) | 540 | (aset state 0 (make-ring 10))) |
| 530 | (ring-insert (aref state 0) | 541 | (ring-insert (aref state 0) |
| 531 | (cons (aset state 1 (float-time)) | 542 | (cons (aset state 1 (float-time)) |
| @@ -538,8 +549,7 @@ It is a vector of the form [ VELOCITY TIME ]." | |||
| 538 | (total 0)) | 549 | (total 0)) |
| 539 | (dolist (tem elts) | 550 | (dolist (tem elts) |
| 540 | (setq total (+ total (cdr tem)))) | 551 | (setq total (+ total (cdr tem)))) |
| 541 | (/ total (* (- (caar elts) | 552 | (/ total (* (- (float-time) (caar elts)) |
| 542 | (caar (last elts))) | ||
| 543 | 100)))) | 553 | 100)))) |
| 544 | 554 | ||
| 545 | (defun pixel-scroll-start-momentum (event) | 555 | (defun pixel-scroll-start-momentum (event) |
| @@ -555,26 +565,40 @@ It is a vector of the form [ VELOCITY TIME ]." | |||
| 555 | (while-no-input | 565 | (while-no-input |
| 556 | (unwind-protect (progn | 566 | (unwind-protect (progn |
| 557 | (aset state 0 (pixel-scroll-calculate-velocity state)) | 567 | (aset state 0 (pixel-scroll-calculate-velocity state)) |
| 558 | (let ((velocity (/ (aref state 0) 3)) | 568 | (when (> (abs (aref state 0)) |
| 559 | (time-spent 0)) | 569 | pixel-scroll-precision-momentum-min-velocity) |
| 560 | (if (> velocity 0) | 570 | (let* ((velocity (* (aref state 0) |
| 561 | (while (and (> velocity 0.2) | 571 | pixel-scroll-precision-initial-velocity-factor)) |
| 562 | (<= time-spent pixel-scroll-precision-momentum-seconds)) | 572 | (original-velocity velocity) |
| 563 | (pixel-scroll-precision-scroll-up (ceiling velocity)) | 573 | (time-spent 0)) |
| 564 | (setq velocity (* velocity pixel-scroll-precision-momentum-factor)) | 574 | (if (> velocity 0) |
| 565 | (redisplay t) | 575 | (while (and (> velocity 0) |
| 566 | (sit-for pixel-scroll-precision-momentum-tick) | 576 | (<= time-spent |
| 567 | (setq time-spent (+ time-spent | 577 | pixel-scroll-precision-momentum-seconds)) |
| 568 | pixel-scroll-precision-momentum-tick)))) | 578 | (when (> (round velocity) 0) |
| 569 | (while (and (< velocity -0.4) | 579 | (pixel-scroll-precision-scroll-up (round velocity))) |
| 570 | (<= time-spent | 580 | (setq velocity (- velocity |
| 571 | pixel-scroll-precision-momentum-seconds)) | 581 | (/ original-velocity |
| 572 | (pixel-scroll-precision-scroll-down (floor (abs velocity))) | 582 | (/ pixel-scroll-precision-momentum-seconds |
| 573 | (setq velocity (* velocity pixel-scroll-precision-momentum-factor)) | 583 | pixel-scroll-precision-momentum-tick)))) |
| 574 | (redisplay t) | 584 | (redisplay t) |
| 575 | (sit-for pixel-scroll-precision-momentum-tick) | 585 | (sit-for pixel-scroll-precision-momentum-tick) |
| 576 | (setq time-spent (+ time-spent | 586 | (setq time-spent (+ time-spent |
| 577 | pixel-scroll-precision-momentum-tick))))) | 587 | pixel-scroll-precision-momentum-tick)))) |
| 588 | (while (and (< velocity 0) | ||
| 589 | (<= time-spent | ||
| 590 | pixel-scroll-precision-momentum-seconds)) | ||
| 591 | (when (> (round (abs velocity)) 0) | ||
| 592 | (pixel-scroll-precision-scroll-down (round | ||
| 593 | (abs velocity)))) | ||
| 594 | (setq velocity (+ velocity | ||
| 595 | (/ (abs original-velocity) | ||
| 596 | (/ pixel-scroll-precision-momentum-seconds | ||
| 597 | pixel-scroll-precision-momentum-tick)))) | ||
| 598 | (redisplay t) | ||
| 599 | (sit-for pixel-scroll-precision-momentum-tick) | ||
| 600 | (setq time-spent (+ time-spent | ||
| 601 | pixel-scroll-precision-momentum-tick)))))) | ||
| 578 | (aset state 0 (make-ring 10)) | 602 | (aset state 0 (make-ring 10)) |
| 579 | (aset state 1 nil)))))))) | 603 | (aset state 1 nil)))))))) |
| 580 | 604 | ||
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 656cb878e3e..7a5221d83ab 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el | |||
| @@ -1586,18 +1586,17 @@ happens interactively)." | |||
| 1586 | (let* ((tabs (funcall tab-bar-tabs-function)) | 1586 | (let* ((tabs (funcall tab-bar-tabs-function)) |
| 1587 | (current-index (tab-bar--current-tab-index tabs)) | 1587 | (current-index (tab-bar--current-tab-index tabs)) |
| 1588 | (keep-index (if (integerp tab-number) | 1588 | (keep-index (if (integerp tab-number) |
| 1589 | (1- (max 0 (min tab-number (length tabs)))) | 1589 | (1- (max 1 (min tab-number (length tabs)))) |
| 1590 | current-index)) | 1590 | current-index)) |
| 1591 | (keep-tab (nth keep-index tabs)) | ||
| 1592 | (index 0)) | 1591 | (index 0)) |
| 1593 | 1592 | ||
| 1594 | (when keep-tab | 1593 | (when (nth keep-index tabs) |
| 1595 | (unless (eq keep-index current-index) | 1594 | (unless (eq keep-index current-index) |
| 1596 | (tab-bar-select-tab (1+ keep-index)) | 1595 | (tab-bar-select-tab (1+ keep-index)) |
| 1597 | (setq tabs (funcall tab-bar-tabs-function))) | 1596 | (setq tabs (funcall tab-bar-tabs-function))) |
| 1598 | 1597 | ||
| 1599 | (dolist (tab tabs) | 1598 | (dolist (tab tabs) |
| 1600 | (unless (or (eq tab keep-tab) | 1599 | (unless (or (eq index keep-index) |
| 1601 | (run-hook-with-args-until-success | 1600 | (run-hook-with-args-until-success |
| 1602 | 'tab-bar-tab-prevent-close-functions tab | 1601 | 'tab-bar-tab-prevent-close-functions tab |
| 1603 | ;; `last-tab-p' logically can't ever be true | 1602 | ;; `last-tab-p' logically can't ever be true |
diff --git a/src/alloc.c b/src/alloc.c index 24dc07b3696..ff845989264 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -3160,26 +3160,26 @@ cleanup_vector (struct Lisp_Vector *vector) | |||
| 3160 | module_finalize_function (function); | 3160 | module_finalize_function (function); |
| 3161 | } | 3161 | } |
| 3162 | #endif | 3162 | #endif |
| 3163 | else if (NATIVE_COMP_FLAG | 3163 | #ifdef HAVE_NATIVE_COMP |
| 3164 | && PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT)) | 3164 | else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT)) |
| 3165 | { | 3165 | { |
| 3166 | struct Lisp_Native_Comp_Unit *cu = | 3166 | struct Lisp_Native_Comp_Unit *cu = |
| 3167 | PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit); | 3167 | PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit); |
| 3168 | unload_comp_unit (cu); | 3168 | unload_comp_unit (cu); |
| 3169 | } | 3169 | } |
| 3170 | else if (NATIVE_COMP_FLAG | 3170 | else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_SUBR)) |
| 3171 | && PSEUDOVECTOR_TYPEP (&vector->header, PVEC_SUBR)) | ||
| 3172 | { | 3171 | { |
| 3173 | struct Lisp_Subr *subr = | 3172 | struct Lisp_Subr *subr = |
| 3174 | PSEUDOVEC_STRUCT (vector, Lisp_Subr); | 3173 | PSEUDOVEC_STRUCT (vector, Lisp_Subr); |
| 3175 | if (!NILP (subr->native_comp_u[0])) | 3174 | if (!NILP (subr->native_comp_u)) |
| 3176 | { | 3175 | { |
| 3177 | /* FIXME Alternative and non invasive solution to this | 3176 | /* FIXME Alternative and non invasive solution to this |
| 3178 | cast? */ | 3177 | cast? */ |
| 3179 | xfree ((char *)subr->symbol_name); | 3178 | xfree ((char *)subr->symbol_name); |
| 3180 | xfree (subr->native_c_name[0]); | 3179 | xfree (subr->native_c_name); |
| 3181 | } | 3180 | } |
| 3182 | } | 3181 | } |
| 3182 | #endif | ||
| 3183 | } | 3183 | } |
| 3184 | 3184 | ||
| 3185 | /* Reclaim space used by unmarked vectors. */ | 3185 | /* Reclaim space used by unmarked vectors. */ |
| @@ -6788,15 +6788,17 @@ mark_object (Lisp_Object arg) | |||
| 6788 | break; | 6788 | break; |
| 6789 | 6789 | ||
| 6790 | case PVEC_SUBR: | 6790 | case PVEC_SUBR: |
| 6791 | #ifdef HAVE_NATIVE_COMP | ||
| 6791 | if (SUBR_NATIVE_COMPILEDP (obj)) | 6792 | if (SUBR_NATIVE_COMPILEDP (obj)) |
| 6792 | { | 6793 | { |
| 6793 | set_vector_marked (ptr); | 6794 | set_vector_marked (ptr); |
| 6794 | struct Lisp_Subr *subr = XSUBR (obj); | 6795 | struct Lisp_Subr *subr = XSUBR (obj); |
| 6795 | mark_object (subr->native_intspec); | 6796 | mark_object (subr->native_intspec); |
| 6796 | mark_object (subr->native_comp_u[0]); | 6797 | mark_object (subr->native_comp_u); |
| 6797 | mark_object (subr->lambda_list[0]); | 6798 | mark_object (subr->lambda_list); |
| 6798 | mark_object (subr->type[0]); | 6799 | mark_object (subr->type); |
| 6799 | } | 6800 | } |
| 6801 | #endif | ||
| 6800 | break; | 6802 | break; |
| 6801 | 6803 | ||
| 6802 | case PVEC_FREE: | 6804 | case PVEC_FREE: |
diff --git a/src/comp.c b/src/comp.c index 7bb160e4f0a..fb9b1a5a2d8 100644 --- a/src/comp.c +++ b/src/comp.c | |||
| @@ -5136,21 +5136,29 @@ make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg, | |||
| 5136 | if (CONSP (minarg)) | 5136 | if (CONSP (minarg)) |
| 5137 | { | 5137 | { |
| 5138 | /* Dynamic code. */ | 5138 | /* Dynamic code. */ |
| 5139 | x->s.lambda_list[0] = maxarg; | 5139 | #ifdef HAVE_NATIVE_COMP |
| 5140 | x->s.lambda_list = maxarg; | ||
| 5141 | #endif | ||
| 5140 | maxarg = XCDR (minarg); | 5142 | maxarg = XCDR (minarg); |
| 5141 | minarg = XCAR (minarg); | 5143 | minarg = XCAR (minarg); |
| 5142 | } | 5144 | } |
| 5143 | else | 5145 | else |
| 5144 | x->s.lambda_list[0] = Qnil; | 5146 | { |
| 5147 | #ifdef HAVE_NATIVE_COMP | ||
| 5148 | x->s.lambda_list = Qnil; | ||
| 5149 | #endif | ||
| 5150 | } | ||
| 5145 | x->s.function.a0 = func; | 5151 | x->s.function.a0 = func; |
| 5146 | x->s.min_args = XFIXNUM (minarg); | 5152 | x->s.min_args = XFIXNUM (minarg); |
| 5147 | x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; | 5153 | x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; |
| 5148 | x->s.symbol_name = xstrdup (SSDATA (symbol_name)); | 5154 | x->s.symbol_name = xstrdup (SSDATA (symbol_name)); |
| 5149 | x->s.native_intspec = intspec; | 5155 | x->s.native_intspec = intspec; |
| 5150 | x->s.doc = XFIXNUM (doc_idx); | 5156 | x->s.doc = XFIXNUM (doc_idx); |
| 5151 | x->s.native_comp_u[0] = comp_u; | 5157 | #ifdef HAVE_NATIVE_COMP |
| 5152 | x->s.native_c_name[0] = xstrdup (SSDATA (c_name)); | 5158 | x->s.native_comp_u = comp_u; |
| 5153 | x->s.type[0] = type; | 5159 | x->s.native_c_name = xstrdup (SSDATA (c_name)); |
| 5160 | x->s.type = type; | ||
| 5161 | #endif | ||
| 5154 | Lisp_Object tem; | 5162 | Lisp_Object tem; |
| 5155 | XSETSUBR (tem, &x->s); | 5163 | XSETSUBR (tem, &x->s); |
| 5156 | 5164 | ||
diff --git a/src/comp.h b/src/comp.h index c4af4193d0b..96bb52a14bc 100644 --- a/src/comp.h +++ b/src/comp.h | |||
| @@ -20,16 +20,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 20 | #ifndef COMP_H | 20 | #ifndef COMP_H |
| 21 | #define COMP_H | 21 | #define COMP_H |
| 22 | 22 | ||
| 23 | /* To keep ifdefs under control. */ | ||
| 24 | enum { | ||
| 25 | NATIVE_COMP_FLAG = | ||
| 26 | #ifdef HAVE_NATIVE_COMP | ||
| 27 | 1 | ||
| 28 | #else | ||
| 29 | 0 | ||
| 30 | #endif | ||
| 31 | }; | ||
| 32 | |||
| 33 | #include <dynlib.h> | 23 | #include <dynlib.h> |
| 34 | 24 | ||
| 35 | struct Lisp_Native_Comp_Unit | 25 | struct Lisp_Native_Comp_Unit |
diff --git a/src/data.c b/src/data.c index 0d3376f0903..b2c395831ae 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -891,9 +891,11 @@ function or t otherwise. */) | |||
| 891 | { | 891 | { |
| 892 | CHECK_SUBR (subr); | 892 | CHECK_SUBR (subr); |
| 893 | 893 | ||
| 894 | return SUBR_NATIVE_COMPILED_DYNP (subr) | 894 | #ifdef HAVE_NATIVE_COMP |
| 895 | ? XSUBR (subr)->lambda_list[0] | 895 | if (SUBR_NATIVE_COMPILED_DYNP (subr)) |
| 896 | : Qt; | 896 | return XSUBR (subr)->lambda_list; |
| 897 | #endif | ||
| 898 | return Qt; | ||
| 897 | } | 899 | } |
| 898 | 900 | ||
| 899 | DEFUN ("subr-type", Fsubr_type, | 901 | DEFUN ("subr-type", Fsubr_type, |
| @@ -917,7 +919,7 @@ DEFUN ("subr-native-comp-unit", Fsubr_native_comp_unit, | |||
| 917 | (Lisp_Object subr) | 919 | (Lisp_Object subr) |
| 918 | { | 920 | { |
| 919 | CHECK_SUBR (subr); | 921 | CHECK_SUBR (subr); |
| 920 | return XSUBR (subr)->native_comp_u[0]; | 922 | return XSUBR (subr)->native_comp_u; |
| 921 | } | 923 | } |
| 922 | 924 | ||
| 923 | DEFUN ("native-comp-unit-file", Fnative_comp_unit_file, | 925 | DEFUN ("native-comp-unit-file", Fnative_comp_unit_file, |
diff --git a/src/eval.c b/src/eval.c index 94ad0607732..fe29564aa2d 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -220,17 +220,14 @@ void | |||
| 220 | init_eval_once (void) | 220 | init_eval_once (void) |
| 221 | { | 221 | { |
| 222 | /* Don't forget to update docs (lispref node "Local Variables"). */ | 222 | /* Don't forget to update docs (lispref node "Local Variables"). */ |
| 223 | if (!NATIVE_COMP_FLAG) | 223 | #ifndef HAVE_NATIVE_COMP |
| 224 | { | 224 | max_specpdl_size = 1800; /* See bug#46818. */ |
| 225 | max_specpdl_size = 1800; /* See bug#46818. */ | 225 | max_lisp_eval_depth = 800; |
| 226 | max_lisp_eval_depth = 800; | 226 | #else |
| 227 | } | 227 | /* Original values increased for comp.el. */ |
| 228 | else | 228 | max_specpdl_size = 2500; |
| 229 | { | 229 | max_lisp_eval_depth = 1600; |
| 230 | /* Original values increased for comp.el. */ | 230 | #endif |
| 231 | max_specpdl_size = 2500; | ||
| 232 | max_lisp_eval_depth = 1600; | ||
| 233 | } | ||
| 234 | Vrun_hooks = Qnil; | 231 | Vrun_hooks = Qnil; |
| 235 | pdumper_do_now_and_after_load (init_eval_once_for_pdumper); | 232 | pdumper_do_now_and_after_load (init_eval_once_for_pdumper); |
| 236 | } | 233 | } |
| @@ -3278,11 +3275,13 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, | |||
| 3278 | else if (MODULE_FUNCTIONP (fun)) | 3275 | else if (MODULE_FUNCTIONP (fun)) |
| 3279 | return funcall_module (fun, nargs, arg_vector); | 3276 | return funcall_module (fun, nargs, arg_vector); |
| 3280 | #endif | 3277 | #endif |
| 3278 | #ifdef HAVE_NATIVE_COMP | ||
| 3281 | else if (SUBR_NATIVE_COMPILED_DYNP (fun)) | 3279 | else if (SUBR_NATIVE_COMPILED_DYNP (fun)) |
| 3282 | { | 3280 | { |
| 3283 | syms_left = XSUBR (fun)->lambda_list[0]; | 3281 | syms_left = XSUBR (fun)->lambda_list; |
| 3284 | lexenv = Qnil; | 3282 | lexenv = Qnil; |
| 3285 | } | 3283 | } |
| 3284 | #endif | ||
| 3286 | else | 3285 | else |
| 3287 | emacs_abort (); | 3286 | emacs_abort (); |
| 3288 | 3287 | ||
diff --git a/src/fileio.c b/src/fileio.c index 859b30564aa..12ece586b83 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -2386,7 +2386,9 @@ permissions. */) | |||
| 2386 | 2386 | ||
| 2387 | if (!NILP (keep_time)) | 2387 | if (!NILP (keep_time)) |
| 2388 | { | 2388 | { |
| 2389 | struct timespec ts[] = { get_stat_atime (&st), get_stat_mtime (&st) }; | 2389 | struct timespec ts[2]; |
| 2390 | ts[0] = get_stat_atime (&st); | ||
| 2391 | ts[1] = get_stat_mtime (&st); | ||
| 2390 | if (futimens (ofd, ts) != 0) | 2392 | if (futimens (ofd, ts) != 0) |
| 2391 | xsignal2 (Qfile_date_error, | 2393 | xsignal2 (Qfile_date_error, |
| 2392 | build_string ("Cannot set file date"), newname); | 2394 | build_string ("Cannot set file date"), newname); |
diff --git a/src/lisp.h b/src/lisp.h index 19caba40014..242156bbcb8 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -2091,10 +2091,12 @@ struct Lisp_Subr | |||
| 2091 | Lisp_Object native_intspec; | 2091 | Lisp_Object native_intspec; |
| 2092 | }; | 2092 | }; |
| 2093 | EMACS_INT doc; | 2093 | EMACS_INT doc; |
| 2094 | Lisp_Object native_comp_u[NATIVE_COMP_FLAG]; | 2094 | #ifdef HAVE_NATIVE_COMP |
| 2095 | char *native_c_name[NATIVE_COMP_FLAG]; | 2095 | Lisp_Object native_comp_u; |
| 2096 | Lisp_Object lambda_list[NATIVE_COMP_FLAG]; | 2096 | char *native_c_name; |
| 2097 | Lisp_Object type[NATIVE_COMP_FLAG]; | 2097 | Lisp_Object lambda_list; |
| 2098 | Lisp_Object type; | ||
| 2099 | #endif | ||
| 2098 | } GCALIGNED_STRUCT; | 2100 | } GCALIGNED_STRUCT; |
| 2099 | union Aligned_Lisp_Subr | 2101 | union Aligned_Lisp_Subr |
| 2100 | { | 2102 | { |
| @@ -4786,19 +4788,19 @@ extern char *emacs_root_dir (void); | |||
| 4786 | INLINE bool | 4788 | INLINE bool |
| 4787 | SUBR_NATIVE_COMPILEDP (Lisp_Object a) | 4789 | SUBR_NATIVE_COMPILEDP (Lisp_Object a) |
| 4788 | { | 4790 | { |
| 4789 | return SUBRP (a) && !NILP (XSUBR (a)->native_comp_u[0]); | 4791 | return SUBRP (a) && !NILP (XSUBR (a)->native_comp_u); |
| 4790 | } | 4792 | } |
| 4791 | 4793 | ||
| 4792 | INLINE bool | 4794 | INLINE bool |
| 4793 | SUBR_NATIVE_COMPILED_DYNP (Lisp_Object a) | 4795 | SUBR_NATIVE_COMPILED_DYNP (Lisp_Object a) |
| 4794 | { | 4796 | { |
| 4795 | return SUBR_NATIVE_COMPILEDP (a) && !NILP (XSUBR (a)->lambda_list[0]); | 4797 | return SUBR_NATIVE_COMPILEDP (a) && !NILP (XSUBR (a)->lambda_list); |
| 4796 | } | 4798 | } |
| 4797 | 4799 | ||
| 4798 | INLINE Lisp_Object | 4800 | INLINE Lisp_Object |
| 4799 | SUBR_TYPE (Lisp_Object a) | 4801 | SUBR_TYPE (Lisp_Object a) |
| 4800 | { | 4802 | { |
| 4801 | return XSUBR (a)->type[0]; | 4803 | return XSUBR (a)->type; |
| 4802 | } | 4804 | } |
| 4803 | 4805 | ||
| 4804 | INLINE struct Lisp_Native_Comp_Unit * | 4806 | INLINE struct Lisp_Native_Comp_Unit * |
diff --git a/src/lread.c b/src/lread.c index 2e63ec48912..5a2f1bc54e5 100644 --- a/src/lread.c +++ b/src/lread.c | |||
| @@ -1279,7 +1279,10 @@ Return t if the file exists and loads successfully. */) | |||
| 1279 | || suffix_p (file, MODULES_SECONDARY_SUFFIX) | 1279 | || suffix_p (file, MODULES_SECONDARY_SUFFIX) |
| 1280 | #endif | 1280 | #endif |
| 1281 | #endif | 1281 | #endif |
| 1282 | || (NATIVE_COMP_FLAG && suffix_p (file, NATIVE_ELISP_SUFFIX))) | 1282 | #ifdef HAVE_NATIVE_COMP |
| 1283 | || suffix_p (file, NATIVE_ELISP_SUFFIX) | ||
| 1284 | #endif | ||
| 1285 | ) | ||
| 1283 | must_suffix = Qnil; | 1286 | must_suffix = Qnil; |
| 1284 | /* Don't insist on adding a suffix | 1287 | /* Don't insist on adding a suffix |
| 1285 | if the argument includes a directory name. */ | 1288 | if the argument includes a directory name. */ |
| @@ -1359,8 +1362,11 @@ Return t if the file exists and loads successfully. */) | |||
| 1359 | bool is_module = false; | 1362 | bool is_module = false; |
| 1360 | #endif | 1363 | #endif |
| 1361 | 1364 | ||
| 1362 | bool is_native_elisp = | 1365 | #ifdef HAVE_NATIVE_COMP |
| 1363 | NATIVE_COMP_FLAG && suffix_p (found, NATIVE_ELISP_SUFFIX) ? true : false; | 1366 | bool is_native_elisp = suffix_p (found, NATIVE_ELISP_SUFFIX); |
| 1367 | #else | ||
| 1368 | bool is_native_elisp = false; | ||
| 1369 | #endif | ||
| 1364 | 1370 | ||
| 1365 | /* Check if we're stuck in a recursive load cycle. | 1371 | /* Check if we're stuck in a recursive load cycle. |
| 1366 | 1372 | ||
diff --git a/src/pdumper.c b/src/pdumper.c index 9eff5c48d09..02956aa7cec 100644 --- a/src/pdumper.c +++ b/src/pdumper.c | |||
| @@ -2860,13 +2860,18 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) | |||
| 2860 | struct Lisp_Subr out; | 2860 | struct Lisp_Subr out; |
| 2861 | dump_object_start (ctx, &out, sizeof (out)); | 2861 | dump_object_start (ctx, &out, sizeof (out)); |
| 2862 | DUMP_FIELD_COPY (&out, subr, header.size); | 2862 | DUMP_FIELD_COPY (&out, subr, header.size); |
| 2863 | if (NATIVE_COMP_FLAG && !NILP (subr->native_comp_u[0])) | 2863 | #ifdef HAVE_NATIVE_COMP |
| 2864 | bool native_comp = !NILP (subr->native_comp_u); | ||
| 2865 | #else | ||
| 2866 | bool native_comp = false; | ||
| 2867 | #endif | ||
| 2868 | if (native_comp) | ||
| 2864 | out.function.a0 = NULL; | 2869 | out.function.a0 = NULL; |
| 2865 | else | 2870 | else |
| 2866 | dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0); | 2871 | dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0); |
| 2867 | DUMP_FIELD_COPY (&out, subr, min_args); | 2872 | DUMP_FIELD_COPY (&out, subr, min_args); |
| 2868 | DUMP_FIELD_COPY (&out, subr, max_args); | 2873 | DUMP_FIELD_COPY (&out, subr, max_args); |
| 2869 | if (NATIVE_COMP_FLAG && !NILP (subr->native_comp_u[0])) | 2874 | if (native_comp) |
| 2870 | { | 2875 | { |
| 2871 | dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name); | 2876 | dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name); |
| 2872 | dump_remember_cold_op (ctx, | 2877 | dump_remember_cold_op (ctx, |
| @@ -2880,19 +2885,16 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) | |||
| 2880 | dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec); | 2885 | dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec); |
| 2881 | } | 2886 | } |
| 2882 | DUMP_FIELD_COPY (&out, subr, doc); | 2887 | DUMP_FIELD_COPY (&out, subr, doc); |
| 2883 | if (NATIVE_COMP_FLAG) | 2888 | #ifdef HAVE_NATIVE_COMP |
| 2884 | { | 2889 | dump_field_lv (ctx, &out, subr, &subr->native_comp_u, WEIGHT_NORMAL); |
| 2885 | dump_field_lv (ctx, &out, subr, &subr->native_comp_u[0], WEIGHT_NORMAL); | 2890 | if (!NILP (subr->native_comp_u)) |
| 2886 | if (!NILP (subr->native_comp_u[0])) | 2891 | dump_field_fixup_later (ctx, &out, subr, &subr->native_c_name); |
| 2887 | dump_field_fixup_later (ctx, &out, subr, &subr->native_c_name[0]); | ||
| 2888 | 2892 | ||
| 2889 | dump_field_lv (ctx, &out, subr, &subr->lambda_list[0], WEIGHT_NORMAL); | 2893 | dump_field_lv (ctx, &out, subr, &subr->lambda_list, WEIGHT_NORMAL); |
| 2890 | dump_field_lv (ctx, &out, subr, &subr->type[0], WEIGHT_NORMAL); | 2894 | dump_field_lv (ctx, &out, subr, &subr->type, WEIGHT_NORMAL); |
| 2891 | } | 2895 | #endif |
| 2892 | dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out)); | 2896 | dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out)); |
| 2893 | if (NATIVE_COMP_FLAG | 2897 | if (native_comp && ctx->flags.dump_object_contents) |
| 2894 | && ctx->flags.dump_object_contents | ||
| 2895 | && !NILP (subr->native_comp_u[0])) | ||
| 2896 | /* We'll do the final addr relocation during VERY_LATE_RELOCS time | 2898 | /* We'll do the final addr relocation during VERY_LATE_RELOCS time |
| 2897 | after the compilation units has been loaded. */ | 2899 | after the compilation units has been loaded. */ |
| 2898 | dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS], | 2900 | dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS], |
| @@ -3422,9 +3424,9 @@ dump_cold_native_subr (struct dump_context *ctx, Lisp_Object subr) | |||
| 3422 | 3424 | ||
| 3423 | dump_remember_fixup_ptr_raw | 3425 | dump_remember_fixup_ptr_raw |
| 3424 | (ctx, | 3426 | (ctx, |
| 3425 | subr_offset + dump_offsetof (struct Lisp_Subr, native_c_name[0]), | 3427 | subr_offset + dump_offsetof (struct Lisp_Subr, native_c_name), |
| 3426 | ctx->offset); | 3428 | ctx->offset); |
| 3427 | const char *c_name = XSUBR (subr)->native_c_name[0]; | 3429 | const char *c_name = XSUBR (subr)->native_c_name; |
| 3428 | dump_write (ctx, c_name, 1 + strlen (c_name)); | 3430 | dump_write (ctx, c_name, 1 + strlen (c_name)); |
| 3429 | } | 3431 | } |
| 3430 | #endif | 3432 | #endif |
| @@ -5361,20 +5363,16 @@ dump_do_dump_relocation (const uintptr_t dump_base, | |||
| 5361 | } | 5363 | } |
| 5362 | case RELOC_NATIVE_SUBR: | 5364 | case RELOC_NATIVE_SUBR: |
| 5363 | { | 5365 | { |
| 5364 | if (!NATIVE_COMP_FLAG) | ||
| 5365 | /* This cannot happen. */ | ||
| 5366 | emacs_abort (); | ||
| 5367 | |||
| 5368 | /* When resurrecting from a dump given non all the original | 5366 | /* When resurrecting from a dump given non all the original |
| 5369 | native compiled subrs may be still around we can't rely on | 5367 | native compiled subrs may be still around we can't rely on |
| 5370 | a 'top_level_run' mechanism, we revive them one-by-one | 5368 | a 'top_level_run' mechanism, we revive them one-by-one |
| 5371 | here. */ | 5369 | here. */ |
| 5372 | struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset); | 5370 | struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset); |
| 5373 | struct Lisp_Native_Comp_Unit *comp_u = | 5371 | struct Lisp_Native_Comp_Unit *comp_u = |
| 5374 | XNATIVE_COMP_UNIT (subr->native_comp_u[0]); | 5372 | XNATIVE_COMP_UNIT (subr->native_comp_u); |
| 5375 | if (!comp_u->handle) | 5373 | if (!comp_u->handle) |
| 5376 | error ("NULL handle in compilation unit %s", SSDATA (comp_u->file)); | 5374 | error ("NULL handle in compilation unit %s", SSDATA (comp_u->file)); |
| 5377 | const char *c_name = subr->native_c_name[0]; | 5375 | const char *c_name = subr->native_c_name; |
| 5378 | eassert (c_name); | 5376 | eassert (c_name); |
| 5379 | void *func = dynlib_sym (comp_u->handle, c_name); | 5377 | void *func = dynlib_sym (comp_u->handle, c_name); |
| 5380 | if (!func) | 5378 | if (!func) |
diff --git a/test/lisp/tab-bar-tests.el b/test/lisp/tab-bar-tests.el new file mode 100644 index 00000000000..7212ce89167 --- /dev/null +++ b/test/lisp/tab-bar-tests.el | |||
| @@ -0,0 +1,51 @@ | |||
| 1 | ;;; tab-bar-tests.el --- Tests for tab-bar.el -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2021 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Juri Linkov <juri@linkov.net> | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 12 | ;; (at your option) any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 21 | |||
| 22 | ;;; Code: | ||
| 23 | |||
| 24 | (require 'ert) | ||
| 25 | |||
| 26 | (defun tab-bar-tests-close-other-tabs (arg) | ||
| 27 | (tab-bar-tabs-set nil) | ||
| 28 | (tab-rename "1") | ||
| 29 | (tab-new) (tab-rename "2") ;; (tab-switch "2") | ||
| 30 | (tab-new) (tab-rename "3") ;; (tab-switch "3") | ||
| 31 | (should (eq (length (tab-bar-tabs)) 3)) | ||
| 32 | (should (equal (alist-get 'name (tab-bar--current-tab-find)) "3")) | ||
| 33 | (tab-bar-close-other-tabs arg) | ||
| 34 | (should (equal (alist-get 'name (tab-bar--current-tab-find)) | ||
| 35 | (if arg (number-to-string (max 1 (min arg 3))) "3"))) | ||
| 36 | (should (eq (length (tab-bar-tabs)) 1)) | ||
| 37 | (should (eq (length tab-bar-closed-tabs) 2)) | ||
| 38 | (tab-undo) | ||
| 39 | (tab-undo) | ||
| 40 | (should (equal (tab-undo) "No more closed tabs to undo")) | ||
| 41 | (should (eq (length (tab-bar-tabs)) 3)) | ||
| 42 | (should (eq (length tab-bar-closed-tabs) 0))) | ||
| 43 | |||
| 44 | (ert-deftest tab-bar-tests-close-other-tabs-default () | ||
| 45 | (tab-bar-tests-close-other-tabs nil)) | ||
| 46 | |||
| 47 | (ert-deftest tab-bar-tests-close-other-tabs-with-arg () | ||
| 48 | (dotimes (i 5) (tab-bar-tests-close-other-tabs i))) | ||
| 49 | |||
| 50 | (provide 'tab-bar-tests) | ||
| 51 | ;;; tab-bar-tests.el ends here | ||