Commit 9b0986f8 by Robert Dewar Committed by Arnaud Charlet

sem_util.ads, [...] (Enter_Name): Exclude -gnatwh warning messages for entities…

sem_util.ads, [...] (Enter_Name): Exclude -gnatwh warning messages for entities in packages which are not used.

2006-10-31  Robert Dewar  <dewar@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
        
        * sem_util.ads, sem_util.adb (Enter_Name): Exclude -gnatwh warning
	messages for entities in packages which are not used.
	(Collect_Synchronized_Interfaces): New procedure.
	(Overrides_Synchronized_Primitive): New function.
	(Denotes_Discriminant): Extend predicate to apply to task types.
	Add missing continuation marks in error msgs
	(Unqualify): New function for removing zero or more levels of
	qualification from an expression. There are numerous places where this
	ought to be used, but we currently only deal properly with zero or one
	level.
	(In_Instance); The analysis of the actuals in the instantiation of a
	child unit is not within an instantiation, even though the parent
	instance is on the scope stack.
	(Safe_To_Capture_Value): Exclude the case of variables that are
	renamings.
	(Check_Obsolescent): Removed
	(Is_Aliased_View): A reference to an enclosing instance in an aggregate
	is an aliased view, even when rewritten as a reference to the target
	object in an assignment.
	(Get_Subprogram_Entity): New function
	(Known_To_Be_Assigned): New function
	(Type_Access_Level): Compute properly the access level of a return
	subtype that is an anonymous access type.
	(Explain_Limited_Type): Correct use of "\" for continuation messages.
	(Is_Transfer): The new extended_return_statement causes a transfer of
	control.
	(Has_Preelaborable_Initialization): New function
	(Has_Null_Exclusion): New function. Given a node N, determine whether it
	has a null exclusion depending on its Nkind.
	Change Is_Lvalue to May_Be_Lvalue
	(May_Be_Lvalue): Extensive additional code to deal with subprogram
	arguments (IN parameters are not Lvalues, IN OUT parameters are).
	(Safe_To_Capture_Value): Extend functionality so it can be used for
	the current value condition case.
	(Has_Compatible_Alignment): New function
	(Is_Dependent_Component_Of_Mutable_Object): Revise the tests for mutable
	objects to handle the Ada 2005 case, where aliasedness no longer implies
	that the object is constrained. In particular, for dereferenced names,
	the designated object must be assumed to be unconstrained.
	(Kill_Current_Values): Properly deal with the case where we encounter
	a loop in the scope chain.
	(Safe_To_Capture_Value): Do not let a loop stop us from capturing
	a value.
	(Compile_Time_Constraint_Error): Improve error message in error case

	* exp_ch13.adb (Expand_N_Freeze_Entity): Remove the freezing node
	associated with entities of abstract interface primitives.
	Call Apply_Address_Clause_Check instead of Apply_Alignment_Check

