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

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:
Ed Schonberg 2004-10-04 16:56:27 +02:00 committed by Arnaud Charlet
parent 8005f3e521
commit 1c6c6771b6
4 changed files with 107 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -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.

68
gcc/ada/exp_attr.adb
View File

@ -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;
-------------------

18
gcc/ada/sem_ch13.adb
View File

@ -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

19
gcc/ada/sem_util.adb
View File

@ -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;