From caa64a44ace7776c08a1ca261380bee9a74e2dff Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 27 Apr 2016 14:47:56 +0200 Subject: [PATCH] [multiple changes] 2016-04-27 Hristian Kirtchev * sem_prag.adb (Process_Atomic_Independent_Shared_Volatile): Code cleanup. Check the original node when trying to determine the node kind of pragma Volatile's argument to account for untagged derivations where the type is transformed into a constrained subtype. 2016-04-27 Olivier Hainque * mkdir.c (__gnat_mkdir): Rework the vxworks section to use a consistent posix interface on the caller side. 2016-04-27 Ed Schonberg * sem_ch10.adb (Build_Limited_View, Decorate_Type): If this is a limited view of a type, initialize the Limited_Dependents field to catch misuses of the type in a client unit. 2016-04-27 Thomas Quinot * a-strunb-shared.adb (Finalize): add missing Reference call. * s-strhas.adb: minor grammar fix and extension of comment * sem_ch8.adb: minor whitespace fixes 2016-04-27 Ed Schonberg * lib-xref.adb (Get_Type_Reference): Handle properly the case of an object declaration whose type definition is a class-wide subtype and whose expression is a function call that returns a classwide type. 2016-04-27 Hristian Kirtchev * sem_util.ads, sem_util.adb (Output_Entity): New routine. (Output_Name): New routine. 2016-04-27 Bob Duff * exp_ch3.adb (Rewrite_As_Renaming): Disable previous change for now. From-SVN: r235495 --- gcc/ada/ChangeLog | 40 ++++++++++++++++++++++++ gcc/ada/a-strunb-shared.adb | 1 + gcc/ada/exp_ch3.adb | 5 ++- gcc/ada/lib-xref.adb | 28 ++++++++++------- gcc/ada/mkdir.c | 16 ++++++++-- gcc/ada/s-strhas.adb | 7 +++-- gcc/ada/sem_ch10.adb | 38 ++++++++++++----------- gcc/ada/sem_ch8.adb | 6 ++-- gcc/ada/sem_prag.adb | 33 +++++++++++--------- gcc/ada/sem_util.adb | 61 +++++++++++++++++++++++++++++++++++++ gcc/ada/sem_util.ads | 16 ++++++++++ 11 files changed, 198 insertions(+), 53 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1cf844c700a..62f41b7c932 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,43 @@ +2016-04-27 Hristian Kirtchev + + * sem_prag.adb (Process_Atomic_Independent_Shared_Volatile): Code + cleanup. Check the original node when trying to determine the node kind + of pragma Volatile's argument to account for untagged derivations + where the type is transformed into a constrained subtype. + +2016-04-27 Olivier Hainque + + * mkdir.c (__gnat_mkdir): Rework the vxworks section to use a + consistent posix interface on the caller side. + +2016-04-27 Ed Schonberg + + * sem_ch10.adb (Build_Limited_View, Decorate_Type): If this + is a limited view of a type, initialize the Limited_Dependents + field to catch misuses of the type in a client unit. + +2016-04-27 Thomas Quinot + + * a-strunb-shared.adb (Finalize): add missing Reference call. + * s-strhas.adb: minor grammar fix and extension of comment + * sem_ch8.adb: minor whitespace fixes + +2016-04-27 Ed Schonberg + + * lib-xref.adb (Get_Type_Reference): Handle properly the case + of an object declaration whose type definition is a class-wide + subtype and whose expression is a function call that returns a + classwide type. + +2016-04-27 Hristian Kirtchev + + * sem_util.ads, sem_util.adb (Output_Entity): New routine. + (Output_Name): New routine. + +2016-04-27 Bob Duff + + * exp_ch3.adb (Rewrite_As_Renaming): Disable previous change for now. + 2016-04-27 Vincent Celier * gnatcmd.adb: For "gnat ls -V -P", recognize switch diff --git a/gcc/ada/a-strunb-shared.adb b/gcc/ada/a-strunb-shared.adb index 72028e08d2c..88698b0c892 100644 --- a/gcc/ada/a-strunb-shared.adb +++ b/gcc/ada/a-strunb-shared.adb @@ -799,6 +799,7 @@ package body Ada.Strings.Unbounded is -- effects if a program references an already-finalized object. Object.Reference := Null_Unbounded_String.Reference; + Reference (Object.Reference); Unreference (SR); end if; end Finalize; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 5f6e3cd9eb1..05f8a6c5105 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6351,7 +6351,10 @@ package body Exp_Ch3 is -- would otherwise make two copies. The RM allows removing redunant -- Adjust/Finalize calls, but does not allow insertion of extra ones. - return (Nkind (Expr_Q) = N_Explicit_Dereference + -- This part is disabled for now, because it breaks GPS builds. + + return (False -- ??? + and then Nkind (Expr_Q) = N_Explicit_Dereference and then not Comes_From_Source (Expr_Q) and then Nkind (Original_Node (Expr_Q)) = N_Function_Call and then Nkind (Object_Definition (N)) in N_Has_Entity diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index d64b4b25d22..c3039cd7a8b 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2016, 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- -- @@ -1467,17 +1467,23 @@ package body Lib.Xref is -- initialized with a tag-indeterminate call gets a subtype -- of the classwide type during expansion. See if the original -- type in the declaration is named, and return it instead - -- of going to the root type. + -- of going to the root type. The expression may be a class- + -- wide function call whose result is on the secondary stack, + -- which forces the declaration to be rewritten as a renaming, + -- so examine the source declaration. - if Ekind (Tref) = E_Class_Wide_Subtype - and then Nkind (Parent (Ent)) = N_Object_Declaration - and then - Nkind (Original_Node (Object_Definition (Parent (Ent)))) - = N_Identifier - then - Tref := - Entity - (Original_Node ((Object_Definition (Parent (Ent))))); + if Ekind (Tref) = E_Class_Wide_Subtype then + declare + Decl : constant Node_Id := Original_Node (Parent (Ent)); + begin + if Nkind (Decl) = N_Object_Declaration + and then Is_Entity_Name + (Original_Node ((Object_Definition (Decl)))) + then + Tref := + Entity ((Original_Node ((Object_Definition (Decl))))); + end if; + end; end if; -- For anything else, exit diff --git a/gcc/ada/mkdir.c b/gcc/ada/mkdir.c index bdb0fa8f7b9..9b0a9265038 100644 --- a/gcc/ada/mkdir.c +++ b/gcc/ada/mkdir.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 2002-2014, Free Software Foundation, Inc. * + * Copyright (C) 2002-2016, 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- * @@ -60,8 +60,18 @@ int __gnat_mkdir (char *dir_name, int encoding ATTRIBUTE_UNUSED) { -#if defined (__vxworks) && !(defined (__RTP__) && ((_WRS_VXWORKS_MAJOR == 7) || (_WRS_VXWORKS_MINOR != 0))) - return mkdir (dir_name); +#if defined (__vxworks) + + /* Pretend that the system mkdir is posix compliant even though it + sometimes is not, not expecting the second argument in some + configurations (e.g. vxworks 653 2.2, difference from 2.5). The + second actual argument will just be ignored in this case. */ + + typedef int posix_mkdir (const char * name, mode_t mode); + + posix_mkdir * vxmkdir = (posix_mkdir *)&mkdir; + return vxmkdir (dir_name, S_IRWXU | S_IRWXG | S_IRWXO); + #elif defined (__MINGW32__) TCHAR wname [GNAT_MAX_PATH_LEN + 2]; diff --git a/gcc/ada/s-strhas.adb b/gcc/ada/s-strhas.adb index 6b7b9fea2a6..9ab5b6e423b 100644 --- a/gcc/ada/s-strhas.adb +++ b/gcc/ada/s-strhas.adb @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2009-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2009-2016, 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- -- @@ -33,8 +33,9 @@ pragma Compiler_Unit_Warning; package body System.String_Hash is - -- Compute a hash value for a key. The approach here is follows the - -- algorithm used in GNU Awk and the ndbm substitute SDBM by Ozan Yigit. + -- Compute a hash value for a key. The approach here follows the algorithm + -- introduced in the ndbm substitute SDBM by Ozan Yigit and then reused in + -- GNU Awk (where they are implemented as a Duff's device). ---------- -- Hash -- diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 9855c9e818e..c02cd4f4e56 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -84,6 +84,13 @@ package body Sem_Ch10 is -- required in order to avoid passing non-decorated entities to the -- back-end. Implements Ada 2005 (AI-50217). + procedure Analyze_Proper_Body (N : Node_Id; Nam : Entity_Id); + -- Common processing for all stubs (subprograms, tasks, packages, and + -- protected cases). N is the stub to be analyzed. Once the subunit name + -- is established, load and analyze. Nam is the non-overloadable entity + -- for which the proper body provides a completion. Subprogram stubs are + -- handled differently because they can be declarations. + procedure Check_Body_Needed_For_SAL (Unit_Name : Entity_Id); -- Check whether the source for the body of a compilation unit must be -- included in a standalone library. @@ -203,13 +210,6 @@ package body Sem_Ch10 is procedure Unchain (E : Entity_Id); -- Remove single entity from visibility list - procedure Analyze_Proper_Body (N : Node_Id; Nam : Entity_Id); - -- Common processing for all stubs (subprograms, tasks, packages, and - -- protected cases). N is the stub to be analyzed. Once the subunit name - -- is established, load and analyze. Nam is the non-overloadable entity - -- for which the proper body provides a completion. Subprogram stubs are - -- handled differently because they can be declarations. - procedure sm; -- A dummy procedure, for debugging use, called just before analyzing the -- main unit (after dealing with any context clauses). @@ -1489,7 +1489,7 @@ package body Sem_Ch10 is -- Check if the named package (or some ancestor) -- leaves visible the full-view of the unit given - -- in the limited-with clause + -- in the limited-with clause. loop if Designate_Same_Unit (Lim_Unit_Name, @@ -5633,15 +5633,19 @@ package body Sem_Ch10 is begin -- An unanalyzed type or a shadow entity of a type is treated as an - -- incomplete type. - - Set_Ekind (Ent, E_Incomplete_Type); - Set_Etype (Ent, Ent); - Set_Full_View (Ent, Empty); - Set_Is_First_Subtype (Ent); - Set_Scope (Ent, Scop); - Set_Stored_Constraint (Ent, No_Elist); - Init_Size_Align (Ent); + -- incomplete type, and carries the corresponding attributes. + + Set_Ekind (Ent, E_Incomplete_Type); + Set_Etype (Ent, Ent); + Set_Full_View (Ent, Empty); + Set_Is_First_Subtype (Ent); + Set_Scope (Ent, Scop); + Set_Stored_Constraint (Ent, No_Elist); + Init_Size_Align (Ent); + + if From_Limited_With (Ent) then + Set_Private_Dependents (Ent, New_Elmt_List); + end if; -- A tagged type and its corresponding shadow entity share one common -- class-wide type. The list of primitive operations for the shadow diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 842bb23a2f5..3f8556d4abf 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1428,15 +1428,15 @@ package body Sem_Ch8 is Set_Etype (New_P, Standard_Void_Type); if Present (Renamed_Object (Old_P)) then - Set_Renamed_Object (New_P, Renamed_Object (Old_P)); + Set_Renamed_Object (New_P, Renamed_Object (Old_P)); else Set_Renamed_Object (New_P, Old_P); end if; Set_Has_Completion (New_P); - Set_First_Entity (New_P, First_Entity (Old_P)); - Set_Last_Entity (New_P, Last_Entity (Old_P)); + Set_First_Entity (New_P, First_Entity (Old_P)); + Set_Last_Entity (New_P, Last_Entity (Old_P)); Set_First_Private_Entity (New_P, First_Private_Entity (Old_P)); Check_Library_Unit_Renaming (N, Old_P); Generate_Reference (Old_P, Name (N)); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 14b53ee3c41..613ccdb414c 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -6467,11 +6467,6 @@ package body Sem_Prag is ------------------------------------------------ procedure Process_Atomic_Independent_Shared_Volatile is - D : Node_Id; - E : Entity_Id; - E_Id : Node_Id; - K : Node_Kind; - procedure Set_Atomic_VFA (E : Entity_Id); -- Set given type as Is_Atomic or Is_Volatile_Full_Access. Also, if -- no explicit alignment was given, set alignment to unknown, since @@ -6495,6 +6490,12 @@ package body Sem_Prag is end if; end Set_Atomic_VFA; + -- Local variables + + Decl : Node_Id; + E : Entity_Id; + E_Arg : Node_Id; + -- Start of processing for Process_Atomic_Independent_Shared_Volatile begin @@ -6502,15 +6503,14 @@ package body Sem_Prag is Check_No_Identifiers; Check_Arg_Count (1); Check_Arg_Is_Local_Name (Arg1); - E_Id := Get_Pragma_Arg (Arg1); + E_Arg := Get_Pragma_Arg (Arg1); - if Etype (E_Id) = Any_Type then + if Etype (E_Arg) = Any_Type then return; end if; - E := Entity (E_Id); - D := Declaration_Node (E); - K := Nkind (D); + E := Entity (E_Arg); + Decl := Declaration_Node (E); -- A pragma that applies to a Ghost entity becomes Ghost for the -- purposes of legality checks and removal of ignored Ghost code. @@ -6619,8 +6619,8 @@ package body Sem_Prag is Set_Treat_As_Volatile (Underlying_Type (E)); end if; - elsif K = N_Object_Declaration - or else (K = N_Component_Declaration + elsif Nkind (Decl) = N_Object_Declaration + or else (Nkind (Decl) = N_Component_Declaration and then Original_Record_Component (E) = E) then if Rep_Item_Too_Late (E, N) then @@ -6674,12 +6674,15 @@ package body Sem_Prag is -- The following check is only relevant when SPARK_Mode is on as -- this is not a standard Ada legality rule. Pragma Volatile can -- only apply to a full type declaration or an object declaration - -- (SPARK RM C.6(1)). + -- (SPARK RM C.6(1)). Original_Node is necessary to account for + -- untagged derived types that are rewritten as subtypes of their + -- respective root types. if SPARK_Mode = On and then Prag_Id = Pragma_Volatile - and then not Nkind_In (K, N_Full_Type_Declaration, - N_Object_Declaration) + and then + not Nkind_In (Original_Node (Decl), N_Full_Type_Declaration, + N_Object_Declaration) then Error_Pragma_Arg ("argument of pragma % must denote a full type or object " diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b49c7888549..7f99291bdf8 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -17708,6 +17708,67 @@ package body Sem_Util is end if; end Original_Corresponding_Operation; + ------------------- + -- Output_Entity -- + ------------------- + + procedure Output_Entity (Id : Entity_Id) is + Scop : Entity_Id; + + begin + Scop := Scope (Id); + + -- The entity may lack a scope when it is in the process of being + -- analyzed. Use the current scope as an approximation. + + if No (Scop) then + Scop := Current_Scope; + end if; + + Output_Name (Chars (Id), Scop); + end Output_Entity; + + ----------------- + -- Output_Name -- + ----------------- + + procedure Output_Name (Nam : Name_Id; Scop : Entity_Id := Current_Scope) is + procedure Output_Scope (S : Entity_Id); + -- Add the fully qualified form of scope S to the name buffer. The + -- qualification format is: + -- scope1__scopeN__ + + ------------------ + -- Output_Scope -- + ------------------ + + procedure Output_Scope (S : Entity_Id) is + begin + if S = Empty then + null; + + elsif S = Standard_Standard then + null; + + else + Output_Scope (Scope (S)); + Add_Str_To_Name_Buffer (Get_Name_String (Chars (S))); + Add_Str_To_Name_Buffer ("__"); + end if; + end Output_Scope; + + -- Start of processing for Output_Name + + begin + Name_Len := 0; + Output_Scope (Scop); + + Add_Str_To_Name_Buffer (Get_Name_String (Nam)); + + Write_Str (Name_Buffer (1 .. Name_Len)); + Write_Eol; + end Output_Name; + ---------------------- -- Policy_In_Effect -- ---------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 5286ec6426e..0845bf7be40 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1933,6 +1933,22 @@ package Sem_Util is -- corresponding operation of S is the original corresponding operation of -- S2. Otherwise, it is S itself. + procedure Output_Entity (Id : Entity_Id); + -- Print entity Id to standard output. The name of the entity appears in + -- fully qualified form. + -- + -- WARNING: this routine should be used in debugging scenarios such as + -- tracking down undefined symbols as it is fairly low level. + + procedure Output_Name (Nam : Name_Id; Scop : Entity_Id := Current_Scope); + -- Print name Nam to standard output. The name appears in fully qualified + -- form assuming it appears in scope Scop. Note that this may not reflect + -- the final qualification as the entity which carries the name may be + -- relocated to a different scope. + -- + -- WARNING: this routine should be used in debugging scenarios such as + -- tracking down undefined symbols as it is fairly low level. + function Policy_In_Effect (Policy : Name_Id) return Name_Id; -- Given a policy, return the policy identifier associated with it. If no -- such policy is in effect, the value returned is No_Name. -- 2.30.2