[multiple changes]

2017-01-06  Justin Squirek  <squirek@adacore.com>

	* exp_ch9.adb (Expand_N_Protected_Type_Declaration):
	Remove declaration generation in the case of
	System_Tasking_Protected_Objects_Single_Entry being used,
	and add a warning message when this is detected to occur.
	(Make_Initialize_Protection): Remove reference pass in the case
	of System_Tasking_Protected_Objects_Single_Entry.
	* rtsfind.ads: Remove RE_Protected_Entry_Queue_Max
	* s-tposen.adb (Initialize_Protection_Entry): Remove
	Entry_Queue_Max parameter.
	* s-tposen.ads: Remove the types use to store the entry queue
	maximum.
	* sem_prag.adb (Analyze_Pragma): Remove entry families restriction

2017-01-06  Yannick Moy  <moy@adacore.com>

	* sem_util.adb, sem_util.ads (Get_Enum_Lit_From_Pos): Strengthen
	behavior of function, to also accept out of range positions
	and raise Constraint_Error in such case, and to copy sloc from
	literal if No_Location passed as location.
	* uintp.adb, uintp.ads (UI_To_Int, UI_To_CC): Strengthen behavior
	of functions to raise Constraint_Error in case of value not in
	appropriate range.

2017-01-06  Tristan Gingold  <gingold@adacore.com>

	* sem_util.adb, s-taprop-linux.adb (Finalize_TCB): Remove call to
	Invalidate_Stack_Cache.

2017-01-06  Eric Botcazou  <ebotcazou@adacore.com>

	* s-os_lib.adb: Minor fix to the signature of Readlink.

2017-01-06  Javier Miranda  <miranda@adacore.com>

	* sem_ch6.adb (Conforming_Types): Handle another
	confusion between views in a nested instance with an actual
	private type whose full view is not in scope.

2017-01-06  Arnaud Charlet  <charlet@adacore.com>

	* exp_ch5.adb (Expand_N_If_Statement): Obey existing comment and
	mark a rewritten if statement as explicit (Comes_From_Source).

From-SVN: r244128

gcc/ada/ChangeLog

@@ -1,3 +1,48 @@
+2017-01-06  Justin Squirek  <squirek@adacore.com>
+
+	* exp_ch9.adb (Expand_N_Protected_Type_Declaration):
+	Remove declaration generation in the case of
+	System_Tasking_Protected_Objects_Single_Entry being used,
+	and add a warning message when this is detected to occur.
+	(Make_Initialize_Protection): Remove reference pass in the case
+	of System_Tasking_Protected_Objects_Single_Entry.
+	* rtsfind.ads: Remove RE_Protected_Entry_Queue_Max
+	* s-tposen.adb (Initialize_Protection_Entry): Remove
+	Entry_Queue_Max parameter.
+	* s-tposen.ads: Remove the types use to store the entry queue
+	maximum.
+	* sem_prag.adb (Analyze_Pragma): Remove entry families restriction
+
+2017-01-06  Yannick Moy  <moy@adacore.com>
+
+	* sem_util.adb, sem_util.ads (Get_Enum_Lit_From_Pos): Strengthen
+	behavior of function, to also accept out of range positions
+	and raise Constraint_Error in such case, and to copy sloc from
+	literal if No_Location passed as location.
+	* uintp.adb, uintp.ads (UI_To_Int, UI_To_CC): Strengthen behavior
+	of functions to raise Constraint_Error in case of value not in
+	appropriate range.
+
+2017-01-06  Tristan Gingold  <gingold@adacore.com>
+
+	* sem_util.adb, s-taprop-linux.adb (Finalize_TCB): Remove call to
+	Invalidate_Stack_Cache.
+
+2017-01-06  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* s-os_lib.adb: Minor fix to the signature of Readlink.
+
+2017-01-06  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch6.adb (Conforming_Types): Handle another
+	confusion between views in a nested instance with an actual
+	private type whose full view is not in scope.
+
+2017-01-06  Arnaud Charlet  <charlet@adacore.com>
+
+	* exp_ch5.adb (Expand_N_If_Statement): Obey existing comment and
+	mark a rewritten if statement as explicit (Comes_From_Source).
+
 2017-01-06  Gary Dismukes  <dismukes@adacore.com>
 
 	* sem_prag.adb, rtsfind.adb, sem_util.adb: Minor typo fixes.

