From patchwork Thu Jun 17 14:33:10 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1493563 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4G5Pnj1KRqz9sSs for ; Fri, 18 Jun 2021 00:39:05 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id A7837395C036 for ; Thu, 17 Jun 2021 14:39:02 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTPS id 14EDD393FC29 for ; Thu, 17 Jun 2021 14:33:12 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 14EDD393FC29 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id B4DF15604D; Thu, 17 Jun 2021 10:33:10 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id tTxH11a8umSt; Thu, 17 Jun 2021 10:33:10 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id A238D116AF6; Thu, 17 Jun 2021 10:33:10 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 9E336A3; Thu, 17 Jun 2021 10:33:10 -0400 (EDT) Date: Thu, 17 Jun 2021 10:33:10 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Subject: [Ada] Removal of technical debt Message-ID: <20210617143310.GA8968@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-12.2 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_ASCII_DIVIDERS, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Justin Squirek Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" This is an iterative patch as part of a greater project to reduce the amount of technical debt present in the frontend of the compiler. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_ch3.adb (Check_Missing_Others): Add comment. (Build_Initialization_Call): Remove inaccurate accessibility comment. * sem_ch12.adb (Analyze_Generic_Subprogram_Declaration): Remove test for Ada2012. (Analyze_Package_Instantiation): Remove speculative comment. (Inline_Instance_Body): Add comments for loops. (Build_Subprogram_Renaming): Remove comment about fix being partial and "ugly." (Instantiate_Subprogram_Body): Remove comment referencing DEC related internal issue. (Subtypes_Match): Add comment and simplify anonymous access test. (Is_Global): Add test for when E is an expanded name, and calculate the scope accordingly. * sem_ch6.adb (Analyze_Function_Return): Update comment regarding accessibility, and add check for Warn_On_Ada_2012_Compatibility. (Mask_Type_Refs): Add comments. (Analyze_Subprogram_Declaration): Remove mysterious suppression of elaboration checks. * sem_ch7.adb (Preserve_Full_Attributes): Preserve Is_Atomic value. * sem_ch8.adb (Most_Descendant_Use_Clause): Remove comment. (Note_Redundant_Use): Fix calls to Find_First_Use to be Find_Most_Prev. (Get_Object_Name): Modify error message to be more descriptive. (Known_But_Visible): Remove mysterious special case for GNAT_Mode. (Find_First_Use): Removed. (Find_Most_Prev): Renamed from Find_First_Use. * sem_prag.adb (Check_Static_Constraint): Add comments to routine. diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1502,7 +1502,8 @@ package body Exp_Ch3 is Typ : constant Entity_Id := Etype (Discr); procedure Check_Missing_Others (V : Node_Id); - -- ??? + -- Check that a given variant and its nested variants have an others + -- choice, and generate a constraint error raise when it does not. -------------------------- -- Check_Missing_Others -- @@ -1871,10 +1872,6 @@ package body Exp_Ch3 is -- Pass the extra accessibility level parameter associated with the -- level of the object being initialized when required. - -- When no entity is present for Id_Ref it may not have been fully - -- analyzed, so allow the default value of standard standard to be - -- passed ??? - if Is_Entity_Name (Id_Ref) and then Present (Init_Proc_Level_Formal (Proc)) then diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3903,12 +3903,7 @@ package body Sem_Ch12 is -- Check restriction imposed by AI05-073: a generic function -- cannot return an abstract type or an access to such. - -- This is a binding interpretation should it apply to earlier - -- versions of Ada as well as Ada 2012??? - - if Is_Abstract_Type (Designated_Type (Result_Type)) - and then Ada_Version >= Ada_2012 - then + if Is_Abstract_Type (Designated_Type (Result_Type)) then Error_Msg_N ("generic function cannot have an access result " & "that designates an abstract type", Spec); @@ -4539,10 +4534,7 @@ package body Sem_Ch12 is -- If the current scope is itself an instance within a child -- unit, there will be duplications in the scope stack, and the -- unstacking mechanism in Inline_Instance_Body will fail. - -- This loses some rare cases of optimization, and might be - -- improved some day, if we can find a proper abstraction for - -- "the complete compilation context" that can be saved and - -- restored. ??? + -- This loses some rare cases of optimization. if Is_Generic_Instance (Current_Scope) then declare @@ -4987,17 +4979,20 @@ package body Sem_Ch12 is if Gen_Comp /= Cunit_Entity (Current_Sem_Unit) then - -- Add some comments for the following two loops ??? + -- Loop through enclosing scopes until we reach a generic instance, + -- package body, or subprogram. S := Current_Scope; while Present (S) and then S /= Standard_Standard loop + + -- Save use clauses from enclosing scopes into Use_Clauses + loop Num_Scopes := Num_Scopes + 1; Use_Clauses (Num_Scopes) := (Scope_Stack.Table - (Scope_Stack.Last - Num_Scopes + 1). - First_Use_Clause); + (Scope_Stack.Last - Num_Scopes + 1).First_Use_Clause); End_Use_Clauses (Use_Clauses (Num_Scopes)); exit when Scope_Stack.Last - Num_Scopes + 1 = Scope_Stack.First @@ -5554,7 +5549,6 @@ package body Sem_Ch12 is -- If there is a formal subprogram with the same name as the unit -- itself, do not add this renaming declaration, to prevent -- ambiguities when there is a call with that name in the body. - -- This is a partial and ugly fix for one ACATS test. ??? Renaming_Decl := First (Renaming_List); while Present (Renaming_Decl) loop @@ -9764,6 +9758,7 @@ package body Sem_Ch12 is -- point of the current enclosing instance. Pending a better usage of -- Slocs to indicate instantiation places, we determine the place of -- origin of a node by finding the maximum sloc of any ancestor node. + -- Why is this not equivalent to Top_Level_Location ??? ------------------- @@ -12576,9 +12571,7 @@ package body Sem_Ch12 is -- errors, this may be an instance whose scope is a premature instance. -- In that case we must insure that the (legal) program does raise -- program error if executed. We generate a subprogram body for this - -- purpose. See DEC ac30vso. - - -- Should not reference proprietary DEC tests in comments ??? + -- purpose. elsif Serious_Errors_Detected = 0 and then Nkind (Parent (Inst_Node)) /= N_Compilation_Unit @@ -12705,7 +12698,7 @@ package body Sem_Ch12 is function Subtypes_Match (Gen_T, Act_T : Entity_Id) return Boolean; -- Check that base types are the same and that the subtypes match - -- statically. Used in several of the above. + -- statically. Used in several of the validation subprograms. -------------------------------------------- -- Check_Shared_Variable_Control_Aspects -- @@ -12840,7 +12833,9 @@ package body Sem_Ch12 is T : constant Entity_Id := Get_Instance_Of (Gen_T); begin - -- Some detailed comments would be useful here ??? + -- Check that the base types, root types (when dealing with class + -- wide types), or designated types (when dealing with anonymous + -- access types) of Gen_T and Act_T are statically matching subtypes. return ((Base_Type (T) = Act_T or else Base_Type (T) = Base_Type (Act_T)) @@ -12852,9 +12847,7 @@ package body Sem_Ch12 is (Get_Instance_Of (Root_Type (Gen_T)), Root_Type (Act_T))) - or else - (Ekind (Gen_T) in E_Anonymous_Access_Subprogram_Type - | E_Anonymous_Access_Type + or else (Is_Anonymous_Access_Type (Gen_T) and then Ekind (Act_T) = Ekind (Gen_T) and then Subtypes_Statically_Match (Designated_Type (Gen_T), Designated_Type (Act_T))); @@ -15626,7 +15619,8 @@ package body Sem_Ch12 is elsif Nkind (E) not in N_Entity then return False; - elsif Is_Child_Unit (E) + elsif Nkind (E) /= N_Expanded_Name + and then Is_Child_Unit (E) and then (Is_Instance_Node (Parent (N2)) or else (Nkind (Parent (N2)) = N_Expanded_Name and then N2 = Selector_Name (Parent (N2)) @@ -15636,7 +15630,19 @@ package body Sem_Ch12 is return True; else - Se := Scope (E); + -- E may be an expanded name - typically an operator - in which + -- case we must find its enclosing scope since expanded names + -- don't have corresponding scopes. + + if Nkind (E) = N_Expanded_Name then + Se := Find_Enclosing_Scope (E); + + -- Otherwise, E is an entity and will have Scope set + + else + Se := Scope (E); + end if; + while Se /= Gen_Scope loop if Se = Standard_Standard then return True; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1535,14 +1535,12 @@ package body Sem_Ch6 is -- Check RM 6.5 (5.9/3) if Has_Aliased then - if Ada_Version < Ada_2012 then - - -- Shouldn't this test Warn_On_Ada_2012_Compatibility ??? - -- Can it really happen (extended return???) - + if Ada_Version < Ada_2012 + and then Warn_On_Ada_2012_Compatibility + then Error_Msg_N ("ALIASED only allowed for limited return objects " - & "in Ada 2012??", N); + & "in Ada 2012?y?", N); elsif not Is_Limited_View (R_Type) then Error_Msg_N @@ -1674,9 +1672,9 @@ package body Sem_Ch6 is Related_Nod => N); end if; - -- ??? A real run-time accessibility check is needed in cases - -- involving dereferences of access parameters. For now we just - -- check the static cases. + -- Perform static accessibility checks for cases involving + -- dereferences of access parameters. Runtime accessibility checks + -- get generated elsewhere. if (Ada_Version < Ada_2005 or else Debug_Flag_Dot_L) and then Is_Limited_View (Etype (Scope_Id)) @@ -3827,7 +3825,8 @@ package body Sem_Ch6 is Result : Elist_Id := No_Elist; function Mask_Type_Refs (Node : Node_Id) return Traverse_Result; - -- Mask all types referenced in the subtree rooted at Node + -- Mask all types referenced in the subtree rooted at Node as + -- formally frozen. -------------------- -- Mask_Type_Refs -- @@ -3835,7 +3834,8 @@ package body Sem_Ch6 is function Mask_Type_Refs (Node : Node_Id) return Traverse_Result is procedure Mask_Type (Typ : Entity_Id); - -- ??? what does this do? + -- Mask a given type as formally frozen when outside the current + -- scope, or else freeze the type. --------------- -- Mask_Type -- @@ -5665,17 +5665,6 @@ package body Sem_Ch6 is end; end if; - -- What is the following code for, it used to be - - -- ??? Set_Suppress_Elaboration_Checks - -- ??? (Designator, Elaboration_Checks_Suppressed (Designator)); - - -- The following seems equivalent, but a bit dubious - - if Elaboration_Checks_Suppressed (Designator) then - Set_Kill_Elaboration_Checks (Designator); - end if; - -- For a compilation unit, set body required. This flag will only be -- reset if a valid Import or Interface pragma is processed later on. diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -2722,6 +2722,7 @@ package body Sem_Ch7 is (Priv, Size_Known_At_Compile_Time (Full)); Set_Is_Volatile (Priv, Is_Volatile (Full)); Set_Treat_As_Volatile (Priv, Treat_As_Volatile (Full)); + Set_Is_Atomic (Priv, Is_Atomic (Full)); Set_Is_Ada_2005_Only (Priv, Is_Ada_2005_Only (Full)); Set_Is_Ada_2012_Only (Priv, Is_Ada_2012_Only (Full)); Set_Has_Pragma_Unmodified (Priv, Has_Pragma_Unmodified (Full)); @@ -2733,7 +2734,6 @@ package body Sem_Ch7 is if Is_Unchecked_Union (Full) then Set_Is_Unchecked_Union (Base_Type (Priv)); end if; - -- Why is atomic not copied here ??? if Referenced (Full) then Set_Referenced (Priv); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -481,11 +481,10 @@ package body Sem_Ch8 is -- legality of selector given the scope denoted by prefix, and change node -- N into a expanded name with a properly set Entity field. - function Find_Most_Prev (Use_Clause : Node_Id) return Node_Id; + function Find_First_Use (Use_Clause : Node_Id) return Node_Id; -- Find the most previous use clause (that is, the first one to appear in -- the source) by traversing the previous clause chain that exists in both -- N_Use_Package_Clause nodes and N_Use_Type_Clause nodes. - -- ??? a better subprogram name is in order function Find_Renamed_Entity (N : Node_Id; @@ -529,7 +528,6 @@ package body Sem_Ch8 is Clause2 : Entity_Id) return Entity_Id; -- Determine which use clause parameter is the most descendant in terms of -- scope. - -- ??? a better subprogram name is in order procedure Premature_Usage (N : Node_Id); -- Diagnose usage of an entity before it is visible @@ -1168,7 +1166,9 @@ package body Sem_Ch8 is and then Is_Anonymous_Access_Type (Etype (Expression (Nam))) and then not Is_Anonymous_Access_Type (T) then - Wrong_Type (Expression (Nam), T); -- Should we give better error??? + Error_Msg_NE + ("cannot rename anonymous access object " + & "as a named access type", Expression (Nam), T); end if; -- Check that a class-wide object is not being renamed as an object @@ -5314,16 +5314,6 @@ package body Sem_Ch8 is elsif not Comes_From_Source (E) then return False; - - -- In gnat internal mode, we consider all entities known. The - -- historical reason behind this discrepancy is not known??? But the - -- only effect is to modify the error message given, so it is not - -- critical. Since it only affects the exact wording of error - -- messages in illegal programs, we do not mention this as an - -- effect of -gnatg, since it is not a language modification. - - elsif GNAT_Mode then - return True; end if; -- Here we have an entity that is not from package Standard, and @@ -6989,10 +6979,10 @@ package body Sem_Ch8 is end Find_Expanded_Name; -------------------- - -- Find_Most_Prev -- + -- Find_First_Use -- -------------------- - function Find_Most_Prev (Use_Clause : Node_Id) return Node_Id is + function Find_First_Use (Use_Clause : Node_Id) return Node_Id is Curr : Node_Id; begin @@ -7004,7 +6994,7 @@ package body Sem_Ch8 is end loop; return Curr; - end Find_Most_Prev; + end Find_First_Use; ------------------------- -- Find_Renamed_Entity -- @@ -9804,16 +9794,16 @@ package body Sem_Ch8 is if Present (Redundant) and then Parent (Redundant) /= Prev_Use then -- Make sure we are looking at most-descendant use_package_clause - -- by traversing the chain with Find_Most_Prev and then verifying + -- by traversing the chain with Find_First_Use and then verifying -- there is no scope manipulation via Most_Descendant_Use_Clause. if Nkind (Prev_Use) = N_Use_Package_Clause and then (Nkind (Parent (Prev_Use)) /= N_Compilation_Unit or else Most_Descendant_Use_Clause - (Prev_Use, Find_Most_Prev (Prev_Use)) /= Prev_Use) + (Prev_Use, Find_First_Use (Prev_Use)) /= Prev_Use) then - Prev_Use := Find_Most_Prev (Prev_Use); + Prev_Use := Find_First_Use (Prev_Use); end if; Error_Msg_Sloc := Sloc (Prev_Use); @@ -10367,7 +10357,7 @@ package body Sem_Ch8 is if Present (Current_Use_Clause (T)) then Use_Clause_Known : declare Clause1 : constant Node_Id := - Find_Most_Prev (Current_Use_Clause (T)); + Find_First_Use (Current_Use_Clause (T)); Clause2 : constant Node_Id := Parent (Id); Ent1 : Entity_Id; Ent2 : Entity_Id; @@ -10507,10 +10497,10 @@ package body Sem_Ch8 is -- a spurious warning - so verify there is a previous use clause. if Current_Use_Clause (Scope (T)) /= - Find_Most_Prev (Current_Use_Clause (Scope (T))) + Find_First_Use (Current_Use_Clause (Scope (T))) then Error_Msg_Sloc := - Sloc (Find_Most_Prev (Current_Use_Clause (Scope (T)))); + Sloc (Find_First_Use (Current_Use_Clause (Scope (T)))); Error_Msg_NE -- CODEFIX ("& is already use-visible through package use clause #??", Id, T); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -4083,9 +4083,9 @@ package body Sem_Prag is procedure Check_Static_Constraint (Constr : Node_Id); -- Constr is a constraint from an N_Subtype_Indication node from a - -- component constraint in an Unchecked_Union type. This routine checks - -- that the constraint is static as required by the restrictions for - -- Unchecked_Union. + -- component constraint in an Unchecked_Union type, a range, or a + -- discriminant association. This routine checks that the constraint + -- is static as required by the restrictions for Unchecked_Union. procedure Check_Valid_Configuration_Pragma; -- Legality checks for placement of a configuration pragma @@ -6458,11 +6458,6 @@ package body Sem_Prag is -- Check_Static_Constraint -- ----------------------------- - -- Note: for convenience in writing this procedure, in addition to - -- the officially (i.e. by spec) allowed argument which is always a - -- constraint, it also allows ranges and discriminant associations. - -- Above is not clear ??? - procedure Check_Static_Constraint (Constr : Node_Id) is procedure Require_Static (E : Node_Id); @@ -6893,7 +6888,7 @@ package body Sem_Prag is Proc : Entity_Id := Empty; begin - -- The body of this procedure needs some comments ??? + -- Perform sanity checks on Name if not Is_Entity_Name (Name) then Error_Pragma_Arg @@ -6909,6 +6904,9 @@ package body Sem_Prag is ("argument of pragma% must be parameterless procedure", Arg); end if; + -- Otherwise, search through interpretations looking for one which + -- has no parameters. + else declare Found : Boolean := False; @@ -6923,10 +6921,17 @@ package body Sem_Prag is if Ekind (Proc) = E_Procedure and then No (First_Formal (Proc)) then + -- We found an interpretation, note it and continue + -- looking looking to verify it is unique. + if not Found then Found := True; Set_Entity (Name, Proc); Set_Is_Overloaded (Name, False); + + -- Two procedures with the same name, log an error + -- since the name is ambiguous. + else Error_Pragma_Arg ("ambiguous handler name for pragma%", Arg); @@ -6937,9 +6942,13 @@ package body Sem_Prag is end loop; if not Found then + -- Issue an error if we haven't found a suitable match for + -- Name. + Error_Pragma_Arg ("argument of pragma% must be parameterless procedure", Arg); + else Proc := Entity (Name); end if;