From 2e326498a4ceca3eb6290dd969bc99d56777a526 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 8 Nov 2016 21:45:54 -0800
Subject: [PATCH] alien.parser: throw error if enum values don't fit c-type.
---
basis/alien/parser/parser-tests.factor | 7 +++++++
basis/alien/parser/parser.factor | 18 ++++++++++++++----
2 files changed, 21 insertions(+), 4 deletions(-)
diff --git a/basis/alien/parser/parser-tests.factor b/basis/alien/parser/parser-tests.factor
index fb1c76182f..b1dc1f6677 100644
--- a/basis/alien/parser/parser-tests.factor
+++ b/basis/alien/parser/parser-tests.factor
@@ -124,3 +124,10 @@ TYPEDEF: int alien-parser-test-int ! reasonably unique name...
{ } [
[ C-TYPE: hi TYPEDEF: void* hi ] with-compilation-unit
] unit-test
+
+[
+"IN: alien.parser.tests
+USING: alien.c-types alien.syntax ;
+ENUM: tv_peripherals_4 < uchar
+{ appletv 1 } { chromecast 2 } { roku 444 } ;" eval( -- )
+] [ error>> enum-values-outside-c-type-interval? ] must-fail-with
diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor
index b15c6e5a1f..aa599707f0 100755
--- a/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@@ -1,9 +1,12 @@
! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
+
USING: accessors alien alien.c-types alien.enums alien.libraries
-arrays classes classes.parser combinators combinators.short-circuit
-compiler.units effects fry kernel lexer locals math namespaces parser
-sequences splitting summary vocabs.parser words ;
+arrays classes classes.parser combinators
+combinators.short-circuit compiler.units effects fry kernel
+lexer locals math math.order namespaces parser sequences
+splitting summary vocabs.parser words ;
+
IN: alien.parser
SYMBOL: current-library
@@ -102,12 +105,19 @@ M: *-in-c-type-name summary
dup ";" = not
[ swap parse-enum-member scan-token parse-enum-members ] [ 2drop ] if ;
+ERROR: enum-values-outside-c-type-interval name base-type values ;
+
+: check-enum-members ( name base-type members -- name base-type members )
+ over c-type-interval '[ second _ _ between? ] dupd reject
+ [ nip enum-values-outside-c-type-interval ] unless-empty ;
+
PRIVATE>
: parse-enum ( -- name base-type members )
parse-enum-name
parse-enum-base-type
- [ V{ } clone 0 ] dip parse-enum-members ;
+ [ V{ } clone 0 ] dip parse-enum-members
+ check-enum-members ;
: scan-function-name ( -- return function )
scan-c-type scan-token parse-pointers ;