diff options
Diffstat (limited to 'gcc/ada/freeze.adb')
| -rw-r--r-- | gcc/ada/freeze.adb | 39 |
1 files changed, 24 insertions, 15 deletions
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 5bbcab0134c..f7b40527395 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -2062,9 +2062,7 @@ package body Freeze is -- Set OK_To_Reorder_Components depending on debug flags - if Rec = Base_Type (Rec) - and then Convention (Rec) = Convention_Ada - then + if Is_Base_Type (Rec) and then Convention (Rec) = Convention_Ada then if (Has_Discriminants (Rec) and then Debug_Flag_Dot_V) or else (not Has_Discriminants (Rec) and then Debug_Flag_Dot_R) @@ -3096,18 +3094,31 @@ package body Freeze is end if; -- If ancestor subtype present, freeze that first. Note that this - -- will also get the base type frozen. + -- will also get the base type frozen. Need RM reference ??? Atype := Ancestor_Subtype (E); if Present (Atype) then Freeze_And_Append (Atype, N, Result); - -- Otherwise freeze the base type of the entity before freezing - -- the entity itself (RM 13.14(15)). + -- No ancestor subtype present + + else + -- See if we have a nearest ancestor that has a predicate. + -- That catches the case of derived type with a predicate. + -- Need RM reference here ??? - elsif E /= Base_Type (E) then - Freeze_And_Append (Base_Type (E), N, Result); + Atype := Nearest_Ancestor (E); + + if Present (Atype) and then Has_Predicates (Atype) then + Freeze_And_Append (Atype, N, Result); + end if; + + -- Freeze base type before freezing the entity (RM 13.14(15)) + + if E /= Base_Type (E) then + Freeze_And_Append (Base_Type (E), N, Result); + end if; end if; -- For a derived type, freeze its parent type first (RM 13.14(15)) @@ -3464,9 +3475,9 @@ package body Freeze is end; end if; - -- If any of the index types was an enumeration type with - -- a non-standard rep clause, then we indicate that the - -- array type is always packed (even if it is not bit packed). + -- If any of the index types was an enumeration type with a + -- non-standard rep clause, then we indicate that the array + -- type is always packed (even if it is not bit packed). if Non_Standard_Enum then Set_Has_Non_Standard_Rep (Base_Type (E)); @@ -3805,9 +3816,7 @@ package body Freeze is -- these till the freeze-point since we need the small and range -- values. We only do these checks for base types - if Is_Ordinary_Fixed_Point_Type (E) - and then E = Base_Type (E) - then + if Is_Ordinary_Fixed_Point_Type (E) and then Is_Base_Type (E) then if Small_Value (E) < Ureal_2_M_80 then Error_Msg_Name_1 := Name_Small; Error_Msg_N @@ -3852,7 +3861,7 @@ package body Freeze is -- only to base types. if Present (Default_Pool) - and then E = Base_Type (E) + and then Is_Base_Type (E) and then not Has_Storage_Size_Clause (E) and then No (Associated_Storage_Pool (E)) then |