From: Piotr Trojanek <trojanek@adacore.com>
Date: Tue, 31 Aug 2021 17:13:29 +0000 (+0200)
Subject: [Ada] Fix for a static Leading_Part attribute raising constraint error
X-Git-Tag: basepoints/gcc-13~4189
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=c0dcfc875bf5cdd594e34fde74f85f39d3091684;p=thirdparty%2Fgcc.git

[Ada] Fix for a static Leading_Part attribute raising constraint error

gcc/ada/

	* sem_attr.adb (Eval_Attribute): Evaluation of attribute
	Leading_Part with illegal second parameter is now similar to
	evaluation of Remainder with its second parameter being zero.
---

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 4265df6b8c02..180210c25bae 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -9135,12 +9135,26 @@ package body Sem_Attr is
       -- Leading_Part --
       ------------------
 
-      when Attribute_Leading_Part =>
+      when Attribute_Leading_Part => Leading_Part : declare
+         Radix_Digits : constant Uint := Expr_Value (E2);
+
+      begin
+         if UI_Le (Radix_Digits, Uint_0) then
+            Apply_Compile_Time_Constraint_Error
+              (N, "Radix_Digits in Leading_Part is zero or negative",
+               CE_Explicit_Raise,
+               Warn => not Static);
+
+            Check_Expressions;
+            return;
+         end if;
+
          Fold_Ureal
            (N,
             Eval_Fat.Leading_Part
-              (P_Base_Type, Expr_Value_R (E1), Expr_Value (E2)),
+              (P_Base_Type, Expr_Value_R (E1), Radix_Digits),
             Static);
+      end Leading_Part;
 
       ------------
       -- Length --