Skip to content

R
riscv-gcc-1
Commit 2f8313ce by Eric Botcazou Committed by Pierre-Marie de Rodat
Options

[Ada] Small enhancement to the -gnatD/-gnatG output for fixed-point types 

This is a small enhancement to the -gnatD/-gnatG output: the base type
of fixed-point types, which is usually an itype, used to be printed as
??? in this case.  It is now printed in a similar fashion as the first
subtype.

For the following package:

package P is

  type D is delta 128.0 / (2 ** 15) range 0.0 .. 256.0;

end P;

the  -gnatD/-gnatG must now be:

Source recreated from tree for P (spec)
---------------------------------------

p_E : short_integer := 0;

package p is
   type p__d is delta [1.0/256.0] range 0.0 .. 256.0;
   [type p__TdB is delta [1.0/256.0] range -[2147483648.0*2**(-8)] ..
     [2147483647.0*2**(-8)]]
   freeze p__TdB []
end p;

2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* sprint.adb (Sprint_Node_Actual)
	<N_Decimal_Fixed_Point_Definition>: Swap a couple of spaces.
	(Write_Itype): Minor consistency fixes throughout.  Add support
	for printing ordinary and decimal fixed-point types and
	subtypes.

From-SVN: r273689
parent 75f6bfce
Showing with 67 additions and 32 deletions
gcc/ada/ChangeLog
2019-07-22 Eric Botcazou <ebotcazou@adacore.com>
* sprint.adb (Sprint_Node_Actual)
<N_Decimal_Fixed_Point_Definition>: Swap a couple of spaces.
(Write_Itype): Minor consistency fixes throughout. Add support
for printing ordinary and decimal fixed-point types and
subtypes.
2019-07-22 Eric Botcazou <ebotcazou@adacore.com>
* exp_attr.adb (Expand_Loop_Entry_Attribute): Beef up comment.
2019-07-22 Ed Schonberg <schonberg@adacore.com>
......
gcc/ada/sprint.adb
......@@ -1483,9 +1483,9 @@ package body Sprint is
end;
when N_Decimal_Fixed_Point_Definition =>
Write_Str_With_Col_Check_Sloc (" delta ");
Write_Str_With_Col_Check_Sloc ("delta ");
Sprint_Node (Delta_Expression (Node));
Write_Str_With_Col_Check ("digits ");
Write_Str_With_Col_Check (" digits ");
Sprint_Node (Digits_Expression (Node));
Sprint_Opt_Node (Real_Range_Specification (Node));
......@@ -4187,9 +4187,7 @@ package body Sprint is
declare
B : constant Node_Id := Etype (Typ);
X : Node_Id;
P : constant Node_Id := Parent (Typ);
S : constant Saved_Output_Buffer := Save_Output_Buffer;
-- Save current output buffer
......@@ -4197,6 +4195,8 @@ package body Sprint is
-- Save sloc of related node, so it is not modified when
-- printing with -gnatD.
X : Node_Id;
begin
-- Write indentation at start of line
......@@ -4324,8 +4324,8 @@ package body Sprint is
declare
L : constant Node_Id := Type_Low_Bound (Typ);
H : constant Node_Id := Type_High_Bound (Typ);
LE : Node_Id;
HE : Node_Id;
BL : Node_Id;
BH : Node_Id;
begin
-- B can either be a scalar type, in which case the
......@@ -4335,29 +4335,29 @@ package body Sprint is
-- constraint.
if Is_Scalar_Type (B) then
LE := Type_Low_Bound (B);
HE := Type_High_Bound (B);
BL := Type_Low_Bound (B);
BH := Type_High_Bound (B);
else
LE := Empty;
HE := Empty;
BL := Empty;
BH := Empty;
end if;
if No (LE)
if No (BL)
or else (True
and then Nkind (L) = N_Integer_Literal
and then Nkind (H) = N_Integer_Literal
and then Nkind (LE) = N_Integer_Literal
and then Nkind (HE) = N_Integer_Literal
and then UI_Eq (Intval (L), Intval (LE))
and then UI_Eq (Intval (H), Intval (HE)))
and then Nkind (BL) = N_Integer_Literal
and then Nkind (BH) = N_Integer_Literal
and then UI_Eq (Intval (L), Intval (BL))
and then UI_Eq (Intval (H), Intval (BH)))
then
null;
else
Write_Str (" range ");
Sprint_Node (Type_Low_Bound (Typ));
Sprint_Node (L);
Write_Str (" .. ");
Sprint_Node (Type_High_Bound (Typ));
Sprint_Node (H);
end if;
end;
......@@ -4368,7 +4368,7 @@ package body Sprint is
Write_Str ("mod ");
Write_Uint_With_Col_Check (Modulus (Typ), Auto);
-- Floating point types and subtypes
-- Floating-point types and subtypes
when E_Floating_Point_Subtype
| E_Floating_Point_Type
......@@ -4379,9 +4379,9 @@ package body Sprint is
Write_Str ("new ");
end if;
Write_Id (Etype (Typ));
Write_Id (B);
if Digits_Value (Typ) /= Digits_Value (Etype (Typ)) then
if Digits_Value (Typ) /= Digits_Value (B) then
Write_Str (" digits ");
Write_Uint_With_Col_Check
(Digits_Value (Typ), Decimal);
......@@ -4392,27 +4392,54 @@ package body Sprint is
declare
L : constant Node_Id := Type_Low_Bound (Typ);
H : constant Node_Id := Type_High_Bound (Typ);
LE : constant Node_Id := Type_Low_Bound (B);
HE : constant Node_Id := Type_High_Bound (B);
BL : constant Node_Id := Type_Low_Bound (B);
BH : constant Node_Id := Type_High_Bound (B);
begin
if Nkind (L) = N_Real_Literal
if True
and then Nkind (L) = N_Real_Literal
and then Nkind (H) = N_Real_Literal
and then Nkind (LE) = N_Real_Literal
and then Nkind (HE) = N_Real_Literal
and then UR_Eq (Realval (L), Realval (LE))
and then UR_Eq (Realval (H), Realval (HE))
and then Nkind (BL) = N_Real_Literal
and then Nkind (BH) = N_Real_Literal
and then UR_Eq (Realval (L), Realval (BL))
and then UR_Eq (Realval (H), Realval (BH))
then
null;
else
Write_Str (" range ");
Sprint_Node (Type_Low_Bound (Typ));
Sprint_Node (L);
Write_Str (" .. ");
Sprint_Node (Type_High_Bound (Typ));
Sprint_Node (H);
end if;
end;
-- Ordinary fixed-point types and subtypes
when E_Ordinary_Fixed_Point_Subtype
| E_Ordinary_Fixed_Point_Type
=>
Write_Header (Ekind (Typ) = E_Ordinary_Fixed_Point_Type);
Write_Str ("delta ");
Write_Ureal_With_Col_Check_Sloc (Delta_Value (Typ));
Write_Str (" range ");
Sprint_Node (Type_Low_Bound (Typ));
Write_Str (" .. ");
Sprint_Node (Type_High_Bound (Typ));
-- Decimal fixed-point types and subtypes
when E_Decimal_Fixed_Point_Subtype
| E_Decimal_Fixed_Point_Type
=>
Write_Header (Ekind (Typ) = E_Decimal_Fixed_Point_Type);
Write_Str ("delta ");
Write_Ureal_With_Col_Check_Sloc (Delta_Value (Typ));
Write_Str (" digits ");
Write_Uint_With_Col_Check (Digits_Value (Typ), Decimal);
-- Record subtypes
when E_Record_Subtype
......@@ -4493,16 +4520,16 @@ package body Sprint is
when E_String_Literal_Subtype =>
declare
LB : constant Uint :=
L : constant Uint :=
Expr_Value (String_Literal_Low_Bound (Typ));
Len : constant Uint :=
String_Literal_Length (Typ);
begin
Write_Header (False);
Write_Str ("String (");
Write_Int (UI_To_Int (LB));
Write_Int (UI_To_Int (L));
Write_Str (" .. ");
Write_Int (UI_To_Int (LB + Len) - 1);
Write_Int (UI_To_Int (L + Len) - 1);
Write_Str (");");
end;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment