diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 28 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/exp_disp.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 28 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_type.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 10 |
10 files changed, 88 insertions, 30 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5de8f002659..b98c272eed3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,33 @@ 2015-05-12 Robert Dewar <dewar@adacore.com> + * sem_type.adb, sem_ch10.adb, freeze.adb, sem_ch6.adb, exp_disp.adb: + Minor reformatting. + +2015-05-12 Bob Duff <duff@adacore.com> + + * exp_attr.adb (Size): Remove unnecessary check for types with + unknown discriminants. That was causing the compiler to build + a function call _size(T), where T is a type, not an object. + +2015-05-12 Ed Schonberg <schonberg@adacore.com> + + * sem_ch4.adb (Extended_Primitive_Ops): Exclude overriding + primitive operations of a type extension declared in the package + body, to prevent duplicates in extended list. + +2015-05-12 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb (Analyze_Component_Declaration): If the component is + an unconstrained synchronized type with discriminants, create a + constrained default subtype for it, so that the enclosing record + can be given the proper size. + * sem_util.adb (Build_Default_Subtype): If the subtype is created + for a record discriminant, do not analyze the declarztion at + once because it is added to the freezing actions of the enclosing + record type. + +2015-05-12 Robert Dewar <dewar@adacore.com> + * exp_prag.adb (Expand_N_Pragma): Rewrite ignored pragma as Null statements. * namet.ads (Boolean3): Document this flag used for Ignore_Pragma. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index ef11b1911f1..c985a426817 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -5538,14 +5538,11 @@ package body Exp_Attr is -- For X'Size applied to an object of a class-wide type, transform -- X'Size into a call to the primitive operation _Size applied to X. - elsif Is_Class_Wide_Type (Ptyp) - or else (Id = Attribute_Size - and then Is_Tagged_Type (Ptyp) - and then Has_Unknown_Discriminants (Ptyp)) - then + elsif Is_Class_Wide_Type (Ptyp) then + -- No need to do anything else compiling under restriction -- No_Dispatching_Calls. During the semantic analysis we - -- already notified such violation. + -- already noted this restriction violation. if Restriction_Active (No_Dispatching_Calls) then return; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 68f504d0ae4..a70cf6a814d 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -1612,8 +1612,8 @@ package body Exp_Disp is Set_Scope (Anon, Current_Scope); end if; - Set_Directly_Designated_Type (Anon, - Non_Limited_View (Actual_DDT)); + Set_Directly_Designated_Type + (Anon, Non_Limited_View (Actual_DDT)); Set_Etype (Actual_Dup, Anon); end if; end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index d43a9fcfc81..8c1681526cf 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -425,8 +425,8 @@ package body Freeze is Ret_Type : constant Entity_Id := Etype (Result_Definition (Spec)); begin if Has_Non_Limited_View (Ret_Type) then - Set_Result_Definition (Spec, - New_Occurrence_Of (Non_Limited_View (Ret_Type), Loc)); + Set_Result_Definition + (Spec, New_Occurrence_Of (Non_Limited_View (Ret_Type), Loc)); end if; end; end if; @@ -456,10 +456,11 @@ package body Freeze is elsif Is_Access_Type (Form_Type) and then not Is_Access_Type (Pref) then - Actuals := New_List - (Make_Attribute_Reference (Loc, - Attribute_Name => Name_Access, - Prefix => Relocate_Node (Pref))); + Actuals := + New_List ( + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Access, + Prefix => Relocate_Node (Pref))); else Actuals := New_List (Pref); end if; @@ -530,7 +531,7 @@ package body Freeze is Make_Simple_Return_Statement (Loc, Expression => Make_Function_Call (Loc, - Name => Call_Name, + Name => Call_Name, Parameter_Associations => Actuals)); elsif Ekind (Old_S) = E_Enumeration_Literal then @@ -540,13 +541,12 @@ package body Freeze is elsif Nkind (Nam) = N_Character_Literal then Call_Node := - Make_Simple_Return_Statement (Loc, - Expression => Call_Name); + Make_Simple_Return_Statement (Loc, Expression => Call_Name); else Call_Node := Make_Procedure_Call_Statement (Loc, - Name => Call_Name, + Name => Call_Name, Parameter_Associations => Actuals); end if; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 4973dc15c80..bf1704ed6ef 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -5605,8 +5605,8 @@ package body Sem_Ch10 is Set_Non_Limited_View (Shadow, Ent); if Is_Tagged then - Set_Non_Limited_View (Class_Wide_Type (Shadow), - Class_Wide_Type (Ent)); + Set_Non_Limited_View + (Class_Wide_Type (Shadow), Class_Wide_Type (Ent)); end if; if Is_Incomplete_Or_Private_Type (Ent) then diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 64761f8a61b..addfc0a56c3 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -1794,9 +1794,10 @@ package body Sem_Ch3 is ----------------------------------- procedure Analyze_Component_Declaration (N : Node_Id) is - Id : constant Entity_Id := Defining_Identifier (N); - E : constant Node_Id := Expression (N); - Typ : constant Node_Id := + Loc : constant Source_Ptr := Sloc (N); + Id : constant Entity_Id := Defining_Identifier (N); + E : constant Node_Id := Expression (N); + Typ : constant Node_Id := Subtype_Indication (Component_Definition (N)); T : Entity_Id; P : Entity_Id; @@ -2123,6 +2124,27 @@ package body Sem_Ch3 is end if; end if; + -- If the component is an unconstrained task or protected type with + -- discriminants, the component and the enclosing record are limited + -- and the component is constrained by its default values. Compute + -- its actual subtype, else it may be allocated the maximum size by + -- the backend, and possibly overflow. + + if Is_Concurrent_Type (T) + and then not Is_Constrained (T) + and then Has_Discriminants (T) + and then not Has_Discriminants (Current_Scope) + then + declare + Act_T : constant Entity_Id := Build_Default_Subtype (T, N); + begin + Set_Etype (Id, Act_T); + Set_Component_Definition (N, + Make_Component_Definition (Loc, + Subtype_Indication => New_Occurrence_Of (Act_T, Loc))); + end; + end if; + Set_Original_Record_Component (Id, Id); if Has_Aspects (N) then diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 0af8a4624af..c6769c5d54b 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -8196,6 +8196,12 @@ package body Sem_Ch4 is while Present (Op) loop if Comes_From_Source (Op) and then Is_Overloadable (Op) + + -- Exclude overriding primitive operations of a type + -- extension declared in the package body, to prevent + -- duplicates in extended list. + + and then not Is_Primitive (Op) and then Is_List_Member (Unit_Declaration_Node (Op)) and then List_Containing (Unit_Declaration_Node (Op)) = Body_Decls diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index eb09ee3b597..dcbee8cbd86 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2921,11 +2921,8 @@ package body Sem_Ch6 is procedure Detect_And_Exchange (Id : Entity_Id) is Typ : constant Entity_Id := Etype (Id); - begin - if From_Limited_With (Typ) - and then Has_Non_Limited_View (Typ) - then + if From_Limited_With (Typ) and then Has_Non_Limited_View (Typ) then Set_Etype (Id, Non_Limited_View (Typ)); end if; end Detect_And_Exchange; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index b4d752d3258..785121adf24 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -1228,7 +1228,7 @@ package body Sem_Type is -- incomplete, get full view if available. return Has_Non_Limited_View (T1) - and then Covers (Get_Full_View (Non_Limited_View (T1)), T2); + and then Covers (Get_Full_View (Non_Limited_View (T1)), T2); elsif From_Limited_With (T2) then @@ -1237,7 +1237,7 @@ package body Sem_Type is -- verify that the context type is the nonlimited view. return Has_Non_Limited_View (T2) - and then Covers (T1, Get_Full_View (Non_Limited_View (T2))); + and then Covers (T1, Get_Full_View (Non_Limited_View (T2))); -- Ada 2005 (AI-412): Coverage for regular incomplete subtypes diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index f6b76e11a7f..0c176f03067 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1546,7 +1546,15 @@ package body Sem_Util is Constraints => Constraints))); Insert_Action (N, Decl); - Analyze (Decl); + + -- If the context is a component declaration the subtype + -- declaration will be analyzed when the enclosing type is + -- frozen, otherwise do it now. + + if Ekind (Current_Scope) /= E_Record_Type then + Analyze (Decl); + end if; + return Act; end; end Build_Default_Subtype; |