bug#27016: possible bug in `defsetf'

bug#27016: possible bug in `defsetf'

[Rafael D Sorkin]

Hi, 

The second behavior below seems like a bug to me.  It was not
present in emacs 23.1

Best wishes, 
Rafael Sorkin


emacs-version				; 23.1.1
(setq pair (cons 3 4))			; (3 . 4)
(foobar pair)				; Symbol's function definition is void: foobar
(setf (foobar pair) 0)			; No setf-method known for foobar 
(unless t
  (defalias 'foobar 'cons)
  (defsetf foobar setcar))		; nil 
(foobar pair)				; same as above
(setf (foobar pair) 0)			; same as above
pair					; (3 . 4)


emacs-version				; 24.5.1
(setq pair (cons 3 4))			; (3 . 4)
(foobar pair)				; Symbol's function definition is void: foobar
(setf (foobar pair) 0)			; (foobar pair) is not a valid place expression 
(unless t
  (defalias 'foobar 'cons)
  (defsetf foobar setcar))		; nil 
(foobar pair)				; same as above
(setf (foobar pair) 0)			; 0       !
pair					; (0 . 4) !


~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-
 Rafael Sorkin
 Perimeter Institute for Theoretical Physics
 31 Caroline Street North
 Waterloo, ON  N2L 2Y5
 Canada
~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-

bug#27016: possible bug in `defsetf'

[npostavs]

tags 27016 unreproducible
quit

Rafael D Sorkin <rsorkin@perimeterinstitute.ca> writes:

> emacs-version				; 24.5.1
> (setq pair (cons 3 4))			; (3 . 4)
> (foobar pair)				; Symbol's function definition is void: foobar
> (setf (foobar pair) 0)			; (foobar pair) is not a valid place expression 
> (unless t
>   (defalias 'foobar 'cons)
>   (defsetf foobar setcar))		; nil 
> (foobar pair)				; same as above
> (setf (foobar pair) 0)			; 0       !
> pair					; (0 . 4) !

I'm not able to reproduce this behaviour on 24.5, the second setf throws
an error just like the first.  How are you evaluating these exactly
(starting from emacs -Q)?  I tried C-x C-e on each sexp in turn.

bug#27016: possible bug in `defsetf'

[Rafael D Sorkin]

Hi Noam,

