diff options
Diffstat (limited to 'gcc/ada/freeze.adb')
| -rw-r--r-- | gcc/ada/freeze.adb | 26 |
1 files changed, 26 insertions, 0 deletions
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 4765d8e..cc5553e 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -6711,7 +6711,12 @@ package body Freeze is Hival : Ureal; Atype : Entity_Id; + Orig_Lo : Ureal; + Orig_Hi : Ureal; + -- Save original bounds (for shaving tests) + Actual_Size : Nat; + -- Actual size chosen function Fsize (Lov, Hiv : Ureal) return Nat; -- Returns size of type with given bounds. Also leaves these @@ -6762,6 +6767,9 @@ package body Freeze is Loval := Realval (Lo); Hival := Realval (Hi); + Orig_Lo := Loval; + Orig_Hi := Hival; + -- Ordinary fixed-point case if Is_Ordinary_Fixed_Point_Type (Typ) then @@ -7130,6 +7138,24 @@ package body Freeze is Set_RM_Size (Typ, Minsiz); end if; end; + + -- Check for shaving + + if Comes_From_Source (Typ) then + if Orig_Lo < Expr_Value_R (Lo) then + Error_Msg_N + ("declared low bound of type & is outside type range??", Typ); + Error_Msg_N + ("\low bound adjusted up by delta (RM 3.5.9(13))??", Typ); + end if; + + if Orig_Hi > Expr_Value_R (Hi) then + Error_Msg_N + ("declared high bound of type & is outside type range??", Typ); + Error_Msg_N + ("\high bound adjusted down by delta (RM 3.5.9(13))??", Typ); + end if; + end if; end Freeze_Fixed_Point_Type; ------------------ |