From: Arnaud Charlet Date: Thu, 12 Jul 2012 10:33:23 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=1e4b91fc4f5c6d15955594c01553462a38db97d4;p=gcc.git [multiple changes] 2012-07-12 Thomas Quinot * s-bytswa.adb (Swapped2.Bswap16): Remove local function, no longer needed. 2012-07-12 Javier Miranda * exp_attr.adb (Expand_N_Attribute_Reference): For attributes 'access, 'unchecked_access and 'unrestricted_access, iff the current instance reference is located in a protected subprogram or entry then rewrite the access attribute to be the name of the "_object" parameter. 2012-07-12 Tristan Gingold * raise.h: Revert previous patch: structure is used in init.c by vms. 2012-07-12 Vincent Celier * make.adb (Binding_Phase): If --subdirs was used, but not -P, change the working directory to the specified subdirectory before invoking gnatbind. (Linking_Phase): If --subdirs was used, but not -P, change the working directory to the specified subdirectory before invoking gnatlink. 2012-07-12 Vincent Pucci * exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body): For a procedure, instead of replacing each Comp reference by a reference to Current_Comp, make a renaming Comp of Current_Comp that rewrites the original renaming generated by the compiler during the analysis. Move the declarations of the procedure inside the generated block. (Process_Stmts): Moved in the body of Build_Lock_Free_Unprotected_Subprogram_Body. (Process_Node): Moved in the body of Build_Lock_Free_Unprotected_Subprogram_Body. * sem_ch9.adb (Allows_Lock_Free_Implementation): Restrict any non-elementary out parameters in protected procedures. 2012-07-12 Thomas Quinot * sem_ch13.adb (Analyze_Attribute_Definition_Clause, case Scalar_Storage_Order): Attribute applies to base type only. From-SVN: r189435 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ec8cded8dcf..81f63248f96 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,49 @@ +2012-07-12 Thomas Quinot + + * s-bytswa.adb (Swapped2.Bswap16): Remove local function, + no longer needed. + +2012-07-12 Javier Miranda + + * exp_attr.adb (Expand_N_Attribute_Reference): For + attributes 'access, 'unchecked_access and 'unrestricted_access, + iff the current instance reference is located in a protected + subprogram or entry then rewrite the access attribute to be the + name of the "_object" parameter. + +2012-07-12 Tristan Gingold + + * raise.h: Revert previous patch: structure is used in init.c + by vms. + +2012-07-12 Vincent Celier + + * make.adb (Binding_Phase): If --subdirs was used, but not + -P, change the working directory to the specified subdirectory + before invoking gnatbind. + (Linking_Phase): If --subdirs was used, but not -P, change the working + directory to the specified subdirectory before invoking gnatlink. + +2012-07-12 Vincent Pucci + + * exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body): + For a procedure, instead of replacing each Comp reference by a + reference to Current_Comp, make a renaming Comp of Current_Comp + that rewrites the original renaming generated by the compiler + during the analysis. Move the declarations of the procedure + inside the generated block. + (Process_Stmts): Moved in the body + of Build_Lock_Free_Unprotected_Subprogram_Body. + (Process_Node): + Moved in the body of Build_Lock_Free_Unprotected_Subprogram_Body. + * sem_ch9.adb (Allows_Lock_Free_Implementation): Restrict any + non-elementary out parameters in protected procedures. + +2012-07-12 Thomas Quinot + + * sem_ch13.adb (Analyze_Attribute_Definition_Clause, case + Scalar_Storage_Order): Attribute applies to base type only. + 2012-07-12 Ed Schonberg * exp_aggr.adb (Convert_To_Positional): Increase acceptable size diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index cc658a2471e..352aab1778a 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -815,11 +815,19 @@ package body Exp_Attr is -- rewrite into reference to current instance. if Is_Protected_Self_Reference (Pref) - and then not + and then not (Nkind_In (Parent (N), N_Index_Or_Discriminant_Constraint, N_Discriminant_Association) and then Nkind (Parent (Parent (Parent (Parent (N))))) = N_Component_Definition) + + -- No action needed for these attributes since the current instance + -- will be rewritten to be the name of the _object parameter + -- associated with the enclosing protected subprogram (see below). + + and then Id /= Attribute_Access + and then Id /= Attribute_Unchecked_Access + and then Id /= Attribute_Unrestricted_Access then Rewrite (Pref, Concurrent_Ref (Pref)); Analyze (Pref); @@ -1028,10 +1036,36 @@ package body Exp_Attr is New_Occurrence_Of (Formal, Loc))); Set_Etype (N, Typ); - -- The expression must appear in a default expression, - -- (which in the initialization procedure is the - -- right-hand side of an assignment), and not in a - -- discriminant constraint. + elsif Is_Protected_Type (Entity (Pref)) then + + -- No action needed for current instance located in a + -- component definition (expansion will occur in the + -- init proc) + + if Is_Protected_Type (Current_Scope) then + null; + + -- If the current instance reference is located in a + -- protected subprogram or entry then rewrite the access + -- attribute to be the name of the "_object" parameter. + -- An unchecked conversion is applied to ensure a type + -- match in cases of expander-generated calls (e.g. init + -- procs). + + else + Formal := + First_Entity + (Protected_Body_Subprogram (Current_Scope)); + Rewrite (N, + Unchecked_Convert_To (Typ, + New_Occurrence_Of (Formal, Loc))); + Set_Etype (N, Typ); + end if; + + -- The expression must appear in a default expression, + -- (which in the initialization procedure is the right-hand + -- side of an assignment), and not in a discriminant + -- constraint. else Par := Parent (N); diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index e95db771798..bf1cbc48f23 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -2955,26 +2955,30 @@ package body Exp_Ch9 is -- manner: -- procedure P (...) is - -- -- begin -- loop -- declare + -- -- Saved_Comp : constant ... := - -- Atomic_Load (Comp'Address, Relaxed); + -- Atomic_Load (_Object.Comp'Address, Relaxed); -- Current_Comp : ... := Saved_Comp; + -- Comp : Comp_Type renames Current_Comp; + -- -- begin -- - -- exit when Atomic_Compare (Comp, Saved_Comp, Current_Comp); + -- exit when Atomic_Compare + -- (_Object.Comp, Saved_Comp, Current_Comp); -- end; -- <> -- end loop; -- end P; - -- References to Comp which appear in the original statements are replaced - -- with references to Current_Comp. Each return and raise statement of P is - -- transformed into an atomic status check: + -- Each return and raise statement of P is transformed into an atomic + -- status check: - -- if Atomic_Compare (Comp, Saved_Comp, Current_Comp) then + -- if Atomic_Compare (_Object.Comp, Saved_Comp, Current_Comp) then -- -- else -- goto L0; @@ -2985,15 +2989,16 @@ package body Exp_Ch9 is -- manner: -- function F (...) return ... is - -- - -- Saved_Comp : constant ... := Atomic_Load (Comp'Address); + -- + -- Saved_Comp : constant ... := Atomic_Load (_Object.Comp'Address); + -- Comp : Comp_Type renames Saved_Comp; + -- -- begin -- -- end F; - -- References to Comp which appear in the original statements are replaced - -- with references to Saved_Comp. - function Build_Lock_Free_Unprotected_Subprogram_Body (N : Node_Id; Prot_Typ : Node_Id) return Node_Id @@ -3003,162 +3008,11 @@ package body Exp_Ch9 is Loc : constant Source_Ptr := Sloc (N); Label_Id : Entity_Id := Empty; - procedure Process_Stmts - (Stmts : List_Id; - Compare : Entity_Id; - Unsigned : Entity_Id; - Comp : Entity_Id; - Saved_Comp : Entity_Id; - Current_Comp : Entity_Id); - -- Given a statement sequence Stmts, wrap any return or raise statements - -- in the following manner: - -- - -- if System.Atomic_Primitives.Atomic_Compare_Exchange - -- (Comp'Address, - -- Interfaces.Unsigned (Saved_Comp), - -- Interfaces.Unsigned (Current_Comp)) - -- then - -- ; - -- else - -- goto L0; - -- end if; - -- - -- Replace all references to Comp with a reference to Current_Comp. - function Referenced_Component (N : Node_Id) return Entity_Id; -- Subprograms which meet the lock-free implementation criteria are -- allowed to reference only one unique component. Return the prival -- of the said component. - ------------------- - -- Process_Stmts -- - ------------------- - - procedure Process_Stmts - (Stmts : List_Id; - Compare : Entity_Id; - Unsigned : Entity_Id; - Comp : Entity_Id; - Saved_Comp : Entity_Id; - Current_Comp : Entity_Id) - is - function Process_Node (N : Node_Id) return Traverse_Result; - -- Transform a single node if it is a return statement, a raise - -- statement or a reference to Comp. - - ------------------ - -- Process_Node -- - ------------------ - - function Process_Node (N : Node_Id) return Traverse_Result is - - procedure Wrap_Statement (Stmt : Node_Id); - -- Wrap an arbitrary statement inside an if statement where the - -- condition does an atomic check on the state of the object. - - -------------------- - -- Wrap_Statement -- - -------------------- - - procedure Wrap_Statement (Stmt : Node_Id) is - begin - -- The first time through, create the declaration of a label - -- which is used to skip the remainder of source statements if - -- the state of the object has changed. - - if No (Label_Id) then - Label_Id := - Make_Identifier (Loc, New_External_Name ('L', 0)); - Set_Entity (Label_Id, - Make_Defining_Identifier (Loc, Chars (Label_Id))); - end if; - - -- Generate: - - -- if System.Atomic_Primitives.Atomic_Compare_Exchange - -- (Comp'Address, - -- Interfaces.Unsigned (Saved_Comp), - -- Interfaces.Unsigned (Current_Comp)) - -- then - -- ; - -- else - -- goto L0; - -- end if; - - Rewrite (Stmt, - Make_If_Statement (Loc, - Condition => - Make_Function_Call (Loc, - Name => - New_Reference_To (Compare, Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Comp, Loc), - Attribute_Name => Name_Address), - - Unchecked_Convert_To (Unsigned, - New_Reference_To (Saved_Comp, Loc)), - - Unchecked_Convert_To (Unsigned, - New_Reference_To (Current_Comp, Loc)))), - - Then_Statements => New_List (Relocate_Node (Stmt)), - - Else_Statements => New_List ( - Make_Goto_Statement (Loc, - Name => New_Reference_To (Entity (Label_Id), Loc))))); - end Wrap_Statement; - - -- Start of processing for Process_Node - - begin - -- Wrap each return and raise statement that appear inside a - -- procedure. Skip the last return statement which is added by - -- default since it is transformed into an exit statement. - - if Is_Procedure - and then Nkind_In (N, N_Simple_Return_Statement, - N_Extended_Return_Statement, - N_Raise_Statement) - and then Nkind (Last (Stmts)) /= N_Simple_Return_Statement - then - Wrap_Statement (N); - return Skip; - - -- Replace all references to the original component by a reference - -- to the current state of the component. - - elsif Nkind (N) = N_Identifier - and then Present (Entity (N)) - and then Entity (N) = Comp - then - Rewrite (N, Make_Identifier (Loc, Chars (Current_Comp))); - return Skip; - end if; - - -- Force reanalysis - - Set_Analyzed (N, False); - - return OK; - end Process_Node; - - procedure Process_Nodes is new Traverse_Proc (Process_Node); - - -- Local variables - - Stmt : Node_Id; - - -- Start of processing for Process_Stmts - - begin - Stmt := First (Stmts); - while Present (Stmt) loop - Process_Nodes (Stmt); - Next (Stmt); - end loop; - end Process_Stmts; - -------------------------- -- Referenced_Component -- -------------------------- @@ -3214,20 +3068,25 @@ package body Exp_Ch9 is -- Local variables - Comp : constant Entity_Id := Referenced_Component (N); - Decls : constant List_Id := Declarations (N); - Stmts : List_Id; + Comp : constant Entity_Id := Referenced_Component (N); + Hand_Stmt_Seq : Node_Id := Handled_Statement_Sequence (N); + Decls : List_Id := Declarations (N); -- Start of processing for Build_Lock_Free_Unprotected_Subprogram_Body begin - Stmts := New_Copy_List (Statements (Handled_Statement_Sequence (N))); + -- Add renamings for the protection object, discriminals, privals and + -- the entry index constant for use by debugger. + + Debug_Private_Data_Declarations (Decls); -- Perform the lock-free expansion when the subprogram references a -- protected component. if Present (Comp) then declare + Comp_Decl : constant Node_Id := Parent (Comp); + Comp_Sel_Nam : constant Node_Id := Name (Comp_Decl); Comp_Type : constant Entity_Id := Etype (Comp); Block_Decls : List_Id; Compare : Entity_Id; @@ -3238,9 +3097,138 @@ package body Exp_Ch9 is Load_Params : List_Id; Saved_Comp : Entity_Id; Stmt : Node_Id; + Stmts : List_Id := + New_Copy_List (Statements (Hand_Stmt_Seq)); Typ_Size : Int; Unsigned : Entity_Id; + function Process_Node (N : Node_Id) return Traverse_Result; + -- Transform a single node if it is a return statement, a raise + -- statement or a reference to Comp. + + procedure Process_Stmts (Stmts : List_Id); + -- Given a statement sequence Stmts, wrap any return or raise + -- statements in the following manner: + -- + -- if System.Atomic_Primitives.Atomic_Compare_Exchange + -- (Comp'Address, + -- Interfaces.Unsigned (Saved_Comp), + -- Interfaces.Unsigned (Current_Comp)) + -- then + -- ; + -- else + -- goto L0; + -- end if; + + ------------------ + -- Process_Node -- + ------------------ + + function Process_Node (N : Node_Id) return Traverse_Result is + + procedure Wrap_Statement (Stmt : Node_Id); + -- Wrap an arbitrary statement inside an if statement where the + -- condition does an atomic check on the state of the object. + + -------------------- + -- Wrap_Statement -- + -------------------- + + procedure Wrap_Statement (Stmt : Node_Id) is + begin + -- The first time through, create the declaration of a label + -- which is used to skip the remainder of source statements + -- if the state of the object has changed. + + if No (Label_Id) then + Label_Id := + Make_Identifier (Loc, New_External_Name ('L', 0)); + Set_Entity (Label_Id, + Make_Defining_Identifier (Loc, Chars (Label_Id))); + end if; + + -- Generate: + + -- if System.Atomic_Primitives.Atomic_Compare_Exchange + -- (Comp'Address, + -- Interfaces.Unsigned (Saved_Comp), + -- Interfaces.Unsigned (Current_Comp)) + -- then + -- ; + -- else + -- goto L0; + -- end if; + + Rewrite (Stmt, + Make_If_Statement (Loc, + Condition => + Make_Function_Call (Loc, + Name => + New_Reference_To (Compare, Loc), + Parameter_Associations => New_List ( + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Comp_Sel_Nam), + Attribute_Name => Name_Address), + + Unchecked_Convert_To (Unsigned, + New_Reference_To (Saved_Comp, Loc)), + + Unchecked_Convert_To (Unsigned, + New_Reference_To (Current_Comp, Loc)))), + + Then_Statements => New_List (Relocate_Node (Stmt)), + + Else_Statements => New_List ( + Make_Goto_Statement (Loc, + Name => + New_Reference_To (Entity (Label_Id), Loc))))); + end Wrap_Statement; + + -- Start of processing for Process_Node + + begin + -- Wrap each return and raise statement that appear inside a + -- procedure. Skip the last return statement which is added by + -- default since it is transformed into an exit statement. + + if Is_Procedure + and then ((Nkind (N) = N_Simple_Return_Statement + and then N /= Last (Stmts)) + or else Nkind (N) = N_Extended_Return_Statement + or else (Nkind_In (N, N_Raise_Constraint_Error, + N_Raise_Program_Error, + N_Raise_Statement, + N_Raise_Storage_Error) + and then Comes_From_Source (N))) + then + Wrap_Statement (N); + return Skip; + end if; + + -- Force reanalysis + + Set_Analyzed (N, False); + + return OK; + end Process_Node; + + procedure Process_Nodes is new Traverse_Proc (Process_Node); + + ------------------- + -- Process_Stmts -- + ------------------- + + procedure Process_Stmts (Stmts : List_Id) is + Stmt : Node_Id; + + begin + Stmt := First (Stmts); + while Present (Stmt) loop + Process_Nodes (Stmt); + Next (Stmt); + end loop; + end Process_Stmts; + begin -- Get the type size @@ -3305,7 +3293,7 @@ package body Exp_Ch9 is Load_Params := New_List ( Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Comp, Loc), + Prefix => Relocate_Node (Comp_Sel_Nam), Attribute_Name => Name_Address)); -- For protected procedures, set the memory model to be relaxed @@ -3329,7 +3317,14 @@ package body Exp_Ch9 is -- Protected procedures if Is_Procedure then - Block_Decls := New_List (Decl); + -- Move the original declarations inside the generated block + + Block_Decls := Decls; + + -- Reset the declarations list of the protected procedure to be + -- an empty list. + + Decls := Empty_List; -- Generate: -- Current_Comp : Comp_Type := Saved_Comp; @@ -3338,21 +3333,50 @@ package body Exp_Ch9 is Make_Defining_Identifier (Loc, New_External_Name (Chars (Comp), Suffix => "_current")); - Append_To (Block_Decls, + -- Insert the declarations of Saved_Comp and Current_Comp in + -- the block declarations right before the renaming of the + -- protected component. + + Insert_Before (Comp_Decl, Decl); + + Insert_Before (Comp_Decl, Make_Object_Declaration (Loc, Defining_Identifier => Current_Comp, Object_Definition => New_Reference_To (Comp_Type, Loc), - Expression => New_Reference_To (Saved_Comp, Loc))); + Expression => + New_Reference_To (Saved_Comp, Loc))); -- Protected function else - Append_To (Decls, Decl); Current_Comp := Saved_Comp; + + -- Insert the declaration of Saved_Comp in the function + -- declarations right before the renaming of the protected + -- component. + + Insert_Before (Comp_Decl, Decl); end if; - Process_Stmts - (Stmts, Compare, Unsigned, Comp, Saved_Comp, Current_Comp); + -- Rewrite the protected component renaming declaration to be a + -- renaming of Current_Comp. + + -- Generate: + -- Comp : Comp_Type renames Current_Comp; + + Rewrite (Comp_Decl, + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => + Defining_Identifier (Comp_Decl), + Subtype_Mark => + New_Occurrence_Of (Comp_Type, Loc), + Name => + New_Reference_To (Current_Comp, Loc))); + + -- Wrap any return or raise statements in Stmts in same the manner + -- described in Process_Stmts. + + Process_Stmts (Stmts); -- Generate: @@ -3370,7 +3394,7 @@ package body Exp_Ch9 is New_Reference_To (Compare, Loc), Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Comp, Loc), + Prefix => Relocate_Node (Comp_Sel_Nam), Attribute_Name => Name_Address), Unchecked_Convert_To (Unsigned, @@ -3413,7 +3437,7 @@ package body Exp_Ch9 is if Is_Procedure then Stmts := New_List ( - Make_Procedure_Call_Statement (Loc, + Make_Procedure_Call_Statement (Loc, Name => New_Reference_To (RTE (RE_Atomic_Synchronize), Loc)), Make_Loop_Statement (Loc, @@ -3425,14 +3449,12 @@ package body Exp_Ch9 is Statements => Stmts))), End_Label => Empty)); end if; + + Hand_Stmt_Seq := + Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts); end; end if; - -- Add renamings for the protection object, discriminals, privals and - -- the entry index constant for use by debugger. - - Debug_Private_Data_Declarations (Decls); - -- Make an unprotected version of the subprogram for use within the same -- object, with new name and extra parameter representing the object. @@ -3441,8 +3463,7 @@ package body Exp_Ch9 is Specification => Build_Protected_Sub_Specification (N, Prot_Typ, Unprotected_Mode), Declarations => Decls, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts)); + Handled_Statement_Sequence => Hand_Stmt_Seq); end Build_Lock_Free_Unprotected_Subprogram_Body; ------------------------- diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index dca504d7919..0eed65d90fd 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -4435,6 +4435,13 @@ package body Make is declare Success : Boolean := False; begin + -- If gnatmake was invoked with --subdirs and no project file, + -- put the executable in the subdirectory specified. + + if Prj.Subdirs /= null and then Main_Project = No_Project then + Change_Dir (Object_Directory_Path.all); + end if; + Link (Main_ALI_File, Link_With_Shared_Libgcc.all & Args (Args'First .. Last_Arg), @@ -4571,6 +4578,13 @@ package body Make is end if; end if; + -- If gnatmake was invoked with --subdirs and no project file, put the + -- binder generated files in the subdirectory specified. + + if Main_Project = No_Project and then Prj.Subdirs /= null then + Change_Dir (Object_Directory_Path.all); + end if; + begin Bind (Main_ALI_File, Bind_Shared.all & Args (Args'First .. Last_Arg)); diff --git a/gcc/ada/raise.h b/gcc/ada/raise.h index 1c4eb36e9c6..7fb18597ec6 100644 --- a/gcc/ada/raise.h +++ b/gcc/ada/raise.h @@ -37,7 +37,16 @@ extern "C" { typedef unsigned Exception_Code; -struct Exception_Data; +struct Exception_Data +{ + char Not_Handled_By_Others; + char Lang; + int Name_Length; + char *Full_Name, *Htable_Ptr; + Exception_Code Import_Code; + void (*Raise_Hook)(void); +}; + typedef struct Exception_Data *Exception_Id; extern void _gnat_builtin_longjmp (void *, int); diff --git a/gcc/ada/s-bytswa.adb b/gcc/ada/s-bytswa.adb index ac54d0eedb0..e029980c0bc 100644 --- a/gcc/ada/s-bytswa.adb +++ b/gcc/ada/s-bytswa.adb @@ -56,9 +56,6 @@ package body System.Byte_Swapping is function Swapped2 (Input : Item) return Item is function As_U16 is new Unchecked_Conversion (Item, U16); function As_Item is new Unchecked_Conversion (U16, Item); - - function Bswap_16 (X : U16) return U16 is (X / 256 or X * 256); - -- ??? Need to have function local here to allow inlining pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 2, "storage size must be 2 bytes"); begin diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index a601c7b78cf..58d649214f3 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3332,7 +3332,7 @@ package body Sem_Ch13 is else if (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then - Set_Reverse_Storage_Order (U_Ent, True); + Set_Reverse_Storage_Order (Base_Type (U_Ent), True); end if; end if; end if; diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index d6141bc1e05..e6eba745370 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -170,24 +170,30 @@ package body Sem_Ch9 is Par_Specs : constant List_Id := Parameter_Specifications (Specification (Decl)); - Par : constant Node_Id := First (Par_Specs); - Par_Typ : constant Entity_Id := - Etype (Parameter_Type (Par)); + + Par : Node_Id; begin - if Out_Present (Par) - and then not Is_Elementary_Type (Par_Typ) - then - if Complain then - Error_Msg_NE - ("non-elementary out parameter& not allowed " & - "when Lock_Free given", - Par, - Defining_Identifier (Par)); + Par := First (Par_Specs); + + while Present (Par) loop + if Out_Present (Par) + and then not Is_Elementary_Type + (Etype (Parameter_Type (Par))) + then + if Complain then + Error_Msg_NE + ("non-elementary out parameter& not allowed " & + "when Lock_Free given", + Par, + Defining_Identifier (Par)); + end if; + + return False; end if; - return False; - end if; + Next (Par); + end loop; end; end if; @@ -451,9 +457,9 @@ package body Sem_Ch9 is -- already been accessed by the subprogram body. if No (Comp) then - Comp := Id; + Comp := Comp_Id; - elsif Comp /= Id then + elsif Comp /= Comp_Id then if Complain then Error_Msg_N ("only one protected component allowed",