[multiple changes]
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. From-SVN: r230536
This commit is contained in:
parent
a25e72b5e5
commit
c0dd5b3822
@ -1,3 +1,34 @@
|
||||
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.
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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,6 +6503,7 @@ package body Sem_Ch8 is
|
||||
Comp : Entity_Id;
|
||||
|
||||
begin
|
||||
if GNATprove_Mode then
|
||||
Comp := First_Entity (Etype (P));
|
||||
while Present (Comp) loop
|
||||
if Chars (Comp) = Chars (Selector_Name (N)) then
|
||||
@ -6510,6 +6515,7 @@ package body Sem_Ch8 is
|
||||
|
||||
Next_Component (Comp);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
return False;
|
||||
end Available_Subtype;
|
||||
|
@ -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;
|
||||
|
||||
--------------------------------------------------
|
||||
|
Loading…
x
Reference in New Issue
Block a user