From 9fde638da6523b717ec7aca4f11ce8bf4f44dde7 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Wed, 3 Aug 2011 10:17:45 +0000 Subject: [PATCH] prj-proc.adb, [...]: Minor reformatting. 2011-08-03 Robert Dewar * prj-proc.adb, exp_util.ads, exp_ch9.adb, make.adb, prj-ext.adb, prj-ext.ads, alfa.ads, sem_ch4.adb, makeutl.adb, makeutl.ads, lib-xref-alfa.adb, sem_cat.adb, exp_dist.adb, get_alfa.adb, prj-env.adb, prj-env.ads, prj-tree.adb, alfa.ads: Minor reformatting. From-SVN: r177260 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/alfa.ads | 3 +++ gcc/ada/exp_ch9.adb | 2 +- gcc/ada/exp_dist.adb | 12 ++++++++++++ gcc/ada/exp_util.ads | 2 +- gcc/ada/get_alfa.adb | 1 + gcc/ada/lib-xref-alfa.adb | 8 +++++--- gcc/ada/make.adb | 8 ++++---- gcc/ada/makeutl.adb | 16 +++++++++------- gcc/ada/makeutl.ads | 35 +++++++++++++++++------------------ gcc/ada/prj-env.adb | 4 +++- gcc/ada/prj-env.ads | 4 ++-- gcc/ada/prj-ext.adb | 19 ++++++++++--------- gcc/ada/prj-ext.ads | 19 +++++++++---------- gcc/ada/prj-proc.adb | 38 +++++++++++++++++++++----------------- gcc/ada/prj-tree.adb | 3 +-- gcc/ada/sem_cat.adb | 3 +++ gcc/ada/sem_ch4.adb | 4 ++-- 18 files changed, 111 insertions(+), 77 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a28897f750d..7cb3c194feb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2011-08-03 Robert Dewar + + * prj-proc.adb, exp_util.ads, exp_ch9.adb, make.adb, prj-ext.adb, + prj-ext.ads, alfa.ads, sem_ch4.adb, makeutl.adb, makeutl.ads, + lib-xref-alfa.adb, sem_cat.adb, exp_dist.adb, get_alfa.adb, + prj-env.adb, prj-env.ads, prj-tree.adb, alfa.ads: Minor reformatting. + 2011-08-03 Javier Miranda * exp_util.adb, sem_aux.adb, exp_util.ads, sem_aux.ads: diff --git a/gcc/ada/alfa.ads b/gcc/ada/alfa.ads index 8601a321f21..ec171bba367 100644 --- a/gcc/ada/alfa.ads +++ b/gcc/ada/alfa.ads @@ -91,6 +91,9 @@ package ALFA is -- FS . scope line type col entity (-> spec-file . spec-scope)? + -- What is the ? marke here, is it part of the actual syntax, or is + -- it a query about a problem, in which case it should be ??? + -- scope is the ones-origin scope number for the current file (e.g. 2 = -- reference to the second FS line in this FD block). diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 1b2e7fd81d0..6500ea65c6a 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -3797,7 +3797,7 @@ package body Exp_Ch9 is Prefix => New_Reference_To (Defining_Identifier (N_Node), Loc))); - -- If it is a vm_by_copy_actual, copy it to a new variable + -- If it is a VM_By_Copy_Actual, copy it to a new variable elsif Is_VM_By_Copy_Actual (Actual) then N_Node := diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 51cf49a98bd..5f6180bdc21 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -1030,6 +1030,10 @@ package body Exp_Dist is pragma Warnings (Off, Subp_Str); begin + -- Disable expansion of stubs if serious errors have been diagnosed, + -- because otherwise some illegal remote subprogram declarations + -- could cause cascaded errors in stubs. + if Serious_Errors_Detected /= 0 then return; end if; @@ -3841,6 +3845,10 @@ package body Exp_Dist is pragma Warnings (Off, Subp_Val); begin + -- Disable expansion of stubs if serious errors have been + -- diagnosed, because otherwise some illegal remote subprogram + -- declarations could cause cascaded errors in stubs. + if Serious_Errors_Detected /= 0 then return; end if; @@ -6849,6 +6857,10 @@ package body Exp_Dist is Proxy_Obj_Addr : Entity_Id; begin + -- Disable expansion of stubs if serious errors have been + -- diagnosed, because otherwise some illegal remote subprogram + -- declarations could cause cascaded errors in stubs. + if Serious_Errors_Detected /= 0 then return; end if; diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 4f13fa96f88..ae938a03504 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -539,7 +539,7 @@ package Exp_Util is function Is_VM_By_Copy_Actual (N : Node_Id) return Boolean; -- Returns True if we are compiling on VM targets and N is a node that - -- requires to be passed by copy in these targets. + -- requires pass-by-copy in these targets. procedure Kill_Dead_Code (N : Node_Id; Warn : Boolean := False); -- N represents a node for a section of code that is known to be dead. Any diff --git a/gcc/ada/get_alfa.adb b/gcc/ada/get_alfa.adb index d9565b19b1b..0fc967a0b3d 100644 --- a/gcc/ada/get_alfa.adb +++ b/gcc/ada/get_alfa.adb @@ -290,6 +290,7 @@ begin Spec_File := Get_Nat; Check ('.'); Spec_Scope := Get_Nat; + else Spec_File := 0; Spec_Scope := 0; diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb index 860e80eb90a..d325df5ba04 100644 --- a/gcc/ada/lib-xref-alfa.adb +++ b/gcc/ada/lib-xref-alfa.adb @@ -238,6 +238,7 @@ package body ALFA is for S in From .. ALFA_Scope_Table.Last loop declare E : Entity_Id renames ALFA_Scope_Table.Table (S).Scope_Entity; + begin if Lib.Get_Source_Unit (E) = U then ALFA_Scope_Table.Table (S).Scope_Num := Count; @@ -819,9 +820,11 @@ package body ALFA is for S in ALFA_Scope_Table.First .. ALFA_Scope_Table.Last loop declare Srec : ALFA_Scope_Record renames ALFA_Scope_Table.Table (S); + Body_Entity : Entity_Id; Spec_Entity : Entity_Id; Spec_Scope : Scope_Index; + begin if Ekind (Srec.Scope_Entity) = E_Subprogram_Body then Body_Entity := Parent (Parent (Srec.Scope_Entity)); @@ -850,7 +853,6 @@ package body ALFA is end if; end; end loop; - end; -- Generate cross reference ALFA information @@ -864,8 +866,8 @@ package body ALFA is function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range is begin - return Entity_Hashed_Range - (E mod (Entity_Id (Entity_Hashed_Range'Last) + 1)); + return + Entity_Hashed_Range (E mod (Entity_Id (Entity_Hashed_Range'Last) + 1)); end Entity_Hash; ----------------------------------------- diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 534795a14db..d62ec018ac3 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -2311,10 +2311,10 @@ package body Make is Switches := Switches_Of - (Source_File => Source_File, - Project => Arguments_Project, - In_Package => Compiler_Package, - Allow_ALI => False); + (Source_File => Source_File, + Project => Arguments_Project, + In_Package => Compiler_Package, + Allow_ALI => False); end if; diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 5afb62923a5..63731dd480b 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -679,13 +679,13 @@ package body Makeutl is ------------------ procedure Get_Switches - (Source_File : File_Name_Type; - Source_Lang : Name_Id; - Source_Prj : Project_Id; - Pkg_Name : Name_Id; - Project_Tree : Project_Tree_Ref; - Value : out Variable_Value; - Is_Default : out Boolean; + (Source_File : File_Name_Type; + Source_Lang : Name_Id; + Source_Prj : Project_Id; + Pkg_Name : Name_Id; + Project_Tree : Project_Tree_Ref; + Value : out Variable_Value; + Is_Default : out Boolean; Test_Without_Suffix : Boolean := False; Check_ALI_Suffix : Boolean := False) is @@ -697,6 +697,7 @@ package body Makeutl is In_Packages => Project.Decl.Packages, In_Tree => Project_Tree); Lang : Language_Ptr; + begin Is_Default := False; @@ -724,6 +725,7 @@ package body Makeutl is Spec_Suffix : String := Get_Name_String (Naming.Spec_Suffix); Body_Suffix : String := Get_Name_String (Naming.Body_Suffix); Truncated : Boolean := False; + begin Canonical_Case_File_Name (Spec_Suffix); Canonical_Case_File_Name (Body_Suffix); diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 31a456213ce..325dd830d0e 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -155,26 +155,25 @@ package Makeutl is Value : out Variable_Value; Is_Default : out Boolean); procedure Get_Switches - (Source_File : File_Name_Type; - Source_Lang : Name_Id; - Source_Prj : Project_Id; - Pkg_Name : Name_Id; - Project_Tree : Project_Tree_Ref; - Value : out Variable_Value; - Is_Default : out Boolean; + (Source_File : File_Name_Type; + Source_Lang : Name_Id; + Source_Prj : Project_Id; + Pkg_Name : Name_Id; + Project_Tree : Project_Tree_Ref; + Value : out Variable_Value; + Is_Default : out Boolean; Test_Without_Suffix : Boolean := False; Check_ALI_Suffix : Boolean := False); -- Compute the switches (Compilation switches for instance) for the given -- file. This checks various attributes to see if there are file specific -- switches, or else defaults on the switches for the corresponding -- language. Is_Default is set to False if there were file-specific - -- switches Source_File can be set to No_File to force retrieval of - -- the default switches. - -- If Test_Without_Suffix is True, and there is no - -- " for Switches(Source_File) use", then this procedure also tests without - -- the extension of the filename. - -- If Test_Without_Suffix is True and Check_ALI_Suffix is True, then we - -- also replace the file extension with ".ali" when testing. + -- switches Source_File can be set to No_File to force retrieval of the + -- default switches. If Test_Without_Suffix is True, and there is no " for + -- Switches(Source_File) use", then this procedure also tests without the + -- extension of the filename. If Test_Without_Suffix is True and + -- Check_ALI_Suffix is True, then we also replace the file extension with + -- ".ali" when testing. function Linker_Options_Switches (Project : Project_Id; @@ -183,10 +182,6 @@ package Makeutl is -- of project Project, in project tree In_Tree, and in the projects that -- it imports directly or indirectly, and returns the result. - -- Package Mains is used to store the mains specified on the command line - -- and to retrieve them when a project file is used, to verify that the - -- files exist and that they belong to a project file. - function Unit_Index_Of (ALI_File : File_Name_Type) return Int; -- Find the index of a unit in a source file. Return zero if the file is -- not a multi-unit source file. @@ -211,6 +206,10 @@ package Makeutl is -- Mains -- ----------- + -- Package Mains is used to store the mains specified on the command line + -- and to retrieve them when a project file is used, to verify that the + -- files exist and that they belong to a project file. + -- Mains are stored in a table. An index is used to retrieve the mains -- from the table. diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 050660e9b9d..222efe021bf 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -2204,11 +2204,13 @@ package body Prj.Env is procedure Copy (From : Project_Search_Path; To : out Project_Search_Path) is begin Free (To); + if From.Path /= null then To.Path := new String'(From.Path.all); end if; - -- No need to copy the Cache, it will be recomputed as needed. + -- No need to copy the Cache, it will be recomputed as needed + end Copy; end Prj.Env; diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 75f014a4b20..99bd88064fe 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -241,7 +241,7 @@ private end record; No_Project_Search_Path : constant Project_Search_Path := - (Path => null, - Cache => Projects_Paths.Nil); + (Path => null, + Cache => Projects_Paths.Nil); end Prj.Env; diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index a235bde8fa2..5d49fa4438a 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -47,10 +47,10 @@ package body Prj.Ext is N := Name_To_Name_HTable.Get_First (Copy_From.Refs.all); while N /= null loop N2 := new Name_To_Name' - (Key => N.Key, - Value => N.Value, - Source => N.Source, - Next => null); + (Key => N.Key, + Value => N.Value, + Source => N.Source, + Next => null); Name_To_Name_HTable.Set (Self.Refs.all, N2); N := Name_To_Name_HTable.Get_Next (Copy_From.Refs.all); end loop; @@ -82,9 +82,10 @@ package body Prj.Ext is if Source /= External_Source'First then N := Name_To_Name_HTable.Get (Self.Refs.all, Key); + if N /= null then if External_Source'Pos (N.Source) < - External_Source'Pos (Source) + External_Source'Pos (Source) then if Current_Verbosity = High then Debug_Output @@ -99,10 +100,10 @@ package body Prj.Ext is Name_Len := Value'Length; Name_Buffer (1 .. Name_Len) := Value; N := new Name_To_Name' - (Key => Key, - Source => Source, - Value => Name_Find, - Next => null); + (Key => Key, + Source => Source, + Value => Name_Find, + Next => null); if Current_Verbosity = High then Debug_Output ("Add external (" & External_Name & ") is", N.Value); diff --git a/gcc/ada/prj-ext.ads b/gcc/ada/prj-ext.ads index 75b0ed2a0f1..01719cf45fb 100644 --- a/gcc/ada/prj-ext.ads +++ b/gcc/ada/prj-ext.ads @@ -58,21 +58,21 @@ package Prj.Ext is (From_Command_Line, From_Environment, From_External_Attribute); - -- Where was the value of an external reference defined ? - -- They are prioritized in that order, so that a user can always use the - -- command line to override a value coming from his environment, or an - -- environment variable to override a value defined in an aggregate project - -- through the "for External()..." attribute. + -- Indicates where was the value of an external reference defined. They are + -- prioritized in that order, so that a user can always use the command + -- line to override a value coming from his environment, or an environment + -- variable to override a value defined in an aggregate project through the + -- "for External()..." attribute. procedure Add (Self : External_References; External_Name : String; Value : String; Source : External_Source := External_Source'First); - -- Add an external reference (or modify an existing one). - -- No overriding is done if the Source's priority is less than the one - -- used to previously set the value of the variable. The default for Source - -- is such that overriding always occurs. + -- Add an external reference (or modify an existing one). No overriding is + -- done if the Source's priority is less than the one used to previously + -- set the value of the variable. The default for Source is such that + -- overriding always occurs. function Value_Of (Self : External_References; @@ -92,7 +92,6 @@ package Prj.Ext is -- and free any allocated memory. private - -- Use a Static_HTable, rather than a Simple_HTable -- The issue is that we need to be able to copy the contents of the table diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 4e3ba1ba368..ac07421eb90 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -125,18 +125,19 @@ package body Prj.Proc is -- Find the package of Project whose name is With_Name procedure Process_Declarative_Items - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - From_Project_Node : Project_Node_Id; - Node_Tree : Project_Node_Tree_Ref; - Env : Prj.Tree.Environment; - Pkg : Package_Id; - Item : Project_Node_Id; - Child_Env : in out Prj.Tree.Environment; + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + From_Project_Node : Project_Node_Id; + Node_Tree : Project_Node_Tree_Ref; + Env : Prj.Tree.Environment; + Pkg : Package_Id; + Item : Project_Node_Id; + Child_Env : in out Prj.Tree.Environment; Can_Modify_Child_Env : Boolean); -- Process declarative items starting with From_Project_Node, and put them -- in declarations Decl. This is a recursive procedure; it calls itself for -- a package declaration or a case construction. + -- -- Child_Env is the modified environment after seeing declarations like -- "for External(...) use" or "for Project_Path use" in aggregate projects. -- It should have been initialized first. This environment can only be @@ -158,9 +159,11 @@ package body Prj.Proc is -- as processed, call itself recursively for all imported projects and a -- extended project, if any. Then process the declarative items of the -- project. + -- -- Child_Env is the environment created from an aggregate project (new -- external values or project path), and should be initialized before the -- call. + -- -- Is_Root_Project should be true only for the project that the user -- explicitly loaded. In the context of aggregate projects, only that -- project is allowed to modify the environment that will be used to load @@ -2267,15 +2270,15 @@ package body Prj.Proc is if Present (Decl_Item) then Process_Declarative_Items - (Project => Project, - In_Tree => In_Tree, - From_Project_Node => From_Project_Node, - Node_Tree => Node_Tree, - Env => Env, - Pkg => Pkg, - Item => Decl_Item, - Child_Env => Child_Env, - Can_Modify_Child_Env => Can_Modify_Child_Env); + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + Node_Tree => Node_Tree, + Env => Env, + Pkg => Pkg, + Item => Decl_Item, + Child_Env => Child_Env, + Can_Modify_Child_Env => Can_Modify_Child_Env); end if; end Process_Case_Construction; @@ -2331,6 +2334,7 @@ package body Prj.Proc is Reset_Tree : Boolean := True) is Child_Env : Prj.Tree.Environment; + begin if Reset_Tree then diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index 0a1b9a58ef0..aee8da5c48c 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -2270,8 +2270,7 @@ package body Prj.Tree is begin pragma Assert (Present (Node) - and then - In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); + and then In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); In_Tree.Project_Nodes.Table (Node).Flag1 := True; end Set_Is_Not_Last_In_List; diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index 80f017b5938..7b0a1fb8224 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -365,6 +365,7 @@ package body Sem_Cat is Component : Entity_Id; Comp_Type : Entity_Id; U_Typ : constant Entity_Id := Underlying_Type (Typ); + begin if No (U_Typ) then return False; @@ -628,11 +629,13 @@ package body Sem_Cat is function No_External_Streaming (E : Entity_Id) return Boolean is U_E : constant Entity_Id := Underlying_Type (E); + begin if No (U_E) then return False; elsif Has_Read_Write_Attributes (E) then + -- Note: availability of stream attributes is tested on E, not U_E. -- There may be stream attributes defined on U_E that are not visible -- at the place where support of external streaming is tested. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 664a080ee3b..6dacae55ca7 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -7263,8 +7263,8 @@ package body Sem_Ch4 is or else (Ekind (Typ) = E_Anonymous_Access_Type - and then - Base_Type (Designated_Type (Typ)) = Base_Type (Corr_Type)); + and then + Base_Type (Designated_Type (Typ)) = Base_Type (Corr_Type)); end Valid_First_Argument_Of; -- Start of processing for Try_Primitive_Operation -- 2.30.2