Skip to content

R
riscv-gcc-1
Commit 4b342b91 by Robert Dewar Committed by Arnaud Charlet
Options

einfo.ads, [...]: Minor reformatting. 

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* einfo.ads, sem_util.adb, exp_ch6.adb, xgnatugn.adb: Minor
	reformatting.

From-SVN: r197788
parent da1c23dd
Showing with 45 additions and 41 deletions
gcc/ada/ChangeLog
2013-04-11 Robert Dewar <dewar@adacore.com>
* einfo.ads, sem_util.adb, exp_ch6.adb, xgnatugn.adb: Minor
reformatting.
2013-04-11 Doug Rupp <rupp@adacore.com>
* gnatlink.adb: Fold program basename to lower case on VMS for
......
gcc/ada/einfo.ads
......@@ -2843,7 +2843,7 @@ package Einfo is
-- Applies to all entities. True for task types and subtypes
-- Is_Thunk (Flag225)
-- Applies to all entities. True for subprograms that are thunks: that is
-- Defined in all entities. True for subprograms that are thunks: that is
-- small subprograms built by the expander for tagged types that cover
-- interface types. As part of the runtime call to an interface, thunks
-- displace the pointer to the object (pointer named "this" in the C++
......@@ -4831,7 +4831,7 @@ package Einfo is
-- non-synthesized attributes, of the corresponding set procedures) are
-- in the Einfo body.
-- The following attributes apply to all entities
-- The following attributes are defined in all entities
-- Ekind (Ekind)
......@@ -4912,6 +4912,7 @@ package Einfo is
-- Is_Shared_Passive (Flag60)
-- Is_Statically_Allocated (Flag28)
-- Is_Tagged_Type (Flag55)
-- Is_Thunk (Flag225)
-- Is_Trivial_Subprogram (Flag235)
-- Is_Unchecked_Union (Flag117)
-- Is_Visible_Formal (Flag206)
......@@ -5388,7 +5389,6 @@ package Einfo is
-- Is_Private_Descendant (Flag53)
-- Is_Private_Primitive (Flag245) (non-generic case only)
-- Is_Pure (Flag44)
-- Is_Thunk (Flag225)
-- Is_Visible_Lib_Unit (Flag116)
-- Needs_No_Actuals (Flag22)
-- Requires_Overriding (Flag213) (non-generic case only)
......@@ -5513,7 +5513,6 @@ package Einfo is
-- Is_Pure (Flag44)
-- Is_Intrinsic_Subprogram (Flag64)
-- Is_Primitive (Flag218)
-- Is_Thunk (Flag225)
-- Default_Expressions_Processed (Flag108)
-- Aren't there more flags and fields? seems like this list should be
-- more similar to the E_Function list, which is much longer ???
......@@ -5661,7 +5660,6 @@ package Einfo is
-- Is_Private_Descendant (Flag53)
-- Is_Private_Primitive (Flag245) (non-generic case only)
-- Is_Pure (Flag44)
-- Is_Thunk (Flag225)
-- Is_Valued_Procedure (Flag127)
-- Is_Visible_Lib_Unit (Flag116)
-- Needs_No_Actuals (Flag22)
......
gcc/ada/exp_ch6.adb
......@@ -7221,9 +7221,7 @@ package body Exp_Ch6 is
-- the object is returned by reference and the maximum functionality
-- required is just to displace the pointer.
elsif Is_Thunk (Current_Scope)
and then Is_Interface (Exptyp)
then
elsif Is_Thunk (Current_Scope) and then Is_Interface (Exptyp) then
null;
elsif not Requires_Transient_Scope (R_Type) then
......
gcc/ada/sem_util.adb
......@@ -7756,9 +7756,7 @@ package body Sem_Util is
if Compile_Time_Known_Value (Exp) then
return True;
elsif Is_Entity_Name (Exp)
and then Present (Entity (Exp))
then
elsif Is_Entity_Name (Exp) and then Present (Entity (Exp)) then
return Is_Constant_Object (Entity (Exp))
or else Ekind (Entity (Exp)) = E_Enumeration_Literal;
......@@ -9582,11 +9580,10 @@ package body Sem_Util is
return Ekind (Op) = E_Function
and then Is_Intrinsic_Subprogram (Op)
and then
((Present_System_Aux
and then Scope (Op) = System_Aux_Id)
or else
(True_VMS_Target
and then Scope (Scope (Op)) = RTU_Entity (System)));
((Present_System_Aux and then Scope (Op) = System_Aux_Id)
or else
(True_VMS_Target
and then Scope (Scope (Op)) = RTU_Entity (System)));
end Is_VMS_Operator;
-----------------
......
gcc/ada/xgnatugn.adb
......@@ -181,8 +181,7 @@ procedure Xgnatugn is
Target : Target_Type;
-- The Target variable is initialized using the command line
Valid_Characters : constant Character_Set :=
To_Set (Span => (' ', '~'));
Valid_Characters : constant Character_Set := To_Set (Span => (' ', '~'));
-- This array controls which characters are permitted in the input
-- file (after line breaks have been removed). Valid characters
-- are all printable ASCII characters and the space character.
......@@ -190,7 +189,7 @@ procedure Xgnatugn is
Word_Characters : constant Character_Set :=
(To_Set (Ranges =>
(('0', '9'), ('a', 'z'), ('A', 'Z')))
or To_Set ("?-_~"));
or To_Set ("?-_~"));
-- The characters which are permitted in words. Other (valid)
-- characters are assumed to be delimiters between words. Note that
-- this set has to include all characters of the source words of the
......@@ -432,8 +431,9 @@ procedure Xgnatugn is
Trim (Line (1 .. Split - 1), Both);
Target : constant String :=
Trim (Line (Split + 1 .. Line'Last), Both);
Two_Spaces : constant Natural :=
Index (Source, " ");
Two_Spaces : constant Natural := Index (Source, " ");
Non_Word_Character : constant Natural :=
Index (Source,
Word_Characters or
......@@ -469,7 +469,6 @@ procedure Xgnatugn is
declare
Prefix : String renames
Source (Source'First .. J - 1);
begin
if not Is_Known_Word (Prefix) then
Error (Dictionary_File,
......@@ -623,7 +622,7 @@ procedure Xgnatugn is
(VMS_Second_Character + 1, VMS_Third_Character - 1));
return;
end;
end if; -- VMS_Alternative
end if;
-- The Word case. Search for characters not in Word_Characters.
-- We have found a word if the first non-word character is not
......@@ -663,7 +662,7 @@ procedure Xgnatugn is
procedure Rewrite_Word is
First_Word : String
renames Line (Token.Span.First .. Token.Span.Last);
renames Line (Token.Span.First .. Token.Span.Last);
begin
-- We do not perform any error checking below, so we can just skip
......@@ -681,7 +680,7 @@ procedure Xgnatugn is
-- longest possible sequence we can rewrite.
declare
Seq : Token_Span := Token.Span;
Seq : Token_Span := Token.Span;
Lost_Space : Boolean := False;
begin
......@@ -691,23 +690,25 @@ procedure Xgnatugn is
and then Line (Token.Span.First .. Token.Span.Last) = " "
then
Next_Token;
if Token.Kind /= Word
or else not Is_Known_Word (Line (Seq.First
.. Token.Span.Last))
then
-- When we reach this point, the following
-- conditions are true:
--
-- Seq is a known word.
-- The previous token was a space character.
-- Seq extended to the current token is not a
-- known word.
-- When we reach this point, the following conditions
-- are true:
-- Seq is a known word
-- The previous token was a space character
-- Seq extended to the current token is not a
-- known word.
Lost_Space := True;
exit;
else
-- Extend Seq to cover the current (known) word
Seq.Last := Token.Span.Last;
......@@ -717,10 +718,12 @@ procedure Xgnatugn is
else
-- When we reach this point, the following conditions
-- are true:
--
-- Seq is a known word.
-- The previous token was a word.
-- The current token is not a space character.
-- Seq is a known word
-- The previous token was a word
-- The current token is not a space character.
exit;
end if;
......@@ -749,8 +752,8 @@ procedure Xgnatugn is
Next_Token;
if Token.Kind = Word
and then Is_Extension (Line (Token.Span.First
.. Token.Span.Last))
and then
Is_Extension (Line (Token.Span.First .. Token.Span.Last))
then
-- We have discovered a file extension. Convert the file
-- name to upper case.
......@@ -793,6 +796,7 @@ procedure Xgnatugn is
-- Rewrite_Word would have handled it.
Next_Token;
if Token.Kind = Word
and then Is_Extension (Line (Token.Span.First
.. Token.Span.Last))
......@@ -803,6 +807,7 @@ procedure Xgnatugn is
else
Append (Rewritten_Line, '.');
end if;
else
Append (Rewritten_Line, Line (Token.Span.First
.. Token.Span.Last));
......@@ -839,6 +844,7 @@ procedure Xgnatugn is
Append (Rewritten_Line, Line (Token.Non_VMS.First
.. Token.Non_VMS.Last));
end if;
Next_Token;
when VMS_Error =>
......@@ -859,6 +865,7 @@ procedure Xgnatugn is
while not End_Of_File (Source_File.Data) loop
declare
Line : constant String := Get_Line (Source_File'Access);
Rewritten : constant String := Rewrite_Source_Line (Line);
-- We unconditionally rewrite the line so that we can check the
-- syntax of all lines, and not only those which are actually
......@@ -884,8 +891,7 @@ procedure Xgnatugn is
procedure Initialize_Extensions is
procedure Add (Extension : String);
-- Adds an extension which is replaced with itself (in upper
-- case).
-- Adds an extension which is replaced with itself (in upper case)
procedure Add (Extension, Replacement : String);
-- Adds an extension with a custom replacement
......
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