From 654e4d48f5f60e4aa83f0343e8e5e92b78490806 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 23 Apr 2010 20:12:54 -0500
Subject: [PATCH] More error checking in constructors for when slot name is
 repeated or a slot is not present in a tuple

---
 extra/constructors/constructors-tests.factor | 12 ++++++++++--
 extra/constructors/constructors.factor       | 18 ++++++++++++++----
 2 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/extra/constructors/constructors-tests.factor b/extra/constructors/constructors-tests.factor
index 1e098645bf..fef3150f6e 100644
--- a/extra/constructors/constructors-tests.factor
+++ b/extra/constructors/constructors-tests.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test constructors calendar kernel accessors
-combinators.short-circuit initializers math ;
+USING: accessors calendar combinators.short-circuit
+constructors eval initializers kernel math tools.test ;
 IN: constructors.tests
 
 TUPLE: stock-spread stock spread timestamp ;
@@ -41,3 +41,11 @@ CONSTRUCTOR: ct4 ( a b c d -- obj )
 [ 2 ] [ 0 0 <ct2> a>> ] unit-test
 [ 3 ] [ 0 0 0 <ct3> a>> ] unit-test
 [ 4 ] [ 0 0 0 0 <ct4> a>> ] unit-test
+
+[
+    """IN: constructors.tests
+TUPLE: foo a b ;
+CONSTRUCTOR: foo ( a c -- obj ) ;""" eval( -- )
+] [
+    error>> unknown-constructor-parameters?
+] must-fail-with
diff --git a/extra/constructors/constructors.factor b/extra/constructors/constructors.factor
index 747c8f53fc..51df4e8de6 100644
--- a/extra/constructors/constructors.factor
+++ b/extra/constructors/constructors.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs classes classes.tuple effects.parser
-fry generalizations generic.standard kernel lexer locals macros
-parser sequences slots vocabs words arrays ;
+USING: accessors arrays assocs classes classes.tuple
+effects.parser fry generalizations generic.standard kernel
+lexer locals macros parser sequences sets slots vocabs words ;
 IN: constructors
 
 ! An experiment
@@ -38,6 +38,15 @@ MACRO:: slots>constructor ( class slots -- quot )
         default-params swap assoc-union values _ firstn class boa
     ] ;
 
+ERROR: repeated-constructor-parameters class effect ;
+
+ERROR: unknown-constructor-parameters class effect unknown ;
+
+: ensure-constructor-parameters ( class effect -- class effect )
+    dup in>> all-unique? [ repeated-constructor-parameters ] unless
+    2dup [ all-slots [ name>> ] map ] [ in>> ] bi* swap diff
+    [ unknown-constructor-parameters ] unless-empty ;
+
 :: (define-constructor) ( constructor-word class effect def -- word quot )
     constructor-word
     class def define-initializer
@@ -53,7 +62,8 @@ MACRO:: slots>constructor ( class slots -- quot )
     scan-word [ name>> "<" ">" surround create-in dup reset-generic ] keep ;
 
 : parse-constructor ( -- class word effect def )
-    scan-constructor complete-effect parse-definition ;
+    scan-constructor complete-effect ensure-constructor-parameters
+    parse-definition ;
 
 SYNTAX: CONSTRUCTOR: parse-constructor f define-constructor ;