From 84a62ce88b6b105f923130d6c55f8a01b38a43a2 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 12 Oct 2016 14:55:47 +0200 Subject: [multiple changes] 2016-10-12 Bob Duff * 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 * 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 * 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 --- gcc/ada/sem_attr.adb | 146 ++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 126 insertions(+), 20 deletions(-) (limited to 'gcc/ada/sem_attr.adb') 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); -- cgit v1.1