From 286f80f15a8727825fa0184f90dacd4c04d589f4 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 1 Aug 2011 15:59:50 +0000 Subject: [PATCH] 2011-08-01 Robert Dewar * sem_ch3.adb, sem_ch3.ads, sem_ch5.adb, prj-part.adb, par-ch4.adb, sem_util.adb, sem_ch4.adb, sem_ch6.adb, sem_ch6.ads, sem_ch8.adb, sem_ch8.ads, sem_ch13.ads, par-ch5.adb, prj-env.ads: Minor reformatting git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177055 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/par-ch4.adb | 1 + gcc/ada/par-ch5.adb | 5 +++-- gcc/ada/prj-env.ads | 43 ++++++++++++++++++++----------------------- gcc/ada/prj-part.adb | 9 +++++---- gcc/ada/sem_ch13.ads | 6 +++--- gcc/ada/sem_ch3.adb | 2 +- gcc/ada/sem_ch3.ads | 8 ++++---- gcc/ada/sem_ch4.adb | 18 ++++++++++++------ gcc/ada/sem_ch5.adb | 12 +++++++----- gcc/ada/sem_ch6.adb | 28 ++++++++++++++++------------ gcc/ada/sem_ch6.ads | 14 +++++++------- gcc/ada/sem_ch8.adb | 8 ++++++-- gcc/ada/sem_ch8.ads | 20 ++++++++++---------- gcc/ada/sem_util.adb | 30 ++++++++++++++---------------- 15 files changed, 115 insertions(+), 95 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6228f99..97fc48e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2011-08-01 Robert Dewar + + * sem_ch3.adb, sem_ch3.ads, sem_ch5.adb, prj-part.adb, par-ch4.adb, + sem_util.adb, sem_ch4.adb, sem_ch6.adb, sem_ch6.ads, sem_ch8.adb, + sem_ch8.ads, sem_ch13.ads, par-ch5.adb, prj-env.ads: Minor reformatting + 2011-08-01 Pascal Obry * prj-part.ads, prj-part.adb (Parse): Add Target_Name parameter. Pass diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index a351446..e80a7cc 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -673,6 +673,7 @@ package body Ch4 is Formal_Error_Msg_SP ("no mixing of positional and named " & "parameter association"); end if; + Restore_Scan_State (Scan_State); -- to Id goto LP_State_Call; diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index 9a390ab..27bc899f 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -2138,8 +2138,9 @@ package body Ch5 is Inner : while Present (Decl) loop if (Nkind (Decl) not in N_Later_Decl_Item - or else (SPARK_Mode - and then Nkind (Decl) = N_Package_Declaration)) + or else (SPARK_Mode + and then + Nkind (Decl) = N_Package_Declaration)) and then Nkind (Decl) /= N_Pragma then if Ada_Version = Ada_83 then diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index d9d9a69..b576e2d 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -35,7 +35,7 @@ package Prj.Env is -- Initialize global components relative to environment variables procedure Print_Sources (In_Tree : Project_Tree_Ref); - -- Output the list of sources, after Project files have been scanned + -- Output the list of sources after Project files have been scanned procedure Create_Mapping (In_Tree : Project_Tree_Ref); -- Create in memory mapping from the sources of all the projects (in body @@ -47,7 +47,7 @@ package Prj.Env is Path_FD : out File_Descriptor; Path_Name : out Path_Name_Type; File_Use : String); - -- Create temporary file, and fail with an error if it could not be created + -- Create temporary file, fail with an error if it could not be created procedure Create_Mapping_File (Project : Project_Id; @@ -55,27 +55,26 @@ package Prj.Env is In_Tree : Project_Tree_Ref; Name : out Path_Name_Type); -- Create a temporary mapping file for project Project. For each source or - -- template of Language in the Project, put the mapping of its file - -- name and path name in this file. + -- template of Language in the Project, put the mapping of its file name + -- and path name in this file. See fmap for a description of the format + -- of the mapping file. -- -- Implementation note: we pass a language name, not a language_index here, -- since the latter would have to match exactly the index of that language -- for the specified project, and that is not information available in -- buildgpr.adb. - -- - -- See fmap for a description of the format of the mapping file procedure Create_Config_Pragmas_File (For_Project : Project_Id; In_Tree : Project_Tree_Ref); - -- If there needs to have SFN pragmas, either for non standard naming - -- schemes or for individual units. + -- If we need SFN pragmas, either for non standard naming schemes or for + -- individual units. procedure Create_New_Path_File (In_Tree : Project_Tree_Ref; Path_FD : out File_Descriptor; Path_Name : out Path_Name_Type); - -- Create a new temporary path file. Get the file name in Path_Name + -- Create a new temporary path file, placing file name in Path_Name function Ada_Include_Path (Project : Project_Id; @@ -115,7 +114,6 @@ package Prj.Env is -- name of the spec is returned. -- -- If Full_Path is False (the default), the simple file name is returned. - -- -- If Full_Path is True, the absolute path name is returned. -- -- If neither a body nor a spec can be found, an empty string is returned. @@ -152,16 +150,16 @@ package Prj.Env is generic with procedure Action (Path : String); procedure For_All_Object_Dirs (Project : Project_Id); - -- Iterate through all the object directories of a project, including - -- those of imported or modified projects. + -- Iterate through all the object directories of a project, including those + -- of imported or modified projects. ------------------ -- Project Path -- ------------------ type Project_Search_Path is private; - -- An abstraction of the project path. This object provides subprograms to - -- search for projects on the path (and caches the results for more + -- An abstraction of the project path. This object provides subprograms + -- to search for projects on the path (and caches the results to improve -- efficiency). procedure Free (Self : in out Project_Search_Path); @@ -176,8 +174,7 @@ package Prj.Env is -- will remove the default project directory from the project path. -- -- Calls to this subprogram must be performed before the first call to - -- Find_Project below, or PATH will be added at the end of the search - -- path. + -- Find_Project below, or PATH will be added at the end of the search path. procedure Get_Path (Self : in out Project_Search_Path; @@ -185,13 +182,13 @@ package Prj.Env is Target_Name : String := ""); -- Return the current value of the project path, either the value set -- during elaboration of the package or, if procedure Set_Project_Path has - -- been called, the value set by the last call to Set_Project_Path. - -- The returned value must not be modified. + -- been called, the value set by the last call to Set_Project_Path. The + -- returned value must not be modified. procedure Set_Path (Self : in out Project_Search_Path; Path : String); - -- Override the value of the project path. - -- This also removes the implicit default search directories + -- Override the value of the project path. This also removes the implicit + -- default search directories procedure Find_Project (Self : in out Project_Search_Path; @@ -220,9 +217,9 @@ private type Project_Search_Path is record Path : GNAT.OS_Lib.String_Access; - -- As a special case, if the first character is '#:" or this variable is - -- unset, this means that the PATH has not been fully initialized yet - -- (although subprograms above will properly take care of that). + -- As a special case, if the first character is '#:" or this variable + -- is unset, this means that the PATH has not been fully initialized + -- yet (although subprograms above will properly take care of that). Cache : Projects_Paths.Instance; end record; diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 635c8ef..3219e68 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -1552,7 +1552,9 @@ package body Prj.Part is declare Original_Path_Name : constant String := Get_Name_String (Token_Name); + Extended_Project_Path_Name_Id : Path_Name_Type; + begin Find_Project (In_Tree.Project_Path, @@ -1569,8 +1571,7 @@ package body Prj.Part is Error_Msg (Flags, "unknown project file: %%", Token_Ptr); - -- If we are not in the main project file, display the - -- import path. + -- If not in the main project file, display the import path if Project_Stack.Last > 1 then Error_Msg_Name_1 := @@ -1621,8 +1622,8 @@ package body Prj.Part is end if; -- An abstract project can only extend an abstract - -- project, otherwise we may have an abstract project - -- with sources, if it inherits sources from the project + -- project. Otherwise we may have an abstract project + -- with sources if it inherits sources from the project -- it extends. if Project_Qualifier_Of (Project, In_Tree) = Dry and then diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index 32b3237..80d44e6 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -41,9 +41,9 @@ package Sem_Ch13 is E : Entity_Id; L : List_Id); -- This procedure is called to analyze aspect specifications for node N. - -- E is the corresponding entity declared by the declaration node N, and L - -- is the list of aspect specifications for this node. If L is No_List, the - -- call is ignored. Note that we can't use a simpler interface of just + -- E is the corresponding entity declared by the declaration node N, and + -- L is the list of aspect specifications for this node. If L is No_List, + -- the call is ignored. Note that we can't use a simpler interface of just -- passing the node N, since the analysis of the node may cause it to be -- rewritten to a node not permitting aspect specifications. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 7418084..5aaf772 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2028,7 +2028,7 @@ package body Sem_Ch3 is while Present (D) loop -- Package specification cannot contain a package declaration in - -- SPARK or ALFA + -- SPARK or ALFA. if Formal_Verification_Mode and then Nkind (D) = N_Package_Declaration diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index 064b0f7..7888a32 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -171,10 +171,10 @@ package Sem_Ch3 is -- Constraint, return the value of that discriminant. function Is_Constant_Bound (Exp : Node_Id) return Boolean; - -- Determines whether the given bound is a compile-time known value, or a - -- constant entity, or an enumeration literal, or an expression composed - -- of constant-bound subexpressions which are evaluated by means of - -- standard operators. + -- Exp is the expression for an array bound. Determines whether the + -- bound is a compile-time known value, or a constant entity, or an + -- enumeration literal, or an expression composed of constant-bound + -- subexpressions which are evaluated by means of standard operators. function Is_Null_Extension (T : Entity_Id) return Boolean; -- Returns True if the tagged type T has an N_Full_Type_Declaration that diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 76a308d..cd247cb 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -1494,17 +1494,23 @@ package body Sem_Ch4 is begin Set_Etype (N, Any_Type); + + -- Shouldn't the following statement be down in the ELSE of the + -- following loop? ??? + Get_First_Interp (Then_Expr, I, It); - if No (Else_Expr) then - -- if no else_expression the conditional must be boolean. + -- if no Else_Expression the conditional must be boolean + + if No (Else_Expr) then Set_Etype (N, Standard_Boolean); - else - while Present (It.Nam) loop - -- For each possible intepretation of the Then Expression, - -- add it only if the else expression has a compatible type. + -- Else_Expression Present. For each possible intepretation of + -- the Then_Expression, add it only if the Else_Expression has + -- a compatible type. + else + while Present (It.Nam) loop if Has_Compatible_Type (Else_Expr, It.Typ) then Add_One_Interp (N, It.Typ, It.Typ); end if; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 3556590..42b474a 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1100,7 +1100,7 @@ package body Sem_Ch5 is Analyze_Choices (N, Exp_Type, Dont_Care, Others_Present); -- A case statement with a single "others" alternative is not allowed - -- in SPARK or ALFA + -- in SPARK or ALFA. if Formal_Verification_Mode and then Others_Present @@ -1225,7 +1225,7 @@ package body Sem_Ch5 is end if; -- In formal mode, verify that the exit statement respects the SPARK - -- restrictions + -- restrictions. if Formal_Verification_Mode then if Present (Cond) then @@ -1233,6 +1233,7 @@ package body Sem_Ch5 is Formal_Error_Msg_N ("exit with when clause must be directly in loop", N); end if; + else if Nkind (Parent (N)) /= N_If_Statement then if Nkind (Parent (N)) = N_Elsif_Part then @@ -1240,17 +1241,18 @@ package body Sem_Ch5 is else Formal_Error_Msg_N ("exit must be directly in IF", N); end if; + elsif Nkind (Parent (Parent (N))) /= N_Loop_Statement then Formal_Error_Msg_N ("exit must be in IF directly in loop", N); -- First test the presence of ELSE, so that an exit in an ELSE - -- leads to an error mentioning the ELSE + -- leads to an error mentioning the ELSE. elsif Present (Else_Statements (Parent (N))) then Formal_Error_Msg_N ("exit must be in IF without ELSE", N); -- An exit in an ELSIF does not reach here, as it would have been - -- detected in the case (Nkind (Parent (N)) /= N_If_Statement) + -- detected in the case (Nkind (Parent (N)) /= N_If_Statement). elsif Present (Elsif_Parts (Parent (N))) then Formal_Error_Msg_N ("exit must be in IF without ELSIF", N); @@ -1866,7 +1868,7 @@ package body Sem_Ch5 is end; -- Loop parameter specification must include subtype mark in - -- SPARK or ALFA + -- SPARK or ALFA. if Formal_Verification_Mode and then Nkind (DS) = N_Range diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index d96499d..530a51c 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -335,9 +335,10 @@ package body Sem_Ch6 is Error_Msg_N ("illegal context for return statement", N); end if; - if Kind = E_Function or else Kind = E_Generic_Function then + if Ekind_In (Kind, E_Function, E_Generic_Function) then Analyze_Function_Return (N); - elsif Kind = E_Procedure or else Kind = E_Generic_Procedure then + + elsif Ekind_In (Kind, E_Procedure, E_Generic_Procedure) then Set_Return_Present (Scope_Id); end if; @@ -685,13 +686,13 @@ package body Sem_Ch6 is Check_Limited_Return (Expr); -- The only RETURN allowed in SPARK or ALFA is as the last statement - -- of the function + -- of the function. if Formal_Verification_Mode and then Nkind (Parent (N)) /= N_Handled_Sequence_Of_Statements and then (Nkind (Parent (Parent (N))) /= N_Subprogram_Body - or else Present (Next (N))) + or else Present (Next (N))) then Formal_Error_Msg_N ("RETURN should be the last statement in function", N); @@ -1633,9 +1634,9 @@ package body Sem_Ch6 is procedure Check_Missing_Return; -- Checks for a function with a no return statements, and also performs - -- the warning checks implemented by Check_Returns. - -- In formal mode, also verify that a function ends with a RETURN and - -- that a procedure does not contain any RETURN. + -- the warning checks implemented by Check_Returns. In formal mode, also + -- verify that a function ends with a RETURN and that a procedure does + -- not contain any RETURN. function Disambiguate_Spec return Entity_Id; -- When a primitive is declared between the private view and the full @@ -1845,16 +1846,16 @@ package body Sem_Ch6 is Id := Body_Id; end if; - -- In formal mode, the last statement of a function should be - -- a return statement + -- In formal mode, the last statement of a function should be a + -- return statement. if Formal_Verification_Mode then declare Last_Kind : constant Node_Kind := Nkind (Last (Statements (HSS))); begin - if Last_Kind /= N_Simple_Return_Statement - and then Last_Kind /= N_Extended_Return_Statement + if not Nkind_In (Last_Kind, N_Simple_Return_Statement, + N_Extended_Return_Statement) then Formal_Error_Msg_N ("last statement in function should be RETURN", N); @@ -1886,6 +1887,9 @@ package body Sem_Ch6 is Id := Body_Id; end if; + -- Would be nice to point to return statement here, can we + -- borrow the Check_Returns procedure here ??? + if Return_Present (Id) then Formal_Error_Msg_N ("procedure should not have RETURN", N); end if; @@ -6100,7 +6104,7 @@ package body Sem_Ch6 is if Scope (E) /= Scope (S) and then (not Is_Overloadable (E) - or else Subtype_Conformant (E, S)) + or else Subtype_Conformant (E, S)) and then (Is_Immediately_Visible (E) or else Is_Potentially_Use_Visible (S)) diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads index 2fc59b4..90fd520 100644 --- a/gcc/ada/sem_ch6.ads +++ b/gcc/ada/sem_ch6.ads @@ -204,8 +204,8 @@ package Sem_Ch6 is Derived_Type : Entity_Id := Empty); -- Process new overloaded entity. Overloaded entities are created by -- enumeration type declarations, subprogram specifications, entry - -- declarations, and (implicitly) by type derivations. Derived_Type non- - -- Empty indicates that this is a subprogram derived for that type. + -- declarations, and (implicitly) by type derivations. If Derived_Type + -- is non-empty then this is a subprogram derived for that type. procedure Process_Formals (T : List_Id; Related_Nod : Node_Id); -- Enter the formals in the scope of the subprogram or entry, and @@ -239,7 +239,7 @@ package Sem_Ch6 is Old_Id : Entity_Id; Skip_Controlling_Formals : Boolean := False) return Boolean; -- Determine whether two callable entities (subprograms, entries, literals) - -- are subtype conformant (RM6.3.1(16)). Skip_Controlling_Formals is True + -- are subtype conformant (RM 6.3.1(16)). Skip_Controlling_Formals is True -- when checking the conformance of a subprogram that implements an -- interface operation. In that case, only the non-controlling formals -- can (and must) be examined. @@ -249,10 +249,10 @@ package Sem_Ch6 is Old_Id : Entity_Id; Skip_Controlling_Formals : Boolean := False) return Boolean; -- Determine whether two callable entities (subprograms, entries, literals) - -- are type conformant (RM6.3.1(14)). Skip_Controlling_Formals is True when - -- checking the conformance of a subprogram that implements an interface - -- operation. In that case, only the non-controlling formals can (and must) - -- be examined. + -- are type conformant (RM 6.3.1(14)). Skip_Controlling_Formals is True + -- when checking the conformance of a subprogram that implements an + -- interface operation. In that case, only the non-controlling formals + -- can (and must) be examined. procedure Valid_Operator_Definition (Designator : Entity_Id); -- Verify that an operator definition has the proper number of formals diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 852888c..59e9610 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6282,11 +6282,15 @@ package body Sem_Ch8 is -- active set of scopes. for J in reverse 0 .. Scope_Stack.Last loop + + -- S was reached without seing a loop scope first + if Scope_Stack.Table (J).Entity = S then - -- S was reached without seing a loop scope first return False; + + -- S was not yet reached, so it contains at least one inner loop + elsif Ekind (Scope_Stack.Table (J).Entity) = E_Loop then - -- S was not yet reached, so it contains at least one inner loop return True; end if; diff --git a/gcc/ada/sem_ch8.ads b/gcc/ada/sem_ch8.ads index bf5fb3d..6d02a41 100644 --- a/gcc/ada/sem_ch8.ads +++ b/gcc/ada/sem_ch8.ads @@ -102,13 +102,13 @@ package Sem_Ch8 is -- processing for 'Class attribute references. function Has_Loop_In_Inner_Open_Scopes (S : Entity_Id) return Boolean; - -- S is the entity of an open scope. This function determines if there - -- is an inner scope of S which is a loop (i.e. it appears somewhere in - -- the scope stack after S). + -- S is the entity of an open scope. This function determines if there is + -- an inner scope of S which is a loop (i.e. it appears somewhere in the + -- scope stack after S). function In_Open_Scopes (S : Entity_Id) return Boolean; - -- S is the entity of a scope. This function determines if this scope - -- is currently open (i.e. it appears somewhere in the scope stack). + -- S is the entity of a scope. This function determines if this scope is + -- currently open (i.e. it appears somewhere in the scope stack). procedure Initialize; -- Initializes data structures used for visibility analysis. Must be @@ -125,13 +125,13 @@ package Sem_Ch8 is -- analysis of the subunit, the parent's environment is again identical. procedure Push_Scope (S : Entity_Id); - -- Make new scope stack entry, pushing S, the entity for a scope - -- onto the top of the scope table. The current setting of the scope - -- suppress flags is saved for restoration on exit. + -- Make new scope stack entry, pushing S, the entity for a scope onto the + -- top of the scope table. The current setting of the scope suppress flags + -- is saved for restoration on exit. procedure Pop_Scope; - -- Remove top entry from scope stack, restoring the saved setting - -- of the scope suppress flags. + -- Remove top entry from scope stack, restoring the saved setting of the + -- scope suppress flags. function Present_System_Aux (N : Node_Id := Empty) return Boolean; -- Return True if the auxiliary system file has been successfully loaded. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 1096208..9974ec9 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3200,32 +3200,30 @@ package body Sem_Util is Append_Entity (Def_Id, S); Set_Public_Status (Def_Id); - -- Declaring an homonym is not allowed in SPARK or ALFA... + -- Declaring a homonym is not allowed in SPARK or ALFA ... if Formal_Verification_Mode and then Present (C) - -- ...unless the new declaration is in a subprogram, and the visible + -- ... unless the new declaration is in a subprogram, and the visible -- declaration is a variable declaration or a parameter specification - -- outside that subprogram; + -- outside that subprogram. and then not - (Nkind_In (Parent (Parent (Def_Id)), - N_Subprogram_Body, - N_Function_Specification, - N_Procedure_Specification) + (Nkind_In (Parent (Parent (Def_Id)), N_Subprogram_Body, + N_Function_Specification, + N_Procedure_Specification) and then - Nkind_In (Parent (C), - N_Object_Declaration, - N_Parameter_Specification)) + Nkind_In (Parent (C), N_Object_Declaration, + N_Parameter_Specification)) - -- ...or the new declaration is in a package, and the visible - -- declaration occurs outside that package; + -- ... or the new declaration is in a package, and the visible + -- declaration occurs outside that package. - and then not Nkind_In (Parent (Parent (Def_Id)), - N_Package_Specification, - N_Package_Body) + and then not + Nkind_In (Parent (Parent (Def_Id)), N_Package_Specification, + N_Package_Body) - -- ...or the new declaration is a component declaration in a record + -- ... or the new declaration is a component declaration in a record -- type definition. and then Nkind (Parent (Def_Id)) /= N_Component_Declaration -- 2.7.4