Commit 4b342b91 by Robert Dewar Committed by Arnaud Charlet

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