+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.
-- --
-- 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- --
-- 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.
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)
-- 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.
-- 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)
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;
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));
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);
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.
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))
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
-- 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));
-- 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);
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
-- 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;
- 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
-
+ 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
- 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;
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
-- 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
projects / gcc.git / commitdiff