When a dynamic run-time range check was generated to check the bounds
of an aggregate, the reason was wrong, resulting in an exception
message saying length check failed instead of range check failed.
The following test:
1. with Ada.Exceptions; use Ada.Exceptions;
2. with Ada.Text_IO; use Ada.Text_IO;
3. procedure MissLenCheck is
4. function F return Integer is (1);
5. begin
6. begin
7. declare
8. X : String (F .. F) := (F - 1 => '0');
9. begin
10. null;
11. end;
12. Put_Line ("case 1: no exception");
13. exception
14. when x : others =>
15. Put_Line ("case 1: " & Exception_Information (X));
16. end;
17.
18. begin
19. declare
20. Y : String (1 .. 1) := (0 => '0');
|
>>> warning: lower bound of aggregate out of range
>>> warning: Constraint_Error will be raised at run time
21. begin
22. null;
23. end;
24. Put_Line ("case 2: no exception");
25. exception
26. when x : others =>
27. Put_Line ("case 2: " & Exception_Information (X));
28. end;
29. end MissLenCheck;
generates at run-time:
case 1: Exception name: CONSTRAINT_ERROR
Message: misslencheck.adb:8 range check failed
case 2: Exception name: CONSTRAINT_ERROR
Message: misslencheck.adb:20 range check failed
Before this patch, the first message said length check
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-01-27 Robert Dewar <de...@adacore.com>
* exp_aggr.adb (Check_Bounds): Reason is range check, not
length check.
Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb (revision 207120)
+++ exp_aggr.adb (working copy)
@@ -4141,7 +4141,7 @@
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Condition => Cond,
- Reason => CE_Length_Check_Failed));
+ Reason => CE_Range_Check_Failed));
end if;
end Check_Bounds;
