Commit b285815e by Robert Dewar Committed by Arnaud Charlet

sem_prag.adb, [...]: Minor reformatting.

2012-03-15  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb, sem_prag.ads, sem_util.ads, sem_attr.adb, sem_ch6.adb,
	sem_warn.adb: Minor reformatting.

From-SVN: r185418
parent 22f46473
2012-03-15 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, sem_prag.ads, sem_util.ads, sem_attr.adb, sem_ch6.adb,
sem_warn.adb: Minor reformatting.
2012-03-15 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb (Initialized_By_Ctrl_Function): Do not loop over
......
......@@ -1122,9 +1122,7 @@ package body Sem_Attr is
-- Case of a subtype mark
if Is_Entity_Name (P)
and then Is_Type (Entity (P))
then
if Is_Entity_Name (P) and then Is_Type (Entity (P)) then
return;
end if;
......@@ -1134,13 +1132,13 @@ package body Sem_Attr is
if Is_Access_Type (P_Type) then
-- If there is an implicit dereference, then we must freeze
-- the designated type of the access type, since the type of
-- the referenced array is this type (see AI95-00106).
-- If there is an implicit dereference, then we must freeze the
-- designated type of the access type, since the type of the
-- referenced array is this type (see AI95-00106).
-- As done elsewhere, freezing must not happen when pre-analyzing
-- a pre- or postcondition or a default value for an object or
-- for a formal parameter.
-- a pre- or postcondition or a default value for an object or for
-- a formal parameter.
if not In_Spec_Expression then
Freeze_Before (N, Designated_Type (P_Type));
......@@ -4257,7 +4255,8 @@ package body Sem_Attr is
P);
elsif Get_Pragma_Id (Prag) = Pragma_Contract_Case
or else Get_Pragma_Id (Prag) = Pragma_Test_Case
or else
Get_Pragma_Id (Prag) = Pragma_Test_Case
then
declare
Arg_Ens : constant Node_Id :=
......
......@@ -7076,7 +7076,6 @@ package body Sem_Ch6 is
begin
Prag := Spec_CTC_List (Contract (Spec));
loop
-- Retrieve the Ensures component of the contract-case, if any
......@@ -7130,19 +7129,15 @@ package body Sem_Ch6 is
begin
Prag := Spec_PPC_List (Contract (Spec));
loop
Arg := First (Pragma_Argument_Associations (Prag));
if Pragma_Name (Prag) = Name_Postcondition then
-- Since pre- and post-conditions are listed in reverse order,
-- the first postcondition in the list is the last in the
-- source.
-- the first postcondition in the list is last in the source.
if not Class
and then No (Last_Postcondition)
then
if not Class and then No (Last_Postcondition) then
Last_Postcondition := Prag;
end if;
......@@ -7161,8 +7156,8 @@ package body Sem_Ch6 is
Ignored := Find_Post_State (Arg);
if not Post_State_Mentioned then
Error_Msg_N ("?postcondition refers only to pre-state",
Prag);
Error_Msg_N
("?postcondition refers only to pre-state", Prag);
end if;
end if;
end if;
......@@ -7208,7 +7203,7 @@ package body Sem_Ch6 is
if Ekind_In (Spec_Id, E_Function, E_Generic_Function)
and then (Present (Last_Postcondition)
or else Present (Last_Contract_Case))
or else Present (Last_Contract_Case))
and then not Attribute_Result_Mentioned
then
if Present (Last_Postcondition) then
......@@ -11045,17 +11040,16 @@ package body Sem_Ch6 is
-------------
function Grab_CC return Node_Id is
Loc : constant Source_Ptr := Sloc (Prag);
CP : Node_Id;
Req : Node_Id;
Ens : Node_Id;
Post : Node_Id;
Loc : constant Source_Ptr := Sloc (Prag);
-- Similarly to postcondition, the string is "failed xx from yy"
-- where xx is in all lower case. The reason for this different
-- wording compared to other Check cases is that the failure is not
-- at the point of occurrence of the pragma, unlike the other Check
-- cases.
-- As with postcondition, the string is "failed xx from yy" where
-- xx is in all lower case. The reason for this different wording
-- compared to other Check cases is that the failure is not at the
-- point of occurrence of the pragma, unlike the other Check cases.
Msg : constant String :=
"failed contract case from " & Build_Location_String (Loc);
......@@ -11063,57 +11057,60 @@ package body Sem_Ch6 is
begin
-- Copy the Requires and Ensures expressions
Req := New_Copy_Tree (
Expression (Get_Requires_From_Case_Pragma (Prag)),
New_Scope => Current_Scope);
Req := New_Copy_Tree
(Expression (Get_Requires_From_Case_Pragma (Prag)),
New_Scope => Current_Scope);
Ens := New_Copy_Tree (
Expression (Get_Ensures_From_Case_Pragma (Prag)),
New_Scope => Current_Scope);
Ens := New_Copy_Tree
(Expression (Get_Ensures_From_Case_Pragma (Prag)),
New_Scope => Current_Scope);
-- Build the postcondition (not Requires'Old or else Ensures)
Post := Make_Or_Else (Loc,
Left_Opnd => Make_Op_Not (Loc,
Make_Attribute_Reference (Loc,
Prefix => Req,
Attribute_Name => Name_Old)),
Right_Opnd => Ens);
Post :=
Make_Or_Else (Loc,
Left_Opnd =>
Make_Op_Not (Loc,
Make_Attribute_Reference (Loc,
Prefix => Req,
Attribute_Name => Name_Old)),
Right_Opnd => Ens);
-- For a contract case pragma within a generic, generate a
-- postcondition pragma for later expansion. This is also used
-- when an error was detected, thus setting Expander_Active to False.
if not Expander_Active then
CP := Make_Pragma (Loc,
Chars => Name_Postcondition,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Chars => Name_Check,
Expression => Post),
Make_Pragma_Argument_Association (Loc,
Chars => Name_Message,
Expression => Make_String_Literal (Loc, Msg))));
CP :=
Make_Pragma (Loc,
Chars => Name_Postcondition,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Chars => Name_Check,
Expression => Post),
Make_Pragma_Argument_Association (Loc,
Chars => Name_Message,
Expression => Make_String_Literal (Loc, Msg))));
-- Otherwise, create the Check pragma
else
CP := Make_Pragma (Loc,
Chars => Name_Check,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Chars => Name_Name,
Expression =>
Make_Identifier (Loc, Name_Postcondition)),
CP :=
Make_Pragma (Loc,
Chars => Name_Check,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Chars => Name_Name,
Expression => Make_Identifier (Loc, Name_Postcondition)),
Make_Pragma_Argument_Association (Loc,
Chars => Name_Check,
Expression => Post),
Make_Pragma_Argument_Association (Loc,
Chars => Name_Check,
Expression => Post),
Make_Pragma_Argument_Association (Loc,
Chars => Name_Message,
Expression => Make_String_Literal (Loc, Msg))));
Make_Pragma_Argument_Association (Loc,
Chars => Name_Message,
Expression => Make_String_Literal (Loc, Msg))));
end if;
-- Return the Postcondition or Check pragma
......@@ -11534,7 +11531,6 @@ package body Sem_Ch6 is
Prag := Next_Pragma (Prag);
exit when No (Prag);
end loop;
end Process_Contract_Cases;
-----------------------------
......
......@@ -35,14 +35,6 @@ package Sem_Prag is
-- Subprograms --
-----------------
procedure Analyze_PPC_In_Decl_Part (N : Node_Id; S : Entity_Id);
-- Special analyze routine for precondition/postcondition pragma that
-- appears within a declarative part where the pragma is associated
-- with a subprogram specification. N is the pragma node, and S is the
-- entity for the related subprogram. This procedure does a preanalysis
-- of the expressions in the pragma as "spec expressions" (see section
-- in Sem "Handling of Default and Per-Object Expressions...").
procedure Analyze_Pragma (N : Node_Id);
-- Analyze procedure for pragma reference node N
......@@ -54,6 +46,14 @@ package Sem_Prag is
-- expressions in the pragma as "spec expressions" (see section in Sem
-- "Handling of Default and Per-Object Expressions...").
procedure Analyze_PPC_In_Decl_Part (N : Node_Id; S : Entity_Id);
-- Special analyze routine for precondition/postcondition pragma that
-- appears within a declarative part where the pragma is associated
-- with a subprogram specification. N is the pragma node, and S is the
-- entity for the related subprogram. This procedure does a preanalysis
-- of the expressions in the pragma as "spec expressions" (see section
-- in Sem "Handling of Default and Per-Object Expressions...").
function Check_Disabled (Nam : Name_Id) return Boolean;
-- This function is used in connection with pragmas Assertion, Check,
-- Precondition, and Postcondition, to determine if Check pragmas (or
......
......@@ -575,6 +575,7 @@ package Sem_Util is
function Get_Name_From_Case_Pragma (N : Node_Id) return String_Id;
-- Return the Name component of Contract_Case or Test_Case pragma N
-- Bad name, Case_Pragma is meaningless to me ???
function Get_Pragma_Id (N : Node_Id) return Pragma_Id;
pragma Inline (Get_Pragma_Id);
......
......@@ -1772,7 +1772,8 @@ package body Sem_Warn is
if Nkind (P) = N_Pragma
and then
(Pragma_Name (P) = Name_Contract_Case
or else Pragma_Name (P) = Name_Test_Case)
or else
Pragma_Name (P) = Name_Test_Case)
and then
Nod = Get_Ensures_From_Case_Pragma (P)
then
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment