/[gcl]/gcl/ansi-tests/adjust-array.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/adjust-array.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by pfdietz, Thu Mar 4 11:11:51 2004 UTC revision 1.10 by pfdietz, Thu Jul 14 02:54:06 2005 UTC
# Line 324  Line 324 
324    
325  ;;;; Strings  ;;;; Strings
326    
327    (loop for element-type in '(character base-char)
328          for forms = `(
329  (def-adjust-array-test adjust-array.string.1  (def-adjust-array-test adjust-array.string.1
330    (5 :element-type 'character :initial-contents "abcde")    (5 :element-type 'character :initial-contents "abcde")
331    (4 :element-type 'character)    (4 :element-type 'character)
# Line 478  Line 480 
480      a2)      a2)
481     #.(make-array nil :initial-element #\x :element-type 'character))     #.(make-array nil :initial-element #\x :element-type 'character))
482    
483    (def-adjust-array-test adjust-array.string.adjustable.1
484      (5 :initial-contents "abcde" :adjustable t :element-type 'character)
485      (4 :element-type 'character)
486      "abcd")
487    
488    (def-adjust-array-test adjust-array.string.adjustable.2
489      (5 :initial-contents "abcde" :adjustable t :element-type 'character)
490      (8 :initial-element #\x :element-type 'character)
491      "abcdexxx")
492    
493    (def-adjust-array-test adjust-array.string.adjustable.3
494      (5 :initial-contents "abcde" :adjustable t :element-type 'character)
495      (4 :initial-contents "wxyz" :element-type 'character)
496      "wxyz")
497    
498    (def-adjust-array-test adjust-array.string.adjustable.4
499      (5 :initial-contents "abcde" :adjustable t :element-type 'character)
500      (8 :initial-contents "87654321" :element-type 'character)
501      "87654321")
502    
503    (def-adjust-array-fp-test adjust-array.string.adjustable.5
504      (5 :initial-contents "abcde" :fill-pointer 3 :adjustable t :element-type 'character)
505      (4 :element-type 'character :initial-element #\Space)
506      (assert (eq (aref a2 3) #\d))
507      3 "abc")
508    
509    (def-adjust-array-fp-test adjust-array.string.adjustable.6
510      (5 :initial-contents "abcde" :fill-pointer 3 :adjustable t :element-type 'character)
511      (4 :fill-pointer nil :element-type 'character :initial-element #\?)
512      (assert (eq (aref a2 3) #\d))
513      3 "abc")
514    
515    (def-adjust-array-fp-test adjust-array.string.adjustable.7
516      (5 :initial-contents "abcde" :fill-pointer 3 :adjustable t :element-type 'character)
517      (4 :fill-pointer t :element-type 'character :initial-element #\!)
518      nil
519      4 "abcd")
520    
521    (def-adjust-array-fp-test adjust-array.string.adjustable.8
522      (5 :initial-contents "abcde" :fill-pointer 3 :adjustable t :element-type 'character)
523      (4 :fill-pointer 2 :element-type 'character :initial-element #\X)
524      (assert (equal (list (aref a2 2) (aref a2 3)) '(#\c #\d)))
525      2 "ab")
526    
527    (def-adjust-array-fp-test adjust-array.string.adjustable.9
528      (5 :initial-contents "abcde" :fill-pointer 3 :adjustable t :element-type 'character)
529      (8 :fill-pointer 5 :initial-element #\x :element-type 'character)
530      (assert (equal (list (aref a2 5) (aref a2 6) (aref a2 7)) '(#\x #\x #\x)))
531      5 "abcde")
532    
533    (deftest adjust-array.string.adjustable.10
534      (let* ((a1 (make-array 5 :initial-contents "abcde"
535                             :adjustable t :element-type 'character))
536             (a2 (adjust-array a1 4 :displaced-to nil :element-type 'character)))
537        (assert (eq a1 a2))
538        (assert (not (array-displacement a2)))
539        a2)
540      "abcd")
541    
542    (deftest adjust-array.string.adjustable.11
543      (let* ((a0 (make-array 7 :initial-contents "xabcdey" :element-type 'character))
544             (a1 (make-array 5 :displaced-to a0 :displaced-index-offset 1
545                             :adjustable t :element-type 'character))
546             (a2 (adjust-array a1 4 :element-type 'character)))
547        (assert (eq a1 a2))
548        (assert (not (array-displacement a2)))
549        a2)
550      "abcd")
551    
552    (deftest adjust-array.string.adjustable.12
553      (let* ((a0 (make-array 7 :initial-contents "xabcdey" :element-type 'character))
554             (a1 (make-array 5 :displaced-to a0 :displaced-index-offset 1
555                             :adjustable t :element-type 'character))
556             (a2 (adjust-array a1 4 :displaced-to a0 :element-type 'character)))
557        (assert (eq a1 a2))
558        a2)
559      "xabc")
560    
561    (deftest adjust-array.string.adjustable.13
562      (let* ((a0 (make-array 7 :initial-contents "xabcdey" :element-type 'character))
563             (a1 (make-array 5 :displaced-to a0 :displaced-index-offset 1
564                             :adjustable t :element-type 'character))
565             (a2 (make-array 4 :displaced-to a1 :displaced-index-offset 1
566                             :element-type 'character)))
567        (assert (eq a1 (adjust-array a1 5 :displaced-to a0
568                                     :displaced-index-offset 2
569                                     :element-type 'character)))
570        a2)
571      "cdey")
572    )
573      for forms2 = (subst element-type 'character forms)
574      for forms3 = (mapcar #'(lambda (form)
575                               (destructuring-bind (dt name . body) form
576                                 `(,dt ,(if (eql element-type 'character) name
577                                          (intern (replace (copy-seq (symbol-name name))
578                                                           "BASEST"
579                                                           :start1 13 :end1 19)
580                                                  (symbol-package name)))
581                                       ,@ body)))
582                           forms2)
583      do (eval `(progn ,@forms3)))
584    
585  ;; 2-d arrays  ;; 2-d arrays
586    
587  (def-adjust-array-test adjust-array.string.21  (def-adjust-array-test adjust-array.string.21
# Line 496  Line 600 
600                                      "78912000" "00000000" "00000000")                                      "78912000" "00000000" "00000000")
601                  :element-type 'character))                  :element-type 'character))
602    
 ;;; FIXME: Add adjustable string tests  
   
 ;;; FIXME: Add bit vector tests  
   
603  (def-adjust-array-test adjust-array.bit-vector.1  (def-adjust-array-test adjust-array.bit-vector.1
604    (5 :element-type 'bit :initial-contents #*01100)    (5 :element-type 'bit :initial-contents #*01100)
605    (4 :element-type 'bit)    (4 :element-type 'bit)
# Line 671  Line 771 
771                                      #*11111000 #*00000000 #*00000000)                                      #*11111000 #*00000000 #*00000000)
772                  :element-type 'bit))                  :element-type 'bit))
773    
774    ;;; Adjustable bit vector tests
775    
776    (def-adjust-array-test adjust-array.bit-vector.adjustable.1
777      (5 :initial-contents '(1 0 1 1 0) :adjustable t :element-type 'bit)
778      (4 :element-type 'bit)
779      #*1011)
780    
781    (def-adjust-array-test adjust-array.bit-vector.adjustable.2
782      (5 :initial-contents '(1 0 1 0 1) :adjustable t :element-type 'bit)
783      (8 :initial-element '1 :element-type 'bit)
784      #*10101111)
785    
786    (def-adjust-array-test adjust-array.bit-vector.adjustable.3
787      (5 :initial-contents '(0 1 0 1 0) :adjustable t :element-type 'bit)
788      (4 :initial-contents '(1 1 1 0) :element-type 'bit)
789      #*1110)
790    
791    (def-adjust-array-test adjust-array.bit-vector.adjustable.4
792      (5 :initial-contents '(1 0 0 1 0) :adjustable t :element-type 'bit)
793      (8 :initial-contents '(0 1 0 1 1 0 1 0) :element-type 'bit)
794      #*01011010)
795    
796    (def-adjust-array-fp-test adjust-array.bit-vectoradjustable.5
797      (5 :initial-contents '(1 1 1 0 0) :fill-pointer 3 :adjustable t :element-type 'bit)
798      (4 :element-type 'bit :initial-element 0)
799      (assert (eq (aref a2 3) 0))
800      3 #*111)
801    
802    (def-adjust-array-fp-test adjust-array.bit-vector.adjustable.6
803      (5 :initial-contents '(0 0 0 1 1) :fill-pointer 3 :adjustable t :element-type 'bit)
804      (4 :fill-pointer nil :element-type 'bit :initial-element 1)
805      (assert (eq (aref a2 3) 1))
806      3 #*000)
807    
808    (def-adjust-array-fp-test adjust-array.bit-vector.adjustable.7
809      (5 :initial-contents '(1 1 0 1 1) :fill-pointer 3 :adjustable t :element-type 'bit)
810      (4 :fill-pointer t :element-type 'bit :initial-element 1)
811      nil
812      4 #*1101)
813    
814    (def-adjust-array-fp-test adjust-array.bit-vector.adjustable.8
815      (5 :initial-contents '(0 1 1 1 0) :fill-pointer 3 :adjustable t :element-type 'bit)
816      (4 :fill-pointer 2 :element-type 'bit :initial-element 0)
817      (assert (equal (list (aref a2 2) (aref a2 3)) '(1 1)))
818      2 #*01)
819    
820    (def-adjust-array-fp-test adjust-array.bit-vector.adjustable.9
821      (5 :initial-contents '(1 0 0 0 1) :fill-pointer 3 :adjustable t :element-type 'bit)
822      (8 :fill-pointer 5 :initial-element 1 :element-type 'bit)
823      (assert (equal (list (aref a2 5) (aref a2 6) (aref a2 7)) '(1 1 1)))
824      5 #*10001)
825    
826    (deftest adjust-array.bit-vector.adjustable.10
827      (let* ((a1 (make-array 5 :initial-contents '(0 1 1 0 1)
828                             :adjustable t :element-type 'bit))
829             (a2 (adjust-array a1 4 :displaced-to nil :element-type 'bit)))
830        (assert (eq a1 a2))
831        (assert (not (array-displacement a2)))
832        a2)
833      #*0110)
834    
835    (deftest adjust-array.bit-vector.adjustable.11
836      (let* ((a0 (make-array 7 :initial-contents '(0 1 0 1 1 1 0)
837                             :element-type 'bit))
838             (a1 (make-array 5 :displaced-to a0 :displaced-index-offset 1
839                             :adjustable t :element-type 'bit))
840             (a2 (adjust-array a1 4 :element-type 'bit)))
841        (assert (eq a1 a2))
842        (assert (not (array-displacement a2)))
843        a2)
844      #*1011)
845    
846    (deftest adjust-array.bit-vector.adjustable.12
847      (let* ((a0 (make-array 7 :initial-contents '(0 0 1 1 1 1 1)
848                             :element-type 'bit))
849             (a1 (make-array 5 :displaced-to a0 :displaced-index-offset 1
850                             :adjustable t :element-type 'bit))
851             (a2 (adjust-array a1 4 :displaced-to a0 :element-type 'bit)))
852        (assert (eq a1 a2))
853        a2)
854      #*0011)
855    
856    (deftest adjust-array.bit-vector.adjustable.13
857      (let* ((a0 (make-array 7 :initial-contents '(1 0 0 0 0 0 1) :element-type 'bit))
858             (a1 (make-array 5 :displaced-to a0 :displaced-index-offset 1
859                             :adjustable t :element-type 'bit))
860             (a2 (make-array 4 :displaced-to a1 :displaced-index-offset 1
861                             :element-type 'bit)))
862        (assert (eq a1 (adjust-array a1 5 :displaced-to a0
863                                     :displaced-index-offset 2
864                                     :element-type 'bit)))
865        a2)
866      #*0001)
867    
868  ;;; FIXME. specialized integer array tests  ;;; FIXME. specialized integer array tests
869    
870  ;;; FIXNME float array tests  ;;; FIXNME float array tests

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26