diff options
Diffstat (limited to 'gcc/ada/sem_ch3.adb')
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 104 |
1 files changed, 56 insertions, 48 deletions
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 75901bb..425d624 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3713,8 +3713,8 @@ package body Sem_Ch3 is Set_Is_Static_Expression (E, True); Set_Etype (E, Universal_Integer); - Set_Etype (Id, Universal_Integer); Mutate_Ekind (Id, E_Named_Integer); + Set_Etype (Id, Universal_Integer); Set_Is_Frozen (Id, True); Set_Debug_Info_Needed (Id); @@ -3774,8 +3774,8 @@ package body Sem_Ch3 is if Is_Integer_Type (T) then Resolve (E, T); - Set_Etype (Id, Universal_Integer); Mutate_Ekind (Id, E_Named_Integer); + Set_Etype (Id, Universal_Integer); elsif Is_Real_Type (T) then @@ -3806,15 +3806,15 @@ package body Sem_Ch3 is end if; Resolve (E, T); - Set_Etype (Id, Universal_Real); Mutate_Ekind (Id, E_Named_Real); + Set_Etype (Id, Universal_Real); else Wrong_Type (E, Any_Numeric); Resolve (E, T); - Set_Etype (Id, T); Mutate_Ekind (Id, E_Constant); + Set_Etype (Id, T); Set_Never_Set_In_Source (Id, True); Set_Is_True_Constant (Id, True); return; @@ -3963,7 +3963,7 @@ package body Sem_Ch3 is Data_Path_String : constant String := Absolute_Dir & System.OS_Lib.Directory_Separator - & Stringt.To_String (Strval (Def)); + & S; begin Data_Path := Name_Find (Data_Path_String); @@ -6468,12 +6468,15 @@ package body Sem_Ch3 is Priv : Entity_Id; Related_Id : Entity_Id; Has_FLB_Index : Boolean := False; + K : Entity_Kind; begin if Nkind (Def) = N_Constrained_Array_Definition then Index := First (Discrete_Subtype_Definitions (Def)); + K := E_Array_Subtype; else Index := First (Subtype_Marks (Def)); + K := E_Array_Type; end if; -- Find proper names for the implicit types which may be public. In case @@ -6652,7 +6655,7 @@ package body Sem_Ch3 is -- them unique suffixes, because GNATprove require distinct types to -- have different names. - T := Create_Itype (E_Void, P, Related_Id, 'T', Suffix_Index => -1); + T := Create_Itype (K, P, Related_Id, 'T', Suffix_Index => -1); end if; -- Constrained array case @@ -8133,9 +8136,6 @@ package body Sem_Ch3 is Set_Non_Binary_Modulus (Implicit_Base, Non_Binary_Modulus (Parent_Base)); - Set_Is_Known_Valid - (Implicit_Base, Is_Known_Valid (Parent_Base)); - elsif Is_Floating_Point_Type (Parent_Type) then -- Digits of base type is always copied from the digits value of @@ -8508,11 +8508,19 @@ package body Sem_Ch3 is Analyze (Decl); - pragma Assert (Has_Discriminants (Full_Der) - and then not Has_Unknown_Discriminants (Full_Der)); + pragma + Assert + ((Has_Discriminants (Full_Der) + and then not Has_Unknown_Discriminants (Full_Der)) + or else Serious_Errors_Detected > 0); Uninstall_Declarations (Par_Scope); + if Etype (Full_Der) = Any_Type then + pragma Assert (Serious_Errors_Detected > 0); + return; + end if; + -- Freeze the underlying record view, to prevent generation of -- useless dispatching information, which is simply shared with -- the real derived type. @@ -9477,8 +9485,8 @@ package body Sem_Ch3 is if Constraint_Present then if not Has_Discriminants (Parent_Base) or else - (Has_Unknown_Discriminants (Parent_Base) - and then Is_Private_Type (Parent_Base)) + (Has_Unknown_Discriminants (Parent_Type) + and then Is_Private_Type (Parent_Type)) then Error_Msg_N ("invalid constraint: type has no discriminant", @@ -15218,17 +15226,24 @@ package body Sem_Ch3 is R : Node_Id := Empty; T : constant Entity_Id := Etype (Index); Is_FLB_Index : Boolean := False; + Is_Range : constant Boolean := + Nkind (S) = N_Range + or else (Nkind (S) = N_Attribute_Reference + and then Attribute_Name (S) = Name_Range); + Is_Indic : constant Boolean := Nkind (S) = N_Subtype_Indication; + K : constant Entity_Kind := + (if Is_Modular_Integer_Type (T) then E_Modular_Integer_Subtype + elsif Is_Integer_Type (T) then E_Signed_Integer_Subtype + else E_Enumeration_Subtype); begin - Def_Id := - Create_Itype (E_Void, Related_Nod, Related_Id, Suffix, Suffix_Index); - Set_Etype (Def_Id, Base_Type (T)); + if Is_Range or else Is_Indic then + Def_Id := + Create_Itype (K, Related_Nod, Related_Id, Suffix, Suffix_Index); + Set_Etype (Def_Id, Base_Type (T)); + end if; - if Nkind (S) = N_Range - or else - (Nkind (S) = N_Attribute_Reference - and then Attribute_Name (S) = Name_Range) - then + if Is_Range then -- A Range attribute will be transformed into N_Range by Resolve -- If a range has an Empty upper bound, then remember that for later @@ -15263,7 +15278,7 @@ package body Sem_Ch3 is end if; end if; - elsif Nkind (S) = N_Subtype_Indication then + elsif Is_Indic then -- The parser has verified that this is a discrete indication @@ -15318,27 +15333,19 @@ package body Sem_Ch3 is S, Entity (S)); end if; - return; - else Error_Msg_N ("invalid index constraint", S); Rewrite (S, New_Occurrence_Of (T, Sloc (S))); - return; end if; + + return; end if; -- Complete construction of the Itype - if Is_Modular_Integer_Type (T) then - Mutate_Ekind (Def_Id, E_Modular_Integer_Subtype); - - elsif Is_Integer_Type (T) then - Mutate_Ekind (Def_Id, E_Signed_Integer_Subtype); - - else - Mutate_Ekind (Def_Id, E_Enumeration_Subtype); + if K = E_Enumeration_Subtype then Set_Is_Character_Type (Def_Id, Is_Character_Type (T)); - Set_First_Literal (Def_Id, First_Literal (T)); + Set_First_Literal (Def_Id, First_Literal (T)); end if; Set_Size_Info (Def_Id, (T)); @@ -20603,17 +20610,17 @@ package body Sem_Ch3 is if No (Def_Id) then Def_Id := - Create_Itype (E_Void, Related_Nod, Related_Id, 'D', Suffix_Index); + Create_Itype + ((if Is_Signed_Integer_Type (T) then E_Signed_Integer_Subtype + elsif Is_Modular_Integer_Type (T) then E_Modular_Integer_Subtype + else E_Enumeration_Subtype), + Related_Nod, + Related_Id, + 'D', + Suffix_Index); Set_Etype (Def_Id, Base_Type (T)); - if Is_Signed_Integer_Type (T) then - Mutate_Ekind (Def_Id, E_Signed_Integer_Subtype); - - elsif Is_Modular_Integer_Type (T) then - Mutate_Ekind (Def_Id, E_Modular_Integer_Subtype); - - else - Mutate_Ekind (Def_Id, E_Enumeration_Subtype); + if Ekind (Def_Id) = E_Enumeration_Subtype then Set_Is_Character_Type (Def_Id, Is_Character_Type (T)); Set_First_Literal (Def_Id, First_Literal (T)); end if; @@ -21247,6 +21254,12 @@ package body Sem_Ch3 is Discr := First (Discriminant_Specifications (N)); while Present (Discr) loop + if Ekind (Defining_Identifier (Discr)) = E_In_Parameter then + Reinit_Field_To_Zero + (Defining_Identifier (Discr), F_Discriminal_Link); + end if; + + Mutate_Ekind (Defining_Identifier (Discr), E_Discriminant); Enter_Name (Defining_Identifier (Discr)); -- For navigation purposes we add a reference to the discriminant @@ -21522,11 +21535,6 @@ package body Sem_Ch3 is while Present (Discr) loop Id := Defining_Identifier (Discr); - if Ekind (Id) = E_In_Parameter then - Reinit_Field_To_Zero (Id, F_Discriminal_Link); - end if; - - Mutate_Ekind (Id, E_Discriminant); Set_Is_Not_Self_Hidden (Id); Reinit_Component_Location (Id); Reinit_Esize (Id); |