[multiple changes]

2015-03-02  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, exp_attr.adb, checks.adb, exp_aggr.adb: Minor
	reformatting.

2015-03-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb: extend use of Available_Subtype.

2015-03-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Duplication_Error): Remove the special handling
	of 'Class or _Class in the context of pre/postconditions.
	(Process_Class_Wide_Condition): Remove the special handling of
	'Class or _Class in the context of pre/postconditions.
	* sem_util.adb (Original_Aspect_Pragma_Name): Names Pre_Class
	and Post_Class no longer need to be converted to _Pre and _Post.
	* sem_util.ads (Original_Aspect_Pragma_Name): Update the comment
	on usage.

2015-03-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch6.adb (Process_Preconditions): Modify the
	mechanism that find the first source declaration to correct exit
	the loop once it has been found.

2015-03-02  Gary Dismukes  <dismukes@adacore.com>

	* a-strsea.adb: Minor typo fix.

2015-03-02  Bob Duff  <duff@adacore.com>

	* einfo.ads: Minor comment fixes.

From-SVN: r221103
This commit is contained in:
Arnaud Charlet 2015-03-02 10:28:56 +01:00
parent e99991618f
commit e0c23ac71c
12 changed files with 64 additions and 71 deletions

View File

@ -1,3 +1,37 @@
2015-03-02 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, exp_attr.adb, checks.adb, exp_aggr.adb: Minor
reformatting.
2015-03-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb: extend use of Available_Subtype.
2015-03-02 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Duplication_Error): Remove the special handling
of 'Class or _Class in the context of pre/postconditions.
(Process_Class_Wide_Condition): Remove the special handling of
'Class or _Class in the context of pre/postconditions.
* sem_util.adb (Original_Aspect_Pragma_Name): Names Pre_Class
and Post_Class no longer need to be converted to _Pre and _Post.
* sem_util.ads (Original_Aspect_Pragma_Name): Update the comment
on usage.
2015-03-02 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch6.adb (Process_Preconditions): Modify the
mechanism that find the first source declaration to correct exit
the loop once it has been found.
2015-03-02 Gary Dismukes <dismukes@adacore.com>
* a-strsea.adb: Minor typo fix.
2015-03-02 Bob Duff <duff@adacore.com>
* einfo.ads: Minor comment fixes.
2015-03-02 Gary Dismukes <dismukes@adacore.com>
* einfo.adb, checks.adb: Minor reformatting and typo fixes.

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -263,7 +263,7 @@ package body Ada.Strings.Search is
-- Here if no token found
-- RM 2005 A.4.3 (68/1)) specifies that an exception must be raised if
-- RM 2005 A.4.3 (68/1) specifies that an exception must be raised if
-- Source'First is not positive and is assigned to First. Formulation
-- is slightly different in RM 2012, but the intent seems similar, so
-- we check explicitly for that condition.

View File

@ -2576,7 +2576,7 @@ package body Checks is
or else Is_Formal_Subprogram (Subp)
-- Do not process imported subprograms since pre- and postconditions
-- Do not process imported subprograms since pre and postconditions
-- are never verified on routines coming from a different language.
or else Is_Imported (Subp)

View File

@ -2882,7 +2882,7 @@ package Einfo is
-- Is_Public (Flag10)
-- Defined in all entities. Set to indicate that an entity defined in
-- one compilation unit can be referenced from other compilation units.
-- If this reference causes a reference in the generated variable, for
-- If this reference causes a reference in the generated code, for
-- example in the case of a variable name, then the backend will generate
-- an appropriate external name for use by the linker.
@ -3875,8 +3875,8 @@ package Einfo is
-- Defined in all entities. Points to the entity for the scope (block,
-- loop, subprogram, package etc.) in which the entity is declared.
-- Since this field is in the base part of the entity node, the access
-- routines for this field are in Sinfo. Note that for a child package,
-- the Scope will be the parent package, and for a non-child package,
-- routines for this field are in Sinfo. Note that for a child unit,
-- the Scope will be the parent package, and for a root library unit,
-- the Scope will be Standard.
-- Scope_Depth (synthesized)

View File

@ -1542,12 +1542,12 @@ package body Exp_Aggr is
if Is_Scalar_Type (Ctype) then
if Present (Default_Aspect_Component_Value (Typ)) then
return Default_Aspect_Component_Value (Typ);
elsif Present (Default_Aspect_Value (Ctype)) then
return Default_Aspect_Value (Ctype);
else
return Empty;
end if;
else
return Empty;
end if;

View File

@ -3654,16 +3654,17 @@ package body Exp_Attr is
Expr :=
Make_Function_Call (Loc,
Name =>
Name =>
New_Occurrence_Of (RTE (RE_Descendant_Tag), Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Standard_String, Loc),
Prefix =>
New_Occurrence_Of (Standard_String, Loc),
Attribute_Name => Name_Input,
Expressions => New_List (
Expressions => New_List (
Relocate_Node (Duplicate_Subexpr (Strm)))),
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (P_Type, Loc),
Prefix => New_Occurrence_Of (P_Type, Loc),
Attribute_Name => Name_Tag)));
Set_Etype (Expr, RTE (RE_Tag));

View File

@ -7718,9 +7718,10 @@ package body Exp_Ch6 is
Decl := First (Decls);
while Present (Decl) loop
if not Comes_From_Source (Decl) then
Insert_Node := Decl;
if Comes_From_Source (Decl) then
exit;
else
Insert_Node := Decl;
end if;
Next (Decl);

View File

