diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 13 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/lib.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 50 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 8 |
8 files changed, 72 insertions, 35 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e8a7143a044..3939bafd830 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2014-10-20 Robert Dewar <dewar@adacore.com> + + * sem_ch3.adb, prj-proc.adb, sem_ch4.adb, prj-env.adb, lib.ads, + sem_ch13.adb: Minor reformatting. + +2014-10-20 Javier Miranda <miranda@adacore.com> + + * exp_ch3.adb (Expand_N_Object_Declaration): Expand the + declaration of a class-wide limited object containing an + initializing expression into a renaming declaration. Required to + avoid passing such declaration to the backend and also to avoid + generating an extra copy. + 2014-10-20 Eric Botcazou <ebotcazou@adacore.com> * inline.adb (List_Inlining_Info): Minor tweaks. diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index d57fadca639..330e168425a 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5875,6 +5875,29 @@ package body Exp_Ch3 is Set_Expression (N, Empty); return; + -- Handle initialization of limited tagged types + + elsif Is_Tagged_Type (Typ) + and then Is_Class_Wide_Type (Typ) + and then Is_Limited_Record (Typ) + then + -- Given that the type is limited we cannot perform a copy. If + -- Expr_Q is the reference to a variable we mark the variable + -- as OK_To_Rename to expand this declaration into a renaming + -- declaration (see bellow). + + if Is_Entity_Name (Expr_Q) then + Set_OK_To_Rename (Entity (Expr_Q)); + + -- If we cannot convert the expression into a renaming we must + -- consider it an internal error because the backend does not + -- have support to handle it. + + else + pragma Assert (False); + raise Program_Error; + end if; + -- For discrete types, set the Is_Known_Valid flag if the -- initializing value is known to be valid. Only do this for -- source assignments, since otherwise we can end up turning diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index 4a9f7deac5f..5bbd4119f2d 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -750,6 +750,8 @@ private pragma Inline (Unit_File_Name); pragma Inline (Unit_Name); + -- The Units Table + type Unit_Record is record Unit_File_Name : File_Name_Type; Unit_Name : Unit_Name_Type; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index ac5b69f0a97..b6bb25fcbf8 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -1425,10 +1425,8 @@ package body Prj.Env is (Self : Project_Search_Path; Name : String) return String_Access is - - function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path - (Check_Filename => Is_Directory); - + function Find_Rts_In_Path is + new Prj.Env.Find_Name_In_Path (Check_Filename => Is_Directory); begin return Find_Rts_In_Path (Self, Name); end Get_Runtime_Path; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index f0669f2a294..2b865a27fd7 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -909,6 +909,7 @@ package body Prj.Proc is elsif The_Variable.Default then case The_Variable.Kind is + when Undefined => null; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 8b716f47584..211d9675681 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1677,7 +1677,7 @@ package body Sem_Ch13 is then Error_Msg_N ("indexing aspect can only apply to a tagged type", - Aspect); + Aspect); goto Continue; end if; @@ -2711,7 +2711,7 @@ package body Sem_Ch13 is when Aspect_Default_Component_Value => if not (Is_Array_Type (E) - and then Is_Scalar_Type (Component_Type (E))) + and then Is_Scalar_Type (Component_Type (E))) then Error_Msg_N ("aspect Default_Component_Value can only " & "apply to an array of scalar components", N); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index fcc6e1f9ac2..911198f325e 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2237,8 +2237,7 @@ package body Sem_Ch3 is Set_Null_Present (Spec, False); Insert_Before_And_Analyze (Body_Decl, - Make_Subprogram_Declaration (Loc, - Specification => Spec)); + Make_Subprogram_Declaration (Loc, Specification => Spec)); end Handle_Late_Controlled_Primitive; -------------------------------- @@ -3003,7 +3002,8 @@ package body Sem_Ch3 is T := It.Typ; elsif It.Typ = Universal_Real - or else It.Typ = Universal_Integer + or else + It.Typ = Universal_Integer then -- Choose universal interpretation over any other @@ -4883,8 +4883,8 @@ package body Sem_Ch3 is and then (Nkind (Parent (Generic_Parent_Type (N))) /= N_Formal_Type_Declaration - or else Nkind - (Formal_Type_Definition (Parent (Generic_Parent_Type (N)))) /= + or else Nkind (Formal_Type_Definition + (Parent (Generic_Parent_Type (N)))) /= N_Formal_Private_Type_Definition) then if Is_Tagged_Type (Id) then @@ -5329,10 +5329,9 @@ package body Sem_Ch3 is Set_Component_Size (Implicit_Base, Uint_0); Set_Packed_Array_Impl_Type (Implicit_Base, Empty); Set_Has_Controlled_Component - (Implicit_Base, Has_Controlled_Component - (Element_Type) - or else Is_Controlled - (Element_Type)); + (Implicit_Base, + Has_Controlled_Component (Element_Type) + or else Is_Controlled (Element_Type)); Set_Finalize_Storage_Only (Implicit_Base, Finalize_Storage_Only (Element_Type)); @@ -6490,9 +6489,7 @@ package body Sem_Ch3 is -- If we did not have a range constraint, then set the range from the -- parent type. Otherwise, the Process_Subtype call has set the bounds. - if No_Constraint - or else not Has_Range_Constraint (Indic) - then + if No_Constraint or else not Has_Range_Constraint (Indic) then Set_Scalar_Range (Derived_Type, Make_Range (Loc, Low_Bound => New_Copy_Tree (Type_Low_Bound (Parent_Type)), @@ -7695,7 +7692,7 @@ package body Sem_Ch3 is if not Has_Discriminants (Parent_Base) or else (Has_Unknown_Discriminants (Parent_Base) - and then Is_Private_Type (Parent_Base)) + and then Is_Private_Type (Parent_Base)) then Error_Msg_N ("invalid constraint: type has no discriminant", @@ -8636,8 +8633,7 @@ package body Sem_Ch3 is -- Set SSO default for record or array type - if (Is_Array_Type (Derived_Type) - or else Is_Record_Type (Derived_Type)) + if (Is_Array_Type (Derived_Type) or else Is_Record_Type (Derived_Type)) and then Is_Base_Type (Derived_Type) then Set_Default_SSO (Derived_Type); @@ -8818,7 +8814,8 @@ package body Sem_Ch3 is -- and in family bounds. if Is_Concurrent_Type (Current_Scope) - or else Is_Limited_Type (Current_Scope) + or else + Is_Limited_Type (Current_Scope) then CR_Disc := Make_Defining_Identifier (Sloc (Discrim), Chars (Discrim)); @@ -11878,14 +11875,17 @@ package body Sem_Ch3 is Constrain_Discriminated_Type (Desig_Subtype, S, Related_Nod, For_Access => True); - elsif (Is_Task_Type (Desig_Type) or else Is_Protected_Type (Desig_Type)) + elsif Is_Concurrent_Type (Desig_Type) and then not Is_Constrained (Desig_Type) then Constrain_Concurrent (Desig_Subtype, S, Related_Nod, Desig_Type, ' '); else Error_Msg_N ("invalid constraint on access type", S); - Desig_Subtype := Desig_Type; -- Ignore invalid constraint + + -- We simply ignore an invalid constraint + + Desig_Subtype := Desig_Type; Constraint_OK := False; end if; @@ -15517,7 +15517,8 @@ package body Sem_Ch3 is if Present (Discriminant_Specifications (N)) then if (Is_Elementary_Type (Parent_Type) - or else Is_Array_Type (Parent_Type)) + or else + Is_Array_Type (Parent_Type)) and then not Error_Posted (N) then Error_Msg_N @@ -20048,12 +20049,11 @@ package body Sem_Ch3 is if Ekind (Root_Type (Entity (T))) = E_Incomplete_Type and then not (Ada_Version >= Ada_2005 - and then - (Nkind (Parent (T)) = N_Subtype_Declaration - or else - (Nkind (Parent (T)) = N_Subtype_Indication - and then Nkind (Parent (Parent (T))) = - N_Subtype_Declaration))) + and then + (Nkind (Parent (T)) = N_Subtype_Declaration + or else (Nkind (Parent (T)) = N_Subtype_Indication + and then Nkind (Parent (Parent (T))) = + N_Subtype_Declaration))) then Error_Msg_N ("invalid use of type before its full declaration", T); end if; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 167aae85c73..be1b321b253 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -2198,10 +2198,10 @@ package body Sem_Ch4 is and then Is_Discrete_Type (Entity (Actual)) then Replace (N, - Make_Slice (Loc, - Prefix => P, - Discrete_Range => - New_Occurrence_Of (Entity (Actual), Loc))); + Make_Slice (Loc, + Prefix => P, + Discrete_Range => + New_Occurrence_Of (Entity (Actual), Loc))); Analyze (N); return; |