[multiple changes]
2014-11-07 Arnaud Charlet <charlet@adacore.com> * debug.adb, snames.adb-tmpl (Is_Keyword_Name): Consider 'overriding' a keyword in Ada 95 mode when -gnatd.D is used. * gnat_ugn.texi: Document -gnatd.D. 2014-11-07 Vasiliy Fofanov <fofanov@adacore.com> * gnatls.adb: Lower severity of the program's return value in some common cases. 2014-11-07 Ed Schonberg <schonberg@adacore.com> * sem_ch10.adb (Decorate_Type): The limited view of a tagged type has an empty list of primitive operations. 2014-11-07 Hristian Kirtchev <kirtchev@adacore.com> * sem_ch3.adb (Analyze_Object_Declaration): Update references to SPARK RM. (Process_Full_View): Update references to SPARK RM. * sem_ch6.adb (Analyze_Generic_Subprogram_Body): Update references to SPARK RM. (Analyze_Subprogram_Body_Helper): Update references to SPARK RM. * sem_ch7.adb (Analyze_Package_Body_Helper): Update references to SPARK RM. * sem_prag.adb (Check_Ghost_Constituent): Update references to SPARK RM. * sem_res.adb (Check_Ghost_Policy): Update references to SPARK RM. (Resolve_Actuals): Ensure that the actual parameter of a Ghost subprogram whose formal is of mode IN OUT or OUT is Ghost. * sem_util.adb (Check_Ghost_Completion): Update references to SPARK RM. 2014-11-07 Ed Schonberg <schonberg@adacore.com> * exp_ch7.adb (Make_Final_Call): If type of designated object is derived from that of the formal of the Deep_Finalize procedure, add an unchecked conversion to prevent spurious type error. 2014-11-07 Robert Dewar <dewar@adacore.com> * table.adb, inline.adb, einfo.adb, gnat1drv.adb, exp_ch13.adb, exp_fixd.adb, prj-conf.adb, exp_strm.adb, a-cofove.adb, exp_ch3.ads: Minor reformatting. 2014-11-07 Robert Dewar <dewar@adacore.com> * sem_ch12.adb, sem_ch13.adb, prj-tree.adb: Minor reformatting. From-SVN: r217227
This commit is contained in:
Arnaud Charlet
parent
1027438651
commit
3c756b7632
@ -1,3 +1,54 @@
|
||||
2014-11-07 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* debug.adb, snames.adb-tmpl (Is_Keyword_Name): Consider 'overriding'
|
||||
a keyword in Ada 95 mode when -gnatd.D is used.
|
||||
* gnat_ugn.texi: Document -gnatd.D.
|
||||
|
||||
2014-11-07 Vasiliy Fofanov <fofanov@adacore.com>
|
||||
|
||||
* gnatls.adb: Lower severity of the program's return value in
|
||||
some common cases.
|
||||
|
||||
2014-11-07 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch10.adb (Decorate_Type): The limited view of a tagged
|
||||
type has an empty list of primitive operations.
|
||||
|
||||
2014-11-07 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Analyze_Object_Declaration): Update references to SPARK
|
||||
RM.
|
||||
(Process_Full_View): Update references to SPARK RM.
|
||||
* sem_ch6.adb (Analyze_Generic_Subprogram_Body): Update references
|
||||
to SPARK RM.
|
||||
(Analyze_Subprogram_Body_Helper): Update references
|
||||
to SPARK RM.
|
||||
* sem_ch7.adb (Analyze_Package_Body_Helper): Update references
|
||||
to SPARK RM.
|
||||
* sem_prag.adb (Check_Ghost_Constituent): Update references to
|
||||
SPARK RM.
|
||||
* sem_res.adb (Check_Ghost_Policy): Update references to SPARK RM.
|
||||
(Resolve_Actuals): Ensure that the actual parameter of a Ghost
|
||||
subprogram whose formal is of mode IN OUT or OUT is Ghost.
|
||||
* sem_util.adb (Check_Ghost_Completion): Update references to
|
||||
SPARK RM.
|
||||
|
||||
2014-11-07 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_ch7.adb (Make_Final_Call): If type of designated object is
|
||||
derived from that of the formal of the Deep_Finalize procedure,
|
||||
add an unchecked conversion to prevent spurious type error.
|
||||
|
||||
2014-11-07 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* table.adb, inline.adb, einfo.adb, gnat1drv.adb, exp_ch13.adb,
|
||||
exp_fixd.adb, prj-conf.adb, exp_strm.adb, a-cofove.adb, exp_ch3.ads:
|
||||
Minor reformatting.
|
||||
|
||||
2014-11-07 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch12.adb, sem_ch13.adb, prj-tree.adb: Minor reformatting.
|
||||
|
||||
2014-11-07 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* einfo.adb (Set_Is_Checked_Ghost_Entity,
|
||||
|
||||
@ -26,7 +26,8 @@
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Containers.Generic_Array_Sort;
|
||||
with Unchecked_Deallocation;
|
||||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
with System; use type System.Address;
|
||||
|
||||
package body Ada.Containers.Formal_Vectors is
|
||||
@ -41,7 +42,7 @@ package body Ada.Containers.Formal_Vectors is
|
||||
type Elements_Array_Ptr_Const is access constant Elements_Array;
|
||||
|
||||
procedure Free is
|
||||
new Unchecked_Deallocation (Elements_Array, Elements_Array_Ptr);
|
||||
new Ada.Unchecked_Deallocation (Elements_Array, Elements_Array_Ptr);
|
||||
|
||||
function Elems (Container : in out Vector) return Elements_Array_Ptr;
|
||||
function Elemsc
|
||||
|
||||
@ -121,7 +121,7 @@ package body Debug is
|
||||
-- d.A Read/write Aspect_Specifications hash table to tree
|
||||
-- d.B
|
||||
-- d.C Generate concatenation call, do not generate inline code
|
||||
-- d.D
|
||||
-- d.D Disable errors on use of overriding keyword in Ada 95 mode
|
||||
-- d.E Turn selected errors into warnings
|
||||
-- d.F Debug mode for GNATprove
|
||||
-- d.G Ignore calls through generic formal parameters for elaboration
|
||||
@ -602,6 +602,10 @@ package body Debug is
|
||||
-- d.C Generate call to System.Concat_n.Str_Concat_n routines in cases
|
||||
-- where we would normally generate inline concatenation code.
|
||||
|
||||
-- d.D For compatibility with some Ada 95 compilers implementing only
|
||||
-- one feature of Ada 2005 (overriding keyword), disable errors on use
|
||||
-- of overriding keyword in Ada 95 mode.
|
||||
|
||||
-- d.E Turn selected errors into warnings. This debug switch causes a
|
||||
-- specific set of error messages into warnings. Setting this switch
|
||||
-- causes Opt.Error_To_Warning to be set to True. The intention is
|
||||
|
||||
@ -566,9 +566,9 @@ package body Einfo is
|
||||
-- Has_Static_Predicate Flag269
|
||||
-- Stores_Attribute_Old_Prefix Flag270
|
||||
|
||||
-- (Has_Protected) Flag271
|
||||
-- (SSO_Set_Low_By_Default) Flag272
|
||||
-- (SSO_Set_High_By_Default) Flag273
|
||||
-- Has_Protected Flag271
|
||||
-- SSO_Set_Low_By_Default Flag272
|
||||
-- SSO_Set_High_By_Default Flag273
|
||||
-- Is_Generic_Actual_Subprogram Flag274
|
||||
-- No_Predicate_On_Actual Flag275
|
||||
-- No_Dynamic_Predicate_On_Actual Flag276
|
||||
|
||||
@ -418,7 +418,7 @@ package body Exp_Ch13 is
|
||||
Apply_Address_Clause_Check (E, N);
|
||||
end if;
|
||||
|
||||
-- Analyze actions in freeze node, if any.
|
||||
-- Analyze actions in freeze node, if any
|
||||
|
||||
if Present (Actions (N)) then
|
||||
declare
|
||||
|
||||
@ -107,10 +107,10 @@ package Exp_Ch3 is
|
||||
function Make_Tag_Assignment (N : Node_Id) return Node_Id;
|
||||
-- An object declaration that has an initialization for a tagged object
|
||||
-- requires a separate reassignment of the tag of the given type, because
|
||||
-- the expression may include an unchecked conversion. This tag
|
||||
-- assignment is inserted after the declaration, but if the object has
|
||||
-- an address clause the assignment is handled as part of the freezing
|
||||
-- of the object, see Check_Address_Clause.
|
||||
-- the expression may include an unchecked conversion. This tag assignment
|
||||
-- is inserted after the declaration, but if the object has an address
|
||||
-- clause the assignment is handled as part of the freezing of the object,
|
||||
-- see Check_Address_Clause.
|
||||
|
||||
function Needs_Simple_Initialization
|
||||
(T : Entity_Id;
|
||||
|
||||
@ -3662,6 +3662,15 @@ package body Exp_Ch7 is
|
||||
Set_Etype (Arg, Ftyp);
|
||||
return Arg;
|
||||
|
||||
-- Otherwise, introduce a conversion when the designated object
|
||||
-- has a type derived from the formal of the controlled routine.
|
||||
|
||||
elsif Is_Private_Type (Ftyp)
|
||||
and then Present (Atyp)
|
||||
and then Is_Derived_Type (Underlying_Type (Base_Type (Atyp)))
|
||||
then
|
||||
return Unchecked_Convert_To (Ftyp, Arg);
|
||||
|
||||
else
|
||||
return Arg;
|
||||
end if;
|
||||
@ -4769,11 +4778,14 @@ package body Exp_Ch7 is
|
||||
|
||||
-- Generate:
|
||||
-- [Deep_]Finalize (Obj_Ref);
|
||||
-- Set type of dereference, so that proper conversion are
|
||||
-- generated when operation is inherited.
|
||||
|
||||
Obj_Ref := New_Occurrence_Of (Obj_Id, Loc);
|
||||
|
||||
if Is_Access_Type (Obj_Typ) then
|
||||
Obj_Ref := Make_Explicit_Dereference (Loc, Obj_Ref);
|
||||
Set_Etype (Obj_Ref, Directly_Designated_Type (Obj_Typ));
|
||||
end if;
|
||||
|
||||
Append_To (Stmts,
|
||||
|
||||
@ -1129,8 +1129,7 @@ package body Exp_Strm is
|
||||
-- to construct.
|
||||
|
||||
if Has_Discriminants (Typ)
|
||||
and then
|
||||
No (Discriminant_Default_Value (First_Discriminant (Typ)))
|
||||
and then No (Discriminant_Default_Value (First_Discriminant (Typ)))
|
||||
and then not Is_Constrained (Underlying_Type (B_Typ))
|
||||
then
|
||||
Discr := First_Discriminant (B_Typ);
|
||||
@ -1148,7 +1147,7 @@ package body Exp_Strm is
|
||||
Decl :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Make_Defining_Identifier (Loc, Cn),
|
||||
Object_Definition =>
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Etype (Discr), Loc));
|
||||
|
||||
-- If this is an access discriminant, do not perform default
|
||||
@ -1163,9 +1162,9 @@ package body Exp_Strm is
|
||||
Append_To (Decls, Decl);
|
||||
Append_To (Decls,
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix => New_Occurrence_Of (Etype (Discr), Loc),
|
||||
Prefix => New_Occurrence_Of (Etype (Discr), Loc),
|
||||
Attribute_Name => Name_Read,
|
||||
Expressions => New_List (
|
||||
Expressions => New_List (
|
||||
Make_Identifier (Loc, Name_S),
|
||||
Make_Identifier (Loc, Cn))));
|
||||
|
||||
@ -1195,7 +1194,7 @@ package body Exp_Strm is
|
||||
Odef :=
|
||||
Make_Subtype_Indication (Loc,
|
||||
Subtype_Mark => New_Occurrence_Of (B_Typ, Loc),
|
||||
Constraint =>
|
||||
Constraint =>
|
||||
Make_Index_Or_Discriminant_Constraint (Loc,
|
||||
Constraints => Constr));
|
||||
|
||||
@ -1264,11 +1263,9 @@ package body Exp_Strm is
|
||||
-- because those are written by 'Write.
|
||||
|
||||
if Has_Discriminants (Typ)
|
||||
and then
|
||||
No (Discriminant_Default_Value (First_Discriminant (Typ)))
|
||||
and then No (Discriminant_Default_Value (First_Discriminant (Typ)))
|
||||
then
|
||||
Disc := First_Discriminant (Typ);
|
||||
|
||||
while Present (Disc) loop
|
||||
|
||||
-- If the type is an unchecked union, it must have default
|
||||
@ -1287,10 +1284,10 @@ package body Exp_Strm is
|
||||
|
||||
Append_To (Stms,
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
Prefix =>
|
||||
New_Occurrence_Of (Stream_Base_Type (Etype (Disc)), Loc),
|
||||
Attribute_Name => Name_Write,
|
||||
Expressions => New_List (
|
||||
Expressions => New_List (
|
||||
Make_Identifier (Loc, Name_S),
|
||||
Disc_Ref)));
|
||||
|
||||
@ -1300,9 +1297,9 @@ package body Exp_Strm is
|
||||
|
||||
Append_To (Stms,
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix => New_Occurrence_Of (Typ, Loc),
|
||||
Prefix => New_Occurrence_Of (Typ, Loc),
|
||||
Attribute_Name => Name_Write,
|
||||
Expressions => New_List (
|
||||
Expressions => New_List (
|
||||
Make_Identifier (Loc, Name_S),
|
||||
Make_Identifier (Loc, Name_V))));
|
||||
|
||||
@ -1448,7 +1445,7 @@ package body Exp_Strm is
|
||||
|
||||
Append_To (Result,
|
||||
Make_Case_Statement (Loc,
|
||||
Expression => D_Ref,
|
||||
Expression => D_Ref,
|
||||
Alternatives => Alts));
|
||||
end if;
|
||||
|
||||
@ -1485,10 +1482,9 @@ package body Exp_Strm is
|
||||
|
||||
return
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
New_Occurrence_Of (Field_Typ, Loc),
|
||||
Prefix => New_Occurrence_Of (Field_Typ, Loc),
|
||||
Attribute_Name => Nam,
|
||||
Expressions => New_List (
|
||||
Expressions => New_List (
|
||||
Make_Identifier (Loc, Name_S),
|
||||
Make_Selected_Component (Loc,
|
||||
Prefix => Make_Identifier (Loc, Name_V),
|
||||
@ -1654,18 +1650,19 @@ package body Exp_Strm is
|
||||
Parameter_Specifications => New_List (
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => Make_Defining_Identifier (Loc, Name_S),
|
||||
Parameter_Type =>
|
||||
Parameter_Type =>
|
||||
Make_Access_Definition (Loc,
|
||||
Null_Exclusion_Present => True,
|
||||
Subtype_Mark => New_Occurrence_Of (
|
||||
Class_Wide_Type (RTE (RE_Root_Stream_Type)), Loc)))),
|
||||
Subtype_Mark =>
|
||||
New_Occurrence_Of
|
||||
(Class_Wide_Type (RTE (RE_Root_Stream_Type)), Loc)))),
|
||||
|
||||
Result_Definition => New_Occurrence_Of (Typ, Loc));
|
||||
|
||||
Decl :=
|
||||
Make_Subprogram_Body (Loc,
|
||||
Specification => Spec,
|
||||
Declarations => Decls,
|
||||
Specification => Spec,
|
||||
Declarations => Decls,
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => Stms));
|
||||
@ -1698,11 +1695,12 @@ package body Exp_Strm is
|
||||
Parameter_Specifications => New_List (
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => Make_Defining_Identifier (Loc, Name_S),
|
||||
Parameter_Type =>
|
||||
Parameter_Type =>
|
||||
Make_Access_Definition (Loc,
|
||||
Null_Exclusion_Present => True,
|
||||
Subtype_Mark => New_Occurrence_Of (
|
||||
Class_Wide_Type (RTE (RE_Root_Stream_Type)), Loc))),
|
||||
Subtype_Mark =>
|
||||
New_Occurrence_Of
|
||||
(Class_Wide_Type (RTE (RE_Root_Stream_Type)), Loc))),
|
||||
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
|
||||
@ -1711,8 +1709,8 @@ package body Exp_Strm is
|
||||
|
||||
Decl :=
|
||||
Make_Subprogram_Body (Loc,
|
||||
Specification => Spec,
|
||||
Declarations => Empty_List,
|
||||
Specification => Spec,
|
||||
Declarations => Empty_List,
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => Stms));
|
||||
|
||||
@ -364,8 +364,7 @@ procedure Gnat1drv is
|
||||
-- SPARK version of the expander.
|
||||
|
||||
-- On the contrary, we need to enable explicitly all language checks,
|
||||
-- as they may have been marked as suppressed by the use of switch
|
||||
-- -gnatp
|
||||
-- as they may have been suppressed by the use of switch -gnatp.
|
||||
|
||||
Suppress_Options.Suppress := (others => False);
|
||||
|
||||
|
||||
@ -3588,6 +3588,13 @@ Enforce Ada 83 restrictions.
|
||||
@cindex @option{-gnat95} (@command{gcc})
|
||||
Enforce Ada 95 restrictions.
|
||||
|
||||
Note: for compatibility with some Ada 95 compilers which support only
|
||||
the @code{overriding} keyword of Ada 2005, the @option{-gnatd.D} switch can
|
||||
be used along with @option{-gnat95} to achieve a similar effect with GNAT.
|
||||
|
||||
@option{-gnatd.D} instructs GNAT to consider @code{overriding} as a keyword
|
||||
and handle its associated semantic checks, even in Ada 95 mode.
|
||||
|
||||
@item -gnat05
|
||||
@cindex @option{-gnat05} (@command{gcc})
|
||||
Allow full Ada 2005 features.
|
||||
|
||||
@ -1663,6 +1663,7 @@ begin
|
||||
("Default runtime not available. Use --RTS= with a valid runtime");
|
||||
Write_Eol;
|
||||
Write_Eol;
|
||||
Exit_Status := E_Warnings;
|
||||
end if;
|
||||
|
||||
Write_Str ("Source Search Path:");
|
||||
@ -1775,10 +1776,11 @@ begin
|
||||
Usage;
|
||||
else
|
||||
Try_Help;
|
||||
Exit_Status := E_Fatal;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Exit_Program (E_Fatal);
|
||||
Exit_Program (Exit_Status);
|
||||
end if;
|
||||
|
||||
Initialize_ALI;
|
||||
|
||||
@ -496,6 +496,7 @@ package body Inline is
|
||||
end if;
|
||||
|
||||
Last_Inlined := E;
|
||||
|
||||
else
|
||||
Register_Backend_Not_Inlined_Subprogram (E);
|
||||
end if;
|
||||
@ -3323,6 +3324,7 @@ package body Inline is
|
||||
|
||||
D := First (Decls);
|
||||
while Present (D) loop
|
||||
|
||||
-- First declarations universally excluded
|
||||
|
||||
if Nkind (D) = N_Package_Declaration then
|
||||
|
||||
@ -1105,17 +1105,17 @@ package body Prj.Conf is
|
||||
|
||||
if Selected_Target /= null and then
|
||||
Selected_Target.all /= ""
|
||||
|
||||
then
|
||||
Args (4) :=
|
||||
new String'("--target=" & Selected_Target.all);
|
||||
Arg_Last := 4;
|
||||
|
||||
elsif Normalized_Hostname /= "" then
|
||||
if At_Least_One_Compiler_Command then
|
||||
Args (4) :=
|
||||
new String'("--target=all");
|
||||
Args (4) := new String'("--target=all");
|
||||
else
|
||||
Args (4) :=
|
||||
new String'("--target=" & Normalized_Hostname);
|
||||
Args (4) := new String'("--target=" & Normalized_Hostname);
|
||||
end if;
|
||||
|
||||
Arg_Last := 4;
|
||||
@ -1599,7 +1599,7 @@ package body Prj.Conf is
|
||||
Implicit_Project : Boolean := False;
|
||||
On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null)
|
||||
is
|
||||
Success : Boolean := False;
|
||||
Success : Boolean := False;
|
||||
Target_Try_Again : Boolean := True;
|
||||
Config_Try_Again : Boolean;
|
||||
|
||||
@ -1632,12 +1632,13 @@ package body Prj.Conf is
|
||||
|
||||
Update_Ignore_Missing_With (Env.Flags, True);
|
||||
|
||||
Automatically_Generated := False;
|
||||
-- If in fact the config file is automatically generated,
|
||||
-- Note: If in fact the config file is automatically generated, then
|
||||
-- Automatically_Generated will be set to True after invocation of
|
||||
-- Process_Project_And_Apply_Config.
|
||||
|
||||
-- Record Target_Value and Target_Origin.
|
||||
Automatically_Generated := False;
|
||||
|
||||
-- Record Target_Value and Target_Origin
|
||||
|
||||
if Target_Name = "" then
|
||||
Opt.Target_Value := new String'(Normalized_Hostname);
|
||||
@ -2165,11 +2166,11 @@ package body Prj.Conf is
|
||||
Tree : Project_Tree_Ref;
|
||||
With_State : in out State)
|
||||
is
|
||||
Lang_Id : Language_Ptr;
|
||||
Lang_Id : Language_Ptr;
|
||||
Compiler_Root : Compiler_Root_Ptr;
|
||||
Runtime_Root : Runtime_Root_Ptr;
|
||||
Comp_Driver : String_Access;
|
||||
Comp_Dir : String_Access;
|
||||
Runtime_Root : Runtime_Root_Ptr;
|
||||
Comp_Driver : String_Access;
|
||||
Comp_Dir : String_Access;
|
||||
Prefix : String_Access;
|
||||
|
||||
pragma Unreferenced (Tree);
|
||||
@ -2226,8 +2227,9 @@ package body Prj.Conf is
|
||||
|
||||
declare
|
||||
Runtime : constant String :=
|
||||
Runtime_Name_For (Lang_Id.Name);
|
||||
Root : String_Access;
|
||||
Runtime_Name_For (Lang_Id.Name);
|
||||
Root : String_Access;
|
||||
|
||||
begin
|
||||
if Runtime'Length > 0 then
|
||||
if Is_Absolute_Path (Runtime) then
|
||||
|
||||
@ -2458,8 +2458,7 @@ package body Prj.Tree is
|
||||
begin
|
||||
pragma Assert
|
||||
(Present (Node)
|
||||
and then
|
||||
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
|
||||
and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
|
||||
In_Tree.Project_Nodes.Table (Node).Display_Name := To;
|
||||
end Set_Display_Name_Of;
|
||||
|
||||
|
||||
@ -5615,10 +5615,12 @@ package body Sem_Ch10 is
|
||||
Init_Size_Align (Ent);
|
||||
|
||||
-- A tagged type and its corresponding shadow entity share one common
|
||||
-- class-wide type.
|
||||
-- class-wide type. The list of primitive operations for the shadow
|
||||
-- entity is empty.
|
||||
|
||||
if Is_Tagged then
|
||||
Set_Is_Tagged_Type (Ent);
|
||||
Set_Direct_Primitive_Operations (Ent, New_Elmt_List);
|
||||
|
||||
if No (Class_Wide_Type (Ent)) then
|
||||
CW_Typ :=
|
||||
|
||||
@ -3454,9 +3454,10 @@ package body Sem_Ch12 is
|
||||
ASN : Node_Id;
|
||||
|
||||
begin
|
||||
ASN := Make_Aspect_Specification (Loc,
|
||||
Identifier => Make_Identifier (Loc, Name_Default_Storage_Pool),
|
||||
Expression => New_Copy (Default_Pool));
|
||||
ASN :=
|
||||
Make_Aspect_Specification (Loc,
|
||||
Identifier => Make_Identifier (Loc, Name_Default_Storage_Pool),
|
||||
Expression => New_Copy (Default_Pool));
|
||||
|
||||
if No (Aspect_Specifications (Specification (N))) then
|
||||
Set_Aspect_Specifications (Specification (N), New_List (ASN));
|
||||
@ -3972,8 +3973,8 @@ package body Sem_Ch12 is
|
||||
|
||||
ASN2 := First (Aspect_Specifications (Gen_Spec));
|
||||
while Present (ASN2) loop
|
||||
if Chars (Identifier (ASN2))
|
||||
= Name_Default_Storage_Pool
|
||||
if Chars (Identifier (ASN2)) =
|
||||
Name_Default_Storage_Pool
|
||||
then
|
||||
Remove (ASN2);
|
||||
exit;
|
||||
|
||||
@ -9234,10 +9234,10 @@ package body Sem_Ch13 is
|
||||
|
||||
begin
|
||||
-- If rep_clauses are to be ignored, no need for legality checks. In
|
||||
-- particular, no need to pester user about rep clauses that violate
|
||||
-- the rule on constant addresses, given that these clauses will be
|
||||
-- removed by Freeze before they reach the back end.
|
||||
-- Similarly in CodePeer mode, we want to relax these checks.
|
||||
-- particular, no need to pester user about rep clauses that violate the
|
||||
-- rule on constant addresses, given that these clauses will be removed
|
||||
-- by Freeze before they reach the back end. Similarly in CodePeer mode,
|
||||
-- we want to relax these checks.
|
||||
|
||||
if not Ignore_Rep_Clauses and not CodePeer_Mode then
|
||||
Check_Expr_Constants (Expr);
|
||||
|
||||
@ -3925,7 +3925,7 @@ package body Sem_Ch3 is
|
||||
|
||||
-- The Ghost policy in effect at the point of declaration
|
||||
-- and at the point of completion must match
|
||||
-- (SPARK RM 6.9(14)).
|
||||
-- (SPARK RM 6.9(15)).
|
||||
|
||||
if Present (Prev_Entity)
|
||||
and then Is_Ghost_Entity (Prev_Entity)
|
||||
@ -4112,7 +4112,7 @@ package body Sem_Ch3 is
|
||||
Set_Is_Ghost_Entity (Id);
|
||||
|
||||
-- The Ghost policy in effect at the point of declaration and at the
|
||||
-- point of completion must match (SPARK RM 6.9(14)).
|
||||
-- point of completion must match (SPARK RM 6.9(16)).
|
||||
|
||||
if Present (Prev_Entity) and then Is_Ghost_Entity (Prev_Entity) then
|
||||
Check_Ghost_Completion (Prev_Entity, Id);
|
||||
@ -19786,7 +19786,7 @@ package body Sem_Ch3 is
|
||||
Set_Is_Ghost_Entity (Full_T);
|
||||
|
||||
-- The Ghost policy in effect at the point of declaration and at the
|
||||
-- point of completion must match (SPARK RM 6.9(14)).
|
||||
-- point of completion must match (SPARK RM 6.9(15)).
|
||||
|
||||
Check_Ghost_Completion (Priv_T, Full_T);
|
||||
|
||||
|
||||
@ -1220,7 +1220,7 @@ package body Sem_Ch6 is
|
||||
Set_Is_Ghost_Entity (Body_Id);
|
||||
|
||||
-- The Ghost policy in effect at the point of declaration and at
|
||||
-- the point of completion must match (SPARK RM 6.9(14)).
|
||||
-- the point of completion must match (SPARK RM 6.9(15)).
|
||||
|
||||
Check_Ghost_Completion (Gen_Id, Body_Id);
|
||||
end if;
|
||||
@ -3343,7 +3343,7 @@ package body Sem_Ch6 is
|
||||
Set_Is_Ghost_Entity (Body_Id);
|
||||
|
||||
-- The Ghost policy in effect at the point of declaration and
|
||||
-- at the point of completion must match (SPARK RM 6.9(14)).
|
||||
-- at the point of completion must match (SPARK RM 6.9(15)).
|
||||
|
||||
Check_Ghost_Completion (Spec_Id, Body_Id);
|
||||
end if;
|
||||
|
||||
@ -735,7 +735,7 @@ package body Sem_Ch7 is
|
||||
Set_Is_Ghost_Entity (Body_Id);
|
||||
|
||||
-- The Ghost policy in effect at the point of declaration and at the
|
||||
-- point of completion must match (SPARK RM 6.9(14)).
|
||||
-- point of completion must match (SPARK RM 6.9(15)).
|
||||
|
||||
Check_Ghost_Completion (Spec_Id, Body_Id);
|
||||
end if;
|
||||
|
||||
@ -23473,7 +23473,7 @@ package body Sem_Prag is
|
||||
|
||||
-- The Ghost policy in effect at the point of abstract
|
||||
-- state declaration and constituent must match
|
||||
-- (SPARK RM 6.9(15)).
|
||||
-- (SPARK RM 6.9(16)).
|
||||
|
||||
if Is_Checked_Ghost_Entity (State_Id)
|
||||
and then Is_Ignored_Ghost_Entity (Constit_Id)
|
||||
|
||||
@ -841,7 +841,7 @@ package body Sem_Res is
|
||||
|
||||
begin
|
||||
-- The Ghost policy in effect a the point of declaration and at the
|
||||
-- point of use must match (SPARK RM 6.9(13)).
|
||||
-- point of use must match (SPARK RM 6.9(14)).
|
||||
|
||||
if Is_Checked_Ghost_Entity (Id) and then Policy = Name_Ignore then
|
||||
Error_Msg_Sloc := Sloc (Err_N);
|
||||
@ -4625,6 +4625,26 @@ package body Sem_Res is
|
||||
("\subprogram & has Extensions_Visible True", A, Nam);
|
||||
end if;
|
||||
|
||||
-- The actual parameter of a Ghost subprogram whose formal is of
|
||||
-- mode IN OUT or OUT must be a Ghost variable (SPARK RM 6.9(13)).
|
||||
|
||||
if Is_Ghost_Entity (Nam)
|
||||
and then Ekind_In (F, E_In_Out_Parameter, E_Out_Parameter)
|
||||
and then Is_Entity_Name (A)
|
||||
and then Present (Entity (A))
|
||||
and then not Is_Ghost_Entity (Entity (A))
|
||||
then
|
||||
Error_Msg_NE
|
||||
("non-ghost variable & cannot appear as actual in call to "
|
||||
& "ghost procedure", A, Entity (A));
|
||||
|
||||
if Ekind (F) = E_In_Out_Parameter then
|
||||
Error_Msg_N ("\corresponding formal has mode `IN OUT`", A);
|
||||
else
|
||||
Error_Msg_N ("\corresponding formal has mode OUT", A);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next_Actual (A);
|
||||
|
||||
-- Case where actual is not present
|
||||
|
||||
@ -2681,7 +2681,7 @@ package body Sem_Util is
|
||||
|
||||
begin
|
||||
-- The Ghost policy in effect at the point of declaration and at the
|
||||
-- point of completion must match (SPARK RM 6.9(14)).
|
||||
-- point of completion must match (SPARK RM 6.9(15)).
|
||||
|
||||
if Is_Checked_Ghost_Entity (Partial_View)
|
||||
and then Policy = Name_Ignore
|
||||
|
||||
@ -29,6 +29,7 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Debug; use Debug;
|
||||
with Opt; use Opt;
|
||||
with Table;
|
||||
with Types; use Types;
|
||||
@ -395,7 +396,11 @@ package body Snames is
|
||||
and then (Ada_Version >= Ada_95
|
||||
or else N not in Ada_95_Reserved_Words)
|
||||
and then (Ada_Version >= Ada_2005
|
||||
or else N not in Ada_2005_Reserved_Words)
|
||||
or else N not in Ada_2005_Reserved_Words
|
||||
or else (Debug_Flag_Dot_DD and then N = Name_Overriding))
|
||||
-- Accept 'overriding' keywords if -gnatd.D is used,
|
||||
-- for compatibility with Ada 95 compilers implementing
|
||||
-- only this Ada 2005 extension.
|
||||
and then (Ada_Version >= Ada_2012
|
||||
or else N not in Ada_2012_Reserved_Words);
|
||||
end Is_Keyword_Name;
|
||||
|
||||
@ -399,6 +399,10 @@ package body Table is
|
||||
Tree_Read_Data
|
||||
(Tree_Get_Table_Address,
|
||||
(Last_Val - Int (First) + 1) *
|
||||
|
||||
-- Note the importance of parenthesizing the following division
|
||||
-- to avoid the possibility of intermediate overflow.
|
||||
|
||||
(Table_Type'Component_Size / Storage_Unit));
|
||||
end Tree_Read;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user