[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 06/25: Add compute-cpl tests
From: |
Andy Wingo |
Subject: |
[Guile-commits] 06/25: Add compute-cpl tests |
Date: |
Mon, 19 Jan 2015 10:41:06 +0000 |
wingo pushed a commit to branch wip-goops-refactor
in repository guile.
commit 52bafa4111b13dc74560691f04371fe5041e0fcd
Author: Andy Wingo <address@hidden>
Date: Tue Jan 13 21:07:42 2015 +0100
Add compute-cpl tests
* test-suite/tests/goops.test: Add tests for compute-cpl based on
comments from goops.scm.
* module/oop/goops.scm (compute-std-cpl): Remove comment, and add
docstring.
(compute-cpl): Improve comment.
---
module/oop/goops.scm | 26 +++-----------------------
test-suite/tests/goops.test | 25 ++++++++++++++++++++++++-
2 files changed, 27 insertions(+), 24 deletions(-)
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 5507cf7..dd4a023 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -245,29 +245,8 @@
(define (is-a? obj class)
(and (memq class (class-precedence-list (class-of obj))) #t))
-
-;;; The standard class precedence list computation algorithm
-;;;
-;;; Correct behaviour:
-;;;
-;;; (define-class food ())
-;;; (define-class fruit (food))
-;;; (define-class spice (food))
-;;; (define-class apple (fruit))
-;;; (define-class cinnamon (spice))
-;;; (define-class pie (apple cinnamon))
-;;; => cpl (pie) = pie apple fruit cinnamon spice food object top
-;;;
-;;; (define-class d ())
-;;; (define-class e ())
-;;; (define-class f ())
-;;; (define-class b (d e))
-;;; (define-class c (e f))
-;;; (define-class a (b c))
-;;; => cpl (a) = a b d c e f object top
-;;;
-
(define (compute-std-cpl c get-direct-supers)
+ "The standard class precedence list computation algorithm."
(define (only-non-null lst)
(filter (lambda (l) (not (null? l))) lst))
@@ -299,7 +278,8 @@
c-direct-supers)
(list c-direct-supers))))))
-;; Bootstrap version.
+;; This version of compute-cpl is replaced with a generic function once
+;; GOOPS has booted.
(define (compute-cpl class)
(compute-std-cpl class class-direct-supers))
diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index d8a5ecf..7c8e21d 100644
--- a/test-suite/tests/goops.test
+++ b/test-suite/tests/goops.test
@@ -1,6 +1,6 @@
;;;; goops.test --- test suite for GOOPS -*- scheme -*-
;;;;
-;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011, 2012, 2014 Free
Software Foundation, Inc.
+;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011, 2012, 2014, 2015
Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -562,3 +562,26 @@
(pass-if-exception "out of range"
exception:out-of-range
(make <foreign-test> #:a (ash 1 64))))
+
+(define-class <food> ())
+(define-class <fruit> (<food>))
+(define-class <spice> (<food>))
+(define-class <apple> (<fruit>))
+(define-class <cinnamon> (<spice>))
+(define-class <pie> (<apple> <cinnamon>))
+
+(define-class <d> ())
+(define-class <e> ())
+(define-class <f> ())
+(define-class <b> (<d> <e>))
+(define-class <c> (<e> <f>))
+(define-class <a> (<b> <c>))
+
+(with-test-prefix "compute-cpl"
+ (pass-if-equal "<pie>"
+ (list <pie> <apple> <fruit> <cinnamon> <spice> <food> <object> <top>)
+ (compute-cpl <pie>))
+
+ (pass-if-equal "<a>"
+ (list <a> <b> <d> <c> <e> <f> <object> <top>)
+ (compute-cpl <a>)))
- [Guile-commits] branch wip-goops-refactor updated (b623b66 -> 2941be2), Andy Wingo, 2015/01/19
- [Guile-commits] 01/25: GOOPS cleanup to use SRFI-1 better, Andy Wingo, 2015/01/19
- [Guile-commits] 02/25: append-map rather than mapappend, Andy Wingo, 2015/01/19
- [Guile-commits] 03/25: GOOPS utils module cleanups, Andy Wingo, 2015/01/19
- [Guile-commits] 04/25: Fold (oop goops util) into (oop goops), Andy Wingo, 2015/01/19
- [Guile-commits] 05/25: Scheme GOOPS cleanups, Andy Wingo, 2015/01/19
- [Guile-commits] 07/25: scm_make cleanup, Andy Wingo, 2015/01/19
- [Guile-commits] 06/25: Add compute-cpl tests,
Andy Wingo <=
- [Guile-commits] 09/25: Commenting in goops.scm, Andy Wingo, 2015/01/19
- [Guile-commits] 08/25: Narrative reordering in goops.scm, Andy Wingo, 2015/01/19
- [Guile-commits] 11/25: when and unless for one-armed ifs in goops.scm, Andy Wingo, 2015/01/19
- [Guile-commits] 13/25: Convert emit-linear-dispatch to use match, Andy Wingo, 2015/01/19
- [Guile-commits] 14/25: `match' refactor in goops.scm, Andy Wingo, 2015/01/19
- [Guile-commits] 15/25: GOOPS class slot indices defined as inline values, Andy Wingo, 2015/01/19
- [Guile-commits] 10/25: More GOOPS comments, Andy Wingo, 2015/01/19
- [Guile-commits] 17/25: slot-ref, slot-set! et al bypass "using-class" variants, Andy Wingo, 2015/01/19
- [Guile-commits] 18/25: change-object-class refactor, Andy Wingo, 2015/01/19
- [Guile-commits] 19/25: GOOPS: Deprecate "using-class" procs like slot-ref-using-class, Andy Wingo, 2015/01/19