From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.bugs Subject: bug#8338: 24.0.50; lexbind lisp error Date: Thu, 05 May 2011 00:47:48 -0300 Message-ID: References: <874o6smpnj.fsf@linux.vnet.ibm.com> <87aag1or61.fsf@linux.vnet.ibm.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: dough.gmane.org 1304567295 17536 80.91.229.12 (5 May 2011 03:48:15 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Thu, 5 May 2011 03:48:15 +0000 (UTC) Cc: 8338@debbugs.gnu.org, "Eric M. Ludlam" To: "Aneesh Kumar K.V" Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu May 05 05:48:11 2011 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1QHpXt-0002no-Td for geb-bug-gnu-emacs@m.gmane.org; Thu, 05 May 2011 05:48:10 +0200 Original-Received: from localhost ([::1]:44133 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QHpXt-0001lQ-HS for geb-bug-gnu-emacs@m.gmane.org; Wed, 04 May 2011 23:48:09 -0400 Original-Received: from eggs.gnu.org ([140.186.70.92]:53202) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QHpXp-0001lK-9K for bug-gnu-emacs@gnu.org; Wed, 04 May 2011 23:48:06 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1QHpXn-0003eH-GP for bug-gnu-emacs@gnu.org; Wed, 04 May 2011 23:48:05 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:45153) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QHpXn-0003eD-D5 for bug-gnu-emacs@gnu.org; Wed, 04 May 2011 23:48:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.69) (envelope-from ) id 1QHpXm-0002Pb-HO; Wed, 04 May 2011 23:48:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-To: owner@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 05 May 2011 03:48:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 8338 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 8338-submit@debbugs.gnu.org id=B8338.13045672809264 (code B ref 8338); Thu, 05 May 2011 03:48:02 +0000 Original-Received: (at 8338) by debbugs.gnu.org; 5 May 2011 03:48:00 +0000 Original-Received: from localhost ([127.0.0.1] helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1QHpXk-0002PM-6z for submit@debbugs.gnu.org; Wed, 04 May 2011 23:48:00 -0400 Original-Received: from fencepost.gnu.org ([140.186.70.10]) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1QHpXh-0002P8-I2 for 8338@debbugs.gnu.org; Wed, 04 May 2011 23:47:58 -0400 Original-Received: from 121-249-126-200.fibertel.com.ar ([200.126.249.121]:23931 helo=ceviche.home) by fencepost.gnu.org with esmtpsa (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1QHpXb-00025F-Pr; Wed, 04 May 2011 23:47:52 -0400 Original-Received: by ceviche.home (Postfix, from userid 20848) id 11E8F66168; Thu, 5 May 2011 00:47:48 -0300 (ART) In-Reply-To: <87aag1or61.fsf@linux.vnet.ibm.com> (Aneesh Kumar K. V.'s message of "Thu, 07 Apr 2011 23:54:54 +0530") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.50 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.11 Precedence: list Resent-Date: Wed, 04 May 2011 23:48:02 -0400 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:46227 Archived-At: > I looked at the bzr trunk and here is how to reproduce > emacs -Q > enable semantic (semantic-mode 1) > open a c file kernel/fork.c > on a function name do semantic-ia-show-summary > exit emacs. This will ask to create semanticDB > start emacs -Q > open the same c file > you get the error I believe I have found the culprit and fixed it with the patch below which I have just installed into trunk. Thanks Eric for pointing out that maybe the real problem was hidden by a condition-case somewhere. I'm bumping into another unexplained problem now, tho. It might be due to some local messed up database (the same problem shows up with Emacs-23.3), but in any case, please confirm (or infirm) that the problem is really fixed for you. Stefan === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-05 03:26:55 +0000 +++ lisp/ChangeLog 2011-05-05 03:41:47 +0000 @@ -1,3 +1,13 @@ +2011-05-05 Stefan Monnier + + Fix earlier half-done eieio-defmethod change (bug#8338). + * emacs-lisp/eieio.el (eieio--defmethod): Rename from eieio-defmethod. + Streamline and change calling convention. + (defmethod): Adjust accordingly and simplify. + (eieio-defclass): Fix broken calls to eieio-defmethod and redirect to + new eieio--defmethod. + (slot-boundp): Minor CSE simplification. + 2011-05-05 Milan Zamazal * progmodes/glasses.el (glasses-separate-capital-groups): New option. === modified file 'lisp/emacs-lisp/eieio.el' --- lisp/emacs-lisp/eieio.el 2011-04-01 15:16:50 +0000 +++ lisp/emacs-lisp/eieio.el 2011-05-05 03:31:19 +0000 @@ -656,14 +656,14 @@ ;; so that users can `setf' the space returned by this function (if acces (progn - (eieio-defmethod acces - (list (if (eq alloc :class) :static :primary) - (list (list 'this cname)) - (format + (eieio--defmethod + acces (if (eq alloc :class) :static :primary) cname + `(lambda (this) + ,(format "Retrieves the slot `%s' from an object of class `%s'" name cname) - (list 'if (list 'slot-boundp 'this (list 'quote name)) - (list 'eieio-oref 'this (list 'quote name)) + (if (slot-boundp this ',name) + (eieio-oref this ',name) ;; Else - Some error? nil? nil))) @@ -683,22 +683,21 @@ ;; If a writer is defined, then create a generic method of that ;; name whose purpose is to set the value of the slot. (if writer - (progn - (eieio-defmethod writer - (list (list (list 'this cname) 'value) - (format "Set the slot `%s' of an object of class `%s'" + (eieio--defmethod + writer nil cname + `(lambda (this value) + ,(format "Set the slot `%s' of an object of class `%s'" name cname) - `(setf (slot-value this ',name) value))) - )) + (setf (slot-value this ',name) value)))) ;; If a reader is defined, then create a generic method ;; of that name whose purpose is to access this slot value. (if reader - (progn - (eieio-defmethod reader - (list (list (list 'this cname)) - (format "Access the slot `%s' from object of class `%s'" + (eieio--defmethod + reader nil cname + `(lambda (this) + ,(format "Access the slot `%s' from object of class `%s'" name cname) - `(slot-value this ',name))))) + (slot-value this ',name)))) ) (setq slots (cdr slots))) @@ -1290,83 +1289,48 @@ ((typearg class-name) arg2 &optional opt &rest rest) \"doc-string\" body)" - (let* ((key (cond ((or (eq ':BEFORE (car args)) - (eq ':before (car args))) - (setq args (cdr args)) - :before) - ((or (eq ':AFTER (car args)) - (eq ':after (car args))) - (setq args (cdr args)) - :after) - ((or (eq ':PRIMARY (car args)) - (eq ':primary (car args))) - (setq args (cdr args)) - :primary) - ((or (eq ':STATIC (car args)) - (eq ':static (car args))) - (setq args (cdr args)) - :static) - (t nil))) + (let* ((key (if (keywordp (car args)) (pop args))) (params (car args)) - (lamparams - (mapcar (lambda (param) (if (listp param) (car param) param)) - params)) (arg1 (car params)) - (class (if (listp arg1) (nth 1 arg1) nil))) - `(eieio-defmethod ',method - '(,@(if key (list key)) - ,params) - (lambda ,lamparams ,@(cdr args))))) + (class (if (consp arg1) (nth 1 arg1)))) + `(eieio--defmethod ',method ',key ',class + (lambda ,(if (consp arg1) + (cons (car arg1) (cdr params)) + params) + ,@(cdr args))))) -(defun eieio-defmethod (method args &optional code) +(defun eieio--defmethod (method kind argclass code) "Work part of the `defmethod' macro defining METHOD with ARGS." - (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa) + (let ((key ;; find optional keys - (setq key - (cond ((or (eq ':BEFORE (car args)) - (eq ':before (car args))) - (setq args (cdr args)) + (cond ((or (eq ':BEFORE kind) + (eq ':before kind)) method-before) - ((or (eq ':AFTER (car args)) - (eq ':after (car args))) - (setq args (cdr args)) + ((or (eq ':AFTER kind) + (eq ':after kind)) method-after) - ((or (eq ':PRIMARY (car args)) - (eq ':primary (car args))) - (setq args (cdr args)) + ((or (eq ':PRIMARY kind) + (eq ':primary kind)) method-primary) - ((or (eq ':STATIC (car args)) - (eq ':static (car args))) - (setq args (cdr args)) + ((or (eq ':STATIC kind) + (eq ':static kind)) method-static) ;; Primary key - (t method-primary))) - ;; get body, and fix contents of args to be the arguments of the fn. - (setq body (cdr args) - args (car args)) - (setq loopa args) - ;; Create a fixed version of the arguments - (while loopa - (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa)) - argfix)) - (setq loopa (cdr loopa))) + (t method-primary)))) ;; make sure there is a generic (eieio-defgeneric method - (if (stringp (car body)) - (car body) (format "Generically created method `%s'." method))) + (or (documentation code) + (format "Generically created method `%s'." method))) ;; create symbol for property to bind to. If the first arg is of ;; the form (varname vartype) and `vartype' is a class, then ;; that class will be the type symbol. If not, then it will fall ;; under the type `primary' which is a non-specific calling of the ;; function. - (setq firstarg (car args)) - (if (listp firstarg) - (progn - (setq argclass (nth 1 firstarg)) + (if argclass (if (not (class-p argclass)) (error "Unknown class type %s in method parameters" - (nth 1 firstarg)))) + argclass)) (if (= key -1) (signal 'wrong-type-argument (list :static 'non-class-arg))) ;; generics are higher @@ -1884,11 +1848,11 @@ ;; Skip typechecking while retrieving this value. (let ((eieio-skip-typecheck t)) ;; Return nil if the magic symbol is in there. - (if (eieio-object-p object) - (if (eq (eieio-oref object slot) eieio-unbound) nil t) - (if (class-p object) - (if (eq (eieio-oref-default object slot) eieio-unbound) nil t) - (signal 'wrong-type-argument (list 'eieio-object-p object)))))) + (not (eq (cond + ((eieio-object-p object) (eieio-oref object slot)) + ((class-p object) (eieio-oref-default object slot)) + (t (signal 'wrong-type-argument (list 'eieio-object-p object)))) + eieio-unbound)))) (defun slot-makeunbound (object slot) "In OBJECT, make SLOT unbound."