Ongoing work to implement AI05-0144. No test needed.
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-01-03 Javier Miranda <mira...@adacore.com>
* sem_warn.adb (Warn_On_Overlapping_Actuals): Adding documentation
plus restricting the functionality of this routine to cover the
cases described in the Ada 2012 reference manual. The previous
extended support is now available under -gnatX.
* s-tassta.adb (Finalize_Global_Tasks): Addition of a dummy
variable to call Timed_Sleep. Required to avoid warning on
overlapping out-mode actuals.
* opt.ads (Extensions_Allowed): Update documentation.
Index: s-tassta.adb
===================================================================
--- s-tassta.adb (revision 194841)
+++ s-tassta.adb (working copy)
@@ -806,8 +806,9 @@
procedure Finalize_Global_Tasks is
Self_ID : constant Task_Id := STPO.Self;
- Ignore : Boolean;
- pragma Unreferenced (Ignore);
+ Ignore_1 : Boolean;
+ Ignore_2 : Boolean;
+ pragma Unreferenced (Ignore_1, Ignore_2);
function State
(Int : System.Interrupt_Management.Interrupt_ID) return Character;
@@ -877,7 +878,7 @@
Timed_Sleep
(Self_ID, 0.01, System.OS_Primitives.Relative,
- Self_ID.Common.State, Ignore, Ignore);
+ Self_ID.Common.State, Ignore_1, Ignore_2);
end loop;
end if;
@@ -886,7 +887,7 @@
Timed_Sleep
(Self_ID, 0.01, System.OS_Primitives.Relative,
- Self_ID.Common.State, Ignore, Ignore);
+ Self_ID.Common.State, Ignore_1, Ignore_2);
Unlock (Self_ID);
Index: sem_warn.adb
===================================================================
--- sem_warn.adb (revision 194841)
+++ sem_warn.adb (working copy)
@@ -3292,41 +3292,89 @@
Act1, Act2 : Node_Id;
Form1, Form2 : Entity_Id;
+ function Is_Covered_Formal (Formal : Node_Id) return Boolean;
+ -- Return True if Formal is covered by the Ada 2012 rule. Under -gnatX
+ -- the rule is extended to cover record and array types.
+
+ function Refer_Same_Object (Act1, Act2 : Node_Id) return Boolean;
+ -- Two names are known to refer to the same object if the two names
+ -- are known to denote the same object; or one of the names is a
+ -- selected_component, indexed_component, or slice and its prefix is
+ -- known to refer to the same object as the other name; or one of the
+ -- two names statically denotes a renaming declaration whose renamed
+ -- object_name is known to refer to the same object as the other name
+ -- (RM 6.4.1(6.11/3))
+
+ -----------------------
+ -- Refer_Same_Object --
+ -----------------------
+
+ function Refer_Same_Object (Act1, Act2 : Node_Id) return Boolean is
+ begin
+ return Denotes_Same_Object (Act1, Act2)
+ or else Denotes_Same_Prefix (Act1, Act2);
+ end Refer_Same_Object;
+
+ -----------------------
+ -- Is_Covered_Formal --
+ -----------------------
+
+ function Is_Covered_Formal (Formal : Node_Id) return Boolean is
+ begin
+ -- Ada 2012 rule
+
+ if not Extensions_Allowed then
+ return
+ Ekind_In (Formal, E_Out_Parameter,
+ E_In_Out_Parameter)
+ and then Is_Elementary_Type (Etype (Formal));
+
+ -- Under -gnatX the rule is extended to cover array and record types
+
+ else
+ return
+ Ekind_In (Formal, E_Out_Parameter,
+ E_In_Out_Parameter)
+ and then (Is_Elementary_Type (Etype (Formal))
+ or else Is_Record_Type (Etype (Formal))
+ or else Is_Array_Type (Etype (Formal)));
+ end if;
+ end Is_Covered_Formal;
+
begin
- if not Warn_On_Overlap then
+ if Ada_Version < Ada_2012 and then not Warn_On_Overlap then
return;
end if;
-- Exclude calls rewritten as enumeration literals
- if Nkind (N) not in N_Subprogram_Call then
+ if Nkind (N) not in N_Subprogram_Call
+ and then Nkind (N) /= N_Entry_Call_Statement
+ then
return;
end if;
- -- Exclude calls to library subprograms. Container operations specify
- -- safe behavior when source and target coincide.
+ -- If a call C has two or more parameters of mode in out or out that are
+ -- of an elementary type, then the call is legal only if for each name
+ -- N that is passed as a parameter of mode in out or out to the call C,
+ -- there is no other name among the other parameters of mode in out or
+ -- out to C that is known to denote the same object (RM 6.4.1(6.15/3))
- if Is_Predefined_File_Name
- (Unit_File_Name (Get_Source_Unit (Sloc (Subp))))
- then
- return;
- end if;
+ -- Under -gnatX the rule is extended to cover array and record types.
Form1 := First_Formal (Subp);
Act1 := First_Actual (N);
while Present (Form1) and then Present (Act1) loop
- if Ekind (Form1) /= E_In_Parameter then
+
+ if Is_Covered_Formal (Form1) then
Form2 := First_Formal (Subp);
Act2 := First_Actual (N);
while Present (Form2) and then Present (Act2) loop
if Form1 /= Form2
- and then Ekind (Form2) /= E_Out_Parameter
- and then
- (Denotes_Same_Object (Act1, Act2)
- or else
- Denotes_Same_Prefix (Act1, Act2))
+ and then Is_Covered_Formal (Form2)
+ and then Refer_Same_Object (Act1, Act2)
then
- -- Exclude generic types and guard against previous errors
+ -- Guard against previous errors
if Error_Posted (N)
or else No (Etype (Act1))
@@ -3334,15 +3382,9 @@
then
null;
- elsif Is_Generic_Type (Etype (Act1))
- or else
- Is_Generic_Type (Etype (Act2))
- then
- null;
+ -- If the actual is a function call in prefix notation,
+ -- there is no real overlap.
- -- If the actual is a function call in prefix notation,
- -- there is no real overlap.
-
elsif Nkind (Act2) = N_Function_Call then
null;
@@ -3350,11 +3392,20 @@
-- intended.
elsif
- Is_By_Reference_Type (Underlying_Type (Etype (Form1)))
+ Present (Underlying_Type (Etype (Form1)))
+ and then
+ (Is_By_Reference_Type (Underlying_Type (Etype (Form1)))
+ or else
+ Convention (Underlying_Type (Etype (Form1)))
+ = Convention_Ada_Pass_By_Reference)
then
null;
+ -- Here we may need to issue message
+
else
+ Error_Msg_Warn := Ada_Version < Ada_2012;
+
declare
Act : Node_Id;
Form : Entity_Id;
Index: opt.ads
===================================================================
--- opt.ads (revision 194841)
+++ opt.ads (working copy)
@@ -563,7 +563,7 @@
Extensions_Allowed : Boolean := False;
-- GNAT
-- Set to True by switch -gnatX if GNAT specific language extensions
- -- are allowed. Currently there are no such defined extensions.
+ -- are allowed.
type External_Casing_Type is (
As_Is, -- External names cased as they appear in the Ada source
