+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
package body Ada.Containers.Formal_Hashed_Maps with
SPARK_Mode => Off
is
+ pragma Annotate (CodePeer, Skip_Analysis);
-----------------------
-- Local Subprograms --
package body Ada.Containers.Formal_Hashed_Sets with
SPARK_Mode => Off
is
+ pragma Annotate (CodePeer, Skip_Analysis);
-----------------------
-- Local Subprograms --
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;
package body Ada.Containers.Formal_Ordered_Maps with
SPARK_Mode => Off
is
+ pragma Annotate (CodePeer, Skip_Analysis);
-----------------------------
-- Node Access Subprograms --
package body Ada.Containers.Formal_Ordered_Sets with
SPARK_Mode => Off
is
+ pragma Annotate (CodePeer, Skip_Analysis);
------------------------------
-- Access to Fields of Node --
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
-------------------------
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;
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;
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;
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;
-- 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,
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),
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,
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),
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;
----------------------
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;
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;
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);
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
(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 "
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
(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 --
(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
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
elsif Attribute_Name (Exp) = Name_Last then
Kind := 'L';
else
- Ent := Empty;
return;
end if;
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;
projects / gcc.git / commitdiff