@ -16466,7 +16466,7 @@ package body Sem_Ch3 is
Set_Has_Private_Declaration (Prev);
Set_Has_Private_Declaration (Id);
-- AI12-0133: indicate whether we have a partial view with
-- AI12-0133: Indicate whether we have a partial view with
-- unknown discriminants, in which case initialization of objects
-- of the type do not receive an invariant check.

View File

@ -6593,8 +6593,7 @@ package body Sem_Ch8 is
and then (not Is_Entity_Name (P)
or else Chars (Entity (P)) /= Name_uInit)
then
if Is_Entity_Name (P)
and then Ekind (Etype (P)) = E_Record_Subtype
if Ekind (Etype (P)) = E_Record_Subtype
and then Nkind (Parent (Etype (P))) = N_Subtype_Declaration
and then Is_Array_Type (Etype (Selector))
and then not Is_Packed (Etype (Selector))

View File

@ -21445,10 +21445,6 @@ package body Sem_Prag is
procedure Replace_Types is new Traverse_Proc (Replace_Type);
-- Local variables
Prag_Nam : constant Name_Id := Original_Aspect_Pragma_Name (N);
-- Start of processing for Process_Class_Wide_Condition
begin
@ -21456,8 +21452,9 @@ package body Sem_Prag is
-- dispatching type, therefore the aspect/pragma is illegal.
if No (Disp_Typ) then
Error_Msg_Name_1 := Original_Aspect_Pragma_Name (N);
if From_Aspect_Specification (N) then
Error_Msg_Name_1 := Prag_Nam;
Error_Msg_N
("aspect % can only be specified for a primitive operation "
& "of a tagged type", Corresponding_Aspect (N));
@ -21465,12 +21462,6 @@ package body Sem_Prag is
-- The pragma is a source construct
else
if Prag_Nam = Name_Precondition then
Error_Msg_Name_1 := Name_Pre_Class;
else
Error_Msg_Name_1 := Name_Post_Class;
end if;
Error_Msg_N
("pragma % can only be specified for a primitive operation "
& "of a tagged type", N);
@ -24973,11 +24964,11 @@ package body Sem_Prag is
procedure Duplication_Error (Prag : Node_Id; Prev : Node_Id) is
Prag_From_Asp : constant Boolean := From_Aspect_Specification (Prag);
Prag_Nam : constant Name_Id := Original_Aspect_Pragma_Name (Prag);
Prev_From_Asp : constant Boolean := From_Aspect_Specification (Prev);
begin
Error_Msg_Sloc := Sloc (Prev);
Error_Msg_Sloc := Sloc (Prev);
Error_Msg_Name_1 := Original_Aspect_Pragma_Name (Prag);
-- Emit a precise message to distinguish between source pragmas and
-- pragmas generated from aspects. The ordering of the two pragmas is
@ -24989,42 +24980,14 @@ package body Sem_Prag is
-- No error is emitted when both pragmas come from aspects because this
-- is already detected by the general aspect analysis mechanism.
if Prag_Nam = Name_uPre then
Error_Msg_Name_1 := Name_Pre;
elsif Prag_Nam = Name_uPost then
Error_Msg_Name_1 := Name_Post;
if Prag_From_Asp and Prev_From_Asp then
null;
elsif Prag_From_Asp then
Error_Msg_N ("aspect % duplicates pragma declared #", Prag);
elsif Prev_From_Asp then
Error_Msg_N ("pragma % duplicates aspect declared #", Prag);
else
Error_Msg_Name_1 := Prag_Nam;
end if;
-- The item appears as aspect XXX'Class or pragma XXX_Class
if Class_Present (Prag) then
if Prag_From_Asp and Prev_From_Asp then
null;
elsif Prag_From_Asp then
Error_Msg_N
("aspect `%'Class` duplicates pragma declared #", Prag);
elsif Prev_From_Asp then
Error_Msg_N
("pragma `%_Class` duplicates aspect declared #", Prag);
else
Error_Msg_N
("pragma `%_Class` duplicates pragma declared #", Prag);
end if;
-- Otherwise the pragma appears in its normal form
else
if Prag_From_Asp and Prev_From_Asp then
null;
elsif Prag_From_Asp then
Error_Msg_N ("aspect % duplicates pragma declared #", Prag);
elsif Prev_From_Asp then
Error_Msg_N ("pragma % duplicates aspect declared #", Prag);
else
Error_Msg_N ("pragma % duplicates pragma declared #", Prag);
end if;
Error_Msg_N ("pragma % duplicates pragma declared #", Prag);
end if;
end Duplication_Error;

View File

@ -15538,15 +15538,12 @@ package body Sem_Util is
if Item_Nam = Name_Invariant then
Item_Nam := Name_uInvariant;
elsif Nam_In (Item_Nam, Name_Post, Name_Post_Class) then
elsif Item_Nam = Name_Post then
Item_Nam := Name_uPost;
elsif Nam_In (Item_Nam, Name_Pre, Name_Pre_Class) then
elsif Item_Nam = Name_Pre then
Item_Nam := Name_uPre;
elsif Item_Nam = Name_Invariant then
Item_Nam := Name_uInvariant;
elsif Nam_In (Item_Nam, Name_Type_Invariant,
Name_Type_Invariant_Class)
then

View File

@ -1683,9 +1683,7 @@ package Sem_Util is
-- returns the following values:
--
-- Invariant -> Name_uInvariant
-- Post -> Name_uPost
-- Post'Class -> Name_uPost
-- Pre -> Name_uPre
-- Pre'Class -> Name_uPre
-- Type_Invariant -> Name_uType_Invariant
-- Type_Invariant'Class -> Name_uType_Invariant