OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

freeze.adb (Freeze_Entity): Improve warnings on access types in pure units. 

2008-04-08  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Freeze_Entity): Improve warnings on access types in pure
	units.
	(Size_Known): Generic formal scalar types have known at compile
	time size, so remove check.
	Fix casing error in formal parameter name in call
	(Freeze_Subprogram): If the subprogram is a user-defined operator,
	recheck its overriding indication.

From-SVN: r134033
This commit is contained in:
Robert Dewar 2008-04-08 08:51:27 +02:00 committed by Arnaud Charlet
parent 9cf50493b2
commit c6a9797ed4
1 changed files with 75 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
gcc/ada/freeze.adb
View File

@ -617,17 +617,29 @@ package body Freeze is
if Size_Known_At_Compile_Time (T) then
return True;
-- Always True for scalar types. This is true even for generic formal
-- scalar types. We used to return False in the latter case, but the
-- size is known at compile time, even in the template, we just do
-- not know the exact size but that's not the point of this routine.
elsif Is_Scalar_Type (T)
or else Is_Task_Type (T)
then
return not Is_Generic_Type (T);
return True;
-- Array types
elsif Is_Array_Type (T) then
-- String literals always have known size, and we can set it
if Ekind (T) = E_String_Literal_Subtype then
Set_Small_Size (T, Component_Size (T)
* String_Literal_Length (T));
return True;
-- Unconstrained types never have known at compile time size
elsif not Is_Constrained (T) then
return False;
@ -637,6 +649,8 @@ package body Freeze is
elsif Error_Posted (T) then
return False;
-- Otherwise if component size unknown, then array size unknown
elsif not Size_Known (Component_Type (T)) then
return False;
end if;
@ -685,9 +699,13 @@ package body Freeze is
return True;
end;
-- Access types always have known at compile time sizes
elsif Is_Access_Type (T) then
return True;
-- For non-generic private types, go to underlying type if present
elsif Is_Private_Type (T)
and then not Is_Generic_Type (T)
and then Present (Underlying_Type (T))
@ -701,6 +719,8 @@ package body Freeze is
return Size_Known (Underlying_Type (T));
end if;
-- Record types
elsif Is_Record_Type (T) then
-- A class-wide type is never considered to have a known size
@ -906,6 +926,8 @@ package body Freeze is
return True;
end;
-- All other cases, size not known at compile time
else
return False;
end if;
@ -1100,8 +1122,8 @@ package body Freeze is
New_N :=
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
Object_definition => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (E));
Object_Definition => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (E));
Insert_Before (Parent (E), New_N);
Analyze (New_N);
@ -1298,7 +1320,7 @@ package body Freeze is
-- We also add finalization chains to access types whose designated
-- types are controlled. This is normally done when freezing the type,
-- but this misses recursive type definitions where the later members
-- of the recursion introduce controlled components (e.g. 5624-001).
-- of the recursion introduce controlled components.
-- Loop through entities
@ -3516,9 +3538,23 @@ package body Freeze is
if Is_Pure_Unit_Access_Type (E)
and then (Ada_Version < Ada_05
or else not No_Pool_Assigned (E))
or else not No_Pool_Assigned (E))
then
Error_Msg_N ("named access type not allowed in pure unit", E);
if Ada_Version >= Ada_05 then
Error_Msg_N
("\would be legal if Storage_Size of 0 given?", E);
elsif No_Pool_Assigned (E) then
Error_Msg_N
("\would be legal in Ada 2005?", E);
else
Error_Msg_N
("\would be legal in Ada 2005 if "
& "Storage_Size of 0 given?", E);
end if;
end if;
end if;
@ -3807,12 +3843,12 @@ package body Freeze is
-----------------------
procedure Freeze_Expression (N : Node_Id) is
In_Def_Exp : constant Boolean := In_Default_Expression;
Typ : Entity_Id;
Nam : Entity_Id;
Desig_Typ : Entity_Id;
P : Node_Id;
Parent_P : Node_Id;
In_Spec_Exp : constant Boolean := In_Spec_Expression;
Typ : Entity_Id;
Nam : Entity_Id;
Desig_Typ : Entity_Id;
P : Node_Id;
Parent_P : Node_Id;
Freeze_Outside : Boolean := False;
-- This flag is set true if the entity must be frozen outside the
@ -3883,7 +3919,7 @@ package body Freeze is
-- make sure that we actually have a real expression (if we have
-- a subtype indication, we can't test Is_Static_Expression!)
if In_Def_Exp
if In_Spec_Exp
and then Nkind (N) in N_Subexpr
and then not Is_Static_Expression (N)
then
@ -4015,7 +4051,7 @@ package body Freeze is
-- For either of these cases, we skip the freezing
if not In_Default_Expression
if not In_Spec_Expression
and then Nkind (N) = N_Identifier
and then (Present (Entity (N)))
then
@ -4202,11 +4238,11 @@ package body Freeze is
-- static type, and the freeze scope needs to be the outer scope, not
-- the scope of the subprogram with the default parameter.
-- For default expressions in generic units, the Move_Freeze_Nodes
-- mechanism (see sem_ch12.adb) takes care of placing them at the proper
-- place, after the generic unit.
-- For default expressions and other spec expressions in generic units,
-- the Move_Freeze_Nodes mechanism (see sem_ch12.adb) takes care of
-- placing them at the proper place, after the generic unit.
if (In_Def_Exp and not Inside_A_Generic)
if (In_Spec_Exp and not Inside_A_Generic)
or else Freeze_Outside
or else (Is_Type (Current_Scope)
and then (not Is_Concurrent_Type (Current_Scope)
@ -4254,15 +4290,15 @@ package body Freeze is
end if;
-- Now we have the right place to do the freezing. First, a special
-- adjustment, if we are in default expression analysis mode, these
-- freeze actions must not be thrown away (normally all inserted actions
-- are thrown away in this mode. However, the freeze actions are from
-- static expressions and one of the important reasons we are doing this
-- adjustment, if we are in spec-expression analysis mode, these freeze
-- actions must not be thrown away (normally all inserted actions are
-- thrown away in this mode. However, the freeze actions are from static
-- expressions and one of the important reasons we are doing this
-- special analysis is to get these freeze actions. Therefore we turn
-- off the In_Default_Expression mode to propagate these freeze actions.
-- off the In_Spec_Expression mode to propagate these freeze actions.
-- This also means they get properly analyzed and expanded.
In_Default_Expression := False;
In_Spec_Expression := False;
-- Freeze the designated type of an allocator (RM 13.14(13))
@ -4283,7 +4319,9 @@ package body Freeze is
Freeze_Before (P, Nam);
end if;
In_Default_Expression := In_Def_Exp;
-- Restore In_Spec_Expression flag
In_Spec_Expression := In_Spec_Exp;
end Freeze_Expression;
-----------------------------
@ -5080,6 +5118,19 @@ package body Freeze is
Error_Msg_N
("pragma Inline_Always not allowed for dispatching subprograms", E);
end if;
-- Because of the implicit representation of inherited predefined
-- operators in the front-end, the overriding status of the operation
-- may be affected when a full view of a type is analyzed, and this is
-- not captured by the analysis of the corresponding type declaration.
-- Therefore the correctness of a not-overriding indicator must be
-- rechecked when the subprogram is frozen.
if Nkind (E) = N_Defining_Operator_Symbol
and then not Error_Posted (Parent (E))
then
Check_Overriding_Indicator (E, Empty, Is_Primitive (E));
end if;
end Freeze_Subprogram;
----------------------