/usr/src/gcc-8/debian/patches/ada-749574.diff is in gcc-8-source 8-20180414-1ubuntu2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | From: Ludovic Brenta <lbrenta@debian.org>
From: Nicolas Boulenguez <nicolas@debian.org>
Forwarded: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=81087
Bug-Debian: http://bugs.debian.org/749574
Description: array index out of range in gnatlink
The procedure gnatlink assumes that the Linker_Options.Table contains access
values to strings whose 'First index is always 1. This assumption is wrong
for the string returned by function Base_Name.
.
The wrong indices are not detected because gnatlink is compiled with
-gnatp, but the test result is wrong.
.
The following program normally raises Constraint_Error, prints FALSE
if compiled with -gnatn, while the expected result is TRUE.
.
procedure A is
G : constant String (3 .. 5) := "abc";
begin
Ada.Text_IO.Put_Line (Boolean'Image (G (1 .. 2) = "ab"));
end A;
Index: b/src/gcc/ada/gnatlink.adb
===================================================================
--- a/src/gcc/ada/gnatlink.adb
+++ b/src/gcc/ada/gnatlink.adb
@@ -239,6 +239,9 @@ procedure Gnatlink is
procedure Write_Usage;
-- Show user the program options
+ function Starts_With (Source, Pattern : String) return Boolean;
+ pragma Inline (Starts_With);
+
---------------
-- Base_Name --
---------------
@@ -495,7 +498,7 @@ procedure Gnatlink is
Binder_Options.Table (Binder_Options.Last) :=
Linker_Options.Table (Linker_Options.Last);
- elsif Arg'Length >= 7 and then Arg (1 .. 7) = "--LINK=" then
+ elsif Starts_With (Arg, "--LINK=") then
if Arg'Length = 7 then
Exit_With_Error ("Missing argument for --LINK=");
end if;
@@ -529,7 +532,7 @@ procedure Gnatlink is
end loop;
end;
- elsif Arg'Length >= 6 and then Arg (1 .. 6) = "--GCC=" then
+ elsif Starts_With (Arg, "--GCC=") then
if Arg'Length = 6 then
Exit_With_Error ("Missing argument for --GCC=");
end if;
@@ -1254,13 +1257,9 @@ procedure Gnatlink is
1 .. Linker_Options.Last
loop
if Linker_Options.Table (J) /= null
- and then
- Linker_Options.Table (J)'Length
- > Run_Path_Opt'Length
- and then
- Linker_Options.Table (J)
- (1 .. Run_Path_Opt'Length) =
- Run_Path_Opt
+ and then Starts_With
+ (Linker_Options.Table (J).all,
+ Run_Path_Opt)
then
-- We have found an already
-- specified run_path_option:
@@ -1377,6 +1376,17 @@ procedure Gnatlink is
Status := fclose (Fd);
end Process_Binder_File;
+ ----------------
+ -- StartsWith --
+ ----------------
+
+ function Starts_With (Source, Pattern : String) return Boolean is
+ Last : constant Natural := Source'First + Pattern'Length - 1;
+ begin
+ return Last <= Source'Last
+ and then Pattern = Source (Source'First .. Last);
+ end Starts_With;
+
-----------
-- Usage --
-----------
@@ -1890,8 +1900,8 @@ begin
while J <= Linker_Options.Last loop
if Linker_Options.Table (J).all = "-Xlinker"
and then J < Linker_Options.Last
- and then Linker_Options.Table (J + 1)'Length > 8
- and then Linker_Options.Table (J + 1) (1 .. 8) = "--stack="
+ and then Starts_With (Linker_Options.Table (J + 1).all,
+ "--stack=")
then
if Stack_Op then
Linker_Options.Table (J .. Linker_Options.Last - 2) :=
@@ -1922,13 +1932,9 @@ begin
-- Here we just check for a canonical form that matches the
-- pragma Linker_Options set in the NT runtime.
- if (Linker_Options.Table (J)'Length > 17
- and then Linker_Options.Table (J) (1 .. 17) =
- "-Xlinker --stack=")
- or else
- (Linker_Options.Table (J)'Length > 12
- and then Linker_Options.Table (J) (1 .. 12) =
- "-Wl,--stack=")
+ if Starts_With (Linker_Options.Table (J).all, "-Xlinker --stack=")
+ or else Starts_With (Linker_Options.Table (J).all,
+ "-Wl,--stack=")
then
if Stack_Op then
Linker_Options.Table (J .. Linker_Options.Last - 1) :=
|