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> 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. * exp_attr.adb (Expand_Loop_Entry_Attribute): Beef up comment.
2019-07-22 Ed Schonberg <schonberg@adacore.com> 2019-07-22 Ed Schonberg <schonberg@adacore.com>
......
gcc/ada/sprint.adb
...@@ -1483,9 +1483,9 @@ package body Sprint is ...@@ -1483,9 +1483,9 @@ package body Sprint is
end; end;
when N_Decimal_Fixed_Point_Definition => 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)); Sprint_Node (Delta_Expression (Node));
Write_Str_With_Col_Check ("digits "); Write_Str_With_Col_Check (" digits ");
Sprint_Node (Digits_Expression (Node)); Sprint_Node (Digits_Expression (Node));
Sprint_Opt_Node (Real_Range_Specification (Node)); Sprint_Opt_Node (Real_Range_Specification (Node));
...@@ -4187,9 +4187,7 @@ package body Sprint is ...@@ -4187,9 +4187,7 @@ package body Sprint is
declare declare
B : constant Node_Id := Etype (Typ); B : constant Node_Id := Etype (Typ);
X : Node_Id;
P : constant Node_Id := Parent (Typ); P : constant Node_Id := Parent (Typ);
S : constant Saved_Output_Buffer := Save_Output_Buffer; S : constant Saved_Output_Buffer := Save_Output_Buffer;
-- Save current output buffer -- Save current output buffer
...@@ -4197,6 +4195,8 @@ package body Sprint is ...@@ -4197,6 +4195,8 @@ package body Sprint is
-- Save sloc of related node, so it is not modified when -- Save sloc of related node, so it is not modified when
-- printing with -gnatD. -- printing with -gnatD.
X : Node_Id;
begin begin
-- Write indentation at start of line -- Write indentation at start of line
...@@ -4324,8 +4324,8 @@ package body Sprint is ...@@ -4324,8 +4324,8 @@ package body Sprint is
declare declare
L : constant Node_Id := Type_Low_Bound (Typ); L : constant Node_Id := Type_Low_Bound (Typ);
H : constant Node_Id := Type_High_Bound (Typ); H : constant Node_Id := Type_High_Bound (Typ);
LE : Node_Id; BL : Node_Id;
HE : Node_Id; BH : Node_Id;
begin begin
-- B can either be a scalar type, in which case the -- B can either be a scalar type, in which case the
...@@ -4335,29 +4335,29 @@ package body Sprint is ...@@ -4335,29 +4335,29 @@ package body Sprint is
-- constraint. -- constraint.
if Is_Scalar_Type (B) then if Is_Scalar_Type (B) then
LE := Type_Low_Bound (B); BL := Type_Low_Bound (B);
HE := Type_High_Bound (B); BH := Type_High_Bound (B);
else else
LE := Empty; BL := Empty;
HE := Empty; BH := Empty;
end if; end if;
if No (LE) if No (BL)
or else (True or else (True
and then Nkind (L) = N_Integer_Literal and then Nkind (L) = N_Integer_Literal
and then Nkind (H) = N_Integer_Literal and then Nkind (H) = N_Integer_Literal
and then Nkind (LE) = N_Integer_Literal and then Nkind (BL) = N_Integer_Literal
and then Nkind (HE) = N_Integer_Literal and then Nkind (BH) = N_Integer_Literal
and then UI_Eq (Intval (L), Intval (LE)) and then UI_Eq (Intval (L), Intval (BL))
and then UI_Eq (Intval (H), Intval (HE))) and then UI_Eq (Intval (H), Intval (BH)))
then then
null; null;
else else
Write_Str (" range "); Write_Str (" range ");
Sprint_Node (Type_Low_Bound (Typ)); Sprint_Node (L);
Write_Str (" .. "); Write_Str (" .. ");
Sprint_Node (Type_High_Bound (Typ)); Sprint_Node (H);
end if; end if;
end; end;
...@@ -4368,7 +4368,7 @@ package body Sprint is ...@@ -4368,7 +4368,7 @@ package body Sprint is
Write_Str ("mod "); Write_Str ("mod ");
Write_Uint_With_Col_Check (Modulus (Typ), Auto); Write_Uint_With_Col_Check (Modulus (Typ), Auto);
-- Floating point types and subtypes -- Floating-point types and subtypes
when E_Floating_Point_Subtype when E_Floating_Point_Subtype
| E_Floating_Point_Type | E_Floating_Point_Type
...@@ -4379,9 +4379,9 @@ package body Sprint is ...@@ -4379,9 +4379,9 @@ package body Sprint is
Write_Str ("new "); Write_Str ("new ");
end if; 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_Str (" digits ");
Write_Uint_With_Col_Check Write_Uint_With_Col_Check
(Digits_Value (Typ), Decimal); (Digits_Value (Typ), Decimal);
...@@ -4392,27 +4392,54 @@ package body Sprint is ...@@ -4392,27 +4392,54 @@ package body Sprint is
declare declare
L : constant Node_Id := Type_Low_Bound (Typ); L : constant Node_Id := Type_Low_Bound (Typ);
H : constant Node_Id := Type_High_Bound (Typ); H : constant Node_Id := Type_High_Bound (Typ);
LE : constant Node_Id := Type_Low_Bound (B); BL : constant Node_Id := Type_Low_Bound (B);
HE : constant Node_Id := Type_High_Bound (B); BH : constant Node_Id := Type_High_Bound (B);
begin 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 (H) = N_Real_Literal
and then Nkind (LE) = N_Real_Literal and then Nkind (BL) = N_Real_Literal
and then Nkind (HE) = N_Real_Literal and then Nkind (BH) = N_Real_Literal
and then UR_Eq (Realval (L), Realval (LE)) and then UR_Eq (Realval (L), Realval (BL))
and then UR_Eq (Realval (H), Realval (HE)) and then UR_Eq (Realval (H), Realval (BH))
then then
null; null;
else else
Write_Str (" range "); Write_Str (" range ");
Sprint_Node (Type_Low_Bound (Typ)); Sprint_Node (L);
Write_Str (" .. "); Write_Str (" .. ");
Sprint_Node (Type_High_Bound (Typ)); Sprint_Node (H);
end if; end if;
end; 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 -- Record subtypes
when E_Record_Subtype when E_Record_Subtype
...@@ -4493,16 +4520,16 @@ package body Sprint is ...@@ -4493,16 +4520,16 @@ package body Sprint is
when E_String_Literal_Subtype => when E_String_Literal_Subtype =>
declare declare
LB : constant Uint := L : constant Uint :=
Expr_Value (String_Literal_Low_Bound (Typ)); Expr_Value (String_Literal_Low_Bound (Typ));
Len : constant Uint := Len : constant Uint :=
String_Literal_Length (Typ); String_Literal_Length (Typ);
begin begin
Write_Header (False); Write_Header (False);
Write_Str ("String ("); Write_Str ("String (");
Write_Int (UI_To_Int (LB)); Write_Int (UI_To_Int (L));
Write_Str (" .. "); Write_Str (" .. ");
Write_Int (UI_To_Int (LB + Len) - 1); Write_Int (UI_To_Int (L + Len) - 1);
Write_Str (");"); Write_Str (");");
end; 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