2014-11-20 Thomas Quinot <quinot@adacore.com>

	* g-socket.adb (To_Host_Entry): Guard against case of a
	non-AF_INET entry.

2014-11-20  Vadim Godunko  <godunko@adacore.com>

	* a-strunb-shared.adb (To_Unbounded_String): Use shared empty
	object to construct return value when source string is empty or
	requested length is zero.
	* a-stwiun-shared.adb (To_Unbounded_Wide_String): Likewise.
	* a-stzunb-shared.adb (To_Unbounded_Wide_Wide_String): Likewise.

2014-11-20  Yannick Moy  <moy@adacore.com>

	* a-cfhase.adb, a-cfinve.adb, a-cforma.adb, a-cfhama.adb, a-cforse.adb,
	a-cofove.adb: Skip CodePeer analysis on body of all formal containers.

2014-11-20  Arnaud Charlet  <charlet@adacore.com>

	* adaint.c: Fix typo.
	* exp_util.adb (Make_Subtype_From_Expr): Complete previous change,
	generate constant values.
	* sem_eval.adb (Decompose_Expr): Fix latent bug leading to a wrong
	evaluation to '0' of some unknown values.

2014-11-20  Robert Dewar  <dewar@adacore.com>

	* repinfo.adb (List_Record_Info): Do not list discriminant in
	unchecked union.
	* sem_ch13.adb (Has_Good_Profile): Minor reformatting
	(Analyze_Stream_TSS_Definition): Minor reformatting
	(Analyze_Record_Representation_Clause): Do not issue warning
	for missing rep clause for discriminant in unchecked union.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@217861 138bc75d-0d04-0410-961f-82ee72b054a4

16 files changed, 210 insertions, 60 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d5473a1c4d8..5c3df6f8e46 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,38 @@
+2014-11-20  Thomas Quinot  <quinot@adacore.com>
+
+	* g-socket.adb (To_Host_Entry): Guard against case of a
+	non-AF_INET entry.
+
+2014-11-20  Vadim Godunko  <godunko@adacore.com>
+
+	* a-strunb-shared.adb (To_Unbounded_String): Use shared empty
+	object to construct return value when source string is empty or
+	requested length is zero.
+	* a-stwiun-shared.adb (To_Unbounded_Wide_String): Likewise.
+	* a-stzunb-shared.adb (To_Unbounded_Wide_Wide_String): Likewise.
+
+2014-11-20  Yannick Moy  <moy@adacore.com>
+
+	* a-cfhase.adb, a-cfinve.adb, a-cforma.adb, a-cfhama.adb, a-cforse.adb,
+	a-cofove.adb: Skip CodePeer analysis on body of all formal containers.
+
+2014-11-20  Arnaud Charlet  <charlet@adacore.com>
+
+	* adaint.c: Fix typo.
+	* exp_util.adb (Make_Subtype_From_Expr): Complete previous change,
+	generate constant values.
+	* sem_eval.adb (Decompose_Expr): Fix latent bug leading to a wrong
+	evaluation to '0' of some unknown values.
+
+2014-11-20  Robert Dewar  <dewar@adacore.com>
+
+	* repinfo.adb (List_Record_Info): Do not list discriminant in
+	unchecked union.
+	* sem_ch13.adb (Has_Good_Profile): Minor reformatting
+	(Analyze_Stream_TSS_Definition): Minor reformatting
+	(Analyze_Record_Representation_Clause): Do not issue warning
+	for missing rep clause for discriminant in unchecked union.
+
 2014-11-20  Vadim Godunko  <godunko@adacore.com>
 
 	* a-strunb-shared.adb, a-stwiun-shared.adb, a-stzunb-shared.adb
diff --git a/gcc/ada/a-cfhama.adb b/gcc/ada/a-cfhama.adb
index 1504f605d71..11dbc6fe66d 100644
--- a/gcc/ada/a-cfhama.adb
+++ b/gcc/ada/a-cfhama.adb
@@ -38,6 +38,7 @@ with System; use type System.Address;
 package body Ada.Containers.Formal_Hashed_Maps with
   SPARK_Mode => Off
 is