Following your suggestion I tried starting with "emacs -Q" and
got the same results as you did.  However if I (require 'cl)
then the bug returns.  (I normally require CL automatically on
starting emacs.)  So perhaps it's an incompatibility between CL
and the new way that defsetf is implemented.

- Rafael

 > Sender: Noam Postavsky <npostavs@gmail.com>
 > From: npostavs@users.sourceforge.net
 > To: Rafael D Sorkin <rsorkin@perimeterinstitute.ca>
 > Cc: 27016@debbugs.gnu.org
 > Subject: Re: bug#27016: possible bug in `defsetf'
 > Date: Mon, 22 May 2017 08:11:25 -0400
 > In-Reply-To: <E1dCh04-0001Bd-Ec@mars.pi.local> (Rafael D. Sorkin's message of
 >  "Mon, 22 May 2017 02:39:28 -0400")
 > User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2 (gnu/linux)
 > 
 > tags 27016 unreproducible
 > quit
 > 
 > Rafael D Sorkin <rsorkin@perimeterinstitute.ca> writes:
 > 
 > > emacs-version				; 24.5.1
 > > (setq pair (cons 3 4))			; (3 . 4)
 > > (foobar pair)				; Symbol's function definition is void: foobar
 > > (setf (foobar pair) 0)			; (foobar pair) is not a valid place expression 
 > > (unless t
 > >   (defalias 'foobar 'cons)
 > >   (defsetf foobar setcar))		; nil 
 > > (foobar pair)				; same as above
 > > (setf (foobar pair) 0)			; 0       !
 > > pair					; (0 . 4) !
 > 
 > I'm not able to reproduce this behaviour on 24.5, the second setf throws
 > an error just like the first.  How are you evaluating these exactly
 > (starting from emacs -Q)?  I tried C-x C-e on each sexp in turn.

~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-
 Rafael Sorkin
 Perimeter Institute for Theoretical Physics
 31 Caroline Street North
 Waterloo, ON  N2L 2Y5
 Canada
~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-

bug#27016: possible bug in `defsetf'

[npostavs]

tags 27016 - unreproducible
found 27016 24.4
found 27016 25.2
quit

Rafael D Sorkin <rsorkin@perimeterinstitute.ca> writes:

> Following your suggestion I tried starting with "emacs -Q" and
> got the same results as you did.  However if I (require 'cl)
> then the bug returns.  (I normally require CL automatically on
> starting emacs.)  So perhaps it's an incompatibility between CL
> and the new way that defsetf is implemented.

Oh, right, I see it now.  It happens in 24.4 and later.  I'm not sure
it's a bug though.  My guess is that the difference is eager
macroexpansion.  When I compile, then I get the same behaviour with 24.3
(that's my earliest working Emacs build) as well.

    $ emacs -Q -batch -l cl -f batch-byte-compile bug-27016-defsetf.el 

    In toplevel form:
    bug-27016-defsetf.el:1:1:Warning: cl package required at runtime
    bug-27016-defsetf.el:3:1:Warning: global/dynamic var `pair' lacks a prefix
    Wrote /home/npostavs/src/emacs/bug-27016-defsetf.elc
    $ emacs -Q -batch -l bug-27016-defsetf.elc
    pair: (0 . 4)

where bug-27016-defsetf.el has contents:

    (require 'cl)

    (defvar pair nil)
    (setq pair (cons 3 4))                  ; (3 . 4)
    (unless t
      (defalias 'foobar 'cons)
      (defsetf foobar setcar))              ; nil
    (setf (foobar pair) 0)                  ; 0       !

    (message "pair: %S" pair)

bug#27016: possible bug in `defsetf'

[Rafael D Sorkin]

Thanks, I was wondering about that myself.  Is there a standard
for elisp (or common lisp) that would determine whether eager
macro expansion is an error in this case?

I would expect that a `defun' or `defsetf' etc which is within a
conditional would not be executed until it was known whether the
condition was satisfied.  The opposite behavior seems
counter-intuitive to me.

But if you decide that this behavior is not a bug, then please
let me know, so that I can adapt to it in the future.

 > tags 27016 - unreproducible
 > found 27016 24.4
 > found 27016 25.2
 > quit
 > 
 > Rafael D Sorkin <rsorkin@perimeterinstitute.ca> writes:
 > 
 > > Following your suggestion I tried starting with "emacs -Q" and
 > > got the same results as you did.  However if I (require 'cl)
 > > then the bug returns.  (I normally require CL automatically on
 > > starting emacs.)  So perhaps it's an incompatibility between CL
 > > and the new way that defsetf is implemented.
 > 
 > Oh, right, I see it now.  It happens in 24.4 and later.  I'm not sure
 > it's a bug though.  My guess is that the difference is eager
 > macroexpansion.  When I compile, then I get the same behaviour with 24.3
 > (that's my earliest working Emacs build) as well.
 > 
 >     $ emacs -Q -batch -l cl -f batch-byte-compile bug-27016-defsetf.el 
 > 
 >     In toplevel form:
 >     bug-27016-defsetf.el:1:1:Warning: cl package required at runtime
 >     bug-27016-defsetf.el:3:1:Warning: global/dynamic var `pair' lacks a prefix
 >     Wrote /home/npostavs/src/emacs/bug-27016-defsetf.elc
 >     $ emacs -Q -batch -l bug-27016-defsetf.elc
 >     pair: (0 . 4)
 > 
 > where bug-27016-defsetf.el has contents:
 > 
 >     (require 'cl)
 > 
 >     (defvar pair nil)
 >     (setq pair (cons 3 4))                  ; (3 . 4)
 >     (unless t
 >       (defalias 'foobar 'cons)
 >       (defsetf foobar setcar))              ; nil
 >     (setf (foobar pair) 0)                  ; 0       !
 > 
 >     (message "pair: %S" pair)

~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-
 Rafael Sorkin
 Perimeter Institute for Theoretical Physics
 31 Caroline Street North
 Waterloo, ON  N2L 2Y5
 Canada
~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-

bug#27016: possible bug in `defsetf'

[Michael Heerdegen]

npostavs@users.sourceforge.net writes:

> Oh, right, I see it now.  It happens in 24.4 and later.  I'm not sure
> it's a bug though.  My guess is that the difference is eager
> macroexpansion.  When I compile, then I get the same behaviour with 24.3
> (that's my earliest working Emacs build) as well.

(require 'cl)

(macroexpand-1 (macroexpand-1 (macroexpand-1 '(defsetf foobar setcar))))
==>

#+begin_src emacs-lisp
(gv-define-expander foobar
  (lambda
    (do &rest args)
    (gv--defsetter 'foobar
                   (lambda
                     (val &rest args)
                     `(,'setcar ,@args ,val))
                   do args)))
#+end_src

A comment in the definition of `gv-define-expander' says:

  ;; Use eval-and-compile so the method can be used in the same file as it
  ;; is defined.
  ;; FIXME: Just like byte-compile-macro-environment, we should have something
  ;; like byte-compile-symbolprop-environment so as to handle these things
  ;; cleanly without affecting the running Emacs.

Anyway, the above expands to

(macroexpand-1 (macroexpand-1 (macroexpand-1 (macroexpand-1 '(defsetf foobar setcar)))))
==>

#+begin_src emacs-lisp
(eval-and-compile
  (put 'foobar 'gv-expander
       (lambda
         (do &rest args)
         (gv--defsetter 'foobar
                        (lambda
                          (val &rest args)
                          `(,'setcar ,@args ,val))
                        do args))))
#+end_src

The `put' is evaluated when the `defsetf' macro call is expanded.
That's what's causing the issue.

AFAIK we don't say that `defsetf' is only allowed at top level, so I
would say (without any judgement) that it's a bug.  And it's not limited
to `defsetf' in "cl".


Michael.

bug#27016: possible bug in `defsetf'

[npostavs]

Rafael D Sorkin <rsorkin@perimeterinstitute.ca> writes:

> Thanks, I was wondering about that myself.  Is there a standard
> for elisp (or common lisp) that would determine whether eager
> macro expansion is an error in this case?

CLTL says this[1]:

    The evaluator is typically implemented as an interpreter that traverses
    the given form recursively, performing each step of the computation as
    it goes. An interpretive implementation is not required, however. A
    permissible alternative approach is for the evaluator first to
    completely compile the form into machine-executable code and then invoke
    the resulting code. This technique virtually eliminates
    incompatibilities between interpreted and compiled code but also renders
    the evalhook mechanism relatively useless. Various mixed strategies are
    also possible. All of these approaches should produce the same results
    when executing a correct program but may produce different results for
    incorrect programs. For example, the approaches may differ as to when
    macro calls are expanded; macro definitions should not depend on the
    time at which they are expanded. Implementors should document the
    evaluation strategy for each implementation.

and this[2] specifically about defsetf:

    X3J13 voted in March 1989 (DEFINING-MACROS-NON-TOP-LEVEL) to clarify
    that, while defining forms normally appear at top level, it is
    meaningful to place them in non-top-level contexts; the complex form of
    defsetf must define the expander function within the enclosing lexical
    environment, not within the global environment.

I'm not sure whether (unless ...) counts as an "enclosing lexical
environment" though.

> I would expect that a `defun' or `defsetf' etc which is within a
> conditional would not be executed until it was known whether the
> condition was satisfied.  The opposite behavior seems
> counter-intuitive to me.

`defun' takes effect at runtime (or rather it expands to `defalias'
which operates at runtime), whereas `defsetf' has to affect subsequent
compilation, so waiting until runtime to decide whether the condition is
true could not really work.

> But if you decide that this behavior is not a bug, then please
> let me know, so that I can adapt to it in the future.

I *think* it's not a bug, or at least not one worth fixing.  If you wrap
your (unless ...) form in (eval-when-compile ...) then you get your
expected behaviour.

[1]: https://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node179.html
[2]: https://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node80.html

bug#27016: possible bug in `defsetf'

[npostavs]

Michael Heerdegen <michael_heerdegen@web.de> writes:

> A comment in the definition of `gv-define-expander' says:
>
>   ;; Use eval-and-compile so the method can be used in the same file as it
>   ;; is defined.
>   ;; FIXME: Just like byte-compile-macro-environment, we should have something
>   ;; like byte-compile-symbolprop-environment so as to handle these things
>   ;; cleanly without affecting the running Emacs.

I think fixing that would not fix this bug, because the (setf (foobar
pair) 0) would still be compiled according to
byte-compile-symbolprop-environment.  It would just mean that compiling
the file containing (defsetf foobar setcar) would not affect other files
in the compiler's session.

bug#27016: possible bug in `defsetf'

[Michael Heerdegen]

npostavs@users.sourceforge.net writes:

> I think fixing that would not fix this bug, because the (setf (foobar
> pair) 0) would still be compiled according to
> byte-compile-symbolprop-environment.  It would just mean that compiling
> the file containing (defsetf foobar setcar) would not affect other files
> in the compiler's session.

Yes, there is probably no reasonable backward-compatible fix at all.


Michael.

bug#27016: possible bug in `defsetf'

[npostavs]

Michael Heerdegen <michael_heerdegen@web.de> writes:
>
> Yes, there is probably no reasonable backward-compatible fix at all.

Apologies if I'm misreading you, but do you have a non
backwards-compatible fix in mind?  Because I don't see one of those
either.

bug#27016: possible bug in `defsetf'

[Michael Heerdegen]

npostavs@users.sourceforge.net writes:

> Apologies if I'm misreading you, but do you have a non
> backwards-compatible fix in mind?  Because I don't see one of those
> either.

I wondered whether we could handle top-level setter definitions
specially (i.e. like now) and give up the magic for the rest.  But
that's probably a too drastic change, and I'm not sure if it would be a
good change either.


Michael.

bug#27016: possible bug in `defsetf'

[Rafael D Sorkin]

 > `defun' takes effect at runtime (or rather it expands to
 > `defalias' which operates at runtime), whereas `defsetf' has
 > to affect subsequent compilation, so waiting until runtime to
 > decide whether the condition is true could not really work.

Well the way I was using it, everything used to work fine.  I
found the bug when it stopped working and I was unable to figure
out why.

I had a defsetf inside a conditional in a file that was to be
loaded and/or compiled and then loaded.  (Compilation isn't
really the issue.)  Before loading that file I set a "switch"
which the conditional referred to.  That way a defsetf done
before loading the file could be either overridden or not, as
desired.

I found the ability to control the defsetf this way to be
useful.  However, as I wrote before, I only used this device a
few times, not so many that I couldn't adapt to losing it.

~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-
 Rafael Sorkin
 Perimeter Institute for Theoretical Physics
 31 Caroline Street North
 Waterloo, ON  N2L 2Y5
 Canada
~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-

bug#27016: possible bug in `defsetf'

[Michael Heerdegen]

Rafael D Sorkin <rsorkin@perimeterinstitute.ca> writes:

> I had a defsetf inside a conditional in a file that was to be
> loaded and/or compiled and then loaded.  (Compilation isn't
> really the issue.)  Before loading that file I set a "switch"
> which the conditional referred to.  That way a defsetf done
> before loading the file could be either overridden or not, as
> desired.

Can't you just `defsetf' unconditionally to a named function, and change
that function's definition when appropriate (in a conditional)?


Michael.

bug#27016: possible bug in `defsetf'

[npostavs]

tags 27016 wontfix
close 27016
quit

> Can't you just `defsetf' unconditionally to a named function, and change
> that function's definition when appropriate (in a conditional)?

Or just

    (eval-and-compile
      (unless t
        (defsetf foobar setcar)))

Anyway, I don't see any likely solutions to make this work exactly as
before, so I'm going to close this as wontfix, but feel free to continue
discussing (and/or say that I'm wrong).

bug#27016: possible bug in `defsetf'

[Rafael D Sorkin]

 > > I had a defsetf inside a conditional in a file that was to be
 > > loaded and/or compiled and then loaded.  (Compilation isn't
 > > really the issue.)  Before loading that file I set a "switch"
 > > which the conditional referred to.  That way a defsetf done
 > > before loading the file could be either overridden or not, as
 > > desired.
 > 
 > Can't you just `defsetf' unconditionally to a named function,
 > and change that function's definition when appropriate (in a
 > conditional)?
 > 
 > 
 > Michael.

Thanks for the suggestion, Michael.  I think it would work, but
the function I'm aliasing to is `symbol-value', and I would feel
slightly uncomfortable to insert an intermediate function which
would have to either call `symbol-value' or be redefined to be
it.  Fortunately, I hadn't used defsetf inside a conditional
more than a couple of times, and for those it was easy to devise
adequate workarounds (once I understood what the problem was).

For the future, I have resolved to use `defsetf' only at top
level.

- Rafael

~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-
 Rafael Sorkin
 Perimeter Institute for Theoretical Physics
 31 Caroline Street North
 Waterloo, ON  N2L 2Y5
 Canada
~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-

bug#27016: possible bug in `defsetf'

[Rafael D Sorkin]

 > tags 27016 wontfix
 > close 27016
 > quit
 > 
 > > Can't you just `defsetf' unconditionally to a named
 > > function, and change that function's definition when
 > > appropriate (in a conditional)?
 > 
 > Or just
 > 
 >     (eval-and-compile
 >       (unless t
 >         (defsetf foobar setcar)))
 > 
 > Anyway, I don't see any likely solutions to make this work
 > exactly as before, so I'm going to close this as wontfix, but
 > feel free to continue discussing (and/or say that I'm wrong).

One problem is that, as far as I know, common lisp doesn't have
`eval-and-compile', and my code is meant to work with both elisp
and common lisp.  In any case, as I wrote to Michael, I plan now
to use defsetf only at top level.  So thanks for the suggestion,
and do feel free to keep this bug closed as "wontfix".

- Rafael
~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-
 Rafael Sorkin
 Perimeter Institute for Theoretical Physics
 31 Caroline Street North
 Waterloo, ON  N2L 2Y5
 Canada
~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-

bug#27016: possible bug in `defsetf'

[npostavs]

Rafael D Sorkin <rsorkin@perimeterinstitute.ca> writes:

>  >     (eval-and-compile
>  >       (unless t
>  >         (defsetf foobar setcar)))
>  > 
> One problem is that, as far as I know, common lisp doesn't have
> `eval-and-compile', and my code is meant to work with both elisp
> and common lisp.

Oh, I think `eval-when' should be equivalent:

    (eval-when (compile load eval)
      (unless t
        (defsetf foobar setcar)))

bug#27016: possible bug in `defsetf'

[Michael Heerdegen]

npostavs@users.sourceforge.net writes:

> Oh, I think `eval-when' should be equivalent:
>
>     (eval-when (compile load eval)
>       (unless t
>         (defsetf foobar setcar)))

FWIW, I don't understand.  Doesn't that just expand to the same code as
before when evaluated?  That code is just evaluated under even more
circumstances.

I would rather try something like

#+begin_src emacs-lisp
(unless t
  (eval '(progn (defalias 'foobar 'cons)
                (defsetf foobar setcar))))
#+end_src

to avoid the eager macro expansion unless the code is actually run.


Michael.

bug#27016: possible bug in `defsetf'

[Noam Postavsky]

On Thu, May 25, 2017 at 4:26 PM, Michael Heerdegen
<michael_heerdegen@web.de> wrote:
> npostavs@users.sourceforge.net writes:
>
>> Oh, I think `eval-when' should be equivalent:
>>
>>     (eval-when (compile load eval)
>>       (unless t
>>         (defsetf foobar setcar)))
>
> FWIW, I don't understand.  Doesn't that just expand to the same code as
> before when evaluated?  That code is just evaluated under even more
> circumstances.

Hmm, I thought it would cause the 'unless t' to happen in the
macroexpansion phase as well, but I was wrong. Apparently 'eval-when'
doesn't have this effect, only eval-when-compile or eval-and-compile
will do the trick.

bug#27016: possible bug in `defsetf'

[Michael Heerdegen]

Noam Postavsky <npostavs@users.sourceforge.net> writes:

> Hmm, I thought it would cause the 'unless t' to happen in the
> macroexpansion phase as well, but I was wrong. Apparently 'eval-when'
> doesn't have this effect, only eval-when-compile or eval-and-compile
> will do the trick.

That also doesn't work.  Apart from the fact that you would have the
`defsetf' executed at compile time as side effect,

#+begin_src emacs-lisp
(macroexpand '(defsetf foo bar))
==>
'(lambda
   (do &rest args)
   (gv--defsetter 'foo
                  (lambda
                    (val &rest args)
                    `(,'bar ,@args ,val))
                  do args))
#+end_src

(i.e. a constant!).

When you compile a file with this content:

#+begin_src emacs-lisp
(eval-and-compile
  (unless nil
    (defsetf foo bar)))
#+end_src

you get an empty .elc.

Isn't that strange?


Michael.

bug#27016: possible bug in `defsetf'

[npostavs]

Michael Heerdegen <michael_heerdegen@web.de> writes:

> Noam Postavsky <npostavs@users.sourceforge.net> writes:
>
>> Hmm, I thought it would cause the 'unless t' to happen in the
>> macroexpansion phase as well, but I was wrong. Apparently 'eval-when'
>> doesn't have this effect, only eval-when-compile or eval-and-compile
>> will do the trick.
>
> That also doesn't work.

Oh, hmm, I only checked by evaluating, I didn't actually try compiling
to a separate file.

> #+begin_src emacs-lisp
> (macroexpand '(defsetf foo bar))
> ==>
> '(lambda
>    (do &rest args)
>    (gv--defsetter 'foo
>                   (lambda
>                     (val &rest args)
>                     `(,'bar ,@args ,val))
>                   do args))
> #+end_src

I don't understand where that quote comes from.  I guess I don't really
understand what's going on here as well as I thought.

> When you compile a file with this content:
>
> #+begin_src emacs-lisp
> (eval-and-compile
>   (unless nil
>     (defsetf foo bar)))
> #+end_src
>
> you get an empty .elc.
>
> Isn't that strange?

Yeah, even stranger...

bug#27016: possible bug in `defsetf'

[Michael Heerdegen]

Hello,

I wonder now if the definition of `eval-and-compile' as defmacro is
correct.  Maybe Stefan can help (I CC'd him), he may also want to look
at the rest of the report...

npostavs@users.sourceforge.net writes:

> > #+begin_src emacs-lisp
> > (macroexpand '(defsetf foo bar))
> > ==>
> > '(lambda
> >    (do &rest args)
> >    (gv--defsetter 'foo
> >                   (lambda
> >                     (val &rest args)
> >                     `(,'bar ,@args ,val))
> >                   do args))
> > #+end_src
>
> I don't understand where that quote comes from.

The `defsetf' expands to an `eval-and-compile'.  The `eval-and-compile'
expands to a quoted constant, see its definition (as defmacro).


> > When you compile a file with this content:
> >
> > #+begin_src emacs-lisp
> > (eval-and-compile
> >   (unless nil
> >     (defsetf foo bar)))
> > #+end_src
> >
> > you get an empty .elc.
> >
> > Isn't that strange?
>
> Yeah, even stranger...

AFAIU, when compiled, `eval-and-compile' macroexpands its body (see the
defconst of `byte-compile-initial-macro-environment').  So what is
compiled is essentially

#+begin_src emacs-lisp
(if nil nil
  '(closure
    (t)
    (do &rest args)
    (gv--defsetter 'foo
                   (lambda
                     (val &rest args)
                     `(,'bar ,@args ,val))
                   do args)))
#+end_src

and that's just discarded.


Michael.

bug#27016: possible bug in `defsetf'

[Stefan Monnier]

> (unless t
>   (defalias 'foobar 'cons)
>   (defsetf foobar setcar))		; nil 
> (foobar pair)				; same as above
> (setf (foobar pair) 0)			; 0       !

I can confirm that it's a bug.  It's perfectly correct for the defsetf
to be macroexpanded, but not to be evaluated.
Not sure how best to get that behavior.  The naive/straightforward way
might be to introduce some sort of eval-and-compile-when-at-toplevel,
but there's probably a better way.  The first thing to do is to look at
how it was done in Emacs-23.


        Stefan

bug#27016: possible bug in `defsetf'

[Rafael D Sorkin]

 > I would rather try something like
 > 
 > #+begin_src emacs-lisp
 > (unless t
 >   (eval '(progn (defalias 'foobar 'cons)
 >                 (defsetf foobar setcar))))
 > #+end_src
 > 
 > to avoid the eager macro expansion unless the code is actually run.

That looks like it would have to work.  I will keep it mind in
case of future need.  Thanks.

~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-
 Rafael Sorkin
 Perimeter Institute for Theoretical Physics
 31 Caroline Street North
 Waterloo, ON  N2L 2Y5
 Canada
~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-

bug#27016: possible bug in `defsetf'

[npostavs]

reopen 27016
tag 27016 - wontfix
quit

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

>> (unless t
>>   (defalias 'foobar 'cons)
>>   (defsetf foobar setcar))		; nil 
>> (foobar pair)				; same as above
>> (setf (foobar pair) 0)			; 0       !
>
> I can confirm that it's a bug.  It's perfectly correct for the defsetf
> to be macroexpanded, but not to be evaluated.
> Not sure how best to get that behavior.  The naive/straightforward way
> might be to introduce some sort of eval-and-compile-when-at-toplevel,
> but there's probably a better way.  The first thing to do is to look at
> how it was done in Emacs-23.

Is the difference in Emacs-23 not just eager macroexpansion?

Both the Emacs-23 and the current code seem to expand to (put 'foobar
...).

bug#27016: possible bug in `defsetf'

[Stefan Monnier]

> Is the difference in Emacs-23 not just eager macroexpansion?

Could be.  But I'm more worried about the byte-compiled case.

> Both the Emacs-23 and the current code seem to expand to (put 'foobar
> ...).

Beware: there's macro-expansion and then there's macro-expansion.
[ See byte-compile-macro-environment.  ]


        Stefan

bug#27016: possible bug in `defsetf'

[npostavs]

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

>> Is the difference in Emacs-23 not just eager macroexpansion?
>
> Could be.  But I'm more worried about the byte-compiled case.

I hope someone will correct me if I've gotten mixed up again, but I
believe the byte-compiled case already works fine:

    ~/src/emacs$ cat bug-27016-defsetf.el
    (require 'cl)

    (defvar pair nil)
    (setq pair (cons 3 4))
    (when nil
      (defalias 'foobar 'cons)
      (defsetf foobar setcar))
    ~/src/emacs$ emacs -Q -batch -f batch-byte-compile bug-27016-defsetf.el

    In toplevel form:
    bug-27016-defsetf.el:1:1:Warning: cl package required at runtime
    bug-27016-defsetf.el:3:1:Warning: global/dynamic var ‘pair’ lacks a prefix
    ~/src/emacs$ emacs -Q -batch -l bug-27016-defsetf.elc --eval '(setf (foobar pair) 0)'
    Symbol’s function definition is void: \(setf\ foobar\)

bug#27016: possible bug in `defsetf'

[Michael Heerdegen]

npostavs@users.sourceforge.net writes:

> I hope someone will correct me if I've gotten mixed up again, but I
> believe the byte-compiled case already works fine:
>
>     ~/src/emacs$ cat bug-27016-defsetf.el
>     (require 'cl)
>
>     (defvar pair nil)
>     (setq pair (cons 3 4))
>     (when nil
>       (defalias 'foobar 'cons)
>       (defsetf foobar setcar))
>     ~/src/emacs$ emacs -Q -batch -f batch-byte-compile bug-27016-defsetf.el
>
>     In toplevel form:
>     bug-27016-defsetf.el:1:1:Warning: cl package required at runtime
>     bug-27016-defsetf.el:3:1:Warning: global/dynamic var ‘pair’ lacks a prefix
>     ~/src/emacs$ emacs -Q -batch -l bug-27016-defsetf.elc --eval '(setf (foobar pair) 0)'
>     Symbol’s function definition is void: \(setf\ foobar\)

Yes - if you use two separate Emacs instances.  The defsetf gets
evaluated in the Emacs that is used to compile the code
(unconditionally).

So what you state is not suspicious for a problem with a surprising side
effect when performing macroexpansion, right?


Michael.

bug#27016: possible bug in `defsetf'

[npostavs]

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

tags 27016 + patch
quit

Michael Heerdegen <michael_heerdegen@web.de> writes:

> npostavs@users.sourceforge.net writes:
>
>> I hope someone will correct me if I've gotten mixed up again, but I
>> believe the byte-compiled case already works fine:
>>
>>     ~/src/emacs$ cat bug-27016-defsetf.el
>>     (require 'cl)
>>
>>     (defvar pair nil)
>>     (setq pair (cons 3 4))
>>     (when nil
>>       (defalias 'foobar 'cons)
>>       (defsetf foobar setcar))
>>     ~/src/emacs$ emacs -Q -batch -f batch-byte-compile bug-27016-defsetf.el
>>
>>     In toplevel form:
>>     bug-27016-defsetf.el:1:1:Warning: cl package required at runtime
>>     bug-27016-defsetf.el:3:1:Warning: global/dynamic var ‘pair’ lacks a prefix
>>     ~/src/emacs$ emacs -Q -batch -l bug-27016-defsetf.elc --eval '(setf (foobar pair) 0)'
>>     Symbol’s function definition is void: \(setf\ foobar\)
>
> Yes - if you use two separate Emacs instances.  The defsetf gets
> evaluated in the Emacs that is used to compile the code
> (unconditionally).
>
> So what you state is not suspicious for a problem with a surprising side
> effect when performing macroexpansion, right?

Right.

    ~/src/emacs$ emacs -Q -batch --eval '(byte-compile-file "bug-27016-defsetf.el")' -l bug-27016-defsetf.elc --eval  '(progn (setf (foobar pair) 0) (print pair))'

    In toplevel form:
    bug-27016-defsetf.el:1:1:Warning: cl package required at runtime
    bug-27016-defsetf.el:3:1:Warning: global/dynamic var ‘pair’ lacks a prefix

    (0 . 4)

You were indeed correct to point to that FIXME comment in
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27016#28

Here's a patch for it:


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

From 1c6585f06ce87b62c505a575661554b6d6b961c8 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sun, 9 Jul 2017 15:56:50 -0400
Subject: [PATCH] Don't define gv expanders in compiler session (Bug#27016)

This prevents definitions being compiled from leaking into the current
Emacs doing the compilation.
* lisp/emacs-lisp/gv.el (gv-define-expander): Push the expander
definition into `byte-compile-macro-environment' instead of evaluating
at compile time.
(gv-get): Check `byte-compile-macro-environment' for gv-expander
definitions.
---
 lisp/emacs-lisp/gv.el | 20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index c5c12a6414..b916dda731 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -91,7 +91,10 @@ (defun gv-get (place do)
    ((not (consp place)) (signal 'gv-invalid-place (list place)))
    (t
     (let* ((head (car place))
-           (gf (function-get head 'gv-expander 'autoload)))
+           (gf (or (alist-get head (alist-get :gv-expands
+                                              (bound-and-true-p
+                                               byte-compile-macro-environment)))
+                   (function-get head 'gv-expander 'autoload))))
       (if gf (apply gf do (cdr place))
         (let ((me (macroexpand-1 place
                                  ;; (append macroexpand-all-environment
@@ -146,12 +149,15 @@ (defmacro gv-define-expander (name handler)
 HANDLER is a function which takes an argument DO followed by the same
 arguments as NAME.  DO is a function as defined in `gv-get'."
   (declare (indent 1) (debug (sexp form)))
-  ;; Use eval-and-compile so the method can be used in the same file as it
-  ;; is defined.
-  ;; FIXME: Just like byte-compile-macro-environment, we should have something
-  ;; like byte-compile-symbolprop-environment so as to handle these things
-  ;; cleanly without affecting the running Emacs.
-  `(eval-and-compile (put ',name 'gv-expander ,handler)))
+  ;; Push onto `byte-compile-macro-environment' so the method can be
+  ;; used in the same file as it is defined.
+  (when (boundp 'byte-compile-macro-environment)
+    (push (cons :gv-expanders
+                (cons (cons name handler)
+                      (cdr (assq :gv-expanders
+                                 byte-compile-macro-environment))))
+          byte-compile-macro-environment))
+  `(put ',name 'gv-expander ,handler))
 
 ;;;###autoload
 (defun gv--defun-declaration (symbol name args handler &optional fix)
-- 
2.11.1

bug#27016: possible bug in `defsetf'

[Michael Heerdegen]

npostavs@users.sourceforge.net writes:

> Here's a patch for it: [...]

Thanks for working on this.  AFAIU I think it should work.

> @@ -146,12 +149,15 @@ (defmacro gv-define-expander (name handler)
>  HANDLER is a function which takes an argument DO followed by the same
>  arguments as NAME.  DO is a function as defined in `gv-get'."
>    (declare (indent 1) (debug (sexp form)))
> -  ;; Use eval-and-compile so the method can be used in the same file as it
> -  ;; is defined.
> -  ;; FIXME: Just like byte-compile-macro-environment, we should have something
> -  ;; like byte-compile-symbolprop-environment so as to handle these things
> -  ;; cleanly without affecting the running Emacs.
> -  `(eval-and-compile (put ',name 'gv-expander ,handler)))
> +  ;; Push onto `byte-compile-macro-environment' so the method can be
> +  ;; used in the same file as it is defined.
> +  (when (boundp 'byte-compile-macro-environment)
> +    (push (cons :gv-expanders
> +                (cons (cons name handler)
> +                      (cdr (assq :gv-expanders
> +                                 byte-compile-macro-environment))))
> +          byte-compile-macro-environment))
> +  `(put ',name 'gv-expander ,handler))

Is it intended to add an :gv-expanders entry to
byte-compile-macro-environment more than once?


Michael.

bug#27016: possible bug in `defsetf'

[npostavs]

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

Michael Heerdegen <michael_heerdegen@web.de> writes:

> Is it intended to add an :gv-expanders entry to
> byte-compile-macro-environment more than once?

Hmm, not entirely consciously, I was following the same pattern I had
used for cl-symbol-macrolet, but in that case we're establishing a
let-binding so it's important to be able to pop back to the old binding.
It's not needed here though.

Also, I had a typo in gv-get (:gv-expands instead of :gv-expanders),
because I didn't actually test the positive case.  Here's a working(?)
version, with tests:


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

From b48af25eb5c18cb45d9e431076df767718efa0ec Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Mon, 10 Jul 2017 21:42:05 -0400
Subject: [PATCH v2] Don't define gv expanders in compiler session (Bug#27016)

This prevents definitions being compiled from leaking into the current
Emacs doing the compilation.
* lisp/emacs-lisp/gv.el (gv-define-expander): Push the expander
definition into `byte-compile-macro-environment' instead of evaluating
at compile time.
(gv-get): Check `byte-compile-macro-environment' for gv-expander
definitions.
* test/lisp/emacs-lisp/gv-tests.el: New tests.
---
 lisp/emacs-lisp/gv.el            |  23 ++++++---
 test/lisp/emacs-lisp/gv-tests.el | 103 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 119 insertions(+), 7 deletions(-)
 create mode 100644 test/lisp/emacs-lisp/gv-tests.el

diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index c5c12a6414..fa8ae27e1f 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -91,7 +91,10 @@ (defun gv-get (place do)
    ((not (consp place)) (signal 'gv-invalid-place (list place)))
    (t
     (let* ((head (car place))
-           (gf (function-get head 'gv-expander 'autoload)))
+           (gf (or (alist-get head (alist-get :gv-expanders
+                                              (bound-and-true-p
+                                               byte-compile-macro-environment)))
+                   (function-get head 'gv-expander 'autoload))))
       (if gf (apply gf do (cdr place))
         (let ((me (macroexpand-1 place
                                  ;; (append macroexpand-all-environment
@@ -146,12 +149,18 @@ (defmacro gv-define-expander (name handler)
 HANDLER is a function which takes an argument DO followed by the same
 arguments as NAME.  DO is a function as defined in `gv-get'."
   (declare (indent 1) (debug (sexp form)))
-  ;; Use eval-and-compile so the method can be used in the same file as it
-  ;; is defined.
-  ;; FIXME: Just like byte-compile-macro-environment, we should have something
-  ;; like byte-compile-symbolprop-environment so as to handle these things
-  ;; cleanly without affecting the running Emacs.
-  `(eval-and-compile (put ',name 'gv-expander ,handler)))
+  ;; Push onto `byte-compile-macro-environment' so the method can be
+  ;; used in the same file as it is defined.
+  (when (boundp 'byte-compile-macro-environment)
+    (let* ((expanders (assq :gv-expanders byte-compile-macro-environment))
+           (expander (assq name (cdr expanders)))
+           (new-expander (cons name handler)))
+      (cond (expander (setcdr expander handler))
+            (expanders (setcdr expanders (cons new-expander (cdr expanders))))
+            (t (setq byte-compile-macro-environment
+                     (cons (cons :gv-expanders (list new-expander))
+                           byte-compile-macro-environment))))))
+  `(put ',name 'gv-expander ,handler))
 
 ;;;###autoload
 (defun gv--defun-declaration (symbol name args handler &optional fix)
diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el
new file mode 100644
index 0000000000..affc7ce455
--- /dev/null
+++ b/test/lisp/emacs-lisp/gv-tests.el
@@ -0,0 +1,103 @@
+;;; gv-tests.el --- tests for gv.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(eval-when-compile (require 'cl-lib))
+
+(cl-defmacro gv-tests--in-temp-dir ((elvar elcvar)
+                                    (&rest filebody)
+                                    &rest body)
+  (declare (indent 2))
+  `(let ((default-directory (make-temp-file "gv-test" t)))
+     (unwind-protect
+         (let ((,elvar "gv-test-deffoo.el")
+               (,elcvar "gv-test-deffoo.elc"))
+           (with-temp-file ,elvar
+             (insert ";; -*- lexical-binding: t; -*-\n")
+             (dolist (form ',filebody)
+               (pp form (current-buffer))))
+           ,@body)
+       (delete-directory default-directory t))))
+
+(ert-deftest gv-define-expander-in-file ()
+  (gv-tests--in-temp-dir (el elc)
+      ((gv-define-setter gv-test-foo (newval cons)
+         `(setcar ,cons ,newval))
+       (defvar gv-test-pair (cons 1 2))
+       (setf (gv-test-foo gv-test-pair) 99)
+       (message "%d" (car gv-test-pair)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc)
+      (should (equal (buffer-string) "99\n")))))
+
+(ert-deftest gv-dont-define-expander-in-file ()
+  ;; The expander is defined while we are compiling the file, even
+  ;; though it's inside (when nil ...).
+  :expected-result :failed
+  (gv-tests--in-temp-dir (el elc)
+      ((when nil (gv-define-setter gv-test-foo (newval cons)
+                   `(setcar ,cons ,newval)))
+       (defvar gv-test-pair (cons 1 2))
+       (setf (gv-test-foo gv-test-pair) 99)
+       (message "%d" (car gv-test-pair)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc)
+      (should (equal (buffer-string)
+                     "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n")))))
+
+(ert-deftest gv-define-expander-out-of-file ()
+  (gv-tests--in-temp-dir (el elc)
+      ((gv-define-setter gv-test-foo (newval cons)
+         `(setcar ,cons ,newval))
+       (defvar gv-test-pair (cons 1 2)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc
+                    "--eval"
+                    (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99)
+                                             (message "%d" (car gv-test-pair)))))
+      (should (equal (buffer-string) "99\n")))))
+
+(ert-deftest gv-dont-define-expander-other-file ()
+  (gv-tests--in-temp-dir (el elc)
+      ((if nil (gv-define-setter gv-test-foo (newval cons)
+                 `(setcar ,cons ,newval)))
+       (defvar gv-test-pair (cons 1 2)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc
+                    "--eval"
+                    (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99)
+                                             (message "%d" (car gv-test-pair)))))
+      (should (equal (buffer-string)
+                     "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n")))))
+
+;;; gv-tests.el ends here
-- 
2.11.1

bug#27016: possible bug in `defsetf'

[Stefan Monnier]

> -           (gf (function-get head 'gv-expander 'autoload)))
> +           (gf (or (alist-get head (alist-get :gv-expands
> +                                              (bound-and-true-p
> +                                               byte-compile-macro-environment)))
> +                   (function-get head 'gv-expander 'autoload))))

I think a better avenue would be to change function-put and function-get
to DTRT.


        Stefan

bug#27016: possible bug in `defsetf'

[npostavs]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

> I think a better avenue would be to change function-put and function-get
> to DTRT.

I can see how that might work for function-get:

    (defun function-get (f prop &optional autoload)
      ...
   +  (or
   +   (if (eq prop 'gv-expander)
   +       (alist-get f (alist-get :gv-expanders
   +                               (bound-and-true-p
   +                                byte-compile-macro-environment))))
       (let ((val nil))
         (while (and (symbolp f)
                     (null (setq val (get f prop)))
         ;; etc...

But how can I make function-put do the right thing for both a macro
calling it and keep it's normal role?

bug#27016: possible bug in `defsetf'

[Stefan Monnier]

> I can see how that might work for function-get:
>
>     (defun function-get (f prop &optional autoload)
>       ...
>    +  (or
>    +   (if (eq prop 'gv-expander)
>    +       (alist-get f (alist-get :gv-expanders
>    +                               (bound-and-true-p
>    +                                byte-compile-macro-environment))))
>        (let ((val nil))
>          (while (and (symbolp f)
>                      (null (setq val (get f prop)))
>          ;; etc...

Why limit this to `gv-expander`?
Also, we should probably move the test within the subsequent `while`
loop, so that it interacts correctly with aliases.

> But how can I make function-put do the right thing for both a macro
> calling it and keep it's normal role?

I don't know what to do when a macro calls it (I can't think of any
reason we'd want to do that), but I know how to handle the case where
a macro outputs code that uses it: Add (byte-defop-compiler-1
function-put) as well as a byte-compile-function-put function.
See byte-compile-autoload and byte-compile-make-obsolete-variable
for examples.


        Stefan

bug#27016: possible bug in `defsetf'

[npostavs]

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

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

> I don't know what to do when a macro calls it (I can't think of any
> reason we'd want to do that), but I know how to handle the case where
> a macro outputs code that uses it: Add (byte-defop-compiler-1
> function-put) as well as a byte-compile-function-put function.
> See byte-compile-autoload and byte-compile-make-obsolete-variable
> for examples.

Oh, I think I get it now.


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

From 565dd64e74b78f56982bd7ca92f34ab71e6d669a Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 13 Jul 2017 00:40:35 -0400
Subject: [PATCH v3 1/2] Let `function-put' affect compilation of the current
 file

* lisp/emacs-lisp/bytecomp.el (byte-compile-plist-environment): New
variable.
(byte-compile-close-variables): Let-bind it to nil.
(byte-compile-function-put): New byte-defop-compiler.
* lisp/subr.el (function-get): Consult
`byte-compile-plist-environment'.
---
 lisp/emacs-lisp/bytecomp.el | 18 ++++++++++++++++++
 lisp/subr.el                |  7 ++++++-
 2 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index e5b9b47b1d..028efbce26 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -498,6 +498,10 @@ (defvar byte-compile-macro-environment byte-compile-initial-macro-environment
 Each element looks like (MACRONAME . DEFINITION).  It is
 \(MACRONAME . nil) when a macro is redefined as a function.")
 
+(defvar byte-compile-plist-environment nil
+  "Alist of property lists defined in the file being compiled.
+Each element looks like (SYMBOL . PLIST).")
+
 (defvar byte-compile-function-environment nil
   "Alist of functions defined in the file being compiled.
 This is so we can inline them when necessary.
@@ -1585,6 +1589,7 @@ (defmacro byte-compile-close-variables (&rest body)
           ;; macroenvironment.
           (copy-alist byte-compile-initial-macro-environment))
          (byte-compile--outbuffer nil)
+         (byte-compile-plist-environment nil)
          (byte-compile-function-environment nil)
          (byte-compile-bound-variables nil)
          (byte-compile-lexical-variables nil)
@@ -4577,6 +4582,7 @@ (byte-defop-compiler-1 defvar)
 (byte-defop-compiler-1 defconst byte-compile-defvar)
 (byte-defop-compiler-1 autoload)
 (byte-defop-compiler-1 lambda byte-compile-lambda-form)
+(byte-defop-compiler-1 function-put)
 
 ;; If foo.el declares `toto' as obsolete, it is likely that foo.el will
 ;; actually use `toto' in order for this obsolete variable to still work
@@ -4725,6 +4731,18 @@ (put 'make-variable-buffer-local
      'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local)
 (defun byte-compile-form-make-variable-buffer-local (form)
   (byte-compile-keep-pending form 'byte-compile-normal-call))
+
+(defun byte-compile-function-put (form)
+  (pcase form
+    (`(,_ (,(or 'quote 'function) ,(and fun (guard (symbolp fun))))
+          ',prop ,(or `#',value (and value (guard (functionp value)))))
+     (let ((fplist (assq fun byte-compile-plist-environment)))
+       (if fplist
+           (setcdr fplist (plist-put (cdr fplist) prop value))
+         (push (cons fun (list prop value))
+               byte-compile-plist-environment)))))
+  (byte-compile-normal-call form))
+
 \f
 ;;; tags
 
diff --git a/lisp/subr.el b/lisp/subr.el
index 42b4e1c211..3e4a3dedf5 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2971,7 +2971,12 @@ (defun function-get (f prop &optional autoload)
 if it's an autoloaded macro."
   (let ((val nil))
     (while (and (symbolp f)
-                (null (setq val (get f prop)))
+                (null (setq val (or (plist-get
+                                     (alist-get
+                                      f (bound-and-true-p
+                                         byte-compile-plist-environment))
+                                     prop)
+                                    (get f prop))))
                 (fboundp f))
       (let ((fundef (symbol-function f)))
         (if (and autoload (autoloadp fundef)
-- 
2.11.1


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

From bb2165c72cc7fa436ab911ab756cacec6384927d Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 13 Jul 2017 00:42:38 -0400
Subject: [PATCH v3 2/2] Don't define gv expanders in compiler's runtime
 (Bug#27016)

This prevents definitions being compiled from leaking into the current
Emacs doing the compilation.
* lisp/emacs-lisp/gv.el (gv-define-expander): Use function-put instead
of `put' with `eval-and-compile'.
* test/lisp/emacs-lisp/gv-tests.el: New tests.
---
 lisp/emacs-lisp/gv.el            |   7 +--
 test/lisp/emacs-lisp/gv-tests.el | 103 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 104 insertions(+), 6 deletions(-)
 create mode 100644 test/lisp/emacs-lisp/gv-tests.el

diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index c5c12a6414..54105f89af 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -146,12 +146,7 @@ (defmacro gv-define-expander (name handler)
 HANDLER is a function which takes an argument DO followed by the same
 arguments as NAME.  DO is a function as defined in `gv-get'."
   (declare (indent 1) (debug (sexp form)))
-  ;; Use eval-and-compile so the method can be used in the same file as it
-  ;; is defined.
-  ;; FIXME: Just like byte-compile-macro-environment, we should have something
-  ;; like byte-compile-symbolprop-environment so as to handle these things
-  ;; cleanly without affecting the running Emacs.
-  `(eval-and-compile (put ',name 'gv-expander ,handler)))
+  `(function-put ',name 'gv-expander ,handler))
 
 ;;;###autoload
 (defun gv--defun-declaration (symbol name args handler &optional fix)
diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el
new file mode 100644
index 0000000000..affc7ce455
--- /dev/null
+++ b/test/lisp/emacs-lisp/gv-tests.el
@@ -0,0 +1,103 @@
+;;; gv-tests.el --- tests for gv.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(eval-when-compile (require 'cl-lib))
+
+(cl-defmacro gv-tests--in-temp-dir ((elvar elcvar)
+                                    (&rest filebody)
+                                    &rest body)
+  (declare (indent 2))
+  `(let ((default-directory (make-temp-file "gv-test" t)))
+     (unwind-protect
+         (let ((,elvar "gv-test-deffoo.el")
+               (,elcvar "gv-test-deffoo.elc"))
+           (with-temp-file ,elvar
+             (insert ";; -*- lexical-binding: t; -*-\n")
+             (dolist (form ',filebody)
+               (pp form (current-buffer))))
+           ,@body)
+       (delete-directory default-directory t))))
+
+(ert-deftest gv-define-expander-in-file ()
+  (gv-tests--in-temp-dir (el elc)
+      ((gv-define-setter gv-test-foo (newval cons)
+         `(setcar ,cons ,newval))
+       (defvar gv-test-pair (cons 1 2))
+       (setf (gv-test-foo gv-test-pair) 99)
+       (message "%d" (car gv-test-pair)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc)
+      (should (equal (buffer-string) "99\n")))))
+
+(ert-deftest gv-dont-define-expander-in-file ()
+  ;; The expander is defined while we are compiling the file, even
+  ;; though it's inside (when nil ...).
+  :expected-result :failed
+  (gv-tests--in-temp-dir (el elc)
+      ((when nil (gv-define-setter gv-test-foo (newval cons)
+                   `(setcar ,cons ,newval)))
+       (defvar gv-test-pair (cons 1 2))
+       (setf (gv-test-foo gv-test-pair) 99)
+       (message "%d" (car gv-test-pair)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc)
+      (should (equal (buffer-string)
+                     "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n")))))
+
+(ert-deftest gv-define-expander-out-of-file ()
+  (gv-tests--in-temp-dir (el elc)
+      ((gv-define-setter gv-test-foo (newval cons)
+         `(setcar ,cons ,newval))
+       (defvar gv-test-pair (cons 1 2)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc
+                    "--eval"
+                    (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99)
+                                             (message "%d" (car gv-test-pair)))))
+      (should (equal (buffer-string) "99\n")))))
+
+(ert-deftest gv-dont-define-expander-other-file ()
+  (gv-tests--in-temp-dir (el elc)
+      ((if nil (gv-define-setter gv-test-foo (newval cons)
+                 `(setcar ,cons ,newval)))
+       (defvar gv-test-pair (cons 1 2)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc
+                    "--eval"
+                    (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99)
+                                             (message "%d" (car gv-test-pair)))))
+      (should (equal (buffer-string)
+                     "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n")))))
+
+;;; gv-tests.el ends here
-- 
2.11.1

bug#27016: possible bug in `defsetf'

[Stefan Monnier]

> Oh, I think I get it now.

Looks about right.  A few comments below.


        Stefan


> @@ -4577,6 +4582,7 @@ (byte-defop-compiler-1 defvar)
>  (byte-defop-compiler-1 defconst byte-compile-defvar)
>  (byte-defop-compiler-1 autoload)
>  (byte-defop-compiler-1 lambda byte-compile-lambda-form)
> +(byte-defop-compiler-1 function-put)
> 
>  ;; If foo.el declares `toto' as obsolete, it is likely that foo.el will
>  ;; actually use `toto' in order for this obsolete variable to still work

I know it's not how it's done everywhere now, but I like to put the
byte-defop-compiler-1 next to the handler function.

> @@ -4725,6 +4731,18 @@ (put 'make-variable-buffer-local
>       'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local)
>  (defun byte-compile-form-make-variable-buffer-local (form)
>    (byte-compile-keep-pending form 'byte-compile-normal-call))
> +
> +(defun byte-compile-function-put (form)
> +  (pcase form
> +    (`(,_ (,(or 'quote 'function) ,(and fun (guard (symbolp fun))))
> +          ',prop ,(or `#',value (and value (guard (functionp value)))))

The value doesn't have to be `functionp` (it is in the case of
gv-expander, but it depends on the property).

> +     (let ((fplist (assq fun byte-compile-plist-environment)))
> +       (if fplist
> +           (setcdr fplist (plist-put (cdr fplist) prop value))
> +         (push (cons fun (list prop value))
> +               byte-compile-plist-environment)))))

I'd just unconditionally use `push`:

         (push (cons fun `(,prop ,value . ,fplist))
               byte-compile-plist-environment)))))

bug#27016: possible bug in `defsetf'

[npostavs]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

> Looks about right.

Except that it isn't.  While compiling map.el, I get

../../emacs-master/lisp/emacs-lisp/map.el:292:1:Error: Symbol’s function definition is void: internal-make-closure

I can fix this with

@@ -146,7 +146,7 @@ (defmacro gv-define-expander (name handler)
 HANDLER is a function which takes an argument DO followed by the same
 arguments as NAME.  DO is a function as defined in `gv-get'."
   (declare (indent 1) (debug (sexp form)))
-  `(function-put ',name 'gv-expander ,handler))
+  `(function-put ',name 'gv-expander (eval-when-compile ,handler)))

But that doesn't look like the right thing.

> I know it's not how it's done everywhere now, but I like to put the
> byte-defop-compiler-1 next to the handler function.

Makes sense.

>> +(defun byte-compile-function-put (form)
>> +  (pcase form
>> +    (`(,_ (,(or 'quote 'function) ,(and fun (guard (symbolp fun))))
>> +          ',prop ,(or `#',value (and value (guard (functionp value)))))
>
> The value doesn't have to be `functionp` (it is in the case of
> gv-expander, but it depends on the property).

Right.  I got a bit turned around with the quoting levels.  And given
the error above, I'm still not sure I have it worked out correctly.

>> +     (let ((fplist (assq fun byte-compile-plist-environment)))
>> +       (if fplist
>> +           (setcdr fplist (plist-put (cdr fplist) prop value))
>> +         (push (cons fun (list prop value))
>> +               byte-compile-plist-environment)))))
>
> I'd just unconditionally use `push`:
>
>          (push (cons fun `(,prop ,value . ,fplist))
>                byte-compile-plist-environment)))))

Yeah, that is simpler.

bug#27016: possible bug in `defsetf'

[Stefan Monnier]

> Except that it isn't.  While compiling map.el, I get
>
> ../../emacs-master/lisp/emacs-lisp/map.el:292:1:Error: Symbol’s function definition is void: internal-make-closure

Hmm... yes ... interesting ... I see the problem: byte-compile-function-put
receives a form that's been preprocessed.  These look very much like
Elisp, but fundamentally, they're really just a different intermediate
representation, which includes things like `internal-make-closure', so
they can't be used as Elisp expressions (e.g. passed to `eval`): they
need to be passed through the rest of the compiler before they can be used.

I'm not sure yet how best way to solve this.


        Stefan

bug#27016: possible bug in `defsetf'

[Stefan Monnier]

> I'm not sure yet how best way to solve this.

I believe the patch below does the right thing.  It's kind of a bummer
that we have to byte-compile the function call by hand, tho.  I tested
it only lightly, so please give it a more thorough testing and then feel
free to push it.


        Stefan


diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index e5b9b47b1d..e6f90e044b 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -498,6 +498,10 @@ byte-compile-macro-environment
 Each element looks like (MACRONAME . DEFINITION).  It is
 \(MACRONAME . nil) when a macro is redefined as a function.")
 
+(defvar byte-compile-plist-environment nil
+  "Alist of property lists defined in the file being compiled.
+Each element looks like (SYMBOL . PLIST).")
+
 (defvar byte-compile-function-environment nil
   "Alist of functions defined in the file being compiled.
 This is so we can inline them when necessary.
@@ -1585,6 +1589,7 @@ byte-compile-close-variables
           ;; macroenvironment.
           (copy-alist byte-compile-initial-macro-environment))
          (byte-compile--outbuffer nil)
+         (byte-compile-plist-environment nil)
          (byte-compile-function-environment nil)
          (byte-compile-bound-variables nil)
          (byte-compile-lexical-variables nil)
@@ -4695,7 +4700,7 @@ byte-compile-file-form-defalias
              (if (null fun)
                  (message "Macro %s unrecognized, won't work in file" name)
                (message "Macro %s partly recognized, trying our luck" name)
-               (push (cons name (eval fun))
+               (push (cons name (eval fun t))
                      byte-compile-macro-environment)))
            (byte-compile-keep-pending form))))
 
@@ -4725,6 +4730,33 @@ byte-compile-make-variable-buffer-local
      'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local)
 (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)
+(defun byte-compile-function-put (form)
+  (pcase form
+    ((and `(,op ,fun ,prop ,val)
+          (guard (and (macroexp-const-p fun)
+                      (macroexp-const-p prop)
+                      (or (macroexp-const-p val)
+                          ;; Also accept anonymous functions, since
+                          ;;  we're at top-level which implies they're
+                          ;;  also constants.
+                          (pcase val (`(function (lambda . ,_)) t))))))
+     (byte-compile-push-constant op)
+     (byte-compile-form fun)
+     (byte-compile-form prop)
+     (let* ((fun (eval fun t))
+            (prop (eval prop t))
+            (val (if (macroexp-const-p val)
+                     (eval val t)
+                   (byte-compile-lambda (cadr val)))))
+       (push (cons fun `(,prop ,val
+                         . ,(assq fun byte-compile-plist-environment)))
+             byte-compile-plist-environment)
+       (byte-compile-push-constant val)
+       (byte-compile-out 'byte-call 3)))
+
+    (_ (byte-compile-keep-pending form))))
 \f
 ;;; tags
 

bug#27016: possible bug in `defsetf'

[npostavs]

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

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

> @@ -4695,7 +4700,7 @@ byte-compile-file-form-defalias
>               (if (null fun)
>                   (message "Macro %s unrecognized, won't work in file" name)
>                 (message "Macro %s partly recognized, trying our luck" name)
> -               (push (cons name (eval fun))
> +               (push (cons name (eval fun t))

What does this do?  Should it be `lexical-binding' instead of `t'?

> +       (push (cons fun `(,prop ,val
> +                         . ,(assq fun byte-compile-plist-environment)))

That should be alist-get instead of assq.  I've fixed that and added a
test for it.


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

From 8ae4c8b840070c025fc7a9b24ab7fcff38683191 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@IRO.UMontreal.CA>
Date: Fri, 14 Jul 2017 00:32:34 -0400
Subject: [PATCH v4 1/2] Let function-put take effect during compilation

* lisp/emacs-lisp/bytecomp.el (byte-compile-plist-environment): New
variable.
* lisp/emacs-lisp/bytecomp.el (byte-compile--outbuffer): Let-bind it to
nil.
* lisp/emacs-lisp/bytecomp.el (byte-compile-function-put): New
function, handles compilation of top-level `function-put' calls.
* lisp/subr.el (function-get): Consult byte-compile-plist-environment.

Co-authored-by: Noam Postavsky <npostavs@gmail.com>
---
 lisp/emacs-lisp/bytecomp.el            | 34 +++++++++++++++++++++++++++++++++-
 lisp/subr.el                           |  7 ++++++-
 test/lisp/emacs-lisp/bytecomp-tests.el | 17 +++++++++++++++++
 3 files changed, 56 insertions(+), 2 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index fdd4276e4e..ee474f9527 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -498,6 +498,10 @@ (defvar byte-compile-macro-environment byte-compile-initial-macro-environment
 Each element looks like (MACRONAME . DEFINITION).  It is
 \(MACRONAME . nil) when a macro is redefined as a function.")
 
+(defvar byte-compile-plist-environment nil
+  "Alist of property lists defined in the file being compiled.
+Each element looks like (SYMBOL . PLIST).")
+
 (defvar byte-compile-function-environment nil
   "Alist of functions defined in the file being compiled.
 This is so we can inline them when necessary.
@@ -1572,6 +1576,7 @@ (defmacro byte-compile-close-variables (&rest body)
           ;; macroenvironment.
           (copy-alist byte-compile-initial-macro-environment))
          (byte-compile--outbuffer nil)
+         (byte-compile-plist-environment nil)
          (byte-compile-function-environment nil)
          (byte-compile-bound-variables nil)
          (byte-compile-lexical-variables nil)
@@ -4682,7 +4687,7 @@ (defun byte-compile-file-form-defalias (form)
              (if (null fun)
                  (message "Macro %s unrecognized, won't work in file" name)
                (message "Macro %s partly recognized, trying our luck" name)
-               (push (cons name (eval fun))
+               (push (cons name (eval fun t))
                      byte-compile-macro-environment)))
            (byte-compile-keep-pending form))))
 
@@ -4712,6 +4717,33 @@ (put 'make-variable-buffer-local
      'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local)
 (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)
+(defun byte-compile-function-put (form)
+  (pcase form
+    ((and `(,op ,fun ,prop ,val)
+          (guard (and (macroexp-const-p fun)
+                      (macroexp-const-p prop)
+                      (or (macroexp-const-p val)
+                          ;; Also accept anonymous functions, since
+                          ;;  we're at top-level which implies they're
+                          ;;  also constants.
+                          (pcase val (`(function (lambda . ,_)) t))))))
+     (byte-compile-push-constant op)
+     (byte-compile-form fun)
+     (byte-compile-form prop)
+     (let* ((fun (eval fun t))
+            (prop (eval prop t))
+            (val (if (macroexp-const-p val)
+                     (eval val t)
+                   (byte-compile-lambda (cadr val)))))
+       (push `(,fun
+               . (,prop ,val ,@(alist-get fun byte-compile-plist-environment)))
+             byte-compile-plist-environment)
+       (byte-compile-push-constant val)
+       (byte-compile-out 'byte-call 3)))
+
+    (_ (byte-compile-keep-pending form))))
 \f
 ;;; tags
 
diff --git a/lisp/subr.el b/lisp/subr.el
index a9edff6166..0c7e52c7a7 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2962,7 +2962,12 @@ (defun function-get (f prop &optional autoload)
 if it's an autoloaded macro."
   (let ((val nil))
     (while (and (symbolp f)
-                (null (setq val (get f prop)))
+                (null (setq val (or (plist-get
+                                     (alist-get
+                                      f (bound-and-true-p
+                                         byte-compile-plist-environment))
+                                     prop)
+                                    (get f prop))))
                 (fboundp f))
       (let ((fundef (symbol-function f)))
         (if (and autoload (autoloadp fundef)
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index d15bd8b6e6..8ef2ce7025 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -545,6 +545,23 @@ (ert-deftest bytecomp-tests--old-style-backquotes ()
 This functionality has been obsolete for more than 10 years already
 and will be removed soon.  See (elisp)Backquote in the manual.")))))))
 
+
+(ert-deftest bytecomp-tests-function-put ()
+  "Check `function-put' operates during compilation."
+  (should (boundp 'lread--old-style-backquotes))
+  (bytecomp-tests--with-temp-file source
+    (dolist (form '((function-put 'bytecomp-tests--foo 'foo 1)
+                    (function-put 'bytecomp-tests--foo 'bar 2)
+                    (defmacro bytecomp-tests--foobar ()
+                      `(cons ,(function-get 'bytecomp-tests--foo 'foo)
+                             ,(function-get 'bytecomp-tests--foo 'bar)))
+                    (defvar bytecomp-tests--foobar 1)
+                    (setq bytecomp-tests--foobar (bytecomp-tests--foobar))))
+      (print form (current-buffer)))
+    (write-region (point-min) (point-max) source nil 'silent)
+    (byte-compile-file source t)
+    (should (equal bytecomp-tests--foobar (cons 1 2)))))
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End:
-- 
2.11.1


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

From ee889d6bb0e36d8852ab122cfbcf2782dc12f74e Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 13 Jul 2017 00:42:38 -0400
Subject: [PATCH v4 2/2] Don't define gv expanders in compiler's runtime
 (Bug#27016)

This prevents definitions being compiled from leaking into the current
Emacs doing the compilation.
* lisp/emacs-lisp/gv.el (gv-define-expander): Use function-put instead
of `put' with `eval-and-compile'.
* test/lisp/emacs-lisp/gv-tests.el: New tests.
---
 lisp/emacs-lisp/gv.el            |   7 +-
 test/lisp/emacs-lisp/gv-tests.el | 140 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 141 insertions(+), 6 deletions(-)
 create mode 100644 test/lisp/emacs-lisp/gv-tests.el

diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index c5c12a6414..54105f89af 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -146,12 +146,7 @@ (defmacro gv-define-expander (name handler)
 HANDLER is a function which takes an argument DO followed by the same
 arguments as NAME.  DO is a function as defined in `gv-get'."
   (declare (indent 1) (debug (sexp form)))
-  ;; Use eval-and-compile so the method can be used in the same file as it
-  ;; is defined.
-  ;; FIXME: Just like byte-compile-macro-environment, we should have something
-  ;; like byte-compile-symbolprop-environment so as to handle these things
-  ;; cleanly without affecting the running Emacs.
-  `(eval-and-compile (put ',name 'gv-expander ,handler)))
+  `(function-put ',name 'gv-expander ,handler))
 
 ;;;###autoload
 (defun gv--defun-declaration (symbol name args handler &optional fix)
diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el
new file mode 100644
index 0000000000..b15a3de8cc
--- /dev/null
+++ b/test/lisp/emacs-lisp/gv-tests.el
@@ -0,0 +1,140 @@
+;;; gv-tests.el --- tests for gv.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(eval-when-compile (require 'cl-lib))
+
+(cl-defmacro gv-tests--in-temp-dir ((elvar elcvar)
+                                    (&rest filebody)
+                                    &rest body)
+  (declare (indent 2))
+  `(let ((default-directory (make-temp-file "gv-test" t)))
+     (unwind-protect
+         (let ((,elvar "gv-test-deffoo.el")
+               (,elcvar "gv-test-deffoo.elc"))
+           (with-temp-file ,elvar
+             (insert ";; -*- lexical-binding: t; -*-\n")
+             (dolist (form ',filebody)
+               (pp form (current-buffer))))
+           ,@body)
+       (delete-directory default-directory t))))
+
+(ert-deftest gv-define-expander-in-file ()
+  (gv-tests--in-temp-dir (el elc)
+      ((gv-define-setter gv-test-foo (newval cons)
+         `(setcar ,cons ,newval))
+       (defvar gv-test-pair (cons 1 2))
+       (setf (gv-test-foo gv-test-pair) 99)
+       (message "%d" (car gv-test-pair)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc)
+      (should (equal (buffer-string) "99\n")))))
+
+(ert-deftest gv-define-expander-in-file-twice ()
+  (gv-tests--in-temp-dir (el elc)
+      ((gv-define-setter gv-test-foo (newval cons)
+         `(setcar ,cons ,newval))
+       (defvar gv-test-pair (cons 1 2))
+       (setf (gv-test-foo gv-test-pair) 99)
+       (gv-define-setter gv-test-foo (newval cons)
+         `(setcdr ,cons ,newval))
+       (setf (gv-test-foo gv-test-pair) 42)
+       (message "%S" gv-test-pair))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc)
+      (should (equal (buffer-string) "(99 . 42)\n")))))
+
+(ert-deftest gv-dont-define-expander-in-file ()
+  ;; The expander is defined while we are compiling the file, even
+  ;; though it's inside (when nil ...) because the compiler won't
+  ;; analyze the conditional.
+  :expected-result :failed
+  (gv-tests--in-temp-dir (el elc)
+      ((when nil (gv-define-setter gv-test-foo (newval cons)
+                   `(setcar ,cons ,newval)))
+       (defvar gv-test-pair (cons 1 2))
+       (setf (gv-test-foo gv-test-pair) 99)
+       (message "%d" (car gv-test-pair)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc)
+      (should (equal (buffer-string)
+                     "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n")))))
+
+(ert-deftest gv-define-expander-in-function ()
+  ;; The expander is not defined while we are compiling the file, the
+  ;; compiler won't handle gv definitions not at top-level.
+  :expected-result :failed
+  (gv-tests--in-temp-dir (el elc)
+      ((defun foo ()
+         (gv-define-setter gv-test-foo (newval cons)
+           `(setcar ,cons ,newval))
+         t)
+       (defvar gv-test-pair (cons 1 2))
+       (setf (gv-test-foo gv-test-pair) 99)
+       (message "%d" (car gv-test-pair)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc)
+      (should (equal (buffer-string) "99\n")))))
+
+(ert-deftest gv-define-expander-out-of-file ()
+  (gv-tests--in-temp-dir (el elc)
+      ((gv-define-setter gv-test-foo (newval cons)
+         `(setcar ,cons ,newval))
+       (defvar gv-test-pair (cons 1 2)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc
+                    "--eval"
+                    (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99)
+                                             (message "%d" (car gv-test-pair)))))
+      (should (equal (buffer-string) "99\n")))))
+
+(ert-deftest gv-dont-define-expander-other-file ()
+  (gv-tests--in-temp-dir (el elc)
+      ((if nil (gv-define-setter gv-test-foo (newval cons)
+                 `(setcar ,cons ,newval)))
+       (defvar gv-test-pair (cons 1 2)))
+    (with-temp-buffer
+      (call-process (concat invocation-directory invocation-name)
+                    nil '(t t) nil
+                    "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+                    "-l" elc
+                    "--eval"
+                    (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99)
+                                             (message "%d" (car gv-test-pair)))))
+      (should (equal (buffer-string)
+                     "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n")))))
+
+;;; gv-tests.el ends here
-- 
2.11.1

bug#27016: possible bug in `defsetf'

[Stefan Monnier]

>> +               (push (cons name (eval fun t))
> What does this do?  Should it be `lexical-binding' instead of `t'?

Sorry, part of an unrelated experiment.

>> +       (push (cons fun `(,prop ,val
>> +                         . ,(assq fun byte-compile-plist-environment)))
> That should be alist-get instead of assq.

Good catch.

> +     (let* ((fun (eval fun t))
> +            (prop (eval prop t))

These should likely be just (eval fun) without the `t` either.
Tho it doesn't really matter in any case: all those `eval`s just strip
off the quote in front of a sexp and should do the same regardless of
lexical-binding.


        Stefan

bug#27016: possible bug in `defsetf'

[npostavs]

tags 27016 fixed
close 27016 26.1
quit

This should be fix in master now.

[1: 79a74568e9]: 2017-08-07 18:54:49 -0400
  Don't define gv expanders in compiler's runtime (Bug#27016)
  http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=79a74568e9166f63a12adb30f54edcd57a6405a3

[2: cc30d77ecd]: 2017-08-07 18:54:49 -0400
  Let `define-symbol-prop' take effect during compilation
  http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=cc30d77ecdd1b9155ade3d0656a84a0839ee2795