mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 20:01:28 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2017-09-08  Bob Duff  <duff@adacore.com>

	* exp_intr.adb (Add_Source_Info): Do not decode
	file names; they were not encoded in the first place.

2017-09-08  Bob Duff  <duff@adacore.com>

	* a-tags.adb (Internal_Tag): Unsuppress checks, so we get
	exceptions instead of crashes. Check for absurdly long strings
	and empty strings. Empty strings cause trouble because they can
	have super-null ranges (e.g. 100..10), which causes Ext_Copy to
	be empty, which causes an array index out of bounds.
	* s-ststop.adb (Input): Unsuppress checks, so we get exceptions
	instead of crashes.

2017-09-08  Arnaud Charlet  <charlet@adacore.com>

	* sem_util.adb (Is_CCT_Instance): allow use in
	the context of protected types.

2017-09-08  Arnaud Charlet  <charlet@adacore.com>

	* a-tigeli.adb: minor remove extra whitespace.

From-SVN: r251885
This commit is contained in:
Arnaud Charlet 2017-09-08 12:18:12 +02:00
parent ae5115dd46
commit 17d7aa85b7
6 changed files with 58 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
gcc/ada/ChangeLog
View File

@ -1,3 +1,27 @@
2017-09-08 Bob Duff <duff@adacore.com>
* exp_intr.adb (Add_Source_Info): Do not decode
file names; they were not encoded in the first place.
2017-09-08 Bob Duff <duff@adacore.com>
* a-tags.adb (Internal_Tag): Unsuppress checks, so we get
exceptions instead of crashes. Check for absurdly long strings
and empty strings. Empty strings cause trouble because they can
have super-null ranges (e.g. 100..10), which causes Ext_Copy to
be empty, which causes an array index out of bounds.
* s-ststop.adb (Input): Unsuppress checks, so we get exceptions
instead of crashes.
2017-09-08 Arnaud Charlet <charlet@adacore.com>
* sem_util.adb (Is_CCT_Instance): allow use in
the context of protected types.
2017-09-08 Arnaud Charlet <charlet@adacore.com>
* a-tigeli.adb: minor remove extra whitespace.
2017-09-08 Gary Dismukes <dismukes@adacore.com>
* par-ch4.adb: Reformatting of an error message.

27
gcc/ada/a-tags.adb
View File

@ -641,10 +641,22 @@ package body Ada.Tags is
Header_Separator : constant Character := '#';
function Internal_Tag (External : String) return Tag is
Ext_Copy : aliased String (External'First .. External'Last + 1);
Res : Tag := null;
pragma Unsuppress (All_Checks);
-- To make T'Class'Input robust in the case of bad data
Res : Tag := null;
begin
-- Raise Tag_Error for empty strings, and for absurdly long strings.
-- This is to make T'Class'Input robust in the case of bad data, for
-- example a String(123456789..1234). The limit of 10,000 characters is
-- arbitrary, but is unlikely to be exceeded by legitimate external tag
-- names.
if External'Length not in 1 .. 10_000 then
raise Tag_Error;
end if;
-- Handle locally defined tagged types
if External'Length > Internal_Tag_Header'Length
@ -731,9 +743,14 @@ package body Ada.Tags is
else
-- Make NUL-terminated copy of external tag string
Ext_Copy (External'Range) := External;
Ext_Copy (Ext_Copy'Last) := ASCII.NUL;
Res := External_Tag_HTable.Get (Ext_Copy'Address);
declare
Ext_Copy : aliased String (External'First .. External'Last + 1);
pragma Assert (Ext_Copy'Length > 1); -- See Length check at top
begin
Ext_Copy (External'Range) := External;
Ext_Copy (Ext_Copy'Last) := ASCII.NUL;
Res := External_Tag_HTable.Get (Ext_Copy'Address);
end;
end if;
if Res = null then

4
gcc/ada/a-tigeli.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -197,7 +197,7 @@ begin
-- last line, in which case no End_Error should be raised.
if ch = EOF then
if Last < Item'First then
if Last < Item'First then
raise End_Error;
else -- All done

2
gcc/ada/exp_intr.adb
View File

@ -125,7 +125,7 @@ package body Exp_Intr is
Append (Buf, Nat (Get_Logical_Line_Number (Loc)));
when Name_File =>
Append_Decoded (Buf, Reference_Name (Get_Source_File_Index (Loc)));
Append (Buf, Reference_Name (Get_Source_File_Index (Loc)));
when Name_Source_Location =>
Build_Location_String (Buf, Loc);

13
gcc/ada/s-ststop.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2008-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2008-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -128,17 +128,20 @@ package body System.Strings.Stream_Ops is
(Strm : access Root_Stream_Type'Class;
IO : IO_Kind) return Array_Type
is
pragma Unsuppress (All_Checks);
-- To make T'Class'Input robust in the case of bad data. The
-- declaration of Item below could raise Storage_Error if the length
-- is huge.
begin
if Strm = null then
raise Constraint_Error;
end if;
declare
Low : Index_Type;
High : Index_Type;
Low, High : Index_Type'Base;
begin
-- Read the bounds of the string
-- Read the bounds of the string. Note that they could be out of
-- range of Index_Type in the case of empty arrays.
Index_Type'Read (Strm, Low);
Index_Type'Read (Strm, High);

1
gcc/ada/sem_util.adb
View File

@ -12499,6 +12499,7 @@ package body Sem_Util is
E_Function,
E_Package,
E_Procedure,
E_Protected_Type,
E_Task_Type));
return Scope_Within_Or_Same (Context_Id, Ref_Id);