+2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * 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 <hainque@adacore.com>
+
+ * mkdir.c (__gnat_mkdir): Rework the vxworks section to use a
+ consistent posix interface on the caller side.
+
+2016-04-27 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <quinot@adacore.com>
+
+ * 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 <schonberg@adacore.com>
+
+ * 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 <kirtchev@adacore.com>
+
+ * sem_util.ads, sem_util.adb (Output_Entity): New routine.
+ (Output_Name): New routine.
+
+2016-04-27 Bob Duff <duff@adacore.com>
+
+ * exp_ch3.adb (Rewrite_As_Renaming): Disable previous change for now.
+
2016-04-27 Vincent Celier <celier@adacore.com>
* gnatcmd.adb: For "gnat ls -V -P", recognize switch
-- effects if a program references an already-finalized object.
Object.Reference := Null_Unbounded_String.Reference;
+ Reference (Object.Reference);
Unreference (SR);
end if;
end Finalize;
-- 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
-- --
-- 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- --
-- 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
* *
* 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- *
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];
-- --
-- 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- --
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 --
-- 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.
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).
-- 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,
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
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));
------------------------------------------------
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
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
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.
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
-- 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 "
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 --
----------------------
-- 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.
projects / gcc.git / commitdiff