From 0d53d36b6e25fb2c306dc3d5a76b78e596795b6e Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 1 Aug 2011 17:54:39 +0200 Subject: [PATCH] [multiple changes] 2011-08-01 Yannick Moy * sem_util.adb (Enter_Name): issue error in formal mode on declaration of homonym, unless the homonym is one of the cases allowed in SPARK * par-ch5.adb (Parse_Decls_Begin_End): issue error in SPARK mode for package declaration occurring after a body. 2011-08-01 Robert Dewar * checks.adb, exp_ch4.adb: Minor reformatting. 2011-08-01 Javier Miranda * einfo.ads (Access_Disp_Table): Fix documentation. (Dispatch_Table_Wrappers): Fix documentation. 2011-08-01 Pascal Obry * prj-env.adb, prj-env.ads: Minor reformatting. From-SVN: r177053 --- gcc/ada/ChangeLog | 20 ++++++++++++++++++++ gcc/ada/checks.adb | 6 ++++-- gcc/ada/einfo.ads | 33 +++++++++++++++++---------------- gcc/ada/exp_ch4.adb | 1 - gcc/ada/par-ch5.adb | 6 +++++- gcc/ada/prj-env.adb | 12 ++++++------ gcc/ada/prj-env.ads | 2 +- gcc/ada/sem_util.adb | 39 +++++++++++++++++++++++++++++++++++++++ 8 files changed, 92 insertions(+), 27 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 810203732bd..e69a94cc5c5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2011-08-01 Yannick Moy + + * sem_util.adb (Enter_Name): issue error in formal mode on declaration + of homonym, unless the homonym is one of the cases allowed in SPARK + * par-ch5.adb (Parse_Decls_Begin_End): issue error in SPARK mode for + package declaration occurring after a body. + +2011-08-01 Robert Dewar + + * checks.adb, exp_ch4.adb: Minor reformatting. + +2011-08-01 Javier Miranda + + * einfo.ads (Access_Disp_Table): Fix documentation. + (Dispatch_Table_Wrappers): Fix documentation. + +2011-08-01 Pascal Obry + + * prj-env.adb, prj-env.ads: Minor reformatting. + 2011-08-01 Yannick Moy * sem_util.ads, sem_util.adb, par.adb, par_util.adb diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 62dd861557c..a1a91b6d7a3 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -4565,8 +4565,10 @@ package body Checks is ---------------------- function Entity_Of_Prefix return Entity_Id is - P : Node_Id := Prefix (N); + P : Node_Id; + begin + P := Prefix (N); while not Is_Entity_Name (P) loop if not Nkind_In (P, N_Selected_Component, N_Indexed_Component) @@ -4596,7 +4598,7 @@ package body Checks is if not Is_Array_Type (Etype (A)) or else (Present (A_Ent) - and then Index_Checks_Suppressed (A_Ent)) + and then Index_Checks_Suppressed (A_Ent)) or else Index_Checks_Suppressed (Etype (A)) then return; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index a451ddcd45c..4495f582680 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -338,18 +338,18 @@ package Einfo is -- statements referencing the same entry. -- Access_Disp_Table (Elist16) [implementation base type only] --- Present in record types and subtypes. Set in tagged types to point to --- the dispatch tables associated with the tagged type. The first two --- entities correspond with the primary dispatch table: 1) primary --- dispatch table with user-defined primitives, 2) primary dispatch table --- with predefined primitives. For each interface type covered by the --- tagged type we also have: 3) secondary dispatch table with thunks of --- primitives covering user-defined interface primitives, 4) secondary --- dispatch table with thunks of predefined primitives, 5) secondary --- dispatch table with user-defined primitives, and 6) secondary dispatch --- table with predefined primitives. The last entity of this list is an --- access type declaration used to expand dispatching calls through the --- primary dispatch table. For a non-tagged record, contains No_Elist. +-- Present in E_Record_Type and E_Record_Subtype entities. Set in tagged +-- types to point to their dispatch tables. The first two entities are +-- associated with the primary dispatch table: 1) primary dispatch table +-- with user-defined primitives 2) primary dispatch table with predefined +-- primitives. For each interface type covered by the tagged type we also +-- have: 3) secondary dispatch table with thunks of primitives covering +-- user-defined interface primitives, 4) secondary dispatch table with +-- thunks of predefined primitives, 5) secondary dispatch table with user +-- defined primitives, and 6) secondary dispatch table with predefined +-- primitives. The last entity of this list is an access type declaration +-- used to expand dispatching calls through the primary dispatch table. +-- For a non-tagged record, contains No_Elist. -- Actual_Subtype (Node17) -- Present in variables, constants, and formal parameters. This is the @@ -855,10 +855,11 @@ package Einfo is -- index starting at 1 and ranging up to number of discriminants. -- Dispatch_Table_Wrappers (Elist26) [implementation base type only] --- Present in record types and subtypes. Set in library level tagged type --- entities if we are generating statically allocated dispatch tables. --- Points to the list of dispatch table wrappers associated with the --- tagged type. For a non-tagged record, contains No_Elist. +-- Present in E_Record_Type and E_Record_Subtype entities. Set in library +-- level tagged type entities if we are generating statically allocated +-- dispatch tables. Points to the list of dispatch table wrappers +-- associated with the tagged type. For a non-tagged record, contains +-- No_Elist. -- DTC_Entity (Node16) -- Present in function and procedure entities. Set to Empty unless diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 34e49247835..5615ac912dd 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -876,7 +876,6 @@ package body Exp_Ch4 is if Present (TagT) then declare Full_T : constant Entity_Id := Underlying_Type (TagT); - begin Tag_Assign := Make_Assignment_Statement (Loc, diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index acea49b7445..9a390ab03a0 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -2114,6 +2114,8 @@ package body Ch5 is -- The same is true for the SPARK mode: although SPARK 95 removes -- the distinction between initial and later declarative items, -- the distinction remains in the Examiner. (JB01-005) + -- Note that the Examiner does not count package declarations in later + -- declarative items. if Ada_Version = Ada_83 or else SPARK_Mode then Decl := First (Decls); @@ -2135,7 +2137,9 @@ package body Ch5 is Body_Sloc := Sloc (Decl); Inner : while Present (Decl) loop - if Nkind (Decl) not in N_Later_Decl_Item + if (Nkind (Decl) not in N_Later_Decl_Item + 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.adb b/gcc/ada/prj-env.adb index 1114ab34205..2e0cb8a915d 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -2013,9 +2013,9 @@ package body Prj.Env is ------------------- function Try_Path_Name (Path : String) return String_Access is - First : Natural; - Last : Natural; - Result : String_Access := null; + First : Natural; + Last : Natural; + Result : String_Access := null; begin if Current_Verbosity = High then @@ -2080,9 +2080,9 @@ package body Prj.Env is -- Local Declarations - Result : String_Access; - Has_Dot : Boolean := False; - Key : Name_Id; + Result : String_Access; + Has_Dot : Boolean := False; + Key : Name_Id; -- Start of processing for Find_Project diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index c7500236817..cd6145dcfde 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -75,7 +75,7 @@ package Prj.Env is (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. Get the file name in Path_Name function Ada_Include_Path (Project : Project_Id; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 6631e1c04fd..1096208cdf9 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3200,6 +3200,45 @@ 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... + + if Formal_Verification_Mode and then Present (C) + + -- ...unless the new declaration is in a subprogram, and the visible + -- declaration is a variable declaration or a parameter specification + -- outside that subprogram; + + and then not + (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)) + + -- ...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) + + -- ...or the new declaration is a component declaration in a record + -- type definition. + + and then Nkind (Parent (Def_Id)) /= N_Component_Declaration + + -- Don't issue error for non-source entities + + and then Comes_From_Source (Def_Id) + and then Comes_From_Source (C) + then + Error_Msg_Sloc := Sloc (C); + Formal_Error_Msg_N ("redeclaration of identifier &#", Def_Id); + end if; + -- Warn if new entity hides an old one if Warn_On_Hiding and then Present (C) -- 2.30.2