Re: [Gcl-devel] Package test failures

[Camm Maguire]

Greetings!  A few other fixes with comments:

"Paul F. Dietz" <address@hidden> writes:

> I've classified the causes of the failures of the package tests:
> 
> DEFPACKAGE-3
>     Documentation is not being stored so that (DOCUMENTATION <package> T)
>     can retrieve it.
> 
> DEFPACKAGE-4, DO-SYMBOLS-1,4,5
>     These appear to be broken because DO-SYMBOLS is not correct.
>     It needs to iterate over all the symbols accessible in a package,
>     not just those present in the package.  Accessible symbols include
>     those inherited from other packages.  Here, the package H has no
>     internal or external symbols but does inherit the symbol A:FOO.

I think I've done this correctly, but I still get some (as yet)
unexplained failures on the following tests:
   CL-TEST::DEFPACKAGE-4, CL-TEST::DEFPACKAGE-24, 
   CL-TEST::DEFPACKAGE-25, CL-TEST::DO-SYMBOLS-8.

For example, there is some strange miscompilation of
cl-test::num-symbols-in-package:

=============================================================================
>(LOOP
        CL-TEST::FOR
        CL-TEST::N
        CL-TEST::IN
        '("A" :A #\A)
        COUNT
        (NOT (IGNORE-ERRORS
                 (PROGN
                   (IGNORE-ERRORS (DELETE-PACKAGE "H"))
                   (LET ((CL-TEST::P
                             (IGNORE-ERRORS
                                 (EVAL (LIST 'DEFPACKAGE "H"
                                        (LIST :USE CL-TEST::N))))))
                     (AND (PACKAGEP CL-TEST::P)
                          (EQUAL (PACKAGE-NAME CL-TEST::P) "H")
                          (EQUAL (PACKAGE-USE-LIST CL-TEST::P)
                                 (LIST (FIND-PACKAGE "A")))
                          (EQUAL (PACKAGE-USED-BY-LIST CL-TEST::P) NIL)
                          (EQUAL (PACKAGE-NICKNAMES CL-TEST::P) NIL)
                          (EQUAL (PACKAGE-SHADOWING-SYMBOLS CL-TEST::P)
                                 NIL)
                          (EQL (CL-TEST::NUM-SYMBOLS-IN-PACKAGE
                                   CL-TEST::P)
                               (CL-TEST::NUM-EXTERNAL-SYMBOLS-IN-PACKAGE
                                   "A"))
                          (EQUAL (DOCUMENTATION CL-TEST::P T) NIL)))))))


3

>(setq cl-test::n "A")

"A"

>(delete-package "H")

T

>(setq cl-test::p (EVAL (LIST 'DEFPACKAGE "H"
                                        (LIST :USE CL-TEST::N))))

#<"H" package>

>(cl-test::num-symbols-in-package cl-test::p)

0

>(defun my-num-symbols-in-package (p)
  (let ((num 0))
    (declare (fixnum num))
    (do-symbols (s p num)
      (declare (ignore s))
      (incf num))))


MY-NUM-SYMBOLS-IN-PACKAGE

>(my-num-symbols-in-package cl-test::p)

1

=============================================================================
And is the do-symbols-8 test broken?
=============================================================================
>(HANDLER-CASE
          (LET ((CL-TEST::X NIL))
            (LIST (DO-SYMBOLS (CL-TEST::S "DS1")
                    (WHEN (EQUAL (SYMBOL-NAME CL-TEST::S) "C")
                      (GO CL-TEST::BAR))
                    (PUSH CL-TEST::S CL-TEST::X)
                    (GO CL-TEST::FOO)
                    CL-TEST::BAR
                    (PUSH T CL-TEST::X)
                    CL-TEST::FOO)
                  (CL-TEST::SORT-SYMBOLS CL-TEST::X)))
          (ERROR (CL-TEST::C) CL-TEST::C))


#<CONDITIONS::INTERNAL-SIMPLE-STREAM-ERROR.39>

