diff options
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 50 | ||||
| -rw-r--r-- | gcc/ada/exp_intr.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_eval.adb | 56 |
3 files changed, 57 insertions, 59 deletions
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 91ae71e..e376648 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -12815,56 +12815,6 @@ package body Exp_Ch4 is return; end if; - -- If we have a conversion of a compile time known value to a target - -- type and the value is in range of the target type, then we can simply - -- replace the construct by an integer literal of the correct type. We - -- only apply this to discrete types being converted. Possibly it may - -- apply in other cases, but it is too much trouble to worry about. - - -- Note that we do not do this transformation if the Kill_Range_Check - -- flag is set, since then the value may be outside the expected range. - -- This happens in the Normalize_Scalars case. - - -- We also skip this if either the target or operand type is biased - -- because in this case, the unchecked conversion is supposed to - -- preserve the bit pattern, not the integer value. - - if Is_Integer_Type (Target_Type) - and then not Has_Biased_Representation (Target_Type) - and then Is_Discrete_Type (Operand_Type) - and then not Has_Biased_Representation (Operand_Type) - and then Compile_Time_Known_Value (Operand) - and then not Kill_Range_Check (N) - then - declare - Val : constant Uint := Expr_Rep_Value (Operand); - - begin - if Compile_Time_Known_Value (Type_Low_Bound (Target_Type)) - and then - Compile_Time_Known_Value (Type_High_Bound (Target_Type)) - and then - Val >= Expr_Value (Type_Low_Bound (Target_Type)) - and then - Val <= Expr_Value (Type_High_Bound (Target_Type)) - then - Rewrite (N, Make_Integer_Literal (Sloc (N), Val)); - - -- If Address is the target type, just set the type to avoid a - -- spurious type error on the literal when Address is a visible - -- integer type. - - if Is_Descendant_Of_Address (Target_Type) then - Set_Etype (N, Target_Type); - else - Analyze_And_Resolve (N, Target_Type); - end if; - - return; - end if; - end; - end if; - -- Generate an extra temporary for cases unsupported by the C backend if Modify_Tree_For_C then diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 7fc00c7..3be039b 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -29,7 +29,6 @@ with Einfo; use Einfo; with Elists; use Elists; with Expander; use Expander; with Exp_Atag; use Exp_Atag; -with Exp_Ch4; use Exp_Ch4; with Exp_Ch7; use Exp_Ch7; with Exp_Ch11; use Exp_Ch11; with Exp_Code; use Exp_Code; @@ -857,7 +856,7 @@ package body Exp_Intr is --------------------------- procedure Expand_Unc_Conversion (N : Node_Id; E : Entity_Id) is - Func : constant Entity_Id := Entity (Name (N)); + Func : constant Entity_Id := Entity (Name (N)); Conv : Node_Id; Ftyp : Entity_Id; Ttyp : Entity_Id; @@ -908,12 +907,7 @@ package body Exp_Intr is end if; Rewrite (N, Unchecked_Convert_To (Ttyp, Conv)); - Set_Etype (N, Ttyp); - Set_Analyzed (N); - - if Nkind (N) = N_Unchecked_Type_Conversion then - Expand_N_Unchecked_Type_Conversion (N); - end if; + Analyze_And_Resolve (N, Ttyp); end Expand_Unc_Conversion; ----------------------------- diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 68498e6..1a832f7 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -4359,8 +4359,62 @@ package body Sem_Eval is -- processing is to check for a non-static context for the operand. procedure Eval_Unchecked_Conversion (N : Node_Id) is + Target_Type : constant Entity_Id := Etype (N); + Operand : constant Node_Id := Expression (N); + Operand_Type : constant Entity_Id := Etype (Operand); + begin - Check_Non_Static_Context (Expression (N)); + Check_Non_Static_Context (Operand); + + -- If we have a conversion of a compile time known value to a target + -- type and the value is in range of the target type, then we can simply + -- replace the construct by an integer literal of the correct type. We + -- only apply this to discrete types being converted. Possibly it may + -- apply in other cases, but it is too much trouble to worry about. + + -- Note that we do not do this transformation if the Kill_Range_Check + -- flag is set, since then the value may be outside the expected range. + -- This happens in the Normalize_Scalars case. + + -- We also skip this if either the target or operand type is biased + -- because in this case, the unchecked conversion is supposed to + -- preserve the bit pattern, not the integer value. + + if Is_Integer_Type (Target_Type) + and then not Has_Biased_Representation (Target_Type) + and then Is_Discrete_Type (Operand_Type) + and then not Has_Biased_Representation (Operand_Type) + and then Compile_Time_Known_Value (Operand) + and then not Kill_Range_Check (N) + then + declare + Val : constant Uint := Expr_Rep_Value (Operand); + + begin + if Compile_Time_Known_Value (Type_Low_Bound (Target_Type)) + and then + Compile_Time_Known_Value (Type_High_Bound (Target_Type)) + and then + Val >= Expr_Value (Type_Low_Bound (Target_Type)) + and then + Val <= Expr_Value (Type_High_Bound (Target_Type)) + then + Rewrite (N, Make_Integer_Literal (Sloc (N), Val)); + + -- If Address is the target type, just set the type to avoid a + -- spurious type error on the literal when Address is a visible + -- integer type. + + if Is_Descendant_Of_Address (Target_Type) then + Set_Etype (N, Target_Type); + else + Analyze_And_Resolve (N, Target_Type); + end if; + + return; + end if; + end; + end if; end Eval_Unchecked_Conversion; -------------------- |