diff options
Diffstat (limited to 'openscad/UnitTest.hs')
-rw-r--r-- | openscad/UnitTest.hs | 311 |
1 files changed, 311 insertions, 0 deletions
diff --git a/openscad/UnitTest.hs b/openscad/UnitTest.hs new file mode 100644 index 0000000..97bdfd1 --- /dev/null +++ b/openscad/UnitTest.hs | |||
@@ -0,0 +1,311 @@ | |||
1 | #!/usr/bin/env runghc | ||
2 | |||
3 | module Main where | ||
4 | |||
5 | import Control.DeepSeq | ||
6 | import Control.Exception | ||
7 | import Test.Tasty | ||
8 | import Test.Tasty.HUnit | ||
9 | import Test.HUnit.Tools | ||
10 | import Graphics.OpenSCAD | ||
11 | import Data.Colour (withOpacity) | ||
12 | import Data.List.NonEmpty (fromList) | ||
13 | import Data.Semigroup (Semigroup((<>), sconcat), Monoid(mconcat, mempty, mappend)) | ||
14 | |||
15 | |||
16 | |||
17 | assertError err code = | ||
18 | assertRaises "Check error" (ErrorCall err) . evaluate $ deepseq (show code) () | ||
19 | |||
20 | sw = concat . words | ||
21 | st n e a = testCase n $ (sw $ render a) @?= (sw e) | ||
22 | |||
23 | |||
24 | {- About the test result values. | ||
25 | |||
26 | Running "cabal test" does not verify that the results do the intended | ||
27 | thing in OpenSCAD. Possibly we'll add shell tests for that at some | ||
28 | point, but not yet. | ||
29 | |||
30 | For now, if you change or add strings, please manually copy them into | ||
31 | OpenSCAD and make sure they do what you want the Model data structure | ||
32 | that they are testing does. | ||
33 | -} | ||
34 | |||
35 | tests = testGroup "Tests" [ | ||
36 | testGroup "3d-primitives" [ | ||
37 | testGroup "Spheres" [ | ||
38 | st "1" "sphere(1.0);" $ sphere 1 def, | ||
39 | st "2" "sphere(2.0,$fn=100);" (sphere 2 $ fn 100), | ||
40 | st "3" "sphere(2.0,$fa=5.0);" (sphere 2 $ fa 5), | ||
41 | st "4" "sphere(2.0,$fs=0.1);" (sphere 2 $ fs 0.1) | ||
42 | ], | ||
43 | |||
44 | testGroup "Boxes" [ | ||
45 | st "box" "cube([1.0,2.0,3.0]);" $ box 1 2 3, | ||
46 | st "cube" "cube([2.0,2.0,2.0]);" $ cube 2 | ||
47 | ], | ||
48 | |||
49 | testGroup "Cylinders" [ | ||
50 | st "1" "cylinder(r=1.0,h=2.0);" $ cylinder 1 2 def, | ||
51 | st "2" "cylinder(r=1.0,h=2.0,$fs=0.6);" (cylinder 1 2 $ fs 0.6), | ||
52 | st "3" "cylinder(r=1.0,h=2.0,$fn=10);" (cylinder 1 2 $ fn 10), | ||
53 | st "4" "cylinder(r=1.0,h=2.0,$fa=30.0);" (cylinder 1 2 $ fa 30) | ||
54 | ], | ||
55 | |||
56 | testGroup "Oblique-Cylinders" [ | ||
57 | st "1" "cylinder(r1=1.0,h=2.0,r2=2.0);" $ obCylinder 1 2 2 def, | ||
58 | st "2" "cylinder(r1=1.0,h=2.0,r2=2.0,$fs=0.6);" | ||
59 | (obCylinder 1 2 2 $ fs 0.6), | ||
60 | st "3" "cylinder(r1=1.0,h=2.0,r2=2.0,$fn=10);" | ||
61 | (obCylinder 1 2 2 $ fn 10), | ||
62 | st "4" "cylinder(r1=1.0,h=2.0,r2=2.0,$fa=30.0);" | ||
63 | (obCylinder 1 2 2 $ fa 30) | ||
64 | ], | ||
65 | |||
66 | testGroup "Misc" [ | ||
67 | st "import" "import(\"test.stl\");" (solid $ importFile "test.stl"), | ||
68 | st "polyhedron 1" | ||
69 | "polyhedron(points=[[10.0,10.0,0.0],[10.0,-10.0,0.0],[0.0,0.0,10.0],[-10.0,-10.0,0.0],[-10.0,10.0,0.0]],triangles=[[0,1,2],[1,3,2],[3,4,2],[4,0,2],[1,0,4],[3,1,4]],convexity=1);" $ | ||
70 | polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)], | ||
71 | [(10, -10, 0), (-10, -10, 0), (0, 0, 10)], | ||
72 | [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)], | ||
73 | [(-10, 10, 0), (10, 10, 0), (0, 0, 10)], | ||
74 | [(10, -10, 0), (10, 10, 0), (-10, 10, 0)], | ||
75 | [(-10, -10, 0), (10, -10, 0), (-10, 10, 0)]], | ||
76 | st "polyhedron 2" | ||
77 | "polyhedron(points=[[10.0,10.0,0.0],[10.0,-10.0,0.0],[0.0,0.0,10.0],[-10.0,-10.0,0.0],[-10.0,10.0,0.0]],faces=[[0,1,2],[1,3,2],[3,4,2],[4,0,2],[4,3,1,0]],convexity=1);" $ | ||
78 | polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)], | ||
79 | [(10, -10, 0), (-10, -10, 0), (0, 0, 10)], | ||
80 | [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)], | ||
81 | [(-10, 10, 0), (10, 10, 0), (0, 0, 10)], | ||
82 | [(-10, 10, 0), (-10, -10, 0), (10, -10, 0), (10, 10, 0)]], | ||
83 | st "unsafePolyhedron" | ||
84 | "polyhedron(points=[[10.0,10.0,0.0],[10.0,-10.0,0.0],[-10.0,-10.0,0.0],[-10.0,10.0,0.0],[0.0,0.0,10.0]],faces=[[0,1,4],[1,2,4],[2,3,4],[3,0,4],[1,0,3],[2,1,3]],convexity=1);" | ||
85 | (unsafePolyhedron 1 [(10.0,10.0,0.0),(10.0,-10.0,0.0),(-10.0,-10.0,0.0), | ||
86 | (-10.0,10.0,0.0),(0.0,0.0,10)] | ||
87 | $ Faces [[0,1,4],[1,2,4],[2,3,4],[3,0,4],[1,0,3], | ||
88 | [2,1,3]]) | ||
89 | ], | ||
90 | testGroup "Linear-Extrusion" [ | ||
91 | st "1" | ||
92 | "linear_extrude(height=10.0,twist=0.0,scale=[1.0,1.0],slices=10,convexity=10)circle(1.0);" | ||
93 | (linearExtrude 10 0 (1, 1) 10 10 def $ circle 1 def), | ||
94 | st "2" | ||
95 | "linear_extrude(height=10.0,twist=100.0,scale=[1.0,1.0],slices=10,convexity=10)translate([2.0,0.0])circle(1.0);" | ||
96 | (linearExtrude 10 100 (1, 1) 10 10 def $ translate (2, 0) | ||
97 | $ circle 1 def), | ||
98 | st "3" | ||
99 | "linear_extrude(height=10.0,twist=500.0,scale=[1.0,1.0],slices=10,convexity=10)translate([2.0,0.0])circle(1.0);" | ||
100 | (linearExtrude 10 500 (1, 1) 10 10 def $ translate (2, 0) | ||
101 | $ circle 1 def), | ||
102 | st "4" | ||
103 | "linear_extrude(height=10.0,twist=360.0,scale=[1.0,1.0],slices=100,convexity=10)translate([2.0,0.0])circle(1.0);" | ||
104 | (linearExtrude 10 360 (1, 1) 100 10 def $ translate (2, 0) | ||
105 | $ circle 1 def), | ||
106 | st "5" | ||
107 | "linear_extrude(height=10.0,twist=360.0,scale=[1.0,1.0],slices=100,convexity=10,$fn=100)translate([2.0,0.0])circle(1.0);" | ||
108 | (linearExtrude 10 360 (1, 1) 100 10 (fn 100) $ translate (2, 0) | ||
109 | $ circle 1 def), | ||
110 | st "6" | ||
111 | "linear_extrude(height=10.0,twist=0.0,scale=[3.0,3.0],slices=100,convexity=10)translate([2.0,0.0])circle(1.0);" | ||
112 | (linearExtrude 10 0 (3, 3) 100 10 def $ translate (2, 0) $ circle 1 def), | ||
113 | st "7" | ||
114 | "linear_extrude(height=10.0,twist=0.0,scale=[1.0,5.0],slices=100,convexity=10,$fn=100)translate([2.0,0.0])circle(1.0);" | ||
115 | (linearExtrude 10 0 (1, 5) 100 10 (fn 100) $ translate (2, 0) | ||
116 | $ circle 1 def) | ||
117 | ], | ||
118 | |||
119 | testGroup "Rotated-Extrusion" [ | ||
120 | st "1" "rotate_extrude(convexity=10)translate([2.0,0.0])circle(1.0);" | ||
121 | (rotateExtrude 10 def $ translate (2, 0) $ circle 1 def), | ||
122 | st "2" | ||
123 | "rotate_extrude(convexity=10,$fn=100)translate([2.0,0.0])circle(1.0,$fn=100);" | ||
124 | (rotateExtrude 10 (fn 100) $ translate (2, 0) $ circle 1 $ fn 100) | ||
125 | ], | ||
126 | |||
127 | testGroup "Surface" [ | ||
128 | st "Normal" "surface(file=\"test.dat\",convexity=5);" $ | ||
129 | surface "test.dat" False 5, | ||
130 | st "Inverted" "surface(file=\"test.dat\",invert=true,convexity=5);" $ | ||
131 | surface "test.dat" True 5 -- Requires 2014.QX | ||
132 | ] | ||
133 | ], | ||
134 | |||
135 | testGroup "2d-primitives" [ | ||
136 | testGroup "Squares" [ | ||
137 | st "rectangle" "square([2.0,3.0]);" $ rectangle 2 3, | ||
138 | st "square" "square([2.0,2.0]);" $ square 2 | ||
139 | ], | ||
140 | testGroup "Circles" [ | ||
141 | st "1" "circle(1.0);" $ circle 1 def, | ||
142 | st "2" "circle(2.0,$fn=100);" (circle 2 $ fn 100), | ||
143 | st "3" "circle(2.0,$fa=5.0);" (circle 2 $ fa 5), | ||
144 | st "4" "circle(2.0,$fs=0.1);" (circle 2 $ fs 0.1) | ||
145 | ], | ||
146 | testGroup "Misc" [ | ||
147 | st "import" "import(\"test.dxf\");" (solid $ importFile "test.dxf"), | ||
148 | st "polygon" | ||
149 | "polygon(points=[[0.0,0.0],[100.0,0.0],[0.0,100.0],[10.0,10.0],[80.0,10.0],[10.0,80.0]],paths=[[0,1,2],[3,4,5]],convexity=10);" $ | ||
150 | polygon 10 [[(0,0),(100,0),(0,100)],[(10,10),(80,10),(10,80)]], | ||
151 | st "unsafePolygon" | ||
152 | "polygon(points=[[0.0,0.0],[100.0,0.0],[0.0,100.0],[10.0,10.0],[80.0,10.0],[10.0,80.0]], paths=[[0,1,2],[3,4,5]],convexity=1);" | ||
153 | (unsafePolygon 1 [(0,0),(100,0),(0,100),(10,10),(80,10),(10,80)] | ||
154 | [[0,1,2],[3,4,5]]), | ||
155 | st "projection" | ||
156 | "projection(cut=false)scale([10.0,10.0,10.0])difference(){translate([0.0,0.0,1.0])cube([1.0,1.0,1.0]);translate([0.25,0.25,0.0])cube([0.5,0.5,3.0]);}" | ||
157 | (projection False . scale (10, 10, 10) . difference (up 1 (cube 1)) | ||
158 | $ translate (0.25, 0.25, 0) (box 0.5 0.5 3)) | ||
159 | ] | ||
160 | ], | ||
161 | |||
162 | testGroup "Transformations" [ | ||
163 | testGroup "Size changes" [ | ||
164 | st "scale 1" "scale([0.5,1.0,2.0])cube([1.0,1.0,1.0]);" | ||
165 | (scale (0.5, 1, 2) $ cube 1), | ||
166 | st "scale 2" "scale([0.5,2.0])square([1.0,1.0]);" | ||
167 | (scale (0.5, 2) $ rectangle 1 1), | ||
168 | st "resize 1" "resize([10.0,20.0])square([2.0,2.0]);" | ||
169 | (resize (10, 20) $ square 2), | ||
170 | st "resize 2" "resize([10.0,20.0,30.0])cube([2.0,2.0,2.0]);" | ||
171 | (resize (10, 20, 30) $ cube 2) | ||
172 | ], | ||
173 | |||
174 | testGroup "Rotations" [ | ||
175 | st "1" "rotate([180.0,0.0,0.0])cube([2.0,2.0,2.0]);" | ||
176 | (rotate (180, 0, 0) $ cube 2), | ||
177 | st "2" "rotate([0.0,180.0,0.0])cube([2.0,2.0,2.0]);" | ||
178 | (rotate (0, 180, 0) $ cube 2), | ||
179 | st "3" "rotate([0.0,180.0,180.0])cube([2.0,2.0,2.0]);" | ||
180 | (rotate (0, 180, 180) $ cube 2), | ||
181 | st "4" "rotate([180.0,0.0])square([2.0,1.0]);" | ||
182 | (rotate (180, 0) $ rectangle 2 1), | ||
183 | st "5" "rotate([0.0,180.0])square([2.0,1.0]);" | ||
184 | (rotate (0, 180) $ rectangle 2 1) | ||
185 | ], | ||
186 | testGroup "Mirrors" [ | ||
187 | st "1" "mirror([1.0,0.0,0.0])cube([2.0,2.0,2.0]);" | ||
188 | (mirror (1, 0, 0) $ cube 2), | ||
189 | st "2" "mirror([0.0,1.0,0.0])cube([2.0,2.0,2.0]);" | ||
190 | (mirror (0, 1, 0) $ cube 2), | ||
191 | st "3" "rotate([0.0,1.0,1.0])cube([2.0,2.0,2.0]);" | ||
192 | (rotate (0, 1, 1) $ cube 2), | ||
193 | st "4" "mirror([1.0,0.0])square([2.0,1.0]);" | ||
194 | (mirror (1, 0) $ rectangle 2 1), | ||
195 | st "2" "mirror([0.0,1.0])square([2.0,1.0]);" | ||
196 | (mirror (0, 1) $ rectangle 2 1) | ||
197 | ], | ||
198 | |||
199 | st "multmatrix" | ||
200 | "multmatrix([[1.0,0.0,0.0,10.0],[0.0,1.0,0.0,20.0],[0.0,0.0,1.0,30.0],[0.0,0.0,0.0,1.0]])cylinder(r=2.0,h=3.0);" | ||
201 | (multMatrix ( (1, 0, 0, 10), | ||
202 | (0, 1, 0, 20), | ||
203 | (0, 0, 1, 30), | ||
204 | (0, 0, 0, 1) ) $ cylinder 2 3 def), | ||
205 | |||
206 | testGroup "Colors" [ | ||
207 | st "color 1" "color([1.0,0.0,0.0])cube([1.0,1.0,1.0]);" (color red $ cube 1), | ||
208 | st "color 2" "color([1.0,0.0,0.0])square([1.0,1.0]);" | ||
209 | (color red $ square 1), | ||
210 | st "transparent 1" "color([1.0,0.0,0.0,0.7])cube([1.0,1.0,1.0]);" | ||
211 | (transparent (red `withOpacity` 0.7) $ cube 1), | ||
212 | st "transparent 2" "color([1.0,0.0,0.0,0.7])square([1.0,1.0]);" | ||
213 | (transparent (red `withOpacity` 0.7) $ square 1) | ||
214 | ] | ||
215 | ], | ||
216 | |||
217 | testGroup "Facets" [ | ||
218 | st "facet 1" "assign($fn=100){sphere(2.0,$fn=100);}" | ||
219 | (var (fn 100) [sphere 2 $ fn 100]), | ||
220 | st "facet 2" "assign($fa=5.0){sphere(2.0,$fa=5.0);}" | ||
221 | (var (fa 5) [sphere 2 $ fa 5]), | ||
222 | st "facet 3" "assign($fs=0.1){sphere(2.0,$fs=0.1);}" | ||
223 | (var (fs 0.1) [sphere 2 $ fs 0.1]) | ||
224 | ], | ||
225 | |||
226 | testGroup "Errors" [ | ||
227 | testCase "Polygon Pointcount" | ||
228 | . assertError "Polygon has fewer than 3 points." $ | ||
229 | polygon 1 [[(0, 0), (0, 1)]], | ||
230 | testCase "Polygon Linearity" | ||
231 | . assertError "Points in polygon are collinear." $ | ||
232 | polygon 1 [[(0, 0), (0, 1), (0, 2)]], | ||
233 | testCase "Polyhedron Linearity" | ||
234 | . assertError "Some face has collinear points." $ | ||
235 | polyhedron 1 [[(0, 0, 0), (1, 0, 0), (2, 0, 0)]], | ||
236 | testCase "Polyhedron Planarity" . assertError "Some face isn't coplanar." $ | ||
237 | polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 10, 10)], | ||
238 | [(10, -10, 0), (-10, -10, 0), (0, 0, 10)], | ||
239 | [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)], | ||
240 | [(-10, 10, 0), (10, 10, 0), (0, 0, 10)], | ||
241 | [(-10, 10, 0), (-10, -10, 0), (10, -10, 0), (0, 0, -10)]], | ||
242 | testCase "Polyhedron Edges" . assertError "Some edges are not in two faces." $ | ||
243 | polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)], | ||
244 | [(10, -10, 0), (-10, -10, 0), (0, 0, 10)], | ||
245 | [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)], | ||
246 | [(-10, 10, 0), (10, 10, 0), (0, 0, 10)], | ||
247 | [(10, -10, 0), (10, 10, 0), (-10, 10, 0)], | ||
248 | [(-10, -10, 0), (10, -10, 0), (-10, 20, 0)]], | ||
249 | testCase "Polyhedron Faces" | ||
250 | . assertError "Some faces have different orientation." $ | ||
251 | polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)], | ||
252 | [(10, -10, 0), (-10, -10, 0), (0, 0, 10)], | ||
253 | [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)], | ||
254 | [(-10, 10, 0), (10, 10, 0), (0, 0, 10)], | ||
255 | [(10, -10, 0), (10, 10, 0), (-10, 10, 0)], | ||
256 | [(10, -10, 0), (-10, -10, 0), (-10, 10, 0)]], | ||
257 | testCase "Polyhedron Orientation" | ||
258 | . assertError "Face orientations are counterclockwise." $ | ||
259 | polyhedron 1 [[(10, -10, 0), (10, 10, 0), (0, 0, 10)], | ||
260 | [(-10, -10, 0), (10, -10, 0), (0, 0, 10)], | ||
261 | [(-10, 10, 0), (-10, -10, 0), (0, 0, 10)], | ||
262 | [(10, 10, 0), (-10, 10, 0), (0, 0, 10)], | ||
263 | [(10, 10, 0), (10, -10, 0), (-10, 10, 0)], | ||
264 | [(10, -10, 0), (-10, -10, 0), (-10, 10, 0)]] | ||
265 | ], | ||
266 | |||
267 | testGroup "Combinations" [ | ||
268 | st "union" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}" | ||
269 | (union [cube 1, sphere 1.1 $ fs 0.1]), | ||
270 | st "difference" "difference(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}" | ||
271 | (difference (cube 1) . sphere 1.1 $ fs 0.1), | ||
272 | st "intersection" "intersection(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}" | ||
273 | (intersection [cube 1, sphere 1.1 $ fs 0.1]), | ||
274 | st "minkowski" | ||
275 | "minkowski(){cube([10.0,10.0,10.0]);cylinder(r=2.0,h=1.1,$fn=50);}" | ||
276 | (minkowski [cube 10, cylinder 2 1.1 $ fn 50]), | ||
277 | st "hull" "hull(){translate([15.0,10.0])circle(10.0);circle(10.0);}" | ||
278 | (hull [circle 10 def # translate (15, 10), circle 10 def]) | ||
279 | ], | ||
280 | |||
281 | testGroup "Haskell" [ | ||
282 | st "# 3d" "translate([-3.0,-3.0,-3.0])color([1.0,0.0,0.0])cube([3.0,3.0,3.0]);" | ||
283 | (cube 3 # color red # translate (-3, -3, -3)), | ||
284 | st "# 2d" | ||
285 | "translate([3.0,3.0])color([1.0,0.6470588235294119,0.0])square([2.0,2.0]);" | ||
286 | (square 2 # color orange # translate (3, 3)), | ||
287 | st "Monoid 1 3d" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}" | ||
288 | (cube 1 <> sphere 1.1 (fs 0.1)), | ||
289 | st "Monoid 1 2d" "union(){square([1.0,1.0]);circle(1.1,$fs=0.1);}" | ||
290 | (square 1 <> circle 1.1 (fs 0.1)), | ||
291 | st "Monoid 2 3d" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}" | ||
292 | (mconcat [cube 1, sphere 1.1 $ fs 0.1]), | ||
293 | st "Monoid 2 2d" "union(){square([1.0,1.0]);circle(1.1,$fs=0.1);}" | ||
294 | (mconcat [square 1, circle 1.1 $ fs 0.1]), | ||
295 | st "Monoid 3 3d" "sphere(1.1,$fs=0.1);" (mconcat [sphere 1.1 $ fs 0.1]), | ||
296 | st "Monoid 3 2d" "square([1.0,1.0]);" (mconcat [square 1]), | ||
297 | st "Semigroup 1 3d" "cube([0.0,0.0,0.0]);" (solid mempty), | ||
298 | -- should we export a "shape" function? | ||
299 | st "Semigroup 1 2d" "cube([0.0,0.0,0.0]);" (mempty :: Model2d), | ||
300 | st "Semigroup 2 3d" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}" | ||
301 | (mappend (cube 1) $ sphere 1.1 (fs 0.1)), | ||
302 | st "Semigroup 2 2d" "union(){square([1.0,1.0]);circle(1.1,$fs=0.1);}" | ||
303 | (mappend (square 1) $ circle 1.1 (fs 0.1)), | ||
304 | st "Semigroup 3 3d" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}" | ||
305 | (sconcat $ fromList [cube 1, sphere 1.1 $ fs 0.1]), | ||
306 | st "Semigroup 3 2d" "union(){square([1.0,1.0]);circle(1.1,$fs=0.1);}" | ||
307 | (sconcat $ fromList [square 1, circle 1.1 $ fs 0.1]) | ||
308 | ] | ||
309 | ] | ||
310 | |||
311 | main = defaultMain tests | ||