From bfe2554f052b11ecf07d93cb04137f3fca5c6e6d Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Sun, 18 Apr 2021 09:45:04 -0400 Subject: [PATCH] [Ada] Fix the -gnatyr switch so it works in record rep clauses gcc/ada/ * sem_ch13.adb (Analyze_Record_Representation_Clause): Call Set_Entity_With_Checks instead of Set_Entity, so we perform the check for correct casing. * style.adb (Check_Identifier): Minor comment improvement. Cleanup overly complicated code. --- gcc/ada/sem_ch13.adb | 2 +- gcc/ada/style.adb | 50 ++++++++++++++++++++++---------------------------- 2 files changed, 23 insertions(+), 29 deletions(-) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index d7667f2..dcd5954 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -8561,7 +8561,7 @@ package body Sem_Ch13 is Generate_Reference (Comp, Component_Name (CC), Set_Ref => False); - Set_Entity (Component_Name (CC), Comp); + Set_Entity_With_Checks (Component_Name (CC), Comp); -- Update Fbit and Lbit to the actual bit number diff --git a/gcc/ada/style.adb b/gcc/ada/style.adb index a34d3e0..1409cc6 100644 --- a/gcc/ada/style.adb +++ b/gcc/ada/style.adb @@ -136,48 +136,42 @@ package body Style is Tref := Source_Text (Get_Source_File_Index (Sref)); Tdef := Source_Text (Get_Source_File_Index (Sdef)); - -- Ignore operator name case completely. This also catches the - -- case of where one is an operator and the other is not. This - -- is a phenomenon from rewriting of operators as functions, - -- and is to be ignored. + -- Ignore case of operator names. This also catches the case + -- where one is an operator and the other is not. This is a + -- phenomenon from rewriting of operators as functions, and is + -- to be ignored. if Tref (Sref) = '"' or else Tdef (Sdef) = '"' then return; else - while Tref (Sref) = Tdef (Sdef) loop + loop + -- If end of identifiers, all done. Note that they are the + -- same length. - -- If end of identifier, all done + pragma Assert + (Identifier_Char (Tref (Sref)) = + Identifier_Char (Tdef (Sdef))); if not Identifier_Char (Tref (Sref)) then return; - - -- Otherwise loop continues - - else - Sref := Sref + 1; - Sdef := Sdef + 1; end if; - end loop; - -- Fall through loop when mismatch between identifiers - -- If either identifier is not terminated, error. + -- Case mismatch - if Identifier_Char (Tref (Sref)) - or else - Identifier_Char (Tdef (Sdef)) - then - Error_Msg_Node_1 := Def; - Error_Msg_Sloc := Sloc (Def); - Error_Msg -- CODEFIX - ("(style) bad casing of & declared#", Sref, Ref); - return; + if Tref (Sref) /= Tdef (Sdef) then + Error_Msg_Node_1 := Def; + Error_Msg_Sloc := Sloc (Def); + Error_Msg -- CODEFIX + ("(style) bad casing of & declared#", Sref, Ref); + return; + end if; - -- Else end of identifiers, and they match + Sref := Sref + 1; + Sdef := Sdef + 1; + end loop; - else - return; - end if; + pragma Assert (False); end if; end if; -- 2.7.4