Commit 3e720c96 by Hristian Kirtchev Committed by Arnaud Charlet

exp_util.adb, [...]: Minor reformatting.

2017-09-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb, einfo.adb, sem_attr.adb, exp_ch4.adb, gnatls.adb,
	exp_ch3.adb, xoscons.adb: Minor reformatting.

From-SVN: r251758
parent f8159014
2017-09-06 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb, einfo.adb, sem_attr.adb, exp_ch4.adb, gnatls.adb,
exp_ch3.adb, xoscons.adb: Minor reformatting.
2017-09-06 Raphael Amiard <amiard@adacore.com>
* a-chtgop.ads, a-chtgop.adb: Add versions of First and Next with
......
......@@ -7132,7 +7132,7 @@ package body Einfo is
loop
if Nkind_In (P, N_Selected_Component, N_Expanded_Name)
or else (Nkind (P) = N_Defining_Program_Unit_Name
and then Is_Child_Unit (Id))
and then Is_Child_Unit (Id))
then
P := Parent (P);
else
......
......@@ -7556,12 +7556,12 @@ package body Exp_Ch3 is
-- Do not generate invariant procedure within other assertion
-- subprograms, which may involve local declarations of local
-- subtypes to which these checks don't apply.
-- subtypes to which these checks do not apply.
elsif Has_Invariants (Def_Id) then
if Within_Internal_Subprogram
or else (Ekind (Current_Scope) = E_Function
and then Is_Predicate_Function (Current_Scope))
or else (Ekind (Current_Scope) = E_Function
and then Is_Predicate_Function (Current_Scope))
then
null;
else
......
......@@ -4061,6 +4061,7 @@ package body Exp_Ch4 is
New_Copy_Tree (Right_Opnd (N))));
Set_Left_Opnd (Mod_Expr,
Unchecked_Convert_To (Standard_Integer, Op_Expr));
else
Set_Left_Opnd (Op_Expr,
Unchecked_Convert_To (Standard_Integer,
......@@ -4157,6 +4158,7 @@ package body Exp_Ch4 is
Expand_Modular_Subtraction;
when N_Op_Minus =>
-- Expand -expr into (0 - expr)
Rewrite (N,
......
......@@ -823,6 +823,7 @@ package body Exp_Util is
Flag_Id : constant Entity_Id := Make_Temporary (Loc, 'F');
Flag_Expr : Node_Id;
Param : Node_Id;
Pref : Node_Id;
Temp : Node_Id;
begin
......@@ -877,19 +878,17 @@ package body Exp_Util is
-- in the code that follows.
else
if
Nkind (Parent (Temp)) = N_Unchecked_Type_Conversion
Pref := Temp;
if Nkind (Parent (Pref)) = N_Unchecked_Type_Conversion
then
Param :=
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Parent (Temp)),
Attribute_Name => Name_Tag);
else
Param :=
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Temp),
Attribute_Name => Name_Tag);
Pref := Parent (Pref);
end if;
Param :=
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Pref),
Attribute_Name => Name_Tag);
end if;
-- Generate:
......
......@@ -1232,7 +1232,7 @@ procedure Gnatls is
Uninitialized_Prefix : constant String := '#' & Path_Separator;
-- Prefix to indicate that the project path has not been initialized
-- yet. Must be two characters long
-- yet. Must be two characters long.
---------------------
-- Add_Directories --
......@@ -1244,6 +1244,7 @@ procedure Gnatls is
Prepend : Boolean := False)
is
Tmp : String_Access;
begin
if Self = null then
Self := new String'(Uninitialized_Prefix & Path);
......@@ -1256,7 +1257,6 @@ procedure Gnatls is
end if;
Free (Tmp);
end if;
end Add_Directories;
-------------------------------------
......@@ -1306,6 +1306,7 @@ procedure Gnatls is
else
(1 => Directory_Separator));
-- Note: Target_Name has a trailing / when it comes from Sdefault
begin
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all & Target_Name & Extra_Sep & Suffix);
......@@ -1315,15 +1316,15 @@ procedure Gnatls is
begin
if Self /= null
and then (Self'Length = 0
and then (Self'Length = 0
or else Self (Self'First) /= '#')
then
return;
end if;
-- The current directory is always first in the search path. Since
-- the Project_Path currently starts with '#:' as a sign that it
-- isn't initialized, we simply replace '#' with '.'
-- the Project_Path currently starts with '#:' as a sign that it is
-- not initialized, we simply replace '#' with '.'
if Self = null then
Self := new String'('.' & Path_Separator);
......@@ -1342,12 +1343,12 @@ procedure Gnatls is
Ada_Prj_Path := Getenv (Ada_Project_Path);
if Gpr_Prj_Path_File.all /= "" then
FD := Open_Read (Gpr_Prj_Path_File.all, GNAT.OS_Lib.Text);
if FD = Invalid_FD then
Osint.Fail ("warning: could not read project path file """ &
Gpr_Prj_Path_File.all & """");
Osint.Fail
("warning: could not read project path file """
& Gpr_Prj_Path_File.all & """");
end if;
Len := Integer (File_Length (FD));
......@@ -1448,8 +1449,7 @@ procedure Gnatls is
Add_Default_Dir := False;
for J in Last + 1 .. Name_Len loop
Name_Buffer (J - 2) :=
Name_Buffer (J);
Name_Buffer (J - 2) := Name_Buffer (J);
end loop;
Name_Len := Name_Len - 2;
......@@ -1515,11 +1515,13 @@ procedure Gnatls is
if Base_Name (Runtime_Name) = Runtime_Name then
-- $prefix/$target/$runtime/lib/gnat
Add_Target
(Runtime_Name & Directory_Separator &
"lib" & Directory_Separator & "gnat");
-- $prefix/$target/$runtime/share/gpr
Add_Target
(Runtime_Name & Directory_Separator &
"share" & Directory_Separator & "gpr");
......@@ -1529,11 +1531,13 @@ procedure Gnatls is
new String'(Normalize_Pathname (Runtime_Name));
-- $runtime_dir/lib/gnat
Add_Str_To_Name_Buffer
(Path_Separator & Runtime.all & Directory_Separator &
"lib" & Directory_Separator & "gnat");
-- $runtime_dir/share/gpr
Add_Str_To_Name_Buffer
(Path_Separator & Runtime.all & Directory_Separator &
"share" & Directory_Separator & "gpr");
......@@ -1541,10 +1545,12 @@ procedure Gnatls is
end if;
-- $prefix/$target/lib/gnat
Add_Target
("lib" & Directory_Separator & "gnat");
-- $prefix/$target/share/gpr
Add_Target
("share" & Directory_Separator & "gpr");
end if;
......@@ -1589,8 +1595,8 @@ procedure Gnatls is
end if;
else
-- Because we don't want to resolve symbolic links, we cannot
-- use Locate_Regular_File. So, we try each possible path
-- Because we do not want to resolve symbolic links, we cannot
-- use Locate_Regular_File. Instead we try each possible path
-- successively.
First := Self'First;
......
......@@ -3763,6 +3763,7 @@ package body Sem_Attr is
--------------
when Attribute_Enum_Rep =>
-- T'Enum_Rep (X) case
if Present (E1) then
......@@ -3770,14 +3771,15 @@ package body Sem_Attr is
Check_Discrete_Type;
Resolve (E1, P_Base_Type);
-- X'Enum_Rep case. X must be an object or enumeration literal, and
-- X'Enum_Rep case. X must be an object or enumeration literal, and
-- it must be of a discrete type.
elsif not ((Is_Object_Reference (P)
or else (Is_Entity_Name (P)
and then Ekind (Entity (P)) =
E_Enumeration_Literal))
and then Is_Discrete_Type (Etype (P)))
elsif not
((Is_Object_Reference (P)
or else
(Is_Entity_Name (P)
and then Ekind (Entity (P)) = E_Enumeration_Literal))
and then Is_Discrete_Type (Etype (P)))
then
Error_Attr_P ("prefix of % attribute must be discrete object");
end if;
......
......@@ -152,8 +152,8 @@ procedure XOSCons is
-- True if S contains Tmpl_Name, possibly with different casing
function Spaces (Count : Integer) return String;
-- If Count is positive, return a string of Count spaces, else return an
-- empty string.
-- If Count is positive, return a string of Count spaces, else return
-- an empty string.
---------
-- ">" --
......
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