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

[multiple changes]

Browse Source 
2017-01-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch9.adb: minor style fixes in comments.
	* sem_ch9.adb (Analyze_Delay_Relative): in GNATprove mode a delay
	relative statement introduces an implicit dependency on
	Ada.Real_Time.Clock_Time.
	* sem_util.adb: Minor reformatting.

2017-01-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications): Aspect Alignment
	must be treated as delayed aspect even if the expression is
	a literal, because the aspect affects the freezing and the
	elaboration of the object to which it applies.

2017-01-20  Tristan Gingold  <gingold@adacore.com>

	* s-osinte-vxworks.ads (Interrup_Range): New subtype.

2017-01-20  Ed Schonberg  <schonberg@adacore.com>

	* lib-xref.adb (Generate_Reference): Do not warn about the
	presence of a pragma Unreferenced if the entity appears as the
	actual in a procedure call that does not come from source.

2017-01-20  Pascal Obry  <obry@adacore.com>

	* expect.c, terminals.c: Fix some warnings about unused variables.
	* gsocket.h, adaint.c, adaint.h: Fix some more warnings in the C part
	of the runtime.

2017-01-20  Bob Duff  <duff@adacore.com>

	* exp_attr.adb (Constrained): Apply an access check (check that
	the prefix is not null) when the prefix denotes an object of an
	access type; that is, when there is an implicit dereference.

2017-01-20  Gary Dismukes  <dismukes@adacore.com>

	* s-rident.ads (constant Profile_Info): Remove
	No_Calendar from GNAT_Extended_Ravenscar restrictions.

2017-01-20  Tristan Gingold  <gingold@adacore.com>

	*  s-maccod.ads: Add pragma No_Elaboration_Code_All

From-SVN: r244718
This commit is contained in:
Arnaud Charlet 2017-01-20 15:49:28 +01:00
parent 4cea867569
commit be42aa717c
14 changed files with 189 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
gcc/ada/ChangeLog
View File

@ -1,3 +1,49 @@
2017-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch9.adb: minor style fixes in comments.
* sem_ch9.adb (Analyze_Delay_Relative): in GNATprove mode a delay
relative statement introduces an implicit dependency on
Ada.Real_Time.Clock_Time.
* sem_util.adb: Minor reformatting.
2017-01-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications): Aspect Alignment
must be treated as delayed aspect even if the expression is
a literal, because the aspect affects the freezing and the
elaboration of the object to which it applies.
2017-01-20 Tristan Gingold <gingold@adacore.com>
* s-osinte-vxworks.ads (Interrup_Range): New subtype.
2017-01-20 Ed Schonberg <schonberg@adacore.com>
* lib-xref.adb (Generate_Reference): Do not warn about the
presence of a pragma Unreferenced if the entity appears as the
actual in a procedure call that does not come from source.
2017-01-20 Pascal Obry <obry@adacore.com>
* expect.c, terminals.c: Fix some warnings about unused variables.
* gsocket.h, adaint.c, adaint.h: Fix some more warnings in the C part
of the runtime.
2017-01-20 Bob Duff <duff@adacore.com>
* exp_attr.adb (Constrained): Apply an access check (check that
the prefix is not null) when the prefix denotes an object of an
access type; that is, when there is an implicit dereference.
2017-01-20 Gary Dismukes <dismukes@adacore.com>
* s-rident.ads (constant Profile_Info): Remove
No_Calendar from GNAT_Extended_Ravenscar restrictions.
2017-01-20 Tristan Gingold <gingold@adacore.com>
* s-maccod.ads: Add pragma No_Elaboration_Code_All
2017-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* ghost.adb (Mark_Ghost_Clause): New routine.

1
gcc/ada/adaint.h
View File

