Skip to content

Commit

Permalink
Add support for floating-point types First/Last attributes evaluation
Browse files Browse the repository at this point in the history
  • Loading branch information
thvnx committed Aug 1, 2024
1 parent 9cd693c commit 466089c
Show file tree
Hide file tree
Showing 3 changed files with 75 additions and 4 deletions.
42 changes: 42 additions & 0 deletions extensions/src/libadalang-expr_eval.adb
Original file line number Diff line number Diff line change
Expand Up @@ -493,6 +493,48 @@ package body Libadalang.Expr_Eval is
return Eval_Range_Attr
(D.As_Ordinary_Fixed_Point_Def.F_Range.F_Range.As_Ada_Node,
A);
when Ada_Floating_Point_Def =>
declare
Def : constant LAL.Floating_Point_Def :=
D.As_Floating_Point_Def;

Rng : constant LAL.Range_Spec := Def.F_Range;
begin
-- If a range has been specified we simply recurse on it,
-- otherwise we need to manually compute its bounds using
-- the `digits` value specified for that type definition.
if Rng.Is_Null then
declare
Digits_Res : constant Eval_Result :=
Expr_Eval (Def.F_Num_Digits);

Digits_Val : constant Integer :=
(if Digits_Res.Kind in Int
then To_Integer (Digits_Res.Int_Result)
else raise Property_Error with
"digits must be an integer");

Bound : constant Double :=
(if Digits_Val > 0
then (10.0 ** (4 * Digits_Val))
else raise Property_Error with
"digits must be positive");
begin
return Result : Eval_Result :=
(Kind => Real,
Expr_Type => D.Parent.As_Base_Type_Decl,
Real_Result => <>)
do
Result.Real_Result.Set
(case A is
when Range_First => -Bound,
when Range_Last => Bound);
end return;
end;
else
return Eval_Range_Attr (Rng.F_Range.As_Ada_Node, A);
end if;
end;

when others =>
raise Property_Error with
Expand Down
17 changes: 17 additions & 0 deletions testsuite/tests/ada_api/static_expr_eval/test.adb
Original file line number Diff line number Diff line change
Expand Up @@ -203,6 +203,23 @@ begin
null;
end;

-- Floating point ranges
declare
type T is digits 8 range 0.0 .. 1.0;
type U is digits 2;

T_First : T := T'First;
T_Last : T := T'Last;

U_First : U := U'First;
U_Last : U := U'Last;

Float_First : Float := Float'First;
Float_Last : Float := Float'Last;
begin
null;
end;

-- Invalid decimal fixed point defs
declare
type T is delta 1 digits 2;
Expand Down
20 changes: 16 additions & 4 deletions testsuite/tests/ada_api/static_expr_eval/test.out
Original file line number Diff line number Diff line change
Expand Up @@ -242,6 +242,18 @@ Expr <ObjectDecl ["V_First"] test.adb:200:7-200:30> evaluated to Real -3/2

Expr <ObjectDecl ["V_Last"] test.adb:201:7-201:29> evaluated to Real 3/2

Expr <ObjectDecl ["T_First"] test.adb:211:7-211:30> evaluated to Real 0

Expr <ObjectDecl ["T_Last"] test.adb:212:7-212:29> evaluated to Real 1

Expr <ObjectDecl ["U_First"] test.adb:214:7-214:30> evaluated to Real -100000000

Expr <ObjectDecl ["U_Last"] test.adb:215:7-215:29> evaluated to Real 100000000

Expr <ObjectDecl ["Float_First"] test.adb:217:7-217:42> evaluated to Real -340282346638528859811704183484516925440

Expr <ObjectDecl ["Float_Last"] test.adb:218:7-218:41> evaluated to Real 340282346638528859811704183484516925440

Property_Error: delta must be real

Property_Error: digits must be an integer
Expand All @@ -258,14 +270,14 @@ Property_Error: Unsupported type discrepancy

Property_Error: Unsupported type discrepancy

Expr <ObjectDecl ["Times_RI"] test.adb:227:7-227:35> evaluated to Real 7
Expr <ObjectDecl ["Times_RI"] test.adb:244:7-244:35> evaluated to Real 7

Expr <ObjectDecl ["Times_IR"] test.adb:228:7-228:35> evaluated to Real 15/2
Expr <ObjectDecl ["Times_IR"] test.adb:245:7-245:35> evaluated to Real 15/2

Expr <ObjectDecl ["Div_RI"] test.adb:229:7-229:35> evaluated to Real 7/4
Expr <ObjectDecl ["Div_RI"] test.adb:246:7-246:35> evaluated to Real 7/4

Property_Error: Unsupported type discrepancy

Expr <ObjectDecl ["Pow"] test.adb:231:7-231:36> evaluated to Real 625/16
Expr <ObjectDecl ["Pow"] test.adb:248:7-248:36> evaluated to Real 625/16

Done.

0 comments on commit 466089c

Please sign in to comment.