ezgcd bug / fix
- Subject: ezgcd bug / fix
- From: Barton Willis
- Date: Sun, 29 Nov 2009 14:09:30 -0600
Bug (reported):
(%i1) ezgcd(rat(x-7), x-8);
(%o1) true
This bug is due to a spurious return:
(defmfun $ezgcd (&rest args)
(prog (pfl allvars presult flag genvar denom pfl2)
;;need if genvar doesn't shrink
(when (null args)
(wna-err '$ezgcd))
(when (some #'$ratp args)
(return (setq flag t))) ;; <-- spurious return
...
The variable flag determines if the result should be converted to general
form on exiting.
There are no problems with the testsuite. Is it OK to make this fix now?
Barton
(defmfun $ezgcd (&rest args)
(prog (pfl allvars presult flag genvar denom pfl2)
;;need if genvar doesn't shrink
(when (null args)
(wna-err '$ezgcd))
(when (some #'$ratp args)
(setq flag t))
(setq pfl (mapcar #'(lambda (h) (cdr (ratf h))) args))
(setq pfl2 (list 1))
(do ((lcm (cdar pfl))
(l (cdr pfl) (cdr l))
(cof1)
(cof2))
((null l) (setq denom lcm))
(desetq (lcm cof1 cof2) (plcmcofacts lcm (cdar l)))
(unless (equal cof1 1)
(mapcar #'(lambda (x) (ptimes x cof1)) pfl2))
(push cof2 pfl2))
(setq pfl (mapcar #'car pfl))
(setq allvars (sort (listovarsl pfl) #'pointergp))
(setq presult (if $ratfac
(let (($gcd '$ez))
(facmgcd pfl))
(ezgcd pfl allvars modulus)))
(setq presult (cons (cons (car presult) denom)
(if (equal denom 1)
(cdr presult)
(mapcar #'ptimes (cdr presult) pfl2))))
(setq presult (cons '(mlist)
(cons (rdis* (car presult))
(mapcar #'pdis* (cdr presult)))))
(return (if flag presult ($totaldisrep presult)))))