Skip to content

R
riscv-gcc-1
Commit c840bf9b by Pierre-Marie de Rodat
Options

s-osinte__linux.ads (Relative_Timed_Wait): Add variable needed for using monotonic clock. 

gcc/ada/

2017-10-20  Doug Rupp  <rupp@adacore.com>

	* libgnarl/s-osinte__linux.ads (Relative_Timed_Wait): Add variable
	needed for using monotonic clock.
	* libgnarl/s-taprop__linux.adb: Revert previous monotonic clock
	changes.
	* libgnarl/s-taprop__linux.adb, s-taprop__posix.adb: Unify and factor
	out monotonic clock related functions body.
	(Timed_Sleep, Timed_Delay, Montonic_Clock, RT_Resolution,
	Compute_Deadline): Move to...
	* libgnarl/s-tpopmo.adb: ... here. New separate package body.

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

	* sem_util.adb (Is_Controlling_Limited_Procedure): Handle properly the
	case where the controlling formal is an anonymous access to interface
	type.
	* exp_ch9.adb (Extract_Dispatching_Call): If controlling actual is an
	access type, handle properly the the constructed dereference that
	designates the object used in the rewritten synchronized call.
	(Parameter_Block_Pack): If the type of the actual is by-copy, its
	generated declaration in the parameter block does not need an
	initialization even if the type is a null-excluding access type,
	because it will be initialized with the value of the actual later on.
	(Parameter_Block_Pack): Do not add controlling actual to parameter
	block when its type is by-copy.

2017-10-20  Justin Squirek  <squirek@adacore.com>

	* sem_ch8.adb (Update_Use_Clause_Chain): Add sanity check to verify
	scope stack traversal into the context clause.

gcc/testsuite/

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

	* gnat.dg/sync_iface_call.adb, gnat.dg/sync_iface_call_pkg.ads,
	gnat.dg/sync_iface_call_pkg2.adb, gnat.dg/sync_iface_call_pkg2.ads:
	New testcase.

