exp_util.adb, [...]: Minor reformatting.
2011-09-02 Robert Dewar <dewar@adacore.com> * exp_util.adb, exp_ch9.adb, sem_attr.adb, sem_ch6.adb: Minor reformatting. From-SVN: r178450
This commit is contained in:
Robert Dewar
Arnaud Charlet
parent
d5aa443cb4
commit
dc36a7e3bc
@ -1,3 +1,8 @@
|
||||
2011-09-02 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_util.adb, exp_ch9.adb, sem_attr.adb, sem_ch6.adb: Minor
|
||||
reformatting.
|
||||
|
||||
2011-09-02 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_ch9.adb (Install_Private_Data_Declarations): Add guards
|
||||
|
||||
@ -12481,11 +12481,11 @@ package body Exp_Ch9 is
|
||||
or else Has_Interfaces (Protect_Rec)
|
||||
or else
|
||||
((Has_Attach_Handler (Ptyp) or else Has_Interrupt_Handler (Ptyp))
|
||||
and then not Restriction_Active (No_Dynamic_Attachment))
|
||||
and then not Restriction_Active (No_Dynamic_Attachment))
|
||||
then
|
||||
declare
|
||||
Pkg_Id : constant RTU_Id :=
|
||||
Corresponding_Runtime_Package (Ptyp);
|
||||
Pkg_Id : constant RTU_Id := Corresponding_Runtime_Package (Ptyp);
|
||||
|
||||
Called_Subp : RE_Id;
|
||||
|
||||
begin
|
||||
@ -12536,8 +12536,7 @@ package body Exp_Ch9 is
|
||||
|
||||
Append_To (Args,
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
New_Reference_To (P_Arr, Loc),
|
||||
Prefix => New_Reference_To (P_Arr, Loc),
|
||||
Attribute_Name => Name_Unrestricted_Access));
|
||||
|
||||
-- Build_Entry_Names generation flag. When set to true, the
|
||||
|
||||
@ -1526,14 +1526,14 @@ package body Exp_Util is
|
||||
or else Present (Interface_List (Parent (Typ)))
|
||||
or else
|
||||
(((Has_Attach_Handler (Typ) and then not Restricted_Profile)
|
||||
or else Has_Interrupt_Handler (Typ))
|
||||
or else Has_Interrupt_Handler (Typ))
|
||||
and then not Restriction_Active (No_Dynamic_Attachment))
|
||||
then
|
||||
if Abort_Allowed
|
||||
or else Restriction_Active (No_Entry_Queue) = False
|
||||
or else Number_Entries (Typ) > 1
|
||||
or else (Has_Attach_Handler (Typ)
|
||||
and then not Restricted_Profile)
|
||||
and then not Restricted_Profile)
|
||||
then
|
||||
Pkg_Id := System_Tasking_Protected_Objects_Entries;
|
||||
else
|
||||
@ -1560,10 +1560,8 @@ package body Exp_Util is
|
||||
|
||||
if Act_ST = Etype (Exp) then
|
||||
return;
|
||||
|
||||
else
|
||||
Rewrite (Exp,
|
||||
Convert_To (Act_ST, Relocate_Node (Exp)));
|
||||
Rewrite (Exp, Convert_To (Act_ST, Relocate_Node (Exp)));
|
||||
Analyze_And_Resolve (Exp, Act_ST);
|
||||
end if;
|
||||
end Convert_To_Actual_Subtype;
|
||||
@ -1644,7 +1642,6 @@ package body Exp_Util is
|
||||
Name_Req : Boolean := False) return Node_Id
|
||||
is
|
||||
New_Exp : Node_Id;
|
||||
|
||||
begin
|
||||
Remove_Side_Effects (Exp, Name_Req);
|
||||
New_Exp := New_Copy_Tree (Exp);
|
||||
|
||||
@ -4939,12 +4939,15 @@ package body Sem_Attr is
|
||||
-- all scope checks and checks for aliased views are omitted.
|
||||
|
||||
when Attribute_Unrestricted_Access =>
|
||||
|
||||
-- If from source, deal with relevant restrictions
|
||||
|
||||
if Comes_From_Source (N) then
|
||||
Check_Restriction (No_Unchecked_Access, N);
|
||||
|
||||
if Nkind (P) in N_Has_Entity
|
||||
and then Present (Entity (P))
|
||||
and then Is_Object (Entity (P))
|
||||
and then Present (Entity (P))
|
||||
and then Is_Object (Entity (P))
|
||||
then
|
||||
Check_Restriction (No_Implicit_Aliasing, N);
|
||||
end if;
|
||||
|
||||
@ -5462,23 +5462,25 @@ package body Sem_Ch6 is
|
||||
|
||||
-- Inherited : constant Subprogram_List :=
|
||||
-- Inherited_Subprograms (Spec_Id);
|
||||
-- List of subprograms inherited by this subprogram
|
||||
-- -- List of subprograms inherited by this subprogram
|
||||
-- Code is currently commented out as, in some cases, it causes crashes
|
||||
-- because Direct_Primitive_Operations is not available for a private
|
||||
-- type???
|
||||
|
||||
Last_Postcondition : Node_Id := Empty;
|
||||
Last_Postcondition : Node_Id := Empty;
|
||||
-- Last postcondition on the subprogram, or else Empty if either no
|
||||
-- postcondition or only inherited postconditions.
|
||||
|
||||
Attribute_Result_Mentioned : Boolean := False;
|
||||
-- Whether attribute 'Result is mentioned in a postcondition
|
||||
|
||||
Post_State_Mentioned : Boolean := False;
|
||||
Post_State_Mentioned : Boolean := False;
|
||||
-- Whether some expression mentioned in a postcondition can have a
|
||||
-- different value in the post-state than in the pre-state.
|
||||
|
||||
function Check_Attr_Result (N : Node_Id) return Traverse_Result;
|
||||
-- Check whether N is a reference to the attribute 'Result, and if so
|
||||
-- set Attribute_Result_Mentioned and return Abandon. Otherwise return
|
||||
-- OK.
|
||||
-- Check if N is a reference to the attribute 'Result, and if so set
|
||||
-- Attribute_Result_Mentioned and return Abandon. Otherwise return OK.
|
||||
|
||||
function Check_Post_State (N : Node_Id) return Traverse_Result;
|
||||
-- Check whether the value of evaluating N can be different in the
|
||||
@ -5487,9 +5489,7 @@ package body Sem_Ch6 is
|
||||
-- reference to attribute 'Old, in order to ignore its prefix, which
|
||||
-- is precisely evaluated in the pre-state. Otherwise return OK.
|
||||
|
||||
procedure Process_Post_Conditions
|
||||
(Spec : Node_Id;
|
||||
Class : Boolean);
|
||||
procedure Process_Post_Conditions (Spec : Node_Id; Class : Boolean);
|
||||
-- This processes the Spec_PPC_List from Spec, processing any
|
||||
-- postconditions from the list. If Class is True, then only
|
||||
-- postconditions marked with Class_Present are considered. The
|
||||
@ -5506,8 +5506,7 @@ package body Sem_Ch6 is
|
||||
function Check_Attr_Result (N : Node_Id) return Traverse_Result is
|
||||
begin
|
||||
if Nkind (N) = N_Attribute_Reference
|
||||
and then
|
||||
Get_Attribute_Id (Attribute_Name (N)) = Attribute_Result
|
||||
and then Get_Attribute_Id (Attribute_Name (N)) = Attribute_Result
|
||||
then
|
||||
Attribute_Result_Mentioned := True;
|
||||
return Abandon;
|
||||
@ -5531,6 +5530,7 @@ package body Sem_Ch6 is
|
||||
|
||||
when N_Identifier |
|
||||
N_Expanded_Name =>
|
||||
|
||||
declare
|
||||
E : constant Entity_Id := Entity (N);
|
||||
begin
|
||||
@ -5583,7 +5583,7 @@ package body Sem_Ch6 is
|
||||
loop
|
||||
Arg := First (Pragma_Argument_Associations (Prag));
|
||||
|
||||
-- Since pre- and postconditions are listed in reverse order, the
|
||||
-- Since pre- and post-conditions are listed in reverse order, the
|
||||
-- first postcondition in the list is the last in the source.
|
||||
|
||||
if Pragma_Name (Prag) = Name_Postcondition
|
||||
@ -5607,7 +5607,7 @@ package body Sem_Ch6 is
|
||||
and then not Class
|
||||
then
|
||||
Post_State_Mentioned := False;
|
||||
Ignored := Find_Post_State (Arg);
|
||||
Ignored := Find_Post_State (Arg);
|
||||
|
||||
if not Post_State_Mentioned then
|
||||
Error_Msg_N ("?postcondition only refers to pre-state",
|
||||
@ -5635,7 +5635,7 @@ package body Sem_Ch6 is
|
||||
|
||||
-- Code is currently commented out as, in some cases, it causes crashes
|
||||
-- because Direct_Primitive_Operations is not available for a private
|
||||
-- type. This may cause more warnings to be issued than necessary.
|
||||
-- type. This may cause more warnings to be issued than necessary. ???
|
||||
|
||||
-- for J in Inherited'Range loop
|
||||
-- if Present (Spec_PPC_List (Contract (Inherited (J)))) then
|
||||
@ -5662,8 +5662,8 @@ package body Sem_Ch6 is
|
||||
procedure Check_Subprogram_Order (N : Node_Id) is
|
||||
|
||||
function Subprogram_Name_Greater (S1, S2 : String) return Boolean;
|
||||
-- This is used to check if S1 > S2 in the sense required by this
|
||||
-- test, for example nameab < namec, but name2 < name10.
|
||||
-- This is used to check if S1 > S2 in the sense required by this test,
|
||||
-- for example nameab < namec, but name2 < name10.
|
||||
|
||||
-----------------------------
|
||||
-- Subprogram_Name_Greater --
|
||||
|
||||
Loading…
Reference in New Issue
Block a user