>          (LET ((CL-TEST::X NIL))
            (LIST (DO-SYMBOLS (CL-TEST::S "DS1")
                    (WHEN (EQUAL (SYMBOL-NAME CL-TEST::S) "C")
                      (GO CL-TEST::BAR))
                    (PUSH CL-TEST::S CL-TEST::X)
                    (GO CL-TEST::FOO)
                    CL-TEST::BAR
                    (PUSH T CL-TEST::X)
                    CL-TEST::FOO)
                  (CL-TEST::SORT-SYMBOLS CL-TEST::X)))

Error in PROGN [or a callee]: CL-TEST::BAR is an undefined tag.
========================================================================================
Also, I assume the test wants a shadowing import of a non existent
symbol to throw a package error, but I cannot find this in the spec
anywhere, and gcl's current implementation does not complain in this
situation:

Form: (IGNORE-ERRORS (IGNORE-ERRORS (DELETE-PACKAGE "H"))
          (IGNORE-ERRORS (DELETE-PACKAGE "G"))
          (EVAL '(DEFPACKAGE "G" (:USE)))
          (HANDLER-CASE
              (EVAL '(DEFPACKAGE "H"
                         (:SHADOWING-IMPORT-FROM "G" "NOT-THERE")))
              (PACKAGE-ERROR (CL-TEST::C)
                  (IF (POSITION 'ABORT (COMPUTE-RESTARTS CL-TEST::C)
                          :KEY #'RESTART-NAME :TEST-NOT #'EQ)
                      'CL-TEST::SUCCESS 'CL-TEST::FAIL))
              (ERROR (CL-TEST::C) CL-TEST::C)))
Expected value: CL-TEST::SUCCESS
Actual value: #<"H" package>.
=============================================================================

Finally, if I enable the package error exceptional situations
specified for delete package in the spec, I break 3 delete-package
tests.  I have therefore not committed this yet.


Test CL-TEST::DELETE-PACKAGE-2 failed
Form: (PROGN
        (IGNORE-ERRORS (DELETE-PACKAGE :TEST1))
        (LET ((CL-TEST::P (MAKE-PACKAGE :TEST1 :USE NIL)))
          (LIST (NOT (NOT (DELETE-PACKAGE :TEST1)))
                (NOT (NOT (PACKAGEP CL-TEST::P)))
                (DELETE-PACKAGE CL-TEST::P))))
Expected value: (T T NIL)
Actual value: #<CONDITIONS::INTERNAL-PACKAGE-ERROR.0>.
 CL-TEST::DELETE-PACKAGE-3 CL-TEST::DELETE-PACKAGE-4
Test CL-TEST::DELETE-PACKAGE-5 failed
Form: (PROG (CL-TEST::P1 CL-TEST::S1 CL-TEST::P2 CL-TEST::S2
                CL-TEST::P3)
        (IGNORE-ERRORS (DELETE-PACKAGE "P3"))
        (IGNORE-ERRORS (DELETE-PACKAGE "P2"))
        (IGNORE-ERRORS (DELETE-PACKAGE "P1"))
        (SETQ CL-TEST::P1 (MAKE-PACKAGE "P1" :USE NIL))
        (SETQ CL-TEST::S1 (INTERN "S1" CL-TEST::P1))
        (EXPORT CL-TEST::S1 "P1")
        (SETQ CL-TEST::P2 (MAKE-PACKAGE "P2" :USE '("P1")))
        (SETQ CL-TEST::S2 (INTERN "S2" CL-TEST::P2))
        (EXPORT CL-TEST::S1 CL-TEST::P2)
        (EXPORT CL-TEST::S2 "P2")
        (SETF CL-TEST::P3 (MAKE-PACKAGE "P3" :USE '("P2")))
        (CATCH 'CL-TEST::CONTINUE-FAILED
          (LET ((*DEBUGGER-HOOK*
                    #'CL-TEST::CATCH-CONTINUE-DEBUGGER-HOOK)
                (CL-TEST::*CATCH-ERROR-TYPE* 'PACKAGE-ERROR))
            (DECLARE (SPECIAL *DEBUGGER-HOOK*
                              CL-TEST::*CATCH-ERROR-TYPE*))
            (DELETE-PACKAGE CL-TEST::P2)))
        (UNLESS (AND (EQUAL (PACKAGE-NAME CL-TEST::P1) "P1")
                     (NULL (PACKAGE-NAME CL-TEST::P2))
                     (EQUAL (PACKAGE-NAME CL-TEST::P3) "P3"))
          (RETURN 'CL-TEST::FAIL1))
        (UNLESS (EQ (SYMBOL-PACKAGE CL-TEST::S1) CL-TEST::P1)
          (RETURN 'CL-TEST::FAIL2))
        (UNLESS (EQUAL (PRIN1-TO-STRING CL-TEST::S1) "P1:S1")
          (RETURN 'CL-TEST::FAIL3))
        (UNLESS (EQUAL (MULTIPLE-VALUE-LIST
                           (FIND-SYMBOL "S1" CL-TEST::P3))
                       '(NIL NIL))
          (RETURN 'CL-TEST::FAIL4))
        (UNLESS (EQUAL (MULTIPLE-VALUE-LIST
                           (FIND-SYMBOL "S2" CL-TEST::P3))
                       '(NIL NIL))
          (RETURN 'CL-TEST::FAIL5))
        (UNLESS (AND (NULL (PACKAGE-USED-BY-LIST CL-TEST::P1))
                     (NULL (PACKAGE-USED-BY-LIST CL-TEST::P3)))
          (RETURN 'CL-TEST::FAIL6))
        (UNLESS (AND (PACKAGEP CL-TEST::P1) (PACKAGEP CL-TEST::P2)
                     (PACKAGEP CL-TEST::P3))
          (RETURN 'CL-TEST::FAIL7))
        (UNLESS (AND (NULL (PACKAGE-USE-LIST CL-TEST::P1))
                     (NULL (PACKAGE-USE-LIST CL-TEST::P3)))
          (RETURN 'CL-TEST::FAIL8))
        (IGNORE-ERRORS (DELETE-PACKAGE CL-TEST::P3))
        (IGNORE-ERRORS (DELETE-PACKAGE CL-TEST::P1))
        (RETURN T))
Expected value: T
Actual value: #<CONDITIONS::INTERNAL-PACKAGE-ERROR.1>.
Test CL-TEST::DELETE-PACKAGE-6 failed
Form: (PROGN
        (WHEN (FIND-PACKAGE "TEST-20") (DELETE-PACKAGE "TEST-20"))
        (CATCH 'CL-TEST::CONTINUE-FAILED
          (LET ((*DEBUGGER-HOOK*
                    #'CL-TEST::CATCH-CONTINUE-DEBUGGER-HOOK)
                (CL-TEST::*CATCH-ERROR-TYPE* 'PACKAGE-ERROR))
            (DECLARE (SPECIAL *DEBUGGER-HOOK*
                              CL-TEST::*CATCH-ERROR-TYPE*))
            (AND (NOT (DELETE-PACKAGE "TEST-20")) T))))
Expected value: T
Actual value: #<CONDITIONS::INTERNAL-PACKAGE-ERROR.2>.



In addition, there are several other error conditions specified in
package.d which may need to be changed to package errors, but are not
yet exposed in the tests.  I'll try to find time to go over the spec
in this regard.



============================================================================= 


> 
> DEFPACKAGE-13
>     Repeating the :SIZE parameter should cause a PROGRAM-ERROR.
> 
> DEFPACKAGE-14
>     Repeating the :DOCUMENTATION parameter should cause a PROGRAM-ERROR.
> 
> DEFPACKAGE-15,16
>     Should signal a PACKAGE-ERROR if a nickname is already in use.
> 
> DEFPACKAGE-17,18,19,20,21,22,23
>     These are name conflicts that should cause PROGRAM-ERRORs.
> 

All straightforward fixes I think.

Take care,

> 
>       Paul
> 
> 
> 
> _______________________________________________
> Gcl-devel mailing list
> address@hidden
> http://mail.gnu.org/mailman/listinfo/gcl-devel
> 
> 

-- 
Camm Maguire                                            address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens."  --  Baha'u'llah