From-SVN: r118312
parent 60573ca2
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -81,15 +81,14 @@ package body Exp_Ch13 is ...@@ -81,15 +81,14 @@ package body Exp_Ch13 is
when Attribute_Address => when Attribute_Address =>
-- If there is an initialization which did not come from -- If there is an initialization which did not come from the
-- the source program, then it is an artifact of our -- source program, then it is an artifact of our expansion, and we
-- expansion, and we suppress it. The case we are most -- suppress it. The case we are most concerned about here is the
-- concerned about here is the initialization of a packed -- initialization of a packed array to all false, which seems
-- array to all false, which seems inappropriate for a -- inappropriate for variable to which an address clause is
-- variable to which an address clause is applied. The -- applied. The expression may itself have been rewritten if the
-- expression may itself have been rewritten if the type is a -- type is packed array, so we need to examine whether the
-- packed array, so we need to examine whether the original -- original node is in the source.
-- node is in the source.
declare declare
Decl : constant Node_Id := Declaration_Node (Ent); Decl : constant Node_Id := Declaration_Node (Ent);
...@@ -139,7 +138,6 @@ package body Exp_Ch13 is ...@@ -139,7 +138,6 @@ package body Exp_Ch13 is
-- assignment statement to initialze this value. -- assignment statement to initialze this value.
elsif Is_Access_Type (Ent) then elsif Is_Access_Type (Ent) then
V := Make_Defining_Identifier (Loc, V := Make_Defining_Identifier (Loc,
New_External_Name (Chars (Ent), 'V')); New_External_Name (Chars (Ent), 'V'));
...@@ -246,13 +244,14 @@ package body Exp_Ch13 is ...@@ -246,13 +244,14 @@ package body Exp_Ch13 is
Delete : Boolean := False; Delete : Boolean := False;
begin begin
-- For object, with address clause, check alignment is OK -- Processing for objects with address clauses
if Is_Object (E) then if Is_Object (E) and then Present (Address_Clause (E)) then
Apply_Alignment_Check (E, N); Apply_Address_Clause_Check (E, N);
return;
-- Only other items requiring any front end action are -- Only other items requiring any front end action are types and
-- types and subprograms. -- subprograms.
elsif not Is_Type (E) and then not Is_Subprogram (E) then elsif not Is_Type (E) and then not Is_Subprogram (E) then
return; return;
...@@ -268,12 +267,12 @@ package body Exp_Ch13 is ...@@ -268,12 +267,12 @@ package body Exp_Ch13 is
return; return;
end if; end if;
-- If we are freezing entities defined in protected types, they -- If we are freezing entities defined in protected types, they belong
-- belong in the enclosing scope, given that the original type -- in the enclosing scope, given that the original type has been
-- has been expanded away. The same is true for entities in task types, -- expanded away. The same is true for entities in task types, in
-- in particular the parameter records of entries (Entities in bodies -- particular the parameter records of entries (Entities in bodies are
-- are all frozen within the body). If we are in the task body, this -- all frozen within the body). If we are in the task body, this is a
-- is a proper scope. -- proper scope.
if Ekind (E_Scope) = E_Protected_Type if Ekind (E_Scope) = E_Protected_Type
or else (Ekind (E_Scope) = E_Task_Type or else (Ekind (E_Scope) = E_Task_Type
...@@ -349,19 +348,26 @@ package body Exp_Ch13 is ...@@ -349,19 +348,26 @@ package body Exp_Ch13 is
elsif Is_Subprogram (E) then elsif Is_Subprogram (E) then
Freeze_Subprogram (N); Freeze_Subprogram (N);
-- Ada 2005 (AI-251): Remove the freezing node associated with the
-- entities internally used by the frontend to register primitives
-- covering abstract interfaces. The call to Freeze_Subprogram has
-- already expanded the code that fills the corresponding entry in
-- its secondary dispatch table and therefore the code generator
-- has nothing else to do with this freezing node.
Delete := Present (Abstract_Interface_Alias (E));
end if; end if;
-- Analyze actions generated by freezing. The init_proc contains -- Analyze actions generated by freezing. The init_proc contains source
-- source expressions that may raise constraint_error, and the -- expressions that may raise Constraint_Error, and the assignment
-- assignment procedure for complex types needs checks on individual -- procedure for complex types needs checks on individual component
-- component assignments, but all other freezing actions should be -- assignments, but all other freezing actions should be compiled with
-- compiled with all checks off. -- all checks off.
if Present (Actions (N)) then if Present (Actions (N)) then
Decl := First (Actions (N)); Decl := First (Actions (N));
while Present (Decl) loop while Present (Decl) loop
if Nkind (Decl) = N_Subprogram_Body if Nkind (Decl) = N_Subprogram_Body
and then (Is_Init_Proc (Defining_Entity (Decl)) and then (Is_Init_Proc (Defining_Entity (Decl))
or else or else
......
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