* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@88494
138bc75d-0d04-0410-961f-
82ee72b054a4
+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.
-- 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.
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;
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;
-------------------
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,
("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:
("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;
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
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
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);
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;
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;
projects / platform / upstream / linaro-gcc.git / commitdiff