1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
(require :unittest "lib/llib/unittest.l")
;(setq sys::*gc-hook* #'(lambda (a b) (format t "GC! free:~A total:~A~%" a b)))
(init-unit-test)
(deftest test-copy-object-body
(let (vmrss vmrss-orig a b)
(setq vmrss-orig (elt (unix::getrusage 0) 2))
(dotimes (j 10)
(dotimes (i 1000)
(setq a (make-cube 100 100 100))
(setq b (copy-object a))
(unless (equal (send a :vertices) (send b :vertices))
(assert nil (format nil "(equal ~A ~A)~%" a b))))
(format *error-output* "copy-object ~A ~A" a b)
(print (sys::gc) *error-output*)
(setq vmrss (elt (unix::getrusage 0) 2))
(format *error-output* "~A gc:~A, vmrss:~A -> ~A~%" j (sys::gc) vmrss-orig vmrss)
(if (>= vmrss (* 2 vmrss-orig))
(warning-message 1 "~A copy-object body ~A -> ~A~%" (sys::thread-self) vmrss-orig vmrss))
)
(assert (< vmrss (* 10 vmrss-orig)) "copy-object body")))
#|
(deftest test-copy-object-thread
(let (vmrss vmrss-orig a b)
(need-thread 2)
(setq vmrss-orig (elt (unix::getrusage 0) 2))
(setq a (sys::thread #'test-copy-object-body))
(setq b (sys::thread #'test-copy-object-body))
(sys:wait-thread a)
(sys:wait-thread b)
(print (sys::gc) *error-output*)
(setq vmrss (elt (unix::getrusage 0) 2))
(format *error-output* "gc:~A, vmrss:~A -> ~A~%" (sys::gc) vmrss-orig vmrss)
(assert (< vmrss (* 10 vmrss-orig)) "copy-object body thread")
))
|#
;;;
(setq i-max 200000)
#+(or :s390x :riscv64)
(setq i-max 200)
(deftest test-copy-object-integer
(setq vmrss-orig (elt (unix::getrusage 0) 2))
(dotimes (j 5)
(dotimes (i i-max)
(setq a 10)
(setq b (copy-object a))
(unless (equal a b)
(assert nil (format nil "(equal ~A ~A)" a b))))
(print (sys::gc) *error-output*)
;;
(setq vmrss (elt (unix::getrusage 0) 2))
(format *error-output* "~A gc:~A, vmrss:~A -> ~A~%" j (sys::gc) vmrss-orig vmrss)
(assert (< vmrss (* 10 vmrss-orig)) "copy-object integer")))
(deftest test-copy-object-list
(setq vmrss-orig (elt (unix::getrusage 0) 2))
(dotimes (j 10)
(dotimes (i i-max)
(setq a (list 10 20 30 40 50 60 70 80 90 100))
(setq b (copy-object a))
(unless (equal a b)
(assert nil (format nil "(equal ~A ~A)" a b))))
(print (sys::gc) *error-output*)
;;
(setq vmrss (elt (unix::getrusage 0) 2))
(format *error-output* "~A gc:~A, vmrss:~A -> ~A~%" j (sys::gc) vmrss-orig vmrss)
(assert (< vmrss (* 20 vmrss-orig)) "copy-object list")))
(deftest test-copy-object-vector
(setq vmrss-orig (elt (unix::getrusage 0) 2))
(dotimes (j 5)
(dotimes (i i-max)
(setq a (float-vector 1 2 3 4 5 6 7 8 9 10))
(setq b (copy-object a))
(unless (equal a b)
(assert nil (format nil "(equal ~A ~A)" a b))))
(print (sys::gc) *error-output*)
;;
(setq vmrss (elt (unix::getrusage 0) 2))
(format *error-output* "~A gc:~A, vmrss:~A -> ~A~%" j (sys::gc) vmrss-orig vmrss)
(assert (< vmrss (* 10 vmrss-orig)) "copy-object vector")))
(deftest test-copy-object-matrix
(setq vmrss-orig (elt (unix::getrusage 0) 2))
(dotimes (j 5)
(dotimes (i i-max)
(setq a (unit-matrix 10))
;;(setq b (copy-object a))
(setq b (copy-matrix a))
(unless (equal a b)
(assert nil (format nil "(equal ~A ~A)" a b))))
(print (sys::gc) *error-output*)
;;
(setq vmrss (elt (unix::getrusage 0) 2))
(format *error-output* "~A gc:~A, vmrss:~A -> ~A~%" j (sys::gc) vmrss-orig vmrss)
(assert (< vmrss (* 10 vmrss-orig)) "copy-object matrix")))
(eval-when (load eval)
(run-all-tests)
(exit))
|
