From 4627db38d111f3e1a1d468f03acbf24e760469cc Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 9 Sep 2010 12:18:17 +0000 Subject: [PATCH] 2010-09-09 Robert Dewar * sem_res.adb (Resolve_Type_Conversion): Catch more cases of redundant conversions. 2010-09-09 Vincent Celier * gnatlbr.adb: Remove redundant conversions. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164079 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 9 +++++++ gcc/ada/gnatlbr.adb | 7 +++-- gcc/ada/sem_res.adb | 78 ++++++++++++++++++++++++++++++++++++++--------------- 3 files changed, 68 insertions(+), 26 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2c0de6f..1427747 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2010-09-09 Robert Dewar + + * sem_res.adb (Resolve_Type_Conversion): Catch more cases of redundant + conversions. + +2010-09-09 Vincent Celier + + * gnatlbr.adb: Remove redundant conversions. + 2010-09-09 Vincent Celier * prj-proc.adb: Minor comment spelling error fix. diff --git a/gcc/ada/gnatlbr.adb b/gcc/ada/gnatlbr.adb index 38526bd..27962a4 100644 --- a/gcc/ada/gnatlbr.adb +++ b/gcc/ada/gnatlbr.adb @@ -194,8 +194,8 @@ begin loop declare - Dir : constant String_Access := String_Access - (Get_Next_Dir_In_Path (Include_Dir_Name)); + Dir : constant String_Access := + Get_Next_Dir_In_Path (Include_Dir_Name); begin exit when Dir = null; Include_Dirs := Include_Dirs + 1; @@ -211,8 +211,7 @@ begin loop declare Dir : constant String_Access := - String_Access - (Get_Next_Dir_In_Path (Object_Dir_Name)); + Get_Next_Dir_In_Path (Object_Dir_Name); begin exit when Dir = null; Object_Dirs := Object_Dirs + 1; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index fc138f4..cc59f4d 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6505,13 +6505,10 @@ package body Sem_Res is -- be anonymous access types. elsif Ada_Version >= Ada_2012 - and then Ekind_In (Etype (L), - E_Anonymous_Access_Type, - E_Anonymous_Access_Subprogram_Type) - - and then Ekind_In (Etype (R), - E_Anonymous_Access_Type, - E_Anonymous_Access_Subprogram_Type) + and then Ekind_In (Etype (L), E_Anonymous_Access_Type, + E_Anonymous_Access_Subprogram_Type) + and then Ekind_In (Etype (R), E_Anonymous_Access_Type, + E_Anonymous_Access_Subprogram_Type) then Check_Conditional_Expression (L); Check_Conditional_Expression (R); @@ -8655,6 +8652,10 @@ package body Sem_Res is Orig_N : Node_Id; Orig_T : Node_Id; + Test_Redundant : Boolean := Warn_On_Redundant_Constructs; + -- Set to False to suppress cases where we want to suppress the test + -- for redundancy to avoid possible false positives on this warning. + begin if not Conv_OK and then not Valid_Conversion (N, Target_Typ, Operand) @@ -8662,7 +8663,20 @@ package body Sem_Res is return; end if; - if Etype (Operand) = Any_Fixed then + -- If the Operand Etype is Universal_Fixed, then the conversion is + -- never redundant. We need this check because by the time we have + -- finished the rather complex transformation, the conversion looks + -- redundant when it is not. + + if Operand_Typ = Universal_Fixed then + Test_Redundant := False; + + -- If the operand is marked as Any_Fixed, then special processing is + -- required. This is also a case where we suppress the test for a + -- redundant conversion, since most certainly it is not redundant. + + elsif Operand_Typ = Any_Fixed then + Test_Redundant := False; -- Mixed-mode operation involving a literal. Context must be a fixed -- type which is applied to the literal subsequently. @@ -8768,9 +8782,13 @@ package body Sem_Res is Orig_N := Original_Node (N); - if Warn_On_Redundant_Constructs - and then Comes_From_Source (Orig_N) + -- Here we test for a redundant conversion if the warning mode is + -- active (and was not locally reset), and we have a type conversion + -- from source not appearing in a generic instance. + + if Test_Redundant and then Nkind (Orig_N) = N_Type_Conversion + and then Comes_From_Source (Orig_N) and then not In_Instance then Orig_N := Original_Node (Expression (Orig_N)); @@ -8786,12 +8804,21 @@ package body Sem_Res is Orig_T := Etype (Parent (N)); end if; - if Is_Entity_Name (Orig_N) - and then - (Etype (Entity (Orig_N)) = Orig_T - or else - (Ekind (Entity (Orig_N)) = E_Loop_Parameter - and then Covers (Orig_T, Etype (Entity (Orig_N))))) + -- if we have an entity name, then give the warning if the entity + -- is the right type, or if it is a loop parameter covered by the + -- original type (that's needed because loop parameters have an + -- odd subtype coming from the bounds). + + if (Is_Entity_Name (Orig_N) + and then + (Etype (Entity (Orig_N)) = Orig_T + or else + (Ekind (Entity (Orig_N)) = E_Loop_Parameter + and then Covers (Orig_T, Etype (Entity (Orig_N)))))) + + -- If not an entity, then type of expression must match + + or else Etype (Orig_N) = Orig_T then -- One more check, do not give warning if the analyzed conversion -- has an expression with non-static bounds, and the bounds of the @@ -8804,13 +8831,21 @@ package body Sem_Res is then null; - -- Here we give the redundant conversion warning + -- Here we give the redundant conversion warning. If it is an + -- entity, give the name of the entity in the message. If not, + -- just mention the expression. else - Error_Msg_Node_2 := Orig_T; - Error_Msg_NE -- CODEFIX - ("?redundant conversion, & is of type &!", - N, Entity (Orig_N)); + if Is_Entity_Name (Orig_N) then + Error_Msg_Node_2 := Orig_T; + Error_Msg_NE -- CODEFIX + ("?redundant conversion, & is of type &!", + N, Entity (Orig_N)); + else + Error_Msg_NE + ("?redundant conversion, expression is of type&!", + N, Orig_T); + end if; end if; end if; end if; @@ -9129,7 +9164,6 @@ package body Sem_Res is Resolve (Operand, Opnd_Type); Eval_Unchecked_Conversion (N); - end Resolve_Unchecked_Type_Conversion; ------------------------------ -- 2.7.4