2010-06-23 Javier Miranda <miranda@adacore.com>

	* sem_ch3.adb (Add_Internal_Interface_Entities): Generate internal
	entities for parent types that are interfaces. Needed in generics to
	handle formals that implement interfaces.
	(Derive_Subprograms): Add assertion for derivation of tagged types that
	do not cover interfaces. For generics, complete code that handles
	derivation of type that covers interfaces because the previous
	condition was weak (it required only name consistency; arguments were
	not checked). Add new code to locate primitives covering interfaces
	defined in generic units or instantiatons.
	* sem_util.adb (Has_Interfaces): Add missing support for derived types.
	* sem_ch6.adb (Check_Overriding_Indicator): Minor code cleanups.
	* exp_disp.adb (Make_Select_Specific_Data_Table): Skip primitives of
	interfaces that are parents of the type because they share the primary
	dispatch table.
	(Register_Primitive): Do not register primitives of interfaces that
	are parents of the type.
	* sem_ch13.adb (Analyze_Freeze_Entity): Add documentation.
	* exp_cg.adb (Write_Type_Info): When displaying overriding of interface
	primitives skip primitives of interfaces that are parents of the type.

2010-06-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Eval_Attribute): If the prefix is an array, the
	attribute cannot be constant-folded if an index type is a formal type,
	or is derived from one.
	* checks.adb (Determine_Range): ditto.

2010-06-23  Arnaud Charlet  <charlet@adacore.com>

	* gnat_ugn.texi, gnatxref.adb: Add support for --ext switch.

2010-06-23  Bob Duff  <duff@adacore.com>

	* g-pehage.ads, g-pehage.adb (Put): Fix off-by-one bug.
	(Insert): Disallow nul characters.
	(misc output routines): Assert no nul characters.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161247 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 42 insertions, 8 deletions

diff --git a/gcc/ada/g-pehage.adb b/gcc/ada/g-pehage.adb
index 6c63c82cb49..91344a0ed8c 100644
--- a/gcc/ada/g-pehage.adb
+++ b/gcc/ada/g-pehage.adb
@@ -145,6 +145,9 @@ package body GNAT.Perfect_Hash_Generators is
    --  Return a string which includes string Str or integer Int preceded by
    --  leading spaces if required by width W.
 
+   function Trim_Trailing_Nuls (Str : String) return String;
+   --  Return Str, but with trailing NUL characters removed.
+
    Output : File_Descriptor renames GNAT.OS_Lib.Standout;
    --  Shortcuts
 
@@ -524,6 +527,7 @@ package body GNAT.Perfect_Hash_Generators is
    ---------
 
    procedure Add (C : Character) is
+      pragma Assert (C /= ASCII.NUL);
    begin
       Line (Last + 1) := C;
       Last := Last + 1;
@@ -536,6 +540,11 @@ package body GNAT.Perfect_Hash_Generators is
    procedure Add (S : String) is
       Len : constant Natural := S'Length;
    begin
+      for J in S'Range loop
+         pragma Assert (S (J) /= ASCII.NUL);
+         null;
+      end loop;
+
       Line (Last + 1 .. Last + Len) := S;
       Last := Last + Len;
    end Add;
@@ -1261,6 +1270,11 @@ package body GNAT.Perfect_Hash_Generators is
          New_Line (Output);
       end if;
 
+      for J in Value'Range loop
+         pragma Assert (Value (J) /= ASCII.NUL);
+         null;
+      end loop;
+
       WT.Set_Last (NK);
       WT.Table (NK) := New_Word (Value);
       NK := NK + 1;
@@ -1726,6 +1740,11 @@ package body GNAT.Perfect_Hash_Generators is
    procedure Put (File : File_Descriptor; Str : String) is
       Len : constant Natural := Str'Length;
    begin
+      for J in Str'Range loop
+         pragma Assert (Str (J) /= ASCII.NUL);
+         null;
+      end loop;
+
       if Write (File, Str'Address, Len) /= Len then
          raise Program_Error;
       end if;
@@ -1768,13 +1787,12 @@ package body GNAT.Perfect_Hash_Generators is
          Last := 0;
       end if;
 
-      if Last + Len + 3 > Max then
+      if Last + Len + 3 >= Max then
          Flush;
       end if;
 
       if Last = 0 then
-         Line (Last + 1 .. Last + 5) := "     ";
-         Last := Last + 5;
+         Add ("     ");
 
          if F1 <= L1 then
             if C1 = F1 and then C2 = F2 then
@@ -1801,8 +1819,7 @@ package body GNAT.Perfect_Hash_Generators is
          Add (' ');
       end if;
 
-      Line (Last + 1 .. Last + Len) := S;
-      Last := Last + Len;
+      Add (S);
 
       if C2 = L2 then
          Add (')');
@@ -1869,7 +1886,8 @@ package body GNAT.Perfect_Hash_Generators is
          K := Get_Key (J);
          Put (File, Image (J, M),           F1, L1, J, 1, 3, 1);
          Put (File, Image (K.Edge, M),      F1, L1, J, 1, 3, 2);
-         Put (File, WT.Table (Initial (J)).all, F1, L1, J, 1, 3, 3);
+         Put (File, Trim_Trailing_Nuls (WT.Table (Initial (J)).all),
+                    F1, L1, J, 1, 3, 3);
       end loop;
    end Put_Initial_Keys;
 
@@ -1950,7 +1968,8 @@ package body GNAT.Perfect_Hash_Generators is
          K := Get_Key (J);
          Put (File, Image (J, M),           F1, L1, J, 1, 3, 1);
          Put (File, Image (K.Edge, M),      F1, L1, J, 1, 3, 2);
-         Put (File, WT.Table (Reduced (J)).all, F1, L1, J, 1, 3, 3);
+         Put (File, Trim_Trailing_Nuls (WT.Table (Reduced (J)).all),
+                    F1, L1, J, 1, 3, 3);
       end loop;
    end Put_Reduced_Keys;
 
@@ -2337,7 +2356,8 @@ package body GNAT.Perfect_Hash_Generators is
                     Same_Keys_Sets_Table (J).First ..
                     Same_Keys_Sets_Table (J).Last
                   loop
-                     Put (Output, WT.Table (Reduced (K)).all);
+                     Put (Output,
+                          Trim_Trailing_Nuls (WT.Table (Reduced (K)).all));
                      New_Line (Output);
                   end loop;
                   Put (Output, "--");
@@ -2488,6 +2508,20 @@ package body GNAT.Perfect_Hash_Generators is
       return S;
    end Sum;
 
+   ------------------------
+   -- Trim_Trailing_Nuls --
+   ------------------------
+
+   function Trim_Trailing_Nuls (Str : String) return String is
+   begin
+      for J in Str'Range loop
+         if Str (J) = ASCII.NUL then
+            return Str (Str'First .. J - 1);
+         end if;
+      end loop;
+      return Str;
+   end Trim_Trailing_Nuls;
+
    ---------------
    -- Type_Size --
    ---------------