[multiple changes]
2016-04-27 Arnaud Charlet <charlet@adacore.com> * sem_ch10.adb, sem_case.adb: Mark messages udner -gnatwr when needed. 2016-04-27 Hristian Kirtchev <kirtchev@adacore.com> * errout.adb, errutil.adb: Minor reformatting. 2016-04-27 Ed Schonberg <schonberg@adacore.com> * sem_ch13.adb (Analyze_Aspect_Specifications, case Pre/Post): Check that the classwide version is illegal when the prefix is an operation of an untagged synchronized type. From-SVN: r235504
This commit is contained in:
parent
ac566cbe4b
commit
57323d5bd3
6 changed files with 37 additions and 8 deletions
|
@ -1,3 +1,17 @@
|
||||||
|
2016-04-27 Arnaud Charlet <charlet@adacore.com>
|
||||||
|
|
||||||
|
* sem_ch10.adb, sem_case.adb: Mark messages udner -gnatwr when needed.
|
||||||
|
|
||||||
|
2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>
|
||||||
|
|
||||||
|
* errout.adb, errutil.adb: Minor reformatting.
|
||||||
|
|
||||||
|
2016-04-27 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* sem_ch13.adb (Analyze_Aspect_Specifications, case Pre/Post):
|
||||||
|
Check that the classwide version is illegal when the prefix is
|
||||||
|
an operation of an untagged synchronized type.
|
||||||
|
|
||||||
2016-04-27 Arnaud Charlet <charleT@adacore.com>
|
2016-04-27 Arnaud Charlet <charleT@adacore.com>
|
||||||
|
|
||||||
* sinput-l.ads, sem_ch13.adb: Minor editing.
|
* sinput-l.ads, sem_ch13.adb: Minor editing.
|
||||||
|
|
|
@ -3082,6 +3082,7 @@ package body Errout is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Is_Serious_Error then
|
if Is_Serious_Error then
|
||||||
|
|
||||||
-- We always set Error_Posted on the node itself
|
-- We always set Error_Posted on the node itself
|
||||||
|
|
||||||
Set_Error_Posted (N);
|
Set_Error_Posted (N);
|
||||||
|
|
|
@ -314,8 +314,7 @@ package body Errutil is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
elsif Errors.Table (Cur_Msg).Warn
|
elsif Errors.Table (Cur_Msg).Warn
|
||||||
or else
|
or else Errors.Table (Cur_Msg).Style
|
||||||
Errors.Table (Cur_Msg).Style
|
|
||||||
then
|
then
|
||||||
Warnings_Detected := Warnings_Detected + 1;
|
Warnings_Detected := Warnings_Detected + 1;
|
||||||
|
|
||||||
|
|
|
@ -1128,10 +1128,7 @@ package body Sem_Case is
|
||||||
procedure No_OP (C : Node_Id) is
|
procedure No_OP (C : Node_Id) is
|
||||||
begin
|
begin
|
||||||
if Nkind (C) = N_Range and then Warn_On_Redundant_Constructs then
|
if Nkind (C) = N_Range and then Warn_On_Redundant_Constructs then
|
||||||
Error_Msg_N ("choice is an empty range?", C);
|
Error_Msg_N ("choice is an empty range?r?", C);
|
||||||
|
|
||||||
else
|
|
||||||
null;
|
|
||||||
end if;
|
end if;
|
||||||
end No_OP;
|
end No_OP;
|
||||||
|
|
||||||
|
|
|
@ -557,7 +557,7 @@ package body Sem_Ch10 is
|
||||||
or else Used_In_Spec)
|
or else Used_In_Spec)
|
||||||
then
|
then
|
||||||
Error_Msg_N -- CODEFIX
|
Error_Msg_N -- CODEFIX
|
||||||
("redundant with clause in body??", Clause);
|
("redundant with clause in body?r?", Clause);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Used_In_Body := False;
|
Used_In_Body := False;
|
||||||
|
@ -586,7 +586,7 @@ package body Sem_Ch10 is
|
||||||
|
|
||||||
if Withed then
|
if Withed then
|
||||||
Error_Msg_N -- CODEFIX
|
Error_Msg_N -- CODEFIX
|
||||||
("redundant with clause??", Clause);
|
("redundant with clause?r?", Clause);
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
|
|
|
@ -3129,6 +3129,24 @@ package body Sem_Ch13 is
|
||||||
Pname := Name_Postcondition;
|
Pname := Name_Postcondition;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- Check that the class-wide predicate cannot be applied to
|
||||||
|
-- an operation of a synchronized type that is not a tagged
|
||||||
|
-- type. Other legality checks are performed when analyzing
|
||||||
|
-- the contract of the operation.
|
||||||
|
|
||||||
|
if Class_Present (Aspect)
|
||||||
|
and then Is_Concurrent_Type (Current_Scope)
|
||||||
|
and then not Is_Tagged_Type (Current_Scope)
|
||||||
|
and then Ekind_In (E, E_Entry, E_Function, E_Procedure)
|
||||||
|
then
|
||||||
|
Error_Msg_Name_1 := Original_Aspect_Pragma_Name (Aspect);
|
||||||
|
Error_Msg_N
|
||||||
|
("aspect % can only be specified for a primitive "
|
||||||
|
& "operation of a tagged type", Aspect);
|
||||||
|
|
||||||
|
goto Continue;
|
||||||
|
end if;
|
||||||
|
|
||||||
-- If the expressions is of the form A and then B, then
|
-- If the expressions is of the form A and then B, then
|
||||||
-- we generate separate Pre/Post aspects for the separate
|
-- we generate separate Pre/Post aspects for the separate
|
||||||
-- clauses. Since we allow multiple pragmas, there is no
|
-- clauses. Since we allow multiple pragmas, there is no
|
||||||
|
|
Loading…
Add table
Reference in a new issue