From 50d68c1b10cc42d7def89fae601a30e050da8028 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 14 Jan 2010 18:15:47 +1300
Subject: [PATCH] Fix input-classes of /i and mod, and add some regression
tests with various reductions of the original test-case from the terrain demo
---
basis/compiler/tests/optimizer.factor | 18 +++++++++++++---
.../known-words/known-words.factor | 7 +++----
.../tree/propagation/propagation-tests.factor | 2 ++
extra/alien/data/map/map-tests.factor | 10 ++++++++-
extra/grid-meshes/grid-meshes-tests.factor | 21 +++++++++++++++++++
5 files changed, 50 insertions(+), 8 deletions(-)
create mode 100644 extra/grid-meshes/grid-meshes-tests.factor
diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
index 0831d6e8dd..04064e4427 100644
--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@@ -4,7 +4,7 @@ sbufs strings tools.test vectors words sequences.private
quotations classes classes.algebra classes.tuple.private
continuations growable namespaces hints alien.accessors
compiler.tree.builder compiler.tree.optimizer sequences.deep
-compiler definitions generic.single shuffle ;
+compiler definitions generic.single shuffle math.order ;
IN: compiler.tests.optimizer
GENERIC: xyz ( obj -- obj )
@@ -445,5 +445,17 @@ M: object bad-dispatch-position-test* ;
[ 1024 bignum ] [ 10 [ 1 >bignum swap >fixnum shift ] compile-call dup class ] unit-test
-! Not sure if I want to fix this...
-! [ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with
+TUPLE: grid-mesh-tuple { length read-only } { step read-only } ;
+
+: grid-mesh-test-case ( -- vertices )
+ 1.0 1.0 { 2 } first /f [ /i 1 + ] keep grid-mesh-tuple boa
+ 1 f <array>
+ [
+ [ drop length>> >fixnum 2 min ] 2keep
+ [
+ [ step>> 1 * ] dip
+ 0 swap set-nth-unsafe
+ ] 2curry times
+ ] keep ;
+
+[ { 0.5 } ] [ grid-mesh-test-case ] unit-test
diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index 0fde7ffa86..6aacbc57da 100644
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel effects accessors math math.private
math.integers.private math.floats.private math.partial-dispatch
@@ -23,11 +23,10 @@ IN: compiler.tree.propagation.known-words
{ + - * / }
[ { number number } "input-classes" set-word-prop ] each
-{ /f < > <= >= u< u> u<= u>= }
+{ /f /i mod < > <= >= u< u> u<= u>= }
[ { real real } "input-classes" set-word-prop ] each
-{ /i mod /mod }
-[ { rational rational } "input-classes" set-word-prop ] each
+\ /mod { rational rational } "input-classes" set-word-prop
{ bitand bitor bitxor bitnot shift }
[ { integer integer } "input-classes" set-word-prop ] each
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index f8a53b3287..9be76ba0d0 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -90,6 +90,8 @@ IN: compiler.tree.propagation.tests
[ float ] [ [ { float float } declare mod ] final-math-class ] unit-test
+[ V{ integer float } ] [ [ { float float } declare [ /i ] keep ] final-classes ] unit-test
+
[ V{ fixnum } ] [ [ 255 bitand ] final-classes ] unit-test
[ V{ fixnum } ] [
diff --git a/extra/alien/data/map/map-tests.factor b/extra/alien/data/map/map-tests.factor
index b97a356e6e..305ae6bdf2 100644
--- a/extra/alien/data/map/map-tests.factor
+++ b/extra/alien/data/map/map-tests.factor
@@ -1,6 +1,6 @@
! (c)Joe Groff bsd license
USING: alien.data.map fry generalizations kernel locals math.vectors
-math.vectors.conversion math math.vectors.simd sequences
+math.vectors.conversion math math.vectors.simd math.ranges sequences
specialized-arrays tools.test ;
FROM: alien.c-types => uchar short int float ;
SPECIALIZED-ARRAYS: int float float-4 uchar-16 ;
@@ -145,3 +145,11 @@ CONSTANT: plane-count 4
B{ 15 25 35 45 55 65 75 85 95 105 115 125 135 145 155 165 }
fold-rgba-planes
] unit-test
+
+: data-map-compiler-bug-test ( n -- byte-array )
+ [ 0.0 1.0 1.0 ] dip /f <range>
+ [ ] data-map( object -- float ) ;
+
+[ float-array{ 0.0 0.5 1.0 } ]
+[ 2 data-map-compiler-bug-test byte-array>float-array ]
+unit-test
diff --git a/extra/grid-meshes/grid-meshes-tests.factor b/extra/grid-meshes/grid-meshes-tests.factor
new file mode 100644
index 0000000000..ef71a669ed
--- /dev/null
+++ b/extra/grid-meshes/grid-meshes-tests.factor
@@ -0,0 +1,21 @@
+IN: grid-meshes.tests
+USING: alien.c-types grid-meshes grid-meshes.private
+specialized-arrays tools.test ;
+SPECIALIZED-ARRAY: float
+
+[
+ float-array{
+ 0.0 0.0 0.0 1.0
+ 0.0 0.0 0.5 1.0
+ 0.5 0.0 0.0 1.0
+ 0.5 0.0 0.5 1.0
+ 1.0 0.0 0.0 1.0
+ 1.0 0.0 0.5 1.0
+ 0.0 0.0 0.5 1.0
+ 0.0 0.0 1.0 1.0
+ 0.5 0.0 0.5 1.0
+ 0.5 0.0 1.0 1.0
+ 1.0 0.0 0.5 1.0
+ 1.0 0.0 1.0 1.0
+ }
+] [ { 2 2 } vertex-array byte-array>float-array ] unit-test