From 2c1b72d7b658ecef2cd2cb7b09f5a7fcb40b3ea4 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 4 Aug 2011 09:51:08 +0200 Subject: [PATCH] [multiple changes] 2011-08-04 Robert Dewar * par_sco.adb, prj-proc.adb, make.adb, bindgen.adb, prj.adb, prj.ads, makeutl.adb, makeutl.ads, prj-nmsc.adb, exp_ch5.adb, exp_ch12.adb, exp_ch7.ads, exp_util.ads, sem_util.ads, g-comlin.ads, exp_ch6.adb, exp_ch6.ads, lib-xref.ads, exp_ch7.adb, exp_util.adb, exp_dist.adb, exp_strm.adb, gnatcmd.adb, freeze.adb, g-comlin.adb, lib-xref-alfa.adb, sem_attr.adb, sem_prag.adb, sem_util.adb, sem_elab.adb, sem_ch8.adb, sem_ch11.adb, sem_eval.adb, sem_ch13.adb, sem_disp.adb, a-fihema.adb: Minor reformatting and code reorganization. 2011-08-04 Emmanuel Briot * projects.texi: Added doc for aggregate projects. From-SVN: r177320 --- gcc/ada/ChangeLog | 15 ++ gcc/ada/a-fihema.adb | 3 + gcc/ada/bindgen.adb | 52 ++-- gcc/ada/exp_ch12.adb | 2 +- gcc/ada/exp_ch5.adb | 58 ++--- gcc/ada/exp_ch6.adb | 192 +++++++-------- gcc/ada/exp_ch6.ads | 6 +- gcc/ada/exp_ch7.adb | 464 ++++++++++++++--------------------- gcc/ada/exp_ch7.ads | 4 +- gcc/ada/exp_dist.adb | 11 +- gcc/ada/exp_strm.adb | 30 ++- gcc/ada/exp_util.adb | 18 +- gcc/ada/exp_util.ads | 8 +- gcc/ada/freeze.adb | 36 +-- gcc/ada/g-comlin.adb | 40 +-- gcc/ada/g-comlin.ads | 13 +- gcc/ada/gnatcmd.adb | 5 +- gcc/ada/lib-xref-alfa.adb | 238 ++++++++++++------ gcc/ada/lib-xref.ads | 5 + gcc/ada/make.adb | 9 +- gcc/ada/makeutl.adb | 120 ++++----- gcc/ada/makeutl.ads | 110 ++++----- gcc/ada/par_sco.adb | 19 +- gcc/ada/prj-nmsc.adb | 42 ++-- gcc/ada/prj-proc.adb | 2 + gcc/ada/prj.adb | 15 +- gcc/ada/prj.ads | 19 +- gcc/ada/projects.texi | 502 ++++++++++++++++++++++++++++++++++++++ gcc/ada/sem_attr.adb | 4 +- gcc/ada/sem_ch11.adb | 5 +- gcc/ada/sem_ch13.adb | 7 +- gcc/ada/sem_ch8.adb | 12 +- gcc/ada/sem_disp.adb | 21 +- gcc/ada/sem_elab.adb | 8 +- gcc/ada/sem_eval.adb | 6 +- gcc/ada/sem_prag.adb | 3 +- gcc/ada/sem_util.adb | 23 +- gcc/ada/sem_util.ads | 2 +- 38 files changed, 1323 insertions(+), 806 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e318a9490a7..fa4fbdb6c4a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2011-08-04 Robert Dewar + + * par_sco.adb, prj-proc.adb, make.adb, bindgen.adb, prj.adb, prj.ads, + makeutl.adb, makeutl.ads, prj-nmsc.adb, exp_ch5.adb, exp_ch12.adb, + exp_ch7.ads, exp_util.ads, sem_util.ads, g-comlin.ads, exp_ch6.adb, + exp_ch6.ads, lib-xref.ads, exp_ch7.adb, exp_util.adb, exp_dist.adb, + exp_strm.adb, gnatcmd.adb, freeze.adb, g-comlin.adb, lib-xref-alfa.adb, + sem_attr.adb, sem_prag.adb, sem_util.adb, sem_elab.adb, sem_ch8.adb, + sem_ch11.adb, sem_eval.adb, sem_ch13.adb, sem_disp.adb, a-fihema.adb: + Minor reformatting and code reorganization. + +2011-08-04 Emmanuel Briot + + * projects.texi: Added doc for aggregate projects. + 2011-08-04 Emmanuel Briot * prj-proc.adb, prj-nmsc.adb, prj-env.adb (Process_Declarative_Items): diff --git a/gcc/ada/a-fihema.adb b/gcc/ada/a-fihema.adb index ab0e273cba1..d44d1dbd320 100644 --- a/gcc/ada/a-fihema.adb +++ b/gcc/ada/a-fihema.adb @@ -45,6 +45,7 @@ package body Ada.Finalization.Heap_Management is Header_Size : constant Storage_Count := Node'Size / Storage_Unit; Header_Offset : constant Storage_Offset := Header_Size; + -- Comments needed??? function Address_To_Node_Ptr is new Ada.Unchecked_Conversion (Address, Node_Ptr); @@ -144,6 +145,7 @@ package body Ada.Finalization.Heap_Management is N.Prev := L; Unlock_Task.all; + exception when others => Unlock_Task.all; @@ -230,6 +232,7 @@ package body Ada.Finalization.Heap_Management is end if; Unlock_Task.all; + exception when others => Unlock_Task.all; diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 9072e36f06a..53abc17c04c 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -1224,16 +1224,16 @@ package body Bindgen is if U.Set_Elab_Entity - -- Don't generate reference for stand alone library + -- Don't generate reference for stand alone library and then not U.SAL_Interface - -- Don't generate reference for predefined file in No_Run_Time - -- mode, since we don't include the object files in this case + -- Don't generate reference for predefined file in No_Run_Time + -- mode, since we don't include the object files in this case and then not (No_Run_Time_Mode - and then Is_Predefined_File_Name (U.Sfile)) + and then Is_Predefined_File_Name (U.Sfile)) then Set_String (" "); Set_String ("E"); @@ -1309,16 +1309,16 @@ package body Bindgen is if U.Set_Elab_Entity - -- Don't generate reference for stand alone library + -- Don't generate reference for stand alone library and then not U.SAL_Interface - -- Don't generate reference for predefined file in No_Run_Time - -- mode, since we don't include the object files in this case + -- Don't generate reference for predefined file in No_Run_Time + -- mode, since we don't include the object files in this case and then not (No_Run_Time_Mode - and then Is_Predefined_File_Name (U.Sfile)) + and then Is_Predefined_File_Name (U.Sfile)) then Set_String ("extern int "); Get_Name_String (U.Uname); @@ -1403,9 +1403,9 @@ package body Bindgen is -- since it will be done when we process the body. else - if Force_Checking_Of_Elaboration_Flags or - Interface_Library_Unit or - (not Bind_Main_Program) + if Force_Checking_Of_Elaboration_Flags + or Interface_Library_Unit + or not Bind_Main_Program then Set_String (" if E"); Set_Unit_Number (Unum_Spec); @@ -1445,9 +1445,9 @@ package body Bindgen is Set_Char (';'); Write_Statement_Buffer; - if Force_Checking_Of_Elaboration_Flags or - Interface_Library_Unit or - (not Bind_Main_Program) + if Force_Checking_Of_Elaboration_Flags + or Interface_Library_Unit + or not Bind_Main_Program then WBI (" end if;"); end if; @@ -1537,9 +1537,9 @@ package body Bindgen is else Get_Name_String (U.Uname); - if Force_Checking_Of_Elaboration_Flags or - Interface_Library_Unit or - (not Bind_Main_Program) + if Force_Checking_Of_Elaboration_Flags + or Interface_Library_Unit + or not Bind_Main_Program then Set_String (" if ("); Set_Unit_Name; @@ -1783,7 +1783,7 @@ package body Bindgen is Set_String (" - 1;"); Write_Statement_Buffer; - if Interface_Library_Unit or (not Bind_Main_Program) then + if Interface_Library_Unit or not Bind_Main_Program then Set_String (" if E"); Set_Unit_Number (Unum); Set_String (" = 0 then"); @@ -1796,7 +1796,7 @@ package body Bindgen is Set_Char (';'); Write_Statement_Buffer; - if Interface_Library_Unit or (not Bind_Main_Program) then + if Interface_Library_Unit or not Bind_Main_Program then WBI (" end if;"); end if; @@ -1907,7 +1907,7 @@ package body Bindgen is Set_String ("_E--;"); Write_Statement_Buffer; - if Interface_Library_Unit or (not Bind_Main_Program) then + if Interface_Library_Unit or not Bind_Main_Program then Set_String (" if ("); Set_Unit_Name; Set_String ("_E == 0)"); @@ -2509,7 +2509,7 @@ package body Bindgen is -- If not spec that has an associated body, then generate a comment -- giving the name of the corresponding object file. - if (not Units.Table (Elab_Order.Table (E)).SAL_Interface) + if not Units.Table (Elab_Order.Table (E)).SAL_Interface and then Units.Table (Elab_Order.Table (E)).Utype /= Is_Spec then Get_Name_String @@ -3535,8 +3535,9 @@ package body Bindgen is WBI (" type Version_32 is mod 2 ** 32;"); for U in Units.First .. Units.Last loop - if not Units.Table (U).SAL_Interface and then - ((not Bind_For_Library) or else Units.Table (U).Directly_Scanned) + if not Units.Table (U).SAL_Interface + and then + (not Bind_For_Library or else Units.Table (U).Directly_Scanned) then Increment_Ubuf; WBI (" " & Ubuf & " : constant Version_32 := 16#" & @@ -3586,8 +3587,9 @@ package body Bindgen is procedure Gen_Versions_C is begin for U in Units.First .. Units.Last loop - if not Units.Table (U).SAL_Interface and then - ((not Bind_For_Library) or else Units.Table (U).Directly_Scanned) + if not Units.Table (U).SAL_Interface + and then + (not Bind_For_Library or else Units.Table (U).Directly_Scanned) then Set_String ("unsigned "); diff --git a/gcc/ada/exp_ch12.adb b/gcc/ada/exp_ch12.adb index 7c7f92ce38a..f6c5fc8ce68 100644 --- a/gcc/ada/exp_ch12.adb +++ b/gcc/ada/exp_ch12.adb @@ -62,7 +62,7 @@ package body Exp_Ch12 is Right_Opnd => Make_Attribute_Reference (Loc, Attribute_Name => Name_Elaborated, - Prefix => New_Occurrence_Of (Ent, Loc))), + Prefix => New_Occurrence_Of (Ent, Loc))), Reason => PE_Access_Before_Elaboration)); end if; end Expand_N_Generic_Instantiation; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 5f3e30049f7..6cbd62898ab 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3538,9 +3538,9 @@ package body Exp_Ch5 is else Append_To (Res, - Make_Final_Call ( - Obj_Ref => Duplicate_Subexpr_No_Checks (L), - Typ => Etype (L))); + Make_Final_Call + (Obj_Ref => Duplicate_Subexpr_No_Checks (L), + Typ => Etype (L))); end if; -- Save the Tag in a local variable Tag_Id @@ -3551,12 +3551,10 @@ package body Exp_Ch5 is Append_To (Res, Make_Object_Declaration (Loc, Defining_Identifier => Tag_Id, - Object_Definition => - New_Reference_To (RTE (RE_Tag), Loc), - Expression => + Object_Definition => New_Reference_To (RTE (RE_Tag), Loc), + Expression => Make_Selected_Component (Loc, - Prefix => - Duplicate_Subexpr_No_Checks (L), + Prefix => Duplicate_Subexpr_No_Checks (L), Selector_Name => New_Reference_To (First_Tag_Component (T), Loc)))); @@ -3581,11 +3579,11 @@ package body Exp_Ch5 is Append_To (Res, Make_Object_Declaration (Loc, Defining_Identifier => Prev_Id, - Object_Definition => + Object_Definition => New_Reference_To (RTE (RE_Root_Controlled_Ptr), Loc), - Expression => + Expression => Make_Selected_Component (Loc, - Prefix => + Prefix => Unchecked_Convert_To (RTE (RE_Root_Controlled), New_Copy_Tree (L)), Selector_Name => @@ -3597,11 +3595,11 @@ package body Exp_Ch5 is Append_To (Res, Make_Object_Declaration (Loc, Defining_Identifier => Next_Id, - Object_Definition => + Object_Definition => New_Reference_To (RTE (RE_Root_Controlled_Ptr), Loc), - Expression => + Expression => Make_Selected_Component (Loc, - Prefix => + Prefix => Unchecked_Convert_To (RTE (RE_Root_Controlled), New_Copy_Tree (L)), Selector_Name => @@ -3625,14 +3623,12 @@ package body Exp_Ch5 is if Save_Tag then Append_To (Res, Make_Assignment_Statement (Loc, - Name => + Name => Make_Selected_Component (Loc, - Prefix => - Duplicate_Subexpr_No_Checks (L), + Prefix => Duplicate_Subexpr_No_Checks (L), Selector_Name => New_Reference_To (First_Tag_Component (T), Loc)), - Expression => - New_Reference_To (Tag_Id, Loc))); + Expression => New_Reference_To (Tag_Id, Loc))); end if; -- Restore the Prev and Next fields on .NET/JVM @@ -3645,30 +3641,27 @@ package body Exp_Ch5 is Append_To (Res, Make_Assignment_Statement (Loc, - Name => + Name => Make_Selected_Component (Loc, - Prefix => + Prefix => Unchecked_Convert_To (RTE (RE_Root_Controlled), New_Copy_Tree (L)), Selector_Name => Make_Identifier (Loc, Name_Prev)), - Expression => - New_Reference_To (Prev_Id, Loc))); + Expression => New_Reference_To (Prev_Id, Loc))); -- Generate: -- Root_Controlled (L).Next := Next_Id; Append_To (Res, Make_Assignment_Statement (Loc, - Name => + Name => Make_Selected_Component (Loc, - Prefix => + Prefix => Unchecked_Convert_To (RTE (RE_Root_Controlled), New_Copy_Tree (L)), - Selector_Name => - Make_Identifier (Loc, Name_Next)), - Expression => - New_Reference_To (Next_Id, Loc))); + Selector_Name => Make_Identifier (Loc, Name_Next)), + Expression => New_Reference_To (Next_Id, Loc))); end if; -- Adjust the target after the assignment when controlled (not in the @@ -3676,14 +3669,15 @@ package body Exp_Ch5 is if Ctrl_Act then Append_To (Res, - Make_Adjust_Call ( - Obj_Ref => Duplicate_Subexpr_Move_Checks (L), - Typ => Etype (L))); + Make_Adjust_Call + (Obj_Ref => Duplicate_Subexpr_Move_Checks (L), + Typ => Etype (L))); end if; return Res; exception + -- Could use comment here ??? when RE_Not_Available => diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 1bb0a710a22..eabd3ef086c 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1790,8 +1790,7 @@ package body Exp_Ch6 is -- called. function Is_Direct_Deep_Call (Subp : Entity_Id) return Boolean; - -- Determine whether Subp denotes a non-dispatching call to a Deep - -- routine. + -- Determine if Subp denotes a non-dispatching call to a Deep routine function New_Value (From : Node_Id) return Node_Id; -- From is the original Expression. New_Value is equivalent to a call @@ -4465,19 +4464,17 @@ package body Exp_Ch6 is Append_To (Decls, Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Pool_Id, - Subtype_Mark => + Subtype_Mark => New_Reference_To (RTE (RE_Root_Storage_Pool), Loc), - Name => + Name => Make_Explicit_Dereference (Loc, Prefix => Make_Function_Call (Loc, - Name => + Name => New_Reference_To (RTE (RE_Base_Pool), Loc), - Parameter_Associations => New_List ( Make_Explicit_Dereference (Loc, - Prefix => - New_Reference_To (Collect, Loc))))))); + Prefix => New_Reference_To (Collect, Loc))))))); -- Create an access type which uses the storage pool of the -- caller's collection. This additional type is necessary @@ -4493,7 +4490,7 @@ package body Exp_Ch6 is Append_To (Decls, Make_Full_Type_Declaration (Loc, Defining_Identifier => Ptr_Typ, - Type_Definition => + Type_Definition => Make_Access_To_Object_Definition (Loc, Subtype_Indication => New_Reference_To (Ret_Typ, Loc)))); @@ -4514,7 +4511,7 @@ package body Exp_Ch6 is Append_To (Decls, Make_Object_Declaration (Loc, Defining_Identifier => Local_Id, - Object_Definition => + Object_Definition => New_Reference_To (Ptr_Typ, Loc))); -- Allocate the object, generate: @@ -4523,8 +4520,7 @@ package body Exp_Ch6 is Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => - New_Reference_To (Local_Id, Loc), + Name => New_Reference_To (Local_Id, Loc), Expression => Alloc_Expr)); -- Generate: @@ -4532,8 +4528,7 @@ package body Exp_Ch6 is Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => - New_Reference_To (Temp_Id, Loc), + Name => New_Reference_To (Temp_Id, Loc), Expression => Unchecked_Convert_To (Temp_Typ, New_Reference_To (Local_Id, Loc)))); @@ -4554,16 +4549,14 @@ package body Exp_Ch6 is return Make_If_Statement (Loc, - Condition => + Condition => Make_Op_Ne (Loc, - Left_Opnd => - New_Reference_To (Collect, Loc), - Right_Opnd => - Make_Null (Loc)), + Left_Opnd => New_Reference_To (Collect, Loc), + Right_Opnd => Make_Null (Loc)), Then_Statements => New_List ( Make_Block_Statement (Loc, - Declarations => Decls, + Declarations => Decls, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts)))); @@ -4576,8 +4569,7 @@ package body Exp_Ch6 is else return Make_Assignment_Statement (Loc, - Name => - New_Reference_To (Temp_Id, Loc), + Name => New_Reference_To (Temp_Id, Loc), Expression => Alloc_Expr); end if; end Build_Heap_Allocator; @@ -4616,7 +4608,7 @@ package body Exp_Ch6 is return Make_Procedure_Call_Statement (Loc, - Name => + Name => New_Reference_To (RTE (RE_Move_Activation_Chain), Loc), Parameter_Associations => New_List (From, To, New_Master)); end Move_Activation_Chain; @@ -4666,10 +4658,9 @@ package body Exp_Ch6 is Flag_Decl := Make_Object_Declaration (Loc, Defining_Identifier => Flag_Id, - Object_Definition => - New_Reference_To (Standard_Boolean, Loc), - Expression => - New_Reference_To (Standard_False, Loc)); + Object_Definition => + New_Reference_To (Standard_Boolean, Loc), + Expression => New_Reference_To (Standard_False, Loc)); Prepend_To (Declarations (Func_Bod), Flag_Decl); Analyze (Flag_Decl); @@ -4695,7 +4686,7 @@ package body Exp_Ch6 is else Stmts := New_List ( Make_Block_Statement (Loc, - Declarations => New_List, + Declarations => New_List, Handled_Statement_Sequence => HSS)); end if; @@ -4710,7 +4701,7 @@ package body Exp_Ch6 is -- the case of result types with task parts. if Is_Build_In_Place - and Has_Task (Etype (Par_Func)) + and then Has_Task (Etype (Par_Func)) then Append_To (Stmts, Move_Activation_Chain); end if; @@ -4730,10 +4721,8 @@ package body Exp_Ch6 is Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => - New_Reference_To (Flag_Id, Loc), - Expression => - New_Reference_To (Standard_True, Loc))); + Name => New_Reference_To (Flag_Id, Loc), + Expression => New_Reference_To (Standard_True, Loc))); end; end if; @@ -4741,8 +4730,7 @@ package body Exp_Ch6 is Return_Stmt := Make_Simple_Return_Statement (Loc, - Expression => - New_Occurrence_Of (Ret_Obj_Id, Loc)); + Expression => New_Occurrence_Of (Ret_Obj_Id, Loc)); Append_To (Stmts, Return_Stmt); HSS := Make_Handled_Sequence_Of_Statements (Loc, Stmts); @@ -4753,7 +4741,7 @@ package body Exp_Ch6 is if Present (HSS) then Result := Make_Block_Statement (Loc, - Declarations => Return_Object_Declarations (N), + Declarations => Return_Object_Declarations (N), Handled_Statement_Sequence => HSS); -- We set the entity of the new block statement to be that of the @@ -4777,8 +4765,8 @@ package body Exp_Ch6 is then pragma Assert (Nkind (Original_Node (Ret_Obj_Decl)) = N_Object_Declaration - and then Is_Build_In_Place_Function_Call - (Expression (Original_Node (Ret_Obj_Decl)))); + and then Is_Build_In_Place_Function_Call + (Expression (Original_Node (Ret_Obj_Decl)))); -- Return the build-in-place result by reference @@ -4853,10 +4841,8 @@ package body Exp_Ch6 is then Init_Assignment := Make_Assignment_Statement (Loc, - Name => - New_Reference_To (Return_Obj_Id, Loc), - Expression => - Relocate_Node (Return_Obj_Expr)); + Name => New_Reference_To (Return_Obj_Id, Loc), + Expression => Relocate_Node (Return_Obj_Expr)); Set_Etype (Name (Init_Assignment), Etype (Return_Obj_Id)); Set_Assignment_OK (Name (Init_Assignment)); @@ -4875,7 +4861,7 @@ package body Exp_Ch6 is Make_Type_Conversion (Loc, Subtype_Mark => New_Occurrence_Of (Etype (Return_Obj_Id), Loc), - Expression => + Expression => Relocate_Node (Expression (Init_Assignment)))); end if; @@ -4942,9 +4928,9 @@ package body Exp_Ch6 is Ptr_Type_Decl := Make_Full_Type_Declaration (Loc, Defining_Identifier => Ref_Type, - Type_Definition => + Type_Definition => Make_Access_To_Object_Definition (Loc, - All_Present => True, + All_Present => True, Subtype_Indication => New_Reference_To (Return_Obj_Typ, Loc))); @@ -4961,7 +4947,7 @@ package body Exp_Ch6 is Alloc_Obj_Decl := Make_Object_Declaration (Loc, Defining_Identifier => Alloc_Obj_Id, - Object_Definition => + Object_Definition => New_Reference_To (Ref_Type, Loc)); Insert_Before (Ret_Obj_Decl, Alloc_Obj_Decl); @@ -4988,7 +4974,7 @@ package body Exp_Ch6 is Subtype_Mark => New_Reference_To (Etype (Return_Obj_Expr), Loc), - Expression => + Expression => New_Copy_Tree (Return_Obj_Expr))); else @@ -5089,7 +5075,7 @@ package body Exp_Ch6 is Make_If_Statement (Loc, Condition => Make_Op_Eq (Loc, - Left_Opnd => + Left_Opnd => New_Reference_To (Obj_Alloc_Formal, Loc), Right_Opnd => Make_Integer_Literal (Loc, @@ -5098,20 +5084,20 @@ package body Exp_Ch6 is Then_Statements => New_List ( Make_Assignment_Statement (Loc, - Name => + Name => New_Reference_To (Alloc_Obj_Id, Loc), Expression => Make_Unchecked_Type_Conversion (Loc, Subtype_Mark => New_Reference_To (Ref_Type, Loc), - Expression => + Expression => New_Reference_To (Object_Access, Loc)))), Elsif_Parts => New_List ( Make_Elsif_Part (Loc, Condition => Make_Op_Eq (Loc, - Left_Opnd => + Left_Opnd => New_Reference_To (Obj_Alloc_Formal, Loc), Right_Opnd => Make_Integer_Literal (Loc, @@ -5120,7 +5106,7 @@ package body Exp_Ch6 is Then_Statements => New_List ( Make_Assignment_Statement (Loc, - Name => + Name => New_Reference_To (Alloc_Obj_Id, Loc), Expression => SS_Allocator)))), @@ -5143,15 +5129,13 @@ package body Exp_Ch6 is if Present (Init_Assignment) then Rewrite (Name (Init_Assignment), Make_Explicit_Dereference (Loc, - Prefix => - New_Reference_To (Alloc_Obj_Id, Loc))); + Prefix => New_Reference_To (Alloc_Obj_Id, Loc))); Set_Etype (Name (Init_Assignment), Etype (Return_Obj_Id)); Append_To - (Then_Statements (Alloc_If_Stmt), - Init_Assignment); + (Then_Statements (Alloc_If_Stmt), Init_Assignment); end if; Insert_Before (Ret_Obj_Decl, Alloc_If_Stmt); @@ -5169,16 +5153,15 @@ package body Exp_Ch6 is Obj_Acc_Deref := Make_Explicit_Dereference (Loc, - Prefix => - New_Reference_To (Object_Access, Loc)); + Prefix => New_Reference_To (Object_Access, Loc)); Rewrite (Ret_Obj_Decl, Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Return_Obj_Id, - Access_Definition => Empty, - Subtype_Mark => + Access_Definition => Empty, + Subtype_Mark => New_Occurrence_Of (Return_Obj_Typ, Loc), - Name => Obj_Acc_Deref)); + Name => Obj_Acc_Deref)); Set_Renamed_Object (Return_Obj_Id, Obj_Acc_Deref); end; @@ -5358,10 +5341,8 @@ package body Exp_Ch6 is and then not Comes_From_Source (Parent (S)) then Loc := Sloc (Last_Stm); - elsif Present (End_Label (H)) then Loc := Sloc (End_Label (H)); - else Loc := Sloc (Last_Stm); end if; @@ -5580,8 +5561,7 @@ package body Exp_Ch6 is Set_Declarations (N, Empty_List); Set_Handled_Statement_Sequence (N, Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List ( - Make_Null_Statement (Loc)))); + Statements => New_List (Make_Null_Statement (Loc)))); return; end if; end if; @@ -5935,11 +5915,10 @@ package body Exp_Ch6 is New_Reference_To (RTE (RE_Complete_Entry_Body), Loc), Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Prefix => + Prefix => New_Reference_To (Find_Protection_Object (Current_Scope), Loc), - Attribute_Name => - Name_Unchecked_Access))); + Attribute_Name => Name_Unchecked_Access))); Insert_Before (N, Call); Analyze (Call); @@ -6020,7 +5999,7 @@ package body Exp_Ch6 is Decls := New_List ( Make_Full_Type_Declaration (Loc, Defining_Identifier => Obj_Ptr, - Type_Definition => + Type_Definition => Make_Access_To_Object_Definition (Loc, Subtype_Indication => New_Reference_To @@ -6031,8 +6010,9 @@ package body Exp_Ch6 is Rec := Make_Explicit_Dereference (Loc, - Unchecked_Convert_To (Obj_Ptr, - New_Occurrence_Of (Param, Loc))); + Prefix => + Unchecked_Convert_To (Obj_Ptr, + New_Occurrence_Of (Param, Loc))); -- Analyze new actual. Other actuals in calls are already analyzed -- and the list of actuals is not reanalyzed after rewriting. @@ -6057,14 +6037,13 @@ package body Exp_Ch6 is Rec : Node_Id; begin - -- If the protected object is not an enclosing scope, this is - -- an inter-object function call. Inter-object procedure - -- calls are expanded by Exp_Ch9.Build_Simple_Entry_Call. - -- The call is intra-object only if the subprogram being - -- called is in the protected body being compiled, and if the - -- protected object in the call is statically the enclosing type. - -- The object may be an component of some other data structure, - -- in which case this must be handled as an inter-object call. + -- If the protected object is not an enclosing scope, this is an + -- inter-object function call. Inter-object procedure calls are expanded + -- by Exp_Ch9.Build_Simple_Entry_Call. The call is intra-object only if + -- the subprogram being called is in the protected body being compiled, + -- and if the protected object in the call is statically the enclosing + -- type. The object may be an component of some other data structure, in + -- which case this must be handled as an inter-object call. if not In_Open_Scopes (Scop) or else not Is_Entity_Name (Name (N)) @@ -6078,8 +6057,8 @@ package body Exp_Ch6 is end if; Build_Protected_Subprogram_Call (N, - Name => New_Occurrence_Of (Subp, Sloc (N)), - Rec => Convert_Concurrent (Rec, Etype (Rec)), + Name => New_Occurrence_Of (Subp, Sloc (N)), + Rec => Convert_Concurrent (Rec, Etype (Rec)), External => True); else @@ -6431,15 +6410,16 @@ package body Exp_Ch6 is Make_Raise_Constraint_Error (Loc, Condition => Make_Op_Ne (Loc, - Left_Opnd => + Left_Opnd => Make_Selected_Component (Loc, Prefix => Duplicate_Subexpr (Exp), Selector_Name => Make_Identifier (Loc, Name_uTag)), Right_Opnd => Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Base_Type (Utyp), Loc), + Prefix => + New_Occurrence_Of (Base_Type (Utyp), Loc), Attribute_Name => Name_Tag)), - Reason => CE_Tag_Check_Failed)); + Reason => CE_Tag_Check_Failed)); -- If the result type is a specific nonlimited tagged type, then we -- have to ensure that the tag of the result is that of the result @@ -6494,7 +6474,7 @@ package body Exp_Ch6 is or else Nkind_In (Exp, N_Type_Conversion, N_Unchecked_Type_Conversion) or else (Is_Entity_Name (Exp) - and then Ekind (Entity (Exp)) in Formal_Kind) + and then Ekind (Entity (Exp)) in Formal_Kind) or else Scope_Depth (Enclosing_Dynamic_Scope (Etype (Exp))) > Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id))) then @@ -6512,16 +6492,18 @@ package body Exp_Ch6 is then Tag_Node := Make_Explicit_Dereference (Loc, - Unchecked_Convert_To (RTE (RE_Tag_Ptr), - Make_Function_Call (Loc, - Name => New_Reference_To (RTE (RE_Base_Address), Loc), - Parameter_Associations => New_List ( - Unchecked_Convert_To (RTE (RE_Address), - Duplicate_Subexpr (Prefix (Exp))))))); + Prefix => + Unchecked_Convert_To (RTE (RE_Tag_Ptr), + Make_Function_Call (Loc, + Name => + New_Reference_To (RTE (RE_Base_Address), Loc), + Parameter_Associations => New_List ( + Unchecked_Convert_To (RTE (RE_Address), + Duplicate_Subexpr (Prefix (Exp))))))); else Tag_Node := Make_Attribute_Reference (Loc, - Prefix => Duplicate_Subexpr (Exp), + Prefix => Duplicate_Subexpr (Exp), Attribute_Name => Name_Tag); end if; @@ -6529,8 +6511,7 @@ package body Exp_Ch6 is Make_Raise_Program_Error (Loc, Condition => Make_Op_Gt (Loc, - Left_Opnd => - Build_Get_Access_Level (Loc, Tag_Node), + Left_Opnd => Build_Get_Access_Level (Loc, Tag_Node), Right_Opnd => Make_Integer_Literal (Loc, Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id)))), @@ -6587,7 +6568,7 @@ package body Exp_Ch6 is Constant_Present => True, Object_Definition => New_Occurrence_Of (R_Type, Loc), Expression => ExpR), - Suppress => All_Checks); + Suppress => All_Checks); Rewrite (Exp, New_Occurrence_Of (Tnn, Loc)); end; end if; @@ -6612,7 +6593,7 @@ package body Exp_Ch6 is N_Integer_Literal, N_Real_Literal) or else (Nkind (Exp) = N_Explicit_Dereference - and then Is_Entity_Name (Prefix (Exp))) + and then Is_Entity_Name (Prefix (Exp))) then null; @@ -7465,9 +7446,9 @@ package body Exp_Ch6 is Ptr_Typ_Decl := Make_Full_Type_Declaration (Loc, Defining_Identifier => Ptr_Typ, - Type_Definition => + Type_Definition => Make_Access_To_Object_Definition (Loc, - All_Present => True, + All_Present => True, Subtype_Indication => New_Reference_To (Result_Subt, Loc))); Insert_After_And_Analyze (Assign, Ptr_Typ_Decl); @@ -7481,11 +7462,8 @@ package body Exp_Ch6 is Obj_Decl := Make_Object_Declaration (Loc, Defining_Identifier => Obj_Id, - Object_Definition => - New_Reference_To (Ptr_Typ, Loc), - Expression => - Make_Reference (Loc, - Prefix => Relocate_Node (Func_Call))); + Object_Definition => New_Reference_To (Ptr_Typ, Loc), + Expression => Make_Reference (Loc, Relocate_Node (Func_Call))); Insert_After_And_Analyze (Ptr_Typ_Decl, Obj_Decl); Rewrite (Assign, Make_Null_Statement (Loc)); @@ -7693,9 +7671,9 @@ package body Exp_Ch6 is Ptr_Typ_Decl := Make_Full_Type_Declaration (Loc, Defining_Identifier => Ref_Type, - Type_Definition => + Type_Definition => Make_Access_To_Object_Definition (Loc, - All_Present => True, + All_Present => True, Subtype_Indication => New_Reference_To (Etype (Function_Call), Loc))); @@ -7715,9 +7693,7 @@ package body Exp_Ch6 is -- Finally, create an access object initialized to a reference to the -- function call. - New_Expr := - Make_Reference (Loc, - Prefix => Relocate_Node (Func_Call)); + New_Expr := Make_Reference (Loc, Relocate_Node (Func_Call)); Def_Id := Make_Temporary (Loc, 'R', New_Expr); Set_Etype (Def_Id, Ref_Type); diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads index 433b96a62b7..0c50667d993 100644 --- a/gcc/ada/exp_ch6.ads +++ b/gcc/ada/exp_ch6.ads @@ -83,9 +83,9 @@ package Exp_Ch6 is -- Present for all build-in-place functions. Address at which to place -- the return object, or null if BIP_Alloc_Form indicates allocated by -- callee. - -- ??? We also need to be able to pass in some way to access a - -- user-defined storage pool at some point. And perhaps a constrained - -- flag. + -- + -- ??? We also need to be able to pass in some way to access a user- + -- defined storage pool at some point. And perhaps a constrained flag. function BIP_Formal_Suffix (Kind : BIP_Formal_Kind) return String; -- Ada 2005 (AI-318-02): Returns a string to be used as the suffix of names diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index c49cf254dee..cd17b0f1179 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -286,7 +286,6 @@ package body Exp_Ch7 is Adjust_Case => Name_Adjust, Finalize_Case => Name_Finalize, Address_Case => Name_Finalize_Address); - Deep_Name_Of : constant array (Final_Primitives) of TSS_Name_Type := (Initialize_Case => TSS_Deep_Initialize, Adjust_Case => TSS_Deep_Adjust, @@ -473,10 +472,10 @@ package body Exp_Ch7 is if VM_Target = No_VM then Set_TSS (Typ, - Make_Deep_Proc ( - Prim => Address_Case, - Typ => Typ, - Stmts => Make_Deep_Array_Body (Address_Case, Typ))); + Make_Deep_Proc + (Prim => Address_Case, + Typ => Typ, + Stmts => Make_Deep_Array_Body (Address_Case, Typ))); end if; end Build_Array_Deep_Procs; @@ -499,6 +498,7 @@ package body Exp_Ch7 is and then Is_Task_Allocation_Block (N); Is_Task_Body : constant Boolean := Nkind (Original_Node (N)) = N_Task_Body; + Loc : constant Source_Ptr := Sloc (N); Stmts : constant List_Id := New_List; @@ -569,12 +569,12 @@ package body Exp_Ch7 is Append_To (Stmts, Make_Procedure_Call_Statement (Loc, - Name => Nam, + Name => Nam, Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Prefix => + Prefix => Make_Selected_Component (Loc, - Prefix => New_Reference_To ( + Prefix => New_Reference_To ( Defining_Identifier (Param), Loc), Selector_Name => Make_Identifier (Loc, Name_uObject)), @@ -600,12 +600,12 @@ package body Exp_Ch7 is Append_To (Stmts, Make_Procedure_Call_Statement (Loc, - Name => Nam, + Name => Nam, Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Prefix => + Prefix => Make_Selected_Component (Loc, - Prefix => + Prefix => New_Reference_To (Defining_Identifier (Param), Loc), Selector_Name => @@ -619,7 +619,7 @@ package body Exp_Ch7 is if Abort_Allowed then Append_To (Stmts, Make_Procedure_Call_Statement (Loc, - Name => + Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc), Parameter_Associations => Empty_List)); end if; @@ -643,8 +643,8 @@ package body Exp_Ch7 is Append_To (Stmts, Make_Procedure_Call_Statement (Loc, Name => - New_Reference_To ( - RTE (RE_Expunge_Unactivated_Tasks), Loc), + New_Reference_To + (RTE (RE_Expunge_Unactivated_Tasks), Loc), Parameter_Associations => New_List ( New_Reference_To (Activation_Chain_Entity (N), Loc)))); @@ -671,7 +671,7 @@ package body Exp_Ch7 is Make_If_Statement (Loc, Condition => Make_Function_Call (Loc, - Name => + Name => New_Reference_To (RTE (RE_Enqueued), Loc), Parameter_Associations => New_List ( New_Reference_To (Cancel_Param, Loc))), @@ -679,8 +679,8 @@ package body Exp_Ch7 is Then_Statements => New_List ( Make_Procedure_Call_Statement (Loc, Name => - New_Reference_To ( - RTE (RE_Cancel_Protected_Entry_Call), Loc), + New_Reference_To + (RTE (RE_Cancel_Protected_Entry_Call), Loc), Parameter_Associations => New_List ( New_Reference_To (Cancel_Param, Loc)))))); @@ -690,11 +690,11 @@ package body Exp_Ch7 is elsif Is_RTE (Etype (Cancel_Param), RE_Delay_Block) then Append_To (Stmts, Make_Procedure_Call_Statement (Loc, - Name => + Name => New_Reference_To (RTE (RE_Cancel_Async_Delay), Loc), Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Prefix => + Prefix => New_Reference_To (Cancel_Param, Loc), Attribute_Name => Name_Unchecked_Access)))); @@ -704,7 +704,7 @@ package body Exp_Ch7 is else Append_To (Stmts, Make_Procedure_Call_Statement (Loc, - Name => + Name => New_Reference_To (RTE (RE_Cancel_Task_Entry_Call), Loc), Parameter_Associations => New_List ( New_Reference_To (Cancel_Param, Loc)))); @@ -723,7 +723,6 @@ package body Exp_Ch7 is begin if Is_Array_Type (Typ) then Build_Array_Deep_Procs (Typ); - else pragma Assert (Is_Record_Type (Typ)); Build_Record_Deep_Procs (Typ); end if; @@ -3298,10 +3297,9 @@ package body Exp_Ch7 is else return Make_Procedure_Call_Statement (Loc, - Name => + Name => New_Reference_To (RTE (RE_Finalize_Protection), Loc), - Parameter_Associations => - New_List (Concurrent_Ref (Ref))); + Parameter_Associations => New_List (Concurrent_Ref (Ref))); end if; end Cleanup_Protected_Object; @@ -3314,6 +3312,7 @@ package body Exp_Ch7 is Ref : Node_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (N); + begin -- For restricted run-time libraries (Ravenscar), tasks are -- non-terminating and they can only appear at library level, so we do @@ -3325,10 +3324,9 @@ package body Exp_Ch7 is else return Make_Procedure_Call_Statement (Loc, - Name => + Name => New_Reference_To (RTE (RE_Free_Task), Loc), - Parameter_Associations => - New_List (Concurrent_Ref (Ref))); + Parameter_Associations => New_List (Concurrent_Ref (Ref))); end if; end Cleanup_Task; @@ -3442,9 +3440,10 @@ package body Exp_Ch7 is ------------------------ function Enclosing_Function (E : Entity_Id) return Entity_Id is - Func_Id : Entity_Id := E; + Func_Id : Entity_Id; begin + Func_Id := E; while Present (Func_Id) and then Func_Id /= Standard_Standard loop @@ -3866,14 +3865,15 @@ package body Exp_Ch7 is -- appear. procedure Expand_N_Package_Declaration (N : Node_Id) is - Id : constant Entity_Id := Defining_Entity (N); - Spec : constant Node_Id := Specification (N); - Decls : List_Id; - Fin_Id : Entity_Id; + Id : constant Entity_Id := Defining_Entity (N); + Spec : constant Node_Id := Specification (N); + Decls : List_Id; + Fin_Id : Entity_Id; + No_Body : Boolean := False; - -- True in the case of a package declaration that is a compilation unit - -- and for which no associated body will be compiled in - -- this compilation. + -- True in the case of a package declaration that is a compilation + -- unit and for which no associated body will be compiled in this + -- compilation. begin -- Case of a package declaration other than a compilation unit @@ -3889,10 +3889,9 @@ package body Exp_Ch7 is No_Body := True; -- Special case of generating calling stubs for a remote call interface - -- package: even though the package declaration requires one, the - -- body won't be processed in this compilation (so any stubs for RACWs - -- declared in the package must be generated here, along with the - -- spec). + -- package: even though the package declaration requires one, the body + -- won't be processed in this compilation (so any stubs for RACWs + -- declared in the package must be generated here, along with the spec). elsif Parent (N) = Cunit (Main_Unit) and then Is_Remote_Call_Interface (Id) @@ -4224,9 +4223,9 @@ package body Exp_Ch7 is Before : List_Id renames SE.Actions_To_Be_Wrapped_Before; procedure Process_Transient_Objects - (First_Object : Node_Id; - Last_Object : Node_Id; - Related_Node : Node_Id); + (First_Object : Node_Id; + Last_Object : Node_Id; + Related_Node : Node_Id); -- First_Object and Last_Object define a list which contains potential -- controlled transient objects. Finalization flags are inserted before -- First_Object and finalization calls are inserted after Last_Object. @@ -4238,9 +4237,9 @@ package body Exp_Ch7 is ------------------------------- procedure Process_Transient_Objects - (First_Object : Node_Id; - Last_Object : Node_Id; - Related_Node : Node_Id) + (First_Object : Node_Id; + Last_Object : Node_Id; + Related_Node : Node_Id) is Abort_Id : Entity_Id; Built : Boolean := False; @@ -4264,8 +4263,8 @@ package body Exp_Ch7 is and then Analyzed (Stmt) and then Is_Finalizable_Transient (Stmt, N) - -- Do not process the node to be wrapped since it will be - -- handled by the enclosing finalizer. + -- Do not process the node to be wrapped since it will be + -- handled by the enclosing finalizer. and then Stmt /= Related_Node then @@ -4321,9 +4320,9 @@ package body Exp_Ch7 is Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => New_List ( - Make_Final_Call ( - Obj_Ref => Obj_Ref, - Typ => Desig)), + Make_Final_Call + (Obj_Ref => Obj_Ref, + Typ => Desig)), Exception_Handlers => New_List ( Build_Exception_Handler (Loc, E_Id, Raised_Id)))); @@ -4402,12 +4401,12 @@ package body Exp_Ch7 is -- Add all actions associated with a transient scope into the main -- tree. There are several scenarios here: - -- + -- +--- Before ----+ +----- After ---+ -- 1) First_Obj ....... Target ........ Last_Obj - -- + -- 2) First_Obj ....... Target - -- + -- 3) Target ........ Last_Obj if Present (Before) then @@ -4572,11 +4571,10 @@ package body Exp_Ch7 is Ptr_Typ : Entity_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Obj_Ref); - begin return Make_Procedure_Call_Statement (Loc, - Name => + Name => New_Reference_To (RTE (RE_Attach), Loc), Parameter_Associations => New_List ( New_Reference_To (Associated_Collection (Ptr_Typ), Loc), @@ -4593,7 +4591,7 @@ package body Exp_Ch7 is begin return Make_Procedure_Call_Statement (Loc, - Name => + Name => New_Reference_To (RTE (RE_Detach), Loc), Parameter_Associations => New_List ( Unchecked_Convert_To (RTE (RE_Root_Controlled_Ptr), Obj_Ref))); @@ -4622,8 +4620,7 @@ package body Exp_Ch7 is return Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To (Proc_Id, Loc), + Name => New_Reference_To (Proc_Id, Loc), Parameter_Associations => Params); end Make_Call; @@ -4810,29 +4807,21 @@ package body Exp_Ch7 is Comp_Ref := Make_Indexed_Component (Loc, - Prefix => - Make_Identifier (Loc, Name_V), - Expressions => - New_References_To (Index_List, Loc)); + Prefix => Make_Identifier (Loc, Name_V), + Expressions => New_References_To (Index_List, Loc)); Set_Etype (Comp_Ref, Comp_Typ); -- Generate: -- [Deep_]Adjust (V (J1, ..., JN)) if Prim = Adjust_Case then - Call := - Make_Adjust_Call ( - Obj_Ref => Comp_Ref, - Typ => Comp_Typ); + Call := Make_Adjust_Call (Obj_Ref => Comp_Ref, Typ => Comp_Typ); -- Generate: -- [Deep_]Finalize (V (J1, ..., JN)) else pragma Assert (Prim = Finalize_Case); - Call := - Make_Final_Call ( - Obj_Ref => Comp_Ref, - Typ => Comp_Typ); + Call := Make_Final_Call (Obj_Ref => Comp_Ref, Typ => Comp_Typ); end if; -- Generate the block which houses the adjust or finalize call: @@ -4855,10 +4844,9 @@ package body Exp_Ch7 is Make_Block_Statement (Loc, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Call), - - Exception_Handlers => New_List ( - Build_Exception_Handler (Loc, E_Id, Raised_Id)))); + Statements => New_List (Call), + Exception_Handlers => New_List ( + Build_Exception_Handler (Loc, E_Id, Raised_Id)))); else Core_Loop := Call; end if; @@ -4884,14 +4872,12 @@ package body Exp_Ch7 is Make_Iteration_Scheme (Loc, Loop_Parameter_Specification => Make_Loop_Parameter_Specification (Loc, - Defining_Identifier => Loop_Id, + Defining_Identifier => Loop_Id, Discrete_Subtype_Definition => Make_Attribute_Reference (Loc, - Prefix => - Make_Identifier (Loc, Name_V), - Attribute_Name => - Name_Range, - Expressions => New_List ( + Prefix => Make_Identifier (Loc, Name_V), + Attribute_Name => Name_Range, + Expressions => New_List ( Make_Integer_Literal (Loc, Dim))), Reverse_Present => Prim = Finalize_Case)), @@ -4934,11 +4920,10 @@ package body Exp_Ch7 is return New_List ( Make_Block_Statement (Loc, - Declarations => + Declarations => Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id), Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Stmts))); + Make_Handled_Sequence_Of_Statements (Loc, Stmts))); end Build_Adjust_Or_Finalize_Statements; --------------------------------- @@ -5013,15 +4998,12 @@ package body Exp_Ch7 is while Dim <= Num_Dims loop Expr := Make_Op_Multiply (Loc, - Left_Opnd => - Expr, + Left_Opnd => Expr, Right_Opnd => Make_Attribute_Reference (Loc, - Prefix => - Make_Identifier (Loc, Name_V), - Attribute_Name => - Name_Length, - Expressions => New_List ( + Prefix => Make_Identifier (Loc, Name_V), + Attribute_Name => Name_Length, + Expressions => New_List ( Make_Integer_Literal (Loc, Dim)))); Dim := Dim + 1; @@ -5032,14 +5014,11 @@ package body Exp_Ch7 is return Make_Assignment_Statement (Loc, - Name => - New_Reference_To (Counter_Id, Loc), + Name => New_Reference_To (Counter_Id, Loc), Expression => Make_Op_Subtract (Loc, - Left_Opnd => - Expr, - Right_Opnd => - New_Reference_To (Counter_Id, Loc))); + Left_Opnd => Expr, + Right_Opnd => New_Reference_To (Counter_Id, Loc))); end Build_Counter_Assignment; ----------------------------- @@ -5049,10 +5028,8 @@ package body Exp_Ch7 is function Build_Finalization_Call return Node_Id is Comp_Ref : constant Node_Id := Make_Indexed_Component (Loc, - Prefix => - Make_Identifier (Loc, Name_V), - Expressions => - New_References_To (Final_List, Loc)); + Prefix => Make_Identifier (Loc, Name_V), + Expressions => New_References_To (Final_List, Loc)); begin Set_Etype (Comp_Ref, Comp_Typ); @@ -5060,10 +5037,7 @@ package body Exp_Ch7 is -- Generate: -- [Deep_]Finalize (V); - return - Make_Final_Call ( - Obj_Ref => Comp_Ref, - Typ => Comp_Typ); + return Make_Final_Call (Obj_Ref => Comp_Ref, Typ => Comp_Typ); end Build_Finalization_Call; ------------------- @@ -5103,10 +5077,7 @@ package body Exp_Ch7 is -- Generate: -- [Deep_]Initialize (V (J1, ..., JN)); - return - Make_Init_Call ( - Obj_Ref => Comp_Ref, - Typ => Comp_Typ); + return Make_Init_Call (Obj_Ref => Comp_Ref, Typ => Comp_Typ); end Build_Initialization_Call; -- Start of processing for Build_Initialize_Statements @@ -5146,10 +5117,9 @@ package body Exp_Ch7 is Make_Block_Statement (Loc, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Build_Finalization_Call), - - Exception_Handlers => New_List ( - Build_Exception_Handler (Loc, E_Id, Raised_Id)))); + Statements => New_List (Build_Finalization_Call), + Exception_Handlers => New_List ( + Build_Exception_Handler (Loc, E_Id, Raised_Id)))); else Fin_Stmt := Build_Finalization_Call; end if; @@ -5161,21 +5131,16 @@ package body Exp_Ch7 is Make_If_Statement (Loc, Condition => Make_Op_Gt (Loc, - Left_Opnd => - New_Reference_To (Counter_Id, Loc), - Right_Opnd => - Make_Integer_Literal (Loc, 0)), + Left_Opnd => New_Reference_To (Counter_Id, Loc), + Right_Opnd => Make_Integer_Literal (Loc, 0)), Then_Statements => New_List ( Make_Assignment_Statement (Loc, - Name => - New_Reference_To (Counter_Id, Loc), + Name => New_Reference_To (Counter_Id, Loc), Expression => Make_Op_Subtract (Loc, - Left_Opnd => - New_Reference_To (Counter_Id, Loc), - Right_Opnd => - Make_Integer_Literal (Loc, 1)))), + Left_Opnd => New_Reference_To (Counter_Id, Loc), + Right_Opnd => Make_Integer_Literal (Loc, 1)))), Else_Statements => New_List (Fin_Stmt)); @@ -5204,11 +5169,9 @@ package body Exp_Ch7 is Defining_Identifier => Loop_Id, Discrete_Subtype_Definition => Make_Attribute_Reference (Loc, - Prefix => - Make_Identifier (Loc, Name_V), - Attribute_Name => - Name_Range, - Expressions => New_List ( + Prefix => Make_Identifier (Loc, Name_V), + Attribute_Name => Name_Range, + Expressions => New_List ( Make_Integer_Literal (Loc, Dim))), Reverse_Present => True)), @@ -5262,8 +5225,7 @@ package body Exp_Ch7 is Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id), Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Stmts)); + Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts)); -- Generate the block which contains the initialization call and -- the partial finalization code. @@ -5289,19 +5251,15 @@ package body Exp_Ch7 is Make_Exception_Handler (Loc, Exception_Choices => New_List ( Make_Others_Choice (Loc)), - Statements => New_List ( - Final_Block))))); + Statements => New_List (Final_Block))))); Append_To (Statements (Handled_Statement_Sequence (Init_Loop)), Make_Assignment_Statement (Loc, - Name => - New_Reference_To (Counter_Id, Loc), + Name => New_Reference_To (Counter_Id, Loc), Expression => Make_Op_Add (Loc, - Left_Opnd => - New_Reference_To (Counter_Id, Loc), - Right_Opnd => - Make_Integer_Literal (Loc, 1)))); + Left_Opnd => New_Reference_To (Counter_Id, Loc), + Right_Opnd => Make_Integer_Literal (Loc, 1)))); -- Generate all initialization loops starting from the innermost -- dimension. @@ -5355,15 +5313,13 @@ package body Exp_Ch7 is Declarations => New_List ( Make_Object_Declaration (Loc, Defining_Identifier => Counter_Id, - Object_Definition => + Object_Definition => New_Reference_To (Standard_Integer, Loc), - Expression => - Make_Integer_Literal (Loc, 0))), + Expression => Make_Integer_Literal (Loc, 0))), Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List ( - Init_Loop)))); + Statements => New_List (Init_Loop)))); end Build_Initialize_Statements; ----------------------- @@ -5423,9 +5379,8 @@ package body Exp_Ch7 is if Prim = Address_Case then Formals := New_List ( Make_Parameter_Specification (Loc, - Make_Defining_Identifier (Loc, Name_V), - Parameter_Type => - New_Reference_To (RTE (RE_Address), Loc))); + Defining_Identifier => Make_Defining_Identifier (Loc, Name_V), + Parameter_Type => New_Reference_To (RTE (RE_Address), Loc))); -- Default case @@ -5434,12 +5389,10 @@ package body Exp_Ch7 is Formals := New_List ( Make_Parameter_Specification (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_V), - In_Present => True, - Out_Present => True, - Parameter_Type => - New_Reference_To (Typ, Loc))); + Defining_Identifier => Make_Defining_Identifier (Loc, Name_V), + In_Present => True, + Out_Present => True, + Parameter_Type => New_Reference_To (Typ, Loc))); -- F : Boolean := True @@ -5448,11 +5401,10 @@ package body Exp_Ch7 is then Append_To (Formals, Make_Parameter_Specification (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_F), - Parameter_Type => + Defining_Identifier => Make_Defining_Identifier (Loc, Name_F), + Parameter_Type => New_Reference_To (Standard_Boolean, Loc), - Expression => + Expression => New_Reference_To (Standard_True, Loc))); end if; end if; @@ -5486,8 +5438,7 @@ package body Exp_Ch7 is Declarations => Empty_List, Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Stmts))); + Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts))); return Proc_Id; end Make_Deep_Proc; @@ -5827,7 +5778,7 @@ package body Exp_Ch7 is Make_Case_Statement_Alternative (Loc, Discrete_Choices => New_Copy_List (Discrete_Choices (Var)), - Statements => + Statements => Process_Component_List_For_Adjust ( Component_List (Var)))); @@ -5847,11 +5798,10 @@ package body Exp_Ch7 is Make_Case_Statement (Loc, Expression => Make_Selected_Component (Loc, - Prefix => - Make_Identifier (Loc, Name_V), + Prefix => Make_Identifier (Loc, Name_V), Selector_Name => Make_Identifier (Loc, - Chars (Name (Variant_Part (Comps))))), + Chars => Chars (Name (Variant_Part (Comps))))), Alternatives => Var_Alts); end; end if; @@ -5943,15 +5893,14 @@ package body Exp_Ch7 is begin if Needs_Finalization (Par_Typ) then Call := - Make_Adjust_Call ( - Obj_Ref => - Make_Selected_Component (Loc, - Prefix => - Make_Identifier (Loc, Name_V), - Selector_Name => - Make_Identifier (Loc, Name_uParent)), - Typ => Par_Typ, - For_Parent => True); + Make_Adjust_Call + (Obj_Ref => + Make_Selected_Component (Loc, + Prefix => Make_Identifier (Loc, Name_V), + Selector_Name => + Make_Identifier (Loc, Name_uParent)), + Typ => Par_Typ, + For_Parent => True); -- Generate: -- Deep_Adjust (V._parent, False); -- No_Except_Propagat @@ -5975,8 +5924,7 @@ package body Exp_Ch7 is Make_Block_Statement (Loc, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Adj_Stmt), - + Statements => New_List (Adj_Stmt), Exception_Handlers => New_List ( Build_Exception_Handler (Loc, E_Id, Raised_Id)))); @@ -6018,8 +5966,7 @@ package body Exp_Ch7 is if Present (Proc) then Adj_Stmt := Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To (Proc, Loc), + Name => New_Reference_To (Proc, Loc), Parameter_Associations => New_List ( Make_Identifier (Loc, Name_V))); @@ -6028,8 +5975,7 @@ package body Exp_Ch7 is Make_Block_Statement (Loc, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Adj_Stmt), - + Statements => New_List (Adj_Stmt), Exception_Handlers => New_List ( Build_Exception_Handler (Loc, E_Id, Raised_Id)))); @@ -6037,8 +5983,7 @@ package body Exp_Ch7 is Append_To (Bod_Stmts, Make_If_Statement (Loc, - Condition => - Make_Identifier (Loc, Name_F), + Condition => Make_Identifier (Loc, Name_F), Then_Statements => New_List (Adj_Stmt))); end if; end; @@ -6082,12 +6027,10 @@ package body Exp_Ch7 is return New_List ( Make_Block_Statement (Loc, - Declarations => + Declarations => Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id), - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Bod_Stmts))); + Make_Handled_Sequence_Of_Statements (Loc, Bod_Stmts))); end if; end Build_Adjust_Statements; @@ -6180,7 +6123,7 @@ package body Exp_Ch7 is Append_To (Decls, Make_Implicit_Label_Declaration (Loc, Defining_Identifier => Entity (Label_Id), - Label_Construct => Label)); + Label_Construct => Label)); -- Generate: -- when N => @@ -6223,22 +6166,19 @@ package body Exp_Ch7 is -- end; Fin_Stmt := - Make_Final_Call ( - Obj_Ref => - Make_Selected_Component (Loc, - Prefix => - Make_Identifier (Loc, Name_V), - Selector_Name => - Make_Identifier (Loc, Chars (Id))), - Typ => Typ); + Make_Final_Call + (Obj_Ref => + Make_Selected_Component (Loc, + Prefix => Make_Identifier (Loc, Name_V), + Selector_Name => Make_Identifier (Loc, Chars (Id))), + Typ => Typ); if not Restriction_Active (No_Exception_Propagation) then Fin_Stmt := Make_Block_Statement (Loc, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Fin_Stmt), - + Statements => New_List (Fin_Stmt), Exception_Handlers => New_List ( Build_Exception_Handler (Loc, E_Id, Raised_Id)))); end if; @@ -6461,10 +6401,9 @@ package body Exp_Ch7 is Jump_Block := Make_Block_Statement (Loc, - Declarations => Decls, + Declarations => Decls, Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Stmts)); + Make_Handled_Sequence_Of_Statements (Loc, Stmts)); if Present (Var_Case) then return New_List (Var_Case, Jump_Block); @@ -6544,15 +6483,14 @@ package body Exp_Ch7 is begin if Needs_Finalization (Par_Typ) then Call := - Make_Final_Call ( - Obj_Ref => - Make_Selected_Component (Loc, - Prefix => - Make_Identifier (Loc, Name_V), - Selector_Name => - Make_Identifier (Loc, Name_uParent)), - Typ => Par_Typ, - For_Parent => True); + Make_Final_Call + (Obj_Ref => + Make_Selected_Component (Loc, + Prefix => Make_Identifier (Loc, Name_V), + Selector_Name => + Make_Identifier (Loc, Name_uParent)), + Typ => Par_Typ, + For_Parent => True); -- Generate: -- Deep_Finalize (V._parent, False); -- No_Except_Propag @@ -6576,8 +6514,7 @@ package body Exp_Ch7 is Make_Block_Statement (Loc, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Fin_Stmt), - + Statements => New_List (Fin_Stmt), Exception_Handlers => New_List ( Build_Exception_Handler (Loc, E_Id, Raised_Id)))); @@ -6621,8 +6558,7 @@ package body Exp_Ch7 is if Present (Proc) then Fin_Stmt := Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To (Proc, Loc), + Name => New_Reference_To (Proc, Loc), Parameter_Associations => New_List ( Make_Identifier (Loc, Name_V))); @@ -6631,8 +6567,7 @@ package body Exp_Ch7 is Make_Block_Statement (Loc, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Fin_Stmt), - + Statements => New_List (Fin_Stmt), Exception_Handlers => New_List ( Build_Exception_Handler (Loc, E_Id, Raised_Id)))); @@ -6640,8 +6575,7 @@ package body Exp_Ch7 is Prepend_To (Bod_Stmts, Make_If_Statement (Loc, - Condition => - Make_Identifier (Loc, Name_F), + Condition => Make_Identifier (Loc, Name_F), Then_Statements => New_List (Fin_Stmt))); end if; end; @@ -6686,12 +6620,10 @@ package body Exp_Ch7 is return New_List ( Make_Block_Statement (Loc, - Declarations => + Declarations => Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id), - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Bod_Stmts))); + Make_Handled_Sequence_Of_Statements (Loc, Bod_Stmts))); end if; end Build_Finalize_Statements; @@ -6778,10 +6710,9 @@ package body Exp_Ch7 is if Is_Controlled (Typ) then return New_List ( Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To ( - Find_Prim_Op (Typ, Name_Of (Prim)), Loc), - + Name => + New_Reference_To + (Find_Prim_Op (Typ, Name_Of (Prim)), Loc), Parameter_Associations => New_List ( Make_Identifier (Loc, Name_V)))); else @@ -7044,8 +6975,8 @@ package body Exp_Ch7 is elsif Is_Class_Wide_Type (Typ) and then Has_Discriminants (Root_Type (Typ)) - and then not Is_Empty_Elmt_List ( - Discriminant_Constraint (Root_Type (Typ))) + and then not + Is_Empty_Elmt_List (Discriminant_Constraint (Root_Type (Typ))) then declare Parent_Typ : Entity_Id := Root_Type (Typ); @@ -7055,8 +6986,8 @@ package body Exp_Ch7 is while Parent_Typ /= Etype (Parent_Typ) and then Has_Discriminants (Parent_Typ) - and then not Is_Empty_Elmt_List ( - Discriminant_Constraint (Parent_Typ)) + and then not + Is_Empty_Elmt_List (Discriminant_Constraint (Parent_Typ)) loop Parent_Typ := Etype (Parent_Typ); end loop; @@ -7091,11 +7022,9 @@ package body Exp_Ch7 is New_Reference_To (Desg_Typ, Loc))), Make_Attribute_Definition_Clause (Loc, - Name => - New_Reference_To (Ptr_Typ, Loc), - Chars => Name_Storage_Size, - Expression => - Make_Integer_Literal (Loc, 0))); + Name => New_Reference_To (Ptr_Typ, Loc), + Chars => Name_Storage_Size, + Expression => Make_Integer_Literal (Loc, 0))); Obj_Expr := Make_Identifier (Loc, Name_V); @@ -7127,11 +7056,10 @@ package body Exp_Ch7 is begin return Make_Op_Multiply (Loc, - Left_Opnd => - Make_Integer_Literal (Loc, 2), + Left_Opnd => Make_Integer_Literal (Loc, 2), Right_Opnd => Make_Op_Divide (Loc, - Left_Opnd => + Left_Opnd => Make_Integer_Literal (Loc, Esize (Typ)), Right_Opnd => Make_Integer_Literal (Loc, System_Storage_Unit))); @@ -7146,9 +7074,8 @@ package body Exp_Ch7 is Append_To (Decls, Make_Attribute_Definition_Clause (Loc, - Name => - New_Reference_To (Ptr_Typ, Loc), - Chars => Name_Size, + Name => New_Reference_To (Ptr_Typ, Loc), + Chars => Name_Size, Expression => Make_Integer_Literal (Loc, System_Address_Size))); @@ -7172,10 +7099,8 @@ package body Exp_Ch7 is else Dope_Expr := Make_Op_Add (Loc, - Left_Opnd => - Dope_Expr, - Right_Opnd => - Bounds_Size_Expression (Etype (Index))); + Left_Opnd => Dope_Expr, + Right_Opnd => Bounds_Size_Expression (Etype (Index))); end if; Next_Index (Index); @@ -7189,10 +7114,10 @@ package body Exp_Ch7 is Append_To (Decls, Make_Object_Declaration (Loc, Defining_Identifier => Dope_Id, - Constant_Present => True, - Object_Definition => + Constant_Present => True, + Object_Definition => New_Reference_To (RTE (RE_Storage_Offset), Loc), - Expression => Dope_Expr)); + Expression => Dope_Expr)); -- Shift the address from the start of the dope vector to the -- start of the elements: @@ -7204,7 +7129,7 @@ package body Exp_Ch7 is Obj_Expr := Make_Function_Call (Loc, - Name => + Name => New_Reference_To (RTE (RE_Add_Offset_To_Address), Loc), Parameter_Associations => New_List ( Obj_Expr, @@ -7224,8 +7149,7 @@ package body Exp_Ch7 is Make_Final_Call ( Obj_Ref => Make_Explicit_Dereference (Loc, - Prefix => - Unchecked_Convert_To (Ptr_Typ, Obj_Expr)), + Prefix => Unchecked_Convert_To (Ptr_Typ, Obj_Expr)), Typ => Desg_Typ))))); end Make_Finalize_Address_Stmts; @@ -7262,7 +7186,7 @@ package body Exp_Ch7 is E_Occ := Make_Defining_Identifier (Loc, Name_E); Raise_Node := Make_Procedure_Call_Statement (Loc, - Name => + Name => New_Reference_To (RTE (RE_Reraise_Occurrence), Loc), Parameter_Associations => New_List ( New_Reference_To (E_Occ, Loc))); @@ -7275,7 +7199,7 @@ package body Exp_Ch7 is E_Occ := Make_Defining_Identifier (Loc, Name_E); Raise_Node := Make_Procedure_Call_Statement (Loc, - Name => + Name => New_Reference_To (RTE (RE_Raise_From_Controlled_Operation), Loc), Parameter_Associations => New_List ( @@ -7364,7 +7288,6 @@ package body Exp_Ch7 is if Has_Controlled_Component (Utyp) then Proc := TSS (Utyp, Deep_Name_Of (Initialize_Case)); - else Proc := Find_Prim_Op (Utyp, Name_Of (Initialize_Case)); Check_Visibly_Controlled (Initialize_Case, Typ, Proc, Ref); @@ -7402,22 +7325,17 @@ package body Exp_Ch7 is -- V : in out Typ Make_Parameter_Specification (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_V), - In_Present => True, - Out_Present => True, - Parameter_Type => - New_Reference_To (Typ, Loc)), + Defining_Identifier => Make_Defining_Identifier (Loc, Name_V), + In_Present => True, + Out_Present => True, + Parameter_Type => New_Reference_To (Typ, Loc)), -- F : Boolean := True Make_Parameter_Specification (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_F), - Parameter_Type => - New_Reference_To (Standard_Boolean, Loc), - Expression => - New_Reference_To (Standard_True, Loc))); + Defining_Identifier => Make_Defining_Identifier (Loc, Name_F), + Parameter_Type => New_Reference_To (Standard_Boolean, Loc), + Expression => New_Reference_To (Standard_True, Loc))); -- Add the necessary number of counters to represent the initialization -- state of an object. @@ -7426,15 +7344,14 @@ package body Exp_Ch7 is Make_Subprogram_Body (Loc, Specification => Make_Procedure_Specification (Loc, - Defining_Unit_Name => Nam, + Defining_Unit_Name => Nam, Parameter_Specifications => Formals), Declarations => No_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => - Make_Deep_Record_Body (Finalize_Case, Typ, True))); + Statements => Make_Deep_Record_Body (Finalize_Case, Typ, True))); end Make_Local_Deep_Finalize; ---------------------------------------- @@ -7507,14 +7424,14 @@ package body Exp_Ch7 is return Make_Procedure_Call_Statement (Loc, - Name => + Name => New_Reference_To (RTE (RE_Set_Finalize_Address_Ptr), Loc), Parameter_Associations => New_List ( New_Reference_To (Associated_Collection (Ptr_Typ), Loc), Make_Attribute_Reference (Loc, - Prefix => + Prefix => New_Reference_To (TSS (Utyp, TSS_Finalize_Address), Loc), Attribute_Name => Name_Unrestricted_Access))); end Make_Set_Finalize_Address_Ptr_Call; @@ -7596,13 +7513,11 @@ package body Exp_Ch7 is Block := Make_Block_Statement (Loc, - Identifier => - New_Reference_To (Current_Scope, Loc), - Declarations => Decls, + Identifier => New_Reference_To (Current_Scope, Loc), + Declarations => Decls, Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Instrs), - Has_Created_Identifier => True); + Make_Handled_Sequence_Of_Statements (Loc, Statements => Instrs), + Has_Created_Identifier => True); Set_Parent (Block, Par); -- Insert actions stuck in the transient scopes as well as all freezing @@ -7786,15 +7701,14 @@ package body Exp_Ch7 is Insert_Actions (N, New_List ( Make_Object_Declaration (Loc, Defining_Identifier => Temp, - Object_Definition => - New_Reference_To (Typ, Loc)), + Object_Definition => New_Reference_To (Typ, Loc)), Make_Transient_Block (Loc, Action => Make_Assignment_Statement (Loc, Name => New_Reference_To (Temp, Loc), Expression => Expr), - Par => Parent (N)))); + Par => Parent (N)))); Rewrite (N, New_Reference_To (Temp, Loc)); Analyze_And_Resolve (N, Typ); diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads index dd1b8f88fc8..08c3734fdd7 100644 --- a/gcc/ada/exp_ch7.ads +++ b/gcc/ada/exp_ch7.ads @@ -119,7 +119,7 @@ package Exp_Ch7 is -- Create a call to prepend an object to a finalization collection. Obj_Ref -- is the object, Ptr_Typ is the access type that owns the collection. -- Generate the following: - + -- -- Ada.Finalization.Heap_Managment.Attach -- (FC, -- System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref)); @@ -127,7 +127,7 @@ package Exp_Ch7 is function Make_Detach_Call (Obj_Ref : Node_Id) return Node_Id; -- Create a call to unhook an object from an arbitrary list. Obj_Ref is the -- object. Generate the following: - + -- -- Ada.Finalization.Heap_Management.Detach -- (System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref)); diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 60c24685337..af06000216b 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -6558,10 +6558,10 @@ package body Exp_Dist is Make_Component_Association (Loc, Choices => New_List (Make_Identifier (Loc, Name_Ras)), Expression => - PolyORB_Support.Helpers.Build_From_Any_Call ( - Underlying_RACW_Type (RAS_Type), - New_Occurrence_Of (Any_Parameter, Loc), - No_List)))))); + PolyORB_Support.Helpers.Build_From_Any_Call + (Underlying_RACW_Type (RAS_Type), + New_Occurrence_Of (Any_Parameter, Loc), + No_List)))))); Func_Spec := Make_Function_Specification (Loc, @@ -10321,7 +10321,8 @@ package body Exp_Dist is begin Append_To (Parameter_List, Make_Function_Call (Loc, - Name => New_Occurrence_Of (RTE (RE_TA_I32), Loc), + Name => + New_Occurrence_Of (RTE (RE_TA_I32), Loc), Parameter_Associations => New_List (Expr_Node))); end Add_Long_Parameter; diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index 0f365e29fe9..28e97c51056 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -202,35 +202,34 @@ package body Exp_Strm is Odecl := Make_Object_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_V), - Object_Definition => + Object_Definition => New_Occurrence_Of (Stream_Base_Type (Typ), Loc)); else Odecl := Make_Object_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_V), - Object_Definition => + Object_Definition => Make_Subtype_Indication (Loc, Subtype_Mark => New_Occurrence_Of (Stream_Base_Type (Typ), Loc), - Constraint => - Make_Index_Or_Discriminant_Constraint (Loc, - Constraints => Ranges))); + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, Ranges))); end if; - Rstmt := Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Typ, Loc), - Attribute_Name => Name_Read, - Expressions => New_List ( - Make_Identifier (Loc, Name_S), - Make_Identifier (Loc, Name_V))); + Rstmt := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Typ, Loc), + Attribute_Name => Name_Read, + Expressions => New_List ( + Make_Identifier (Loc, Name_S), + Make_Identifier (Loc, Name_V))); if Ada_Version >= Ada_2005 then Stms := New_List ( Make_Extended_Return_Statement (Loc, Return_Object_Declarations => New_List (Odecl), Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - New_List (Rstmt)))); + Make_Handled_Sequence_Of_Statements (Loc, New_List (Rstmt)))); else -- pragma Assert (not Is_Limited_Type (Typ)); -- Returning a local object, shouldn't happen in the case of a @@ -1200,10 +1199,9 @@ package body Exp_Strm is Make_Handled_Sequence_Of_Statements (Loc, Statements => New_List ( Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Typ, Loc), + Prefix => New_Occurrence_Of (Typ, Loc), Attribute_Name => Name_Read, - Expressions => New_List ( + Expressions => New_List ( Make_Identifier (Loc, Name_S), Make_Identifier (Loc, Name_V))))))); else diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index cc4502ed289..5cade6c8e28 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -338,24 +338,23 @@ package body Exp_Util is ----------------- function Find_Object (E : Node_Id) return Node_Id is - Expr : Node_Id := E; - Change : Boolean := True; + Expr : Node_Id; begin pragma Assert (Is_Allocate); - while Change loop - Change := False; - + Expr := E; + loop if Nkind_In (Expr, N_Qualified_Expression, N_Unchecked_Type_Conversion) then - Expr := Expression (Expr); - Change := True; + Expr := Expression (Expr); elsif Nkind (Expr) = N_Explicit_Dereference then - Expr := Prefix (Expr); - Change := True; + Expr := Prefix (Expr); + + else + exit; end if; end loop; @@ -4393,7 +4392,6 @@ package body Exp_Util is function Is_Related_To_Func_Return (Id : Entity_Id) return Boolean is Expr : constant Node_Id := Related_Expression (Id); - begin return Present (Expr) diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index e9b373d0e3f..08ffc75208d 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -484,13 +484,11 @@ package Exp_Util is -- Return the stream size value of the subtype E function Has_Access_Constraint (E : Entity_Id) return Boolean; - -- Given object or type E, determine whether a discriminant is of an access - -- type. + -- Given object or type E, determine if a discriminant is of an access type function Has_Controlled_Objects (N : Node_Id) return Boolean; - -- Given an arbitrary node N, determine whether it has a declarative or a - -- statement part and whether those lists contain at least one controlled - -- object. + -- Given a node N, determine if it has a declarative or a statement part + -- and whether those lists contain at least one controlled object. function Has_Controlled_Objects (L : List_Id; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index cec09edc30f..c6da2c9041c 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1190,6 +1190,7 @@ package body Freeze is Set_Expression (Par, New_Occurrence_Of (Temp, Loc)); return True; + else return False; end if; @@ -2726,24 +2727,24 @@ package body Freeze is if Has_Foreign_Convention (E) - -- We are looking for a return of unconstrained array + -- We are looking for a return of unconstrained array and then Is_Array_Type (R_Type) and then not Is_Constrained (R_Type) - -- Exclude imported routines, the warning does not - -- belong on the import, but rather on the routine - -- definition. + -- Exclude imported routines, the warning does not + -- belong on the import, but rather on the routine + -- definition. and then not Is_Imported (E) - -- Exclude VM case, since both .NET and JVM can handle - -- return of unconstrained arrays without a problem. + -- Exclude VM case, since both .NET and JVM can handle + -- return of unconstrained arrays without a problem. and then VM_Target = No_VM - -- Check that general warning is enabled, and that it - -- is not suppressed for this particular case. + -- Check that general warning is enabled, and that it + -- is not suppressed for this particular case. and then Warn_On_Export_Import and then not Has_Warnings_Off (E) @@ -3920,7 +3921,7 @@ package body Freeze is if Is_Pure_Unit_Access_Type (E) and then (Ada_Version < Ada_2005 - or else not No_Pool_Assigned (E)) + or else not No_Pool_Assigned (E)) then Error_Msg_N ("named access type not allowed in pure unit", E); @@ -5449,8 +5450,8 @@ package body Freeze is elsif Is_Array_Type (Retype) and then not Is_Constrained (Retype) - -- Exclude cases where descriptor mechanism is set, since the - -- VMS descriptor mechanisms allow such unconstrained returns. + -- Exclude cases where descriptor mechanism is set, since the + -- VMS descriptor mechanisms allow such unconstrained returns. and then Mechanism (E) not in Descriptor_Codes @@ -5459,8 +5460,8 @@ package body Freeze is and then Warn_On_Export_Import - -- Exclude the VM case, since return of unconstrained arrays - -- is properly handled in both the JVM and .NET cases. + -- Exclude the VM case, since return of unconstrained arrays + -- is properly handled in both the JVM and .NET cases. and then VM_Target = No_VM then @@ -5724,15 +5725,14 @@ package body Freeze is Declarations => New_List ( Make_Object_Declaration (Loc, - Defining_Identifier => - Make_Temporary (Loc, 'T'), - Object_Definition => + Defining_Identifier => Make_Temporary (Loc, 'T'), + Object_Definition => New_Occurrence_Of (Etype (Formal), Loc), - Expression => New_Copy_Tree (Dcopy))), + Expression => New_Copy_Tree (Dcopy))), Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List)); + Statements => Empty_List)); Set_Scope (Dnam, Scope (E)); Set_Assignment_OK (First (Declarations (Dbody))); diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb index 51321b56694..b4d322ce16b 100644 --- a/gcc/ada/g-comlin.adb +++ b/gcc/ada/g-comlin.adb @@ -200,8 +200,8 @@ package body GNAT.Command_Line is (Config : Command_Line_Configuration; Section : String); -- Iterate over all switches defined in Config, for a specific section. - -- Index is set to the index in Config.Switches. - -- Stop iterating when Callback returns False. + -- Index is set to the index in Config.Switches. Stop iterating when + -- Callback returns False. -------------- -- Argument -- @@ -1598,12 +1598,15 @@ package body GNAT.Command_Line is loop begin if Cmd.Config /= null then + -- Do not use Getopt_Description in this case. Otherwise, -- if we have defined a prefix -gnaty, and two switches -- -gnatya and -gnatyL!, we would have a different behavior -- depending on the order of switches: + -- -gnatyL1a => -gnatyL with argument "1a" -- -gnatyaL1 => -gnatya and -gnatyL with argument "1" + -- This is because the call to Getopt below knows nothing -- about prefixes, and in the first case finds a valid -- switch with arguments, so returns it without analyzing @@ -1613,6 +1616,7 @@ package body GNAT.Command_Line is S := Getopt (Switches => "*", Concatenate => False, Parser => Parser); + else S := Getopt (Switches => "* " & Getopt_Description, Concatenate => False, @@ -1622,9 +1626,8 @@ package body GNAT.Command_Line is exit when S = ASCII.NUL; declare - Sw : constant String := - Real_Full_Switch (S, Parser); - Is_Section : Boolean := False; + Sw : constant String := Real_Full_Switch (S, Parser); + Is_Section : Boolean := False; begin if Cmd.Config /= null @@ -1797,29 +1800,30 @@ package body GNAT.Command_Line is is pragma Unreferenced (Index); - Full : constant String := Prefix & Group (Idx .. Group'Last); + Full : constant String := Prefix & Group (Idx .. Group'Last); - Sw : constant String := Actual_Switch (Switch); + Sw : constant String := Actual_Switch (Switch); -- Switches definition minus argument definition Last : Natural; Param : Natural; begin - if - -- Verify that sw starts with Prefix - Looking_At (Sw, Sw'First, Prefix) + -- Verify that sw starts with Prefix - -- Verify that the group starts with sw - and then Looking_At (Full, Full'First, Sw) + if Looking_At (Sw, Sw'First, Prefix) + + -- Verify that the group starts with sw + and then Looking_At (Full, Full'First, Sw) then Last := Idx + Sw'Length - Prefix'Length - 1; Param := Last + 1; if Can_Have_Parameter (Switch) then - -- Include potential parameter to the recursive call. - -- Only numbers are allowed. + + -- Include potential parameter to the recursive call. Only + -- numbers are allowed. while Last < Group'Last and then Group (Last + 1) in '0' .. '9' @@ -1865,6 +1869,7 @@ package body GNAT.Command_Line is return False; end if; end if; + return True; end Analyze_Simple_Switch; @@ -2019,6 +2024,7 @@ package body GNAT.Command_Line is -- results with or without this call. Foreach_In_Config (Config, Section); + if Found_In_Config then return; end if; @@ -2053,8 +2059,8 @@ package body GNAT.Command_Line is if Config /= null and then Config.Prefixes /= null then for P in Config.Prefixes'Range loop if Switch'Length > Config.Prefixes (P)'Length + 1 - and then Looking_At - (Switch, Switch'First, Config.Prefixes (P).all) + and then + Looking_At (Switch, Switch'First, Config.Prefixes (P).all) then -- Alias expansion will be done recursively @@ -2076,6 +2082,7 @@ package body GNAT.Command_Line is then -- Recursive calls already done on each switch of the group: -- Return without executing Callback. + return; end if; end if; @@ -2091,6 +2098,7 @@ package body GNAT.Command_Line is then Found_In_Config := False; Foreach_Starts_With (Config, Section); + if Found_In_Config then return; end if; diff --git a/gcc/ada/g-comlin.ads b/gcc/ada/g-comlin.ads index 0544854d52e..590eab61923 100644 --- a/gcc/ada/g-comlin.ads +++ b/gcc/ada/g-comlin.ads @@ -583,6 +583,7 @@ package GNAT.Command_Line is -- assumed that the remainder of the switch ("uv") is a set of characters -- whose order is irrelevant. In fact, this package will sort them -- alphabetically. + -- -- When grouping switches that accept arguments (for instance "-gnatyL!" -- as the definition, and "-gnatyaL12b" as the command line), only -- numerical arguments are accepted. The above is equivalent to @@ -772,9 +773,9 @@ package GNAT.Command_Line is Config : Command_Line_Configuration); function Get_Configuration (Cmd : Command_Line) return Command_Line_Configuration; - -- Set or retrieve the configuration used for that command line. - -- The Config must have been initialized first, by calling one of the - -- Define_Switches subprograms. + -- Set or retrieve the configuration used for that command line. The Config + -- must have been initialized first, by calling one of the Define_Switches + -- subprograms. procedure Set_Command_Line (Cmd : in out Command_Line; @@ -786,9 +787,9 @@ package GNAT.Command_Line is -- -- The parsing of Switches is done through calls to Getopt, by passing -- Getopt_Description as an argument. (A "*" is automatically prepended so - -- that all switches and command line arguments are accepted). - -- If a config was defined via Set_Configuration, the Getopt_Description - -- parameter will be ignored. + -- that all switches and command line arguments are accepted). If a config + -- was defined via Set_Configuration, the Getopt_Description parameter will + -- be ignored. -- -- To properly handle switches that take parameters, you should document -- them in Getopt_Description. Otherwise, the switch and its parameter will diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index f858c8a5c4a..d00f03b1238 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -1291,8 +1291,9 @@ procedure GNATCmd is begin Makeutl.Test_If_Relative_Path (Switch, Parent, - Do_Fail => Osint.Fail'Access, - Including_Non_Switch => False, Including_RTS => True); + Do_Fail => Osint.Fail'Access, + Including_Non_Switch => False, + Including_RTS => True); end Test_If_Relative_Path; ------------------- diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb index d325df5ba04..b650d389809 100644 --- a/gcc/ada/lib-xref-alfa.adb +++ b/gcc/ada/lib-xref-alfa.adb @@ -158,23 +158,38 @@ package body ALFA is -- Filter table Xrefs to add all references used in ALFA to the table -- ALFA_Xref_Table. + procedure Detect_And_Add_ALFA_Scope (N : Node_Id); + -- Call Add_ALFA_Scope on scopes + function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range; -- Hash function for hash table - procedure Traverse_Declarations_Or_Statements (L : List_Id); - procedure Traverse_Handled_Statement_Sequence (N : Node_Id); - procedure Traverse_Package_Body (N : Node_Id); - procedure Traverse_Package_Declaration (N : Node_Id); - procedure Traverse_Subprogram_Body (N : Node_Id); - -- Traverse the corresponding construct, generating ALFA scope table - -- entries. + procedure Traverse_Compilation_Unit + (CU : Node_Id; + Process : Node_Processing); + procedure Traverse_Declarations_Or_Statements + (L : List_Id; + Process : Node_Processing); + procedure Traverse_Handled_Statement_Sequence + (N : Node_Id; + Process : Node_Processing); + procedure Traverse_Package_Body + (N : Node_Id; + Process : Node_Processing); + procedure Traverse_Package_Declaration + (N : Node_Id; + Process : Node_Processing); + procedure Traverse_Subprogram_Body + (N : Node_Id; + Process : Node_Processing); + -- Traverse the corresponding constructs, calling Process on all + -- declarations. ------------------- -- Add_ALFA_File -- ------------------- procedure Add_ALFA_File (U : Unit_Number_Type; D : Nat) is - Lu : Node_Id; From : Scope_Index; S : constant Source_File_Index := Source_Index (U); @@ -189,44 +204,7 @@ package body ALFA is From := ALFA_Scope_Table.Last + 1; - -- Get Unit (checking case of subunit) - - Lu := Unit (Cunit (U)); - - if Nkind (Lu) = N_Subunit then - Lu := Proper_Body (Lu); - end if; - - -- Traverse the unit - - if Nkind (Lu) = N_Subprogram_Body then - Traverse_Subprogram_Body (Lu); - - elsif Nkind (Lu) = N_Subprogram_Declaration then - Add_ALFA_Scope (Lu); - - elsif Nkind (Lu) = N_Package_Declaration then - Traverse_Package_Declaration (Lu); - - elsif Nkind (Lu) = N_Package_Body then - Traverse_Package_Body (Lu); - - -- ??? TBD - - elsif Nkind (Lu) = N_Generic_Package_Declaration then - null; - - -- ??? TBD - - elsif Nkind (Lu) in N_Generic_Instantiation then - null; - - -- All other cases of compilation units (e.g. renamings), generate - -- no ALFA information. - - else - null; - end if; + Traverse_Compilation_Unit (Cunit (U), Detect_And_Add_ALFA_Scope'Access); -- Update scope numbers @@ -860,6 +838,21 @@ package body ALFA is Add_ALFA_Xrefs; end Collect_ALFA; + ------------------------------- + -- Detect_And_Add_ALFA_Scope -- + ------------------------------- + + procedure Detect_And_Add_ALFA_Scope (N : Node_Id) is + begin + if Nkind_In (N, N_Subprogram_Declaration, + N_Subprogram_Body, + N_Package_Declaration, + N_Package_Body) + then + Add_ALFA_Scope (N); + end if; + end Detect_And_Add_ALFA_Scope; + ----------------- -- Entity_Hash -- ----------------- @@ -870,11 +863,84 @@ package body ALFA is Entity_Hashed_Range (E mod (Entity_Id (Entity_Hashed_Range'Last) + 1)); end Entity_Hash; + ------------------------------------ + -- Traverse_All_Compilation_Units -- + ------------------------------------ + + procedure Traverse_All_Compilation_Units (Process : Node_Processing) is + begin + for U in Units.First .. Last_Unit loop + Traverse_Compilation_Unit (Cunit (U), Process); + end loop; + end Traverse_All_Compilation_Units; + + ------------------------------- + -- Traverse_Compilation_Unit -- + ------------------------------- + + procedure Traverse_Compilation_Unit + (CU : Node_Id; + Process : Node_Processing) + is + Lu : Node_Id; + + begin + -- Get Unit (checking case of subunit) + + Lu := Unit (CU); + + if Nkind (Lu) = N_Subunit then + Lu := Proper_Body (Lu); + end if; + + -- Call Process on all declarations + + if Nkind (Lu) in N_Declaration + or else Nkind (Lu) in N_Later_Decl_Item + then + Process (Lu); + end if; + + -- Traverse the unit + + if Nkind (Lu) = N_Subprogram_Body then + Traverse_Subprogram_Body (Lu, Process); + + elsif Nkind (Lu) = N_Subprogram_Declaration then + null; + + elsif Nkind (Lu) = N_Package_Declaration then + Traverse_Package_Declaration (Lu, Process); + + elsif Nkind (Lu) = N_Package_Body then + Traverse_Package_Body (Lu, Process); + + -- ??? TBD + + elsif Nkind (Lu) = N_Generic_Package_Declaration then + null; + + -- ??? TBD + + elsif Nkind (Lu) in N_Generic_Instantiation then + null; + + -- All other cases of compilation units (e.g. renamings), are not + -- declarations. + + else + null; + end if; + end Traverse_Compilation_Unit; + ----------------------------------------- -- Traverse_Declarations_Or_Statements -- ----------------------------------------- - procedure Traverse_Declarations_Or_Statements (L : List_Id) is + procedure Traverse_Declarations_Or_Statements + (L : List_Id; + Process : Node_Processing) + is N : Node_Id; begin @@ -882,12 +948,21 @@ package body ALFA is N := First (L); while Present (N) loop + -- Call Process on all declarations + + if Nkind (N) in N_Declaration + or else + Nkind (N) in N_Later_Decl_Item + then + Process (N); + end if; + case Nkind (N) is -- Package declaration when N_Package_Declaration => - Traverse_Package_Declaration (N); + Traverse_Package_Declaration (N, Process); -- Generic package declaration ??? TBD @@ -898,13 +973,13 @@ package body ALFA is when N_Package_Body => if Ekind (Defining_Entity (N)) /= E_Generic_Package then - Traverse_Package_Body (N); + Traverse_Package_Body (N, Process); end if; -- Subprogram declaration when N_Subprogram_Declaration => - Add_ALFA_Scope (N); + null; -- Generic subprogram declaration ??? TBD @@ -915,21 +990,22 @@ package body ALFA is when N_Subprogram_Body => if not Is_Generic_Subprogram (Defining_Entity (N)) then - Traverse_Subprogram_Body (N); + Traverse_Subprogram_Body (N, Process); end if; -- Block statement when N_Block_Statement => - Traverse_Declarations_Or_Statements (Declarations (N)); + Traverse_Declarations_Or_Statements (Declarations (N), Process); Traverse_Handled_Statement_Sequence - (Handled_Statement_Sequence (N)); + (Handled_Statement_Sequence (N), Process); when N_If_Statement => -- Traverse the statements in the THEN part - Traverse_Declarations_Or_Statements (Then_Statements (N)); + Traverse_Declarations_Or_Statements + (Then_Statements (N), Process); -- Loop through ELSIF parts if present @@ -940,7 +1016,7 @@ package body ALFA is begin while Present (Elif) loop Traverse_Declarations_Or_Statements - (Then_Statements (Elif)); + (Then_Statements (Elif), Process); Next (Elif); end loop; end; @@ -948,7 +1024,8 @@ package body ALFA is -- Finally traverse the ELSE statements if present - Traverse_Declarations_Or_Statements (Else_Statements (N)); + Traverse_Declarations_Or_Statements + (Else_Statements (N), Process); -- Case statement @@ -961,7 +1038,8 @@ package body ALFA is begin Alt := First (Alternatives (N)); while Present (Alt) loop - Traverse_Declarations_Or_Statements (Statements (Alt)); + Traverse_Declarations_Or_Statements + (Statements (Alt), Process); Next (Alt); end loop; end; @@ -970,12 +1048,12 @@ package body ALFA is when N_Extended_Return_Statement => Traverse_Handled_Statement_Sequence - (Handled_Statement_Sequence (N)); + (Handled_Statement_Sequence (N), Process); -- Loop when N_Loop_Statement => - Traverse_Declarations_Or_Statements (Statements (N)); + Traverse_Declarations_Or_Statements (Statements (N), Process); when others => null; @@ -989,17 +1067,21 @@ package body ALFA is -- Traverse_Handled_Statement_Sequence -- ----------------------------------------- - procedure Traverse_Handled_Statement_Sequence (N : Node_Id) is + procedure Traverse_Handled_Statement_Sequence + (N : Node_Id; + Process : Node_Processing) + is Handler : Node_Id; begin if Present (N) then - Traverse_Declarations_Or_Statements (Statements (N)); + Traverse_Declarations_Or_Statements (Statements (N), Process); if Present (Exception_Handlers (N)) then Handler := First (Exception_Handlers (N)); while Present (Handler) loop - Traverse_Declarations_Or_Statements (Statements (Handler)); + Traverse_Declarations_Or_Statements + (Statements (Handler), Process); Next (Handler); end loop; end if; @@ -1010,34 +1092,42 @@ package body ALFA is -- Traverse_Package_Body -- --------------------------- - procedure Traverse_Package_Body (N : Node_Id) is + procedure Traverse_Package_Body + (N : Node_Id; + Process : Node_Processing) is begin - Add_ALFA_Scope (N); - Traverse_Declarations_Or_Statements (Declarations (N)); - Traverse_Handled_Statement_Sequence (Handled_Statement_Sequence (N)); + Traverse_Declarations_Or_Statements (Declarations (N), Process); + Traverse_Handled_Statement_Sequence + (Handled_Statement_Sequence (N), Process); end Traverse_Package_Body; ---------------------------------- -- Traverse_Package_Declaration -- ---------------------------------- - procedure Traverse_Package_Declaration (N : Node_Id) is + procedure Traverse_Package_Declaration + (N : Node_Id; + Process : Node_Processing) + is Spec : constant Node_Id := Specification (N); begin - Add_ALFA_Scope (N); - Traverse_Declarations_Or_Statements (Visible_Declarations (Spec)); - Traverse_Declarations_Or_Statements (Private_Declarations (Spec)); + Traverse_Declarations_Or_Statements + (Visible_Declarations (Spec), Process); + Traverse_Declarations_Or_Statements + (Private_Declarations (Spec), Process); end Traverse_Package_Declaration; ------------------------------ -- Traverse_Subprogram_Body -- ------------------------------ - procedure Traverse_Subprogram_Body (N : Node_Id) is + procedure Traverse_Subprogram_Body + (N : Node_Id; + Process : Node_Processing) is begin - Add_ALFA_Scope (N); - Traverse_Declarations_Or_Statements (Declarations (N)); - Traverse_Handled_Statement_Sequence (Handled_Statement_Sequence (N)); + Traverse_Declarations_Or_Statements (Declarations (N), Process); + Traverse_Handled_Statement_Sequence + (Handled_Statement_Sequence (N), Process); end Traverse_Subprogram_Body; end ALFA; diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads index c5aa20fd199..3d6252efb31 100644 --- a/gcc/ada/lib-xref.ads +++ b/gcc/ada/lib-xref.ads @@ -591,6 +591,11 @@ package Lib.Xref is package ALFA is + type Node_Processing is access procedure (N : Node_Id); + + procedure Traverse_All_Compilation_Units (Process : Node_Processing); + -- Call Process on all declarations through all compilation units + procedure Collect_ALFA (Sdep_Table : Unit_Ref_Table; Num_Sdep : Nat); -- Collect ALFA information from library units (for files and scopes) -- and from cross-references. Fill in the tables in library package diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 684bccfd936..29a5d4c339b 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -410,9 +410,8 @@ package body Make is procedure Make_Failed (S : String); -- Delete all temp files created by Gnatmake and call Osint.Fail, with the -- parameter S (see osint.ads). This is called from the Prj hierarchy and - -- the MLib hierarchy. - -- This subprogram also prints current error messages on stdout (ie - -- finalizes errout) + -- the MLib hierarchy. This subprogram also prints current error messages + -- on stdout (ie finalizes errout) -------------------------- -- Obsolete Executables -- @@ -424,8 +423,8 @@ package body Make is -- compiled, or has already been compiled for another executable. Max_Header : constant := 200; - -- This needs a proper comment, it used to say "arbitrary" - -- that's not an adequate comment ??? + -- This needs a proper comment, it used to say "arbitrary" that's not an + -- adequate comment ??? type Header_Num is range 1 .. Max_Header; -- Header_Num for the hash table Obsoleted below diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 2c821dc1c92..16a245c0553 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -23,7 +23,6 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Unchecked_Deallocation; with ALI; use ALI; with Debug; with Err_Vars; use Err_Vars; @@ -40,12 +39,13 @@ with Snames; use Snames; with Table; with Tempdir; -with Ada.Command_Line; use Ada.Command_Line; +with Ada.Command_Line; use Ada.Command_Line; +with Ada.Unchecked_Deallocation; -with GNAT.Case_Util; use GNAT.Case_Util; -with GNAT.Directory_Operations; use GNAT.Directory_Operations; +with GNAT.Case_Util; use GNAT.Case_Util; +with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.HTable; -with GNAT.Regexp; use GNAT.Regexp; +with GNAT.Regexp; use GNAT.Regexp; package body Makeutl is @@ -1077,6 +1077,7 @@ package body Makeutl is function Is_Subunit (Source : Prj.Source_Id) return Boolean is Src_Ind : Source_File_Index; + begin if Source.Kind = Sep then return True; @@ -1084,9 +1085,9 @@ package body Makeutl is -- A Spec, a file based language source or a body with a spec cannot be -- a subunit. - elsif Source.Kind = Spec or else - Source.Unit = No_Unit_Index or else - Other_Part (Source) /= No_Source + elsif Source.Kind = Spec + or else Source.Unit = No_Unit_Index + or else Other_Part (Source) /= No_Source then return False; end if; @@ -1263,42 +1264,6 @@ package body Makeutl is end if; end Add_Main; - -------------------------- - -- Set_Multi_Unit_Index -- - -------------------------- - - procedure Set_Multi_Unit_Index - (Project_Tree : Project_Tree_Ref := null; - Index : Int := 0) is - begin - if Index /= 0 then - if Names.Last = 0 then - Fail_Program - (Project_Tree, - "cannot specify a multi-unit index but no main " & - "on the command line"); - - elsif Names.Last > 1 then - Fail_Program - (Project_Tree, - "cannot specify several mains with a multi-unit index"); - - else - Names.Table (Names.Last).Index := Index; - end if; - end if; - end Set_Multi_Unit_Index; - - ------------ - -- Delete -- - ------------ - - procedure Delete is - begin - Names.Set_Last (0); - Mains.Reset; - end Delete; - -------------------- -- Complete_Mains -- -------------------- @@ -1451,12 +1416,24 @@ package body Makeutl is end if; end Do_Complete; + -- Start of processing for Complete_Mains + begin Complete_All (Root_Project, Project_Tree); end Complete_Mains; + ------------ + -- Delete -- + ------------ + + procedure Delete is + begin + Names.Set_Last (0); + Mains.Reset; + end Delete; + ----------------------- - -- FIll_From_Project -- + -- Fill_From_Project -- ----------------------- procedure Fill_From_Project @@ -1468,6 +1445,10 @@ package body Makeutl is -- Add the main units from this project into Mains. -- This takes into account the aggregated projects + ---------------------------- + -- Add_Mains_From_Project -- + ---------------------------- + procedure Add_Mains_From_Project (Project : Project_Id; Tree : Project_Tree_Ref) @@ -1513,6 +1494,8 @@ package body Makeutl is procedure Fill_All is new For_Project_And_Aggregated (Add_Mains_From_Project); + -- Start of processing for Fill_From_Project + begin Fill_All (Root_Project, Project_Tree); end Fill_From_Project; @@ -1522,9 +1505,8 @@ package body Makeutl is --------------- function Next_Main return String is - Info : Main_Info; + Info : constant Main_Info := Next_Main; begin - Info := Next_Main; if Info = No_Main_Info then return ""; else @@ -1532,10 +1514,6 @@ package body Makeutl is end if; end Next_Main; - --------------- - -- Next_Main -- - --------------- - function Next_Main return Main_Info is begin if Current >= Names.Last then @@ -1567,6 +1545,34 @@ package body Makeutl is begin Current := 0; end Reset; + + -------------------------- + -- Set_Multi_Unit_Index -- + -------------------------- + + procedure Set_Multi_Unit_Index + (Project_Tree : Project_Tree_Ref := null; + Index : Int := 0) + is + begin + if Index /= 0 then + if Names.Last = 0 then + Fail_Program + (Project_Tree, + "cannot specify a multi-unit index but no main " & + "on the command line"); + + elsif Names.Last > 1 then + Fail_Program + (Project_Tree, + "cannot specify several mains with a multi-unit index"); + + else + Names.Table (Names.Last).Index := Index; + end if; + end if; + end Set_Multi_Unit_Index; + end Mains; ----------------------- @@ -1633,10 +1639,9 @@ package body Makeutl is return; end if; - -- Because relative path arguments to --RTS= may be relative - -- to the search directory prefix, those relative path - -- arguments are converted only when they include directory - -- information. + -- Because relative path arguments to --RTS= may be relative to + -- the search directory prefix, those relative path arguments + -- are converted only when they include directory information. if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then if Parent'Length = 0 then @@ -1772,10 +1777,6 @@ package body Makeutl is Write_Eol; end Verbose_Msg; - ----------------- - -- Verbose_Msg -- - ----------------- - procedure Verbose_Msg (N1 : File_Name_Type; S1 : String; @@ -1794,6 +1795,7 @@ package body Makeutl is ----------- package body Queue is + type Q_Record is record Info : Source_Info; Processed : Boolean; diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index fa3ba031446..29e9e1a7af6 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -31,7 +31,7 @@ with ALI; with Namet; use Namet; with Opt; with Osint; -with Prj; use Prj; +with Prj; use Prj; with Prj.Tree; with Types; use Types; @@ -40,6 +40,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package Makeutl is type Fail_Proc is access procedure (S : String); + -- Pointer to procedure which outputs a failure message On_Windows : constant Boolean := Directory_Separator = '\'; -- True when on Windows @@ -119,8 +120,8 @@ package Makeutl is -- Return True if source is a subunit procedure Initialize_Source_Record (Source : Source_Id); - -- Get information either about the source file, the object and - -- dependency file, as well as their timestamps. This includes timestamps. + -- Get information either about the source file, or the object and + -- dependency file, as well as their timestamps. function Is_External_Assignment (Env : Prj.Tree.Environment; @@ -230,12 +231,12 @@ package Makeutl is Exit_Code : Osint.Exit_Code_Type := Osint.E_Success; S : String := ""); -- Terminate program, with or without a message, setting the status code - -- according to Fatal. - -- This properly removes all temporary files + -- according to Fatal. This properly removes all temporary files. ----------------------- -- Project_Tree data -- ----------------------- + -- The following types are specific to builders, and associated with each -- of the loaded project trees. @@ -288,10 +289,10 @@ package Makeutl is Option_Compile_Only : Boolean := False; -- Was "-c" specified ? Option_Bind_Only : Boolean := False; Option_Link_Only : Boolean := False); - -- Compute which compilation phases will be needed for Tree. This also - -- does the computation for aggregated trees. - -- This also check whether we'll need to check the closure of the files we - -- have just compiled to add them to the queue. + -- Compute which compilation phases will be needed for Tree. This also does + -- the computation for aggregated trees. This also check whether we'll need + -- to check the closure of the files we have just compiled to add them to + -- the queue. ----------- -- Mains -- @@ -313,8 +314,9 @@ package Makeutl is Project : Project_Id; Tree : Project_Tree_Ref; end record; + No_Main_Info : constant Main_Info := - (No_File, 0, No_Location, No_Source, No_Project, null); + (No_File, 0, No_Location, No_Source, No_Project, null); package Mains is procedure Add_Main @@ -323,17 +325,14 @@ package Makeutl is Location : Source_Ptr := No_Location; Project : Project_Id := No_Project; Tree : Project_Tree_Ref := null); - -- Add one main to the table. - -- This is in general used to add the main files specified on the - -- command line. - -- Index is used for multi-unit source files, and indicates which unit - -- within the source is concerned. + -- Add one main to the table. This is in general used to add the main + -- files specified on the command line. Index is used for multi-unit + -- source files, and indicates which unit in the source is concerned. -- Location is the location within the project file (if a project file - -- is used). - -- Project and Tree indicate to which project the main should belong. - -- In particular, for aggregate projects, this isn't necessarily the - -- main project tree. These can be set to No_Project and null when not - -- using projects. + -- is used). Project and Tree indicate to which project the main should + -- belong. In particular, for aggregate projects, this isn't necessarily + -- the main project tree. These can be set to No_Project and null when + -- not using projects. procedure Delete; -- Empty the table @@ -347,17 +346,17 @@ package Makeutl is -- If a single main file was defined, this subprogram indicates which -- unit inside it is the main (case of a multi-unit source files). -- Errors are raised if zero or more than one main file was defined, - -- and Index is not 0. - -- This subprogram is used for the handling of the command line switch. + -- and Index is non-zaero. This subprogram is used for the handling + -- of the command line switch. function Next_Main return String; function Next_Main return Main_Info; - -- Moves the cursor forward and returns the new current entry. - -- Returns No_File_And_Loc if there are no more mains in the table. + -- Moves the cursor forward and returns the new current entry. Returns + -- No_File_And_Loc if there are no more mains in the table. function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural; - -- Returns the number of mains in this project tree (if Tree is null, - -- it returns the total number of project trees) + -- Returns the number of mains in this project tree (if Tree is null, it + -- returns the total number of project trees) procedure Fill_From_Project (Root_Project : Project_Id; @@ -371,7 +370,7 @@ package Makeutl is Project_Tree : Project_Tree_Ref); -- If some main units were already added from the command line, check -- that they all belong to the root project, and that they are full - -- full paths rather than (partial) base names (e.g. no body suffix was + -- paths rather than (partial) base names (e.g. no body suffix was -- specified). end Mains; @@ -383,29 +382,29 @@ package Makeutl is type Source_Info_Format is (Format_Gprbuild, Format_Gnatmake); package Queue is - -- The queue of sources to be checked for compilation. - -- There can be a single such queue per application. + + -- The queue of sources to be checked for compilation. There can be a + -- single such queue per application. type Source_Info (Format : Source_Info_Format := Format_Gprbuild) is record case Format is - when Format_Gprbuild => - Tree : Project_Tree_Ref := null; - Id : Source_Id := null; - - when Format_Gnatmake => - File : File_Name_Type := No_File; - Unit : Unit_Name_Type := No_Unit_Name; - Index : Int := 0; - Project : Project_Id := No_Project; + when Format_Gprbuild => + Tree : Project_Tree_Ref := null; + Id : Source_Id := null; + + when Format_Gnatmake => + File : File_Name_Type := No_File; + Unit : Unit_Name_Type := No_Unit_Name; + Index : Int := 0; + Project : Project_Id := No_Project; end case; end record; -- Information about files stored in the queue. The exact information -- depends on the builder, and in particular whether it only supports -- project-based files (in which case we have a full Source_Id record). - No_Source_Info : constant Source_Info := - (Format_Gprbuild, null, null); + No_Source_Info : constant Source_Info := (Format_Gprbuild, null, null); procedure Initialize (Queue_Per_Obj_Dir : Boolean; @@ -429,21 +428,19 @@ package Makeutl is -- Returns True if the queue is empty function Is_Virtually_Empty return Boolean; - -- Returns True if the queue is empty or if all object directories are - -- busy. + -- Returns True if queue is empty or if all object directories are busy procedure Insert (Source : Source_Info; With_Roots : Boolean := False); function Insert (Source : Source_Info; With_Roots : Boolean := False) return Boolean; - -- Insert source in the queue. - -- The second version returns False if the Source was already marked in - -- the queue. - -- If With_Roots is True and the source is in Format_Gprbuild mode (ie - -- with a project), this procedure also includes the "Roots" for this - -- main, ie all the other files that must be included in the library or - -- binary (in particular to combine Ada and C files connected through - -- pragma Export/Import). When the roots are computed, they are also - -- stored in the corresponding Source_Id for later reuse by the binder. + -- Insert source in the queue. The second version returns False if the + -- Source was already marked in the queue. If With_Roots is True and the + -- source is in Format_Gprbuild mode (ie with a project), this procedure + -- also includes the "Roots" for this main, ie all the other files that + -- must be included in the library or binary (in particular to combine + -- Ada and C files connected through pragma Export/Import). When the + -- roots are computed, they are also stored in the corresponding + -- Source_Id for later reuse by the binder. procedure Insert_Project_Sources (Project : Project_Id; @@ -452,13 +449,12 @@ package Makeutl is Unique_Compile : Boolean); -- Insert all the compilable sources of the project in the queue. If -- All_Project is true, then all sources from imported projects are also - -- inserted. - -- Unique_Compile should be true if "-u" was specified on the command - -- line: if True and some files were given on the command line), only - -- those files will be compiled (so Insert_Project_Sources will do + -- inserted. Unique_Compile should be true if "-u" was specified on the + -- command line: if True and some files were given on the command line), + -- only those files will be compiled (so Insert_Project_Sources will do -- nothing). If True and no file was specified on the command line, all - -- files of the project(s) will be compiled. - -- This procedure also processed aggregated projects. + -- files of the project(s) will be compiled. This procedure also + -- processed aggregated projects. procedure Insert_Withed_Sources_For (The_ALI : ALI.ALI_Id; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 67076f50928..6c31eab2837 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -440,7 +440,7 @@ package body Par_SCO is ------------------- procedure Output_Header (T : Character) is - Loc : Source_Ptr := No_Location; + Loc : Source_Ptr := No_Location; -- Node whose sloc is used for the decision begin @@ -454,8 +454,8 @@ package body Par_SCO is when 'G' | 'P' => - -- For entry, the token sloc is from the N_Entry_Body. - -- For PRAGMA, we must get the location from the pragma node. + -- For entry, the token sloc is from the N_Entry_Body. For + -- PRAGMA, we must get the location from the pragma node. -- Argument N is the pragma argument, and we have to go up two -- levels (through the pragma argument association) to get to -- the pragma node itself. @@ -482,10 +482,11 @@ package body Par_SCO is Last => False); if T = 'P' then - -- For pragmas we also must make an entry in the hash table - -- for later access by Set_SCO_Pragma_Enabled. We set the - -- pragma as disabled now, the call will change C2 to 'e' - -- to enable the pragma header entry. + + -- For pragmas we also must make an entry in the hash table for + -- later access by Set_SCO_Pragma_Enabled. We set the pragma as + -- disabled now, the call will change C2 to 'e' to enable the + -- pragma header entry. SCO_Table.Table (SCO_Table.Last).C2 := 'd'; Condition_Pragma_Hash_Table.Set (Loc, SCO_Table.Last); @@ -792,6 +793,7 @@ package body Par_SCO is Traverse_Generic_Instantiation (Lu); when others => + -- All other cases of compilation units (e.g. renamings), generate -- no SCO information. @@ -1156,11 +1158,14 @@ package body Par_SCO is declare Cond : constant Node_Id := Condition (Entry_Body_Formal_Part (N)); + begin Set_Statement_Entry; + if Present (Cond) then Process_Decisions_Defer (Cond, 'G'); end if; + Traverse_Subprogram_Or_Task_Body (N); end; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index d1b31f37329..a2058e2540f 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -918,9 +918,9 @@ package body Prj.Nmsc is Flags : Processing_Flags) is Data : Tree_Processing_Data := - (Tree => Tree, - Node_Tree => Node_Tree, - Flags => Flags); + (Tree => Tree, + Node_Tree => Node_Tree, + Flags => Flags); Project_Files : constant Prj.Variable_Value := Prj.Util.Value_Of @@ -930,9 +930,7 @@ package body Prj.Nmsc is Project_Path_For_Aggregate : Prj.Env.Project_Search_Path; - procedure Found_Project_File - (Path : Path_Information; - Rank : Natural); + procedure Found_Project_File (Path : Path_Information; Rank : Natural); -- Called for each project file aggregated by Project procedure Expand_Project_Files is @@ -944,11 +942,9 @@ package body Prj.Nmsc is -- Found_Project_File -- ------------------------ - procedure Found_Project_File - (Path : Path_Information; - Rank : Natural) - is + procedure Found_Project_File (Path : Path_Information; Rank : Natural) is pragma Unreferenced (Rank); + begin if Path.Name /= Project.Path.Name then Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name)); @@ -5046,8 +5042,8 @@ package body Prj.Nmsc is Remove_Source_Dirs : Boolean := False; procedure Add_To_Or_Remove_From_Source_Dirs - (Path : Path_Information; - Rank : Natural); + (Path : Path_Information; + Rank : Natural); -- When Removed = False, the directory Path_Id to the list of -- source_dirs if not already in the list. When Removed = True, -- removed directory Path_Id if in the list. @@ -5060,14 +5056,14 @@ package body Prj.Nmsc is --------------------------------------- procedure Add_To_Or_Remove_From_Source_Dirs - (Path : Path_Information; - Rank : Natural) + (Path : Path_Information; + Rank : Natural) is - List : String_List_Id; - Prev : String_List_Id; - Rank_List : Number_List_Index; - Prev_Rank : Number_List_Index; - Element : String_Element; + List : String_List_Id; + Prev : String_List_Id; + Rank_List : Number_List_Index; + Prev_Rank : Number_List_Index; + Element : String_Element; begin Prev := Nil_String; @@ -5153,11 +5149,11 @@ package body Prj.Nmsc is ((not Source_Files.Default and then Source_Files.Values = Nil_String) or else - (not Source_Dirs.Default - and then Source_Dirs.Values = Nil_String) + (not Source_Dirs.Default + and then Source_Dirs.Values = Nil_String) or else - (not Languages.Default - and then Languages.Values = Nil_String)) + (not Languages.Default + and then Languages.Values = Nil_String)) and then Project.Extends = No_Project; -- Start of processing for Get_Directories diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 295ac40c06f..1a4ca34de02 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -1984,9 +1984,11 @@ package body Prj.Proc is New_Value : Variable_Value) is Name : constant Name_Id := Name_Of (Current_Item, Node_Tree); + Is_Attribute : constant Boolean := Kind_Of (Current_Item, Node_Tree) = N_Attribute_Declaration; + Var : Variable_Id := No_Variable; begin diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 8129925d964..2f4dea1ee6c 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -150,9 +150,10 @@ package body Prj is procedure Delete_Temp_Config_Files (Project_Tree : Project_Tree_Ref) is Success : Boolean; - Proj : Project_List; pragma Warnings (Off, Success); + Proj : Project_List; + begin if not Debug.Debug_Flag_N then if Project_Tree /= null then @@ -171,6 +172,7 @@ package body Prj is Proj.Project.Config_File_Name := No_Path; Proj.Project.Config_File_Temp := False; end if; + Proj := Proj.Next; end loop; end if; @@ -942,8 +944,11 @@ package body Prj is procedure Free (Tree : in out Project_Tree_Ref) is procedure Unchecked_Free is new - Ada.Unchecked_Deallocation (Project_Tree_Data, Project_Tree_Ref); - procedure Unchecked_Free is new Ada.Unchecked_Deallocation + Ada.Unchecked_Deallocation + (Project_Tree_Data, Project_Tree_Ref); + + procedure Unchecked_Free is new + Ada.Unchecked_Deallocation (Project_Tree_Appdata'Class, Project_Tree_Appdata_Access); begin @@ -1478,11 +1483,13 @@ package body Prj is ---------------- function Debug_Name (Tree : Project_Tree_Ref) return Name_Id is - P : Project_List := Tree.Projects; + P : Project_List; + begin Name_Len := 0; Add_Str_To_Name_Buffer ("Tree ["); + P := Tree.Projects; while P /= null loop if P /= Tree.Projects then Add_Char_To_Name_Buffer (','); diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index dae62e73cc2..e300dd99d5d 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -1498,8 +1498,8 @@ package Prj is -- Data for a project tree function Debug_Name (Tree : Project_Tree_Ref) return Name_Id; - -- If debug traces are activated, return an identitier for the - -- project tree. This modifies Name_Buffer + -- If debug traces are activated, return an identitier for the project + -- tree. This modifies Name_Buffer. procedure Expect (The_Token : Token_Type; Token_Image : String); -- Check that the current token is The_Token. If it is not, then output @@ -1524,7 +1524,7 @@ package Prj is -- whether a project was already processed for instance. generic - with procedure Action (Project : Project_Id; Tree : Project_Tree_Ref); + with procedure Action (Project : Project_Id; Tree : Project_Tree_Ref); procedure For_Project_And_Aggregated (Root_Project : Project_Id; Root_Tree : Project_Tree_Ref); @@ -1691,9 +1691,8 @@ package Prj is -- Does nothing if Debug.Debug_Flag_N is set procedure Delete_Temp_Config_Files (Project_Tree : Project_Tree_Ref); - -- Delete all temporary config files. - -- Does nothing if Debug.Debug_Flag_N is set or if Project_Tree is null. - -- This initially came from gnatmake + -- Delete all temporary config files. Does nothing if Debug.Debug_Flag_N is + -- set or if Project_Tree is null. This initially came from gnatmake -- ??? Should this be combined with Delete_All_Temp_Files above procedure Delete_Temporary_File @@ -1701,8 +1700,8 @@ package Prj is Path : Path_Name_Type); -- Delete a temporary file from the disk. The file is also removed from the -- list of temporary files to delete at the end of the program, in case - -- another program running on the same machine has recreated it. - -- Does nothing if Debug.Debug_Flag_N is set + -- another program running on the same machine has recreated it. Does + -- nothing if Debug.Debug_Flag_N is set Virtual_Prefix : constant String := "v$"; -- The prefix for virtual extending projects. Because of the '$', which is @@ -1734,8 +1733,8 @@ package Prj is procedure Debug_Increase_Indent (Str : String := ""; Str2 : Name_Id := No_Name); procedure Debug_Decrease_Indent (Str : String := ""); - -- Increase or decrease the indentation level for debug traces. - -- This indentation level only affects output done through Debug_Output. + -- Increase or decrease the indentation level for debug traces. This + -- indentation level only affects output done through Debug_Output. private diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index 3d7e59706c2..cd0970a3aaf 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -18,6 +18,7 @@ * Scenarios in Projects:: * Library Projects:: * Project Extension:: +* Aggregate Projects:: * Project File Reference:: @end menu @@ -1103,6 +1104,12 @@ and no project file with the @file{^.gpr^.GPR^} extension is found, then the file is searched for exactly as written in the @code{with} clause, that is with no extension. +As mentioned above, the path after a @code{with} has to be a literal +string, and you cannot use concatenation, or lookup the value of external +variables to change the directories from which a project is loaded. +A solution if you need something like this is to use aggregate projects +(@pxref{Aggregate Projects}). + @cindex project path When a relative path or a base name is used, the project files are searched relative to each of the directories in the @@ -2109,6 +2116,501 @@ When building project @file{c_ext.gpr}, the entire modified project space is considered for recompilation, including the sources of @file{b.gpr} that are impacted by the changes in @code{A1} and @code{C1}. +@c --------------------------------------------- +@node Aggregate Projects +@section Aggregate Projects +@c --------------------------------------------- + +@noindent + +Aggregate projects are an extension of the project paradigm, and are +meant to solve a few specific use cases that cannot be solved directly +using standard projects. This section will go over a few of these use +cases to try and explain what you can use aggregate projects for. + +@subsection Building all main units from a single project tree + +Most often, an application is organized into modules and submodules, +which are very conveniently represented as a project tree or graph +(the root project A @code{with}s the projects for each modules (say B and C), +which in turn @code{with} projects for submodules. + +Very often, modules will build their own executables (for testing +purposes for instance), or libraries (for easier reuse in various +contexts). + +However, if you build your project through gnatmake or gprbuild, using +a syntax similar to + +@smallexample + gprbuild -PA.gpr +@end smallexample + +this will only rebuild the main units of project A, not those of the +imported projects B and C. Therefore you have to spawn several +gnatmake commands, one per project, to build all executables. +This is a little inconvenient, but more importantly is inefficient +(since gnatmake needs to do duplicate work to ensure that sources are +up-to-date, and cannot easily compile things in parallel when using +the -j switch). + +Also libraries are always rebuild when building a project. + +You could therefore define an aggregate project Agg that groups A, B +and C. Then, when you build with + +@smallexample + gprbuild -PAgg.gpr +@end smallexample + +this will build all main units from A, B and C. + +@smallexample @c projectfile + aggregate project Agg is + for Project_Files use ("a.gpr", "b.gpr", "c.gpr"); + end Agg; +@end smallexample + +If B or C do not define any main unit (through their Main +attribute), all their sources are build. When you do not group them +in the aggregate project, only those sources that are needed by A +will be build. + +If you add a main unit to a project P not already explicitly referenced in the +aggregate project, you will need to add "p.gpr" in the list of project +files for the aggregate project, or the main unit will not be built when +building the aggregate project. + +@subsection Building a set of projects with a single command + +One other case is when you have multiple applications and libraries +that are build independently from each other (but they can be build in +parallel). For instance, you have a project tree rooted at A, and +another one (which might share some subprojects) rooted at B. + +Using only gprbuild, you could do + +@smallexample + gprbuild -PA.gpr + gprbuild -PB.gpr +@end smallexample + +to build both. But again, gprbuild has to do some duplicate work for +those files that are shared between the two, and cannot truly build +things in parallel efficiently. + +If the two projects are really independent, share no sources other +than through a common subproject, and have no source files with a +common basename, you could create a project C that imports A and +B. But these restrictions are often too strong, and one has to build +them independently. An aggregate project does not have these +limitations, and can aggregate two project trees that have common +sources. + +@smallexample +Aggregate projects can group projects with duplicate file names +@end smallexample + +This scenario is particularly useful in environment like VxWork 653 +where the applications running in the multiple partitions can be build +in parallel through a single gprbuild command. This also works nicely +with Annex E. + +@smallexample + Aggregate projects can be used to build multiple partitions +@end smallexample + +@subsection Define a build environment + +The environment variables at the time you launch gprbuild or gprbuild +will influence the view these tools have of the project (PATH to find +the compiler, ADA_PROJECT_PATH or GPR_PROJECT_PATH to find the +projects, environment variables that are referenced in project files +through the "external" statement,...). Several command line switches +can be used to override those (-X or -aP), but on some systems and +with some projects, this might make the command line too long, and on +all systems often make it hard to read. + +An aggregate project can be used to set the environment for all +projects build through that aggregate. One of the nice aspects is that +you can put the aggregate project under configuration management, and +make sure all your user have a consistent environment when +building. The syntax looks like + +@smallexample @c projectfile + aggregate project Agg is + for Project_Files use ("A.gpr", "B.gpr"); + for Project_Path use ("../dir1", "../dir1/dir2"); + for External ("BUILD") use "PRODUCTION"; + + package Builder is + for Switches ("Ada") use ("-q"); + end Builder; + end Agg; +@end smallexample + +One of the often requested features in projects is to be able to +reference external variables in @code{with} statements, as in + +@smallexample @c projectfile + with external("SETUP") & "path/prj.gpr"; -- ILLEGAL + project MyProject is + ... + end MyProject; +@end smallexample + +For various reasons, this isn't authorized. But using aggregate +projects provide an elegant solution. For instance, you could +use a project file like: + +@smallexample @c projectfile +aggregate project Agg is + for Project_Path use (external("SETUP") % "path"); + for Project_Files use ("myproject.gpr"); +end Agg; + + +with "prj.gpr"; -- searched on Agg'Project_Path +project MyProject is + ... +end MyProject; +@end smallexample + +@subsection Performance improvements in builder + +The loading of aggregate projects is optimized in gprbuild and +gnatmake, so that all files are searched for only once on the disk +(thus reducing the number of system calls and contributing to faster +compilation times especially on systems with sources on remote +servers). As part of the loading, gprbuild and gnatmake compute how +and where a source file should be compiled, and even if it is found +several times in the aggregated projects it will be compiled only +once. + +Since there is no ambiguity as to which switches should be used, files +can be compiled in parallel (through the usual -j switch) and this can +be done while maximizing the use of CPUs (compared to launching +multiple gprbuild and gnatmake commands in parallel). + +@subsection Syntax of aggregate projects + +An aggregate project follows the general syntax of project files. The +recommended extension is still @file{.gpr}. However, a special +@code{aggregate} qualifier must be put before the keyword +@code{project}. + +An aggregate project cannot @code{with} any other project (standard or +aggregate), except an abstract project which can be used to share +attribute values. Building other aggregate projects from an aggregate +project is done through the Project_Files attribute (see below). + +An aggregate project does not have any source files directly (only +through other standard projects). Therefore a number of the standard +attributes and packages are forbidden in an aggregate project. Here is the +(non exhaustive) list: + +@itemize @bullet +@item Languages +@item Source_files, Source_List_File and other attributes dealing with + list of sources. +@item Source_Dirs, Exec_Dir and Object_Dir +@item Library_Dir, Library_Name and other library-related attributes +@item Main +@item Roots +@item Externally_Built +@item Inherit_Source_Path +@item Excluded_Source_Dirs +@item Locally_Removed_Files +@item Excluded_Source_Fies +@item Excluded_Source_List_File +@item Interfaces +@end itemize + +The only package that is authorized (albeit optional) is +Builder. Other packages (in particular Compiler, Binder and Linker) +are forbidden. It is an error to have any of these +(and such an error prevents the proper loading of the aggregate +project). + +Three new attributes have been created, which can only be used in the +context of aggregate projects: + +@table @asis +@item @b{Project_Files}: +@cindex @code{Project_Files} + +This attribute is compulsory (or else we are not aggregating any project, +and thus not doing anything). It specifies a list of @file{.gpr} files +that are grouped in the aggregate. The list may be empty. The project +files can be either other aggregate projects, or standard projects. When +grouping standard projects, you can have both the root of a project tree +(and you do not need to specify all its imported projects), and any project +within the tree. + +Basically, the idea is to specify all those projects that have +main units you want to build and link, or libraries you want to +build. You can even specify projects that do not use the Main +attribute nor the @code{Library_*} attributes, and the result will be to +build all their source files (not just the ones needed by other +projects). + +The file can include paths (absolute or relative). Paths are +relative to the location of the aggregate project file itself (if +you use a base name, we expect to find the .gpr file in the same +directory as the aggregate project file). The extension @file{.gpr} is +mandatory, since this attribute contains file names, not project names. + +Paths can also include the @code{"*"} and @code{"**"} globbing patterns. The +latter indicates that any subdirectory (recursively) will be +searched for matching files. The latter (@code{"**"}) can only occur at the +last position in the directory part (ie @code{"a/**/*.gpr"} is supported, but +not @code{"**/a/*.gpr"}). Starting the pattern with @code{"**"} is equivalent +to starting with @code{"./**"}. + +For now, the pattern @code{"*"} is only allowed in the filename part, not +in the directory part. This is mostly for efficiency reasons to limit the +number of system calls that are needed. + +Here are a few valid examples: + +@smallexample @c projectfile + for Project_Files use ("a.gpr", "subdir/b.gpr"); + -- two specific projects relative to the directory of agg.gpr + + for Project_Files use ("**/*.gpr"); + -- all projects recursively +@end smallexample + +@item @b{Project_Path}: +@cindex @code{Project_Path} + +This attribute can be used to specify a list of directories in +which to look for project files in @code{with} statements. + +When you specify a project in Project_Files +say @code{"x/y/a.gpr"}), and this projects imports a project "b.gpr", only +b.gpr is searched in the project path. a.gpr must be exactly at +/x/y/a.gpr. + +This attribute, however, does not affect the search for the aggregated +project files specified with @code{Project_Files}. + +Each aggregate project has its own (that is if agg1.gpr includes +agg2.gpr, they can potentially both have a different project path). +This project path is defined as the concatenation, in that order, of +the current directory, followed by the command line -aP switches, +then the directories from the Project_Path attribute, then the +directories from the GPR_PROJECT_PATH and ADA_PROJECT_PATH env. +variables, and finally the predefined directories. + +In the example above, agg2.gpr's project path is not influenced by +the attribute agg1'Project_Path, nor is agg1 influenced by +agg2'Project_Path. + +This can potentially lead to errors. In the following example: + +@smallexample + +---------------+ +----------------+ + | Agg1.gpr |-=--includes--=-->| Agg2.gpr | + | 'project_path| | 'project_path | + | | | | + +---------------+ +----------------+ + : : + includes includes + : : + v v + +-------+ +---------+ + | P.gpr |<---------- withs --------| Q.gpr | + +-------+---------\ +---------+ + | | + withs | + | | + v v + +-------+ +---------+ + | R.gpr | | R'.gpr | + +-------+ +---------+ +@end smallexample + +When looking for p.gpr, both aggregates find the same physical file on +the disk. However, it might happen that with their different project +paths, both aggregate projects would in fact find a different r.gpr. +Since we have a common project (p.gpr) "with"ing two different r.gpr, +this will be reported as an error by the builder. + +Directories are relative to the location of the aggregate project file. + +Here are a few valid examples: + +@smallexample @c projectfile + for Project_Path use ("/usr/local/gpr", "gpr/"); +@end smallexample + +@item @b{External}: +@cindex @code{External} + +This attribute can be used to set the value of environment +variables as retrieved through the @code{external} statement +in projects. It does not affect the environment variables +themselves (so for instance you cannot use it to change the value +of your PATH as seen from the spawned compiler). + +This attribute affects the external values as seen in the rest of +the aggreate projects, and in the aggregated projects. + +The exact value of external a variable comes from one of three +sources (each level overrides the previous levels): + +@itemize @bullet +@item An External attribute in aggregate project, for instance + @code{for External ("BUILD_MODE") use "DEBUG"}; + +@item Environment variables + +These override the value given by the attribute, so that +users can override the value set in the (presumably shared +with others in his team) aggregate project. + +@item The -X command line switch to gprbuild and gnatmake + +This always takes precedence. + +@end itemize + +This attribute is only taken into account in the main aggregate +project (i.e. the one specified on the command line to gprbuild or +natmake), and ignored in other aggregate projects. It is invalid +in standard projects. +The goal is to have a consistent value in all +projects that are build through the aggregate, which would not +be the case in the diamond case: A groups the aggregate +projects B and C, which both (either directly or indirectly) +build the project P. If B and C could set different values for +the environment variables, we would have two different views of +P, which in particular might impact the list of source files in P. + +@end table + +@subsection package Builder in aggregate projects + +As we mentioned before, only the package Builder can be specified in +an aggregate project. In this package, only the following attributes +are valid: + +@table @asis +@item @b{Switches}: +@cindex @code{Switches} +This attribute gives the list of switches to use for the builder +(gprbuild or gnatmake), depending on the language of the main file. +For instance, + +@smallexample @c projectfile +for Switches ("Ada") use ("-d", "-p"); +for Switches ("C") use ("-p"); +@end smallexample + +These switches are only read from the main aggregate project (the +one passed on the command line), and ignored in all other aggregate +projects or projects. + +It can only contain builder switches, not compiler switches. + +@item @b{Global_Compilation_Switches} +@cindex @code{Global_Compilation_Switches} + +This attribute gives the list of compiler switches for the various +languages. For instance, + +@smallexample @c projectfile +for Global_Compilation_Switches ("Ada") use ("-O1", "-g"); +for Global_Compilation_Switches ("C") use ("-O2"); +@end smallexample + +This attribute is only taken into account in the aggregate project +specified on the command line, not in other aggregate projects. + +In the projects grouped by that aggregate, the attribute +Builder.Global_Compilation_Switches is also ignored. However, the +attribute Compiler.Default_Switches will be taken into account (but +that of the aggregate have higher priority). The attribute +Compiler.Switches is also taken into account and can be used to +override the switches for a specific file. As a result, it always +has priority. + +The rules are meant to avoid ambiguities when compiling. For +instance, aggregate project Agg groups the projects A and B, that +both depend on C. Here is an extra for all of these projects: + +@smallexample @c projectfile + aggregate project Agg is + for Project_Files use ("a.gpr", "b.gpr"); + package Builder is + for Global_Compilation_Switches ("Ada") use ("-O2"); + end Builder; + end Agg; + + with "c.gpr"; + project A is + package Builder is + for Global_Compilation_Switches ("Ada") use ("-O1"); + -- ignored + end Builder; + + package Compiler is + for Default_Switches ("Ada") use ("-O1", "-g"); + for Switches ("a_file1.adb") use ("-O0"); + end Compiler; + end A; + + with "c.gpr"; + project B is + package Compiler is + for Default_Switches ("Ada") use ("-O0"); + end Compiler; + end B; + + project C is + package Compiler is + for Default_Switches ("Ada") use ("-O3, "-gnatn"); + for Switches ("c_file1.adb") use ("-O0", "-g"); + end Compiler; + end C; +@end smallexample + +then the following switches are used: + +@itemize @bullet +@item all files from project A except a_file1.adb are compiled + with "-O2 -g", since the aggregate project has priority. +@item the file a_file1.adb is compiled with + "-O0", since the Compiler.Switches has priority +@item all files from project B are compiled with + "-O2", since the aggregate project has priority +@item all files from C are compiled with "-O2 -gnatn", except for + c_file1.adb which is compiled with "-O0 -g" +@end itemize + +Even though C is seen through two paths (through A and through +B), the switches used by the compiler are unambiguous. + +@item @b{Global_Configuration_Pragmas} +@cindex @code{Global_Configuration_Pragmas} + +This attribute can be used to specify a file containing +configuration pragmas, to be passed to the compiler. Since we +ignore the package Builder in other aggregate projects and projects, +only those pragmas defined in the main aggregate project will be +taken into account. + +Projects can locally add to those by using the +@code{Compiler.Local_Configuration_Pragmas} attribute if they need. + +@end table + +For projects that are build through the aggregate, the package Builder +is ignored, except for the Executable attribute which specifies the +name of the executables resulting from the link of the main units, and +for the Executable_Suffix. + @c --------------------------------------------- @node Project File Reference @section Project File Reference diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index de0b5978110..240b2812631 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1747,9 +1747,7 @@ package body Sem_Attr is if Nkind (Nod) = N_Identifier then return; - elsif Nkind (Nod) = N_Selected_Component - or else Nkind (Nod) = N_Expanded_Name - then + elsif Nkind_In (Nod, N_Selected_Component, N_Expanded_Name) then Check_Unit_Name (Prefix (Nod)); if Nkind (Selector_Name (Nod)) = N_Identifier then diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index 69428354ca2..68f3d17225f 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -588,8 +588,9 @@ package body Sem_Ch11 is return Same_Expression (Right_Opnd (C1), Right_Opnd (C2)); elsif Nkind (C1) in N_Binary_Op then - return Same_Expression (Left_Opnd (C1), Left_Opnd (C2)) - and then Same_Expression (Right_Opnd (C1), Right_Opnd (C2)); + return Same_Expression (Left_Opnd (C1), Left_Opnd (C2)) + and then + Same_Expression (Right_Opnd (C1), Right_Opnd (C2)); elsif Nkind (C1) = N_Null then return True; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 15689c33344..3bb1d524996 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2840,7 +2840,8 @@ package body Sem_Ch13 is Assoc : Node_Id; Choice : Node_Id; Val : Uint; - Err : Boolean := False; + + Err : Boolean := False; -- Set True to avoid cascade errors and crashes on incorrect source code Lo : constant Uint := Expr_Value (Type_Low_Bound (Universal_Integer)); @@ -2980,12 +2981,15 @@ package body Sem_Ch13 is Err := True; elsif Nkind (Choice) = N_Range then + -- ??? should allow zero/one element range here + Error_Msg_N ("range not allowed here", Choice); Err := True; else Analyze_And_Resolve (Choice, Enumtype); + if Error_Posted (Choice) then Err := True; end if; @@ -2996,6 +3000,7 @@ package body Sem_Ch13 is then Error_Msg_N ("subtype name not allowed here", Choice); Err := True; + -- ??? should allow static subtype with zero/one entry elsif Etype (Choice) = Base_Type (Enumtype) then diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 3256ae89b3c..68ba0309b14 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -74,7 +74,7 @@ package body Sem_Ch8 is -- Visibility and Name Resolution -- ------------------------------------ - -- This package handles name resolution and the collection of + -- This package handles name resolution and the collection of possible -- interpretations for overloaded names, prior to overload resolution. -- Name resolution is the process that establishes a mapping between source @@ -5639,19 +5639,19 @@ package body Sem_Ch8 is and then RTU_Loaded (Ada_Tags) and then ((RTE_Available (RE_Dispatch_Table_Wrapper) - and then Scope (Selector) = + and then Scope (Selector) = RTE (RE_Dispatch_Table_Wrapper)) - or else + or else (RTE_Available (RE_No_Dispatch_Table_Wrapper) - and then Scope (Selector) = + and then Scope (Selector) = RTE (RE_No_Dispatch_Table_Wrapper))) then C_Etype := Empty; else C_Etype := - Build_Actual_Subtype_Of_Component ( - Etype (Selector), N); + Build_Actual_Subtype_Of_Component + (Etype (Selector), N); end if; else diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 369d75ef842..b58f8c0e1a7 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -894,13 +894,13 @@ package body Sem_Disp is then pragma Assert ((Ekind (Subp) = E_Function - and then Is_Dispatching_Operation (Old_Subp) - and then Is_Null_Extension (Base_Type (Etype (Subp)))) + and then Is_Dispatching_Operation (Old_Subp) + and then Is_Null_Extension (Base_Type (Etype (Subp)))) or else (Ekind (Subp) = E_Procedure - and then Is_Dispatching_Operation (Old_Subp) - and then Present (Alias (Old_Subp)) - and then Is_Null_Interface_Primitive + and then Is_Dispatching_Operation (Old_Subp) + and then Present (Alias (Old_Subp)) + and then Is_Null_Interface_Primitive (Ultimate_Alias (Old_Subp))) or else Get_TSS_Name (Subp) = TSS_Stream_Read or else Get_TSS_Name (Subp) = TSS_Stream_Write); @@ -1279,13 +1279,10 @@ package body Sem_Disp is elsif Has_Controlled_Component (Tagged_Type) and then - (Chars (Subp) = Name_Initialize - or else - Chars (Subp) = Name_Adjust - or else - Chars (Subp) = Name_Finalize - or else - Chars (Subp) = Name_Finalize_Address) + (Chars (Subp) = Name_Initialize or else + Chars (Subp) = Name_Adjust or else + Chars (Subp) = Name_Finalize or else + Chars (Subp) = Name_Finalize_Address) then declare F_Node : constant Node_Id := Freeze_Node (Tagged_Type); diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 87f31d82e32..d5d4ac3256d 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -661,6 +661,7 @@ package body Sem_Elab is declare Typ : constant Entity_Id := Etype (First_Formal (Ent)); Init : Entity_Id; + begin if not Is_Controlled (Typ) then return; @@ -2156,9 +2157,10 @@ package body Sem_Elab is Insert_Action (Declaration_Node (E), Make_Object_Declaration (Loce, Defining_Identifier => Ent, - Object_Definition => + Object_Definition => New_Occurrence_Of (Standard_Integer, Loce), - Expression => Make_Integer_Literal (Loc, Uint_0))); + Expression => + Make_Integer_Literal (Loc, Uint_0))); -- Set elaboration flag at the point of the body @@ -2182,7 +2184,7 @@ package body Sem_Elab is Insert_Elab_Check (N, Make_Attribute_Reference (Loc, Attribute_Name => Name_Elaborated, - Prefix => New_Occurrence_Of (E, Loc))); + Prefix => New_Occurrence_Of (E, Loc))); end if; -- Generate the warning diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 0f1468d1faa..5be584307af 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -964,11 +964,11 @@ package body Sem_Eval is return Unknown; end if; end if; - else - -- If the range of either operand cannot be determined, - -- nothing further can be inferred. + -- If the range of either operand cannot be determined, nothing + -- further can be inferred. + else return Unknown; end if; end; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index ccc6aa3c8d8..4ce7ec5a61a 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -4765,7 +4765,8 @@ package body Sem_Prag is -- entities are supported by the VM. if Convention (Subprogram_Def) /= Convention_CIL - and then Convention (Subprogram_Def) /= Convention_Java + and then + Convention (Subprogram_Def) /= Convention_Java then Check_Duplicated_Export_Name (Link_Nam); end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 7920d6d4d98..9948a61c3d2 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -956,17 +956,14 @@ package body Sem_Util is -- Create elaboration flag - Elab_Ent := - Make_Defining_Identifier (Loc, Chars => Name_Find); + Elab_Ent := Make_Defining_Identifier (Loc, Chars => Name_Find); Set_Elaboration_Entity (Spec_Id, Elab_Ent); Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Elab_Ent, - Object_Definition => - New_Occurrence_Of (Standard_Integer, Loc), - Expression => - Make_Integer_Literal (Loc, Uint_0)); + Make_Object_Declaration (Loc, + Defining_Identifier => Elab_Ent, + Object_Definition => New_Occurrence_Of (Standard_Integer, Loc), + Expression => Make_Integer_Literal (Loc, Uint_0)); Push_Scope (Standard_Standard); Add_Global_Declaration (Decl); @@ -5567,7 +5564,7 @@ package body Sem_Util is return False; end if; - -- First treat specially string literals, as the lower bound and length + -- First treat string literals specially, as the lower bound and length -- of string literals are not stored like those of arrays. -- A string literal always has static bounds @@ -5596,8 +5593,9 @@ package body Sem_Util is return False; end if; - if Is_OK_Static_Expression (Low) - and then Is_OK_Static_Expression (High) + if Is_OK_Static_Expression (Low) + and then + Is_OK_Static_Expression (High) then null; else @@ -6000,6 +5998,7 @@ package body Sem_Util is if Nkind (Decl) = N_Incomplete_Type_Declaration then Match := Defining_Identifier (Decl); end if; + else if Nkind_In (Decl, N_Private_Extension_Declaration, N_Private_Type_Declaration) @@ -6021,6 +6020,8 @@ package body Sem_Util is return Empty; end Inspect_Decls; + -- Local variables + Prev : Entity_Id; -- Start of processing for Incomplete_Or_Partial_View diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index c8b1a1ec3cd..d50dc5f7037 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1210,7 +1210,7 @@ package Sem_Util is -- previous errors (particularly in -gnatq mode). function Requires_Transient_Scope (Id : Entity_Id) return Boolean; - -- E is a type entity. The result is True when temporaries of this type + -- Id is a type entity. The result is True when temporaries of this type -- need to be wrapped in a transient scope to be reclaimed properly when a -- secondary stack is in use. Examples of types requiring such wrapping are -- controlled types and variable-sized types including unconstrained -- 2.30.2