+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.
-- 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
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
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
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
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;
-- 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);
("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;
--------------------------
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
P := PP;
end loop;
+
return False;
end In_Some_Private_Part;
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
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
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
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
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
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;
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;
-------------------
git://gcc.gnu.org / gcc.git / commitdiff