Mercurial > hg > CbC > CbC_gcc
diff gcc/ada/pprint.adb @ 131:84e7813d76e9
gcc-8.2
author | mir3636 |
---|---|
date | Thu, 25 Oct 2018 07:37:49 +0900 |
parents | 04ced10e8804 |
children | 1830386684a0 |
line wrap: on
line diff
--- a/gcc/ada/pprint.adb Fri Oct 27 22:46:09 2017 +0900 +++ b/gcc/ada/pprint.adb Thu Oct 25 07:37:49 2018 +0900 @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2008-2017, Free Software Foundation, Inc. -- +-- Copyright (C) 2008-2018, 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- -- @@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ with Atree; use Atree; +with Csets; use Csets; with Einfo; use Einfo; with Namet; use Namet; with Nlists; use Nlists; @@ -50,7 +51,7 @@ From_Source : constant Boolean := Comes_From_Source (Expr) and then not Opt.Debug_Generated_Code; - Append_Paren : Boolean := False; + Append_Paren : Natural := 0; Left : Node_Id := Original_Node (Expr); Right : Node_Id := Original_Node (Expr); @@ -212,8 +213,7 @@ when N_Character_Literal => declare - Char : constant Int := - UI_To_Int (Char_Literal_Value (Expr)); + Char : constant Int := UI_To_Int (Char_Literal_Value (Expr)); begin if Char in 32 .. 127 then return "'" & Character'Val (Char) & "'"; @@ -272,11 +272,43 @@ when N_Attribute_Reference => if Take_Prefix then declare - Id : constant Attribute_Id := - Get_Attribute_Id (Attribute_Name (Expr)); - Str : constant String := - Expr_Name (Prefix (Expr)) & "'" - & Get_Name_String (Attribute_Name (Expr)); + function To_Mixed_Case (S : String) return String; + -- Transform given string into the corresponding one in + -- mixed case form. + + ------------------- + -- To_Mixed_Case -- + ------------------- + + function To_Mixed_Case (S : String) return String is + Result : String (S'Range); + Ucase : Boolean := True; + + begin + for J in S'Range loop + if Ucase then + Result (J) := Fold_Upper (S (J)); + else + Result (J) := Fold_Lower (S (J)); + end if; + + Ucase := (S (J) = '_'); + end loop; + + return Result; + end To_Mixed_Case; + + Id : constant Attribute_Id := + Get_Attribute_Id (Attribute_Name (Expr)); + + -- Always use mixed case for attributes + + Str : constant String := + Expr_Name (Prefix (Expr)) + & "'" + & To_Mixed_Case + (Get_Name_String (Attribute_Name (Expr))); + N : Node_Id; Ranges : List_Id; @@ -699,7 +731,9 @@ when N_Range => Left := Original_Node (Low_Bound (Left)); - when N_Type_Conversion => + when N_Qualified_Expression + | N_Type_Conversion + => Left := Original_Node (Subtype_Mark (Left)); -- For any other item, quit loop @@ -723,6 +757,20 @@ => Right := Original_Node (Selector_Name (Right)); + when N_Qualified_Expression + | N_Type_Conversion + => + Right := Original_Node (Expression (Right)); + + -- If argument does not already account for a closing + -- parenthesis, count one here. + + if not Nkind_In (Right, N_Aggregate, + N_Quantified_Expression) + then + Append_Paren := Append_Paren + 1; + end if; + when N_Designator => Right := Original_Node (Identifier (Right)); @@ -735,9 +783,16 @@ when N_Parameter_Association => Right := Original_Node (Explicit_Actual_Parameter (Right)); + when N_Component_Association => + if Present (Expression (Right)) then + Right := Expression (Right); + else + Right := Last (Choices (Right)); + end if; + when N_Indexed_Component => Right := Original_Node (Last (Sinfo.Expressions (Right))); - Append_Paren := True; + Append_Paren := Append_Paren + 1; when N_Function_Call => if Present (Sinfo.Parameter_Associations (Right)) then @@ -754,13 +809,16 @@ while Present (Rover) loop if Comes_From_Source (Original_Node (Rover)) then Right := Original_Node (Rover); - Append_Paren := True; Found := True; end if; Next (Rover); end loop; + if Found then + Append_Paren := Append_Paren + 1; + end if; + -- Quit loop if no Comes_From_Source parameters exit when not Found; @@ -773,7 +831,37 @@ end if; when N_Quantified_Expression => - Right := Original_Node (Condition (Right)); + Right := Original_Node (Condition (Right)); + Append_Paren := Append_Paren + 1; + + when N_Aggregate => + declare + Aggr : constant Node_Id := Right; + Sub : Node_Id; + + begin + Sub := First (Expressions (Aggr)); + while Present (Sub) loop + if Sloc (Sub) > Sloc (Right) then + Right := Sub; + end if; + + Next (Sub); + end loop; + + Sub := First (Component_Associations (Aggr)); + while Present (Sub) loop + if Sloc (Sub) > Sloc (Right) then + Right := Sub; + end if; + + Next (Sub); + end loop; + + exit when Right = Aggr; + + Append_Paren := Append_Paren + 1; + end; -- For all other items, quit the loop @@ -795,6 +883,7 @@ end if; declare + Threshold : constant := 256; Buffer : String (1 .. Natural (End_Sloc - Scn)); Index : Natural := 0; Skipping_Comment : Boolean := False; @@ -804,6 +893,15 @@ if Right /= Expr then while Scn < End_Sloc loop case Src (Scn) is + + -- Give up on non ASCII characters + + when Character'Val (128) .. Character'Last => + Append_Paren := 0; + Index := 0; + Right := Expr; + exit; + when ' ' | ASCII.HT => @@ -838,6 +936,12 @@ end if; end case; + -- Give up on too long strings + + if Index >= Threshold then + return Buffer (1 .. Index) & "..."; + end if; + Scn := Scn + 1; end loop; end if; @@ -853,11 +957,11 @@ end if; end; - elsif Append_Paren then - return Buffer (1 .. Index) & Expr_Name (Right, False) & ')'; - else - return Buffer (1 .. Index) & Expr_Name (Right, False); + return + Buffer (1 .. Index) + & Expr_Name (Right, False) + & (1 .. Append_Paren => ')'); end if; end; end;