[multiple changes]
2009-04-07 Thomas Quinot <quinot@adacore.com> * g-sothco.ads (Int_Access): Remove extraneous access type (use anonymous access instead). (Get_Socket_From_Set): Fix incorrectly reverted formals Last and Socket to match the underlying C routine. * g-socket.adb (Get): Use named parameter associations instead of positional ones in call go Get_Socket_From_Set, since this routine has two formals of the same type. * g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb, g-socthi-vxworks.ads, g-socthi-mingw.ads, g-socthi.adb, g-socthi.ads: (C_Ioctl, Syscall_Ioctl): use "access C.int" instead of "Int_Access" for type of Arg formal. * sem_warn.adb: Minor reformatting 2009-04-07 Ed Schonberg <schonberg@adacore.com> * sem_util.adb (Has_Tagged_Component): Fix typo in loop that iterates over record components. 2009-04-07 Nicolas Roche <roche@adacore.com> * gsocket.h: Don't include resolvLib.h on VxWorks 6 (kernel and rtp). This library has disappeared between VxWorks 6.4 and VxWorks 6.5 In RTP mode use time.h instead of times.h 2009-04-07 Robert Dewar <dewar@adacore.com> * exp_ch4.adb (Expand_N_Op_Concat): Improve lower bound handling 2009-04-07 Kevin Pouget <pouget@adacore.com> * exp_dist.adb: Modify Build_From_Any_Fonction procedure to correct expanded code for constrained types. 2009-04-07 Ed Schonberg <schonberg@adacore.com> * sem_ch4.adb (Analyze_Overloaded_Selected_Component): implement AI05-105: in an object renaming declaration, anonymousness is a name resolution rule. sem_ch8.adb (Analyze_Object_Renaming): Ditto. 2009-04-07 Arnaud Charlet <charlet@adacore.com> * g-comlin.adb (Expansion): Fix old regression: also return directory names when matching. From-SVN: r145689
This commit is contained in:
Arnaud Charlet
parent
2fc05e3d5e
commit
f16d05d913
|
|
@ -1,3 +1,56 @@
|
|||
2009-04-07 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* g-sothco.ads (Int_Access): Remove extraneous access type (use
|
||||
anonymous access instead).
|
||||
(Get_Socket_From_Set): Fix incorrectly reverted formals
|
||||
Last and Socket to match the underlying C routine.
|
||||
|
||||
* g-socket.adb
|
||||
(Get): Use named parameter associations instead of positional ones in
|
||||
call go Get_Socket_From_Set, since this routine has two formals of the
|
||||
same type.
|
||||
|
||||
* g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
|
||||
g-socthi-vxworks.ads, g-socthi-mingw.ads, g-socthi.adb, g-socthi.ads:
|
||||
(C_Ioctl, Syscall_Ioctl): use "access C.int" instead of "Int_Access"
|
||||
for type of Arg formal.
|
||||
|
||||
* sem_warn.adb: Minor reformatting
|
||||
|
||||
2009-04-07 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_util.adb (Has_Tagged_Component): Fix typo in loop that iterates
|
||||
over record components.
|
||||
|
||||
2009-04-07 Nicolas Roche <roche@adacore.com>
|
||||
|
||||
* gsocket.h:
|
||||
Don't include resolvLib.h on VxWorks 6 (kernel and rtp). This library
|
||||
has disappeared between VxWorks 6.4 and VxWorks 6.5
|
||||
In RTP mode use time.h instead of times.h
|
||||
|
||||
2009-04-07 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_ch4.adb (Expand_N_Op_Concat): Improve lower bound handling
|
||||
|
||||
2009-04-07 Kevin Pouget <pouget@adacore.com>
|
||||
|
||||
* exp_dist.adb: Modify Build_From_Any_Fonction procedure to correct
|
||||
expanded code for constrained types.
|
||||
|
||||
2009-04-07 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch4.adb (Analyze_Overloaded_Selected_Component): implement
|
||||
AI05-105: in an object renaming declaration, anonymousness is a name
|
||||
resolution rule.
|
||||
|
||||
* sem_ch8.adb (Analyze_Object_Renaming): Ditto.
|
||||
|
||||
2009-04-07 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* g-comlin.adb (Expansion): Fix old regression: also return directory
|
||||
names when matching.
|
||||
|
||||
2009-04-07 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_ch4.adb:
|
||||
|
|
|
|||
|
|
@ -2368,7 +2368,14 @@ package body Exp_Ch4 is
|
|||
-- Set lower bound to lower bound of index subtype. This is not
|
||||
-- right where the index subtype bound is dynamic ???
|
||||
|
||||
Fixed_Low_Bound (NN) := Expr_Value (Type_Low_Bound (Ityp));
|
||||
if Compile_Time_Known_Value (Type_Low_Bound (Ityp)) then
|
||||
Fixed_Low_Bound (NN) :=
|
||||
Expr_Value (Type_Low_Bound (Ityp));
|
||||
else
|
||||
Fixed_Low_Bound (NN) :=
|
||||
Expr_Value (Type_Low_Bound (Base_Type (Ityp)));
|
||||
end if;
|
||||
|
||||
Set := True;
|
||||
|
||||
-- String literal case (can only occur for strings of course)
|
||||
|
|
|
|||
|
|
@ -9114,39 +9114,82 @@ package body Exp_Dist is
|
|||
New_Occurrence_Of (Any_Parameter, Loc),
|
||||
New_Occurrence_Of (Strm, Loc))));
|
||||
|
||||
-- declare
|
||||
-- Res : constant T := T'Input (Strm);
|
||||
-- begin
|
||||
-- Release_Buffer (Strm);
|
||||
-- return Res;
|
||||
-- end;
|
||||
if Transmit_As_Unconstrained (Typ) then
|
||||
|
||||
Append_To (Stms, Make_Block_Statement (Loc,
|
||||
Declarations => New_List (
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Res,
|
||||
Constant_Present => True,
|
||||
Object_Definition => New_Occurrence_Of (Typ, Loc),
|
||||
Expression =>
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix => New_Occurrence_Of (Typ, Loc),
|
||||
Attribute_Name => Name_Input,
|
||||
Expressions => New_List (
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix => New_Occurrence_Of (Strm, Loc),
|
||||
Attribute_Name => Name_Access))))),
|
||||
-- declare
|
||||
-- Res : constant T := T'Input (Strm);
|
||||
-- begin
|
||||
-- Release_Buffer (Strm);
|
||||
-- return Res;
|
||||
-- end;
|
||||
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => New_List (
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of (RTE (RE_Release_Buffer), Loc),
|
||||
Parameter_Associations =>
|
||||
New_List (New_Occurrence_Of (Strm, Loc))),
|
||||
Make_Simple_Return_Statement (Loc,
|
||||
Expression => New_Occurrence_Of (Res, Loc))))));
|
||||
Append_To (Stms, Make_Block_Statement (Loc,
|
||||
Declarations => New_List (
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Res,
|
||||
Constant_Present => True,
|
||||
Object_Definition => New_Occurrence_Of (Typ, Loc),
|
||||
Expression =>
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix => New_Occurrence_Of (Typ, Loc),
|
||||
Attribute_Name => Name_Input,
|
||||
Expressions => New_List (
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
New_Occurrence_Of (Strm, Loc),
|
||||
Attribute_Name => Name_Access))))),
|
||||
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => New_List (
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of
|
||||
(RTE (RE_Release_Buffer), Loc),
|
||||
Parameter_Associations =>
|
||||
New_List (New_Occurrence_Of (Strm, Loc))),
|
||||
Make_Simple_Return_Statement (Loc,
|
||||
Expression => New_Occurrence_Of (Res, Loc))))));
|
||||
else
|
||||
|
||||
-- declare
|
||||
-- Res : T;
|
||||
-- begin
|
||||
-- T'Read (Strm, Res);
|
||||
-- Release_Buffer (Strm);
|
||||
-- return Res;
|
||||
-- end;
|
||||
|
||||
Append_To (Stms, Make_Block_Statement (Loc,
|
||||
Declarations => New_List (
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Res,
|
||||
Constant_Present => False,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Typ, Loc))),
|
||||
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => New_List (
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix => New_Occurrence_Of (Typ, Loc),
|
||||
Attribute_Name => Name_Read,
|
||||
Expressions => New_List (
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
New_Occurrence_Of (Strm, Loc),
|
||||
Attribute_Name => Name_Access),
|
||||
New_Occurrence_Of (Res, Loc))),
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of
|
||||
(RTE (RE_Release_Buffer), Loc),
|
||||
Parameter_Associations =>
|
||||
New_List (New_Occurrence_Of (Strm, Loc))),
|
||||
Make_Simple_Return_Statement (Loc,
|
||||
Expression => New_Occurrence_Of (Res, Loc))))));
|
||||
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
|
|
|
|||
|
|
@ -263,24 +263,25 @@ package body GNAT.Command_Line is
|
|||
(It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- If not a directory, check the relative path against the pattern
|
||||
|
||||
else
|
||||
declare
|
||||
Name : String :=
|
||||
It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
|
||||
& S (1 .. Last);
|
||||
begin
|
||||
Canonical_Case_File_Name (Name);
|
||||
|
||||
-- If it matches return the relative path
|
||||
|
||||
if GNAT.Regexp.Match (Name, Iterator.Regexp) then
|
||||
return Name;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Check the relative path against the pattern.
|
||||
-- Note that we try to match also against directory names, since
|
||||
-- clients of this function may expect to retrieve directories.
|
||||
|
||||
declare
|
||||
Name : String :=
|
||||
It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
|
||||
& S (1 .. Last);
|
||||
begin
|
||||
Canonical_Case_File_Name (Name);
|
||||
|
||||
-- If it matches return the relative path
|
||||
|
||||
if GNAT.Regexp.Match (Name, Iterator.Regexp) then
|
||||
return Name;
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
end Expansion;
|
||||
|
||||
|
|
|
|||
|
|
@ -58,6 +58,10 @@ package body GNAT.Sockets is
|
|||
|
||||
ENOERROR : constant := 0;
|
||||
|
||||
Empty_Socket_Set : Socket_Set_Type;
|
||||
-- Variable set in Initialize, and then used internally to provide an
|
||||
-- initial value for Socket_Set_Type objects.
|
||||
|
||||
Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024;
|
||||
-- The network database functions gethostbyname, gethostbyaddr,
|
||||
-- getservbyname and getservbyport can either be guaranteed task safe by
|
||||
|
|
@ -426,7 +430,7 @@ package body GNAT.Sockets is
|
|||
Status : out Selector_Status;
|
||||
Timeout : Selector_Duration := Forever)
|
||||
is
|
||||
E_Socket_Set : Socket_Set_Type; -- (No_Socket, No_Fd_Set_Access)
|
||||
E_Socket_Set : Socket_Set_Type := Empty_Socket_Set;
|
||||
begin
|
||||
Check_Selector
|
||||
(Selector, R_Socket_Set, W_Socket_Set, E_Socket_Set, Status, Timeout);
|
||||
|
|
@ -813,7 +817,7 @@ package body GNAT.Sockets is
|
|||
begin
|
||||
if Item.Last /= No_Socket then
|
||||
Get_Socket_From_Set
|
||||
(Item.Set'Access, L'Unchecked_Access, S'Unchecked_Access);
|
||||
(Item.Set'Access, Last => L'Access, Socket => S'Access);
|
||||
Item.Last := Socket_Type (L);
|
||||
Socket := Socket_Type (S);
|
||||
else
|
||||
|
|
@ -1208,6 +1212,33 @@ package body GNAT.Sockets is
|
|||
return Socket'Img;
|
||||
end Image;
|
||||
|
||||
-----------
|
||||
-- Image --
|
||||
-----------
|
||||
|
||||
function Image (Item : Socket_Set_Type) return String is
|
||||
Socket_Set : Socket_Set_Type := Item;
|
||||
begin
|
||||
declare
|
||||
Last_Img : constant String := Socket_Set.Last'Img;
|
||||
Buffer : String
|
||||
(1 .. (Integer (Socket_Set.Last) + 1) * Last_Img'Length);
|
||||
Index : Positive := 1;
|
||||
Socket : Socket_Type;
|
||||
begin
|
||||
while not Is_Empty (Socket_Set) loop
|
||||
Get (Socket_Set, Socket);
|
||||
declare
|
||||
Socket_Img : constant String := Socket'Img;
|
||||
begin
|
||||
Buffer (Index .. Index + Socket_Img'Length - 1) := Socket_Img;
|
||||
Index := Index + Socket_Img'Length;
|
||||
end;
|
||||
end loop;
|
||||
return "[" & Last_Img & "]" & Buffer (1 .. Index - 1);
|
||||
end;
|
||||
end Image;
|
||||
|
||||
---------------
|
||||
-- Inet_Addr --
|
||||
---------------
|
||||
|
|
@ -1270,6 +1301,8 @@ package body GNAT.Sockets is
|
|||
begin
|
||||
if not Initialized then
|
||||
Initialized := True;
|
||||
Empty_Socket_Set.Last := No_Socket;
|
||||
Reset_Socket_Set (Empty_Socket_Set.Set'Access);
|
||||
Thin.Initialize;
|
||||
end if;
|
||||
end Initialize;
|
||||
|
|
|
|||
|
|
@ -121,7 +121,7 @@ package GNAT.Sockets.Thin is
|
|||
function C_Ioctl
|
||||
(S : C.int;
|
||||
Req : C.int;
|
||||
Arg : Int_Access) return C.int;
|
||||
Arg : access C.int) return C.int;
|
||||
|
||||
function C_Listen
|
||||
(S : C.int;
|
||||
|
|
|
|||
|
|
@ -73,7 +73,7 @@ package body GNAT.Sockets.Thin is
|
|||
function Syscall_Ioctl
|
||||
(S : C.int;
|
||||
Req : C.int;
|
||||
Arg : Int_Access) return C.int;
|
||||
Arg : access C.int) return C.int;
|
||||
pragma Import (C, Syscall_Ioctl, "ioctl");
|
||||
|
||||
function Syscall_Recv
|
||||
|
|
@ -148,7 +148,7 @@ package body GNAT.Sockets.Thin is
|
|||
-- tracks sockets set in non-blocking mode by user.
|
||||
|
||||
Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
|
||||
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
|
||||
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
|
||||
end if;
|
||||
|
||||
return R;
|
||||
|
|
@ -219,7 +219,7 @@ package body GNAT.Sockets.Thin is
|
|||
function C_Ioctl
|
||||
(S : C.int;
|
||||
Req : C.int;
|
||||
Arg : Int_Access) return C.int
|
||||
Arg : access C.int) return C.int
|
||||
is
|
||||
begin
|
||||
if not SOSC.Thread_Blocking_IO
|
||||
|
|
@ -361,7 +361,7 @@ package body GNAT.Sockets.Thin is
|
|||
-- Do not use C_Ioctl as this subprogram tracks sockets set
|
||||
-- in non-blocking mode by user.
|
||||
|
||||
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
|
||||
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
|
||||
Set_Non_Blocking_Socket (R, False);
|
||||
end if;
|
||||
|
||||
|
|
|
|||
|
|
@ -124,7 +124,7 @@ package GNAT.Sockets.Thin is
|
|||
function C_Ioctl
|
||||
(S : C.int;
|
||||
Req : C.int;
|
||||
Arg : Int_Access) return C.int;
|
||||
Arg : access C.int) return C.int;
|
||||
|
||||
function C_Listen
|
||||
(S : C.int;
|
||||
|
|
|
|||
|
|
@ -83,7 +83,7 @@ package body GNAT.Sockets.Thin is
|
|||
function Syscall_Ioctl
|
||||
(S : C.int;
|
||||
Req : C.int;
|
||||
Arg : Int_Access) return C.int;
|
||||
Arg : access C.int) return C.int;
|
||||
pragma Import (C, Syscall_Ioctl, "ioctl");
|
||||
|
||||
function Syscall_Recv
|
||||
|
|
@ -160,7 +160,7 @@ package body GNAT.Sockets.Thin is
|
|||
-- tracks sockets set in non-blocking mode by user.
|
||||
|
||||
Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
|
||||
Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
|
||||
Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
|
||||
-- Is it OK to ignore result ???
|
||||
end if;
|
||||
|
||||
|
|
@ -232,7 +232,7 @@ package body GNAT.Sockets.Thin is
|
|||
function C_Ioctl
|
||||
(S : C.int;
|
||||
Req : C.int;
|
||||
Arg : Int_Access) return C.int
|
||||
Arg : access C.int) return C.int
|
||||
is
|
||||
begin
|
||||
if not SOSC.Thread_Blocking_IO
|
||||
|
|
@ -374,7 +374,7 @@ package body GNAT.Sockets.Thin is
|
|||
-- Do not use C_Ioctl as this subprogram tracks sockets set
|
||||
-- in non-blocking mode by user.
|
||||
|
||||
Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
|
||||
Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
|
||||
-- Is it OK to ignore result ???
|
||||
Set_Non_Blocking_Socket (R, False);
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -122,7 +122,7 @@ package GNAT.Sockets.Thin is
|
|||
function C_Ioctl
|
||||
(S : C.int;
|
||||
Req : C.int;
|
||||
Arg : Int_Access) return C.int;
|
||||
Arg : access C.int) return C.int;
|
||||
|
||||
function C_Listen
|
||||
(S : C.int;
|
||||
|
|
|
|||
|
|
@ -79,7 +79,7 @@ package body GNAT.Sockets.Thin is
|
|||
function Syscall_Ioctl
|
||||
(S : C.int;
|
||||
Req : C.int;
|
||||
Arg : Int_Access) return C.int;
|
||||
Arg : access C.int) return C.int;
|
||||
pragma Import (C, Syscall_Ioctl, "ioctl");
|
||||
|
||||
function Syscall_Recv
|
||||
|
|
@ -164,7 +164,7 @@ package body GNAT.Sockets.Thin is
|
|||
-- tracks sockets set in non-blocking mode by user.
|
||||
|
||||
Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
|
||||
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
|
||||
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
|
||||
end if;
|
||||
|
||||
Disable_SIGPIPE (R);
|
||||
|
|
@ -237,7 +237,7 @@ package body GNAT.Sockets.Thin is
|
|||
function C_Ioctl
|
||||
(S : C.int;
|
||||
Req : C.int;
|
||||
Arg : Int_Access) return C.int
|
||||
Arg : access C.int) return C.int
|
||||
is
|
||||
begin
|
||||
if not SOSC.Thread_Blocking_IO
|
||||
|
|
@ -379,7 +379,7 @@ package body GNAT.Sockets.Thin is
|
|||
-- Do not use C_Ioctl as this subprogram tracks sockets set
|
||||
-- in non-blocking mode by user.
|
||||
|
||||
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
|
||||
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
|
||||
Set_Non_Blocking_Socket (R, False);
|
||||
end if;
|
||||
Disable_SIGPIPE (R);
|
||||
|
|
|
|||
|
|
@ -123,7 +123,7 @@ package GNAT.Sockets.Thin is
|
|||
function C_Ioctl
|
||||
(S : C.int;
|
||||
Req : C.int;
|
||||
Arg : Int_Access) return C.int;
|
||||
Arg : access C.int) return C.int;
|
||||
|
||||
function C_Listen
|
||||
(S : C.int;
|
||||
|
|
|
|||
|
|
@ -247,14 +247,10 @@ package GNAT.Sockets.Thin_Common is
|
|||
-- Socket sets management --
|
||||
----------------------------
|
||||
|
||||
type Int_Access is access all C.int;
|
||||
pragma Convention (C, Int_Access);
|
||||
-- Access to C integers
|
||||
|
||||
procedure Get_Socket_From_Set
|
||||
(Set : access Fd_Set;
|
||||
Socket : Int_Access;
|
||||
Last : Int_Access);
|
||||
Last : access C.int;
|
||||
Socket : access C.int);
|
||||
-- Get last socket in Socket and remove it from the socket set. The
|
||||
-- parameter Last is a maximum value of the largest socket. This hint is
|
||||
-- used to avoid scanning very large socket sets. After a call to
|
||||
|
|
@ -274,7 +270,7 @@ package GNAT.Sockets.Thin_Common is
|
|||
|
||||
procedure Last_Socket_In_Set
|
||||
(Set : access Fd_Set;
|
||||
Last : Int_Access);
|
||||
Last : access C.int);
|
||||
-- Find the largest socket in the socket set. This is needed for select().
|
||||
-- When Last_Socket_In_Set is called, parameter Last is a maximum value of
|
||||
-- the largest socket. This hint is used to avoid scanning very large
|
||||
|
|
|
|||
|
|
@ -66,7 +66,7 @@
|
|||
#include <vxWorks.h>
|
||||
#include <ioLib.h>
|
||||
#include <hostLib.h>
|
||||
#ifndef __RTP__
|
||||
#if (_WRS_VXWORKS_MAJOR != 6) && ! defined (__RTP__)
|
||||
#include <resolvLib.h>
|
||||
#endif
|
||||
#define SHUT_RD 0
|
||||
|
|
@ -176,7 +176,7 @@
|
|||
|
||||
#endif
|
||||
|
||||
#ifdef __vxworks
|
||||
#if defined (__vxworks) && ! defined (__RTP__)
|
||||
#include <sys/times.h>
|
||||
#else
|
||||
#include <sys/time.h>
|
||||
|
|
|
|||
|
|
@ -2638,14 +2638,36 @@ package body Sem_Ch4 is
|
|||
if Chars (Comp) = Chars (Sel)
|
||||
and then Is_Visible_Component (Comp)
|
||||
then
|
||||
Set_Entity (Sel, Comp);
|
||||
Set_Etype (Sel, Etype (Comp));
|
||||
Add_One_Interp (N, Etype (Comp), Etype (Comp));
|
||||
|
||||
-- This also specifies a candidate to resolve the name.
|
||||
-- Further overloading will be resolved from context.
|
||||
-- AI05-105: if the context is an object renaming with
|
||||
-- an anonymous access type, the expected type of the
|
||||
-- object must be anonymous. This is a name resolution rule.
|
||||
|
||||
Set_Etype (Nam, It.Typ);
|
||||
if Nkind (Parent (N)) /= N_Object_Renaming_Declaration
|
||||
or else No (Access_Definition (Parent (N)))
|
||||
or else Ekind (Etype (Comp)) = E_Anonymous_Access_Type
|
||||
or else
|
||||
Ekind (Etype (Comp)) = E_Anonymous_Access_Subprogram_Type
|
||||
then
|
||||
Set_Entity (Sel, Comp);
|
||||
Set_Etype (Sel, Etype (Comp));
|
||||
Add_One_Interp (N, Etype (Comp), Etype (Comp));
|
||||
|
||||
-- This also specifies a candidate to resolve the name.
|
||||
-- Further overloading will be resolved from context.
|
||||
-- The selector name itself does not carry overloading
|
||||
-- information.
|
||||
|
||||
Set_Etype (Nam, It.Typ);
|
||||
|
||||
else
|
||||
|
||||
-- Nnamed access type in the context of a renaming
|
||||
-- declaration with an access definition. Remove
|
||||
-- inapplicable candidate.
|
||||
|
||||
Remove_Interp (I);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next_Entity (Comp);
|
||||
|
|
|
|||
|
|
@ -767,7 +767,46 @@ package body Sem_Ch8 is
|
|||
(Related_Nod => N,
|
||||
N => Access_Definition (N));
|
||||
|
||||
Analyze_And_Resolve (Nam, T);
|
||||
Analyze (Nam);
|
||||
|
||||
-- Ada 2005 AI05-105: if the declaration has an anonymous access
|
||||
-- type, the renamed object must also have an anonymous type, and
|
||||
-- this is a name resolution rule. This was implicit in the last
|
||||
-- part of the first sentence in 8.5.1.(3/2), and is made explicit
|
||||
-- by this recent AI.
|
||||
|
||||
if not Is_Overloaded (Nam) then
|
||||
if Ekind (Etype (Nam)) /= Ekind (T) then
|
||||
Error_Msg_N
|
||||
("Expect anonymous access type is object renaming", N);
|
||||
end if;
|
||||
else
|
||||
declare
|
||||
I : Interp_Index;
|
||||
It : Interp;
|
||||
Typ : Entity_Id := Empty;
|
||||
|
||||
begin
|
||||
Get_First_Interp (Nam, I, It);
|
||||
while Present (It.Typ) loop
|
||||
if No (Typ) then
|
||||
if Ekind (It.Typ) = Ekind (T)
|
||||
and then Covers (T, It.Typ)
|
||||
then
|
||||
Typ := It.Typ;
|
||||
Set_Etype (Nam, Typ);
|
||||
Set_Is_Overloaded (Nam, False);
|
||||
end if;
|
||||
else
|
||||
Error_Msg_N ("ambiguous expression in renaming", N);
|
||||
end if;
|
||||
|
||||
Get_Next_Interp (I, It);
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
|
||||
Resolve (Nam, T);
|
||||
|
||||
-- Ada 2005 (AI-231): "In the case where the type is defined by an
|
||||
-- access_definition, the renamed entity shall be of an access-to-
|
||||
|
|
|
|||
|
|
@ -4831,7 +4831,7 @@ package body Sem_Util is
|
|||
return True;
|
||||
end if;
|
||||
|
||||
Comp := Next_Component (Typ);
|
||||
Next_Component (Comp);
|
||||
end loop;
|
||||
|
||||
return False;
|
||||
|
|
|
|||
|
|
@ -1004,7 +1004,7 @@ package body Sem_Warn is
|
|||
-- Do not output complaint about never being assigned a
|
||||
-- value if a pragma Unmodified applies to the variable
|
||||
-- we are examining, or if it is a parameter, if there is
|
||||
-- a pragma Unreferenced for the corresponding spec, of
|
||||
-- a pragma Unreferenced for the corresponding spec, or
|
||||
-- if the type is marked as having unreferenced objects.
|
||||
-- The last is a little peculiar, but better too few than
|
||||
-- too many warnings in this situation.
|
||||
|
|
@ -1026,7 +1026,7 @@ package body Sem_Warn is
|
|||
-- has a separate declaration in a different unit. This
|
||||
-- is the case where the client of a package sees only
|
||||
-- the private type, and it may be quite reasonable
|
||||
-- for the logical view to be in out, even if the
|
||||
-- for the logical view to be IN OUT, even if the
|
||||
-- implementation ends up using access types or some
|
||||
-- other method to achieve the local effect of a
|
||||
-- modification. On the other hand if the spec and body
|
||||
|
|
@ -1050,10 +1050,10 @@ package body Sem_Warn is
|
|||
then
|
||||
null;
|
||||
|
||||
-- Suppress warning if composite type containing any
|
||||
-- access element component, since the logical effect
|
||||
-- of modifying a parameter may be achieved by modifying
|
||||
-- a referenced entity.
|
||||
-- Suppress warning if composite type contains any access
|
||||
-- component, since the logical effect of modifying a
|
||||
-- parameter may be achieved by modifying a referenced
|
||||
-- object.
|
||||
|
||||
elsif Is_Composite_Type (E1T)
|
||||
and then Has_Access_Values (E1T)
|
||||
|
|
@ -1237,7 +1237,7 @@ package body Sem_Warn is
|
|||
|
||||
-- If Referenced_As_LHS is set, then that's still interesting
|
||||
-- (potential "assigned but never read" case), but not if we
|
||||
-- have pragma Unreferenced, which cancels this error.
|
||||
-- have pragma Unreferenced, which cancels this warning.
|
||||
|
||||
and then (not Referenced_As_LHS_Check_Spec (E1)
|
||||
or else not Has_Unreferenced (E1))
|
||||
|
|
@ -1253,13 +1253,13 @@ package body Sem_Warn is
|
|||
(Check_Unreferenced_Formals and then Is_Formal (E1))
|
||||
|
||||
-- Case of warning on unread variables modified by an
|
||||
-- assignment, or an out parameter if it is the only one.
|
||||
-- assignment, or an OUT parameter if it is the only one.
|
||||
|
||||
or else
|
||||
(Warn_On_Modified_Unread
|
||||
and then Referenced_As_LHS_Check_Spec (E1))
|
||||
|
||||
-- Case of warning on any unread out parameter (note
|
||||
-- Case of warning on any unread OUT parameter (note
|
||||
-- such indications are only set if the appropriate
|
||||
-- warning options were set, so no need to recheck here.
|
||||
|
||||
|
|
@ -1285,11 +1285,11 @@ package body Sem_Warn is
|
|||
or else
|
||||
Is_Overloadable (E1)
|
||||
|
||||
-- Package case, if the main unit is a package
|
||||
-- spec or generic package spec, then there may
|
||||
-- be a corresponding body that references this
|
||||
-- package in some other file. Otherwise we can
|
||||
-- be sure that there is no other reference.
|
||||
-- Package case, if the main unit is a package spec
|
||||
-- or generic package spec, then there may be a
|
||||
-- corresponding body that references this package
|
||||
-- in some other file. Otherwise we can be sure
|
||||
-- that there is no other reference.
|
||||
|
||||
or else
|
||||
(Ekind (E1) = E_Package
|
||||
|
|
@ -1314,7 +1314,7 @@ package body Sem_Warn is
|
|||
and then
|
||||
Referenced (Spec_Entity (E1)))
|
||||
|
||||
-- Consider private type referenced if full view is referenced
|
||||
-- Consider private type referenced if full view is referenced.
|
||||
-- If there is not full view, this is a generic type on which
|
||||
-- warnings are also useful.
|
||||
|
||||
|
|
@ -1330,7 +1330,7 @@ package body Sem_Warn is
|
|||
|
||||
-- Eliminate dispatching operations from consideration, we
|
||||
-- cannot tell if these are referenced or not in any easy
|
||||
-- manner (note this also catches Adjust/Finalize/Initialize)
|
||||
-- manner (note this also catches Adjust/Finalize/Initialize).
|
||||
|
||||
and then not Is_Dispatching_Operation (E1)
|
||||
|
||||
|
|
@ -1356,7 +1356,7 @@ package body Sem_Warn is
|
|||
or else not Is_Task_Type (E1T))
|
||||
|
||||
-- For subunits, only place warnings on the main unit itself,
|
||||
-- since parent units are not completely compiled
|
||||
-- since parent units are not completely compiled.
|
||||
|
||||
and then (Nkind (Unit (Cunit (Main_Unit))) /= N_Subunit
|
||||
or else
|
||||
|
|
@ -1372,7 +1372,7 @@ package body Sem_Warn is
|
|||
then
|
||||
-- Suppress warnings in internal units if not in -gnatg mode
|
||||
-- (these would be junk warnings for an applications program,
|
||||
-- since they refer to problems in internal units)
|
||||
-- since they refer to problems in internal units).
|
||||
|
||||
if GNAT_Mode
|
||||
or else not
|
||||
|
|
@ -1425,8 +1425,8 @@ package body Sem_Warn is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- Recurse into nested package or block. Do not recurse into a
|
||||
-- formal package, because the corresponding body is not analyzed.
|
||||
-- Recurse into nested package or block. Do not recurse into a formal
|
||||
-- package, because the corresponding body is not analyzed.
|
||||
|
||||
<<Continue>>
|
||||
if (Is_Package_Or_Generic_Package (E1)
|
||||
|
|
@ -1484,7 +1484,7 @@ package body Sem_Warn is
|
|||
|
||||
function Prefix_Has_Dereference (Pref : Node_Id) return Boolean is
|
||||
begin
|
||||
-- If prefix is of an access type, certainly need a dereference
|
||||
-- If prefix is of an access type, it certainly needs a dereference
|
||||
|
||||
if Is_Access_Type (Etype (Pref)) then
|
||||
return True;
|
||||
|
|
@ -1526,13 +1526,13 @@ package body Sem_Warn is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- Otherwise see what kind of node we have. If the entity already
|
||||
-- has an unset reference, it is not necessarily the earliest in
|
||||
-- the text, because resolution of the prefix of selected components
|
||||
-- is completed before the resolution of the selected component itself.
|
||||
-- as a result, given (R /= null and then R.X > 0), the occurrences
|
||||
-- of R are examined in right-to-left order. If there is already an
|
||||
-- unset reference, we check whether N is earlier before proceeding.
|
||||
-- Otherwise see what kind of node we have. If the entity already has an
|
||||
-- unset reference, it is not necessarily the earliest in the text,
|
||||
-- because resolution of the prefix of selected components is completed
|
||||
-- before the resolution of the selected component itself. As a result,
|
||||
-- given (R /= null and then R.X > 0), the occurrences of R are examined
|
||||
-- in right-to-left order. If there is already an unset reference, we
|
||||
-- check whether N is earlier before proceeding.
|
||||
|
||||
case Nkind (N) is
|
||||
|
||||
|
|
@ -1560,11 +1560,11 @@ package body Sem_Warn is
|
|||
-- component with default initialization. Both of these
|
||||
-- cases can be ignored, since the actual object that is
|
||||
-- referenced is definitely initialized. Note that this
|
||||
-- covers the case of reading discriminants of an out
|
||||
-- covers the case of reading discriminants of an OUT
|
||||
-- parameter, which is OK even in Ada 83.
|
||||
|
||||
-- Note that we are only interested in a direct reference to
|
||||
-- a record component here. If the reference is via an
|
||||
-- a record component here. If the reference is through an
|
||||
-- access type, then the access object is being referenced,
|
||||
-- not the record, and still deserves an unset reference.
|
||||
|
||||
|
|
@ -1622,9 +1622,9 @@ package body Sem_Warn is
|
|||
SR := Scope (SR);
|
||||
end loop;
|
||||
|
||||
-- Case of reference has an access type. This is special
|
||||
-- case since access types are always set to null so
|
||||
-- cannot be truly uninitialized, but we still want to
|
||||
-- Case of reference has an access type. This is a
|
||||
-- special case since access types are always set to null
|
||||
-- so cannot be truly uninitialized, but we still want to
|
||||
-- warn about cases of obvious null dereference.
|
||||
|
||||
if Is_Access_Type (Typ) then
|
||||
|
|
@ -1634,7 +1634,7 @@ package body Sem_Warn is
|
|||
function Process
|
||||
(N : Node_Id) return Traverse_Result;
|
||||
-- Process function for instantiation of Traverse
|
||||
-- below. Checks if N contains reference to other
|
||||
-- below. Checks if N contains reference to E other
|
||||
-- than a dereference.
|
||||
|
||||
function Ref_In (Nod : Node_Id) return Boolean;
|
||||
|
|
@ -1699,7 +1699,7 @@ package body Sem_Warn is
|
|||
end if;
|
||||
|
||||
-- One more check, don't bother with references
|
||||
-- that are inside conditional statements or while
|
||||
-- that are inside conditional statements or WHILE
|
||||
-- loops if the condition references the entity in
|
||||
-- question. This avoids most false positives.
|
||||
|
||||
|
|
@ -1864,22 +1864,22 @@ package body Sem_Warn is
|
|||
Pack : Entity_Id;
|
||||
|
||||
procedure Check_Inner_Package (Pack : Entity_Id);
|
||||
-- Pack is a package local to a unit in a with_clause. Both the
|
||||
-- unit and Pack are referenced. If none of the entities in Pack
|
||||
-- are referenced, then the only occurrence of Pack is in a use
|
||||
-- clause or a pragma, and a warning is worthwhile as well.
|
||||
-- Pack is a package local to a unit in a with_clause. Both the unit
|
||||
-- and Pack are referenced. If none of the entities in Pack are
|
||||
-- referenced, then the only occurrence of Pack is in a USE clause
|
||||
-- or a pragma, and a warning is worthwhile as well.
|
||||
|
||||
function Check_System_Aux return Boolean;
|
||||
-- Before giving a warning on a with_clause for System, check
|
||||
-- whether a system extension is present.
|
||||
-- Before giving a warning on a with_clause for System, check wheter
|
||||
-- a system extension is present.
|
||||
|
||||
function Find_Package_Renaming
|
||||
(P : Entity_Id;
|
||||
L : Entity_Id) return Entity_Id;
|
||||
-- The only reference to a context unit may be in a renaming
|
||||
-- declaration. If this renaming declares a visible entity, do
|
||||
-- not warn that the context clause could be moved to the body,
|
||||
-- because the renaming may be intended to re-export the unit.
|
||||
-- declaration. If this renaming declares a visible entity, do not
|
||||
-- warn that the context clause could be moved to the body, because
|
||||
-- the renaming may be intended to re-export the unit.
|
||||
|
||||
-------------------------
|
||||
-- Check_Inner_Package --
|
||||
|
|
|
|||
Loading…
Reference in New Issue