summaryrefslogtreecommitdiff
path: root/openscad/UnitTest.hs
diff options
context:
space:
mode:
Diffstat (limited to 'openscad/UnitTest.hs')
-rw-r--r--openscad/UnitTest.hs311
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
3module Main where
4
5import Control.DeepSeq
6import Control.Exception
7import Test.Tasty
8import Test.Tasty.HUnit
9import Test.HUnit.Tools
10import Graphics.OpenSCAD
11import Data.Colour (withOpacity)
12import Data.List.NonEmpty (fromList)
13import Data.Semigroup (Semigroup((<>), sconcat), Monoid(mconcat, mempty, mappend))
14
15
16
17assertError err code =
18 assertRaises "Check error" (ErrorCall err) . evaluate $ deepseq (show code) ()
19
20sw = concat . words
21st n e a = testCase n $ (sw $ render a) @?= (sw e)
22
23
24{- About the test result values.
25
26Running "cabal test" does not verify that the results do the intended
27thing in OpenSCAD. Possibly we'll add shell tests for that at some
28point, but not yet.
29
30For now, if you change or add strings, please manually copy them into
31OpenSCAD and make sure they do what you want the Model data structure
32that they are testing does.
33-}
34
35tests = 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
311main = defaultMain tests
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-16 17:41:55 +0000