Commit 4b8ae2b0 by Arnaud Charlet

[multiple changes]

2015-10-16  Gary Dismukes  <dismukes@adacore.com>

	* prj.adb, sem_util.adb, exp_ch6.adb: Minor reformatting.

2015-10-16  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_Formal_Container_Element_Loop): Modify
	expansion to allow element iteration over formal containers
	whose elements are indefinite types.

2015-10-16  Doug Rupp  <rupp@adacore.com>

	* s-taprop-linux.adb (Monotonic_Clock): Call clock_gettime
	instead of gettimeofday.
	* s-osinte-linux.ads (clock_gettime): New imported subprogram.

From-SVN: r228901
parent 79b5eeb0
2015-10-16 Gary Dismukes <dismukes@adacore.com>
* prj.adb, sem_util.adb, exp_ch6.adb: Minor reformatting.
2015-10-16 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_Formal_Container_Element_Loop): Modify
expansion to allow element iteration over formal containers
whose elements are indefinite types.
2015-10-16 Doug Rupp <rupp@adacore.com>
* s-taprop-linux.adb (Monotonic_Clock): Call clock_gettime
instead of gettimeofday.
* s-osinte-linux.ads (clock_gettime): New imported subprogram.
2015-10-16 Hristian Kirtchev <kirtchev@adacore.com> 2015-10-16 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
......
...@@ -2899,8 +2899,23 @@ package body Exp_Ch5 is ...@@ -2899,8 +2899,23 @@ package body Exp_Ch5 is
-- Cursor := Next (Container, Cursor); -- Cursor := Next (Container, Cursor);
-- end loop; -- end loop;
-- However this expansion is not legal if the element is indefinite.
-- In that case we create a block to hold a variable declaration
-- initialized with a call to Element, and generate:
-- Cursor : Cursor_type := First (Container);
-- while Has_Element (Cursor, Container) loop
-- declare
-- Elmt : Element-Type := Element (Container, Cursor);
-- begin
-- <original loop statements>
-- Cursor := Next (Container, Cursor);
-- end;
-- end loop;
Build_Formal_Container_Iteration Build_Formal_Container_Iteration
(N, Container, Cursor, Init, Advance, New_Loop); (N, Container, Cursor, Init, Advance, New_Loop);
Append_To (Stats, Advance);
Set_Ekind (Cursor, E_Variable); Set_Ekind (Cursor, E_Variable);
Insert_Action (N, Init); Insert_Action (N, Init);
...@@ -2912,33 +2927,50 @@ package body Exp_Ch5 is ...@@ -2912,33 +2927,50 @@ package body Exp_Ch5 is
Defining_Identifier => Element, Defining_Identifier => Element,
Object_Definition => New_Occurrence_Of (Etype (Element_Op), Loc)); Object_Definition => New_Occurrence_Of (Etype (Element_Op), Loc));
-- The element is only modified in expanded code, so it appears as if not Is_Constrained (Etype (Element_Op)) then
-- unassigned to the warning machinery. We must suppress this spurious Set_Expression (Elmt_Decl,
-- warning explicitly. Make_Function_Call (Loc,
Name => New_Occurrence_Of (Element_Op, Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Container, Loc),
New_Occurrence_Of (Cursor, Loc))));
Set_Statements (New_Loop,
New_List
(Make_Block_Statement (Loc,
Declarations => New_List (Elmt_Decl),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Stats))));
Set_Warnings_Off (Element); else
Elmt_Ref :=
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Element, Loc),
Expression =>
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Element_Op, Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Container, Loc),
New_Occurrence_Of (Cursor, Loc))));
Elmt_Ref := Prepend (Elmt_Ref, Stats);
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Element, Loc),
Expression =>
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Element_Op, Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Container, Loc),
New_Occurrence_Of (Cursor, Loc))));
Prepend (Elmt_Ref, Stats); -- The loop is rewritten as a block, to hold the element declaration
Append_To (Stats, Advance);
-- The loop is rewritten as a block, to hold the element declaration New_Loop :=
Make_Block_Statement (Loc,
Declarations => New_List (Elmt_Decl),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (New_Loop)));
end if;
New_Loop := -- The element is only modified in expanded code, so it appears as
Make_Block_Statement (Loc, -- unassigned to the warning machinery. We must suppress this spurious
Declarations => New_List (Elmt_Decl), -- warning explicitly.
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Set_Warnings_Off (Element);
Statements => New_List (New_Loop)));
Rewrite (N, New_Loop); Rewrite (N, New_Loop);
......
...@@ -8979,8 +8979,8 @@ package body Exp_Ch6 is ...@@ -8979,8 +8979,8 @@ package body Exp_Ch6 is
Add_Unconstrained_Actuals_To_Build_In_Place_Call Add_Unconstrained_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id, Alloc_Form => Caller_Allocation); (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
-- The allocation for indefinite library level objects occurs on the -- The allocation for indefinite library-level objects occurs on the
-- heap as opposed to the secondary stack. This accomodates DLLs where -- heap as opposed to the secondary stack. This accommodates DLLs where
-- the secondary stack is destroyed after each library unload. This is -- the secondary stack is destroyed after each library unload. This is
-- a hybrid mechanism where a stack-allocated object lives on the heap. -- a hybrid mechanism where a stack-allocated object lives on the heap.
...@@ -8993,7 +8993,7 @@ package body Exp_Ch6 is ...@@ -8993,7 +8993,7 @@ package body Exp_Ch6 is
-- Create a finalization master for the access result type to ensure -- Create a finalization master for the access result type to ensure
-- that the heap allocation can properly chain the object and later -- that the heap allocation can properly chain the object and later
-- finalize it when the library unit does out of scope. -- finalize it when the library unit goes out of scope.
if Needs_Finalization (Etype (Func_Call)) then if Needs_Finalization (Etype (Func_Call)) then
Build_Finalization_Master Build_Finalization_Master
......
...@@ -599,7 +599,7 @@ package body Prj is ...@@ -599,7 +599,7 @@ package body Prj is
-- This set is needed to ensure that we do not handle the same -- This set is needed to ensure that we do not handle the same
-- project twice in the context of aggregate libraries. -- project twice in the context of aggregate libraries.
-- Since duplicate project names are possible in the context of -- Since duplicate project names are possible in the context of
-- aggregated projects, we need to check the full paths -- aggregated projects, we need to check the full paths.
procedure Recursive_Check procedure Recursive_Check
(Project : Project_Id; (Project : Project_Id;
......
...@@ -224,6 +224,10 @@ package System.OS_Interface is ...@@ -224,6 +224,10 @@ package System.OS_Interface is
subtype timeval is System.Linux.timeval; subtype timeval is System.Linux.timeval;
subtype clockid_t is System.Linux.clockid_t; subtype clockid_t is System.Linux.clockid_t;
function clock_gettime
(clock_id : clockid_t; tp : access timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres function clock_getres
(clock_id : clockid_t; (clock_id : clockid_t;
res : access timespec) return int; res : access timespec) return int;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- -- -- --
-- GNARL is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -39,7 +39,6 @@ pragma Polling (Off); ...@@ -39,7 +39,6 @@ pragma Polling (Off);
-- operations. It causes infinite loops and other problems. -- operations. It causes infinite loops and other problems.
with Interfaces.C; with Interfaces.C;
with Interfaces.C.Extensions;
with System.Task_Info; with System.Task_Info;
with System.Tasking.Debug; with System.Tasking.Debug;
...@@ -64,7 +63,6 @@ package body System.Task_Primitives.Operations is ...@@ -64,7 +63,6 @@ package body System.Task_Primitives.Operations is
use System.Tasking.Debug; use System.Tasking.Debug;
use System.Tasking; use System.Tasking;
use Interfaces.C; use Interfaces.C;
use Interfaces.C.Extensions;
use System.OS_Interface; use System.OS_Interface;
use System.Parameters; use System.Parameters;
use System.OS_Primitives; use System.OS_Primitives;
...@@ -629,30 +627,14 @@ package body System.Task_Primitives.Operations is ...@@ -629,30 +627,14 @@ package body System.Task_Primitives.Operations is
--------------------- ---------------------
function Monotonic_Clock return Duration is function Monotonic_Clock return Duration is
use Interfaces; TS : aliased timespec;
procedure timeval_to_duration
(T : not null access timeval;
sec : not null access C.Extensions.long_long;
usec : not null access C.long);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6;
sec : aliased C.Extensions.long_long;
usec : aliased C.long;
TV : aliased timeval;
Result : int; Result : int;
function gettimeofday
(Tv : access timeval;
Tz : System.Address := System.Null_Address) return int;
pragma Import (C, gettimeofday, "gettimeofday");
begin begin
Result := gettimeofday (TV'Access, System.Null_Address); Result := clock_gettime
(clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
timeval_to_duration (TV'Access, sec'Access, usec'Access);
return Duration (sec) + Duration (usec) / Micro; return To_Duration (TS);
end Monotonic_Clock; end Monotonic_Clock;
------------------- -------------------
......
...@@ -11504,7 +11504,7 @@ package body Sem_Util is ...@@ -11504,7 +11504,7 @@ package body Sem_Util is
then then
return Is_EVF_Expression (Expression (N)); return Is_EVF_Expression (Expression (N));
-- Attributes 'Loop_Entry, 'Old and 'Update are an EVF expression when -- Attributes 'Loop_Entry, 'Old, and 'Update are EVF expressions when
-- their prefix denotes an EVF expression. -- their prefix denotes an EVF expression.
elsif Nkind (N) = N_Attribute_Reference elsif Nkind (N) = N_Attribute_Reference
...@@ -14214,8 +14214,8 @@ package body Sem_Util is ...@@ -14214,8 +14214,8 @@ package body Sem_Util is
-- Start of processing Mark_Coextensions -- Start of processing Mark_Coextensions
begin begin
-- An allocator that appears on the right hand side of an assignment is -- An allocator that appears on the right-hand side of an assignment is
-- treated as a potentially dynamic coextension when the right hand side -- treated as a potentially dynamic coextension when the right-hand side
-- is an allocator or a qualified expression. -- is an allocator or a qualified expression.
-- Obj := new ...'(new Coextension ...); -- Obj := new ...'(new Coextension ...);
...@@ -14227,7 +14227,7 @@ package body Sem_Util is ...@@ -14227,7 +14227,7 @@ package body Sem_Util is
-- An allocator that appears within the expression of a simple return -- An allocator that appears within the expression of a simple return
-- statement is treated as a potentially dynamic coextension when the -- statement is treated as a potentially dynamic coextension when the
-- expression is either aggregate, allocator or qualified expression. -- expression is either aggregate, allocator, or qualified expression.
-- return (new Coextension ...); -- return (new Coextension ...);
-- return new ...'(new Coextension ...); -- return new ...'(new Coextension ...);
...@@ -14257,8 +14257,8 @@ package body Sem_Util is ...@@ -14257,8 +14257,8 @@ package body Sem_Util is
or else or else
Nkind (Parent (Context_Nod)) = N_Extended_Return_Statement; Nkind (Parent (Context_Nod)) = N_Extended_Return_Statement;
-- This routine should not be called with constructs which may not -- This routine should not be called with constructs that cannot contain
-- contain coextensions. -- coextensions.
else else
raise Program_Error; raise Program_Error;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment