+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.
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
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
-- --
-- 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- --
-- 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
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);
-- --
-- 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- --
(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);
E_Function,
E_Package,
E_Procedure,
+ E_Protected_Type,
E_Task_Type));
return Scope_Within_Or_Same (Context_Id, Ref_Id);
projects / gcc.git / commitdiff