-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2004 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- --
-- from another unit. This is true for entities in packages that are
-- at the library level.
- -----------------------
- -- Missing_Subunits --
- -----------------------
+ ----------------------
+ -- Missing_Subunits --
+ ----------------------
function Missing_Subunits return Boolean is
D : Node_Id;
E1 := First_Entity (E);
while Present (E1) loop
- -- We only look at source entities with warning flag off
+ -- We only look at source entities with warning flag on
if Comes_From_Source (E1) and then not Warnings_Off (E1) then
-- do not consider the implicit initialization of an access
-- type to be the assignment of a value for this purpose.
+ if Ekind (E1) = E_Out_Parameter
+ and then Present (Spec_Entity (E1))
+ then
+ UR := Unset_Reference (Spec_Entity (E1));
+ else
+ UR := Unset_Reference (E1);
+ end if;
+
-- If the entity is an out parameter of the current subprogram
-- body, check the warning status of the parameter in the spec.
then
null;
+ elsif Present (UR)
+ and then Is_Access_Type (Etype (E1))
+ then
+
+ -- For access types, the only time we made a UR
+ -- entry was for a dereference, and so we post
+ -- the appropriate warning here (note that the
+ -- dereference may not be explicit in the source,
+ -- for example in the case of a dispatching call
+ -- with an anonymous access controlling formal, or
+ -- of an assignment of a pointer involving a
+ -- discriminant check on the designated object).
+
+ Error_Msg_NE ("& may be null?", UR, E1);
+ goto Continue;
+
elsif Never_Set_In_Source (E1)
and then not Generic_Package_Spec_Entity (E1)
then
-- types from this check, since access types do always have
-- a null value, and that seems legitimate in this case.
- if Ekind (E1) = E_Out_Parameter
- and then Present (Spec_Entity (E1))
- then
- UR := Unset_Reference (Spec_Entity (E1));
- else
- UR := Unset_Reference (E1);
- end if;
-
if Warn_On_No_Value_Assigned and then Present (UR) then
- -- For access types, the only time we made a UR entry
- -- was for a dereference, and so we post the appropriate
- -- warning here. The issue is not that the value is not
- -- initialized here, but that it is null.
-
- if Is_Access_Type (Etype (E1)) then
- Error_Msg_NE ("& may be null?", UR, E1);
- goto Continue;
-
-- For other than access type, go back to original node
-- to deal with case where original unset reference
-- has been rewritten during expansion.
- else
- UR := Original_Node (UR);
+ UR := Original_Node (UR);
- -- In some cases, the original node may be a type
- -- conversion or qualification, and in this case
- -- we want the object entity inside.
+ -- In some cases, the original node may be a type
+ -- conversion or qualification, and in this case
+ -- we want the object entity inside.
- while Nkind (UR) = N_Type_Conversion
- or else Nkind (UR) = N_Qualified_Expression
- loop
- UR := Expression (UR);
- end loop;
+ while Nkind (UR) = N_Type_Conversion
+ or else Nkind (UR) = N_Qualified_Expression
+ loop
+ UR := Expression (UR);
+ end loop;
- -- Here we issue the warning, all checks completed
+ -- Here we issue the warning, all checks completed
+ -- If the unset reference is prefix of a selected
+ -- component that comes from source, mention the
+ -- component as well. If the selected component comes
+ -- from expansion, all we know is that the entity is
+ -- not fully initialized at the point of the reference.
+ -- Locate an unintialized component to get a better
+ -- error message.
- if Nkind (Parent (UR)) = N_Selected_Component then
- Error_Msg_Node_2 := Selector_Name (Parent (UR));
- Error_Msg_N
- ("`&.&` may be referenced before it has a value?",
- UR);
- else
- Error_Msg_N
- ("& may be referenced before it has a value?",
- UR);
+ if Nkind (Parent (UR)) = N_Selected_Component then
+ Error_Msg_Node_2 := Selector_Name (Parent (UR));
+
+ if not Comes_From_Source (Parent (UR)) then
+ declare
+ Comp : Entity_Id;
+
+ begin
+ Comp := First_Entity (Etype (E1));
+ while Present (Comp) loop
+ if Ekind (Comp) = E_Component
+ and then Nkind (Parent (Comp)) =
+ N_Component_Declaration
+ and then No (Expression (Parent (Comp)))
+ then
+ Error_Msg_Node_2 := Comp;
+ exit;
+ end if;
+
+ Next_Entity (Comp);
+ end loop;
+ end;
end if;
- goto Continue;
+ Error_Msg_N
+ ("`&.&` may be referenced before it has a value?",
+ UR);
+ else
+ Error_Msg_N
+ ("& may be referenced before it has a value?",
+ UR);
end if;
+
+ goto Continue;
end if;
end if;
then
if Warn_On_Modified_Unread
and then not Is_Imported (E)
+
+ -- Suppress the message for aliased, renamed
+ -- and access variables since there may be
+ -- other entities that read the memory location.
+
+ and then not Is_Aliased (E)
+ and then No (Renamed_Object (E))
+ and then not (Is_Access_Type (Etype (E))
+ or else
+
+ -- Case of private access type, must examine the
+ -- full view due to visibility issues.
+
+ (Is_Private_Type (Etype (E))
+ and then
+ Is_Access_Type
+ (Full_View (Etype (E)))))
then
Error_Msg_N
("variable & is assigned but never read?", E);
OSDN Git Service
