diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 31 | ||||
| -rw-r--r-- | gcc/ada/a-direct.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/contracts.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/contracts.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/s-os_lib.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 22 |
9 files changed, 91 insertions, 48 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 54ec263..de28d46 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,36 @@ 2015-11-18 Hristian Kirtchev <kirtchev@adacore.com> + * contracts.adb (Add_Contract_Item): Chain pragmas Attach_Handler + and Interrupt_Handler on the classifications list of a [generic] + procedure N_Contract node. + * contracts.ads (Add_Contract_Item): Update the comment on usage. + * einfo.adb (Get_Pragma): Pragmas Attach_Handler and + Interrupt_Handler are found on the classifications list of + N_Contract nodes. + * einfo.ads (Get_Pragma): Update the comment on usage. + * sem_prag.adb (Process_Interrupt_Or_Attach_Handler): Code + reformatting. Store the pragma as a contract item. + +2015-11-18 Ed Schonberg <schonberg@adacore.com> + + * sem_ch8.adb (Available_Subtype): Use only in GNATprove + mode. When generating code it may be necessary to create itypes + at the point of use of a selected component, for example in the + expansion of a record equality operation. + +2015-11-18 Vincent Celier <celier@adacore.com> + + * s-os_lib.adb (Normalize_Pathname.Get_Directory): When + invoking Normalize_Pathname, use the same values for parameters + Resolve_Links and Case_Sensitive as the parent Normalize_Pathname. + +2015-11-18 Vincent Celier <celier@adacore.com> + + * a-direct.adb (Containing_Directory): Return "." when the result + is the current directory, not specified as an absolute path name. + +2015-11-18 Hristian Kirtchev <kirtchev@adacore.com> + * exp_aggr.adb (Is_Completely_Hidden_Discriminant): New routine. (Init_Hidden_Discriminants): Code reformatting. Do not initialize a completely hidden discriminant. diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb index d281829..7c5c4f4 100644 --- a/gcc/ada/a-direct.adb +++ b/gcc/ada/a-direct.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2015, Free Software Foundation, Inc. -- -- -- -- 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- -- @@ -208,35 +208,31 @@ package body Ada.Directories is else declare - -- We need to resolve links because of A.16(47), since we must not - -- return alternative names for files. - - Norm : constant String := Normalize_Pathname (Name); Last_DS : constant Natural := Strings.Fixed.Index (Name, Dir_Seps, Going => Strings.Backward); begin if Last_DS = 0 then - -- There is no directory separator, returns current working - -- directory. + -- There is no directory separator, returns "." representing + -- the current working directory. - return Current_Directory; + return "."; -- If Name indicates a root directory, raise Use_Error, because -- it has no containing directory. - elsif Norm = "/" + elsif Name = "/" or else (Windows and then - (Norm = "\" + (Name = "\" or else - (Norm'Length = 3 - and then Norm (Norm'Last - 1 .. Norm'Last) = ":\" - and then (Norm (Norm'First) in 'a' .. 'z' + (Name'Length = 3 + and then Name (Name'Last - 1 .. Name'Last) = ":\" + and then (Name (Name'First) in 'a' .. 'z' or else - Norm (Norm'First) in 'A' .. 'Z')))) + Name (Name'First) in 'A' .. 'Z')))) then raise Use_Error with "directory """ & Name & """ has no containing directory"; @@ -270,15 +266,10 @@ package body Ada.Directories is Last := Last - 1; end loop; - -- Special case of current directory, identified by "." - - if Last = 1 and then Result (1) = '.' then - return Current_Directory; - -- Special case of "..": the current directory may be a root -- directory. - elsif Last = 2 and then Result (1 .. 2) = ".." then + if Last = 2 and then Result (1 .. 2) = ".." then return Containing_Directory (Current_Directory); else diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 64960c1..4b6a127 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -153,10 +153,12 @@ package body Contracts is end if; -- Entry or subprogram declarations, the applicable pragmas are: + -- Attach_Handler -- Contract_Cases -- Depends -- Extensions_Visible -- Global + -- Interrupt_Handler -- Postcondition -- Precondition -- Test_Case @@ -168,11 +170,10 @@ package body Contracts is E_Generic_Procedure, E_Procedure) then - if Nam_In (Prag_Nam, Name_Postcondition, Name_Precondition) then - Add_Pre_Post_Condition; - - elsif Nam_In (Prag_Nam, Name_Contract_Cases, Name_Test_Case) then - Add_Contract_Test_Case; + if Nam_In (Prag_Nam, Name_Attach_Handler, Name_Interrupt_Handler) + and then Ekind_In (Id, E_Generic_Procedure, E_Procedure) + then + Add_Classification; elsif Nam_In (Prag_Nam, Name_Depends, Name_Extensions_Visible, @@ -185,6 +186,12 @@ package body Contracts is then Add_Classification; + elsif Nam_In (Prag_Nam, Name_Contract_Cases, Name_Test_Case) then + Add_Contract_Test_Case; + + elsif Nam_In (Prag_Nam, Name_Postcondition, Name_Precondition) then + Add_Pre_Post_Condition; + -- The pragma is not a proper contract item else diff --git a/gcc/ada/contracts.ads b/gcc/ada/contracts.ads index 21c609d..ee231fc 100644 --- a/gcc/ada/contracts.ads +++ b/gcc/ada/contracts.ads @@ -38,6 +38,7 @@ package Contracts is -- Abstract_State -- Async_Readers -- Async_Writers + -- Attach_Handler -- Constant_After_Elaboration -- Contract_Cases -- Depends @@ -47,6 +48,7 @@ package Contracts is -- Global -- Initial_Condition -- Initializes + -- Interrupt_Handler -- Part_Of -- Postcondition -- Precondition diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index b7c2732..a8cfa1a 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -7103,6 +7103,7 @@ package body Einfo is Is_CLS : constant Boolean := Id = Pragma_Abstract_State or else + Id = Pragma_Attach_Handler or else Id = Pragma_Async_Readers or else Id = Pragma_Async_Writers or else Id = Pragma_Constant_After_Elaboration or else @@ -7113,6 +7114,7 @@ package body Einfo is Id = Pragma_Global or else Id = Pragma_Initial_Condition or else Id = Pragma_Initializes or else + Id = Pragma_Interrupt_Handler or else Id = Pragma_Part_Of or else Id = Pragma_Refined_Depends or else Id = Pragma_Refined_Global or else diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 28fa5d6..d1f441b 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -8035,6 +8035,8 @@ package Einfo is -- Abstract_State -- Async_Readers -- Async_Writers + -- Attach_Handler + -- Constant_After_Elaboration -- Contract_Cases -- Depends -- Effective_Reads @@ -8042,6 +8044,7 @@ package Einfo is -- Global -- Initial_Condition -- Initializes + -- Interrupt_Handler -- Part_Of -- Precondition -- Postcondition @@ -8050,6 +8053,7 @@ package Einfo is -- Refined_Post -- Refined_State -- Test_Case + -- Volatile_Function function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id; -- Searches the Rep_Item chain for a given entity E, for a record diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 83c20a9..15f1fa7 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -2087,7 +2087,9 @@ package body System.OS_Lib is if Dir'Length > 0 then declare Result : String := - Normalize_Pathname (Dir, "") & Directory_Separator; + Normalize_Pathname + (Dir, "", Resolve_Links, Case_Sensitive) & + Directory_Separator; Last : Positive := Result'Last - 1; begin diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 9e581e0..e8f7b1f 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6484,6 +6484,10 @@ package body Sem_Ch8 is -- This simplifies value tracing in GNATProve. For consistency, both -- the entity name and the subtype come from the constrained component. + -- This is only used in GNATProve mode: when generating code it may be + -- necessary to create an itype in the scope of use of the selected + -- component, e.g. in the context of a expanded record equality. + function Is_Reference_In_Subunit return Boolean; -- In a subunit, the scope depth is not a proper measure of hiding, -- because the context of the proper body may itself hide entities in @@ -6499,17 +6503,19 @@ package body Sem_Ch8 is Comp : Entity_Id; begin - Comp := First_Entity (Etype (P)); - while Present (Comp) loop - if Chars (Comp) = Chars (Selector_Name (N)) then - Set_Etype (N, Etype (Comp)); - Set_Entity (Selector_Name (N), Comp); - Set_Etype (Selector_Name (N), Etype (Comp)); - return True; - end if; + if GNATprove_Mode then + Comp := First_Entity (Etype (P)); + while Present (Comp) loop + if Chars (Comp) = Chars (Selector_Name (N)) then + Set_Etype (N, Etype (Comp)); + Set_Entity (Selector_Name (N), Comp); + Set_Etype (Selector_Name (N), Etype (Comp)); + return True; + end if; - Next_Component (Comp); - end loop; + Next_Component (Comp); + end loop; + end if; return False; end Available_Subtype; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d113a2c..f3282ea 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -8768,30 +8768,28 @@ package body Sem_Prag is ----------------------------------------- procedure Process_Interrupt_Or_Attach_Handler is - Arg1_X : constant Node_Id := Get_Pragma_Arg (Arg1); - Handler_Proc : constant Entity_Id := Entity (Arg1_X); - Proc_Scope : constant Entity_Id := Scope (Handler_Proc); + Handler : constant Entity_Id := Entity (Get_Pragma_Arg (Arg1)); + Prot_Typ : constant Entity_Id := Scope (Handler); begin -- A pragma that applies to a Ghost entity becomes Ghost for the -- purposes of legality checks and removal of ignored Ghost code. - Mark_Pragma_As_Ghost (N, Handler_Proc); - Set_Is_Interrupt_Handler (Handler_Proc); + Mark_Pragma_As_Ghost (N, Handler); + Set_Is_Interrupt_Handler (Handler); -- If the pragma is not associated with a handler procedure within a -- protected type, then it must be for a nonprotected procedure for -- the AAMP target, in which case we don't associate a representation -- item with the procedure's scope. - if Ekind (Proc_Scope) = E_Protected_Type then - if Prag_Id = Pragma_Interrupt_Handler - or else - Prag_Id = Pragma_Attach_Handler - then - Record_Rep_Item (Proc_Scope, N); - end if; + if Ekind (Prot_Typ) = E_Protected_Type then + Record_Rep_Item (Prot_Typ, N); end if; + + -- Chain the pragma on the contract for completeness + + Add_Contract_Item (N, Handler); end Process_Interrupt_Or_Attach_Handler; -------------------------------------------------- |