OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

frontend.adb, [...]: Minor reformatting and code clean up.

Browse Source 
2014-07-29  Robert Dewar  <dewar@adacore.com>

	* frontend.adb, inline.adb, sem_util.adb, sem_res.adb,
	prepcomp.ads: Minor reformatting and code clean up.
	* exp_ch6.adb (Expand_Actuals): Generate predicate test
	unconditionally for case of OUT or IN OUT actual (before this
	was generated only for certain subcases, which is wrong, the
	test is always needed).

From-SVN: r213208
This commit is contained in:
Robert Dewar 2014-07-29 14:59:26 +00:00 committed by Arnaud Charlet
parent 1c4ff014fe
commit fc27e20e72
7 changed files with 109 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/ada/ChangeLog
View File

@ -1,3 +1,12 @@
2014-07-29 Robert Dewar <dewar@adacore.com>
* frontend.adb, inline.adb, sem_util.adb, sem_res.adb,
prepcomp.ads: Minor reformatting and code clean up.
* exp_ch6.adb (Expand_Actuals): Generate predicate test
unconditionally for case of OUT or IN OUT actual (before this
was generated only for certain subcases, which is wrong, the
test is always needed).
2014-07-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb: Move Has_Defaulted_Discriminants to sem_util.

21
gcc/ada/exp_ch6.adb
View File

@ -1743,10 +1743,6 @@ package body Exp_Ch6 is
-- be handled separately because the name does not denote an
-- overloadable entity.
-- If the formal is class-wide the corresponding postcondition
-- procedure does not include a predicate call, so it has to be
-- generated explicitly.
if not Is_Init_Proc (Subp)
and then (Has_Aspect (E_Actual, Aspect_Predicate)
or else
@ -1755,21 +1751,8 @@ package body Exp_Ch6 is
Has_Aspect (E_Actual, Aspect_Static_Predicate))
and then Present (Predicate_Function (E_Actual))
then
if Is_Entity_Name (Actual)
or else
(Is_Derived_Type (E_Actual)
and then Is_Overloadable (Subp)
and then Is_Inherited_Operation_For_Type (Subp, E_Actual))
then
Append_To (Post_Call,
Make_Predicate_Check (E_Actual, Actual));
elsif Is_Class_Wide_Type (E_Formal)
and then not Is_Class_Wide_Type (E_Actual)
then
Append_To (Post_Call,
Make_Predicate_Check (E_Actual, Actual));
end if;
Append_To (Post_Call,
Make_Predicate_Check (E_Actual, Actual));
end if;
-- Processing for IN parameters

88
gcc/ada/frontend.adb
View File

@ -71,6 +71,39 @@ procedure Frontend is
Config_Pragmas : List_Id;
-- Gather configuration pragmas
function Need_To_Be_In_The_Dependencies (Pragma_List : List_Id)
return Boolean;
-- Check if a configuration pragmas file that contains the Pragma_List
-- should be a dependency for the source being compiled. Returns
-- False if Pragma_List is Error_List or contains only pragmas
-- Source_File_Name_Project, returns True otherwise.
------------------------------------
-- Need_To_Be_In_The_Dependencies --
------------------------------------
function Need_To_Be_In_The_Dependencies (Pragma_List : List_Id)
return Boolean
is
Prag : Node_Id;
Pname : Name_Id;
begin
if Pragma_List /= Error_List then
Prag := First (Pragma_List);
while Present (Prag) loop
Pname := Pragma_Name (Prag);
if Pname /= Name_Source_File_Name_Project then
return True;
end if;
Next (Prag);
end loop;
end if;
return False;
end Need_To_Be_In_The_Dependencies;
begin
-- Carry out package initializations. These are initializations which might
-- logically be performed at elaboration time, were it not for the fact
@ -144,8 +177,6 @@ begin
Prag : Node_Id;
Temp_File : Boolean;
begin
-- We always analyze config files with style checks off, since
-- we don't want a miscellaneous gnat.adc that is around to
@ -166,10 +197,23 @@ begin
Name_Len := 8;
Source_gnat_adc := Load_Config_File (Name_Enter);
-- Case of gnat.adc file present
if Source_gnat_adc /= No_Source_File then
-- Parse the gnat.adc file for configuration pragmas
Initialize_Scanner (No_Unit, Source_gnat_adc);
Config_Pragmas := Par (Configuration_Pragmas => True);
-- We unconditionally add a compilation dependency for gnat.adc
-- so that if it changes, we force a recompilation. This is a
-- fairly recent (2014-03-28) change.
Prepcomp.Add_Dependency (Source_gnat_adc);
-- Case of no gnat.adc file present
else
Config_Pragmas := Empty_List;
end if;
@ -196,15 +240,17 @@ begin
-- Now deal with specified config pragmas files if there are any
if Opt.Config_File_Names /= null then
-- Loop through config pragmas files
for Index in Opt.Config_File_Names'Range loop
-- See if extension is .TMP/.tmp indicating a temporary config
-- file (which we ignore from the dependency point of view).
Name_Len := Config_File_Names (Index)'Length;
Name_Buffer (1 .. Name_Len) := Config_File_Names (Index).all;
Temp_File :=
Name_Len > 4
and then
(Name_Buffer (Name_Len - 3 .. Name_Len) = ".TMP"
or else
Name_Buffer (Name_Len - 3 .. Name_Len) = ".tmp");
-- Load the file, error if we did not find it
Source_Config_File := Load_Config_File (Name_Enter);
@ -213,13 +259,29 @@ begin
("cannot find configuration pragmas file "
& Config_File_Names (Index).all);
elsif not Temp_File then
Prepcomp.Add_Dependency (Source_Config_File);
-- If we did find the file, and it contains pragmas other than
-- Source_File_Name_Project, then we unconditionally add a
-- compilation dependency for it so that if it changes, we force
-- a recompilation. This is a fairly recent (2014-03-28) change.
else
-- Parse the config pragmas file, and accumulate results
Initialize_Scanner (No_Unit, Source_Config_File);
declare
Pragma_List : constant List_Id :=
Par (Configuration_Pragmas => True);
begin
if Need_To_Be_In_The_Dependencies (Pragma_List) then
Prepcomp.Add_Dependency (Source_Config_File);
end if;
Append_List_To (Config_Pragmas, Pragma_List);
end;
end if;
Initialize_Scanner (No_Unit, Source_Config_File);
Append_List_To
(Config_Pragmas, Par (Configuration_Pragmas => True));
end loop;
end if;

