diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b5d3226fd08..b2c2a32f6cf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2011-09-06 Robert Dewar + + * g-socket.adb: Minor reformatting + +2011-09-06 Javier Miranda + + * ali.adb (Scan_ALI): Add missing support to load references of + entities imported from other languages. + * ali.ads (Xref_Record): Adding new fields to store the language and + name of an imported entity. + * lib-xref.adb (Output_Import_Export_Info): Fix typo + in comment. + +2011-09-06 Ed Schonberg + + * sem_prag.adb (Analyze_Pragma, case Type_Invariant): A type invariant + is allowed on a full type declaration if it is the completion of + a private declarations. + * sem_ch13.adb (Analyze_Aspect_Specifications): An invariant + aspect is allowed on a full type declaration in the private part + of a package. + 2011-09-06 Robert Dewar * sem_ch8.ads: Minor reformatting diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 2b90ed7e6c1..8201dc6461f 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -504,6 +504,10 @@ package body ALI is or else Nextc = '<' or else Nextc = '>' or else Nextc = '='; + -- Terminate on comma + + exit when Nextc = ','; + -- Terminate if left bracket not part of wide char sequence -- Note that we only recognize brackets notation so far ??? @@ -2389,12 +2393,21 @@ package body ALI is -- Imported entities reference as in: -- 494b25 - -- ??? Simply skipped for now if Nextc = '<' then - while Getc /= '>' loop - null; - end loop; + Skipc; + XR.Imported_Lang := Get_Name; + + pragma Assert (Nextc = ','); + Skipc; + + XR.Imported_Name := Get_Name; + + pragma Assert (Nextc = '>'); + Skipc; + else + XR.Imported_Lang := No_Name; + XR.Imported_Name := No_Name; end if; XR.Col := Get_Nat; diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 0a808179fde..b2b9b3d7ffc 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -975,6 +975,10 @@ package ALI is -- ref1 is a reference to an entity that was instantied at ref2. -- ref2 itself is also the result of an instantiation, that took -- place at ref3 + + Imported_Lang : Name_Id := No_Name; + Imported_Name : Name_Id := No_Name; + -- Language and name of imported entity reference end record; package Xref is new Table.Table ( diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 0f025800163..7fc3e5e466e 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -594,8 +594,10 @@ package body GNAT.Sockets is Socket : Socket_Type) is Last : aliased C.int := C.int (Item.Last); + begin Check_For_Fd_Set (Socket); + if Item.Last /= No_Socket then Remove_Socket_From_Set (Item.Set'Access, C.int (Socket)); Last_Socket_In_Set (Item.Set'Access, Last'Unchecked_Access); @@ -1473,6 +1475,7 @@ package body GNAT.Sockets is is begin Check_For_Fd_Set (Socket); + return Item.Last /= No_Socket and then Socket <= Item.Last and then Is_Socket_In_Set (Item.Set'Access, C.int (Socket)) /= 0; @@ -2120,6 +2123,7 @@ package body GNAT.Sockets is procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type) is begin Check_For_Fd_Set (Socket); + if Item.Last = No_Socket then -- Uninitialized socket set, make sure it is properly zeroed out diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index f2df15f4276..6ba30c71ee4 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1163,7 +1163,7 @@ package body Lib.Xref is procedure Output_Import_Export_Info (Ent : Entity_Id); -- Output language and external name information for an interfaced - -- entity, using the format , + -- entity, using the format ------------------------ -- Get_Type_Reference -- diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 17f49a8ef3a..fd7473cece6 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1289,11 +1289,22 @@ package body Sem_Ch13 is when Aspect_Invariant | Aspect_Type_Invariant => - -- Check placement legality + -- Check placement legality: An invariant must apply to a + -- private type, or appear in the private part of a spec. + -- Analysis of the pragma will verify that in the private + -- part it applies to a completion. - if not Nkind_In (N, N_Private_Type_Declaration, + if Nkind_In (N, N_Private_Type_Declaration, N_Private_Extension_Declaration) then + null; + + elsif Nkind (N) = N_Full_Type_Declaration + and then In_Private_Part (Current_Scope) + then + null; + + else Error_Msg_N ("invariant aspect must apply to a private type", N); end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c3b5dc89242..19818bd9e8a 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -10088,10 +10088,21 @@ package body Sem_Prag is if Typ = Any_Type then return; - elsif not Ekind_In (Typ, E_Private_Type, + -- An invariant must apply to a private type, or appear in the + -- private part of a package spec and apply to a completion. + + elsif Ekind_In (Typ, E_Private_Type, E_Record_Type_With_Private, E_Limited_Private_Type) then + null; + + elsif In_Private_Part (Current_Scope) + and then Has_Private_Declaration (Typ) + then + null; + + else Error_Pragma_Arg ("pragma% only allowed for private type", Arg1); end if;