Index: checks.adb =================================================================== RCS file: /cvs/gcc/gcc/gcc/ada/checks.adb,v retrieving revision 1.36 diff -u -p -r1.36 checks.adb --- checks.adb 1 Jul 2005 01:23:19 -0000 1.36 +++ checks.adb 4 Jul 2005 13:18:02 -0000 @@ -2637,13 +2637,17 @@ package body Checks is when N_Object_Declaration => Msg_K := Objects; - Has_Null_Exclusion := Null_Exclusion_Present (N); - Typ := Entity (Object_Definition (N)); - Related_Nod := Object_Definition (N); - Check_Must_Be_Access (Typ, Has_Null_Exclusion); - Check_Already_Null_Excluding_Type - (Typ, Has_Null_Exclusion, Related_Nod); - Check_Must_Be_Initialized (N, Related_Nod); + + if Nkind (Object_Definition (N)) /= N_Access_Definition then + Has_Null_Exclusion := Null_Exclusion_Present (N); + Typ := Entity (Object_Definition (N)); + Related_Nod := Object_Definition (N); + Check_Must_Be_Access (Typ, Has_Null_Exclusion); + Check_Already_Null_Excluding_Type + (Typ, Has_Null_Exclusion, Related_Nod); + Check_Must_Be_Initialized (N, Related_Nod); + end if; + Check_Null_Not_Allowed (N); when N_Discriminant_Specification => Index: sem_ch3.adb =================================================================== RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch3.adb,v retrieving revision 1.61 diff -u -p -r1.61 sem_ch3.adb --- sem_ch3.adb 1 Jul 2005 01:27:58 -0000 1.61 +++ sem_ch3.adb 4 Jul 2005 13:18:03 -0000 @@ -818,6 +818,7 @@ package body Sem_Ch3 is while Nkind (D_Ityp) /= N_Full_Type_Declaration and then Nkind (D_Ityp) /= N_Procedure_Specification and then Nkind (D_Ityp) /= N_Function_Specification + and then Nkind (D_Ityp) /= N_Object_Declaration and then Nkind (D_Ityp) /= N_Object_Renaming_Declaration and then Nkind (D_Ityp) /= N_Formal_Type_Declaration loop @@ -833,6 +834,7 @@ package body Sem_Ch3 is Set_Scope (Desig_Type, Scope (Defining_Unit_Name (D_Ityp))); elsif Nkind (D_Ityp) = N_Full_Type_Declaration + or else Nkind (D_Ityp) = N_Object_Declaration or else Nkind (D_Ityp) = N_Object_Renaming_Declaration or else Nkind (D_Ityp) = N_Formal_Type_Declaration then @@ -981,7 +983,9 @@ package body Sem_Ch3 is N_Desig : Entity_Id; begin - if From_With_Type (Desig) then + if From_With_Type (Desig) + and then Ekind (Desig) /= E_Access_Type + then Set_From_With_Type (T); if Ekind (Desig) = E_Incomplete_Type then @@ -5870,9 +5874,17 @@ package body Sem_Ch3 is Same_Interfaces : Boolean := True; begin + if Nkind (N_Partial) /= N_Private_Extension_Declaration then + Error_Msg_N + ("(Ada 2005) interfaces only allowed in private" + & " extension declarations", N_Partial); + end if; + -- Count the interfaces implemented by the partial view - if not Is_Empty_List (Interface_List (N_Partial)) then + if Nkind (N_Partial) = N_Private_Extension_Declaration + and then not Is_Empty_List (Interface_List (N_Partial)) + then Iface_Partial := First (Interface_List (N_Partial)); while Present (Iface_Partial) loop Index: exp_ch6.adb =================================================================== RCS file: /cvs/gcc/gcc/gcc/ada/exp_ch6.adb,v retrieving revision 1.42 diff -u -p -r1.42 exp_ch6.adb --- exp_ch6.adb 1 Jul 2005 01:23:41 -0000 1.42 +++ exp_ch6.adb 4 Jul 2005 13:18:03 -0000 @@ -760,13 +760,25 @@ package body Exp_Ch6 is Outcod := New_Copy_Tree (Incod); -- Generate declaration of temporary variable, initializing it - -- with the input parameter unless we have an OUT variable or + -- with the input parameter unless we have an OUT formal or -- this is an initialization call. + -- If the formal is an out parameter with discriminants, the + -- discriminants must be captured even if the rest of the object + -- is in principle uninitialized, because the discriminants may + -- be read by the called subprogram. + if Ekind (Formal) = E_Out_Parameter then Incod := Empty; + if Has_Discriminants (Etype (Formal)) then + Indic := New_Occurrence_Of (Etype (Actual), Loc); + end if; + elsif Inside_Init_Proc then + + -- Could use a comment here to match comment below ??? + if Nkind (Actual) /= N_Selected_Component or else not Has_Discriminant_Dependent_Constraint @@ -774,11 +786,10 @@ package body Exp_Ch6 is then Incod := Empty; - else - -- We need the component in order to generate the proper - -- actual subtype, that depends on enclosing discriminants. - -- What is the comment for, given code below is null ??? + -- Otherwise, keep the component in order to generate the proper + -- actual subtype, that depends on enclosing discriminants. + else null; end if; end if; @@ -3859,9 +3870,20 @@ package body Exp_Ch6 is Make_Handled_Sequence_Of_Statements (Loc, Statements => New_List (Make_Null_Statement (Loc)))); begin - Set_Body_To_Inline (N, New_Copy_Tree (Bod)); + Set_Body_To_Inline (N, Bod); Insert_After (N, Bod); Analyze (Bod); + + -- Corresponding_Spec isn't being set by Analyze_Subprogram_Body, + -- evidently because Set_Has_Completion is called earlier for null + -- procedures in Analyze_Subprogram_Declaration, so we force its + -- setting here. If the setting of Has_Completion is not set + -- earlier, then it can result in missing body errors if other + -- errors were already reported (since expansion is turned off). + + -- Should creation of the empty body be moved to the analyzer??? + + Set_Corresponding_Spec (Bod, Defining_Entity (Specification (N))); end; end if; end Expand_N_Subprogram_Declaration;