+   pragma Annotate (CodePeer, Skip_Analysis);
 
    -----------------------
    -- Local Subprograms --
diff --git a/gcc/ada/a-cfhase.adb b/gcc/ada/a-cfhase.adb
index 3bbcd125776..8d73a2c385c 100644
--- a/gcc/ada/a-cfhase.adb
+++ b/gcc/ada/a-cfhase.adb
@@ -38,6 +38,7 @@ with System; use type System.Address;
 package body Ada.Containers.Formal_Hashed_Sets with
   SPARK_Mode => Off
 is
+   pragma Annotate (CodePeer, Skip_Analysis);
 
    -----------------------
    -- Local Subprograms --
diff --git a/gcc/ada/a-cfinve.adb b/gcc/ada/a-cfinve.adb
index e3f917aaa1e..6574fcb4364 100644
--- a/gcc/ada/a-cfinve.adb
+++ b/gcc/ada/a-cfinve.adb
@@ -29,6 +29,7 @@
 package body Ada.Containers.Formal_Indefinite_Vectors with
   SPARK_Mode => Off
 is
+   pragma Annotate (CodePeer, Skip_Analysis);
 
    function H (New_Item : Element_Type) return Holder renames To_Holder;
    function E (Container : Holder) return Element_Type renames Get;
diff --git a/gcc/ada/a-cforma.adb b/gcc/ada/a-cforma.adb
index cceef9e11d7..bd088bd46df 100644
--- a/gcc/ada/a-cforma.adb
+++ b/gcc/ada/a-cforma.adb
@@ -37,6 +37,7 @@ with System; use type System.Address;
 package body Ada.Containers.Formal_Ordered_Maps with
   SPARK_Mode => Off
 is
+   pragma Annotate (CodePeer, Skip_Analysis);
 
    -----------------------------
    -- Node Access Subprograms --
diff --git a/gcc/ada/a-cforse.adb b/gcc/ada/a-cforse.adb
index b53d08c0edf..e1203215cc9 100644
--- a/gcc/ada/a-cforse.adb
+++ b/gcc/ada/a-cforse.adb
@@ -41,6 +41,7 @@ with System; use type System.Address;
 package body Ada.Containers.Formal_Ordered_Sets with
   SPARK_Mode => Off
 is
+   pragma Annotate (CodePeer, Skip_Analysis);
 
    ------------------------------
    -- Access to Fields of Node --
diff --git a/gcc/ada/a-cofove.adb b/gcc/ada/a-cofove.adb
index 8fc7ed148b6..d9eb35639d0 100644
--- a/gcc/ada/a-cofove.adb
+++ b/gcc/ada/a-cofove.adb
@@ -33,6 +33,7 @@ with System; use type System.Address;
 package body Ada.Containers.Formal_Vectors with
   SPARK_Mode => Off
 is
+   pragma Annotate (CodePeer, Skip_Analysis);
 
    Growth_Factor : constant := 2;
    --  When growing a container, multiply current capacity by this. Doubling
diff --git a/gcc/ada/a-strunb-shared.adb b/gcc/ada/a-strunb-shared.adb
index 9c9246600e7..5cbe3602a5b 100644
--- a/gcc/ada/a-strunb-shared.adb
+++ b/gcc/ada/a-strunb-shared.adb
@@ -1609,17 +1609,35 @@ package body Ada.Strings.Unbounded is
    -------------------------
 
    function To_Unbounded_String (Source : String) return Unbounded_String is
