From 4962dc441d317b6f28ab4ee3bf6b0d83f7c61837 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 8 Jul 2019 08:13:25 +0000 Subject: [PATCH] [Ada] Semantics of Delete for fixed strings This patch corrects a bug in the implementation of Delete in an unusual boundary case: the RM describes the semantics of Delete as equivalent to that of Replace_String with a null argument. As a result, deleting a null string that starts past the end of its argument is a noop and must not raise Index_Error. 2019-07-08 Ed Schonberg gcc/ada/ * libgnat/a-strfix.adb (Delete): The RM describes the semantics of Delete as equivalent to that of Replace_String with a null argument. As a result, deleting a null string that starts past the end of its argument is a noop and must not raise Index_Error. gcc/testsuite/ * gnat.dg/fixed_delete.adb: New testcase. From-SVN: r273205 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/libgnat/a-strfix.adb | 10 +++++++++- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/fixed_delete.adb | 17 +++++++++++++++++ 4 files changed, 38 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/fixed_delete.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 969e9335e0f..2f97ab9ea4e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-07-08 Ed Schonberg + + * libgnat/a-strfix.adb (Delete): The RM describes the semantics + of Delete as equivalent to that of Replace_String with a null + argument. As a result, deleting a null string that starts past + the end of its argument is a noop and must not raise + Index_Error. + 2019-07-08 Javier Miranda * exp_disp.adb (Register_Primitive): When registering a diff --git a/gcc/ada/libgnat/a-strfix.adb b/gcc/ada/libgnat/a-strfix.adb index 6bf825b28f6..b8b5f42dcb1 100644 --- a/gcc/ada/libgnat/a-strfix.adb +++ b/gcc/ada/libgnat/a-strfix.adb @@ -192,7 +192,15 @@ package body Ada.Strings.Fixed is elsif From not in Source'Range or else Through > Source'Last then - raise Index_Error; + -- In most cases this raises an exception, but the case of deleting + -- a null string at the end of the current one is a special-case, and + -- reflects the equivalence with Replace_String (RM A.4.3 (86/3)). + + if From = Source'Last + 1 and then From = Through then + return Source; + else + raise Index_Error; + end if; else declare diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 14d127fc607..a0b6bb4d71f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-07-08 Ed Schonberg + + * gnat.dg/fixed_delete.adb: New testcase. + 2019-07-08 Javier Miranda * gnat.dg/interface9.adb, gnat.dg/interface9_root-child.ads, diff --git a/gcc/testsuite/gnat.dg/fixed_delete.adb b/gcc/testsuite/gnat.dg/fixed_delete.adb new file mode 100644 index 00000000000..c13c71cfd11 --- /dev/null +++ b/gcc/testsuite/gnat.dg/fixed_delete.adb @@ -0,0 +1,17 @@ +-- { dg-do run } + +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Strings.Fixed; use Ada.Strings.Fixed; + +procedure Fixed_Delete is + Str : String := "a"; + Str1 : String := Replace_Slice (Str, 2, 2, ""); + Str2 : String := Delete (Str, 2, 2); +begin + if Str1 /= "a" then + raise Program_Error; + end if; + if Str2 /= "a" then + raise Program_Error; + end if; +end Fixed_Delete; -- 2.30.2