From 9dcca84c27a0eceed246101a6191efaf75313f52 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sat, 15 Aug 2015 19:39:39 -0700
Subject: [PATCH] classes.tuple: a better error if creating a tuple from too
 many values.

---
 core/classes/tuple/tuple-tests.factor |  3 +++
 core/classes/tuple/tuple.factor       | 15 +++++++++++----
 2 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 6d5b8750a9..ea1deadf94 100644
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -860,3 +860,6 @@ C: <no-slot-tuple0> no-slot-tuple0
         [ name>> "d" = ]
     } 1&&
 ] must-fail-with
+
+[ "IN: classes.tuple.tests TUPLE: too-many-slots-test a b c d ; T{ too-many-slots-test f 1 2 3 4 5 }" eval( -- x ) ]
+[ error>> too-many-slots? ] must-fail-with
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 37e93e0056..7ad2d456e4 100644
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -15,6 +15,8 @@ PRIVATE>
 PREDICATE: tuple-class < class
     "metaclass" word-prop tuple-class eq? ;
 
+ERROR: too-many-slots class slots got max ;
+
 ERROR: not-a-tuple object ;
 
 : all-slots ( class -- slots )
@@ -75,11 +77,16 @@ M: tuple class-of layout-of 2 slot { word } declare ; inline
         ] 2each
     ] if-bootstrapping ; inline
 
-: initial-values ( class -- slots )
-    all-slots [ initial>> ] map ;
+: initial-values ( class -- seq )
+    all-slots [ initial>> ] map ; inline
 
-: pad-slots ( slots class -- slots' class )
-    [ initial-values over length tail append ] keep ; inline
+: pad-slots ( seq class -- seq' class )
+    [ initial-values ] keep
+    2over [ length ] bi@ 2dup > [
+        [ nip swap ] 2dip too-many-slots
+    ] [
+        drop [ tail append ] curry dip
+    ] if ; inline
 
 PRIVATE>