nichkara/lace
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add initial prototype.

Browse Source
This commit is contained in:
Rod Kay
2022-07-31 17:34:54 +10:00
commit 54a53b2ac0
1421 changed files with 358874 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
1-base/math/applet/test/geometry/hexagon/hexagon_test.gpr Normal file
View File

@@ -0,0 +1,21 @@
with
"math",
"lace_shared";
project Hexagon_Test
is
for Object_Dir use "build";
for Exec_Dir use ".";
for Main use ("launch_hexagon_test.adb");
package Ide renames Lace_shared.Ide;
package Builder renames Lace_shared.Builder;
package Compiler renames Lace_shared.Compiler;
package Binder renames Lace_shared.Binder;
package Linker is
for Default_Switches ("ada") use ("-g");
end Linker;
end Hexagon_Test;

106
1-base/math/applet/test/geometry/hexagon/launch_hexagon_test.adb Normal file
View File

@@ -0,0 +1,106 @@
with
ada.Text_IO,
float_Math.Geometry.d2.Hexagon;
procedure launch_Hexagon_Test
is
use float_Math.Geometry.d2;
procedure log (Message : in String)
renames ada.Text_IO.put_Line;
Hex : constant Hexagon.item := (circumRadius => 1.0);
begin
log ("");
log (Hex'Image);
log ("");
log ("");
for i in float_Math.Geometry.d2.Hexagon.vertex_Id
loop
log (Hexagon.Site (Hex, i)'Image);
end loop;
log ("");
log ("");
log ("1x1 Grid");
declare
the_Grid : constant hexagon.Grid := Hexagon.to_Grid (1, 1, 1.0);
begin
for Row in 1 .. the_Grid.Rows
loop
log ("");
for Col in 1 .. the_Grid.Cols
loop
log ("[" & Row'Image & "][" & Col'Image & "] => " & Hexagon.hex_Center (the_Grid, [Row, Col])'Image);
end loop;
end loop;
end;
log ("");
log ("");
log ("2x1 Grid");
declare
the_Grid : constant hexagon.Grid := Hexagon.to_Grid (2, 1, 1.0);
begin
for Row in 1 .. the_Grid.Rows
loop
log ("");
for Col in 1 .. the_Grid.Cols
loop
log ("[" & Row'Image & "][" & Col'Image & "] => " & Hexagon.hex_Center (the_Grid, [Row, Col])'Image);
end loop;
end loop;
end;
log ("");
log ("");
log ("1x2 Grid");
declare
the_Grid : constant hexagon.Grid := Hexagon.to_Grid (1, 2, 1.0);
begin
for Row in 1 .. the_Grid.Rows
loop
log ("");
for Col in 1 .. the_Grid.Cols
loop
log ("[" & Row'Image & "][" & Col'Image & "] => " & Hexagon.hex_Center (the_Grid, [Row, Col])'Image);
end loop;
end loop;
end;
log ("");
log ("");
log ("2x2 Grid");
declare
the_Grid : constant hexagon.Grid := Hexagon.to_Grid (2, 2, 1.0);
begin
for Row in 1 .. the_Grid.Rows
loop
log ("");
for Col in 1 .. the_Grid.Cols
loop
log ("[" & Row'Image & "][" & Col'Image & "] => " & Hexagon.hex_Center (the_Grid, [Row, Col])'Image);
end loop;
end loop;
end;
log ("");
log ("");
log ("Done.");
end launch_Hexagon_Test;

2701
1-base/math/applet/test/modeller/gaspra.tab Normal file
View File

File diff suppressed because it is too large Load Diff

15
1-base/math/applet/test/modeller/launch_modeller_test.adb Normal file
View File

@@ -0,0 +1,15 @@
with
ada.Text_IO,
float_Math.Geometry.d3.Modeller.Forge;
procedure launch_modeller_Test
is
use ada.Text_IO,
float_Math.Geometry.d3.Modeller.Forge;
the_Modeller : polar_Model := polar_Model_from ("gaspra.tab");
begin
put_Line ("Done.");
end launch_modeller_Test;

21
1-base/math/applet/test/modeller/test_modeller.gpr Normal file
View File

@@ -0,0 +1,21 @@
with
"math",
"lace_shared";
project test_Modeller
is
for Object_Dir use "build";
for Exec_Dir use ".";
for Main use ("launch_modeller_test.adb");
package Ide renames Lace_shared.Ide;
package Builder renames Lace_shared.Builder;
package Compiler renames Lace_shared.Compiler;
package Binder renames Lace_shared.Binder;
package Linker is
for Default_Switches ("ada") use ("-g");
end Linker;
end test_Modeller;

20
1-base/math/applet/test/suite/launch_math_testsuite.adb Normal file
View File

@@ -0,0 +1,20 @@
with ahven.Text_Runner,
ahven.Framework,
math_Tests.linear_Algebra_2d,
math_Tests.linear_Algebra_3d,
math_Tests.Geometry_2d;
procedure launch_math_Testsuite
is
S : constant ahven.Framework.test_Suite_access := ahven.Framework.create_Suite ("All Math Tests");
begin
S.add_Test (new math_Tests .Test);
S.add_Test (new math_Tests.linear_Algebra_2d.Test);
S.add_Test (new math_Tests.linear_Algebra_3d.Test);
S.add_Test (new math_Tests.Geometry_2d .Test);
ahven.text_Runner.run (S);
ahven.Framework .release_Suite (S);
end launch_math_Testsuite;

97
1-base/math/applet/test/suite/math_tests-geometry_2d.adb Normal file
View File

@@ -0,0 +1,97 @@
with
Ahven,
float_Math.Geometry.d2;
package body math_Tests.Geometry_2d
is
use Ahven,
float_Math;
function almost_Equal (Left, Right : in Real) return Boolean
is
Tolerance : constant := 0.000_001;
begin
return abs (Left - Right) <= Tolerance;
end almost_Equal;
procedure Polygon_is_convex_Test
is
use float_Math.Geometry.d2;
the_Poly : Polygon := (vertex_Count => 4,
vertices => [[-1.0, -1.0],
[ 1.0, -1.0],
[ 1.0, 1.0],
[-1.0, 1.0]]);
begin
assert (is_Convex (the_Poly),
"T1 => " & Image (the_Poly) & " should be convex ... failed !");
the_Poly.Vertices (3) := [0.0, 0.0];
assert (is_Convex (the_Poly),
"T2 => " & Image (the_Poly) & " should be convex ... failed !");
the_Poly.Vertices (3) := [0.0, 0.1];
assert (is_Convex (the_Poly),
"T3 => " & Image (the_Poly) & " should be convex ... failed !");
the_Poly.Vertices (3) := [0.0, -0.1];
assert (not is_Convex (the_Poly),
"T4 => " & Image (the_Poly) & " should not be convex ... failed !");
end Polygon_is_convex_Test;
procedure triangle_Area_Test
is
use float_Math.Geometry.d2;
the_Tri : Triangle := [vertices => [[0.0, 0.0],
[1.0, 0.0],
[1.0, 1.0]]];
begin
assert (almost_Equal (Area (the_Tri), 0.5),
"T1 => & Image (the_Tri) & area should be 0.5 ... failed ! " & Image (Area (the_Tri), 12));
the_Tri := (vertices => [[-0.11073643, -0.179634809],
[-0.0553682148, 0.410182595],
[-0.0276841074, 0.705091298]]);
assert (Area (the_Tri) >= 0.0,
"T2 => & Image (the_Tri) & area should be positive ... failed !");
the_Tri := (vertices => [[-1.0, -1.0],
[ 1.0, -1.0],
[ 1.0, -0.999999]]);
assert (Area (the_Tri) > 0.0,
"T3 => & Image (the_Tri) & area should be positive ... failed !");
the_Tri := (vertices => [[-0.11073643, -0.179634809],
[-0.0276841074, 0.705091298],
[-0.0553682148, 0.410182595]]);
assert (Area (the_Tri) >= 0.0,
"T4 => & Image (the_Tri) & area should be positive ... failed !");
-- tbd: Add tests for degenerate triangles.
end triangle_Area_Test;
overriding
procedure Initialize (T : in out Test) is
begin
T.set_Name ("Geometry (2D) Tests");
Framework.add_test_Routine (T, Polygon_is_convex_Test'Access, "Polygon is convex Test");
Framework.add_test_Routine (T, triangle_Area_Test 'Access, "Triangle area Test");
end Initialize;
end math_Tests.Geometry_2d;

11
1-base/math/applet/test/suite/math_tests-geometry_2d.ads Normal file
View File

@@ -0,0 +1,11 @@
with Ahven.Framework;
package math_Tests.Geometry_2d
is
type Test is new Ahven.Framework.Test_Case with null record;
overriding procedure Initialize (T : in out Test);
end math_Tests.Geometry_2d;

150
1-base/math/applet/test/suite/math_tests-linear_algebra_2d.adb Normal file
View File

@@ -0,0 +1,150 @@
with
Ahven,
float_Math.Algebra.linear.d2;
package body math_Tests.linear_Algebra_2d
is
use Ahven,
float_Math;
function almost_Equal (Left, Right : in Real) return Boolean
is
Tolerance : constant := 0.000_000_1;
begin
return abs (Left - Right) <= Tolerance;
end almost_Equal;
procedure translation_Matrix_Test
is
use
float_Math.Algebra.linear.d2;
From : constant Vector_2 := [0.0, 0.0];
To : Vector_2;
begin
To := From * to_translation_Transform ([1.0, 0.0]);
assert (To (1) = 1.0, Image (To) & " translation () failed !");
assert (To (2) = 0.0, Image (To) & " translation () failed !");
To := From * to_translation_Transform ([0.0, 1.0]);
assert (To (1) = 0.0, Image (To) & " translation () failed !");
assert (To (2) = 1.0, Image (To) & " translation () failed !");
To := From * to_translation_Transform ([-1.0, 0.0]);
assert (To (1) = -1.0, Image (To) & " translation () failed !");
assert (To (2) = 0.0, Image (To) & " translation () failed !");
To := From * to_translation_Transform ([0.0, -1.0]);
assert (To (1) = 0.0, Image (To) & " translation () failed !");
assert (To (2) = -1.0, Image (To) & " translation () failed !");
To := From * to_translation_Transform ([1.0, 1.0]);
assert (To (1) = 1.0, Image (To) & " translation () failed !");
assert (To (2) = 1.0, Image (To) & " translation () failed !");
To := From * to_translation_Transform ([-1.0, -1.0]);
assert (To (1) = -1.0, Image (To) & " translation () failed !");
assert (To (2) = -1.0, Image (To) & " translation () failed !");
end translation_Matrix_Test;
procedure rotation_Matrix_Test
is
use
float_Math.Algebra.linear.d2;
From : constant Vector_2 := [1.0, 0.0];
To : Vector_2;
begin
To := From * to_rotation_Matrix (to_Radians (90.0));
assert (almost_Equal (To (1), 0.0), Image (To, 16) & " rotation (90a) failed !");
assert (almost_Equal (To (2), 1.0), Image (To, 16) & " rotation (90b) failed !");
To := From * to_rotation_Matrix (to_Radians (-90.0));
assert (almost_Equal (To (1), 0.0), Image (To, 16) & " rotation (-90a) failed !");
assert (almost_Equal (To (2), -1.0), Image (To, 16) & " rotation (-90b) failed !");
To := From * to_rotation_Matrix (to_Radians (180.0));
assert (almost_Equal (To (1), -1.0), Image (To, 16) & " rotation (180a) failed !");
assert (almost_Equal (To (2), 0.0), Image (To, 16) & " rotation (180b) failed !");
To := From * to_rotation_Matrix (to_Radians (-180.0));
assert (almost_Equal (To (1), -1.0), Image (To, 16) & " rotation (-180a) failed !");
assert (almost_Equal (To (2), 0.0), Image (To, 16) & " rotation (-180b) failed !");
To := From * to_rotation_Matrix (to_Radians (270.0));
assert (almost_Equal (To (1), 0.0), Image (To, 16) & " rotation (270a) failed !");
assert (almost_Equal (To (2), -1.0), Image (To, 16) & " rotation (270b) failed !");
To := From * to_rotation_Matrix (to_Radians (-270.0));
assert (almost_Equal (To (1), 0.0), Image (To, 16) & " rotation (-270) failed !");
assert (almost_Equal (To (2), 1.0), Image (To, 16) & " rotation (-270) failed !");
end rotation_Matrix_Test;
procedure transform_Test
is
use
float_Math.Algebra.linear.d2;
From : constant Vector_2 := [1.0, 0.0];
To : Vector_2;
Transform : Transform_2d := to_Transform_2d (rotation => to_Radians (90.0),
translation => [0.0, 0.0]);
begin
To := From * Transform;
assert (almost_Equal (To (1), 0.0), Image (To, 16) & " transform (a) failed !");
assert (almost_Equal (To (2), 1.0), Image (To, 16) & " transform (b) failed !");
Transform.Translation := [1.0, 0.0];
To := From * Transform;
assert (almost_Equal (To (1), 1.0), Image (To, 16) & " transform (c) failed !");
assert (almost_Equal (To (2), 1.0), Image (To, 16) & " transform (d) failed !");
end transform_Test;
overriding
procedure Initialize (T : in out Test) is
begin
T.set_Name ("Linear Algebra (2D) Tests");
Framework.add_test_Routine (T, translation_Matrix_Test'Access, "translation_Matrix_Test");
Framework.add_test_Routine (T, rotation_Matrix_Test'Access, "rotation_Matrix_Test");
Framework.add_test_Routine (T, transform_Test'Access, "transform_Test");
end Initialize;
end math_Tests.linear_Algebra_2d;

12
1-base/math/applet/test/suite/math_tests-linear_algebra_2d.ads Normal file
View File

@@ -0,0 +1,12 @@
with Ahven.Framework;
package math_Tests.linear_Algebra_2d
is
type Test is new Ahven.Framework.Test_Case with null record;
overriding
procedure Initialize (T : in out Test);
end math_Tests.linear_Algebra_2d;

228
1-base/math/applet/test/suite/math_tests-linear_algebra_3d.adb Normal file
View File

@@ -0,0 +1,228 @@
with
Ahven,
float_Math.Algebra.linear.d3;
-- with Ada.Text_IO; use Ada.Text_IO;
package body math_Tests.linear_Algebra_3d
is
use Ahven,
float_Math;
function almost_Equal (Left, Right : in Real) return Boolean
is
Tolerance : constant := 0.00_000_1;
begin
return abs (Left - Right) <= Tolerance;
end almost_Equal;
function almost_Equal (Left, Right : in Vector_3) return Boolean
is
begin
return almost_Equal (Left (1), Right (1))
and almost_Equal (Left (2), Right (2))
and almost_Equal (Left (3), Right (3));
end almost_Equal;
function almost_Equal (Left, Right : in Quaternion) return Boolean
is
begin
return almost_Equal (Left.R, Right.R)
and almost_Equal (Left.V (1), Right.V (1))
and almost_Equal (Left.V (2), Right.V (2))
and almost_Equal (Left.V (3), Right.V (3));
end almost_Equal;
procedure translation_Matrix_Test
is
use float_Math.Algebra.linear.d3;
From : constant Vector_3 := [0.0, 0.0, 0.0];
To : Vector_3;
begin
To := From * to_translation_Matrix ([1.0, 0.0, 0.0]);
assert (To (1) = 1.0, Image (To) & " translation (a) failed !");
assert (To (2) = 0.0, Image (To) & " translation (b) failed !");
assert (To (3) = 0.0, Image (To) & " translation (c) failed !");
To := From * to_translation_Matrix ([0.0, 1.0, 0.0]);
assert (To (1) = 0.0, Image (To) & " translation (d) failed !");
assert (To (2) = 1.0, Image (To) & " translation (e) failed !");
assert (To (3) = 0.0, Image (To) & " translation (f) failed !");
To := From * to_translation_Matrix ([-1.0, 0.0, 0.0]);
assert (To (1) = -1.0, Image (To) & " translation (g) failed !");
assert (To (2) = 0.0, Image (To) & " translation (h) failed !");
assert (To (3) = 0.0, Image (To) & " translation (i) failed !");
To := From * to_translation_Matrix ([0.0, -1.0, 0.0]);
assert (To (1) = 0.0, Image (To) & " translation (j) failed !");
assert (To (2) = -1.0, Image (To) & " translation (k) failed !");
assert (To (3) = 0.0, Image (To) & " translation (l) failed !");
To := From * to_translation_Matrix ([1.0, 1.0, 0.0]);
assert (To (1) = 1.0, Image (To) & " translation (m) failed !");
assert (To (2) = 1.0, Image (To) & " translation (n) failed !");
assert (To (3) = 0.0, Image (To) & " translation (o) failed !");
To := From * to_translation_Matrix ([-1.0, -1.0, 0.0]);
assert (To (1) = -1.0, Image (To) & " translation (p) failed !");
assert (To (2) = -1.0, Image (To) & " translation (q) failed !");
assert (To (3) = 0.0, Image (To) & " translation (r) failed !");
end translation_Matrix_Test;
procedure rotation_Matrix_Test
is
use float_Math.Algebra.linear.d3;
From : constant Vector_3 := [1.0, 0.0, 0.0];
To : Vector_3;
begin
To := From * z_Rotation_from (to_Radians (90.0));
assert (almost_Equal (To, [0.0, -1.0, 0.0]),
Image (To, 16) & " rotation (90) failed !");
To := From * z_Rotation_from (to_Radians (-90.0));
assert (almost_Equal (To, [0.0, 1.0, 0.0]),
Image (To, 16) & " rotation (-90) failed !");
To := From * z_Rotation_from (to_Radians (180.0));
assert (almost_Equal (To, [-1.0, 0.0, 0.0]),
Image (To, 16) & " rotation (180) failed !");
To := From * z_Rotation_from (to_Radians (-180.0));
assert (almost_Equal (To, [-1.0, 0.0, 0.0]),
Image (To, 16) & " rotation (-180) failed !");
To := From * z_Rotation_from (to_Radians (270.0));
assert (almost_Equal (To, [0.0, 1.0, 0.0]),
Image (To, 16) & " rotation (270) failed !");
To := From * z_Rotation_from (to_Radians (-270.0));
assert (almost_Equal (To, [0.0, -1.0, 0.0]),
Image (To, 16) & " rotation (-270) failed !");
end rotation_Matrix_Test;
procedure transform_Test
is
use float_Math.Algebra.linear.d3;
From : constant Vector_3 := [1.0, 0.0, 0.0];
To : Vector_3;
Transform : Transform_3d := (rotation => z_Rotation_from (to_Radians (90.0)),
translation => [0.0, 0.0, 0.0]);
begin
To := From * Transform;
assert (almost_Equal (To, [0.0, 1.0, 0.0]),
Image (To, 16) & " transform () failed !");
Transform.Translation := [1.0, 0.0, 0.0];
To := From * Transform;
assert (almost_Equal (To, [1.0, 1.0, 0.0]),
Image (To, 16) & " transform () failed !");
end transform_Test;
procedure quaternion_interpolation_Test
is
use float_Math.Algebra.linear.d3;
Initial : constant Quaternion := to_Quaternion (z_Rotation_from (to_Radians ( 90.0)));
Desired : constant Quaternion := to_Quaternion (z_Rotation_from (to_Radians (180.0)));
begin
-- put_Line (Degrees'Image (to_Degrees (Angle (Interpolated (Initial, Desired, 0.0)))));
-- put_Line (Degrees'Image (to_Degrees (Angle (Initial))));
assert (almost_Equal (Interpolated (Initial, Desired, 0.0), Initial), "almost_Equal (Interpolated (Initial, Desired, 0.0), Initial) ... failed !");
assert (almost_Equal (Interpolated (Initial, Desired, 100.0), Desired), "almost_Equal (Interpolated (Initial, Desired, 1.0), Desired) ... failed !");
-- new_Line;
-- put_Line ("0.01 " & Degrees'Image (to_Degrees (Angle (Interpolated (Initial, Desired, to_Percentage (0.01))))));
-- put_Line ("0.1 " & Degrees'Image (to_Degrees (Angle (Interpolated (Initial, Desired, to_Percentage (0.1))))));
-- put_Line ("0.2 " & Degrees'Image (to_Degrees (Angle (Interpolated (Initial, Desired, to_Percentage (0.2))))));
-- put_Line ("0.3 " & Degrees'Image (to_Degrees (Angle (Interpolated (Initial, Desired, to_Percentage (0.3))))));
-- put_Line ("0.4 " & Degrees'Image (to_Degrees (Angle (Interpolated (Initial, Desired, to_Percentage (0.4))))));
-- put_Line ("0.5 " & Degrees'Image (to_Degrees (Angle (Interpolated (Initial, Desired, to_Percentage (0.5))))));
-- put_Line ("0.6 " & Degrees'Image (to_Degrees (Angle (Interpolated (Initial, Desired, to_Percentage (0.6))))));
-- put_Line ("0.7 " & Degrees'Image (to_Degrees (Angle (Interpolated (Initial, Desired, to_Percentage (0.7))))));
-- put_Line ("0.8 " & Degrees'Image (to_Degrees (Angle (Interpolated (Initial, Desired, to_Percentage (0.8))))));
-- put_Line ("0.9 " & Degrees'Image (to_Degrees (Angle (Interpolated (Initial, Desired, to_Percentage (0.9))))));
-- put_Line ("0.99 " & Degrees'Image (to_Degrees (Angle (Interpolated (Initial, Desired, to_Percentage (0.99))))));
-- put_Line (Degrees'Image (to_Degrees (to_Radians (90.0))));
assert (almost_Equal (Angle (Interpolated (Initial, Desired, 50.0)),
to_Radians (135.0)),
"Angle (Interpolated (Initial, Desired, 0.5)) = to_Radians (135.0) ... failed !");
end quaternion_interpolation_Test;
procedure inverse_transform_Test
is
use float_Math.Algebra.linear.d3;
From : constant Vector_3 := [1.0, 1.0, 1.0];
To : Vector_3;
Transform : constant Matrix_4x4 := to_transform_Matrix (Rotation => z_Rotation_from (to_Radians (90.0)),
Translation => [5.0, 5.0, 5.0]);
begin
To := From * Transform;
To := To * inverse_Transform (Transform);
assert (almost_Equal (To, From),
Image (To, 16) & " inverse_Transform failed !");
end inverse_transform_Test;
overriding
procedure Initialize (T : in out Test) is
begin
T.set_Name ("Linear Algebra (3D) Tests");
Framework.add_test_Routine (T, translation_Matrix_Test'Access, "translation_Matrix_Test");
Framework.add_test_Routine (T, rotation_Matrix_Test'Access, "rotation_Matrix_Test");
Framework.add_test_Routine (T, transform_Test'Access, "transform_Test");
Framework.add_test_Routine (T, inverse_transform_Test'Access, "inverse_transform_Test");
Framework.add_test_Routine (T, quaternion_interpolation_Test'Access, "quaternion_interpolation_Test");
end Initialize;
end math_Tests.linear_Algebra_3d;

12
1-base/math/applet/test/suite/math_tests-linear_algebra_3d.ads Normal file
View File

@@ -0,0 +1,12 @@
with Ahven.Framework;
package math_Tests.linear_Algebra_3d
is
type Test is new Ahven.Framework.Test_Case with null record;
overriding
procedure Initialize (T : in out Test);
end math_Tests.linear_Algebra_3d;

165
1-base/math/applet/test/suite/math_tests.adb Normal file
View File

@@ -0,0 +1,165 @@
with Ahven,
float_Math;
-- with Ada.Text_IO; use Ada.Text_IO;
package body math_Tests
is
use Ahven;
procedure counter_Test
is
use float_Math;
use type Counter;
Count : Counter := 0;
begin
increment (Count); assert (Count = 1, "increment () failed !");
decrement (Count); assert (Count = 0, "decrement () failed !");
increment (Count, 5); assert (Count = 5, "increment (by) failed !");
decrement (Count, 5); assert (Count = 0, "decrement (by) failed !");
end counter_Test;
procedure integer_Test
is
use float_Math;
begin
declare
Age : Integer := 0;
begin
increment (Age); assert (Age = 1, "increment () ... failed !");
decrement (Age); assert (Age = 0, "decrement () ... failed !");
increment (Age, 5); assert (Age = 5, "increment (by) ... failed !");
decrement (Age, 5); assert (Age = 0, "decrement (by) ... failed !");
end;
declare
A : Integer := 1;
B : Integer := 2;
begin
swap (A, B); assert (A = 2 and B = 1, "swap () ... failed !");
end;
end integer_Test;
procedure real_Test
is
use float_Math;
begin
--- almost_Zero
--
begin
assert ( almost_Zero (0.0 ), "almost_Zero (0.0) ... failed !");
assert ( almost_Zero (0.0 + Real'Base'Model_Small), "almost_Zero (0.0 + Real'Base'Model_Small) ... failed !");
assert (not almost_Zero (0.0 + Real'Base'Model_Small
+ Real'Base'Model_Small), "not almost_Zero (0.0 + Real'Base'Model_Small + Real'Base'Model_Small) ... failed !");
assert ( almost_Zero (0.0 - Real'Base'Model_Small), "almost_Zero (0.0 - Real'Base'Model_Small) ... failed !");
assert (not almost_Zero (0.0 - Real'Base'Model_Small
- Real'Base'Model_Small), "not almost_Zero (0.0 - Real'Base'Model_Small - Real'Base'Model_Small) ... failed !");
end;
--- Clamped
--
begin
assert (Clamped ( 0.0, -1.0, 1.0) = 0.0, "Clamped (a) ... failed !");
assert (Clamped ( 2.0, -1.0, 1.0) = 1.0, "Clamped (b) ... failed !");
assert (Clamped (-2.0, -1.0, 1.0) = -1.0, "Clamped (c) ... failed !");
end;
--- clamp
--
declare
the_Real : Real;
begin
the_Real := 0.0; clamp (the_Real, -1.0, 1.0); assert (the_real = 0.0, "clamp (a) ... failed !");
the_Real := 2.0; clamp (the_Real, -1.0, 1.0); assert (the_real = 1.0, "clamp (b) ... failed !");
the_Real := -2.0; clamp (the_Real, -1.0, 1.0); assert (the_real = -1.0, "clamp (c) ... failed !");
end;
--- Image
--
declare
the_Real : constant Real := 1.1111_1111;
begin
assert (Image (the_Real, 0) = " 1", "Image (a) ... failed ! ... '" & Image (the_Real, 0) & "'");
assert (Image (the_Real, 1) = " 1.1", "Image (b) ... failed ! ... '" & Image (the_Real, 1) & "'");
assert (Image (the_Real, 8) = " 1.11111116", "Image (c) ... failed ! ... '" & Image (the_Real, 8) & "'"); -- tbd: why end in '6' ?
end;
end real_Test;
procedure angle_Test
is
use float_Math;
begin
--- to_Radians
--
assert (to_Radians ( 0.0) = 0.0, "to_Radians (a) ... failed ! ... " & Image (to_Radians ( 0.0), 12));
assert (to_Radians ( 90.0) = 90.0 * Pi / 180.0, "to_Radians (b) ... failed ! ... " & Image (to_Radians ( 90.0), 12));
assert (to_Radians (180.0) = 180.0 * Pi / 180.0, "to_Radians (c) ... failed ! ... " & Image (to_Radians (180.0), 12));
assert (to_Radians (270.0) = 270.0 * Pi / 180.0, "to_Radians (d) ... failed ! ... " & Image (to_Radians (270.0), 12));
assert (to_Radians (360.0) = 360.0 * Pi / 180.0, "to_Radians (e) ... failed ! ... " & Image (to_Radians (360.0), 12));
--- to_Degrees
--
assert (to_Degrees ( 0.0) = 0.0, "to_Degrees (a) ... failed ! ... " & Degrees'Image (to_Degrees ( 0.0)));
assert (to_Degrees ( Pi / 2.00) = 90.0, "to_Degrees (b) ... failed ! ... " & Degrees'Image (to_Degrees ( 0.0)));
assert (to_Degrees ( Pi) = 180.0, "to_Degrees (c) ... failed ! ... " & Degrees'Image (to_Degrees ( 0.0)));
assert (to_Degrees ( Pi * 2.0) = 360.0, "to_Degrees (d) ... failed ! ... " & Degrees'Image (to_Degrees ( 0.0)));
end angle_Test;
procedure vector_Test
is
use float_Math;
begin
--- Sum & Average
--
assert (Sum ([0.0, 1.0, 2.0, 3.0]) = 6.0, "Sum () ... failed ! ... " & Image (Sum ([0.0, 1.0, 2.0, 3.0])));
assert (Average ([0.0, 1.0, 2.0, 3.0]) = 1.5, "Average () ... failed ! ... " & Image (Average ([0.0, 1.0, 2.0, 3.0])));
end vector_Test;
overriding
procedure Initialize (T : in out Test) is
begin
T.set_Name ("Core Math Tests");
Framework.add_test_Routine (T, counter_Test'Access, "counter_Test");
Framework.add_test_Routine (T, integer_Test'Access, "integer_Test");
Framework.add_test_Routine (T, real_Test 'Access, "real_Test");
Framework.add_test_Routine (T, angle_Test 'Access, "angle_Test");
Framework.add_test_Routine (T, vector_Test 'Access, "vector_Test");
end Initialize;
end math_Tests;

12
1-base/math/applet/test/suite/math_tests.ads Normal file
View File

@@ -0,0 +1,12 @@
with Ahven.Framework;
package math_Tests
is
type Test is new Ahven.Framework.Test_Case with null record;
overriding
procedure Initialize (T : in out Test);
end math_Tests;

21
1-base/math/applet/test/suite/math_testsuite.gpr Normal file
View File

@@ -0,0 +1,21 @@
with
"ahven",
"math",
"lace_shared";
project Math_Testsuite
is
for Object_Dir use "build";
for Exec_Dir use ".";
for Main use ("launch_math_testsuite.adb");
package Ide renames Lace_shared.Ide;
package Builder renames Lace_shared.Builder;
package Compiler renames Lace_shared.Compiler;
package Binder renames Lace_shared.Binder;
package Linker is
for Default_Switches ("ada") use ("-g");
end Linker;
end Math_Testsuite;