OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

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.

From-SVN: r235495
This commit is contained in:
Arnaud Charlet 2016-04-27 14:47:56 +02:00
parent a6ac73115a
commit caa64a44ac
11 changed files with 197 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
gcc/ada/ChangeLog
View File

@ -1,3 +1,43 @@
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

1
gcc/ada/a-strunb-shared.adb
View File

@ -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;

5
gcc/ada/exp_ch3.adb
View File

@ -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

28
gcc/ada/lib-xref.adb
View File

@ -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

16
gcc/ada/mkdir.c
View File

@ -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];

7
gcc/ada/s-strhas.adb
View File

@ -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 --

36
gcc/ada/sem_ch10.adb
View File

@ -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.
-- 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);
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

6
gcc/ada/sem_ch8.adb
View File

@ -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));

33
gcc/ada/sem_prag.adb
View File

@ -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 "

61
gcc/ada/sem_util.adb
View File

@ -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 --
----------------------

16
gcc/ada/sem_util.ads
View File

@ -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.