[multiple changes]

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

gcc/ada/ChangeLog

+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.

gcc/ada/a-tags.adb

@@ -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

gcc/ada/a-tigeli.adb

@@ -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

gcc/ada/exp_intr.adb

@@ -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);

gcc/ada/s-ststop.adb

@@ -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);

gcc/ada/sem_util.adb

@@ -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);