@ -108,6 +108,7 @@ typedef long OS_Time;
#endif
#define __int64 long long
GNAT_STRUCT_STAT;
/* A lazy cache for the attributes of a file. On some systems, a single call to
stat() will give all this information, so it is better than doing a system

87
gcc/ada/exp_attr.adb
View File

@ -2682,46 +2682,57 @@ package body Exp_Attr is
Res := True;
end if;
end if;
-- If the prefix is not a variable or is aliased, then
-- definitely true; if it's a formal parameter without an
-- associated extra formal, then treat it as constrained.
-- Ada 2005 (AI-363): An aliased prefix must be known to be
-- constrained in order to set the attribute to True.
elsif not Is_Variable (Pref)
or else Present (Formal_Ent)
or else (Ada_Version < Ada_2005
and then Is_Aliased_View (Pref))
or else (Ada_Version >= Ada_2005
and then Is_Constrained_Aliased_View (Pref))
then
Res := True;
-- Variable case, look at type to see if it is constrained.
-- Note that the one case where this is not accurate (the
-- procedure formal case), has been handled above.
-- We use the Underlying_Type here (and below) in case the
-- type is private without discriminants, but the full type
-- has discriminants. This case is illegal, but we generate it
-- internally for passing to the Extra_Constrained parameter.
else
-- In Ada 2012, test for case of a limited tagged type, in
-- which case the attribute is always required to return
-- True. The underlying type is tested, to make sure we also
-- return True for cases where there is an unconstrained
-- object with an untagged limited partial view which has
-- defaulted discriminants (such objects always produce a
-- False in earlier versions of Ada). (Ada 2012: AI05-0214)
Res := Is_Constrained (Underlying_Type (Etype (Ent)))
or else
(Ada_Version >= Ada_2012
and then Is_Tagged_Type (Underlying_Type (Ptyp))
and then Is_Limited_Type (Ptyp));
-- For access type, apply access check as needed
if Is_Access_Type (Ptyp) then
Apply_Access_Check (N);
end if;
-- If the prefix is not a variable or is aliased, then
-- definitely true; if it's a formal parameter without an
-- associated extra formal, then treat it as constrained.
-- Ada 2005 (AI-363): An aliased prefix must be known to be
-- constrained in order to set the attribute to True.
if not Is_Variable (Pref)
or else Present (Formal_Ent)
or else (Ada_Version < Ada_2005
and then Is_Aliased_View (Pref))
or else (Ada_Version >= Ada_2005
and then Is_Constrained_Aliased_View (Pref))
then
Res := True;
-- Variable case, look at type to see if it is constrained.
-- Note that the one case where this is not accurate (the
-- procedure formal case), has been handled above.
-- We use the Underlying_Type here (and below) in case the
-- type is private without discriminants, but the full type
-- has discriminants. This case is illegal, but we generate
-- it internally for passing to the Extra_Constrained
-- parameter.
else
-- In Ada 2012, test for case of a limited tagged type,
-- in which case the attribute is always required to
-- return True. The underlying type is tested, to make
-- sure we also return True for cases where there is an
-- unconstrained object with an untagged limited partial
-- view which has defaulted discriminants (such objects
-- always produce a False in earlier versions of
-- Ada). (Ada 2012: AI05-0214)
Res :=
Is_Constrained (Underlying_Type (Etype (Ent)))
or else
(Ada_Version >= Ada_2012
and then Is_Tagged_Type (Underlying_Type (Ptyp))
and then Is_Limited_Type (Ptyp));
end if;
end if;
Rewrite (N, New_Occurrence_Of (Boolean_Literals (Res), Loc));

14
gcc/ada/exp_ch9.adb
View File

@ -4524,7 +4524,7 @@ package body Exp_Ch9 is
-- If actual is an out parameter of a null-excluding
-- access type, there is access check on entry, so set
-- Suppress_Assignment_Checks on the generated statement
-- that assigns the actual to the parameter block
-- that assigns the actual to the parameter block.
Set_Suppress_Assignment_Checks (Last (Stats));
end if;
@ -6817,7 +6817,7 @@ package body Exp_Ch9 is
Insert_Before (N, Decl);
Analyze (Decl);
-- Rewrite abortable part into a call to this procedure.
-- Rewrite abortable part into a call to this procedure
Astats :=
New_List (
@ -9030,7 +9030,7 @@ package body Exp_Ch9 is
elsif Restriction_Active (No_Implicit_Heap_Allocations) then
if not Discriminated_Size (Defining_Identifier (Priv))
then
-- Any object of the type will be non-static.
-- Any object of the type will be non-static
Error_Msg_N ("component has non-static size??", Priv);
Error_Msg_NE
@ -9039,7 +9039,7 @@ package body Exp_Ch9 is
& "No_Implicit_Heap_Allocations??", Priv, Prot_Typ);
else
-- Object will be non-static if discriminants are.
-- Object will be non-static if discriminants are
Error_Msg_NE
("creation of protected object of type& with "
@ -9055,7 +9055,7 @@ package body Exp_Ch9 is
then
if not Discriminated_Size (Defining_Identifier (Priv))
then
-- Any object of the type will be non-static.
-- Any object of the type will be non-static
Error_Msg_N ("component has non-static size??", Priv);
Error_Msg_NE
@ -9064,7 +9064,7 @@ package body Exp_Ch9 is
& "No_Implicit_Protected_Object_Allocations??",
Priv, Prot_Typ);
else
-- Object will be non-static if discriminants are.
-- Object will be non-static if discriminants are
Error_Msg_NE
("creation of protected object of type& with "
@ -13769,7 +13769,7 @@ package body Exp_Ch9 is
Expression
(First (Pragma_Argument_Associations (Prio_Clause)));
-- Get_Rep_Item returns either priority pragma.
-- Get_Rep_Item returns either priority pragma
if Pragma_Name (Prio_Clause) = Name_Priority then
Prio_Type := RTE (RE_Any_Priority);

8
gcc/ada/expect.c
View File

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 2001-2015, AdaCore *
* Copyright (C) 2001-2016, AdaCore *
* *
* 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- *
@ -388,7 +388,9 @@ __gnat_expect_poll (int *fd,
int max_fd = 0;
int ready;
int i;
#ifdef __hpux__
int received;
#endif
*dead_process = 0;
@ -413,14 +415,18 @@ __gnat_expect_poll (int *fd,
if (ready > 0)
{
#ifdef __hpux__
received = 0;
#endif
for (i = 0; i < num_fd; i++)
{
if (FD_ISSET (fd[i], &rset))
{
is_set[i] = 1;
#ifdef __hpux__
received = 1;
#endif
}
else
is_set[i] = 0;

3
gcc/ada/gsocket.h
View File

@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 2004-2015, Free Software Foundation, Inc. *
* Copyright (C) 2004-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- *
@ -201,6 +201,7 @@
#include <netinet/tcp.h>
#include <sys/ioctl.h>
#include <netdb.h>
#include <unistd.h>
#endif
#ifdef __ANDROID__

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

@ -863,6 +863,14 @@ package body Lib.Xref is
elsif Is_On_LHS (N) then
null;
-- No warning if the reference is in a call that does not come
-- from source (e.g. a call to a controlled type primitive).
elsif not Comes_From_Source (Parent (N))
and then Nkind (Parent (N)) = N_Procedure_Call_Statement
then
null;
-- For entry formals, we want to place the warning message on the
-- corresponding entity in the accept statement. The current scope
-- is the body of the accept, so we find the formal whose name

3
gcc/ada/s-maccod.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -34,6 +34,7 @@
-- for full details.
package System.Machine_Code is
pragma No_Elaboration_Code_All;
pragma Pure;
-- All identifiers in this unit are implementation defined

4
gcc/ada/s-osinte-vxworks.ads
View File

@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2016, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -83,6 +83,8 @@ package System.OS_Interface is
type HW_Interrupt is new int range 0 .. Max_HW_Interrupt;
Max_Interrupt : constant := Max_HW_Interrupt;
subtype Interrupt_Range is Natural range 0 .. Max_HW_Interrupt;
-- For s-interr
-- Signals common to Vxworks 5.x and 6.x

1
gcc/ada/s-rident.ads
View File

@ -567,7 +567,6 @@ package System.Rident is
-- plus these additional restrictions:
No_Calendar => True,
No_Implicit_Task_Allocations => True,
No_Implicit_Protected_Object_Allocations
=> True,

5
gcc/ada/sem_ch13.adb
View File

@ -2044,9 +2044,12 @@ package body Sem_Ch13 is
if A_Id in Boolean_Aspects and then No (Expr) then
Delay_Required := False;
-- For non-Boolean aspects, don't delay if integer literal
-- For non-Boolean aspects, don't delay if integer literal,
-- unless the aspect is Alignment, which affects the
-- freezing of an initialized object.
elsif A_Id not in Boolean_Aspects
and then A_Id /= Aspect_Alignment
and then Present (Expr)
and then Nkind (Expr) = N_Integer_Literal
then

13
gcc/ada/sem_ch9.adb
View File

@ -1162,6 +1162,19 @@ package body Sem_Ch9 is
Check_Potentially_Blocking_Operation (N);
Analyze_And_Resolve (E, Standard_Duration);
Check_Restriction (No_Fixed_Point, E);
-- In SPARK mode the relative delay statement introduces an implicit
-- dependency on the Ada.Real_Time.Clock_Time abstract state, so we must
-- force the loading of the Ada.Real_Time package.
if GNATprove_Mode then
declare
Unused : Entity_Id;
begin
Unused := RTE (RO_RT_Time);
end;
end if;
end Analyze_Delay_Relative;
-------------------------

76
gcc/ada/sem_util.adb
View File

@ -16151,9 +16151,9 @@ package body Sem_Util is
-- NCT_Assoc --
---------------
-- The hash table NCT_Assoc associates old entities in the table
-- with their corresponding new entities (i.e. the pairs of entries
-- presented in the original Map argument are Key-Element pairs).
-- The hash table NCT_Assoc associates old entities in the table with their
-- corresponding new entities (i.e. the pairs of entries presented in the
-- original Map argument are Key-Element pairs).
package NCT_Assoc is new Simple_HTable (
Header_Num => NCT_Header_Num,
@ -16167,10 +16167,10 @@ package body Sem_Util is
-- NCT_Itype_Assoc --
---------------------
-- The hash table NCT_Itype_Assoc contains entries only for those
-- old nodes which have a non-empty Associated_Node_For_Itype set.
-- The key is the associated node, and the element is the new node
-- itself (NOT the associated node for the new node).
-- The hash table NCT_Itype_Assoc contains entries only for those old
-- nodes which have a non-empty Associated_Node_For_Itype set. The key
-- is the associated node, and the element is the new node itself (NOT
-- the associated node for the new node).
package NCT_Itype_Assoc is new Simple_HTable (
Header_Num => NCT_Header_Num,
@ -16227,9 +16227,9 @@ package body Sem_Util is
-- Called during first phase to visit all elements of an Elist
procedure Visit_Field (F : Union_Id; N : Node_Id);
-- Visit a single field, recursing to call Visit_Node or Visit_List
-- if the field is a syntactic descendant of the current node (i.e.
-- its parent is Node N).
-- Visit a single field, recursing to call Visit_Node or Visit_List if
-- the field is a syntactic descendant of the current node (i.e. its
-- parent is Node N).
procedure Visit_Itype (Old_Itype : Entity_Id);
-- Called during first phase to visit subsidiary fields of a defining
@ -16286,6 +16286,7 @@ package body Sem_Util is
procedure Build_NCT_Hash_Tables is
Elmt : Elmt_Id;
Ent : Entity_Id;
begin
if NCT_Hash_Table_Setup then
NCT_Assoc.Reset;
@ -16309,9 +16310,9 @@ package body Sem_Util is
begin
if Present (Anode) then
-- Enter a link between the associated node of the
-- old Itype and the new Itype, for updating later
-- when node is copied.
-- Enter a link between the associated node of the old
-- Itype and the new Itype, for updating later when node
-- is copied.
NCT_Itype_Assoc.Set (Anode, Node (Elmt));
end if;
@ -16470,19 +16471,18 @@ package body Sem_Util is
if Nkind (Old_E) = N_Parameter_Association
and then Present (Next_Named_Actual (Old_E))
then
if First_Named_Actual (Old_Node)
= Explicit_Actual_Parameter (Old_E)
if First_Named_Actual (Old_Node) =
Explicit_Actual_Parameter (Old_E)
then
Set_First_Named_Actual
(New_Node, Explicit_Actual_Parameter (New_E));
end if;
-- Now scan parameter list from the beginning,to locate
-- Now scan parameter list from the beginning, to locate
-- next named actual, which can be out of order.
Old_Next := First (Parameter_Associations (Old_Node));
New_Next := First (Parameter_Associations (New_Node));
while Nkind (Old_Next) /= N_Parameter_Association
or else Explicit_Actual_Parameter (Old_Next) /=
Next_Named_Actual (Old_E)
@ -16728,8 +16728,8 @@ package body Sem_Util is
-- Note: the exclusion of self-referential copies is just an
-- optimization, since the search of the already copied list
-- would catch it, but it is a common case (Etype pointing
-- to itself for an Itype that is a base type).
-- would catch it, but it is a common case (Etype pointing to
-- itself for an Itype that is a base type).
elsif Has_Extension (Node_Id (F))
and then Is_Itype (Entity_Id (F))
@ -16785,8 +16785,8 @@ package body Sem_Util is
New_Itype := New_Copy (Old_Itype);
-- The new Itype has all the attributes of the old one, and
-- we just copy the contents of the entity. However, the back-end
-- The new Itype has all the attributes of the old one, and we
-- just copy the contents of the entity. However, the back-end
-- needs different names for debugging purposes, so we create a
-- new internal name for it in all cases.
@ -16803,7 +16803,6 @@ package body Sem_Util is
-- Case of hash tables used
if NCT_Hash_Tables_Used then
Ent := NCT_Assoc.Get (Associated_Node_For_Itype (Old_Itype));
if Present (Ent) then
@ -16811,11 +16810,12 @@ package body Sem_Util is
end if;
Ent := NCT_Itype_Assoc.Get (Old_Itype);
if Present (Ent) then
Set_Associated_Node_For_Itype (Ent, New_Itype);
-- If the hash table has no association for this Itype and
-- its associated node, enter one now.
-- If the hash table has no association for this Itype and its
-- associated node, enter one now.
else
NCT_Itype_Assoc.Set
@ -16872,7 +16872,7 @@ package body Sem_Util is
-- If a record subtype is simply copied, the entity list will be
-- shared. Thus cloned_Subtype must be set to indicate the sharing.
if Ekind_In (Old_Itype, E_Record_Subtype, E_Class_Wide_Subtype) then
if Ekind_In (Old_Itype, E_Class_Wide_Subtype, E_Record_Subtype) then
Set_Cloned_Subtype (New_Itype, Old_Itype);
end if;
@ -16889,14 +16889,14 @@ package body Sem_Util is
elsif Is_Array_Type (Old_Itype) then
if Present (First_Index (Old_Itype)) then
Visit_Field (Union_Id (List_Containing
(First_Index (Old_Itype))),
Old_Itype);
Visit_Field
(Union_Id (List_Containing (First_Index (Old_Itype))),
Old_Itype);
end if;
if Is_Packed (Old_Itype) then
Visit_Field (Union_Id (Packed_Array_Impl_Type (Old_Itype)),
Old_Itype);
Visit_Field
(Union_Id (Packed_Array_Impl_Type (Old_Itype)), Old_Itype);
end if;
end if;
end Visit_Itype;
@ -16923,17 +16923,14 @@ package body Sem_Util is
----------------
procedure Visit_Node (N : Node_Or_Entity_Id) is
-- Start of processing for Visit_Node
begin
-- Handle case of an Itype, which must be copied
if Has_Extension (N) and then Is_Itype (N) then
-- Nothing to do if already in the list. This can happen with an
-- Itype entity that appears more than once in the tree.
-- Note that we do not want to visit descendants in this case.
-- Itype entity that appears more than once in the tree. Note that
-- we do not want to visit descendants in this case.
-- Test for already in list when hash table is used
@ -17005,13 +17002,13 @@ package body Sem_Util is
end;
end if;
-- Hash table set up if required, now start phase one by visiting
-- top node (we will recursively visit the descendants).
-- Hash table set up if required, now start phase one by visiting top
-- node (we will recursively visit the descendants).
Visit_Node (Source);
-- Now the second phase of the copy can start. First we process
-- all the mapped entities, copying their descendants.
-- Now the second phase of the copy can start. First we process all the
-- mapped entities, copying their descendants.
if Present (Actual_Map) then
declare
@ -17026,6 +17023,7 @@ package body Sem_Util is
if Is_Itype (New_Itype) then
Copy_Itype_With_Replacement (New_Itype);
end if;
Next_Elmt (Elmt);
end loop;
end;

17
gcc/ada/terminals.c
View File

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 2008-2015, AdaCore *
* Copyright (C) 2008-2016, AdaCore *
* *
* 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- *
@ -1410,7 +1410,8 @@ __gnat_setup_child_communication
#ifdef TIOCSCTTY
/* make the tty the controlling terminal */
status = ioctl (desc->slave_fd, TIOCSCTTY, 0);
if ((status = ioctl (desc->slave_fd, TIOCSCTTY, 0)) == -1)
return -1;
#endif
/* adjust tty settings */
@ -1424,8 +1425,10 @@ __gnat_setup_child_communication
if (desc->slave_fd > 2) close (desc->slave_fd);
/* adjust process group settings */
status = setpgid (pid, pid);
status = tcsetpgrp (0, pid);
if ((status = setpgid (pid, pid)) == -1)
return -1;
if ((status = tcsetpgrp (0, pid)) == -1)
return -1;
/* launch the program */
execvp (new_argv[0], new_argv);
@ -1562,9 +1565,9 @@ pty_desc *
__gnat_new_tty (void)
{
int status;
pty_desc* desc;
status = allocate_pty_desc (&desc);
child_setup_tty (desc->master_fd);
pty_desc* desc = NULL;
if ((status = allocate_pty_desc (&desc)))
child_setup_tty (desc->master_fd);
return desc;
}