Commit 9d0c3761 by Arnaud Charlet

[multiple changes]

2009-07-22  Thomas Quinot  <quinot@adacore.com>

	* sem_util.adb, sem_ch10.adb: Minor reformatting

	* g-socket.adb (Receive_Socket, recvfrom(2) variant): Apply required
	special handling for the case of no data received and Item'First =
	Stream_Element_Offset'First.
	(Last_Index): New subprogram factoring the above special handling
	over the various locations where it is required.

2009-07-22  Arnaud Charlet  <charlet@adacore.com>

	* gnat1drv.adb (Gnat1drv): Also disable division by zero and alignment
	checks in CodePeer_Mode.
	* gcc-interface/Make-lang.in: Update dependencies.

2009-07-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb: Improve error message.

	* sem_ch13.adb: If Ignore_Rep_Clauses is enabled, do a minimal analysis
	of an address representation clause.
	* freeze.adb (Freeze_Static_Object): An local imported object is legal
	if it has an address clause.

From-SVN: r149926
parent f6256631
2009-07-22 Thomas Quinot <quinot@adacore.com>
* sem_util.adb, sem_ch10.adb: Minor reformatting
* g-socket.adb (Receive_Socket, recvfrom(2) variant): Apply required
special handling for the case of no data received and Item'First =
Stream_Element_Offset'First.
(Last_Index): New subprogram factoring the above special handling
over the various locations where it is required.
2009-07-22 Arnaud Charlet <charlet@adacore.com>
* gnat1drv.adb (Gnat1drv): Also disable division by zero and alignment
checks in CodePeer_Mode.
* gcc-interface/Make-lang.in: Update dependencies.
2009-07-22 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb: Improve error message.
* sem_ch13.adb: If Ignore_Rep_Clauses is enabled, do a minimal analysis
of an address representation clause.
* freeze.adb (Freeze_Static_Object): An local imported object is legal
if it has an address clause.
2009-07-22 Thomas Quinot <quinot@adacore.com>
* sem_elab.adb (Insert_Elab_Check): When relocating an overloaded
expression to insert an elab check using a conditional expression, be
sure to carry the original list of interpretations to the new location.
......
......@@ -5094,9 +5094,13 @@ package body Freeze is
-- If the object that cannot be static is imported or exported,
-- then we give an error message saying that this object cannot
-- be imported or exported.
-- be imported or exported. If it has an address clause it is
-- an overlay in the current partition and the static requirement
-- is not relevant.
if Is_Imported (E) then
if Is_Imported (E)
and then No (Address_Clause (E))
then
Error_Msg_N
("& cannot be imported (local type is not constant)", E);
......
......@@ -119,9 +119,6 @@ package body GNAT.Sockets is
Hex_To_Char : constant String (1 .. 16) := "0123456789ABCDEF";
-- Use to print in hexadecimal format
function Err_Code_Image (E : Integer) return String;
-- Return the value of E surrounded with brackets
-----------------------
-- Local subprograms --
-----------------------
......@@ -253,6 +250,17 @@ package body GNAT.Sockets is
-- during the elaboration and finalization of this package. A single object
-- of this type must exist at library level.
function Err_Code_Image (E : Integer) return String;
-- Return the value of E surrounded with brackets
function Last_Index
(First : Stream_Element_Offset;
Count : C.int) return Stream_Element_Offset;
-- Compute the Last OUT parameter for the various Receive_Socket
-- subprograms: returns First + Count - 1, except for the case
-- where First = Stream_Element_Offset'First and Res = 0, in which
-- case Stream_Element_Offset'Last is returned instead.
procedure Initialize (X : in out Sockets_Library_Controller);
procedure Finalize (X : in out Sockets_Library_Controller);
......@@ -1356,6 +1364,22 @@ package body GNAT.Sockets is
and then Is_Socket_In_Set (Item.Set'Access, C.int (Socket)) /= 0;
end Is_Set;
----------------
-- Last_Index --
----------------
function Last_Index
(First : Stream_Element_Offset;
Count : C.int) return Stream_Element_Offset
is
begin
if First = Stream_Element_Offset'First and then Count = 0 then
return Stream_Element_Offset'Last;
else
return First + Stream_Element_Offset (Count - 1);
end if;
end Last_Index;
-------------------
-- Listen_Socket --
-------------------
......@@ -1581,17 +1605,7 @@ package body GNAT.Sockets is
Raise_Socket_Error (Socket_Errno);
end if;
if Res = 0
and then Item'First = Ada.Streams.Stream_Element_Offset'First
then
-- No data sent and first index is first Stream_Element_Offset'First
-- Last is set to Stream_Element_Offset'Last.
Last := Ada.Streams.Stream_Element_Offset'Last;
else
Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
end if;
Last := Last_Index (First => Item'First, Count => Res);
end Receive_Socket;
--------------------
......@@ -1623,7 +1637,7 @@ package body GNAT.Sockets is
Raise_Socket_Error (Socket_Errno);
end if;
Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
Last := Last_Index (First => Item'First, Count => Res);
To_Inet_Addr (Sin.Sin_Addr, From.Addr);
From.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
......@@ -1863,17 +1877,7 @@ package body GNAT.Sockets is
Raise_Socket_Error (Socket_Errno);
end if;
if Res = 0
and then Item'First = Ada.Streams.Stream_Element_Offset'First
then
-- No data sent and first index is first Stream_Element_Offset'First
-- Last is set to Stream_Element_Offset'Last.
Last := Ada.Streams.Stream_Element_Offset'Last;
else
Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
end if;
Last := Last_Index (First => Item'First, Count => Res);
end Send_Socket;
-----------------
......
......@@ -158,19 +158,24 @@ procedure Gnat1drv is
ASIS_Mode := False;
-- Suppress overflow checks and access checks since they are handled
-- implicitly by CodePeer.
-- Suppress overflow, division by zero and access checks since they
-- are handled implicitly by CodePeer.
-- Turn off dynamic elaboration checks: generates inconsistencies in
-- trees between specs compiled as part of a main unit or as part of
-- a with-clause.
-- Turn off alignment checks: these cannot be proved statically by
-- CodePeer and generate false positives.
-- Enable all other language checks
Suppress_Options :=
(Overflow_Check => True,
Access_Check => True,
(Access_Check => True,
Alignment_Check => True,
Division_Check => True,
Elaboration_Check => True,
Overflow_Check => True,
others => False);
Enable_Overflow_Checks := False;
Dynamic_Elaboration_Checks := False;
......
......@@ -1440,6 +1440,14 @@ package body Sem_Aggr is
else
Error_Msg_N ("nested array aggregate expected", Expr);
-- If the expression is parenthesized, this may be
-- a missing component association for a 1-aggregate.
if Paren_Count (Expr) > 0 then
Error_Msg_N ("\if single-component aggregate is intended,"
& " write e.g. (1 ='> ...)", Expr);
end if;
return Failure;
end if;
end if;
......
......@@ -665,7 +665,7 @@ package body Sem_Ch10 is
-- loading, we set the Context_Pending flag on the current unit. If the
-- flag is already set there is a potential circularity.
-- We exclude predefined units from this check because they are known
-- to be safe. we also exclude package bodies that are present because
-- to be safe. We also exclude package bodies that are present because
-- circularities between bodies are harmless (and necessary).
if Context_Pending (N) then
......
......@@ -675,8 +675,7 @@ package body Sem_Ch13 is
-- affect legality (except possibly to be rejected because they
-- are incompatible with the compilation target).
when Attribute_Address |
Attribute_Alignment |
when Attribute_Alignment |
Attribute_Bit_Order |
Attribute_Component_Size |
Attribute_Machine_Radix |
......@@ -798,6 +797,20 @@ package body Sem_Ch13 is
Analyze_And_Resolve (Expr, RTE (RE_Address));
-- Even when ignoring rep clauses we need to indicate that the
-- entity has an address clause and thus it is legal to declare
-- it imported.
if Ignore_Rep_Clauses then
if Ekind (U_Ent) = E_Variable
or else Ekind (U_Ent) = E_Constant
then
Record_Rep_Item (U_Ent, N);
end if;
return;
end if;
if Present (Address_Clause (U_Ent)) then
Error_Msg_N ("address already given for &", Nam);
......
......@@ -1045,9 +1045,9 @@ package body Sem_Util is
begin
pragma Assert (Is_Tagged_Type (Typ));
-- In order to avoid spurious errors when analyzing the expanded code
-- In order to avoid spurious errors when analyzing the expanded code,
-- this check is done only for nodes that come from source and for
-- actuals of generic instantiations
-- actuals of generic instantiations.
if (Comes_From_Source (Related_Nod)
or else In_Generic_Actual (Expr))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment