diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d61f7745d62f..463e2689101e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,34 @@ +2014-02-06 Robert Dewar + + * casing.adb (Determine_Casing): Consider SPARK_Mode to be + mixed case. + +2014-02-06 Ed Schonberg + + * exp_ch6.adb (Is_Build_In_Place_Function): Predicate is false + when the function has a foreign convention, but not if only the + limited return type has such a convention. + +2014-02-06 Hristian Kirtchev + + * sem_ch3.adb (Handle_Late_Controlled_Primitive): Remove local + variable Spec. Comment reformatting. Use Copy_Separate_Tree + rather than New_Copy_Tree when building the corresponding + subprogram declaration. + +2014-02-06 Hristian Kirtchev + + * sem_prag.adb (Analyze_Global_Item): Remove + the mode-related checks on abstract states with enabled external + properties. + (Property_Error): Removed. + +2014-02-06 Javier Miranda + + * lib-xref.adb (Generate_Reference): When + generating the reference to the first private entity take care + of handling swapped entities. + 2014-02-06 Sergey Rybin * gnat_ugn.texi, vms_data.ads: Add documentation of -j option for diff --git a/gcc/ada/casing.adb b/gcc/ada/casing.adb index 4a0d855e1ba5..dce1e0bb1749 100644 --- a/gcc/ada/casing.adb +++ b/gcc/ada/casing.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -59,6 +59,14 @@ package body Casing is -- True at start of string, and after an underline character begin + -- A special kludge, consider SPARK_Mode to be mixed case + + if Ident = "SPARK_Mode" then + return Mixed_Case; + end if; + + -- Proceed with normal determination + for S in Ident'Range loop if Ident (S) = '_' or else Ident (S) = '.' then After_Und := True; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 556bfe08b156..39085843ae55 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -9592,13 +9592,13 @@ package body Exp_Ch6 is or else (Ekind (E) = E_Subprogram_Type and then Etype (E) /= Standard_Void_Type) then - -- Note: If you have Convention (C) on an inherently limited type, - -- you're on your own. That is, the C code will have to be carefully - -- written to know about the Ada conventions. + -- Note: If the function has a foreign convention, it cannot build + -- its result in place, so you're on your own. On the other hand, + -- if only the return type has a foreign convention, its layout is + -- intended to be compatible with the other language, but the build- + -- in place machinery can ensure that the object is not copied. - if Has_Foreign_Convention (E) - or else Has_Foreign_Convention (Etype (E)) - then + if Has_Foreign_Convention (E) then return False; -- In Ada 2005 all functions with an inherently limited return type diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 034e67af928b..fbbdc3fb0236 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1088,15 +1088,29 @@ package body Lib.Xref is and then Present (First_Private_Entity (E)) and then In_Extended_Main_Source_Unit (N) then - Add_Entry - ((Ent => Ent, - Loc => Sloc (First_Private_Entity (E)), - Typ => 'E', - Eun => Get_Source_Unit (Def), - Lun => Get_Source_Unit (Ref), - Ref_Scope => Empty, - Ent_Scope => Empty), - Ent_Scope_File => No_Unit); + -- Handle case in which the full-view and partial-view of the + -- first private entity are swapped + + declare + First_Private : Entity_Id := First_Private_Entity (E); + + begin + if Is_Private_Type (First_Private) + and then Present (Full_View (First_Private)) + then + First_Private := Full_View (First_Private); + end if; + + Add_Entry + ((Ent => Ent, + Loc => Sloc (First_Private), + Typ => 'E', + Eun => Get_Source_Unit (Def), + Lun => Get_Source_Unit (Ref), + Ref_Scope => Empty, + Ent_Scope => Empty), + Ent_Scope_File => No_Unit); + end; end if; end if; end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index be9e3e8eb6e3..2f6eedbb5334 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2110,7 +2110,6 @@ package body Sem_Ch3 is Loc : constant Source_Ptr := Sloc (Body_Id); Params : constant List_Id := Parameter_Specifications (Body_Spec); - Spec : Node_Id; Spec_Id : Entity_Id; Dummy : Entity_Id; @@ -2119,8 +2118,8 @@ package body Sem_Ch3 is -- spec analysis. begin - -- Consider only procedure bodies whose name matches one of type - -- [Limited_]Controlled's primitives. + -- Consider only procedure bodies whose name matches one of the three + -- controlled primitives. if Nkind (Body_Spec) /= N_Procedure_Specification or else not Nam_In (Chars (Body_Id), Name_Adjust, @@ -2129,8 +2128,7 @@ package body Sem_Ch3 is then return; - -- A controlled primitive must have exactly one formal whose type - -- derives from [Limited_]Controlled. + -- A controlled primitive must have exactly one formal elsif List_Length (Params) /= 1 then return; @@ -2138,6 +2136,8 @@ package body Sem_Ch3 is Dummy := Analyze_Subprogram_Specification (Body_Spec); + -- The type of the formal must be derived from [Limited_]Controlled + if not Is_Controlled (Etype (Defining_Entity (First (Params)))) then return; end if; @@ -2152,16 +2152,13 @@ package body Sem_Ch3 is end if; -- At this point the body is known to be a late controlled primitive. - -- Generate a matching spec and insert it before the body. - - Spec := New_Copy_Tree (Body_Spec); - - Set_Defining_Unit_Name - (Spec, Make_Defining_Identifier (Loc, Chars (Body_Id))); + -- Generate a matching spec and insert it before the body. Note the + -- use of Copy_Separate_Tree - we want an entirely separate semantic + -- tree in this case. Insert_Before_And_Analyze (Body_Decl, Make_Subprogram_Declaration (Loc, - Specification => Spec)); + Specification => Copy_Separate_Tree (Body_Spec))); end Handle_Late_Controlled_Primitive; -------------------------------- diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index dabc4bbf8936..9549ade0a246 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1912,34 +1912,8 @@ package body Sem_Prag is (Item : Node_Id; Global_Mode : Name_Id) is - procedure Property_Error - (State_Id : Entity_Id; - Prop_Nam : Name_Id); - -- Emit an error concerning state State_Id with enabled property - -- Async_Readers, Effective_Reads or Effective_Writes that is not - -- marked as In_Out or Output item. - - -------------------- - -- Property_Error -- - -------------------- - - procedure Property_Error - (State_Id : Entity_Id; - Prop_Nam : Name_Id) - is - begin - Error_Msg_Name_1 := Prop_Nam; - Error_Msg_NE - ("external state & with enabled property % must have mode " - & "In_Out or Output (SPARK RM 7.1.2(7))", Item, State_Id); - end Property_Error; - - -- Local variables - Item_Id : Entity_Id; - -- Start of processing for Analyze_Global_Item - begin -- Detect one of the following cases @@ -2018,30 +1992,6 @@ package body Sem_Prag is Ref => Item); end if; - -- Detect an external state with an enabled property that - -- does not match the mode of the state. - - if Global_Mode = Name_Input then - if Async_Readers_Enabled (Item_Id) then - Property_Error (Item_Id, Name_Async_Readers); - - elsif Effective_Reads_Enabled (Item_Id) then - Property_Error (Item_Id, Name_Effective_Reads); - - elsif Effective_Writes_Enabled (Item_Id) then - Property_Error (Item_Id, Name_Effective_Writes); - end if; - - elsif Global_Mode = Name_Output - and then Async_Writers_Enabled (Item_Id) - then - Error_Msg_Name_1 := Name_Async_Writers; - Error_Msg_NE - ("external state & with enabled property % must have " - & "mode Input or In_Out (SPARK RM 7.1.2(7))", - Item, Item_Id); - end if; - -- Variable related checks else