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

Reply via email to