Commit f5e976a5 by Arnaud Charlet

[multiple changes]

2009-09-18  Thomas Quinot  <quinot@adacore.com>

	* g-socket.adb (Is_Open): New function indicating whether a
	Selector_Type object is open.

2009-09-18  Vincent Celier  <celier@adacore.com>

	* osint-c.adb (Create_Output_Library_Info): Make sure that the ALI file
	is deleted before creating it.

2009-09-18  Robert Dewar  <dewar@adacore.com>

	* bindgen.adb: Minor reformatting

From-SVN: r151842
parent 658cea5b
2009-09-18 Thomas Quinot <quinot@adacore.com>
* g-socket.adb (Is_Open): New function indicating whether a
Selector_Type object is open.
2009-09-18 Vincent Celier <celier@adacore.com>
* osint-c.adb (Create_Output_Library_Info): Make sure that the ALI file
is deleted before creating it.
2009-09-18 Robert Dewar <dewar@adacore.com>
* bindgen.adb: Minor reformatting
2009-09-18 Arnaud Charlet <charlet@adacore.com> 2009-09-18 Arnaud Charlet <charlet@adacore.com>
* s-taprop-tru64.adb, s-taprop-linux.adb, s-taprop-solaris.adb, * s-taprop-tru64.adb, s-taprop-linux.adb, s-taprop-solaris.adb,
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -198,7 +198,6 @@ package body Bindgen is ...@@ -198,7 +198,6 @@ package body Bindgen is
-- Zero_Cost_Exceptions is set to one if zero cost exceptions are used for -- Zero_Cost_Exceptions is set to one if zero cost exceptions are used for
-- this partition, and to zero if longjmp/setjmp exceptions are used. -- this partition, and to zero if longjmp/setjmp exceptions are used.
-- the use of zero
-- Detect_Blocking indicates whether pragma Detect_Blocking is active or -- Detect_Blocking indicates whether pragma Detect_Blocking is active or
-- not. A value of zero indicates that the pragma is not present, while a -- not. A value of zero indicates that the pragma is not present, while a
......
...@@ -265,6 +265,10 @@ package body GNAT.Sockets is ...@@ -265,6 +265,10 @@ package body GNAT.Sockets is
-- fd_set component is actually cleared. Note that the case where it is -- fd_set component is actually cleared. Note that the case where it is
-- not can occur for an uninitialized Socket_Set_Type object. -- not can occur for an uninitialized Socket_Set_Type object.
function Is_Open (S : Selector_Type) return Boolean;
-- Return True for an "open" Selector_Type object, i.e. one for which
-- Create_Selector has been called and Close_Selector has not been called.
--------- ---------
-- "+" -- -- "+" --
--------- ---------
...@@ -282,9 +286,7 @@ package body GNAT.Sockets is ...@@ -282,9 +286,7 @@ package body GNAT.Sockets is
Res : C.int; Res : C.int;
begin begin
if Selector.R_Sig_Socket = No_Socket if not Is_Open (Selector) then
or else Selector.W_Sig_Socket = No_Socket
then
raise Program_Error with "closed selector"; raise Program_Error with "closed selector";
end if; end if;
...@@ -336,11 +338,7 @@ package body GNAT.Sockets is ...@@ -336,11 +338,7 @@ package body GNAT.Sockets is
Status : out Selector_Status) Status : out Selector_Status)
is is
begin begin
if Selector /= null if Selector /= null and then not Is_Open (Selector.all) then
and then (Selector.R_Sig_Socket = No_Socket
or else
Selector.W_Sig_Socket = No_Socket)
then
raise Program_Error with "closed selector"; raise Program_Error with "closed selector";
end if; end if;
...@@ -492,9 +490,7 @@ package body GNAT.Sockets is ...@@ -492,9 +490,7 @@ package body GNAT.Sockets is
TPtr : Timeval_Access; TPtr : Timeval_Access;
begin begin
if Selector.R_Sig_Socket = No_Socket if not Is_Open (Selector) then
or else Selector.W_Sig_Socket = No_Socket
then
raise Program_Error with "closed selector"; raise Program_Error with "closed selector";
end if; end if;
...@@ -583,9 +579,10 @@ package body GNAT.Sockets is ...@@ -583,9 +579,10 @@ package body GNAT.Sockets is
procedure Close_Selector (Selector : in out Selector_Type) is procedure Close_Selector (Selector : in out Selector_Type) is
begin begin
if Selector.R_Sig_Socket = No_Socket if not Is_Open (Selector) then
or else Selector.W_Sig_Socket = No_Socket
then -- Selector already in closed state: nothing to do
return; return;
end if; end if;
...@@ -662,10 +659,7 @@ package body GNAT.Sockets is ...@@ -662,10 +659,7 @@ package body GNAT.Sockets is
-- Used to set Socket to non-blocking I/O -- Used to set Socket to non-blocking I/O
begin begin
if Selector /= null and then if Selector /= null and then not Is_Open (Selector.all) then
(Selector.R_Sig_Socket = No_Socket
or else Selector.W_Sig_Socket = No_Socket)
then
raise Program_Error with "closed selector"; raise Program_Error with "closed selector";
end if; end if;
...@@ -760,9 +754,9 @@ package body GNAT.Sockets is ...@@ -760,9 +754,9 @@ package body GNAT.Sockets is
Res : C.int; Res : C.int;
begin begin
if Selector.R_Sig_Socket /= No_Socket if Is_Open (Selector) then
or else Selector.W_Sig_Socket /= No_Socket -- Raise exception to prevent socket descriptor leak
then
raise Program_Error with "selector already open"; raise Program_Error with "selector already open";
end if; end if;
...@@ -1392,6 +1386,22 @@ package body GNAT.Sockets is ...@@ -1392,6 +1386,22 @@ package body GNAT.Sockets is
return True; return True;
end Is_IP_Address; end Is_IP_Address;
-------------
-- Is_Open --
-------------
function Is_Open (S : Selector_Type) return Boolean is
begin
-- Either both controlling socket descriptors are valid (case of an
-- open selector) or neither (case of a closed selector).
pragma Assert ((S.R_Sig_Socket /= No_Socket)
=
(S.W_Sig_Socket /= No_Socket));
return S.R_Sig_Socket /= No_Socket;
end Is_Open;
------------ ------------
-- Is_Set -- -- Is_Set --
------------ ------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -202,8 +202,12 @@ package body Osint.C is ...@@ -202,8 +202,12 @@ package body Osint.C is
-------------------------------- --------------------------------
procedure Create_Output_Library_Info is procedure Create_Output_Library_Info is
Dummy : Boolean;
pragma Unreferenced (Dummy);
begin begin
Set_Library_Info_Name; Set_Library_Info_Name;
Delete_File (Name_Buffer (1 .. Name_Len), Dummy);
Create_File_And_Check (Output_FD, Text); Create_File_And_Check (Output_FD, Text);
end Create_Output_Library_Info; end Create_Output_Library_Info;
......
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