gcc/ada/exp_ch5.adb

@@ -3209,10 +3209,6 @@ package body Exp_Ch5 is
             if Present (Condition_Actions (E))
               or else Compile_Time_Known_Value (Condition (E))
             then
-               --  Note this is not an implicit if statement, since it is part
-               --  of an explicit if statement in the source (or of an implicit
-               --  if statement that has already been tested).
-
                New_If :=
                  Make_If_Statement (Sloc (E),
                    Condition       => Condition (E),
@@ -3243,6 +3239,15 @@ package body Exp_Ch5 is
                end if;
 
                Analyze (New_If);
+
+               --  Note this is not an implicit if statement, since it is part
+               --  of an explicit if statement in the source (or of an implicit
+               --  if statement that has already been tested). We set the flag
+               --  after calling Analyze to avoid generating extra warnings
+               --  specific to pure if statements, however (see
+               --  Sem_Ch5.Analyze_If_Statement).
+
+               Set_Comes_From_Source (New_If, Comes_From_Source (N));
                return;
 
             --  No special processing for that elsif part, move to next

gcc/ada/exp_ch9.adb

@@ -9768,6 +9768,7 @@ package body Exp_Ch9 is
       --  initialization routine.
 
       declare
+         Max      : Uint;
          Maxs     : constant List_Id := New_List;
          Count    : Int;
          Item     : Entity_Id;
@@ -9786,69 +9787,80 @@ package body Exp_Ch9 is
             while Present (Item) loop
                if Is_Entry (Item) then
                   Count := Count + 1;
+                  Max   := Get_Max_Queue_Length (Item);
 
-                  Append_To (Maxs,
+                  --  The package System_Tasking_Protected_Objects_Single_Entry
-                    Make_Integer_Literal (Loc,
+                  --  is only used in cases where queue length is 1, so if this
-                      Intval => Get_Max_Queue_Length (Item)));
+                  --  package is being used and there is a value supplied for
+                  --  it print an error message and halt compilation.
+
+                  if Max /= 0
+                    and then Corresponding_Runtime_Package (Prot_Typ) =
+                               System_Tasking_Protected_Objects_Single_Entry
+                  then
+                     Error_Msg_N
+                       ("max_queue_length cannot be applied to entries under "
+                        & "the Ravenscar profile", Item);
+                     raise Program_Error;
+                  end if;
+
+                  Append_To (Maxs, Make_Integer_Literal (Loc, Intval => Max));
                end if;
 
                Next_Entity (Item);
             end loop;
 
-            --  Create the declaration of the array object. Generate:
-
-            --    Maxs_Id : aliased Protected_Entry_Queue_Max_Array
-            --                        (1 .. Count) := (..., ...);
-            --      or
-            --    Maxs_Id : aliased Protected_Entry_Queue_Max := <value>;
-
-            Maxs_Id :=
-              Make_Defining_Identifier (Loc,
-                Chars => New_External_Name (Chars (Prot_Typ), 'B'));
-
             case Corresponding_Runtime_Package (Prot_Typ) is
                when System_Tasking_Protected_Objects_Entries =>
-                  Expr := Make_Aggregate (Loc, Maxs);
 
-                  Obj_Def :=
+                  --  Create the declaration of the array object. Generate:
-                    Make_Subtype_Indication (Loc,
+
-                      Subtype_Mark =>
+                  --    Maxs_Id : aliased Protected_Entry_Queue_Max_Array
-                        New_Occurrence_Of
+                  --                        (1 .. Count) := (..., ...);
-                          (RTE (RE_Protected_Entry_Queue_Max_Array), Loc),
+
-                      Constraint   =>
+                  Maxs_Id :=
-                        Make_Index_Or_Discriminant_Constraint (Loc,
+                    Make_Defining_Identifier (Loc,
-                          Constraints => New_List (
+                      Chars => New_External_Name (Chars (Prot_Typ), 'B'));
-                            Make_Range (Loc,
+
-                              Make_Integer_Literal (Loc, 1),
+                  Max_Vals :=
-                              Make_Integer_Literal (Loc, Count)))));
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => Maxs_Id,
+                      Aliased_Present     => True,
+                      Object_Definition   =>
+                        Make_Subtype_Indication (Loc,
+                          Subtype_Mark =>
+                            New_Occurrence_Of
+                              (RTE (RE_Protected_Entry_Queue_Max_Array), Loc),
+                          Constraint   =>
+                            Make_Index_Or_Discriminant_Constraint (Loc,
+                              Constraints => New_List (
+                                Make_Range (Loc,
+                                  Make_Integer_Literal (Loc, 1),
+                                  Make_Integer_Literal (Loc, Count))))),
+                      Expression          => Make_Aggregate (Loc, Maxs));
+
+                  --  A pointer to this array will be placed in the
+                  --  corresponding record by its initialization procedure so
+                  --  this needs to be analyzed here.
+
+                  Insert_After (Current_Node, Max_Vals);
+                  Current_Node := Max_Vals;
+                  Analyze (Max_Vals);
+
+                  Set_Entry_Max_Queue_Lengths_Array (Prot_Typ, Maxs_Id);
 
                when System_Tasking_Protected_Objects_Single_Entry =>
