===================================================================
@@ -1837,7 +1837,17 @@
-- Start of processing for Replace_Actual_Discriminants
begin
- if not Expander_Active then
+ if Expander_Active then
+ null;
+
+ -- Allow the replacement of concurrent discriminants in GNATprove even
+ -- though this is a light expansion activity. Note that generic units
+ -- are not modified.
+
+ elsif GNATprove_Mode and not Inside_A_Generic then
+ null;
+
+ else
return;
end if;
@@ -1848,9 +1858,7 @@
Tsk := Prefix (Prefix (Name (N)));
end if;
- if No (Tsk) then
- return;
- else
+ if Present (Tsk) then
Replace_Discrs (Default);
end if;
end Replace_Actual_Discriminants;
@@ -3561,6 +3569,7 @@
Rewrite (Actval,
Make_Raise_Constraint_Error (Loc,
Reason => CE_Range_Check_Failed));
+
Set_Raises_Constraint_Error (Actval);
Set_Etype (Actval, Etype (F));
end if;
@@ -3568,12 +3577,12 @@
Assoc :=
Make_Parameter_Association (Loc,
Explicit_Actual_Parameter => Actval,
- Selector_Name => Make_Identifier (Loc, Chars (F)));
+ Selector_Name => Make_Identifier (Loc, Chars (F)));
-- Case of insertion is first named actual
- if No (Prev) or else
- Nkind (Parent (Prev)) /= N_Parameter_Association
+ if No (Prev)
+ or else Nkind (Parent (Prev)) /= N_Parameter_Association
then
Set_Next_Named_Actual (Assoc, First_Named_Actual (N));
Set_First_Named_Actual (N, Actval);
@@ -7474,13 +7483,10 @@
Index := First (Expressions (Entry_Name));
Resolve (Index, Entry_Index_Type (Nam));
- -- Generate a reference for the index entity when the index is not a
- -- literal.
+ -- Generate a reference for the index when it denotes an entity
- if Nkind (Index) in N_Has_Entity
- and then Nkind (Entity (Index)) in N_Entity
- then
- Generate_Reference (Entity (Index), Nam, ' ');
+ if Is_Entity_Name (Index) then
+ Generate_Reference (Entity (Index), Nam);
end if;
-- Up to this point the expression could have been the actual in a
This patch modifies resolution to perform minor expansion for SPARK in order to properly qualify concurrent discriminants used as defaulted actuals in calls. ------------ -- Source -- ------------ -- p.ads package P is protected type PT (D : Integer) is procedure Dummy (Arg : Integer := D); end; PO : PT (0); end P; -- main.adb with P; procedure Main is begin P.PO.Dummy; end Main; ---------------------------- -- Compilation and output -- ---------------------------- $ gcc -c -gnatdg -gnatd.F main.adb with p; with system; procedure main is begin p.po.dummy (arg => p.po.d); end main; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-25 Hristian Kirtchev <kirtchev@adacore.com> * sem_res.adb (Replace_Actual_Discriminants): Replace a discriminant for GNATprove. (Resolve_Entry): Clean up predicate