Mercurial > hg > CbC > CbC_gcc
diff gcc/ada/sprint.adb @ 145:1830386684a0
gcc-9.2.0
| author | anatofuz |
|---|---|
| date | Thu, 13 Feb 2020 11:34:05 +0900 |
| parents | 84e7813d76e9 |
| children |
line wrap: on
line diff
--- a/gcc/ada/sprint.adb Thu Oct 25 07:37:49 2018 +0900 +++ b/gcc/ada/sprint.adb Thu Feb 13 11:34:05 2020 +0900 @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -660,7 +660,7 @@ Write_Source_Lines (Last_Source_Line (Current_Source_File)); Write_Eol; Close_Debug_Source; - Set_Special_Output (null); + Cancel_Special_Output; -- Normal output to standard output file @@ -1483,9 +1483,9 @@ 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 @@ 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 @@ -- 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 @@ 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 @@ -- 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 @@ 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 @@ Write_Str ("new "); end if; - Write_Id (Etype (Typ)); - - if Digits_Value (Typ) /= Digits_Value (Etype (Typ)) then + Write_Id (B); + + if Digits_Value (Typ) /= Digits_Value (B) then Write_Str (" digits "); Write_Uint_With_Col_Check (Digits_Value (Typ), Decimal); @@ -4392,27 +4392,54 @@ 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 @@ 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;