16
gcc/ada/inline.adb
View File

@ -1499,12 +1499,12 @@ package body Inline is
--------------------------
function In_Some_Private_Part (N : Node_Id) return Boolean is
P : Node_Id := N;
P : Node_Id;
PP : Node_Id;
begin
while Present (P)
and then Present (Parent (P))
loop
P := N;
while Present (P) and then Present (Parent (P)) loop
PP := Parent (P);
if Nkind (PP) = N_Package_Specification
@ -1515,6 +1515,7 @@ package body Inline is
P := PP;
end loop;
return False;
end In_Some_Private_Part;
@ -1541,6 +1542,8 @@ package body Inline is
return Nkind (Original_Node (Decl)) = N_Expression_Function;
end Is_Expression_Function;
-- Local declarations
Id : Entity_Id; -- Procedure or function entity for the subprogram
-- Start of Can_Be_Inlined_In_GNATprove_Mode
@ -2162,9 +2165,10 @@ package body Inline is
or else Has_Pragma_Inline_Always (Spec_Id)
or else (Has_Pragma_Inline (Spec_Id)
and then ((Optimization_Level > 0
and then Ekind (Spec_Id)
= E_Function)
and then Ekind (Spec_Id) =
E_Function)
or else Front_End_Inlining));
Body_To_Analyze : Node_Id;
-- Start of processing for Check_Body_To_Inline

7
gcc/ada/prepcomp.ads
View File

@ -31,10 +31,9 @@ with Types; use Types;
package Prepcomp is
procedure Add_Dependency (S : Source_File_Index);
-- Add a dependency on a non-source file.
-- This is used internally for the preprocessing data file and the
-- preprocessing definition file, and also externally for non-temporary
-- configuration pragmas files.
-- Add a dependency on a non-source file. This is used internally for the
-- preprocessing data file and the preprocessing definition file, and also
-- externally for non-temporary configuration pragmas files.
procedure Add_Dependencies;
-- Add dependencies on the preprocessing data file and the preprocessing

16
gcc/ada/sem_res.adb
View File

@ -2978,7 +2978,7 @@ package body Sem_Res is
procedure Check_Aliased_Parameter;
-- Check rules on aliased parameters and related accessibility rules
-- in (3.10.2 (10.2-10.4)).
-- in (RM 3.10.2 (10.2-10.4)).
procedure Check_Argument_Order;
-- Performs a check for the case where the actuals are all simple
@ -3050,12 +3050,12 @@ package body Sem_Res is
else
Error_Msg_NE ("untagged actual does not match "
& "aliased formal&", A, F);
& "aliased formal&", A, F);
end if;
else
Error_Msg_NE ("actual for aliased formal& must be "
& "aliased object", A, F);
& "aliased object", A, F);
end if;
if Ekind (Nam) = E_Procedure then
@ -3063,19 +3063,19 @@ package body Sem_Res is
elsif Ekind (Etype (Nam)) = E_Anonymous_Access_Type then
if Nkind (Parent (N)) = N_Type_Conversion
and then Type_Access_Level (Etype (Parent (N)))
< Object_Access_Level (A)
and then Type_Access_Level (Etype (Parent (N))) <
Object_Access_Level (A)
then
Error_Msg_N ("aliased actual has wrong accessibility", A);
end if;
elsif Nkind (Parent (N)) = N_Qualified_Expression
and then Nkind (Parent (Parent (N))) = N_Allocator
and then Type_Access_Level (Etype (Parent (Parent (N))))
< Object_Access_Level (A)
and then Type_Access_Level (Etype (Parent (Parent (N)))) <
Object_Access_Level (A)
then
Error_Msg_N
("Aliased actual in allocator has wrong accessibility", A);
("aliased actual in allocator has wrong accessibility", A);
end if;
end if;
end Check_Aliased_Parameter;

4
gcc/ada/sem_util.adb
View File

@ -7345,8 +7345,8 @@ package body Sem_Util is
begin
return Has_Discriminants (Typ)
and then Present (First_Discriminant (Typ))
and then Present
(Discriminant_Default_Value (First_Discriminant (Typ)));
and then Present (Discriminant_Default_Value
(First_Discriminant (Typ)));
end Has_Defaulted_Discriminants;
-------------------