diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 16 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 68 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 19 |
4 files changed, 107 insertions, 14 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0931a5c..fbd3a89 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index f87d503..1ba1e03 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -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; ------------------- diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9b8518d..a3fadf2 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 762be69..af36937 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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; |