diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_eval.adb | 67 |
2 files changed, 54 insertions, 19 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1eabde4..7b26e37 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-01-11 Piotr Trojanek <trojanek@adacore.com> + + * sem_eval.adb (Is_Null_Range): Retrieve the full view when called on a + private (sub)type; refactor to avoid early return statement. + (Not_Null_Range): Same as above. + 2018-01-11 Hristian Kirtchev <kirtchev@adacore.com> * freeze.adb (Freeze_Entity): Ensure that a Ghost type is not diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index adefea5..93536cb 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -4755,19 +4755,33 @@ package body Sem_Eval is ------------------- function Is_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean is - Typ : constant Entity_Id := Etype (Lo); - begin - if not Compile_Time_Known_Value (Lo) - or else not Compile_Time_Known_Value (Hi) + if Compile_Time_Known_Value (Lo) + and then Compile_Time_Known_Value (Hi) then - return False; - end if; + declare + Typ : Entity_Id := Etype (Lo); + Full_Typ : constant Entity_Id := Full_View (Typ); + begin + -- When called from the frontend, as part of the analysis of + -- potentially static expressions, Typ will be the full view of a + -- type with all the info needed to answer this query. When called + -- from the backend, for example to know whether a range of a loop + -- is null, Typ might be a private type and we need to explicitly + -- switch to its corresponding full view to access the same info. + + if Present (Full_Typ) then + Typ := Full_Typ; + end if; - if Is_Discrete_Type (Typ) then - return Expr_Value (Lo) > Expr_Value (Hi); - else pragma Assert (Is_Real_Type (Typ)); - return Expr_Value_R (Lo) > Expr_Value_R (Hi); + if Is_Discrete_Type (Typ) then + return Expr_Value (Lo) > Expr_Value (Hi); + else pragma Assert (Is_Real_Type (Typ)); + return Expr_Value_R (Lo) > Expr_Value_R (Hi); + end if; + end; + else + return False; end if; end Is_Null_Range; @@ -5330,20 +5344,35 @@ package body Sem_Eval is -------------------- function Not_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean is - Typ : constant Entity_Id := Etype (Lo); - begin - if not Compile_Time_Known_Value (Lo) - or else not Compile_Time_Known_Value (Hi) + if Compile_Time_Known_Value (Lo) + and then Compile_Time_Known_Value (Hi) then + declare + Typ : Entity_Id := Etype (Lo); + Full_Typ : constant Entity_Id := Full_View (Typ); + begin + -- When called from the frontend, as part of the analysis of + -- potentially static expressions, Typ will be the full view of a + -- type with all the info needed to answer this query. When called + -- from the backend, for example to know whether a range of a loop + -- is null, Typ might be a private type and we need to explicitly + -- switch to its corresponding full view to access the same info. + + if Present (Full_Typ) then + Typ := Full_Typ; + end if; + + if Is_Discrete_Type (Typ) then + return Expr_Value (Lo) <= Expr_Value (Hi); + else pragma Assert (Is_Real_Type (Typ)); + return Expr_Value_R (Lo) <= Expr_Value_R (Hi); + end if; + end; + else return False; end if; - if Is_Discrete_Type (Typ) then - return Expr_Value (Lo) <= Expr_Value (Hi); - else pragma Assert (Is_Real_Type (Typ)); - return Expr_Value_R (Lo) <= Expr_Value_R (Hi); - end if; end Not_Null_Range; ------------- |