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
|
;; -*-theme-d-*-
;; Copyright (C) 2025 Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.
;; Expected results: translation and running OK
(define-proper-program (tests test936)
(import (standard-library core)
(standard-library console-io))
(define-class <person>
(fields
(str-name <string> public public)
(i-age <integer> public public)))
(define-class <employee>
(superclass <person>)
(attributes equal-by-value)
(fields
(str-employer <string> public public)))
(define-foreign-goops-class <a>
(target-name <a>)
(slots
(x <object> public public has-init-value pure-ref #:x)))
(define-foreign-goops-class <c>
(target-name <c>)
(attributes use-eq? equal-by-value)
(slots
(i <integer> public public has-init-value pure-ref #:i)
(str <string> public public has-init-value pure-ref #:str)))
(define-simple-method my-method1
(((x1 (:alt-maybe <person>)) (x2 (:alt-maybe <person>)))
<none> nonpure)
(console-display-line "my-method1")
(console-display-line (equal? x1 x2))
(console-display-line (equal-values? x1 x2))
(console-display-line (equal-contents? x1 x2))
(console-display-line (equal-objects? x1 x2)))
(define-simple-method my-method2
(((x1 (:maybe <employee>)) (x2 (:maybe <employee>)))
<none> nonpure)
(console-display-line "my-method2")
(console-display-line (equal? x1 x2))
(console-display-line (equal-values? x1 x2))
(console-display-line (equal-contents? x1 x2))
(console-display-line (equal-objects? x1 x2)))
(define-simple-method my-method3
(((x1 (:alt-maybe <a>)) (x2 (:alt-maybe <a>)))
<none> nonpure)
(console-display-line "my-method3")
(console-display-line (equal? x1 x2))
(console-display-line (equal-values? x1 x2))
(console-display-line (equal-contents? x1 x2))
(console-display-line (equal-objects? x1 x2)))
(define-simple-method my-method4
(((x1 (:maybe <c>)) (x2 (:maybe <c>)))
<none> nonpure)
(console-display-line "my-method4")
(console-display-line (equal? x1 x2))
(console-display-line (equal-values? x1 x2))
(console-display-line (equal-contents? x1 x2))
(console-display-line (equal-objects? x1 x2)))
(define-main-proc (() <none> nonpure)
(let ((person1 (create <person> "Tommi" 49))
(person2 (create <person> "Tommi" 49))
(employee1 (create <employee> "Tommi" 49 "TUNI"))
(employee2 (create <employee> "Tommi" 49 "TUNI"))
(a1 (make <a> #:x #t))
(a2 (make <a> #:x #t))
(c1 (make <c> #:i 10 #:str "Hello"))
(c2 (make <c> #:i 10 #:str "Hello")))
(my-method1 person1 person2)
(my-method1 person1 person1)
(my-method2 employee1 employee2)
(my-method2 employee1 employee1)
(my-method3 a1 a2)
(my-method3 a1 a1)
(my-method4 c1 c2)
(my-method4 c1 c1))))
|
