The Get routines in Text_IO that take a string argument were behaving
incorrectly when From'Last = Positive'Last. This is a very bizarre case
which probably will never occur in practice, but it leads to undefined
behavior (one possibility is a confusing raise of Data_Error). It is not
worth worrying about handling this "properly", but this change ensures
that a Program_Error exception with a clear message is raised in this
unusual situation:
1. with Ada.Text_IO; use Ada.Text_IO;
2. procedure TextIOLast is
3. package IO is new Integer_IO (Integer);
4. use IO;
5. Str : string (Integer'Last .. Integer'Last) := "5";
6. N : Integer;
7. P : Positive;
8. begin
9. Get (Str, N, P);
10. end;
This program now terminates with the message:
raised PROGRAM_ERROR : Ada.Text_IO.Generic_Aux.String_Skip:
string upper bound is Positive'Last, not supported
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-01-06 Robert Dewar <de...@adacore.com>
* a-wtgeau.adb, a-ztgeau.adb, a-tigeau.adb (String_Skip): Raise PE if
Str'Last = Positive'Last.
Index: a-wtgeau.adb
===================================================================
--- a-wtgeau.adb (revision 219191)
+++ a-wtgeau.adb (working copy)
@@ -484,6 +484,19 @@
procedure String_Skip (Str : String; Ptr : out Integer) is
begin
+ -- Routines calling String_Skip malfunction if Str'Last = Positive'Last.
+ -- It's too much trouble to make this silly case work, so we just raise
+ -- Program_Error with an appropriate message. We raise Program_Error
+ -- rather than Constraint_Error because we don't want this case to be
+ -- converted to Data_Error.
+
+ if Str'Last = Positive'Last then
+ raise Program_Error with
+ "string upper bound is Positive'Last, not supported";
+ end if;
+
+ -- Normal case where Str'Last < Positive'Last
+
Ptr := Str'First;
loop
Index: a-tigeau.adb
===================================================================
--- a-tigeau.adb (revision 219191)
+++ a-tigeau.adb (working copy)
@@ -443,6 +443,19 @@
procedure String_Skip (Str : String; Ptr : out Integer) is
begin
+ -- Routines calling String_Skip malfunction if Str'Last = Positive'Last.
+ -- It's too much trouble to make this silly case work, so we just raise
+ -- Program_Error with an appropriate message. We raise Program_Error
+ -- rather than Constraint_Error because we don't want this case to be
+ -- converted to Data_Error.
+
+ if Str'Last = Positive'Last then
+ raise Program_Error with
+ "string upper bound is Positive'Last, not supported";
+ end if;
+
+ -- Normal case where Str'Last < Positive'Last
+
Ptr := Str'First;
loop
Index: a-ztgeau.adb
===================================================================
--- a-ztgeau.adb (revision 219191)
+++ a-ztgeau.adb (working copy)
@@ -484,6 +484,19 @@
procedure String_Skip (Str : String; Ptr : out Integer) is
begin
+ -- Routines calling String_Skip malfunction if Str'Last = Positive'Last.
+ -- It's too much trouble to make this silly case work, so we just raise
+ -- Program_Error with an appropriate message. We raise Program_Error
+ -- rather than Constraint_Error because we don't want this case to be
+ -- converted to Data_Error.
+
+ if Str'Last = Positive'Last then
+ raise Program_Error with
+ "string upper bound is Positive'Last, not supported";
+ end if;
+
+ -- Normal case where Str'Last < Positive'Last
+
Ptr := Str'First;
loop