-                  Expr := Make_Integer_Literal (Loc, Intval (First (Maxs)));
 
-                  Obj_Def :=
+                  --  If this section is entered this means the package
-                    New_Occurrence_Of
+                  --  System_Tasking_Protected_Objects_Single_Entry is being
-                      (RTE (RE_Protected_Entry_Queue_Max), Loc);
+                  --  used and that it correctly has no Max_Queue_Length
+                  --  specified, so fall through and continue normally.
+
+                  null;
 
                when others =>
                   raise Program_Error;
             end case;
-
-            Max_Vals :=
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Maxs_Id,
-                Aliased_Present     => True,
-                Object_Definition   => Obj_Def,
-                Expression          => Expr);
-
-            --  A pointer to this array will be placed in the corresponding
-            --  record by its initialization procedure so this needs to be
-            --  analyzed here.
-
-            Insert_After (Current_Node, Max_Vals);
-            Current_Node := Max_Vals;
-            Analyze (Max_Vals);
-
-            Set_Entry_Max_Queue_Lengths_Array (Prot_Typ, Maxs_Id);
          end if;
       end;
 
@@ -14201,7 +14213,9 @@ package body Exp_Ch9 is
             --  naturals representing the entry queue maximums for each entry
             --  in the protected type. Zero represents no max.
 