-      DR : constant Shared_String_Access := Allocate (Source'Length);
+      DR : Shared_String_Access;
+
    begin
-      DR.Data (1 .. Source'Length) := Source;
-      DR.Last := Source'Length;
+      if Source'Length = 0 then
+         Reference (Empty_Shared_String'Access);
+         DR := Empty_Shared_String'Access;
+
+      else
+         DR := Allocate (Source'Length);
+         DR.Data (1 .. Source'Length) := Source;
+         DR.Last := Source'Length;
+      end if;
+
       return (AF.Controlled with Reference => DR);
    end To_Unbounded_String;
 
    function To_Unbounded_String (Length : Natural) return Unbounded_String is
-      DR : constant Shared_String_Access := Allocate (Length);
+      DR : Shared_String_Access;
+
    begin
-      DR.Last := Length;
+      if Length = 0 then
+         Reference (Empty_Shared_String'Access);
+         DR := Empty_Shared_String'Access;
+
+      else
+         DR := Allocate (Length);
+         DR.Last := Length;
+      end if;
+
       return (AF.Controlled with Reference => DR);
    end To_Unbounded_String;
 
diff --git a/gcc/ada/a-stwiun-shared.adb b/gcc/ada/a-stwiun-shared.adb
index 284ffd3cf9e..34811b7b90b 100644
--- a/gcc/ada/a-stwiun-shared.adb
+++ b/gcc/ada/a-stwiun-shared.adb
@@ -1624,19 +1624,37 @@ package body Ada.Strings.Wide_Unbounded is
    function To_Unbounded_Wide_String
      (Source : Wide_String) return Unbounded_Wide_String
    is
-      DR : constant Shared_Wide_String_Access := Allocate (Source'Length);
+      DR : Shared_Wide_String_Access;
+
    begin
-      DR.Data (1 .. Source'Length) := Source;
-      DR.Last := Source'Length;
+      if Source'Length = 0 then
+         Reference (Empty_Shared_Wide_String'Access);
+         DR := Empty_Shared_Wide_String'Access;
+
+      else
+         DR := Allocate (Source'Length);
+         DR.Data (1 .. Source'Length) := Source;
+         DR.Last := Source'Length;
+      end if;
+
       return (AF.Controlled with Reference => DR);
    end To_Unbounded_Wide_String;
 
    function To_Unbounded_Wide_String
      (Length : Natural) return Unbounded_Wide_String
    is
-      DR : constant Shared_Wide_String_Access := Allocate (Length);
+      DR : Shared_Wide_String_Access;
+
    begin
-      DR.Last := Length;
+      if Length = 0 then
+         Reference (Empty_Shared_Wide_String'Access);
+         DR := Empty_Shared_Wide_String'Access;
+
+      else
+         DR := Allocate (Length);
+         DR.Last := Length;
+      end if;
+
       return (AF.Controlled with Reference => DR);
    end To_Unbounded_Wide_String;
 
diff --git a/gcc/ada/a-stzunb-shared.adb b/gcc/ada/a-stzunb-shared.adb
index b71f71d5ff3..bf2ed256334 100644
--- a/gcc/ada/a-stzunb-shared.adb
+++ b/gcc/ada/a-stzunb-shared.adb
@@ -1631,19 +1631,37 @@ package body Ada.Strings.Wide_Wide_Unbounded is
    function To_Unbounded_Wide_Wide_String
      (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String
    is
-      DR : constant Shared_Wide_Wide_String_Access := Allocate (Source'Length);
+      DR : Shared_Wide_Wide_String_Access;
+
    begin
-      DR.Data (1 .. Source'Length) := Source;
-      DR.Last := Source'Length;
+      if Source'Length = 0 then
+         Reference (Empty_Shared_Wide_Wide_String'Access);
+         DR := Empty_Shared_Wide_Wide_String'Access;
+
+      else
+         DR := Allocate (Source'Length);
+         DR.Data (1 .. Source'Length) := Source;
+         DR.Last := Source'Length;
+      end if;
+
       return (AF.Controlled with Reference => DR);
    end To_Unbounded_Wide_Wide_String;
 
    function To_Unbounded_Wide_Wide_String
      (Length : Natural) return Unbounded_Wide_Wide_String
    is
-      DR : constant Shared_Wide_Wide_String_Access := Allocate (Length);
+      DR : Shared_Wide_Wide_String_Access;
+
    begin
-      DR.Last := Length;
+      if Length = 0 then
+         Reference (Empty_Shared_Wide_Wide_String'Access);
+         DR := Empty_Shared_Wide_Wide_String'Access;
+
+      else
+         DR := Allocate (Length);
+         DR.Last := Length;
+      end if;
+
       return (AF.Controlled with Reference => DR);
    end To_Unbounded_Wide_Wide_String;
 
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 36a11899618..5df6f3d440a 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -2501,7 +2501,7 @@ win32_wait (int *status)
   pidl = (int *) xmalloc (sizeof (int) * hl_len);
   memmove (pidl, PID_LIST, sizeof (int) * hl_len);
 #else
-  /* Note that index 0 contains the event hanlde that is signaled when the
+  /* Note that index 0 contains the event handle that is signaled when the
      process list has changed */
   hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len + 1);
   hl[0] = ProcListEvt;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index a833a0ff8af..86b46c60e72 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6473,11 +6473,8 @@ package body Exp_Util is
             --    SS_Release;  --  Temp is gone at this point, bounds of S are
             --                 --  non existent.
 
-            --  The bounds are kept as variables rather than constants because
-            --  this prevents spurious optimizations down the line.
-
             --  Generate:
-            --    Low_Bound : Base_Type (Index_Typ) := E'First (J);
+            --    Low_Bound : constant Base_Type (Index_Typ) := E'First (J);
 
             Low_Bound := Make_Temporary (Loc, 'B');
             Insert_Action (E,
@@ -6485,6 +6482,7 @@ package body Exp_Util is
                 Defining_Identifier => Low_Bound,
                 Object_Definition   =>
                   New_Occurrence_Of (Base_Type (Etype (Index_Typ)), Loc),
+                Constant_Present    => True,
                 Expression          =>
                   Make_Attribute_Reference (Loc,
                     Prefix         => Duplicate_Subexpr_No_Checks (E),
@@ -6493,7 +6491,7 @@ package body Exp_Util is
                       Make_Integer_Literal (Loc, J)))));
 
             --  Generate:
-            --    High_Bound : Base_Type (Index_Typ) := E'Last (J);
+            --    High_Bound : constant Base_Type (Index_Typ) := E'Last (J);
 
             High_Bound := Make_Temporary (Loc, 'B');
             Insert_Action (E,
@@ -6501,6 +6499,7 @@ package body Exp_Util is
                 Defining_Identifier => High_Bound,
                 Object_Definition   =>
                   New_Occurrence_Of (Base_Type (Etype (Index_Typ)), Loc),
+                Constant_Present    => True,
                 Expression          =>
                   Make_Attribute_Reference (Loc,
                     Prefix         => Duplicate_Subexpr_No_Checks (E),
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index 94125173515..3a10c9cb929 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -976,11 +976,17 @@ package body GNAT.Sockets is
          Raise_Host_Error (Integer (Err));
       end if;
 
-      return H : constant Host_Entry_Type :=
-                   To_Host_Entry (Res'Unchecked_Access)
-      do
-         Netdb_Unlock;
-      end return;
+      begin
+         return H : constant Host_Entry_Type :=
+                      To_Host_Entry (Res'Unchecked_Access)
+         do
+            Netdb_Unlock;
+         end return;
+      exception
+         when others =>
+            Netdb_Unlock;
+            raise;
+      end;
    end Get_Host_By_Address;
 
    ----------------------
@@ -2420,9 +2426,13 @@ package body GNAT.Sockets is
       Aliases_Count, Addresses_Count : Natural;
 
       --  H_Length is not used because it is currently only ever set to 4, as
-      --  H_Addrtype is always AF_INET.
+      --  we only handle the case of H_Addrtype being AF_INET.
 
    begin
+      if Hostent_H_Addrtype (E) /= SOSC.AF_INET then
+         Raise_Socket_Error (SOSC.EPFNOSUPPORT);
+      end if;
+
       Aliases_Count := 0;
       while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Address loop
          Aliases_Count := Aliases_Count + 1;
diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index d6f3dde7349..3915c30e7ed 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -847,36 +847,48 @@ package body Repinfo is
 
       Comp := First_Component_Or_Discriminant (Ent);
       while Present (Comp) loop
-         Get_Decoded_Name_String (Chars (Comp));
-         Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);
 
-         Cfbit := Component_Bit_Offset (Comp);
+         --  Skip discriminant in unchecked union (since it is not there!)
 
-         if Rep_Not_Constant (Cfbit) then
-            UI_Image_Length := 2;
+         if Ekind (Comp) = E_Discriminant
+           and then Is_Unchecked_Union (Ent)
+         then
+            null;
+
+         --  All other cases
 
          else
-            --  Complete annotation in case not done
+            Get_Decoded_Name_String (Chars (Comp));
+            Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);
 
-            Set_Normalized_Position (Comp, Cfbit / SSU);
-            Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
+            Cfbit := Component_Bit_Offset (Comp);
 
-            Sunit := Cfbit / SSU;
-            UI_Image (Sunit);
-         end if;
+            if Rep_Not_Constant (Cfbit) then
+               UI_Image_Length := 2;
+
+            else
+               --  Complete annotation in case not done
 
-         --  If the record is not packed, then we know that all fields whose
-         --  position is not specified have a starting normalized bit position
-         --  of zero.
+               Set_Normalized_Position (Comp, Cfbit / SSU);
+               Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
 
-         if Unknown_Normalized_First_Bit (Comp)
-           and then not Is_Packed (Ent)
-         then
-            Set_Normalized_First_Bit (Comp, Uint_0);
-         end if;
+               Sunit := Cfbit / SSU;
+               UI_Image (Sunit);
+            end if;
+
+            --  If the record is not packed, then we know that all fields
+            --  whose position is not specified have a starting normalized
+            --  bit position of zero.
 
-         Max_Suni_Length :=
-           Natural'Max (Max_Suni_Length, UI_Image_Length);
+            if Unknown_Normalized_First_Bit (Comp)
+              and then not Is_Packed (Ent)
+            then
+               Set_Normalized_First_Bit (Comp, Uint_0);
+            end if;
+
+            Max_Suni_Length :=
+              Natural'Max (Max_Suni_Length, UI_Image_Length);
+         end if;
 
          Next_Component_Or_Discriminant (Comp);
       end loop;
@@ -885,6 +897,17 @@ package body Repinfo is
 
       Comp := First_Component_Or_Discriminant (Ent);
       while Present (Comp) loop
+
+         --  Skip discriminant in unchecked union (since it is not there!)
+
+         if Ekind (Comp) = E_Discriminant
+           and then Is_Unchecked_Union (Ent)
+         then
+            goto Continue;
+         end if;
+
+         --  All other cases
+
          declare
             Esiz : constant Uint := Esize (Comp);
             Bofs : constant Uint := Component_Bit_Offset (Comp);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 42e64b1287f..a0dd0be46d3 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -3555,7 +3555,7 @@ package body Sem_Ch13 is
 
             if  Base_Type (Typ) = Base_Type (Ent)
               or else (Is_Class_Wide_Type (Typ)
-                and then Typ = Class_Wide_Type (Base_Type (Ent)))
+                        and then Typ = Class_Wide_Type (Base_Type (Ent)))
             then
                null;
             else
@@ -3650,8 +3650,8 @@ package body Sem_Ch13 is
                 (Ekind (Subp) = E_Function
                   or else
                     not Null_Present
-                      (Specification
-                         (Unit_Declaration_Node (Ultimate_Alias (Subp)))))
+                          (Specification
+                             (Unit_Declaration_Node (Ultimate_Alias (Subp)))))
             then
                Error_Msg_N
                  ("stream subprogram for interface type "
@@ -6600,6 +6600,12 @@ package body Sem_Ch13 is
                                or else Size_Known_At_Compile_Time
                                          (Underlying_Type (Etype (Comp))))
                     and then not Has_Warnings_Off (Rectype)
+
+                    --  Ignore discriminant in unchecked union, since it is
+                    --  not there, and cannot have a component clause.
+
+                    and then (not Is_Unchecked_Union (Rectype)
+                               or else Ekind (Comp) /= E_Discriminant)
                   then
                      Error_Msg_Sloc := Sloc (Comp);
                      Error_Msg_NE
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 77eb48c36c5..5d8aa4f53be 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -3163,12 +3163,17 @@ package body Sem_Eval is
                     (Expr : Node_Id;
                      Ent  : out Entity_Id;
                      Kind : out Character;
-                     Cons : out Uint);
+                     Cons : out Uint;
+                     Orig : Boolean := True);
                   --  Given an expression see if it is of the form given above,
                   --  X [+/- K]. If so Ent is set to the entity in X, Kind is
                   --  'F','L','E' for 'First/'Last/simple entity, and Cons is
                   --  the value of K. If the expression is not of the required
                   --  form, Ent is set to Empty.
+                  --
+                  --  Orig indicates whether Expr is the original expression
+                  --  to consider, or if we are handling a sub-expression
+                  --  (e.g. recursive call to Decompose_Expr).
 
                   --------------------
                   -- Decompose_Expr --
@@ -3178,11 +3183,14 @@ package body Sem_Eval is
                     (Expr : Node_Id;
                      Ent  : out Entity_Id;
                      Kind : out Character;
-                     Cons : out Uint)
+                     Cons : out Uint;
+                     Orig : Boolean := True)
                   is
                      Exp : Node_Id;
 
                   begin
+                     Ent := Empty;
+
                      if Nkind (Expr) = N_Op_Add
                        and then Compile_Time_Known_Value (Right_Opnd (Expr))
                      then
@@ -3206,18 +3214,29 @@ package body Sem_Eval is
                          Nkind (Parent (Entity (Expr))) = N_Object_Declaration
                      then
                         Exp := Expression (Parent (Entity (Expr)));
-                        Decompose_Expr (Exp, Ent, Kind, Cons);
+                        Decompose_Expr (Exp, Ent, Kind, Cons, Orig => False);
 
                         --  If original expression includes an entity, create a
                         --  reference to it for use below.
 
                         if Present (Ent) then
                            Exp := New_Occurrence_Of (Ent, Sloc (Ent));
+                        else
+                           return;
                         end if;
 
                      else
-                        Exp  := Expr;
-                        Cons := Uint_0;
+                        --  Only consider the case of X + 0 for a full
+                        --  expression, and not when recursing, otherwise we
+                        --  may end up with evaluating expressions not known
+                        --  at compile time to 0.
+
+                        if Orig then
+                           Exp  := Expr;
+                           Cons := Uint_0;
+                        else
+                           return;
+                        end if;
                      end if;
 
                      --  At this stage Exp is set to the potential X
@@ -3228,7 +3247,6 @@ package body Sem_Eval is
                         elsif Attribute_Name (Exp) = Name_Last then
                            Kind := 'L';
                         else
-                           Ent := Empty;
                            return;
                         end if;
 
@@ -3238,11 +3256,10 @@ package body Sem_Eval is
                         Kind := 'E';
                      end if;
 
-                     if Is_Entity_Name (Exp) and then Present (Entity (Exp))
+                     if Is_Entity_Name (Exp)
+                       and then Present (Entity (Exp))
                      then
                         Ent := Entity (Exp);
-                     else
-                        Ent := Empty;
                      end if;
                   end Decompose_Expr;