[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:
Arnaud Charlet 2015-11-18 11:42:27 +01:00
parent a25e72b5e5
commit c0dd5b3822
9 changed files with 91 additions and 48 deletions

View File

@ -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.

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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;

View File

@ -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;
--------------------------------------------------