[COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances

[COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

Code cleanup; semantics is unaffected.

gcc/ada/

	* sem_prag.adb (Check_In_Out_States, Check_Input_States,
	Check_Output_States, Check_Proof_In_States,
	Check_Refined_Global_List, Report_Extra_Constituents,
	Report_Missing_Items): Remove multiple checks for being inside
	an instance.
	(Analyze_Refined_Global_In_Decl_Part): Add single check for
	being inside an instance.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_prag.adb | 86 ++++++++++++--------------------------------
 1 file changed, 23 insertions(+), 63 deletions(-)

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index a895fd2053a..86a25dc7d0c 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -28712,16 +28712,10 @@ package body Sem_Prag is
       --  Start of processing for Check_In_Out_States
 
       begin
-         --  Do not perform this check in an instance because it was already
-         --  performed successfully in the generic template.
-
-         if In_Instance then
-            null;
-
          --  Inspect the In_Out items of the corresponding Global pragma
          --  looking for a state with a visible refinement.
 
-         elsif Has_In_Out_State and then Present (In_Out_Items) then
+         if Has_In_Out_State and then Present (In_Out_Items) then
             Item_Elmt := First_Elmt (In_Out_Items);
             while Present (Item_Elmt) loop
                Item_Id := Node (Item_Elmt);
@@ -28821,16 +28815,10 @@ package body Sem_Prag is
       --  Start of processing for Check_Input_States
 
       begin
-         --  Do not perform this check in an instance because it was already
-         --  performed successfully in the generic template.
-
-         if In_Instance then
-            null;
-
          --  Inspect the Input items of the corresponding Global pragma looking
          --  for a state with a visible refinement.
 
-         elsif Has_In_State and then Present (In_Items) then
+         if Has_In_State and then Present (In_Items) then
             Item_Elmt := First_Elmt (In_Items);
             while Present (Item_Elmt) loop
                Item_Id := Node (Item_Elmt);
@@ -28944,16 +28932,10 @@ package body Sem_Prag is
       --  Start of processing for Check_Output_States
 
       begin
-         --  Do not perform this check in an instance because it was already
-         --  performed successfully in the generic template.
-
-         if In_Instance then
-            null;
-
          --  Inspect the Output items of the corresponding Global pragma
          --  looking for a state with a visible refinement.
 
-         elsif Has_Out_State and then Present (Out_Items) then
+         if Has_Out_State and then Present (Out_Items) then
             Item_Elmt := First_Elmt (Out_Items);
             while Present (Item_Elmt) loop
                Item_Id := Node (Item_Elmt);
@@ -29050,16 +29032,10 @@ package body Sem_Prag is
       --  Start of processing for Check_Proof_In_States
 
       begin
-         --  Do not perform this check in an instance because it was already
-         --  performed successfully in the generic template.
-
-         if In_Instance then
-            null;
-
          --  Inspect the Proof_In items of the corresponding Global pragma
          --  looking for a state with a visible refinement.
 
-         elsif Has_Proof_In_State and then Present (Proof_In_Items) then
+         if Has_Proof_In_State and then Present (Proof_In_Items) then
             Item_Elmt := First_Elmt (Proof_In_Items);
             while Present (Item_Elmt) loop
                Item_Id := Node (Item_Elmt);
@@ -29214,13 +29190,7 @@ package body Sem_Prag is
       --  Start of processing for Check_Refined_Global_List
 
       begin
-         --  Do not perform this check in an instance because it was already
-         --  performed successfully in the generic template.
-
-         if In_Instance then
-            null;
-
-         elsif Nkind (List) = N_Null then
+         if Nkind (List) = N_Null then
             null;
 
          --  Single global item declaration
@@ -29465,18 +29435,10 @@ package body Sem_Prag is
       --  Start of processing for Report_Extra_Constituents
 
       begin
-         --  Do not perform this check in an instance because it was already
-         --  performed successfully in the generic template.
-
-         if In_Instance then
-            null;
-
-         else
-            Report_Extra_Constituents_In_List (In_Constits);
-            Report_Extra_Constituents_In_List (In_Out_Constits);
-            Report_Extra_Constituents_In_List (Out_Constits);
-            Report_Extra_Constituents_In_List (Proof_In_Constits);
-         end if;
+         Report_Extra_Constituents_In_List (In_Constits);
+         Report_Extra_Constituents_In_List (In_Out_Constits);
+         Report_Extra_Constituents_In_List (Out_Constits);
+         Report_Extra_Constituents_In_List (Proof_In_Constits);
       end Report_Extra_Constituents;
 
       --------------------------
@@ -29488,21 +29450,13 @@ package body Sem_Prag is
          Item_Id   : Entity_Id;
 
       begin
-         --  Do not perform this check in an instance because it was already
-         --  performed successfully in the generic template.
-
-         if In_Instance then
-            null;
-
-         else
-            if Present (Repeat_Items) then
-               Item_Elmt := First_Elmt (Repeat_Items);
-               while Present (Item_Elmt) loop
-                  Item_Id := Node (Item_Elmt);
-                  SPARK_Msg_NE ("missing global item &", N, Item_Id);
-                  Next_Elmt (Item_Elmt);
-               end loop;
-            end if;
+         if Present (Repeat_Items) then
+            Item_Elmt := First_Elmt (Repeat_Items);
+            while Present (Item_Elmt) loop
+               Item_Id := Node (Item_Elmt);
+               SPARK_Msg_NE ("missing global item &", N, Item_Id);
+               Next_Elmt (Item_Elmt);
+            end loop;
          end if;
       end Report_Missing_Items;
 
@@ -29603,6 +29557,13 @@ package body Sem_Prag is
 
       Analyze_Global_In_Decl_Part (N);
 
+      --  Do not perform these checks in an instance because they were already
+      --  performed successfully in the generic template.
+
+      if In_Instance then
+         goto Leave;
+      end if;
+
       --  Perform all refinement checks with respect to completeness and mode
       --  matching.
 
@@ -29671,7 +29632,6 @@ package body Sem_Prag is
       --  in the generic template.
 
       if Serious_Errors_Detected = Errors
-        and then not In_Instance
         and then not Has_Null_State
         and then No_Constit
       then
-- 
2.45.1

[COMMITTED 02/30] ada: Refactor checks for Refined_Depends in generic instances

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

Code cleanup; semantics is unaffected.

gcc/ada/

	* sem_prag.adb (Check_Dependency_Clause, Check_Output_States,
	Report_Extra_Clauses): Remove multiple checks for being inside
	an instance.
	(Analyze_Refined_Depends_In_Decl_Part): Add single check for
	being inside an instance.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_prag.adb | 30 +++++++++---------------------
 1 file changed, 9 insertions(+), 21 deletions(-)

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 86a25dc7d0c..29f27652138 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -27650,13 +27650,6 @@ package body Sem_Prag is
       --  Start of processing for Check_Dependency_Clause
 
       begin
-         --  Do not perform this check in an instance because it was already
-         --  performed successfully in the generic template.
-
-         if In_Instance then
-            return;
-         end if;
-
          --  Examine all refinement clauses and compare them against the
          --  dependence clause.
 
@@ -27910,16 +27903,10 @@ package body Sem_Prag is
       --  Start of processing for Check_Output_States
 
       begin
-         --  Do not perform this check in an instance because it was already
-         --  performed successfully in the generic template.
-
-         if In_Instance then
-            null;
-
          --  Inspect the outputs of pragma Depends looking for a state with a
          --  visible refinement.
 
-         elsif Present (Spec_Outputs) then
+         if Present (Spec_Outputs) then
             Item_Elmt := First_Elmt (Spec_Outputs);
             while Present (Item_Elmt) loop
                Item := Node (Item_Elmt);
@@ -28261,13 +28248,7 @@ package body Sem_Prag is
          Clause : Node_Id;
 
       begin
-         --  Do not perform this check in an instance because it was already
-         --  performed successfully in the generic template.
-
-         if In_Instance then
-            null;
-
-         elsif Present (Clauses) then
+         if Present (Clauses) then
             Clause := First (Clauses);
             while Present (Clause) loop
                SPARK_Msg_N
@@ -28369,6 +28350,13 @@ package body Sem_Prag is
 
       Analyze_Depends_In_Decl_Part (N);
 
+      --  Do not perform these checks in an instance because they were already
+      --  performed successfully in the generic template.
+
+      if In_Instance then
+         goto Leave;
+      end if;
+
       --  Do not match dependencies against refinements if Refined_Depends is
       --  illegal to avoid emitting misleading error.
 
-- 
2.45.1

[COMMITTED 03/30] ada: Remove unnecessary guard against empty list

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

Code cleanup; semantics is unaffected.

gcc/ada/

	* sem_prag.adb (Report_Extra_Clauses): Remove redundant check
	for empty list, because First works also for No_List.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_prag.adb | 15 ++++++---------
 1 file changed, 6 insertions(+), 9 deletions(-)

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 29f27652138..9ccf1b9cf65 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -28248,16 +28248,13 @@ package body Sem_Prag is
          Clause : Node_Id;
 
       begin
-         if Present (Clauses) then
-            Clause := First (Clauses);
-            while Present (Clause) loop
-               SPARK_Msg_N
-                 ("unmatched or extra clause in dependence refinement",
-                  Clause);
+         Clause := First (Clauses);
+         while Present (Clause) loop
+            SPARK_Msg_N
+              ("unmatched or extra clause in dependence refinement", Clause);
 
-               Next (Clause);
-            end loop;
-         end if;
+            Next (Clause);
+         end loop;
       end Report_Extra_Clauses;
 
       --  Local variables
-- 
2.45.1

[COMMITTED 04/30] ada: Fix handling of aspects CPU and Interrupt_Priority

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

When resolving aspect expression, aspects CPU and Interrupt_Priority
should be handled like the aspect Priority; in particular, all these
expressions can reference discriminants of the annotated task type.

gcc/ada/

	* sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): Make
	discriminants visible when analyzing aspect Interrupt_Priority.
	(Freeze_Entity_Checks): Likewise.
	(Resolve_Aspect_Expressions): Likewise for both aspects CPU and
	Interrupt_Priority.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch13.adb | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 4cf6fc9a645..c0a5b6c2c37 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -11107,6 +11107,7 @@ package body Sem_Ch13 is
          elsif A_Id in Aspect_CPU
                      | Aspect_Dynamic_Predicate
                      | Aspect_Ghost_Predicate
+                     | Aspect_Interrupt_Priority
                      | Aspect_Predicate
                      | Aspect_Priority
                      | Aspect_Static_Predicate
@@ -13366,6 +13367,7 @@ package body Sem_Ch13 is
                   if Get_Aspect_Id (Ritem) in Aspect_CPU
                                             | Aspect_Dynamic_Predicate
                                             | Aspect_Ghost_Predicate
+                                            | Aspect_Interrupt_Priority
                                             | Aspect_Predicate
                                             | Aspect_Static_Predicate
                                             | Aspect_Priority
@@ -15881,7 +15883,10 @@ package body Sem_Ch13 is
                      Set_Must_Not_Freeze (Expr);
                      Preanalyze_Spec_Expression (Expr, E);
 
-                  when Aspect_Priority =>
+                  when Aspect_CPU
+                     | Aspect_Interrupt_Priority
+                     | Aspect_Priority
+                  =>
                      Push_Type (E);
                      Preanalyze_Spec_Expression (Expr, Any_Integer);
                      Pop_Type (E);
-- 
2.45.1

[COMMITTED 05/30] ada: Cleanup building of error messages for class-wide contracts

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

Code cleanup; semantics is unaffected.

gcc/ada/

	* exp_ch6.adb (Build_Dynamic_Check_Helper_Call): Remove unused
	iteration over formal parameters.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch6.adb | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index a8a70a5759d..e43389132ae 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7635,7 +7635,6 @@ package body Exp_Ch6 is
                        Dynamic_Call_Helper (CW_Subp);
          Actuals   : constant List_Id := New_List;
          A         : Node_Id   := First_Actual (Call_Node);
-         F         : Entity_Id := First_Formal (Helper_Id);
 
       begin
          while Present (A) loop
@@ -7646,7 +7645,7 @@ package body Exp_Ch6 is
             Remove_Side_Effects (A);
 
             Append_To (Actuals, New_Copy_Tree (A));
-            Next_Formal (F);
+
             Next_Actual (A);
          end loop;
 
-- 
2.45.1

[COMMITTED 06/30] ada: Refactor common code for dynamic and static class-wide preconditions

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

Code cleanup; semantics is unaffected.

gcc/ada/

	* exp_ch6.adb (Install_Class_Preconditions_Check): Refactor
	common code for checking if precondition fails, since the
	difference is only in raising an exception or calling the
	Raise_Assert_Failure procedure.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch6.adb | 36 ++++++++++++++++++------------------
 1 file changed, 18 insertions(+), 18 deletions(-)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index e43389132ae..b5c5865242d 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7868,6 +7868,7 @@ package body Exp_Ch6 is
                         Present (Controlling_Argument (Call_Node));
       Class_Subp    : Entity_Id;
       Cond          : Node_Id;
+      Fail          : Node_Id;
       Subp          : Entity_Id;
 
    --  Start of processing for Install_Class_Preconditions_Check
@@ -7913,30 +7914,29 @@ package body Exp_Ch6 is
       end if;
 
       if Exception_Locations_Suppressed then
-         Insert_Action (Call_Node,
-           Make_If_Statement (Loc,
-             Condition       => Make_Op_Not (Loc, Cond),
-             Then_Statements => New_List (
-               Make_Raise_Statement (Loc,
-                 Name =>
-                   New_Occurrence_Of
-                     (RTE (RE_Assert_Failure), Loc)))));
+         Fail :=
+           Make_Raise_Statement (Loc,
+             Name =>
+               New_Occurrence_Of
+                 (RTE (RE_Assert_Failure), Loc));
 
       --  Failed check with message indicating the failed precondition and the
       --  call that caused it.
 
       else
-         Insert_Action (Call_Node,
-           Make_If_Statement (Loc,
-             Condition       => Make_Op_Not (Loc, Cond),
-             Then_Statements => New_List (
-               Make_Procedure_Call_Statement (Loc,
-                 Name                   =>
-                   New_Occurrence_Of
-                     (RTE (RE_Raise_Assert_Failure), Loc),
-                 Parameter_Associations =>
-                   New_List (Build_Error_Message (Subp))))));
+         Fail :=
+           Make_Procedure_Call_Statement (Loc,
+             Name                   =>
+               New_Occurrence_Of
+                 (RTE (RE_Raise_Assert_Failure), Loc),
+             Parameter_Associations =>
+               New_List (Build_Error_Message (Subp)));
       end if;
+
+      Insert_Action (Call_Node,
+        Make_If_Statement (Loc,
+          Condition       => Make_Op_Not (Loc, Cond),
+          Then_Statements => New_List (Fail)));
    end Install_Class_Preconditions_Check;
 
    ------------------------------
-- 
2.45.1

[COMMITTED 07/30] ada: Add switch to disable expansion of assertions in CodePeer mode

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

A new debug switch -gnatd_k is added, which has only effect in CodePeer
mode. When enabled, assertion expressions are no longer expanded (which
is the default in the CodePeer mode); instead, their expansion needs to
be explicitly enabled by pragma Assertion_Policy.

gcc/ada/

	* debug.adb (d_k): Use first available debug switch.
	* gnat1drv.adb (Adjust_Global_Switches): If new debug switch is
	active then don't expand assertion expressions by default.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/debug.adb    | 7 ++++++-
 gcc/ada/gnat1drv.adb | 8 ++++++--
 2 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 18b4a5480b6..540db2a9942 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -148,7 +148,7 @@ package body Debug is
    --  d_h  Disable the use of (perfect) hash functions for enumeration Value
    --  d_i  Ignore activations and calls to instances for elaboration
    --  d_j  Read JSON files and populate Repinfo tables (opposite of -gnatRjs)
-   --  d_k
+   --  d_k  In CodePeer mode disable expansion of assertion checks
    --  d_l
    --  d_m
    --  d_n
@@ -990,6 +990,11 @@ package body Debug is
    --       compilation session if -gnatRjs was passed, in order to populate
    --       the internal tables of the Repinfo unit from them.
 
+   --  d_k  In CodePeer mode assertion expressions are expanded by default
+   --       (regardless of the -gnata compiler switch); when this switch is
+   --       enabled, expansion of assertion expressions is controlled by
+   --       pragma Assertion_Policy.
+
    --  d_p  The compiler ignores calls to subprograms which verify the run-time
    --       semantics of invariants and postconditions in both the static and
    --       dynamic elaboration models.
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 55b5d565536..081d9435f4a 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -357,9 +357,13 @@ procedure Gnat1drv is
 
          Generate_SCIL := True;
 
-         --  Enable assertions, since they give CodePeer valuable extra info
+         --  Enable assertions, since they give CodePeer valuable extra info;
+         --  however, when switch -gnatd_k is active, then keep assertions
+         --  disabled by default and only enable them when explicitly
+         --  requested by pragma Assertion_Policy, just like in ordinary
+         --  compilation.
 
-         Assertions_Enabled := True;
+         Assertions_Enabled := not Debug_Flag_Underscore_K;
 
          --  Set normal RM validity checking and checking of copies (to catch
          --  e.g. wrong values used in unchecked conversions).
-- 
2.45.1

[COMMITTED 08/30] ada: Enable inlining for subprograms with multiple return statements

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

With the support for forward GOTO statements in the GNATprove backend,
we can now inline subprograms with multiple return statements in the
frontend.

Also, fix inconsistent source locations in the inlined code, which were
now triggering assertion violations in the code for GNATprove
counterexamples.

gcc/ada/

	* inline.adb (Has_Single_Return_In_GNATprove_Mode): Remove.
	(Process_Formals): When rewriting an occurrence of a formal
	parameter, use location of the occurrence, not of the inlined
	call.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/inline.adb | 91 ++++------------------------------------------
 1 file changed, 8 insertions(+), 83 deletions(-)

diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 17b3099e6a6..04cf1194009 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -1090,14 +1090,6 @@ package body Inline is
       --  conflict with subsequent inlinings, so that it is unsafe to try to
       --  inline in such a case.
 
-      function Has_Single_Return_In_GNATprove_Mode return Boolean;
-      --  This function is called only in GNATprove mode, and it returns
-      --  True if the subprogram has no return statement or a single return
-      --  statement as last statement. It returns False for subprogram with
-      --  a single return as last statement inside one or more blocks, as
-      --  inlining would generate gotos in that case as well (although the
-      --  goto is useless in that case).
-
       function Uses_Secondary_Stack (Bod : Node_Id) return Boolean;
       --  If the body of the subprogram includes a call that returns an
       --  unconstrained type, the secondary stack is involved, and it is
@@ -1173,64 +1165,6 @@ package body Inline is
          return False;
       end Has_Pending_Instantiation;
 
-      -----------------------------------------
-      -- Has_Single_Return_In_GNATprove_Mode --
-      -----------------------------------------
-
-      function Has_Single_Return_In_GNATprove_Mode return Boolean is
-         Body_To_Inline : constant Node_Id := N;
-         Last_Statement : Node_Id := Empty;
-
-         function Check_Return (N : Node_Id) return Traverse_Result;
-         --  Returns OK on node N if this is not a return statement different
-         --  from the last statement in the subprogram.
-
-         ------------------
-         -- Check_Return --
-         ------------------
-
-         function Check_Return (N : Node_Id) return Traverse_Result is
-         begin
-            case Nkind (N) is
-               when N_Extended_Return_Statement
-                  | N_Simple_Return_Statement
-               =>
-                  if N = Last_Statement then
-                     return OK;
-                  else
-                     return Abandon;
-                  end if;
-
-               --  Skip locally declared subprogram bodies inside the body to
-               --  inline, as the return statements inside those do not count.
-
-               when N_Subprogram_Body =>
-                  if N = Body_To_Inline then
-                     return OK;
-                  else
-                     return Skip;
-                  end if;
-
-               when others =>
-                  return OK;
-            end case;
-         end Check_Return;
-
-         function Check_All_Returns is new Traverse_Func (Check_Return);
-
-      --  Start of processing for Has_Single_Return_In_GNATprove_Mode
-
-      begin
-         --  Retrieve the last statement
-
-         Last_Statement := Last (Statements (Handled_Statement_Sequence (N)));
-
-         --  Check that the last statement is the only possible return
-         --  statement in the subprogram.
-
-         return Check_All_Returns (N) = OK;
-      end Has_Single_Return_In_GNATprove_Mode;
-
       --------------------------
       -- Uses_Secondary_Stack --
       --------------------------
@@ -1275,16 +1209,6 @@ package body Inline is
       then
          return;
 
-      --  Subprograms that have return statements in the middle of the body are
-      --  inlined with gotos. GNATprove does not currently support gotos, so
-      --  we prevent such inlining.
-
-      elsif GNATprove_Mode
-        and then not Has_Single_Return_In_GNATprove_Mode
-      then
-         Cannot_Inline ("cannot inline & (multiple returns)?", N, Spec_Id);
-         return;
-
       --  Functions that return controlled types cannot currently be inlined
       --  because they require secondary stack handling; controlled actions
       --  may also interfere in complex ways with inlining.
@@ -3518,6 +3442,7 @@ package body Inline is
       ---------------------
 
       function Process_Formals (N : Node_Id) return Traverse_Result is
+         Loc : constant Source_Ptr := Sloc (N);
          A   : Entity_Id;
          E   : Entity_Id;
          Ret : Node_Id;
@@ -3544,13 +3469,13 @@ package body Inline is
 
                if Is_Entity_Name (A) then
                   Had_Private_View := Has_Private_View (N);
-                  Rewrite (N, New_Occurrence_Of (Entity (A), Sloc (N)));
+                  Rewrite (N, New_Occurrence_Of (Entity (A), Loc));
                   Set_Has_Private_View (N, Had_Private_View);
                   Check_Private_View (N);
 
                elsif Nkind (A) = N_Defining_Identifier then
                   Had_Private_View := Has_Private_View (N);
-                  Rewrite (N, New_Occurrence_Of (A, Sloc (N)));
+                  Rewrite (N, New_Occurrence_Of (A, Loc));
                   Set_Has_Private_View (N, Had_Private_View);
                   Check_Private_View (N);
 
@@ -3618,8 +3543,8 @@ package body Inline is
                  or else Yields_Universal_Type (Expression (N))
                then
                   Ret :=
-                    Make_Qualified_Expression (Sloc (N),
-                      Subtype_Mark => New_Occurrence_Of (Ret_Type, Sloc (N)),
+                    Make_Qualified_Expression (Loc,
+                      Subtype_Mark => New_Occurrence_Of (Ret_Type, Loc),
                       Expression   => Relocate_Node (Expression (N)));
 
                --  Use an unchecked type conversion between access types, for
@@ -3635,8 +3560,8 @@ package body Inline is
 
                else
                   Ret :=
-                    Make_Type_Conversion (Sloc (N),
-                      Subtype_Mark => New_Occurrence_Of (Ret_Type, Sloc (N)),
+                    Make_Type_Conversion (Loc,
+                      Subtype_Mark => New_Occurrence_Of (Ret_Type, Loc),
                       Expression   => Relocate_Node (Expression (N)));
                end if;
 
@@ -3715,7 +3640,7 @@ package body Inline is
          elsif Nkind (N) = N_Pragma
            and then Pragma_Name (N) = Name_Unreferenced
          then
-            Rewrite (N, Make_Null_Statement (Sloc (N)));
+            Rewrite (N, Make_Null_Statement (Loc));
             return OK;
 
          else
-- 
2.45.1

[COMMITTED 09/30] ada: Simplify check for type without stream operations

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

Recursive routine Type_Without_Stream_Operation was checking restriction
No_Default_Stream_Attributes at every call, which was confusing and
inefficient.

This routine is only called from the places: Check_Stream_Attribute,
which already checks if this restriction is active, and
Stream_Operation_OK, where we add such a check.

Cleanup related to extending the use of No_Streams restriction.

gcc/ada/

	* exp_ch3.adb (Stream_Operation_OK): Check restriction
	No_Default_Stream_Attributes before call to
	Type_Without_Stream_Operation.
	* sem_util.adb (Type_Without_Stream_Operation): Remove static
	condition from recursive routine

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch3.adb  | 4 +++-
 gcc/ada/sem_util.adb | 4 ----
 2 files changed, 3 insertions(+), 5 deletions(-)

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 8ddae1eb1be..f9dd0914111 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -12912,7 +12912,9 @@ package body Exp_Ch3 is
         and then No (No_Tagged_Streams_Pragma (Typ))
         and then not No_Run_Time_Mode
         and then RTE_Available (RE_Tag)
-        and then No (Type_Without_Stream_Operation (Typ))
+        and then
+          (not Restriction_Active (No_Default_Stream_Attributes)
+             or else No (Type_Without_Stream_Operation (Typ)))
         and then RTE_Available (RE_Root_Stream_Type);
    end Stream_Operation_OK;
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 15994b4d1e9..241be3d2957 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -28557,10 +28557,6 @@ package body Sem_Util is
       Op_Missing : Boolean;
 
    begin
-      if not Restriction_Active (No_Default_Stream_Attributes) then
-         return Empty;
-      end if;
-
       if Is_Elementary_Type (T) then
          if Op = TSS_Null then
             Op_Missing :=
-- 
2.45.1

[COMMITTED 10/30] ada: Skip processing of NUL character for attribute Type_Key

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

Code cleanup; behavior is unaffected.

gcc/ada/

	* sem_attr.adb (Analyze_Attribute): Use fully qualified name
	without a NUL, so that it doesn't need to be skipped afterwards.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_attr.adb | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 403810c8b5e..4fd270aeae9 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6863,8 +6863,8 @@ package body Sem_Attr is
       --------------
 
       when Attribute_Type_Key => Type_Key : declare
-         Full_Name  : constant String_Id :=
-                        Fully_Qualified_Name_String (Entity (P));
+         Full_Name : constant String_Id :=
+           Fully_Qualified_Name_String (Entity (P), Append_NUL => False);
 
          CRC : CRC32;
          --  The computed signature for the type
@@ -6997,9 +6997,9 @@ package body Sem_Attr is
          Start_String;
          Deref := False;
 
-         --  Copy all characters in Full_Name but the trailing NUL
+         --  Copy all characters in Full_Name
 
-         for J in 1 .. String_Length (Full_Name) - 1 loop
+         for J in 1 .. String_Length (Full_Name) loop
             Store_String_Char (Get_String_Char (Full_Name, Pos (J)));
          end loop;
 
-- 
2.45.1

[COMMITTED 11/30] ada: Adjust comments and doc about the new use of restriction No_Streams

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

Extend code comment; move recently added documentation from pragma
No_Tagged_Streams to restriction No_Streams.

gcc/ada/

	* doc/gnat_rm/implementation_defined_pragmas.rst
	(No_Tagged_Streams): Move documentation.
	* doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
	(No_Streams): Likewise.
	* exp_disp.adb (Make_DT): Extend comment.
	* gnat_rm.texi: Regenerate.
	* gnat_ugn.texi: Regenerate.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 .../doc/gnat_rm/implementation_defined_pragmas.rst |  6 ------
 ...ard_and_implementation_defined_restrictions.rst |  6 ++++++
 gcc/ada/exp_disp.adb                               |  4 ++++
 gcc/ada/gnat_rm.texi                               | 14 +++++++-------
 gcc/ada/gnat_ugn.texi                              |  4 ++--
 5 files changed, 19 insertions(+), 15 deletions(-)

diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
index 7e4dd935342..0661670e047 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
@@ -4000,12 +4000,6 @@ applied to a tagged type its Expanded_Name and External_Tag are initialized
 with empty strings. This is useful to avoid exposing entity names at binary
 level but has a negative impact on the debuggability of tagged types.
 
-Alternatively, when pragmas ``Discard_Names`` and ``Restrictions (No_Streams)``
-simultanously apply to a tagged type, its Expanded_Name and External_Tag are
-also initialized with empty strings. In particular, both these pragmas can be
-applied as configuration pragmas to avoid exposing entity names at binary
-level for the entire parition.
-
 Pragma Normalize_Scalars
 ========================
 
diff --git a/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst b/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
index 5c023239163..cf4657b7050 100644
--- a/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
+++ b/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
@@ -675,6 +675,12 @@ To take maximum advantage of this space-saving optimization, any
 unit declaring a tagged type should be compiled with the restriction,
 though this is not required.
 
+When pragmas ``Discard_Names`` and ``Restrictions (No_Streams)`` simultaneously
+apply to a tagged type, its Expanded_Name and External_Tag are also initialized
+with empty strings. In particular, both these pragmas can be applied as
+configuration pragmas to avoid exposing entity names at binary level for the
+entire partition.
+
 No_Tagged_Type_Registration
 ---------------------------
 .. index:: No_Tagged_Type_Registration
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 66be77c9ffc..1a19c1e3303 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -4598,6 +4598,10 @@ package body Exp_Disp is
       --    (2) External_Tag (combined with Internal_Tag) is used for object
       --        streaming and No_Tagged_Streams inhibits the generation of
       --        streams.
+      --  Instead of No_Tagged_Streams, which applies either to a single
+      --  type or to a declarative region, it is possible to use restriction
+      --  No_Streams, which prevents stream objects from being created in the
+      --  entire partition.
 
       Discard_Names : constant Boolean :=
         (Present (No_Tagged_Streams_Pragma (Typ))
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 776dd4a4afc..1e6fb093672 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -19,7 +19,7 @@
 
 @copying
 @quotation
-GNAT Reference Manual , Apr 16, 2024
+GNAT Reference Manual , May 28, 2024
 
 AdaCore
 
@@ -5535,12 +5535,6 @@ applied to a tagged type its Expanded_Name and External_Tag are initialized
 with empty strings. This is useful to avoid exposing entity names at binary
 level but has a negative impact on the debuggability of tagged types.
 
-Alternatively, when pragmas @code{Discard_Names} and @code{Restrictions (No_Streams)}
-simultanously apply to a tagged type, its Expanded_Name and External_Tag are
-also initialized with empty strings. In particular, both these pragmas can be
-applied as configuration pragmas to avoid exposing entity names at binary
-level for the entire parition.
-
 @node Pragma Normalize_Scalars,Pragma Obsolescent,Pragma No_Tagged_Streams,Implementation Defined Pragmas
 @anchor{gnat_rm/implementation_defined_pragmas pragma-normalize-scalars}@anchor{b0}
 @section Pragma Normalize_Scalars
@@ -13246,6 +13240,12 @@ To take maximum advantage of this space-saving optimization, any
 unit declaring a tagged type should be compiled with the restriction,
 though this is not required.
 
+When pragmas @code{Discard_Names} and @code{Restrictions (No_Streams)} simultaneously
+apply to a tagged type, its Expanded_Name and External_Tag are also initialized
+with empty strings. In particular, both these pragmas can be applied as
+configuration pragmas to avoid exposing entity names at binary level for the
+entire partition.
+
 @node No_Tagged_Type_Registration,No_Task_Allocators,No_Streams,Partition-Wide Restrictions
 @anchor{gnat_rm/standard_and_implementation_defined_restrictions no-tagged-type-registration}@anchor{205}
 @subsection No_Tagged_Type_Registration
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 2df2a780ec7..73f496fcdab 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -19,7 +19,7 @@
 
 @copying
 @quotation
-GNAT User's Guide for Native Platforms , Apr 16, 2024
+GNAT User's Guide for Native Platforms , May 28, 2024
 
 AdaCore
 
@@ -29645,8 +29645,8 @@ to permit their use in free software.
 
 @printindex ge
 
-@anchor{d1}@w{                              }
 @anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{                              }
+@anchor{d1}@w{                              }
 
 @c %**end of body
 @bye
-- 
2.45.1

[COMMITTED 12/30] ada: Cleanup repeated code in expansion of stream attributes

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

In expansion of various attributes, in particular for the Input/Output
and Read/Write attributes, we can use constants that are already used
for expansion of many other attributes.

gcc/ada/

	* exp_attr.adb (Expand_N_Attribute_Reference): Use constants
	declared at the beginning of subprogram; tune layout.
	* exp_ch3.adb (Predefined_Primitive_Bodies): Tune layout.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_attr.adb | 36 +++++++++++++++---------------------
 gcc/ada/exp_ch3.adb  |  3 +--
 2 files changed, 16 insertions(+), 23 deletions(-)

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 69428142839..0349db28a1a 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -179,7 +179,6 @@ package body Exp_Attr is
    --    * Rec_Typ - the record type whose internals are to be validated
 
    function Default_Streaming_Unavailable (Typ : Entity_Id) return Boolean;
-   --
    --  In most cases, references to unavailable streaming attributes
    --  are rejected at compile time. In some obscure cases involving
    --  generics and formal derived types, the problem is dealt with at runtime.
@@ -4091,10 +4090,8 @@ package body Exp_Attr is
       ----------------------
 
       when Attribute_Has_Same_Storage => Has_Same_Storage : declare
-         Loc : constant Source_Ptr := Sloc (N);
-
-         X   : constant Node_Id := Prefix (N);
-         Y   : constant Node_Id := First (Expressions (N));
+         X : constant Node_Id := Pref;
+         Y : constant Node_Id := First (Exprs);
          --  The arguments
 
          X_Addr : Node_Id;
@@ -4363,7 +4360,7 @@ package body Exp_Attr is
 
          if Restriction_Active (No_Streams) then
             Rewrite (N,
-              Make_Raise_Program_Error (Sloc (N),
+              Make_Raise_Program_Error (Loc,
                 Reason => PE_Stream_Operation_Not_Allowed));
             Set_Etype (N, B_Type);
             return;
@@ -4415,7 +4412,7 @@ package body Exp_Attr is
                --  case where a No_Streams restriction is active.
 
                Rewrite (N,
-                 Make_Raise_Program_Error (Sloc (N),
+                 Make_Raise_Program_Error (Loc,
                    Reason => PE_Stream_Operation_Not_Allowed));
                Set_Etype (N, B_Type);
                return;
@@ -5295,10 +5292,8 @@ package body Exp_Attr is
       ----------------------
 
       when Attribute_Overlaps_Storage => Overlaps_Storage : declare
-         Loc : constant Source_Ptr := Sloc (N);
-         X   : constant Node_Id    := Prefix (N);
-         Y   : constant Node_Id    := First (Expressions (N));
-
+         X : constant Node_Id := Pref;
+         Y : constant Node_Id := First (Exprs);
          --  The arguments
 
          X_Addr, Y_Addr : Node_Id;
@@ -5451,7 +5446,7 @@ package body Exp_Attr is
 
          if Restriction_Active (No_Streams) then
             Rewrite (N,
-              Make_Raise_Program_Error (Sloc (N),
+              Make_Raise_Program_Error (Loc,
                 Reason => PE_Stream_Operation_Not_Allowed));
             Set_Etype (N, Standard_Void_Type);
             return;
@@ -5505,7 +5500,7 @@ package body Exp_Attr is
                --  case where a No_Streams restriction is active.
 
                Rewrite (N,
-                 Make_Raise_Program_Error (Sloc (N),
+                 Make_Raise_Program_Error (Loc,
                    Reason => PE_Stream_Operation_Not_Allowed));
                Set_Etype (N, Standard_Void_Type);
                return;
@@ -6180,10 +6175,9 @@ package body Exp_Attr is
 
       when Attribute_Reduce =>
          declare
-            Loc : constant Source_Ptr := Sloc (N);
-            E1  : constant Node_Id    := First (Expressions (N));
-            E2  : constant Node_Id    := Next (E1);
-            Bnn : constant Entity_Id  := Make_Temporary (Loc, 'B', N);
+            E1  : constant Node_Id   := First (Exprs);
+            E2  : constant Node_Id   := Next (E1);
+            Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
 
             Accum_Typ : Entity_Id := Empty;
             New_Loop  : Node_Id;
@@ -6381,7 +6375,7 @@ package body Exp_Attr is
 
          if Restriction_Active (No_Streams) then
             Rewrite (N,
-              Make_Raise_Program_Error (Sloc (N),
+              Make_Raise_Program_Error (Loc,
                 Reason => PE_Stream_Operation_Not_Allowed));
             Set_Etype (N, B_Type);
             return;
@@ -6453,7 +6447,7 @@ package body Exp_Attr is
                --  case where a No_Streams restriction is active.
 
                Rewrite (N,
-                 Make_Raise_Program_Error (Sloc (N),
+                 Make_Raise_Program_Error (Loc,
                    Reason => PE_Stream_Operation_Not_Allowed));
                Set_Etype (N, B_Type);
                return;
@@ -8096,7 +8090,7 @@ package body Exp_Attr is
 
          if Restriction_Active (No_Streams) then
             Rewrite (N,
-              Make_Raise_Program_Error (Sloc (N),
+              Make_Raise_Program_Error (Loc,
                 Reason => PE_Stream_Operation_Not_Allowed));
             Set_Etype (N, U_Type);
             return;
@@ -8150,7 +8144,7 @@ package body Exp_Attr is
                --  case where a No_Streams restriction is active.
 
                Rewrite (N,
-                 Make_Raise_Program_Error (Sloc (N),
+                 Make_Raise_Program_Error (Loc,
                    Reason => PE_Stream_Operation_Not_Allowed));
                Set_Etype (N, U_Type);
                return;
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index f9dd0914111..f03cda62149 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -12655,8 +12655,7 @@ package body Exp_Ch3 is
         and then Stream_Operation_OK (Tag_Typ, TSS_Stream_Input)
         and then No (TSS (Tag_Typ, TSS_Stream_Input))
       then
-         Build_Record_Or_Elementary_Input_Function
-           (Tag_Typ, Decl, Ent);
+         Build_Record_Or_Elementary_Input_Function (Tag_Typ, Decl, Ent);
          Append_To (Res, Decl);
       end if;
 
-- 
2.45.1

[COMMITTED 13/30] ada: Fix incorrect lower bound presumption in gnatlink

[Marc Poulhiès]

From: Ronan Desplanques <desplanques@adacore.com>

This patch fixes a subprogram in gnatlink that incorrectly assumed
that the strings it is passed as arguments all have a lower bound of
1.

gcc/ada/

	* gnatlink.adb (Check_File_Name): Fix incorrect assumption.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/gnatlink.adb | 17 ++++++++---------
 1 file changed, 8 insertions(+), 9 deletions(-)

diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb
index d00fd9e5af7..1455412ef93 100644
--- a/gcc/ada/gnatlink.adb
+++ b/gcc/ada/gnatlink.adb
@@ -42,6 +42,7 @@ with Types;
 
 with Ada.Command_Line; use Ada.Command_Line;
 with Ada.Exceptions;   use Ada.Exceptions;
+with Ada.Strings.Fixed;
 
 with System.OS_Lib; use System.OS_Lib;
 with System.CRTL;
@@ -1697,15 +1698,13 @@ begin
 
       procedure Check_File_Name (S : String) is
       begin
-         for J in 1 .. FN'Length - (S'Length - 1) loop
-            if FN (J .. J + (S'Length - 1)) = S then
-               Error_Msg
-                 ("warning: executable file name """ & Output_File_Name.all
-                  & """ contains substring """ & S & '"');
-               Error_Msg
-                 ("admin privileges may be required to run this file");
-            end if;
-         end loop;
+         if Ada.Strings.Fixed.Index (FN, S) /= 0 then
+            Error_Msg
+              ("warning: executable file name """ & Output_File_Name.all
+               & """ contains substring """ & S & '"');
+            Error_Msg
+              ("admin privileges may be required to run this file");
+         end if;
       end Check_File_Name;
 
    --  Start of processing for Bad_File_Names_On_Windows
-- 
2.45.1

[COMMITTED 14/30] ada: Remove incorrect assertion in run-time

[Marc Poulhiès]

From: Ronan Desplanques <desplanques@adacore.com>

There is a special case of file paths on Windows that are absolute
but don't start with a drive letter: UNC paths. This patch removes
an assertion in System.OS_Lib.Normalize_Pathname that failed to take
this case into account. It also renames a local subprogram of
Normalize_Pathname to make its purpose clearer.

gcc/ada/

	* libgnat/s-os_lib.adb (Normalize_Pathname): Remove incorrect
	assert statement.
	(Missed_Drive_Letter): Rename into...
	(Drive_Letter_Omitted): This.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/s-os_lib.adb | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/gcc/ada/libgnat/s-os_lib.adb b/gcc/ada/libgnat/s-os_lib.adb
index 20e109aaa0b..dd2156e1dcb 100644
--- a/gcc/ada/libgnat/s-os_lib.adb
+++ b/gcc/ada/libgnat/s-os_lib.adb
@@ -2089,8 +2089,10 @@ package body System.OS_Lib is
       --  Returns True only if the Name is including a drive
       --  letter at start.
 
-      function Missed_Drive_Letter (Name : String) return Boolean;
-      --  Missed drive letter at start of the normalized pathname
+      function Drive_Letter_Omitted (Name : String) return Boolean;
+      --  Name must be an absolute path. Returns True if and only if
+      --  Name doesn't start with a drive letter and Name is not a
+      --  UNC path.
 
       -------------------
       -- Is_With_Drive --
@@ -2104,11 +2106,11 @@ package body System.OS_Lib is
                      or else Name (Name'First) in 'A' .. 'Z');
       end Is_With_Drive;
 
-      -------------------------
-      -- Missed_Drive_Letter --
-      -------------------------
+      --------------------------
+      -- Drive_Letter_Omitted --
+      --------------------------
 
-      function Missed_Drive_Letter (Name : String) return Boolean is
+      function Drive_Letter_Omitted (Name : String) return Boolean is
       begin
          return On_Windows
            and then not Is_With_Drive (Name)
@@ -2117,7 +2119,7 @@ package body System.OS_Lib is
                              /= Directory_Separator
                      or else Name (Name'First + 1)
                              /= Directory_Separator);
-      end Missed_Drive_Letter;
+      end Drive_Letter_Omitted;
 
       -----------------
       -- Final_Value --
@@ -2174,7 +2176,7 @@ package body System.OS_Lib is
 
          elsif Directory = ""
            or else not Is_Absolute_Path (Directory)
-           or else Missed_Drive_Letter (Directory)
+           or else Drive_Letter_Omitted (Directory)
          then
             --  Directory name not given or it is not absolute or without drive
             --  letter on Windows, get current directory.
@@ -2251,7 +2253,7 @@ package body System.OS_Lib is
       end if;
 
       if Is_Absolute_Path (Name) then
-         if Missed_Drive_Letter (Name) then
+         if Drive_Letter_Omitted (Name) then
             Fill_Directory (Drive_Only => True);
 
             --  Take only drive letter part with colon
@@ -2286,8 +2288,6 @@ package body System.OS_Lib is
 
          --  Ensure drive letter is upper-case
 
-         pragma Assert (Path_Buffer (2) = ':');
-
          if Path_Buffer (1) in 'a' .. 'z' then
             System.Case_Util.To_Upper (Path_Buffer (1 .. 1));
          end if;
-- 
2.45.1

[COMMITTED 15/30] ada: Fix usage of SetThreadIdealProcessor

[Marc Poulhiès]

From: Ronan Desplanques <desplanques@adacore.com>

This patches fixes the way the run-time library checks the return
value of SetThreadIdealProcessor.

gcc/ada/

	* libgnarl/s-taprop__mingw.adb (Set_Task_Affinity): Fix usage
	of SetThreadIdealProcessor.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnarl/s-taprop__mingw.adb | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/libgnarl/s-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb
index 3a124ba78d0..38e281cb721 100644
--- a/gcc/ada/libgnarl/s-taprop__mingw.adb
+++ b/gcc/ada/libgnarl/s-taprop__mingw.adb
@@ -1308,7 +1308,13 @@ package body System.Task_Primitives.Operations is
          Result :=
            SetThreadIdealProcessor
              (T.Common.LL.Thread, ProcessorId (T.Common.Base_CPU) - 1);
-         pragma Assert (Result = 1);
+
+         --  The documentation for SetThreadIdealProcessor states:
+         --
+         --      If the function fails, the return value is (DWORD) - 1.
+         --
+         --  That should map to DWORD'Last in Ada.
+         pragma Assert (Result /= DWORD'Last);
 
       --  Task_Info
 
@@ -1317,7 +1323,10 @@ package body System.Task_Primitives.Operations is
             Result :=
               SetThreadIdealProcessor
                 (T.Common.LL.Thread, T.Common.Task_Info.CPU);
-            pragma Assert (Result = 1);
+
+            --  See the comment above about the return value of
+            --  SetThreadIdealProcessor.
+            pragma Assert (Result /= DWORD'Last);
          end if;
 
       --  Dispatching domains
-- 
2.45.1

[COMMITTED 16/30] ada: Fix usage of SetThreadAffinityMask

[Marc Poulhiès]

From: Ronan Desplanques <desplanques@adacore.com>

This patches fixes the signature of the binding to SetThreadAffinityMask
in the run-time library. It also fixes the error checking after calls
to SetThreadAffinityMask. The previous code behaved as if
SetThreadAffinityMask returned 1 on success, but it in fact returns a
pointer value on success and 0 on failure.

gcc/ada/

	* libgnarl/s-taprop__mingw.adb (Set_Task_Affinity): Fix usage of
	SetThreadAffinityMask.
	* libgnat/s-winext.ads (SetThreadAffinityMask): Fix binding
	signature.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnarl/s-taprop__mingw.adb | 6 +++---
 gcc/ada/libgnat/s-winext.ads         | 2 +-
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/libgnarl/s-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb
index 38e281cb721..f77d71970b8 100644
--- a/gcc/ada/libgnarl/s-taprop__mingw.adb
+++ b/gcc/ada/libgnarl/s-taprop__mingw.adb
@@ -1340,7 +1340,7 @@ package body System.Task_Primitives.Operations is
       then
          declare
             CPU_Set : DWORD := 0;
-
+            Mask_Result : DWORD_PTR;
          begin
             for Proc in T.Common.Domain'Range loop
                if T.Common.Domain (Proc) then
@@ -1352,8 +1352,8 @@ package body System.Task_Primitives.Operations is
                end if;
             end loop;
 
-            Result := SetThreadAffinityMask (T.Common.LL.Thread, CPU_Set);
-            pragma Assert (Result = 1);
+            Mask_Result := SetThreadAffinityMask (T.Common.LL.Thread, CPU_Set);
+            pragma Assert (Mask_Result /= 0);
          end;
       end if;
    end Set_Task_Affinity;
diff --git a/gcc/ada/libgnat/s-winext.ads b/gcc/ada/libgnat/s-winext.ads
index 3f14fc04e60..b402a5615c9 100644
--- a/gcc/ada/libgnat/s-winext.ads
+++ b/gcc/ada/libgnat/s-winext.ads
@@ -55,7 +55,7 @@ package System.Win32.Ext is
 
    function SetThreadAffinityMask
      (hThread              : HANDLE;
-      dwThreadAffinityMask : DWORD) return DWORD;
+      dwThreadAffinityMask : DWORD) return DWORD_PTR;
    pragma Import (Stdcall, SetThreadAffinityMask, "SetThreadAffinityMask");
 
    --------------
-- 
2.45.1

[COMMITTED 17/30] ada: Remove streaming facilities from generics for formal containers

[Marc Poulhiès]

From: Yannick Moy <moy@adacore.com>

The dependency on Ada.Streams is problematic for light runtimes.
As these streaming facilities are in fact not used in formal containers,
remove the corresponding dead code.

gcc/ada/

	* libgnat/a-chtgfo.adb (Generic_Read, Generic_Write): Remove.
	* libgnat/a-chtgfo.ads: Same. Remove dependency on Ada.Streams.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/a-chtgfo.adb | 68 ------------------------------------
 gcc/ada/libgnat/a-chtgfo.ads | 24 -------------
 2 files changed, 92 deletions(-)

diff --git a/gcc/ada/libgnat/a-chtgfo.adb b/gcc/ada/libgnat/a-chtgfo.adb
index c3fff336e9d..df7b554c050 100644
--- a/gcc/ada/libgnat/a-chtgfo.adb
+++ b/gcc/ada/libgnat/a-chtgfo.adb
@@ -359,74 +359,6 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Operations is
       end loop;
    end Generic_Iteration;
 
-   ------------------
-   -- Generic_Read --
-   ------------------
-
-   procedure Generic_Read
-     (Stream : not null access Root_Stream_Type'Class;
-      HT     : out Hash_Table_Type)
-   is
-      N : Count_Type'Base;
-
-   begin
-      Clear (HT);
-
-      Count_Type'Base'Read (Stream, N);
-
-      if Checks and then N < 0 then
-         raise Program_Error with "stream appears to be corrupt";
-      end if;
-
-      if N = 0 then
-         return;
-      end if;
-
-      if Checks and then N > HT.Capacity then
-         raise Capacity_Error with "too many elements in stream";
-      end if;
-
-      for J in 1 .. N loop
-         declare
-            Node : constant Count_Type := New_Node (Stream);
-            Indx : constant Hash_Type := Index (HT, HT.Nodes (Node));
-            B    : Count_Type renames HT.Buckets (Indx);
-         begin
-            Set_Next (HT.Nodes (Node), Next => B);
-            B := Node;
-         end;
-
-         HT.Length := HT.Length + 1;
-      end loop;
-   end Generic_Read;
-
-   -------------------
-   -- Generic_Write --
-   -------------------
-
-   procedure Generic_Write
-     (Stream : not null access Root_Stream_Type'Class;
-      HT     : Hash_Table_Type)
-   is
-      procedure Write (Node : Count_Type);
-      pragma Inline (Write);
-
-      procedure Write is new Generic_Iteration (Write);
-
-      -----------
-      -- Write --
-      -----------
-
-      procedure Write (Node : Count_Type) is
-      begin
-         Write (Stream, HT.Nodes (Node));
-      end Write;
-
-   begin
-      Count_Type'Base'Write (Stream, HT.Length);
-      Write (HT);
-   end Generic_Write;
-
    -----------
    -- Index --
    -----------
diff --git a/gcc/ada/libgnat/a-chtgfo.ads b/gcc/ada/libgnat/a-chtgfo.ads
index 76633d8da05..f4471bec3d2 100644
--- a/gcc/ada/libgnat/a-chtgfo.ads
+++ b/gcc/ada/libgnat/a-chtgfo.ads
@@ -30,8 +30,6 @@
 --  Hash_Table_Type is used to implement hashed containers. This package
 --  declares hash-table operations that do not depend on keys.
 
-with Ada.Streams;
-
 generic
    with package HT_Types is
      new Generic_Formal_Hash_Table_Types (<>);
@@ -113,26 +111,4 @@ package Ada.Containers.Hash_Tables.Generic_Formal_Operations is
    procedure Generic_Iteration (HT : Hash_Table_Type);
    --  Calls Process for each node in hash table HT
 
-   generic
-      use Ada.Streams;
-      with procedure Write
-        (Stream : not null access Root_Stream_Type'Class;
-         Node   : Node_Type);
-   procedure Generic_Write
-     (Stream : not null access Root_Stream_Type'Class;
-      HT     : Hash_Table_Type);
-   --  Used to implement the streaming attribute for hashed containers. It
-   --  calls Write for each node to write its value into Stream.
-
-   generic
-      use Ada.Streams;
-      with function New_Node (Stream : not null access Root_Stream_Type'Class)
-         return Count_Type;
-   procedure Generic_Read
-     (Stream : not null access Root_Stream_Type'Class;
-      HT     : out Hash_Table_Type);
-   --  Used to implement the streaming attribute for hashed containers. It
-   --  first clears hash table HT, then populates the hash table by calling
-   --  New_Node for each item in Stream.
-
 end Ada.Containers.Hash_Tables.Generic_Formal_Operations;
-- 
2.45.1

[COMMITTED 18/30] ada: Tune code related to potentially unevaluated expressions

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

Code cleanup; semantics is unaffected.

gcc/ada/

	* sem_util.adb
	(Immediate_Context_Implies_Is_Potentially_Unevaluated): Use
	collective subtypes in membership tests.
	(Is_Known_On_Entry): Require all alternatives in a case statement
	to return; this change could prevent a recently fixed glitch,
	where one of the alternatives relied on the return statement
	afterwards (also, the new code is shorter).
	* sem_util.ads (Is_Potentially_Unevaluated): Clarify that this
	routine applies to Ada 2012.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_util.adb | 8 +++-----
 gcc/ada/sem_util.ads | 2 +-
 2 files changed, 4 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 241be3d2957..5bea088c44e 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -19485,10 +19485,10 @@ package body Sem_Util is
          elsif Nkind (Par) = N_Case_Expression then
             return Expr /= Expression (Par);
 
-         elsif Nkind (Par) in N_And_Then | N_Or_Else then
+         elsif Nkind (Par) in N_Short_Circuit then
             return Expr = Right_Opnd (Par);
 
-         elsif Nkind (Par) in N_In | N_Not_In then
+         elsif Nkind (Par) in N_Membership_Test then
 
             --  If the membership includes several alternatives, only the first
             --  is definitely evaluated.
@@ -30880,10 +30880,8 @@ package body Sem_Util is
                   return True;
 
                when others =>
-                  null;
+                  return False;
             end case;
-
-            return False;
          end Is_Known_On_Entry;
 
       end Conditional_Evaluation;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 4fef8966380..f282d1fad99 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2219,7 +2219,7 @@ package Sem_Util is
    --  type be partially initialized.
 
    function Is_Potentially_Unevaluated (N : Node_Id) return Boolean;
-   --  Predicate to implement definition given in RM 6.1.1 (20/3)
+   --  Predicate to implement definition given in RM 2012 6.1.1 (20/3)
 
    function Is_Potentially_Persistent_Type (T : Entity_Id) return Boolean;
    --  Determines if type T is a potentially persistent type. A potentially
-- 
2.45.1

[COMMITTED 19/30] ada: Fix references to Ada RM in comments

[Marc Poulhiès]

From: Piotr Trojanek <trojanek@adacore.com>

We seem to have a convention of using "RM" in the GNAT comments, not
"Ada RM". Also, the paragraph references by convention should appear
in parentheses, e.g. "8.3(12.3/2)", not "8.3 12.3/2".

gcc/ada/

	* einfo.ads, exp_attr.adb, exp_ch4.adb, exp_ch7.adb,
	lib-writ.adb, libgnat/a-stbuut.ads, sem_ch13.adb, sem_ch3.adb,
	sem_ch7.adb: Use "RM" in comments.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/einfo.ads            | 2 +-
 gcc/ada/exp_attr.adb         | 4 ++--
 gcc/ada/exp_ch4.adb          | 2 +-
 gcc/ada/exp_ch7.adb          | 2 +-
 gcc/ada/lib-writ.adb         | 3 +--
 gcc/ada/libgnat/a-stbuut.ads | 2 +-
 gcc/ada/sem_ch13.adb         | 4 ++--
 gcc/ada/sem_ch3.adb          | 2 +-
 gcc/ada/sem_ch7.adb          | 2 +-
 9 files changed, 11 insertions(+), 12 deletions(-)

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index e5110f51670..0b0529a39cf 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2728,7 +2728,7 @@ package Einfo is
 --       Defined in all entities. Set for implicitly declared subprograms
 --       that require overriding or are null procedures, and are hidden by
 --       a non-fully conformant homograph with the same characteristics
---       (Ada RM 8.3 12.3/2).
+--       (RM 8.3(12.3/2)).
 
 --    Is_Hidden_Open_Scope
 --       Defined in all entities. Set for a scope that contains the
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 0349db28a1a..1396007a2d1 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2173,8 +2173,8 @@ package body Exp_Attr is
       --  for the arguments of a 'Read attribute reference (since the
       --  scalar argument is an OUT scalar) and for the arguments of a
       --  'Has_Same_Storage or 'Overlaps_Storage attribute reference (which not
-      --  considered to be reads of their prefixes and expressions, see Ada RM
-      --  13.3(73.10/3)).
+      --  considered to be reads of their prefixes and expressions, see
+      --  RM 13.3(73.10/3)).
 
       if Validity_Checks_On and then Validity_Check_Operands
         and then Id /= Attribute_Asm_Output
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 6ceffdf8302..95b7765b173 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -8512,7 +8512,7 @@ package body Exp_Ch4 is
 
          --  For small negative exponents, we return the reciprocal of
          --  the folding of the exponentiation for the opposite (positive)
-         --  exponent, as required by Ada RM 4.5.6(11/3).
+         --  exponent, as required by RM 4.5.6(11/3).
 
          if abs Expv <= 4 then
 
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 993c13c7318..fd1d9db0654 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -7419,7 +7419,7 @@ package body Exp_Ch7 is
                      --  non-POC components are finalized before the
                      --  non-POC extension components. This violates the
                      --  usual "finalize in reverse declaration order"
-                     --  principle, but that's ok (see Ada RM 7.6.1(9)).
+                     --  principle, but that's ok (see RM 7.6.1(9)).
                      --
                      --  Last_POC_Call should be non-empty if the extension
                      --  has at least one POC. Interactions with variant
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index 697b2f2b797..0755b92e4db 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -298,8 +298,7 @@ package body Lib.Writ is
          function Is_Implicit_With_Clause (Clause : Node_Id) return Boolean is
          begin
             --  With clauses created for ancestor units are marked as internal,
-            --  however, they emulate the semantics in Ada RM 10.1.2 (6/2),
-            --  where
+            --  however, they emulate the semantics in RM 10.1.2 (6/2), where
             --
             --    with A.B;
             --
diff --git a/gcc/ada/libgnat/a-stbuut.ads b/gcc/ada/libgnat/a-stbuut.ads
index dadfe5f0010..2a8b08bca57 100644
--- a/gcc/ada/libgnat/a-stbuut.ads
+++ b/gcc/ada/libgnat/a-stbuut.ads
@@ -33,7 +33,7 @@ with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
 
 package Ada.Strings.Text_Buffers.Utils with Pure is
 
-   --  Ada.Strings.Text_Buffers is a predefined unit (see Ada RM A.4.12).
+   --  Ada.Strings.Text_Buffers is a predefined unit (see RM A.4.12).
    --  This is a GNAT-defined child unit of that parent.
 
    subtype Character_7 is
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index c0a5b6c2c37..f84ca2c75d7 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -12860,7 +12860,7 @@ package body Sem_Ch13 is
       procedure Hide_Non_Overridden_Subprograms (Typ : Entity_Id);
       --  Inspect the primitive operations of type Typ and hide all pairs of
       --  implicitly declared non-overridden non-fully conformant homographs
-      --  (Ada RM 8.3 12.3/2).
+      --  (RM 8.3(12.3/2)).
 
       -------------------------------------
       -- Hide_Non_Overridden_Subprograms --
@@ -13028,7 +13028,7 @@ package body Sem_Ch13 is
       --  overriding. If this set contains fully conformant homographs, then
       --  one is chosen arbitrarily (already done during resolution), otherwise
       --  all remaining non-fully conformant homographs are hidden from
-      --  visibility (Ada RM 8.3 12.3/2).
+      --  visibility (RM 8.3(12.3/2)).
 
       if Is_Tagged_Type (E) then
          Hide_Non_Overridden_Subprograms (E);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 263be607ec1..0403babff13 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -16553,7 +16553,7 @@ package body Sem_Ch3 is
 
       New_Overloaded_Entity (New_Subp, Derived_Type);
 
-      --  Ada RM 6.1.1 (15): If a subprogram inherits nonconforming class-wide
+      --  RM 6.1.1(15): If a subprogram inherits nonconforming class-wide
       --  preconditions and the derived type is abstract, the derived operation
       --  is abstract as well if parent subprogram is not abstract or null.
 
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index a70d72c94c1..09d85bea335 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -2400,7 +2400,7 @@ package body Sem_Ch7 is
 
          --  Do not enter implicitly inherited non-overridden subprograms of
          --  a tagged type back into visibility if they have non-conformant
-         --  homographs (Ada RM 8.3 12.3/2).
+         --  homographs (RM 8.3(12.3/2)).
 
          elsif Is_Hidden_Non_Overridden_Subpgm (Id) then
             null;
-- 
2.45.1

[COMMITTED 20/30] ada: Further refine 'Super attribute

[Marc Poulhiès]

From: Justin Squirek <squirek@adacore.com>

This patch adds the restriction on 'Super such that it cannot apply to objects
whose parent type is an interface.

gcc/ada/

	* sem_attr.adb (Analyze_Attribute): Add check for interface parent
	types.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_attr.adb | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 4fd270aeae9..2fd95f36d65 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6683,6 +6683,12 @@ package body Sem_Attr is
             elsif Depends_On_Private (P_Type) then
                Error_Attr_P ("prefix type of % is a private extension");
 
+            --  Disallow view conversions to interfaces in order to avoid
+            --  depending on whether an interface type is used as a parent
+            --  or progenitor type.
+
+            elsif Is_Interface (Node (First_Elmt (Parents))) then
+               Error_Attr_P ("type of % cannot be an interface");
             end if;
 
             --  Generate a view conversion and analyze it
-- 
2.45.1

[COMMITTED 21/30] ada: Unreferenced warning on abstract subprogram

[Marc Poulhiès]

From: Justin Squirek <squirek@adacore.com>

This patch modifies the unreferenced entity warning in the compiler to avoid
noisily warning about unreferenced abstract subprogram.

gcc/ada/

	* sem_warn.adb (Warn_On_Unreferenced_Entity): Add a condition to
	ignore warnings on unreferenced abstract subprogram.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_warn.adb | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 2de3f8668b0..91a57d521d1 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -4452,12 +4452,16 @@ package body Sem_Warn is
                  ("?u?literal & is not referenced!", E);
 
             when E_Function =>
-               Error_Msg_N -- CODEFIX
-                 ("?u?function & is not referenced!", E);
+               if not Is_Abstract_Subprogram (E) then
+                  Error_Msg_N -- CODEFIX
+                    ("?u?function & is not referenced!", E);
+               end if;
 
             when E_Procedure =>
-               Error_Msg_N -- CODEFIX
-                 ("?u?procedure & is not referenced!", E);
+               if not Is_Abstract_Subprogram (E) then
+                  Error_Msg_N -- CODEFIX
+                    ("?u?procedure & is not referenced!", E);
+               end if;
 
             when E_Package =>
                Error_Msg_N -- CODEFIX
-- 
2.45.1

[COMMITTED 22/30] ada: Crash checking accessibility level on private type

[Marc Poulhiès]

From: Justin Squirek <squirek@adacore.com>

This patch fixes an issue in the compiler whereby calculating a static
accessibility level on a private type with an access discriminant resulted
in a compile time crash when No_Dynamic_Accessibility_Checks is enabled.

gcc/ada/

	* accessibility.adb (Accessibility_Level): Use Get_Full_View to
	avoid crashes when calculating scope.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/accessibility.adb | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index 33ce001718a..47b3a7af10a 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -2227,7 +2227,7 @@ package body Accessibility is
                   --  that of the type.
 
                   elsif Ekind (Def_Ent) = E_Discriminant then
-                     return Scope_Depth (Scope (Def_Ent));
+                     return Scope_Depth (Get_Full_View (Scope (Def_Ent)));
                   end if;
                end if;
 
-- 
2.45.1

[COMMITTED 23/30] ada: Iterator filter ignored on formal loop

[Marc Poulhiès]

From: Justin Squirek <squirek@adacore.com>

This patch fixs an issue where iterator filters for formal container and
formal container element loops got silently ignored and remained unexpanded.

gcc/ada/

	* exp_ch5.adb (Expand_Formal_Container_Element_Loop): Add
	expansion of filter condition.
	(Expand_Formal_Container_Loop): Add expansion of filter condition.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch5.adb | 45 +++++++++++++++++++++++++++++++++++++--------
 1 file changed, 37 insertions(+), 8 deletions(-)

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 2973658ce98..f397086d73a 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -4394,6 +4394,18 @@ package body Exp_Ch5 is
       Reinit_Field_To_Zero (Init_Name, F_SPARK_Pragma_Inherited);
       Mutate_Ekind (Init_Name, E_Loop_Parameter);
 
+      --  Wrap the block statements with the condition specified in the
+      --  iterator filter when one is present.
+
+      if Present (Iterator_Filter (I_Spec)) then
+         pragma Assert (Ada_Version >= Ada_2022);
+         Set_Statements (Handled_Statement_Sequence (N),
+            New_List (Make_If_Statement (Loc,
+              Condition => Iterator_Filter (I_Spec),
+              Then_Statements =>
+                Statements (Handled_Statement_Sequence (N)))));
+      end if;
+
       --  The cursor was marked as a loop parameter to prevent user assignments
       --  to it, however this renders the advancement step illegal as it is not
       --  possible to change the value of a constant. Flag the advancement step
@@ -4436,6 +4448,7 @@ package body Exp_Ch5 is
       Advance   : Node_Id;
       Init      : Node_Id;
       New_Loop  : Node_Id;
+      Block     : Node_Id;
 
    begin
       --  For an element iterator, the Element aspect must be present,
@@ -4456,7 +4469,6 @@ package body Exp_Ch5 is
 
       Build_Formal_Container_Iteration
         (N, Container, Cursor, Init, Advance, New_Loop);
-      Append_To (Stats, Advance);
 
       Mutate_Ekind (Cursor, E_Variable);
       Insert_Action (N, Init);
@@ -4481,13 +4493,30 @@ package body Exp_Ch5 is
             Convert_To_Iterable_Type (Container, Loc),
             New_Occurrence_Of (Cursor, Loc))));
 
-      Set_Statements (New_Loop,
-        New_List
-          (Make_Block_Statement (Loc,
-             Declarations => New_List (Elmt_Decl),
-             Handled_Statement_Sequence =>
-               Make_Handled_Sequence_Of_Statements (Loc,
-                 Statements => Stats))));
+      Block :=
+        Make_Block_Statement (Loc,
+          Declarations => New_List (Elmt_Decl),
+          Handled_Statement_Sequence =>
+            Make_Handled_Sequence_Of_Statements (Loc,
+              Statements => Stats));
+
+      --  Wrap the block statements with the condition specified in the
+      --  iterator filter when one is present.
+
+      if Present (Iterator_Filter (I_Spec)) then
+         pragma Assert (Ada_Version >= Ada_2022);
+         Set_Statements (Handled_Statement_Sequence (Block),
+            New_List (
+              Make_If_Statement (Loc,
+                Condition       => Iterator_Filter (I_Spec),
+                Then_Statements =>
+                  Statements (Handled_Statement_Sequence (Block))),
+              Advance));
+      else
+         Append_To (Stats, Advance);
+      end if;
+
+      Set_Statements (New_Loop, New_List (Block));
 
       --  The element is only modified in expanded code, so it appears as
       --  unassigned to the warning machinery. We must suppress this spurious
-- 
2.45.1

[COMMITTED 24/30] ada: Missing style check for extra parentheses in operators

[Marc Poulhiès]

From: Justin Squirek <squirek@adacore.com>

This patch fixes an issue in the compiler whereby wrapping an operand
of a boolean operator resulted in a failure to detect whether or not
they were unnecessary for the -gnatyx style checks.

gcc/ada/

	* ali.adb (Get_Nat): Remove unnecessary parentheses.
	* exp_ch11.adb (Expand_Local_Exception_Handlers): Remove
	unnecessary parentheses.
	* freeze.adb (Freeze_Entity): Remove unnecessary parentheses.
	* lib-list.adb (List): Remove unnecessary parentheses.
	* par-ch5.adb (P_Condition): Add extra parentheses checks on
	condition operands.
	* sem_ch3.adb (Add_Interface_Tag_Components): Remove unnecessary
	parentheses.
	(Check_Delta_Expression): Remove unnecessary parenthesis.
	(Check_Digits_Expression): Remove unnecessary parentheses.
	* sem_ch12.adb (Validate_Array_Type_Instance): Remove unnecessary
	parentheses.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/ali.adb      |  2 +-
 gcc/ada/exp_ch11.adb |  2 +-
 gcc/ada/freeze.adb   |  2 +-
 gcc/ada/lib-list.adb |  4 ++--
 gcc/ada/par-ch5.adb  | 25 +++++++++++++++++++++++++
 gcc/ada/sem_ch12.adb |  2 +-
 gcc/ada/sem_ch3.adb  |  6 +++---
 7 files changed, 34 insertions(+), 9 deletions(-)

diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index 69a91bce5ab..7c7f790325b 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -1351,7 +1351,7 @@ package body ALI is
          --  Check if we are on a number. In the case of bad ALI files, this
          --  may not be true.
 
-         if not (Nextc in '0' .. '9') then
+         if Nextc not in '0' .. '9' then
             Fatal_Error;
          end if;
 
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index 9a0f66ff440..678d76cf3eb 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -552,7 +552,7 @@ package body Exp_Ch11 is
 
          --  Nothing to do if no handlers requiring the goto transformation
 
-         if not (Local_Expansion_Required) then
+         if not Local_Expansion_Required then
             return;
          end if;
 
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index ea6106e6455..ea18f87a4ab 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -6963,7 +6963,7 @@ package body Freeze is
                if Is_Type (Comp) then
                   Freeze_And_Append (Comp, N, Result);
 
-               elsif (Ekind (Comp)) /= E_Function then
+               elsif Ekind (Comp) /= E_Function then
 
                   --  The guard on the presence of the Etype seems to be needed
                   --  for some CodePeer (-gnatcC) cases, but not clear why???
diff --git a/gcc/ada/lib-list.adb b/gcc/ada/lib-list.adb
index ecc29258e13..210827abf8e 100644
--- a/gcc/ada/lib-list.adb
+++ b/gcc/ada/lib-list.adb
@@ -80,7 +80,7 @@ begin
       else
          Write_Unit_Name (Unit_Name (Sorted_Units (R)));
 
-         if Name_Len > (Unit_Length - 1) then
+         if Name_Len > Unit_Length - 1 then
             Write_Eol;
             Write_Str (Unit_Bln);
          else
@@ -91,7 +91,7 @@ begin
 
          Write_Name (Full_File_Name (Source_Index (Sorted_Units (R))));
 
-         if Name_Len > (File_Length - 1) then
+         if Name_Len > File_Length - 1 then
             Write_Eol;
             Write_Str (Unit_Bln);
             Write_Str (File_Bln);
diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb
index d72ddffdece..68c3025e3a0 100644
--- a/gcc/ada/par-ch5.adb
+++ b/gcc/ada/par-ch5.adb
@@ -1360,6 +1360,31 @@ package body Ch5 is
       else
          if Style_Check then
             Style.Check_Xtra_Parens (Cond);
+
+            --  When the condition is an operator then examine parentheses
+            --  surrounding the condition's operands - taking care to avoid
+            --  flagging operands which themselves are operators since they
+            --  may be required for resolution or precedence.
+
+            if Nkind (Cond) in N_Op
+                             | N_Membership_Test
+                             | N_Short_Circuit
+              and then Nkind (Right_Opnd (Cond)) not in N_Op
+                                                      | N_Membership_Test
+                                                      | N_Short_Circuit
+            then
+               Style.Check_Xtra_Parens (Right_Opnd (Cond));
+            end if;
+
+            if Nkind (Cond) in N_Binary_Op
+                             | N_Membership_Test
+                             | N_Short_Circuit
+              and then Nkind (Left_Opnd (Cond)) not in N_Op
+                                                     | N_Membership_Test
+                                                     | N_Short_Circuit
+            then
+               Style.Check_Xtra_Parens (Left_Opnd (Cond));
+            end if;
          end if;
 
          --  And return the result
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 9919cda6340..7daa35f7fe1 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -13228,7 +13228,7 @@ package body Sem_Ch12 is
             Abandon_Instantiation (Actual);
 
          elsif Nkind (Def) = N_Constrained_Array_Definition then
-            if not (Is_Constrained (Act_T)) then
+            if not Is_Constrained (Act_T) then
                Error_Msg_NE
                  ("expect constrained array in instantiation of &",
                   Actual, Gen_T);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 0403babff13..cbe2ef8be54 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1616,7 +1616,7 @@ package body Sem_Ch3 is
 
       Last_Tag := Empty;
 
-      if not (Present (Component_List (Ext))) then
+      if not Present (Component_List (Ext)) then
          Set_Null_Present (Ext, False);
          L := New_List;
          Set_Component_List (Ext,
@@ -12454,7 +12454,7 @@ package body Sem_Ch3 is
 
    procedure Check_Delta_Expression (E : Node_Id) is
    begin
-      if not (Is_Real_Type (Etype (E))) then
+      if not Is_Real_Type (Etype (E)) then
          Wrong_Type (E, Any_Real);
 
       elsif not Is_OK_Static_Expression (E) then
@@ -12482,7 +12482,7 @@ package body Sem_Ch3 is
 
    procedure Check_Digits_Expression (E : Node_Id) is
    begin
-      if not (Is_Integer_Type (Etype (E))) then
+      if not Is_Integer_Type (Etype (E)) then
          Wrong_Type (E, Any_Integer);
 
       elsif not Is_OK_Static_Expression (E) then
-- 
2.45.1

[COMMITTED 25/30] ada: Resolve compilation issues with container aggregates in draft ACATS B tests

[Marc Poulhiès]

From: Gary Dismukes <dismukes@adacore.com>

This change set addresses compilation problems encountered in the draft
versions of the following ACATS B tests for container aggregates:

B435001 (container aggregates with Assign_Indexed)
B435002 (container aggregates with Add_Unnamed)
B435003 (container aggregates with Add_Named)
B435004 (container aggregates with Assign_Indexed and Add_Unnamed)

gcc/ada/

	* sem_aggr.adb (Resolve_Iterated_Association): In the case of
	N_Iterated_Element_Associations that have a key expression, issue
	an error if the aggregate type does not have an Add_Named
	operation, and include a reference to RM22 4.3.5(24) in the error
	message. In the case of an N_Component_Association with a
	Defining_Identifer where the "choice" is given by a function call,
	in the creation of the iterator_specification associate a copy of
	Choice as its Name, and remove the call to
	Analyze_Iterator_Specification, which was causing problems with
	the reanalysis of function calls originally given in prefixed form
	that were transformed into function calls in normal (infix) form.
	The iterator_specification will be analyzed later in any case, so
	that call should not be done here. Remove the with and use of
	Sem_Ch5.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_aggr.adb | 26 ++++++++++++++++++++------
 1 file changed, 20 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 60738550ec1..51b88ab831f 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -49,7 +49,6 @@ with Sem_Aux;        use Sem_Aux;
 with Sem_Case;       use Sem_Case;
 with Sem_Cat;        use Sem_Cat;
 with Sem_Ch3;        use Sem_Ch3;
-with Sem_Ch5;        use Sem_Ch5;
 with Sem_Ch8;        use Sem_Ch8;
 with Sem_Ch13;       use Sem_Ch13;
 with Sem_Dim;        use Sem_Dim;
@@ -3381,7 +3380,15 @@ package body Sem_Aggr is
 
             Key_Expr := Key_Expression (Comp);
             if Present (Key_Expr) then
-               Preanalyze_And_Resolve (New_Copy_Tree (Key_Expr), Key_Type);
+               if not Present (Add_Named_Subp) then
+                  Error_Msg_N
+                    ("iterated_element_association with key_expression only "
+                       & "allowed for container type with Add_Named operation "
+                       & "(RM22 4.3.5(24))",
+                     Comp);
+               else
+                  Preanalyze_And_Resolve (New_Copy_Tree (Key_Expr), Key_Type);
+               end if;
             end if;
             End_Scope;
 
@@ -3414,6 +3421,16 @@ package body Sem_Aggr is
          else
             Choice := First (Discrete_Choices (Comp));
 
+            --  A copy of Choice is made before it's analyzed, to preserve
+            --  prefixed calls in their original form, because otherwise the
+            --  analysis of Choice can transform such calls to normal form,
+            --  and the later analysis of an iterator_specification created
+            --  below in the case of a function-call choice may trigger an
+            --  error on the call (in the case where the function is not
+            --  directly visible).
+
+            Copy := Copy_Separate_Tree (Choice);
+
             --  This is an N_Component_Association with a Defining_Identifier
             --  and Discrete_Choice_List, but the latter can only have a single
             --  choice, as it's a stand-in for a Loop_Parameter_Specification
@@ -3437,7 +3454,7 @@ package body Sem_Aggr is
                     Make_Iterator_Specification (Sloc (N),
                       Defining_Identifier =>
                         Relocate_Node (Defining_Identifier (Comp)),
-                      Name                => New_Copy_Tree (Choice),
+                      Name                => Copy,
                       Reverse_Present     => False,
                       Iterator_Filter     => Empty,
                       Subtype_Indication  => Empty);
@@ -3445,9 +3462,6 @@ package body Sem_Aggr is
                   Set_Iterator_Specification (Comp, I_Spec);
                   Set_Defining_Identifier (Comp, Empty);
 
-                  Analyze_Iterator_Specification
-                    (Iterator_Specification (Comp));
-
                   Resolve_Iterated_Association (Comp, Key_Type, Elmt_Type);
                   --  Recursive call to expand association as iterator_spec
 
-- 
2.45.1

[COMMITTED 26/30] ada: For freezing, treat an extension or delta aggregate like a regular aggregate.

[Marc Poulhiès]

From: Steve Baird <baird@adacore.com>

Extend existing special freezing rules for regular aggregates to also apply to
extension and delta aggregates.

gcc/ada/

	* freeze.adb
	(Should_Freeze_Type.Is_Dispatching_Call_Or_Aggregate): Treat an extension
	aggregate or a delta aggregate like a regular aggregate.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/freeze.adb | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index ea18f87a4ab..c872050dd35 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -222,7 +222,9 @@ package body Freeze is
                       = Scope (Typ)
          then
             return Abandon;
-         elsif Nkind (N) = N_Aggregate
+         elsif Nkind (N) in N_Aggregate
+                          | N_Extension_Aggregate
+                          | N_Delta_Aggregate
            and then Base_Type (Etype (N)) = Base_Type (Typ)
          then
             return Abandon;
-- 
2.45.1

[COMMITTED 27/30] ada: Minor code adjustment to "not Present" test

[Marc Poulhiès]

From: Gary Dismukes <dismukes@adacore.com>

This is just changing a "not Present (...)" test to "No (...)"
to address a CB complaint from gnatcheck.

gcc/ada/

	* sem_aggr.adb (Resolve_Iterated_Association): Change "not Present"
	to "No" in test of Add_Named_Subp.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_aggr.adb | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 51b88ab831f..249350d21de 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3380,7 +3380,7 @@ package body Sem_Aggr is
 
             Key_Expr := Key_Expression (Comp);
             if Present (Key_Expr) then
-               if not Present (Add_Named_Subp) then
+               if No (Add_Named_Subp) then
                   Error_Msg_N
                     ("iterated_element_association with key_expression only "
                        & "allowed for container type with Add_Named operation "
-- 
2.45.1

[COMMITTED 28/30] ada: Derived type with convention C must override convention C_Pass_By_Copy

[Marc Poulhiès]

From: Gary Dismukes <dismukes@adacore.com>

If a type DT is derived from a record type T with convention C_Pass_By_Copy
and explicitly specifies convention C (via aspect or pragma), then type DT
should not be treated as a type with convention C_Pass_By_Copy. Any parameters
of the derived type should be passed by reference rather than by copy. The
compiler was incorrectly inheriting convention C_Pass_By_Copy, by inheriting
the flag set on the parent type, but that flag needs to be unset in the case
where the convention is overridden.

gcc/ada/

	* sem_prag.adb (Set_Convention_From_Pragma): If the specified convention on
	a record type is not C_Pass_By_Copy, then force the C_Pass_By_Copy flag to
	False, to ensure that it's overridden.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_prag.adb | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 9ccf1b9cf65..671b2a542ea 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -8498,6 +8498,15 @@ package body Sem_Prag is
                end if;
             end if;
 
+            --  If the convention of a record type is changed (such as to C),
+            --  this must override C_Pass_By_Copy if that flag was inherited
+            --  from a parent type where the latter convention was specified,
+            --  so we force the flag to False.
+
+            if Cname /= Name_C_Pass_By_Copy and then Is_Record_Type (E) then
+               Set_C_Pass_By_Copy (Base_Type (E), False);
+            end if;
+
             --  If the entity is a derived boolean type, check for the special
             --  case of convention C, C++, or Fortran, where we consider any
             --  nonzero value to represent true.
-- 
2.45.1

[COMMITTED 29/30] ada: Storage_Error in indirect call to function returning limited type

[Marc Poulhiès]

From: Javier Miranda <miranda@adacore.com>

At runtime the code generated by the compiler reports the
exception Storage_Error in an indirect call through an
access-to-subprogram variable that references a function
returning a limited tagged type object.

gcc/ada/

	* sem_ch6.adb (Might_Need_BIP_Task_Actuals): Add support
	for access-to-subprogram parameter types.
	* exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call):
	Add dummy BIP parameters to access-to-subprogram types
	that may reference a function that has BIP parameters.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch6.adb | 11 ++++++++---
 gcc/ada/sem_ch6.adb | 12 +++++++-----
 2 files changed, 15 insertions(+), 8 deletions(-)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index b5c5865242d..005210ce6bd 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -642,15 +642,20 @@ package body Exp_Ch6 is
       Master_Formal : Node_Id;
 
    begin
+      pragma Assert (Ekind (Function_Id) in E_Function
+                                          | E_Subprogram_Type);
+
       --  No such extra parameters are needed if there are no tasks
 
       if not Needs_BIP_Task_Actuals (Function_Id) then
 
          --  However we must add dummy extra actuals if the function is
-         --  a dispatching operation that inherited these extra formals.
+         --  a dispatching operation that inherited these extra formals
+         --  or an access-to-subprogram type that requires these extra
+         --  actuals.
 
-         if Is_Dispatching_Operation (Function_Id)
-           and then Has_BIP_Extra_Formal (Function_Id, BIP_Task_Master)
+         if Has_BIP_Extra_Formal (Function_Id, BIP_Task_Master,
+              Must_Be_Frozen => False)
          then
             Master_Formal :=
               Build_In_Place_Formal (Function_Id, BIP_Task_Master);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index ca40b5479e0..50dac5c4a51 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8663,9 +8663,12 @@ package body Sem_Ch6 is
       --  Determines if E has its extra formals
 
       function Might_Need_BIP_Task_Actuals (E : Entity_Id) return Boolean;
-      --  Determines if E is a dispatching primitive returning a limited tagged
-      --  type object since some descendant might return an object with tasks
-      --  (and therefore need the BIP task extra actuals).
+      --  Determines if E is a function or an access to a function returning a
+      --  limited tagged type object. On dispatching primitives this predicate
+      --  is used to determine if some descendant of the function might return
+      --  an object with tasks (and therefore need the BIP task extra actuals).
+      --  On access-to-subprogram types it is used to determine if the target
+      --  function might return an object with tasks.
 
       function Needs_Accessibility_Check_Extra
         (E      : Entity_Id;
@@ -8786,9 +8789,8 @@ package body Sem_Ch6 is
 
          Func_Typ := Root_Type (Underlying_Type (Etype (Subp_Id)));
 
-         return Ekind (Subp_Id) = E_Function
+         return Ekind (Subp_Id) in E_Function | E_Subprogram_Type
            and then not Has_Foreign_Convention (Func_Typ)
-           and then Is_Dispatching_Operation (Subp_Id)
            and then Is_Tagged_Type (Func_Typ)
            and then Is_Limited_Type (Func_Typ)
            and then not Has_Aspect (Func_Typ, Aspect_No_Task_Parts);
-- 
2.45.1

[COMMITTED 30/30] ada: Add support for No_Implicit_Conditionals to nonbinary modular types

[Marc Poulhiès]

From: Eric Botcazou <ebotcazou@adacore.com>

The expansion of additive operations for nonbinary modular types implemented
in the front-end and its counterpart in code generators may create branches,
which is not allowed when restriction No_Implicit_Conditionals is in effect.

This changes it to use an explicit Mod operation when the restriction is in
effect, which is assumed not to create such branches.

gcc/ada/

	* exp_ch4.adb (Expand_Nonbinary_Modular_Op): Create an explicit Mod
	for additive operations if No_Implicit_Conditionals is in effect.
	(Expand_Modular_Addition): Likewise.
	(Expand_Modular_Subtraction): Likewise.
	(Expand_Modular_Op): Always use an unsigned type obtained by calling
	Small_Integer_Type_For on the required size.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch4.adb | 132 ++++++++++++++++++++++++++------------------
 1 file changed, 77 insertions(+), 55 deletions(-)

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 95b7765b173..bf90b46249a 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -139,9 +139,10 @@ package body Exp_Ch4 is
    --  case of array type arguments.
 
    procedure Expand_Nonbinary_Modular_Op (N : Node_Id);
-   --  When generating C code, convert nonbinary modular arithmetic operations
-   --  into code that relies on the front-end expansion of operator Mod. No
-   --  expansion is performed if N is not a nonbinary modular operand.
+   --  When generating C code or if restriction No_Implicit_Conditionals is in
+   --  effect, convert most nonbinary modular arithmetic operations into code
+   --  that relies on the expansion of an explicit Mod operator. No expansion
+   --  is performed if N is not a nonbinary modular operation.
 
    procedure Expand_Short_Circuit_Operator (N : Node_Id);
    --  Common expansion processing for short-circuit boolean operators
@@ -3899,10 +3900,13 @@ package body Exp_Ch4 is
 
       procedure Expand_Modular_Addition is
       begin
-         --  If this is not the addition of a constant then compute it using
-         --  the general rule: (lhs + rhs) mod Modulus
+         --  If this is not the addition of a constant or else restriction
+         --  No_Implicit_Conditionals is in effect, then compute it using
+         --  the general rule: (lhs + rhs) mod Modulus.
 
-         if Nkind (Right_Opnd (N)) /= N_Integer_Literal then
+         if Nkind (Right_Opnd (N)) /= N_Integer_Literal
+           or else Restriction_Active (No_Implicit_Conditionals)
+         then
             Expand_Modular_Op;
 
          --  If this is an addition of a constant, convert it to a subtraction
@@ -3921,6 +3925,7 @@ package body Exp_Ch4 is
                Cond_Expr : Node_Id;
                Then_Expr : Node_Id;
                Else_Expr : Node_Id;
+
             begin
                --  To prevent spurious visibility issues, convert all
                --  operands to Standard.Unsigned.
@@ -3966,12 +3971,12 @@ package body Exp_Ch4 is
          --   We will convert to another type (not a nonbinary-modulus modular
          --   type), evaluate the op in that representation, reduce the result,
          --   and convert back to the original type. This means that the
-         --   backend does not have to deal with nonbinary-modulus ops.
-
-         Op_Expr  : constant Node_Id := New_Op_Node (Nkind (N), Loc);
-         Mod_Expr : Node_Id;
+         --   back end does not have to deal with nonbinary-modulus ops.
 
+         Mod_Expr    : Node_Id;
+         Op_Expr     : Node_Id;
          Target_Type : Entity_Id;
+
       begin
          --  Select a target type that is large enough to avoid spurious
          --  intermediate overflow on pre-reduction computation (for
@@ -3979,22 +3984,15 @@ package body Exp_Ch4 is
 
          declare
             Required_Size : Uint := RM_Size (Etype (N));
-            Use_Unsigned  : Boolean := True;
+
          begin
             case Nkind (N) is
-               when N_Op_Add =>
+               when N_Op_Add | N_Op_Subtract =>
                   --  For example, if modulus is 255 then RM_Size will be 8
                   --  and the range of possible values (before reduction) will
                   --  be 0 .. 508; that range requires 9 bits.
                   Required_Size := Required_Size + 1;
 
-               when N_Op_Subtract =>
-                  --  For example, if modulus is 255 then RM_Size will be 8
-                  --  and the range of possible values (before reduction) will
-                  --  be -254 .. 254; that range requires 9 bits, signed.
-                  Use_Unsigned := False;
-                  Required_Size := Required_Size + 1;
-
                when N_Op_Multiply =>
                   --  For example, if modulus is 255 then RM_Size will be 8
                   --  and the range of possible values (before reduction) will
@@ -4005,37 +4003,15 @@ package body Exp_Ch4 is
                   null;
             end case;
 
-            if Use_Unsigned then
-               if Required_Size <= Standard_Short_Short_Integer_Size then
-                  Target_Type := Standard_Short_Short_Unsigned;
-               elsif Required_Size <= Standard_Short_Integer_Size then
-                  Target_Type := Standard_Short_Unsigned;
-               elsif Required_Size <= Standard_Integer_Size then
-                  Target_Type := Standard_Unsigned;
-               else
-                  pragma Assert (Required_Size <= 64);
-                  Target_Type := Standard_Unsigned_64;
-               end if;
-            elsif Required_Size <= 8 then
-               Target_Type := Standard_Integer_8;
-            elsif Required_Size <= 16 then
-               Target_Type := Standard_Integer_16;
-            elsif Required_Size <= 32 then
-               Target_Type := Standard_Integer_32;
-            else
-               pragma Assert (Required_Size <= 64);
-               Target_Type := Standard_Integer_64;
-            end if;
-
+            Target_Type := Small_Integer_Type_For (Required_Size, Uns => True);
             pragma Assert (Present (Target_Type));
          end;
 
+         Op_Expr := New_Op_Node (Nkind (N), Loc);
          Set_Left_Opnd (Op_Expr,
-           Unchecked_Convert_To (Target_Type,
-             New_Copy_Tree (Left_Opnd (N))));
+           Unchecked_Convert_To (Target_Type, New_Copy_Tree (Left_Opnd (N))));
          Set_Right_Opnd (Op_Expr,
-           Unchecked_Convert_To (Target_Type,
-             New_Copy_Tree (Right_Opnd (N))));
+           Unchecked_Convert_To (Target_Type, New_Copy_Tree (Right_Opnd (N))));
 
          --  ??? Why do this stuff for some ops and not others?
          if Nkind (N) not in N_Op_And | N_Op_Or | N_Op_Xor then
@@ -4064,13 +4040,24 @@ package body Exp_Ch4 is
             Force_Evaluation (Op_Expr, Mode => Strict);
          end if;
 
+         --  Unconditionally add the modulus to the result for a subtraction,
+         --  this gets rid of all its peculiarities by cancelling out the
+         --  addition of the binary modulus in the case where the subtraction
+         --  wraps around in Target_Type.
+
+         if Nkind (N) = N_Op_Subtract then
+            Op_Expr :=
+               Make_Op_Add (Loc,
+                 Left_Opnd  => Op_Expr,
+                 Right_Opnd => Make_Integer_Literal (Loc, Modulus (Typ)));
+         end if;
+
          Mod_Expr :=
            Make_Op_Mod (Loc,
              Left_Opnd  => Op_Expr,
              Right_Opnd => Make_Integer_Literal (Loc, Modulus (Typ)));
 
-         Rewrite (N,
-           Unchecked_Convert_To (Typ, Mod_Expr));
+         Rewrite (N, Unchecked_Convert_To (Typ, Mod_Expr));
       end Expand_Modular_Op;
 
       --------------------------------
@@ -4079,10 +4066,13 @@ package body Exp_Ch4 is
 
       procedure Expand_Modular_Subtraction is
       begin
-         --  If this is not the addition of a constant then compute it using
-         --  the general rule: (lhs + rhs) mod Modulus
+         --  If this is not the addition of a constant or else restriction
+         --  No_Implicit_Conditionals is in effect, then compute it using
+         --  the general rule: (lhs - rhs) mod Modulus.
 
-         if Nkind (Right_Opnd (N)) /= N_Integer_Literal then
+         if Nkind (Right_Opnd (N)) /= N_Integer_Literal
+           or else Restriction_Active (No_Implicit_Conditionals)
+         then
             Expand_Modular_Op;
 
          --  If this is an addition of a constant, convert it to a subtraction
@@ -4101,6 +4091,7 @@ package body Exp_Ch4 is
                Cond_Expr : Node_Id;
                Then_Expr : Node_Id;
                Else_Expr : Node_Id;
+
             begin
                Cond_Expr :=
                  Make_Op_Lt (Loc,
@@ -4139,23 +4130,46 @@ package body Exp_Ch4 is
    --  Start of processing for Expand_Nonbinary_Modular_Op
 
    begin
-      --  No action needed if front-end expansion is not required or if we
-      --  have a binary modular operand.
+      --  No action needed if we have a binary modular operand
 
-      if not Expand_Nonbinary_Modular_Ops
-        or else not Non_Binary_Modulus (Typ)
-      then
+      if not Non_Binary_Modulus (Typ) then
          return;
       end if;
 
       case Nkind (N) is
          when N_Op_Add =>
+            --  No action needed if front-end expansion is not required and
+            --  restriction No_Implicit_Conditionals is not in effect.
+
+            if not Expand_Nonbinary_Modular_Ops
+              and then not Restriction_Active (No_Implicit_Conditionals)
+            then
+               return;
+            end if;
+
             Expand_Modular_Addition;
 
          when N_Op_Subtract =>
+            --  No action needed if front-end expansion is not required and
+            --  restriction No_Implicit_Conditionals is not in effect.
+
+            if not Expand_Nonbinary_Modular_Ops
+              and then not Restriction_Active (No_Implicit_Conditionals)
+            then
+               return;
+            end if;
+
             Expand_Modular_Subtraction;
 
          when N_Op_Minus =>
+            --  No action needed if front-end expansion is not required and
+            --  restriction No_Implicit_Conditionals is not in effect.
+
+            if not Expand_Nonbinary_Modular_Ops
+              and then not Restriction_Active (No_Implicit_Conditionals)
+            then
+               return;
+            end if;
 
             --  Expand -expr into (0 - expr)
 
@@ -4166,6 +4180,14 @@ package body Exp_Ch4 is
             Analyze_And_Resolve (N, Typ);
 
          when others =>
+            --  No action needed only if front-end expansion is not required
+            --  because we assume that logical and multiplicative operations
+            --  do not involve implicit conditionals.
+
+            if not Expand_Nonbinary_Modular_Ops then
+               return;
+            end if;
+
             Expand_Modular_Op;
       end case;
 
-- 
2.45.1