sem_util.adb (Explain_Limited_Type): Ignore internal components when searching for a limited component to flag.
2004-10-04 Ed Schonberg <schonberg@gnat.com> * sem_util.adb (Explain_Limited_Type): Ignore internal components when searching for a limited component to flag. * exp_attr.adb (Freeze_Stream_Subprogram): Subsidiary procedure to expansion of Input, to account for the fact that the implicit call generated by the attribute reference must freeze the user-defined stream subprogram. This is only relevant to 'Input, because it can appear in an object declaration, prior to the body of the subprogram. * sem_ch13.adb (Rep_Item_Too_Late): Make the error non-serious, so that expansion can proceed and further errors uncovered. (Minor clean up): Fix cases of using | instead of \ for continuation messages. From-SVN: r88494
This commit is contained in:
parent
8005f3e521
commit
1c6c6771b6
@ -1,3 +1,19 @@
|
||||
2004-10-04 Ed Schonberg <schonberg@gnat.com>
|
||||
|
||||
* sem_util.adb (Explain_Limited_Type): Ignore internal components when
|
||||
searching for a limited component to flag.
|
||||
|
||||
* exp_attr.adb (Freeze_Stream_Subprogram): Subsidiary procedure to
|
||||
expansion of Input, to account for the fact that the implicit call
|
||||
generated by the attribute reference must freeze the user-defined
|
||||
stream subprogram. This is only relevant to 'Input, because it can
|
||||
appear in an object declaration, prior to the body of the subprogram.
|
||||
|
||||
* sem_ch13.adb (Rep_Item_Too_Late): Make the error non-serious, so that
|
||||
expansion can proceed and further errors uncovered.
|
||||
(Minor clean up): Fix cases of using | instead of \ for continuation
|
||||
messages.
|
||||
|
||||
2004-10-04 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
|
||||
|
||||
* cuintp.c, decl.c, utils2.c: Use gcc_assert and gcc_unreachable.
|
||||
|
@ -1737,6 +1737,44 @@ package body Exp_Attr is
|
||||
-- the dispatching (class-wide type) case, where it is a reference
|
||||
-- to the dummy object initialized to the right internal tag.
|
||||
|
||||
procedure Freeze_Stream_Subprogram (F : Entity_Id);
|
||||
-- The expansion of the attribute reference may generate a call to
|
||||
-- a user-defined stream subprogram that is frozen by the call. This
|
||||
-- can lead to access-before-elaboration problem if the reference
|
||||
-- appears in an object declaration and the subprogram body has not
|
||||
-- been seen. The freezing of the subprogram requires special code
|
||||
-- because it appears in an expanded context where expressions do
|
||||
-- not freeze their constituents.
|
||||
|
||||
------------------------------
|
||||
-- Freeze_Stream_Subprogram --
|
||||
------------------------------
|
||||
|
||||
procedure Freeze_Stream_Subprogram (F : Entity_Id) is
|
||||
Decl : constant Node_Id := Unit_Declaration_Node (F);
|
||||
Bod : Node_Id;
|
||||
|
||||
begin
|
||||
-- If this is user-defined subprogram, the corresponding
|
||||
-- stream function appears as a renaming-as-body, and the
|
||||
-- user subprogram must be retrieved by tree traversal.
|
||||
|
||||
if Present (Decl)
|
||||
and then Nkind (Decl) = N_Subprogram_Declaration
|
||||
and then Present (Corresponding_Body (Decl))
|
||||
then
|
||||
Bod := Corresponding_Body (Decl);
|
||||
|
||||
if Nkind (Unit_Declaration_Node (Bod)) =
|
||||
N_Subprogram_Renaming_Declaration
|
||||
then
|
||||
Set_Is_Frozen (Entity (Name (Unit_Declaration_Node (Bod))));
|
||||
end if;
|
||||
end if;
|
||||
end Freeze_Stream_Subprogram;
|
||||
|
||||
-- Start of processing for Input
|
||||
|
||||
begin
|
||||
-- If no underlying type, we have an error that will be diagnosed
|
||||
-- elsewhere, so here we just completely ignore the expansion.
|
||||
@ -1902,6 +1940,32 @@ package body Exp_Attr is
|
||||
Build_Record_Or_Elementary_Input_Function
|
||||
(Loc, Base_Type (U_Type), Decl, Fname);
|
||||
Insert_Action (N, Decl);
|
||||
|
||||
if Nkind (Parent (N)) = N_Object_Declaration
|
||||
and then Is_Record_Type (U_Type)
|
||||
then
|
||||
-- The stream function may contain calls to user-defined
|
||||
-- Read procedures for individual components.
|
||||
|
||||
declare
|
||||
Comp : Entity_Id;
|
||||
Func : Entity_Id;
|
||||
|
||||
begin
|
||||
Comp := First_Component (U_Type);
|
||||
while Present (Comp) loop
|
||||
Func :=
|
||||
Find_Stream_Subprogram
|
||||
(Etype (Comp), TSS_Stream_Read);
|
||||
|
||||
if Present (Func) then
|
||||
Freeze_Stream_Subprogram (Func);
|
||||
end if;
|
||||
|
||||
Next_Component (Comp);
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
@ -1918,6 +1982,10 @@ package body Exp_Attr is
|
||||
Set_Controlling_Argument (Call, Cntrl);
|
||||
Rewrite (N, Unchecked_Convert_To (P_Type, Call));
|
||||
Analyze_And_Resolve (N, P_Type);
|
||||
|
||||
if Nkind (Parent (N)) = N_Object_Declaration then
|
||||
Freeze_Stream_Subprogram (Fname);
|
||||
end if;
|
||||
end Input;
|
||||
|
||||
-------------------
|
||||
|
@ -207,7 +207,7 @@ package body Sem_Ch13 is
|
||||
Error_Msg_N
|
||||
("at clause is an obsolescent feature ('R'M 'J.7(2))?", N);
|
||||
Error_Msg_N
|
||||
("|use address attribute definition clause instead?", N);
|
||||
("\use address attribute definition clause instead?", N);
|
||||
end if;
|
||||
|
||||
Rewrite (N,
|
||||
@ -360,7 +360,7 @@ package body Sem_Ch13 is
|
||||
("attaching interrupt to task entry is an " &
|
||||
"obsolescent feature ('R'M 'J.7.1)?", N);
|
||||
Error_Msg_N
|
||||
("|use interrupt procedure instead?", N);
|
||||
("\use interrupt procedure instead?", N);
|
||||
end if;
|
||||
|
||||
-- Case of an address clause for a controlled object:
|
||||
@ -1192,7 +1192,7 @@ package body Sem_Ch13 is
|
||||
("storage size clause for task is an " &
|
||||
"obsolescent feature ('R'M 'J.9)?", N);
|
||||
Error_Msg_N
|
||||
("|use Storage_Size pragma instead?", N);
|
||||
("\use Storage_Size pragma instead?", N);
|
||||
end if;
|
||||
|
||||
FOnly := True;
|
||||
@ -1957,7 +1957,7 @@ package body Sem_Ch13 is
|
||||
Error_Msg_N
|
||||
("mod clause is an obsolescent feature ('R'M 'J.8)?", N);
|
||||
Error_Msg_N
|
||||
("|use alignment attribute definition clause instead?", N);
|
||||
("\use alignment attribute definition clause instead?", N);
|
||||
end if;
|
||||
|
||||
if Present (P) then
|
||||
@ -3478,11 +3478,17 @@ package body Sem_Ch13 is
|
||||
Parent_Type : Entity_Id;
|
||||
|
||||
procedure Too_Late;
|
||||
-- Output the too late message
|
||||
-- Output the too late message. Note that this is not considered a
|
||||
-- serious error, since the effect is simply that we ignore the
|
||||
-- representation clause in this case.
|
||||
|
||||
--------------
|
||||
-- Too_Late --
|
||||
--------------
|
||||
|
||||
procedure Too_Late is
|
||||
begin
|
||||
Error_Msg_N ("representation item appears too late!", N);
|
||||
Error_Msg_N ("|representation item appears too late!", N);
|
||||
end Too_Late;
|
||||
|
||||
-- Start of processing for Rep_Item_Too_Late
|
||||
|
@ -1933,7 +1933,9 @@ package body Sem_Util is
|
||||
|
||||
C := First_Component (T);
|
||||
while Present (C) loop
|
||||
if Is_Limited_Type (Etype (C)) then
|
||||
if Is_Limited_Type (Etype (C))
|
||||
and then Comes_From_Source (C)
|
||||
then
|
||||
Error_Msg_Node_2 := T;
|
||||
Error_Msg_NE ("\component& of type& has limited type", N, C);
|
||||
Explain_Limited_Type (Etype (C), N);
|
||||
@ -1943,9 +1945,8 @@ package body Sem_Util is
|
||||
Next_Component (C);
|
||||
end loop;
|
||||
|
||||
-- It's odd if the loop falls through, but this is only an extra
|
||||
-- error message, so we just let it go and ignore the situation.
|
||||
|
||||
-- The type may be declared explicitly limited, even if no component
|
||||
-- of it is limited, in which case we fall out of the loop.
|
||||
return;
|
||||
end if;
|
||||
end Explain_Limited_Type;
|
||||
@ -3772,14 +3773,16 @@ package body Sem_Util is
|
||||
while Present (Discr) loop
|
||||
if Nkind (Parent (Discr)) = N_Discriminant_Specification then
|
||||
Discr_Val := Expression (Parent (Discr));
|
||||
if not Is_OK_Static_Expression (Discr_Val) then
|
||||
return False;
|
||||
else
|
||||
|
||||
if Present (Discr_Val)
|
||||
and then Is_OK_Static_Expression (Discr_Val)
|
||||
then
|
||||
Append_To (Constraints,
|
||||
Make_Component_Association (Loc,
|
||||
Choices => New_List (New_Occurrence_Of (Discr, Loc)),
|
||||
Expression => New_Copy (Discr_Val)));
|
||||
|
||||
else
|
||||
return False;
|
||||
end if;
|
||||
else
|
||||
return False;
|
||||
|
Loading…
Reference in New Issue
Block a user