Skip to content

R
riscv-gcc-1
Commit ce20f35b by Arnaud Charlet
Options

[multiple changes] 

2012-01-23  Robert Dewar  <dewar@adacore.com>

	* a-calend.adb: Minor reformatting.

2012-01-23  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.adb, sem_ch9.adb: Handle array of access to synchronized
	interface in requeue statement.

2012-01-23  Cyrille Comar  <comar@adacore.com>

	* projects.texi: Remove references to main units and replace
	with references to main programs to be coherent with the
	documentation.

From-SVN: r183412
parent 7647cd4b
Showing with 102 additions and 58 deletions
gcc/ada/ChangeLog
2012-01-23 Robert Dewar <dewar@adacore.com>
* a-calend.adb: Minor reformatting.
2012-01-23 Ed Schonberg <schonberg@adacore.com>
* exp_ch9.adb, sem_ch9.adb: Handle array of access to synchronized
interface in requeue statement.
2012-01-23 Cyrille Comar <comar@adacore.com>
* projects.texi: Remove references to main units and replace
with references to main programs to be coherent with the
documentation.
2012-01-23 Robert Dewar <dewar@adacore.com>
* s-utf_32.adb: Minor reformatting.
2012-01-23 Vincent Celier <celier@adacore.com>
......
gcc/ada/a-calend.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -132,12 +132,10 @@ package body Ada.Calendar is
pragma Import (C, Flag, "__gl_leap_seconds_support");
-- This imported value is used to determine whether the compilation had
-- binder flag "-y" present which enables leap seconds. A value of zero
-- signifies no leap seconds support while a value of one enables the
-- support.
-- signifies no leap seconds support while a value of one enables support.
Leap_Support : constant Boolean := Flag = 1;
-- The above flag controls the usage of leap seconds in all Ada.Calendar
-- routines.
Leap_Support : constant Boolean := (Flag = 1);
-- Flag to controls the usage of leap seconds in all Ada.Calendar routines
Leap_Seconds_Count : constant Natural := 24;
......@@ -172,8 +170,8 @@ package body Ada.Calendar is
Start_Of_Time : constant Time_Rep :=
Ada_Low - Time_Rep (3) * Nanos_In_Day;
-- The Unix lower time bound expressed as nanoseconds since the
-- start of Ada time in UTC.
-- The Unix lower time bound expressed as nanoseconds since the start of
-- Ada time in UTC.
Unix_Min : constant Time_Rep :=
Ada_Low + Time_Rep (17 * 366 + 52 * 365) * Nanos_In_Day;
......@@ -187,7 +185,8 @@ package body Ada.Calendar is
(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
-- The following table contains the hard time values of all existing leap
-- seconds. The values are produced by the utility program xleaps.adb.
-- seconds. The values are produced by the utility program xleaps.adb. This
-- must be updated when additional leap second times are defined.
Leap_Second_Times : constant array (1 .. Leap_Seconds_Count) of Time_Rep :=
(-5601484800000000000,
......@@ -251,10 +250,9 @@ package body Ada.Calendar is
function "-" (Left : Time; Right : Time) return Duration is
pragma Unsuppress (Overflow_Check);
-- The bounds of type Duration expressed as time representations
Dur_Low : constant Time_Rep := Duration_To_Time_Rep (Duration'First);
Dur_High : constant Time_Rep := Duration_To_Time_Rep (Duration'Last);
-- The bounds of type Duration expressed as time representations
Res_N : Time_Rep;
......@@ -266,13 +264,12 @@ package body Ada.Calendar is
-- the generation of bogus values by the Unchecked_Conversion, we apply
-- the following check.
if Res_N < Dur_Low
or else Res_N > Dur_High
then
if Res_N < Dur_Low or else Res_N > Dur_High then
raise Time_Error;
end if;
return Time_Rep_To_Duration (Res_N);
exception
when Constraint_Error =>
raise Time_Error;
......@@ -344,8 +341,7 @@ package body Ada.Calendar is
-- by adding the number of nanoseconds between the two origins.
Res_N : Time_Rep :=
Duration_To_Time_Rep (System.OS_Primitives.Clock) +
Unix_Min;
Duration_To_Time_Rep (System.OS_Primitives.Clock) + Unix_Min;
begin
-- If the target supports leap seconds, determine the number of leap
......@@ -572,10 +568,10 @@ package body Ada.Calendar is
-- Validity checks
if not Year'Valid
or else not Month'Valid
or else not Day'Valid
or else not Seconds'Valid
if not Year'Valid or else
not Month'Valid or else
not Day'Valid or else
not Seconds'Valid
then
raise Time_Error;
end if;
......@@ -603,10 +599,10 @@ package body Ada.Calendar is
begin
-- Validity checks
if not Year'Valid
or else not Month'Valid
or else not Day'Valid
or else not Seconds'Valid
if not Year'Valid or else
not Month'Valid or else
not Day'Valid or else
not Seconds'Valid
then
raise Time_Error;
end if;
......@@ -815,12 +811,10 @@ package body Ada.Calendar is
-- Step 1: Validity checks of input values
if not Year'Valid
or else not Month'Valid
or else not Day'Valid
or else tm_hour not in 0 .. 24
or else tm_min not in 0 .. 59
or else tm_sec not in 0 .. 60
if not Year'Valid or else not Month'Valid or else not Day'Valid
or else tm_hour not in 0 .. 24
or else tm_min not in 0 .. 59
or else tm_sec not in 0 .. 60
or else tm_isdst not in -1 .. 1
then
raise Time_Error;
......@@ -1032,7 +1026,6 @@ package body Ada.Calendar is
Date_N : constant Time_Rep := Time_Rep (Date);
Time_Zone : constant Long_Integer :=
Time_Zones_Operations.UTC_Time_Offset (Date);
Ada_Low_N : Time_Rep;
Day_Count : Long_Integer;
Day_Dur : Time_Dur;
......@@ -1133,7 +1126,7 @@ package body Ada.Calendar is
Date_N := Date_N - Time_Rep (Elapsed_Leaps) * Nano;
-- Step 2: Time zone processing. This action converts the input date
-- from GMT to the requested time zone.
-- from GMT to the requested time zone. Applies from Ada 2005 on.
if Is_Ada_05 then
if Time_Zone /= 0 then
......@@ -1289,6 +1282,7 @@ package body Ada.Calendar is
-- the input date.
Count := (Year - Year_Number'First) / 4;
for Four_Year_Segments in 1 .. Count loop
Res_N := Res_N + Nanos_In_Four_Years;
end loop;
......@@ -1388,9 +1382,7 @@ package body Ada.Calendar is
-- An Ada 2005 caller requesting an explicit leap second or an
-- Ada 95 caller accounting for an invisible leap second.
if Leap_Sec
or else Res_N >= Next_Leap_N
then
if Leap_Sec or else Res_N >= Next_Leap_N then
Res_N := Res_N + Time_Rep (1) * Nano;
end if;
......
gcc/ada/exp_ch9.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -9090,10 +9090,26 @@ package body Exp_Ch9 is
-- Generate:
-- _Disp_Requeue (<Params>);
return
Make_Procedure_Call_Statement (Loc,
Name => Make_Identifier (Loc, Name_uDisp_Requeue),
Parameter_Associations => Params);
-- Find entity for Disp_Requeue operation, which belongs to
-- the type and may not be directly visible.
declare
Elmt : Elmt_Id;
Op : Entity_Id;
begin
Elmt := First_Elmt (Primitive_Operations (Etype (Conc_Typ)));
while Present (Elmt) loop
Op := Node (Elmt);
exit when Chars (Op) = Name_uDisp_Requeue;
Next_Elmt (Elmt);
end loop;
return
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Op, Loc),
Parameter_Associations => Params);
end;
end Build_Dispatching_Requeue;
--------------------------------------
......@@ -9366,6 +9382,16 @@ package body Exp_Ch9 is
Extract_Entry (N, Concval, Ename, Index);
Conc_Typ := Etype (Concval);
-- If the prefix is an access to class-wide type, dereference to get
-- object and entry type.
if Is_Access_Type (Conc_Typ) then
Conc_Typ := Designated_Type (Conc_Typ);
Rewrite (Concval,
Make_Explicit_Dereference (Loc, Relocate_Node (Concval)));
Analyze_And_Resolve (Concval, Conc_Typ);
end if;
-- Examine the scope stack in order to find nearest enclosing protected
-- or task type. This will constitute our invocation source.
......
gcc/ada/projects.texi
@set gprconfig GPRconfig
@c ------ projects.texi
@c Copyright (C) 2002-2011, Free Software Foundation, Inc.
@c Copyright (C) 2002-2012, Free Software Foundation, Inc.
@c This file is shared between the GNAT user's guide and gprbuild. It is not
@c compilable on its own, you should instead compile the other two manuals.
@c For that reason, there is no toplevel @menu
......@@ -2160,7 +2160,7 @@ using standard projects. This section will go over a few of these use
cases to try and explain what you can use aggregate projects for.
@menu
* Building all main units from a single project tree::
* Building all main programs from a single project tree::
* Building a set of projects with a single command::
* Define a build environment::
* Performance improvements in builder::
......@@ -2169,8 +2169,8 @@ cases to try and explain what you can use aggregate projects for.
@end menu
@c -----------------------------------------------------------
@node Building all main units from a single project tree
@subsection Building all main units from a single project tree
@node Building all main programs from a single project tree
@subsection Building all main programs from a single project tree
@c -----------------------------------------------------------
Most often, an application is organized into modules and submodules,
......@@ -2189,7 +2189,7 @@ a syntax similar to
gprbuild -PA.gpr
@end smallexample
this will only rebuild the main units of project A, not those of the
this will only rebuild the main programs of project A, not those of the
imported projects B and C. Therefore you have to spawn several
gnatmake commands, one per project, to build all executables.
This is a little inconvenient, but more importantly is inefficient
......@@ -2206,7 +2206,7 @@ and C. Then, when you build with
gprbuild -PAgg.gpr
@end smallexample
this will build all main units from A, B and C.
this will build all mains from A, B and C.
@smallexample @c projectfile
aggregate project Agg is
......@@ -2214,14 +2214,14 @@ this will build all main units from A, B and C.
end Agg;
@end smallexample
If B or C do not define any main unit (through their Main
If B or C do not define any main program (through their Main
attribute), all their sources are build. When you do not group them
in the aggregate project, only those sources that are needed by A
will be build.
If you add a main unit to a project P not already explicitly referenced in the
If you add a main to a project P not already explicitly referenced in the
aggregate project, you will need to add "p.gpr" in the list of project
files for the aggregate project, or the main unit will not be built when
files for the aggregate project, or the main will not be built when
building the aggregate project.
@c ---------------------------------------------------------
......@@ -2402,7 +2402,7 @@ grouping standard projects, you can have both the root of a project tree
within the tree.
Basically, the idea is to specify all those projects that have
main units you want to build and link, or libraries you want to
main programs you want to build and link, or libraries you want to
build. You can even specify projects that do not use the Main
attribute nor the @code{Library_*} attributes, and the result will be to
build all their source files (not just the ones needed by other
......@@ -2665,7 +2665,7 @@ Projects can locally add to those by using the
For projects that are build through the aggregate, the package Builder
is ignored, except for the Executable attribute which specifies the
name of the executables resulting from the link of the main units, and
name of the executables resulting from the link of the main programs, and
for the Executable_Suffix.
@c ---------------------------------------------
......@@ -4125,7 +4125,7 @@ with one or several main subprograms, by specifying their source files on the
command line.
@smallexample
gnatmake ^-P^/PROJECT_FILE=^prj main1 main2 main3
gnatmake ^-P^/PROJECT_FILE=^prj main1.adb main2.adb main3.adb
@end smallexample
@noindent
......@@ -4161,7 +4161,7 @@ Example:
@smallexample @c projectfile
@group
project Prj is
for Main use ("main1", "main2", "main3");
for Main use ("main1.adb", "main2.adb", "main3.adb");
end Prj;
@end group
@end smallexample
......@@ -4169,7 +4169,7 @@ Example:
@noindent
With this project file, @code{"gnatmake ^-Pprj^/PROJECT_FILE=PRJ^"}
is equivalent to
@code{"gnatmake ^-Pprj^/PROJECT_FILE=PRJ^ main1 main2 main3"}.
@code{"gnatmake ^-Pprj^/PROJECT_FILE=PRJ^ main1.adb main2.adb main3.adb"}.
When the project attribute @code{Main} is not specified, or is specified
as an empty string list, or when the switch @option{-u} is used on the command
......
gcc/ada/sem_ch9.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -1393,6 +1393,7 @@ package body Sem_Ch9 is
Target_Obj : Node_Id := Empty;
Req_Scope : Entity_Id;
Outer_Ent : Entity_Id;
Synch_Type : Entity_Id;
begin
Tasking_Used := True;
......@@ -1548,13 +1549,23 @@ package body Sem_Ch9 is
-- Ada 2012 (AI05-0030): Potential dispatching requeue statement. The
-- target type must be a concurrent interface class-wide type and the
-- target must be a procedure, flagged by pragma Implemented.
-- target must be a procedure, flagged by pragma Implemented. The
-- target may be an access to class-wide type, in which case it must
-- be dereferenced.
if Present (Target_Obj) then
Synch_Type := Etype (Target_Obj);
if Is_Access_Type (Synch_Type) then
Synch_Type := Designated_Type (Synch_Type);
end if;
end if;
Is_Disp_Req :=
Ada_Version >= Ada_2012
and then Present (Target_Obj)
and then Is_Class_Wide_Type (Etype (Target_Obj))
and then Is_Concurrent_Interface (Etype (Target_Obj))
and then Is_Class_Wide_Type (Synch_Type)
and then Is_Concurrent_Interface (Synch_Type)
and then Ekind (Entry_Id) = E_Procedure
and then Has_Rep_Pragma (Entry_Id, Name_Implemented);
......
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