From-SVN: r253948
parent 8ce62196
Showing with 515 additions and 454 deletions
gcc/ada/ChangeLog
2017-10-20 Doug Rupp <rupp@adacore.com>
* libgnarl/s-osinte__linux.ads (Relative_Timed_Wait): Add variable
needed for using monotonic clock.
* libgnarl/s-taprop__linux.adb: Revert previous monotonic clock
changes.
* libgnarl/s-taprop__linux.adb, s-taprop__posix.adb: Unify and factor
out monotonic clock related functions body.
(Timed_Sleep, Timed_Delay, Montonic_Clock, RT_Resolution,
Compute_Deadline): Move to...
* libgnarl/s-tpopmo.adb: ... here. New separate package body.
2017-10-20 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Is_Controlling_Limited_Procedure): Handle properly the
case where the controlling formal is an anonymous access to interface
type.
* exp_ch9.adb (Extract_Dispatching_Call): If controlling actual is an
access type, handle properly the the constructed dereference that
designates the object used in the rewritten synchronized call.
(Parameter_Block_Pack): If the type of the actual is by-copy, its
generated declaration in the parameter block does not need an
initialization even if the type is a null-excluding access type,
because it will be initialized with the value of the actual later on.
(Parameter_Block_Pack): Do not add controlling actual to parameter
block when its type is by-copy.
2017-10-20 Justin Squirek <squirek@adacore.com>
* sem_ch8.adb (Update_Use_Clause_Chain): Add sanity check to verify
scope stack traversal into the context clause.
2017-10-20 Bob Duff <duff@adacore.com>
* sinfo.ads: Fix a comment typo.
......
gcc/ada/exp_ch9.adb
......@@ -12909,11 +12909,14 @@ package body Exp_Ch9 is
end if;
-- If the type of the dispatching object is an access type then return
-- an explicit dereference.
-- an explicit dereference of a copy of the object, and note that
-- this is the controlling actual of the call.
if Is_Access_Type (Etype (Object)) then
Object := Make_Explicit_Dereference (Sloc (N), Object);
Object :=
Make_Explicit_Dereference (Sloc (N), New_Copy_Tree (Object));
Analyze (Object);
Set_Is_Controlling_Actual (Object);
end if;
end Extract_Dispatching_Call;
......@@ -14561,6 +14564,12 @@ package body Exp_Ch9 is
Object_Definition =>
New_Occurrence_Of (Etype (Formal), Loc)));
-- The object is initialized with an explicit assignment
-- later. Indicate that it does not need an initialization
-- to prevent spurious warnings if the type excludes null.
Set_No_Initialization (Last (Decls));
if Ekind (Formal) /= E_Out_Parameter then
-- Generate:
......@@ -14577,15 +14586,22 @@ package body Exp_Ch9 is
Expression => New_Copy_Tree (Actual)));
end if;
-- Generate:
-- If the actual is not controlling, generate:
-- Jnn'unchecked_access
Append_To (Params,
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Unchecked_Access,
Prefix => New_Occurrence_Of (Temp_Nam, Loc)));
-- and add it to aggegate for access to formals. Note that
-- the actual may be by-copy but still be a controlling actual
-- if it is an access to class-wide interface.
Has_Param := True;
if not Is_Controlling_Actual (Actual) then
Append_To (Params,
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Unchecked_Access,
Prefix => New_Occurrence_Of (Temp_Nam, Loc)));
Has_Param := True;
end if;
-- The controlling parameter is omitted
......
gcc/ada/libgnarl/s-osinte__linux.ads
......@@ -448,6 +448,9 @@ package System.OS_Interface is
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
Relative_Timed_Wait : constant Boolean := False;
-- pthread_cond_timedwait requires an absolute delay time
--------------------------
-- POSIX.1c Section 13 --
--------------------------
......
gcc/ada/libgnarl/s-taprop__posix.adb
......@@ -145,6 +145,38 @@ package body System.Task_Primitives.Operations is
package body Specific is separate;
-- The body of this package is target specific
package Monotonic is
function Monotonic_Clock return Duration;
pragma Inline (Monotonic_Clock);
-- Returns "absolute" time, represented as an offset relative to "the
-- Epoch", which is Jan 1, 1970. This clock implementation is immune to
-- the system's clock changes.
function RT_Resolution return Duration;
pragma Inline (RT_Resolution);
-- Returns resolution of the underlying clock used to implement RT_Clock
procedure Timed_Sleep
(Self_ID : ST.Task_Id;
Time : Duration;
Mode : ST.Delay_Modes;
Reason : System.Tasking.Task_States;
Timedout : out Boolean;
Yielded : out Boolean);
-- Combination of Sleep (above) and Timed_Delay
procedure Timed_Delay
(Self_ID : ST.Task_Id;
Time : Duration;
Mode : ST.Delay_Modes);
-- Implement the semantics of the delay statement.
-- The caller should be abort-deferred and should not hold any locks.
end Monotonic;
package body Monotonic is separate;
----------------------------------
-- ATCB allocation/deallocation --
----------------------------------
......@@ -183,18 +215,6 @@ package body System.Task_Primitives.Operations is
pragma Import (C,
GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup");
procedure Compute_Deadline
(Time : Duration;
Mode : ST.Delay_Modes;
Check_Time : out Duration;
Abs_Time : out Duration;
Rel_Time : out Duration);
-- Helper for Timed_Sleep and Timed_Delay: given a deadline specified by
-- Time and Mode, compute the current clock reading (Check_Time), and the
-- target absolute and relative clock readings (Abs_Time, Rel_Time). The
-- epoch for Time depends on Mode; the epoch for Check_Time and Abs_Time
-- is always that of CLOCK_RT_Ada.
-------------------
-- Abort_Handler --
-------------------
......@@ -253,67 +273,6 @@ package body System.Task_Primitives.Operations is
end if;
end Abort_Handler;
----------------------
-- Compute_Deadline --
----------------------
procedure Compute_Deadline
(Time : Duration;
Mode : ST.Delay_Modes;
Check_Time : out Duration;
Abs_Time : out Duration;
Rel_Time : out Duration)
is
begin
Check_Time := Monotonic_Clock;
-- Relative deadline
if Mode = Relative then
Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
if Relative_Timed_Wait then
Rel_Time := Duration'Min (Max_Sensible_Delay, Time);
end if;
pragma Warnings (Off);
-- Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile
-- time known.
-- Absolute deadline specified using the tasking clock (CLOCK_RT_Ada)
elsif Mode = Absolute_RT
or else OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME
then
pragma Warnings (On);
Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
if Relative_Timed_Wait then
Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time);
end if;
-- Absolute deadline specified using the calendar clock, in the
-- case where it is not the same as the tasking clock: compensate for
-- difference between clock epochs (Base_Time - Base_Cal_Time).
else
declare
Cal_Check_Time : constant Duration := OS_Primitives.Clock;
RT_Time : constant Duration :=
Time + Check_Time - Cal_Check_Time;
begin
Abs_Time :=
Duration'Min (Check_Time + Max_Sensible_Delay, RT_Time);
if Relative_Timed_Wait then
Rel_Time :=
Duration'Min (Max_Sensible_Delay, RT_Time - Check_Time);
end if;
end;
end if;
end Compute_Deadline;
-----------------
-- Stack_Guard --
-----------------
......@@ -600,60 +559,7 @@ package body System.Task_Primitives.Operations is
Mode : ST.Delay_Modes;
Reason : Task_States;
Timedout : out Boolean;
Yielded : out Boolean)
is
pragma Unreferenced (Reason);
Base_Time : Duration;
Check_Time : Duration;
Abs_Time : Duration;
Rel_Time : Duration;
Request : aliased timespec;
Result : Interfaces.C.int;
begin
Timedout := True;
Yielded := False;
Compute_Deadline
(Time => Time,
Mode => Mode,
Check_Time => Check_Time,
Abs_Time => Abs_Time,
Rel_Time => Rel_Time);
Base_Time := Check_Time;
if Abs_Time > Check_Time then
Request :=
To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
if Result = 0 or Result = EINTR then
-- Somebody may have called Wakeup for us
Timedout := False;
exit;
end if;
pragma Assert (Result = ETIMEDOUT);
end loop;
end if;
end Timed_Sleep;
Yielded : out Boolean) renames Monotonic.Timed_Sleep;
-----------------
-- Timed_Delay --
......@@ -665,95 +571,19 @@ package body System.Task_Primitives.Operations is
procedure Timed_Delay
(Self_ID : Task_Id;
Time : Duration;
Mode : ST.Delay_Modes)
is
Base_Time : Duration;
Check_Time : Duration;
Abs_Time : Duration;
Rel_Time : Duration;
Request : aliased timespec;
Result : Interfaces.C.int;
pragma Warnings (Off, Result);
begin
if Single_Lock then
Lock_RTS;
end if;
Write_Lock (Self_ID);
Compute_Deadline
(Time => Time,
Mode => Mode,
Check_Time => Check_Time,
Abs_Time => Abs_Time,
Rel_Time => Rel_Time);
Base_Time := Check_Time;
if Abs_Time > Check_Time then
Request :=
To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
Self_ID.Common.State := Delay_Sleep;
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
pragma Assert (Result = 0
or else Result = ETIMEDOUT
or else Result = EINTR);
end loop;
Self_ID.Common.State := Runnable;
end if;
Unlock (Self_ID);
if Single_Lock then
Unlock_RTS;
end if;
Result := sched_yield;
end Timed_Delay;
Mode : ST.Delay_Modes) renames Monotonic.Timed_Delay;
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration is
TS : aliased timespec;
Result : Interfaces.C.int;
begin
Result := clock_gettime
(clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access);
pragma Assert (Result = 0);
return To_Duration (TS);
end Monotonic_Clock;
function Monotonic_Clock return Duration renames Monotonic.Monotonic_Clock;
-------------------
-- RT_Resolution --
-------------------
function RT_Resolution return Duration is
TS : aliased timespec;
Result : Interfaces.C.int;
begin
Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
pragma Assert (Result = 0);
return To_Duration (TS);
end RT_Resolution;
function RT_Resolution return Duration renames Monotonic.RT_Resolution;
------------
-- Wakeup --
......
gcc/ada/libgnarl/s-tpopmo.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- SYSTEM.TASK_PRIMITIVES.OPERATIONS.MONOTONIC --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2017, 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- This is the Monotonic version of this package for Posix and Linux targets.
separate (System.Task_Primitives.Operations)
package body Monotonic is
-----------------------
-- Local Subprograms --
-----------------------
procedure Compute_Deadline
(Time : Duration;
Mode : ST.Delay_Modes;
Check_Time : out Duration;
Abs_Time : out Duration;
Rel_Time : out Duration);
-- Helper for Timed_Sleep and Timed_Delay: given a deadline specified by
-- Time and Mode, compute the current clock reading (Check_Time), and the
-- target absolute and relative clock readings (Abs_Time, Rel_Time). The
-- epoch for Time depends on Mode; the epoch for Check_Time and Abs_Time
-- is always that of CLOCK_RT_Ada.
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration is
TS : aliased timespec;
Result : Interfaces.C.int;
begin
Result := clock_gettime
(clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access);
pragma Assert (Result = 0);
return To_Duration (TS);
end Monotonic_Clock;
-------------------
-- RT_Resolution --
-------------------
function RT_Resolution return Duration is
TS : aliased timespec;
Result : Interfaces.C.int;
begin
Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
pragma Assert (Result = 0);
return To_Duration (TS);
end RT_Resolution;
----------------------
-- Compute_Deadline --
----------------------
procedure Compute_Deadline
(Time : Duration;
Mode : ST.Delay_Modes;
Check_Time : out Duration;
Abs_Time : out Duration;
Rel_Time : out Duration)
is
begin
Check_Time := Monotonic_Clock;
-- Relative deadline
if Mode = Relative then
Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
if Relative_Timed_Wait then
Rel_Time := Duration'Min (Max_Sensible_Delay, Time);
end if;
pragma Warnings (Off);
-- Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile
-- time known.
-- Absolute deadline specified using the tasking clock (CLOCK_RT_Ada)
elsif Mode = Absolute_RT
or else OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME
then
pragma Warnings (On);
Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
if Relative_Timed_Wait then
Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time);
end if;
-- Absolute deadline specified using the calendar clock, in the
-- case where it is not the same as the tasking clock: compensate for
-- difference between clock epochs (Base_Time - Base_Cal_Time).
else
declare
Cal_Check_Time : constant Duration := OS_Primitives.Clock;
RT_Time : constant Duration :=
Time + Check_Time - Cal_Check_Time;
begin
Abs_Time :=
Duration'Min (Check_Time + Max_Sensible_Delay, RT_Time);
if Relative_Timed_Wait then
Rel_Time :=
Duration'Min (Max_Sensible_Delay, RT_Time - Check_Time);
end if;
end;
end if;
end Compute_Deadline;
-----------------
-- Timed_Sleep --
-----------------
-- This is for use within the run-time system, so abort is
-- assumed to be already deferred, and the caller should be
-- holding its own ATCB lock.
procedure Timed_Sleep
(Self_ID : ST.Task_Id;
Time : Duration;
Mode : ST.Delay_Modes;
Reason : System.Tasking.Task_States;
Timedout : out Boolean;
Yielded : out Boolean)
is
pragma Unreferenced (Reason);
Base_Time : Duration;
Check_Time : Duration;
Abs_Time : Duration;
Rel_Time : Duration;
Request : aliased timespec;
Result : Interfaces.C.int;
begin
Timedout := True;
Yielded := False;
Compute_Deadline
(Time => Time,
Mode => Mode,
Check_Time => Check_Time,
Abs_Time => Abs_Time,
Rel_Time => Rel_Time);
Base_Time := Check_Time;
if Abs_Time > Check_Time then
Request :=
To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
if Result in 0 | EINTR then
-- Somebody may have called Wakeup for us
Timedout := False;
exit;
end if;
pragma Assert (Result = ETIMEDOUT);
end loop;
end if;
end Timed_Sleep;
-----------------
-- Timed_Delay --
-----------------
-- This is for use in implementing delay statements, so we assume the
-- caller is abort-deferred but is holding no locks.
procedure Timed_Delay
(Self_ID : ST.Task_Id;
Time : Duration;
Mode : ST.Delay_Modes)
is
Base_Time : Duration;
Check_Time : Duration;
Abs_Time : Duration;
Rel_Time : Duration;
Request : aliased timespec;
Result : Interfaces.C.int;
pragma Warnings (Off, Result);
begin
if Single_Lock then
Lock_RTS;
end if;
Write_Lock (Self_ID);
Compute_Deadline
(Time => Time,
Mode => Mode,
Check_Time => Check_Time,
Abs_Time => Abs_Time,
Rel_Time => Rel_Time);
Base_Time := Check_Time;
if Abs_Time > Check_Time then
Request :=
To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
Self_ID.Common.State := Delay_Sleep;
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
pragma Assert (Result in 0 | ETIMEDOUT | EINTR);
end loop;
Self_ID.Common.State := Runnable;
end if;
Unlock (Self_ID);
if Single_Lock then
Unlock_RTS;
end if;
Result := sched_yield;
end Timed_Delay;
end Monotonic;
gcc/ada/sem_ch8.adb
......@@ -9108,10 +9108,10 @@ package body Sem_Ch8 is
-- Deal with use clauses within the context area if the current
-- scope is a compilation unit.
if Is_Compilation_Unit (Current_Scope) then
pragma Assert (Scope_Stack.Last /= Scope_Stack.First);
if Is_Compilation_Unit (Current_Scope)
and then Sloc (Scope_Stack.Table
(Scope_Stack.Last - 1).Entity) = Standard_Location
then
Update_Chain_In_Scope (Scope_Stack.Last - 1);
end if;
end Update_Use_Clause_Chain;
......
gcc/ada/sem_util.adb
......@@ -13186,17 +13186,29 @@ package body Sem_Util is
function Is_Controlling_Limited_Procedure
(Proc_Nam : Entity_Id) return Boolean
is
Param : Node_Id;
Param_Typ : Entity_Id := Empty;
begin
if Ekind (Proc_Nam) = E_Procedure
and then Present (Parameter_Specifications (Parent (Proc_Nam)))
then
Param_Typ := Etype (Parameter_Type (First (
Parameter_Specifications (Parent (Proc_Nam)))));
Param := Parameter_Type (First (
Parameter_Specifications (Parent (Proc_Nam))));
-- In this case where an Itype was created, the procedure call has been
-- rewritten.
-- The formal may be an anonymous access type.
if Nkind (Param) = N_Access_Definition then
Param_Typ := Entity (Subtype_Mark (Param));
else
Param_Typ := Etype (Param);
end if;
-- In the case where an Itype was created for a dispatchin call, the
-- procedure call has been rewritten. The actual may be an access to
-- interface type in which case it is the designated type that is the
-- controlling type.
elsif Present (Associated_Node_For_Itype (Proc_Nam))
and then Present (Original_Node (Associated_Node_For_Itype (Proc_Nam)))
......@@ -13207,6 +13219,10 @@ package body Sem_Util is
Param_Typ :=
Etype (First (Parameter_Associations
(Associated_Node_For_Itype (Proc_Nam))));
if Ekind (Param_Typ) = E_Anonymous_Access_Type then
Param_Typ := Directly_Designated_Type (Param_Typ);
end if;
end if;
if Present (Param_Typ) then
......
gcc/testsuite/ChangeLog
2017-10-20 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/sync_iface_call.adb, gnat.dg/sync_iface_call_pkg.ads,
gnat.dg/sync_iface_call_pkg2.adb, gnat.dg/sync_iface_call_pkg2.ads:
New testcase.
2017-10-20 Justin Squirek <squirek@adacore.com>
* gnat.dg/default_pkg_actual.adb, gnat.dg/default_pkg_actual2.adb: New
......
gcc/testsuite/gnat.dg/sync_iface_call.adb 0 → 100644
-- { dg-do compile }
with Sync_Iface_Call_Pkg;
with Sync_Iface_Call_Pkg2;
procedure Sync_Iface_Call is
Impl : access Sync_Iface_Call_Pkg.IFace'Class :=
new Sync_Iface_Call_Pkg2.Impl;
Val : aliased Integer := 10;
begin
select
Impl.Do_Stuff (Val);
or
delay 10.0;
end select;
select
Impl.Do_Stuff_Access (Val'Access);
or
delay 10.0;
end select;
select
Impl.Do_Stuff_2 (Val);
or
delay 10.0;
end select;
select
Impl.Do_Stuff_2_Access (Val'Access);
or
delay 10.0;
end select;
end Sync_Iface_Call;
gcc/testsuite/gnat.dg/sync_iface_call_pkg.ads 0 → 100644
package Sync_Iface_Call_Pkg is
type IFace is synchronized interface;
procedure Do_Stuff
(This : in out IFace;
Value : in Integer) is null;
procedure Do_Stuff_Access
(This : in out IFace;
Value : not null access Integer) is null;
procedure Do_Stuff_2
(This : not null access IFace;
Value : in Integer) is null;
procedure Do_Stuff_2_Access
(This : not null access IFace;
Value : not null access Integer) is null;
end Sync_Iface_Call_Pkg;
gcc/testsuite/gnat.dg/sync_iface_call_pkg2.adb 0 → 100644
package body Sync_Iface_Call_Pkg2 is
task body Impl is
begin
null;
end Impl;
end Sync_Iface_Call_Pkg2;
gcc/testsuite/gnat.dg/sync_iface_call_pkg2.ads 0 → 100644
with Sync_Iface_Call_Pkg;
package Sync_Iface_Call_Pkg2 is
task type Impl is new Sync_Iface_Call_Pkg.IFace with end;
end Sync_Iface_Call_Pkg2;
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