[multiple changes]

2016-10-12  Bob Duff  <duff@adacore.com>

	* xref_lib.adb: Use renamings-of-slices to ensure
	that all references to Tables are properly bounds checked (when
	checks are turned on).
	* g-dyntab.ads, g-dyntab.adb: Default-initialize the array
	components, so we don't get uninitialized pointers in case
	of Tables containing access types.  Misc cleanup of the code
	and comments.

2016-10-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Analyze_Attribute, case 'Type_Key): Implement
	functionality of attribute, to provide a reasonably unique key
	for a given type and detect any changes in the semantics of the
	type or any of its subcomponents from version to version.

2016-10-12  Bob Duff  <duff@adacore.com>

	* sem_case.adb (Check_Choice_Set): Separate
	checking for duplicates out into a separate pass from checking
	full coverage, because the check for duplicates does not depend
	on predicates. Therefore, we shouldn't do it separately for the
	predicate vs. no-predicate case; we should share code. The code
	for the predicate case was wrong.

From-SVN: r241039

1 files changed, 126 insertions, 20 deletions

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index cd7691f..4e00e17 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -68,6 +68,7 @@ with Stand;    use Stand;
 with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
 with System;
+with System.CRC32; use System.CRC32;
 with Stringt;  use Stringt;
 with Style;
 with Stylesw;  use Stylesw;
@@ -6139,37 +6140,142 @@ package body Sem_Attr is
          Check_E0;
          Check_Type;
 
-         --  This processing belongs in Eval_Attribute ???
-
          declare
-            function Type_Key return String_Id;
-            --  A very preliminary implementation. For now, a signature
-            --  consists of only the type name. This is clearly incomplete
-            --  (e.g., adding a new field to a record type should change the
-            --  type's Type_Key attribute).
+            Full_Name  : constant String_Id :=
+              Fully_Qualified_Name_String (Entity (P));
+
+            Deref      : Boolean;
+            --  To simplify the handling of mutually recursive types, follow
+            --  a single dereference link in a composite type.
+
+            CRC        : CRC32;
+            --  The computed signature for the type.
+
+            procedure Compute_Type_Key (T : Entity_Id);
+            --  Create a CRC integer from the declaration of the type, For
+            --  a composite type, fold in the representation of its components
+            --  in recursive fashion. We use directly the source representation
+            --  of the types involved.
 
             --------------
             -- Type_Key --
             --------------
 
-            function Type_Key return String_Id is
-               Full_Name : constant String_Id :=
-                             Fully_Qualified_Name_String (Entity (P));
+            procedure Compute_Type_Key (T : Entity_Id)  is
+               SFI          : Source_File_Index;
+               Buffer       : Source_Buffer_Ptr;
+               P_Min, P_Max : Source_Ptr;
+               Rep          : Node_Id;
 
-            begin
-               --  Copy all characters in Full_Name but the trailing NUL
+               procedure Process_One_Declaration;
+               --  Update CRC with the characters of one type declaration,
+               --  or a representation pragma that applies to the type.
 
-               Start_String;
-               for J in 1 .. String_Length (Full_Name) - 1 loop
-                  Store_String_Char (Get_String_Char (Full_Name, Pos (J)));
-               end loop;
+               -----------------------------
+               -- Process_One_Declaration --
+               -----------------------------
+
+               procedure Process_One_Declaration is
+                  Ptr : Source_Ptr;
+
+               begin
+                  Ptr := P_Min;
+
+                  --  Scan type declaration, skipping blanks,
+
+                  while Ptr <= P_Max loop
+                     if Buffer (Ptr) /= ' ' then
+                        System.CRC32.Update (CRC, Buffer (Ptr));
+                     end if;
+
+                     Ptr := Ptr + 1;
+                  end loop;
+               end Process_One_Declaration;
+
+            begin  --  Start of processing for Compute_Type_Key
+
+               if Is_Itype (T) then
+                  return;
+               end if;
+
+               Sloc_Range (Enclosing_Declaration (T), P_Min, P_Max);
+               SFI        := Get_Source_File_Index (P_Min);
+               Buffer     := Source_Text (SFI);
+
+               Process_One_Declaration;
+
+               --  Recurse on relevant component types.
+
+               if Is_Array_Type (T) then
+                  Compute_Type_Key (Component_Type (T));
+
+               elsif Is_Access_Type (T) then
+                  if not Deref then
+                     Deref := True;
+                     Compute_Type_Key (Designated_Type (T));
+                  end if;
 
-               Store_String_Chars ("'Type_Key");
-               return End_String;
-            end Type_Key;
+               elsif Is_Derived_Type (T) then
+                  Compute_Type_Key (Etype  (T));
+
+               elsif Is_Record_Type (T) then
+                  declare
+                     Comp : Entity_Id;
+                  begin
+                     Comp := First_Component (T);
+                     while Present (Comp) loop
+                        Compute_Type_Key (Etype (Comp));
+
+                        Next_Component (Comp);
+                     end loop;
+                  end;
+               end if;
+
+               --  Fold in representation aspects for the type, which
+               --  appear in the same source buffer.
+
+               Rep := First_Rep_Item (T);
+
+               while Present (Rep) loop
+                  if Comes_From_Source (Rep) then
+                     Sloc_Range (Rep, P_Min, P_Max);
+                     Process_One_Declaration;
+                  end if;
+
+                  Rep := Next_Rep_Item (Rep);
+               end loop;
+            end Compute_Type_Key;
 
          begin
-            Rewrite (N, Make_String_Literal (Loc, Type_Key));
+            Start_String;
+            Deref := False;
+
+            --  Copy all characters in Full_Name but the trailing NUL
+
+            for J in 1 .. String_Length (Full_Name) - 1 loop
+               Store_String_Char (Get_String_Char (Full_Name, Pos (J)));
+            end loop;
+
+            --  For standard type return the name of the type. as there is
+            --  no explicit source declaration to use. Otherwise compute
+            --  CRC and convert it to string one character at a time. so as
+            --  not to use Image within the compiler.
+
+            if Scope (Entity (P)) /= Standard_Standard then
+               Initialize (CRC);
+               Compute_Type_Key (Entity (P));
+
+               if not Is_Frozen (Entity (P)) then
+                  Error_Msg_N ("premature usage of Type_Key?", N);
+               end if;
+
+               while CRC > 0 loop
+                  Store_String_Char (Character'Val (48 + (CRC rem 10)));
+                  CRC := CRC / 10;
+               end loop;
+            end if;
+
+            Rewrite (N, Make_String_Literal (Loc, End_String));
          end;
 
          Analyze_And_Resolve (N, Standard_String);