-            if Has_Entry then
+            if Has_Entry
+              and then Pkg_Id /= System_Tasking_Protected_Objects_Single_Entry
+            then
                Append_To (Args,
                  Make_Attribute_Reference (Loc,
                    Prefix         =>
@@ -14212,9 +14226,7 @@ package body Exp_Ch9 is
             --  Edge cases exist where entry initialization functions are
             --  called, but no entries exist, so null is appended.
 
-            elsif Pkg_Id = System_Tasking_Protected_Objects_Single_Entry
+            elsif Pkg_Id = System_Tasking_Protected_Objects_Entries then
-              or else Pkg_Id = System_Tasking_Protected_Objects_Entries
-            then
                Append_To (Args, Make_Null (Loc));
             end if;
 

gcc/ada/rtsfind.ads

@@ -1717,7 +1717,6 @@ package Rtsfind is
      RE_Service_Entry,                   -- Protected_Objects.Single_Entry
      RE_Exceptional_Complete_Single_Entry_Body,
      RE_Protected_Count_Entry,           -- Protected_Objects.Single_Entry
-     RE_Protected_Entry_Queue_Max,       -- Protected_Objects.Single_Entry
      RE_Protected_Single_Entry_Caller,   -- Protected_Objects.Single_Entry
 
      RE_Protected_Entry_Index,           -- System.Tasking.Protected_Objects
@@ -2993,8 +2992,6 @@ package Rtsfind is
        System_Tasking_Protected_Objects_Single_Entry,
      RE_Protected_Count_Entry            =>
        System_Tasking_Protected_Objects_Single_Entry,
-     RE_Protected_Entry_Queue_Max        =>
-       System_Tasking_Protected_Objects_Single_Entry,
      RE_Protected_Single_Entry_Caller    =>
        System_Tasking_Protected_Objects_Single_Entry,
 

gcc/ada/s-os_lib.adb

@@ -2060,7 +2060,7 @@ package body System.OS_Lib is
       function Readlink
         (Path   : System.Address;
          Buf    : System.Address;
-         Bufsiz : Integer) return Integer;
+         Bufsiz : size_t) return Integer;
       pragma Import (C, Readlink, "__gnat_readlink");
 
       function To_Canonical_File_Spec

gcc/ada/s-taprop-linux.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2015, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2016, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -45,7 +45,6 @@ with System.Tasking.Debug;
 with System.Interrupt_Management;
 with System.OS_Constants;
 with System.OS_Primitives;
-with System.Stack_Checking.Operations;
 with System.Multiprocessors;
 
 with System.Soft_Links;
@@ -58,7 +57,6 @@ package body System.Task_Primitives.Operations is
 
    package OSC renames System.OS_Constants;
    package SSL renames System.Soft_Links;
-   package SC renames System.Stack_Checking.Operations;
 
    use System.Tasking.Debug;
    use System.Tasking;
@@ -1048,8 +1046,6 @@ package body System.Task_Primitives.Operations is
          Known_Tasks (T.Known_Tasks_Index) := null;
       end if;
 
-      SC.Invalidate_Stack_Cache (T.Common.Compiler_Data.Pri_Stack_Info'Access);
-
       ATCB_Allocation.Free_ATCB (T);
    end Finalize_TCB;
 

gcc/ada/s-tposen.adb

@@ -215,11 +215,10 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    ---------------------------------
 
    procedure Initialize_Protection_Entry
-     (Object            : Protection_Entry_Access;
+     (Object           : Protection_Entry_Access;
-      Ceiling_Priority  : Integer;
+      Ceiling_Priority : Integer;
-      Compiler_Info     : System.Address;
+      Compiler_Info    : System.Address;
-      Entry_Queue_Max   : Protected_Entry_Queue_Max_Access;
+      Entry_Body       : Entry_Body_Access)
-      Entry_Body        : Entry_Body_Access)
    is
    begin
       Initialize_Protection (Object.Common'Access, Ceiling_Priority);
@@ -227,7 +226,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is
       Object.Compiler_Info := Compiler_Info;
       Object.Call_In_Progress := null;
       Object.Entry_Body := Entry_Body;
-      Object.Entry_Queue_Max := Entry_Queue_Max;
       Object.Entry_Queue := null;
    end Initialize_Protection_Entry;
 

gcc/ada/s-tposen.ads

@@ -182,17 +182,11 @@ package System.Tasking.Protected_Objects.Single_Entry is
 
    type Protection_Entry_Access is access all Protection_Entry;
 
-   type Protected_Entry_Queue_Max is new Natural;
-
-   type Protected_Entry_Queue_Max_Access is
-     access all Protected_Entry_Queue_Max;
-
    procedure Initialize_Protection_Entry
-     (Object            : Protection_Entry_Access;
+     (Object           : Protection_Entry_Access;
-      Ceiling_Priority  : Integer;
+      Ceiling_Priority : Integer;
-      Compiler_Info     : System.Address;
+      Compiler_Info    : System.Address;
-      Entry_Queue_Max   : Protected_Entry_Queue_Max_Access;
+      Entry_Body       : Entry_Body_Access);
-      Entry_Body        : Entry_Body_Access);
    --  Initialize the Object parameter so that it can be used by the run time
    --  to keep track of the runtime state of a protected object.
 
@@ -276,10 +270,6 @@ private
 
       Entry_Queue : Entry_Call_Link;
       --  Place to store the waiting entry call (if any)
-
-      Entry_Queue_Max : Protected_Entry_Queue_Max_Access;
-      --  Access to a natural representing the max value for the single
-      --  entry's queue length. A value of 0 signifies no max.
    end record;
 
 end System.Tasking.Protected_Objects.Single_Entry;

gcc/ada/sem_ch6.adb

@@ -7183,6 +7183,15 @@ package body Sem_Ch6 is
          return Ctype <= Mode_Conformant
            or else Subtypes_Statically_Match (Type_1, Full_View (Type_2));
 
+      --  Another confusion between views in a nested instance with an
+      --  actual private type whose full view is not in scope.
+
+      elsif Ekind (Type_2) = E_Private_Subtype
+        and then In_Instance
+        and then Etype (Type_2) = Type_1
+      then
+         return True;
+
       --  In Ada 2012, incomplete types (including limited views) can appear
       --  as actuals in instantiations.
 

gcc/ada/sem_prag.adb

@@ -17691,13 +17691,6 @@ package body Sem_Prag is
 
                Entry_Id := Unique_Defining_Entity (Entry_Decl);
 
-               --  Pragma illegally applied to an entry family
-
-               if Ekind (Entry_Id) = E_Entry_Family then
-                  Error_Pragma ("pragma % cannot apply to entry families");
-                  return;
-               end if;
-
             --  Otherwise the pragma is associated with an illegal construct
 
             else

gcc/ada/sem_util.adb

@@ -8163,6 +8163,7 @@ package body Sem_Util is
    is
       Btyp : Entity_Id := Base_Type (T);
       Lit  : Node_Id;
+      LLoc : Source_Ptr;
 
    begin
       --  In the case where the literal is of type Character, Wide_Character
@@ -8173,6 +8174,7 @@ package body Sem_Util is
 
       if Is_Standard_Character_Type (T) then
          Set_Character_Literal_Name (UI_To_CC (Pos));
+
          return
            Make_Character_Literal (Loc,
              Chars              => Name_Find,
@@ -8190,9 +8192,26 @@ package body Sem_Util is
          Lit := First_Literal (Btyp);
          for J in 1 .. UI_To_Int (Pos) loop
             Next_Literal (Lit);
+
+            --  If Lit is Empty, Pos is not in range, so raise Constraint_Error
+            --  inside the loop to avoid calling Next_Literal on Empty.
+
+            if No (Lit) then
+               raise Constraint_Error;
+            end if;
          end loop;
 
-         return New_Occurrence_Of (Lit, Loc);
+         --  Create a new node from Lit, with source location provided by Loc
+         --  if not equal to No_Location, or by copying the source location of
+         --  Lit otherwise.
+
+         LLoc := Loc;
+
+         if LLoc = No_Location then
+            LLoc := Sloc (Lit);
+         end if;
+
+         return New_Occurrence_Of (Lit, LLoc);
       end if;
    end Get_Enum_Lit_From_Pos;
 

gcc/ada/sem_util.ads

@@ -917,9 +917,12 @@ package Sem_Util is
       Loc : Source_Ptr) return Node_Id;
    --  This function returns an identifier denoting the E_Enumeration_Literal
    --  entity for the specified value from the enumeration type or subtype T.
-   --  The second argument is the Pos value, which is assumed to be in range.
+   --  The second argument is the Pos value. Constraint_Error is raised if
-   --  The third argument supplies a source location for constructed nodes
+   --  argument Pos is not in range. The third argument supplies a source
-   --  returned by this function.
+   --  location for constructed nodes returned by this function. If No_Location
+   --  is supplied as source location, the location of the returned node is
+   --  copied from the original source location for the enumeration literal,
+   --  when available.
 
    function Get_Iterable_Type_Primitive
      (Typ : Entity_Id;

gcc/ada/uintp.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -2229,9 +2229,12 @@ package body Uintp is
          begin
             --  Uints of more than one digit could be outside the range for
             --  Ints. Caller should have checked for this if not certain.
-            --  Fatal error to attempt to convert from value outside Int'Range.
+            --  Constraint_Error to attempt to convert from value outside
+            --  Int'Range.
 
-            pragma Assert (UI_Is_In_Int_Range (Input));
+            if not UI_Is_In_Int_Range (Input) then
+               raise Constraint_Error;
+            end if;
 
             --  Otherwise, proceed ahead, we are OK
 

gcc/ada/uintp.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -252,12 +252,12 @@ package Uintp is
    --  Converts Char_Code value to universal integer form
 
    function UI_To_Int (Input : Uint) return Int;
-   --  Converts universal integer value to Int. Fatal error if value is not in
+   --  Converts universal integer value to Int. Constraint_Error if value is
-   --  appropriate range.
+   --  not in appropriate range.
 
    function UI_To_CC (Input : Uint) return Char_Code;
-   --  Converts universal integer value to Char_Code. Fatal error if value is
+   --  Converts universal integer value to Char_Code. Constraint_Error if value
-   --  not in Char_Code range.
+   --  is not in Char_Code range.
 
    function Num_Bits (Input : Uint) return Nat;
    --  Approximate number of binary bits in given universal integer. This