+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.
-- --
-- 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- --
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";
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
end if;
-- Entry or subprogram declarations, the applicable pragmas are:
+ -- Attach_Handler
-- Contract_Cases
-- Depends
-- Extensions_Visible
-- Global
+ -- Interrupt_Handler
-- Postcondition
-- Precondition
-- Test_Case
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,
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
-- Abstract_State
-- Async_Readers
-- Async_Writers
+ -- Attach_Handler
-- Constant_After_Elaboration
-- Contract_Cases
-- Depends
-- Global
-- Initial_Condition
-- Initializes
+ -- Interrupt_Handler
-- Part_Of
-- Postcondition
-- Precondition
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
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
-- Abstract_State
-- Async_Readers
-- Async_Writers
+ -- Attach_Handler
+ -- Constant_After_Elaboration
-- Contract_Cases
-- Depends
-- Effective_Reads
-- Global
-- Initial_Condition
-- Initializes
+ -- Interrupt_Handler
-- Part_Of
-- Precondition
-- Postcondition
-- 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
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
-- 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
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;
-----------------------------------------
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;
--------------------------------------------------
projects / gcc.git / commitdiff