+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.
#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
Res := True;
end if;
end if;
+ else
- -- 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.
+ -- For access type, apply access check as needed
- -- Ada 2005 (AI-363): An aliased prefix must be known to be
- -- constrained in order to set the attribute to True.
+ if Is_Access_Type (Ptyp) then
+ Apply_Access_Check (N);
+ end if;
- 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;
+ -- 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.
- -- 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.
+ -- Ada 2005 (AI-363): An aliased prefix must be known to be
+ -- constrained in order to set the attribute to True.
- -- 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.
+ 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;
- 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));
+ -- 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));
-- 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;
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 (
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
& "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 "
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
& "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 "
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);
* *
* 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- *
int max_fd = 0;
int ready;
int i;
+#ifdef __hpux__
int received;
+#endif
*dead_process = 0;
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;
* *
* 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- *
#include <netinet/tcp.h>
#include <sys/ioctl.h>
#include <netdb.h>
+#include <unistd.h>
#endif
#ifdef __ANDROID__
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
-- --
-- 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- --
-- for full details.
package System.Machine_Code is
+ pragma No_Elaboration_Code_All;
pragma Pure;
-- All identifiers in this unit are implementation defined
-- 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- --
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
-- plus these additional restrictions:
- No_Calendar => True,
No_Implicit_Task_Allocations => True,
No_Implicit_Protected_Object_Allocations
=> True,
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
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;
-------------------------
-- 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,
-- 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,
-- 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
procedure Build_NCT_Hash_Tables is
Elmt : Elmt_Id;
Ent : Entity_Id;
+
begin
if NCT_Hash_Table_Setup then
NCT_Assoc.Reset;
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;
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)
-- 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))
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.
-- 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
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
-- 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;
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;
----------------
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
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
if Is_Itype (New_Itype) then
Copy_Itype_With_Replacement (New_Itype);
end if;
+
Next_Elmt (Elmt);
end loop;
end;
* *
* 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- *
#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 */
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);
__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;
}
projects / gcc.git / commitdiff