Skip to content

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

[multiple changes] 

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

	* sem_ch6.adb (Analyze_Subprogram_Declaration): Do not set the
	Corresponding_Body on a defaulted null formal subprogram.
	* sem_ch12.adb (Check_Formal_Package_Instance): No check needed
	on a defaulted formal subprogram that is a null procedure.

2012-01-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch9.adb: Update the comments involving pragma Implemented.
	* sem_ch3.adb (Check_Pragma_Implemented (Entity_Id)): Add local
	constant Subp_Alias and local variable Impl_Subp. Properly
	handle aliases of synchronized wrappers. Code cleanup.
	(Check_Pragma_Implemented (Entity_Id; Entity_Id)): Add
	Name_Optional as part of the condition.
	* sem_prag.adb (Analyze_Pragma): Add "Optional" as one of the
	valid choices of implementation kind.
	(Check_Arg_Is_One_Of): New routine.
	* snames.ads-tmlp: Add Name_Optional.

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

	* par-ch13.adb: Better error recovery in illegal aspect
	specification.

2012-01-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* a-calend.adb: Add with clause for Interfaces.C. Add constant
	Unix_Max.
	(Day_Of_Week): Call the internal UTC_Time_Offset.
	(Split): Call the internal UTC_Time_Offset.
	(Time_Of): Call the internal UTC_Time_Offset.
	(Time_Zone_Operations.UTC_Time_Offset): Call internal UTC_Time_Offset.
	(UTC_Time_Offset): New library-level routine.
	* a-calend.ads (UTC_Time_Offset): Remove parameter
	Is_Historic. Update related comment on usage.
	* a-catizo.adb (UTC_Time_Offset): Removed.
	(UTC_Time_Offset (Time)): Call Time_Zone_Operations.UTC_Time_Offset.
	* a-caltizo.ads (UTC_Time_Offset): Removed.
	(UTC_Time_Offset (Time)): Add back the default expression of parameter
	Date.

From-SVN: r183414
parent 3ffd18f1
Showing with 142 additions and 74 deletions
gcc/ada/ChangeLog
2012-01-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Declaration): Do not set the
Corresponding_Body on a defaulted null formal subprogram.
* sem_ch12.adb (Check_Formal_Package_Instance): No check needed
on a defaulted formal subprogram that is a null procedure.
2012-01-23 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch9.adb: Update the comments involving pragma Implemented.
* sem_ch3.adb (Check_Pragma_Implemented (Entity_Id)): Add local
constant Subp_Alias and local variable Impl_Subp. Properly
handle aliases of synchronized wrappers. Code cleanup.
(Check_Pragma_Implemented (Entity_Id; Entity_Id)): Add
Name_Optional as part of the condition.
* sem_prag.adb (Analyze_Pragma): Add "Optional" as one of the
valid choices of implementation kind.
(Check_Arg_Is_One_Of): New routine.
* snames.ads-tmlp: Add Name_Optional.
2012-01-23 Ed Schonberg <schonberg@adacore.com>
* par-ch13.adb: Better error recovery in illegal aspect
specification.
2012-01-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-calend.adb: Add with clause for Interfaces.C. Add constant
Unix_Max.
(Day_Of_Week): Call the internal UTC_Time_Offset.
(Split): Call the internal UTC_Time_Offset.
(Time_Of): Call the internal UTC_Time_Offset.
(Time_Zone_Operations.UTC_Time_Offset): Call internal UTC_Time_Offset.
(UTC_Time_Offset): New library-level routine.
* a-calend.ads (UTC_Time_Offset): Remove parameter
Is_Historic. Update related comment on usage.
* a-catizo.adb (UTC_Time_Offset): Removed.
(UTC_Time_Offset (Time)): Call Time_Zone_Operations.UTC_Time_Offset.
* a-caltizo.ads (UTC_Time_Offset): Removed.
(UTC_Time_Offset (Time)): Add back the default expression of parameter
Date.
2012-01-23 Robert Dewar <dewar@adacore.com>
* sprint.ads, sprint.adb (Sprint_Node_List): Add New_Lines parameter
......
gcc/ada/a-calend.ads
......@@ -350,12 +350,9 @@ private
package Time_Zones_Operations is
function UTC_Time_Offset
(Date : Time;
Is_Historic : Boolean := True) return Long_Integer;
-- Return the offset in seconds from UTC of an arbitrary date. If flag
-- Is_Historic is set to False, then return the local time zone offset
-- regardless of what Date designates.
function UTC_Time_Offset (Date : Time) return Long_Integer;
-- Return (in seconds), the difference between the local time zone and
-- UTC time at a specific historic date.
end Time_Zones_Operations;
......
gcc/ada/a-catizo.adb
......@@ -42,41 +42,9 @@ package body Ada.Calendar.Time_Zones is
-- UTC_Time_Offset --
---------------------
function UTC_Time_Offset return Time_Offset is
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset is
Offset_L : constant Long_Integer :=
Time_Zones_Operations.UTC_Time_Offset
(Date => Clock,
Is_Historic => False);
Offset : Time_Offset;
begin
if Offset_L = Invalid_Time_Zone_Offset then
raise Unknown_Zone_Error;
end if;
-- The offset returned by Time_Zones_Operations.UTC_Time_Offset is in
-- seconds, the returned value needs to be in minutes.
Offset := Time_Offset (Offset_L / 60);
-- Validity checks
if not Offset'Valid then
raise Unknown_Zone_Error;
end if;
return Offset;
end UTC_Time_Offset;
---------------------
-- UTC_Time_Offset --
---------------------
function UTC_Time_Offset (Date : Time) return Time_Offset is
Offset_L : constant Long_Integer :=
Time_Zones_Operations.UTC_Time_Offset
(Date => Date,
Is_Historic => True);
Time_Zones_Operations.UTC_Time_Offset (Date);
Offset : Time_Offset;
begin
......
gcc/ada/a-catizo.ads
......@@ -26,12 +26,7 @@ package Ada.Calendar.Time_Zones is
Unknown_Zone_Error : exception;
function UTC_Time_Offset return Time_Offset;
-- Returns (in minutes), the difference between the implementation-defined
-- time zone of Calendar, and UTC time. If the time zone of the Calendar
-- implementation is unknown, raises Unknown_Zone_Error.
function UTC_Time_Offset (Date : Time) return Time_Offset;
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset;
-- Returns (in minutes), the difference between the implementation-defined
-- time zone of Calendar, and UTC time, at the time Date. If the time zone
-- of the Calendar implementation is unknown, raises Unknown_Zone_Error.
......
gcc/ada/exp_ch9.adb
......@@ -8878,7 +8878,8 @@ package body Exp_Ch9 is
-- Target.Primitive (Param1, ..., ParamN);
-- Ada 2012 (AI05-0030): Dispatching requeue to an interface primitive
-- marked by pragma Implemented (XXX, By_Any) or not marked at all.
-- marked by pragma Implemented (XXX, By_Any | Optional) or not marked
-- at all.
-- declare
-- S : constant Offset_Index :=
......@@ -8923,9 +8924,9 @@ package body Exp_Ch9 is
function Build_Dispatching_Requeue_To_Any return Node_Id;
-- Ada 2012 (AI05-0030): N denotes a dispatching requeue statement of
-- the form Concval.Ename. Ename is either marked by pragma Implemented
-- (XXX, By_Any) or not marked at all. Create a block which determines
-- at runtime whether Ename denotes an entry or a procedure and perform
-- the appropriate kind of dispatching select.
-- (XXX, By_Any | Optional) or not marked at all. Create a block which
-- determines at runtime whether Ename denotes an entry or a procedure
-- and perform the appropriate kind of dispatching select.
function Build_Normal_Requeue return Node_Id;
-- N denotes a non-dispatching requeue statement to either a task or a
......@@ -9445,9 +9446,10 @@ package body Exp_Ch9 is
Analyze (N);
-- The procedure_or_entry_NAME's implementation kind is either
-- By_Any or pragma Implemented was not applied at all. In this
-- case a runtime test determines whether Ename denotes an entry
-- or a protected procedure and performs the appropriate call.
-- By_Any, Optional, or pragma Implemented was not applied at all.
-- In this case a runtime test determines whether Ename denotes an
-- entry or a protected procedure and performs the appropriate
-- call.
else
Rewrite (N, Build_Dispatching_Requeue_To_Any);
......
gcc/ada/par-ch13.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- --
......@@ -514,12 +514,24 @@ package body Ch13 is
if Token = Tok_Comma
or else Token = Tok_Semicolon
or else (not Semicolon and then Token /= Tok_Arrow)
then
-- or else (not Semicolon and then Token /= Tok_Arrow)
if Aspect_Argument (A_Id) /= Optional then
Error_Msg_Node_1 := Aspect;
Error_Msg_Node_1 := Identifier (Aspect);
Error_Msg_AP ("aspect& requires an aspect definition");
OK := False;
end if;
elsif not Semicolon and then Token /= Tok_Arrow then
if Aspect_Argument (A_Id) /= Optional then
-- The name or expression may be there, but the arrow is
-- missing. Skip to the end of the declaration.
T_Arrow;
Resync_To_Semicolon;
end if;
-- Here we have an aspect definition
......
gcc/ada/sem_ch12.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- --
......@@ -5104,6 +5104,15 @@ package body Sem_Ch12 is
then
null;
-- No check needed if subprogram is a defaulted null procedure
elsif No (Alias (E2))
and then Ekind (E2) = E_Procedure
and then
Null_Present (Specification (Unit_Declaration_Node (E2)))
then
null;
-- Otherwise the actual in the formal and the actual in the
-- instantiation of the formal must match, up to renamings.
......
gcc/ada/sem_ch3.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- --
......@@ -8897,17 +8897,27 @@ package body Sem_Ch3 is
procedure Check_Pragma_Implemented (Subp : Entity_Id) is
Iface_Alias : constant Entity_Id := Interface_Alias (Subp);
Impl_Kind : constant Name_Id := Implementation_Kind (Iface_Alias);
Subp_Alias : constant Entity_Id := Alias (Subp);
Contr_Typ : Entity_Id;
Impl_Subp : Entity_Id;
begin
-- Subp must have an alias since it is a hidden entity used to link
-- an interface subprogram to its overriding counterpart.
pragma Assert (Present (Alias (Subp)));
pragma Assert (Present (Subp_Alias));
-- Handle aliases to synchronized wrappers
Impl_Subp := Subp_Alias;
if Is_Primitive_Wrapper (Impl_Subp) then
Impl_Subp := Wrapped_Entity (Impl_Subp);
end if;
-- Extract the type of the controlling formal
Contr_Typ := Etype (First_Formal (Alias (Subp)));
Contr_Typ := Etype (First_Formal (Subp_Alias));
if Is_Concurrent_Record_Type (Contr_Typ) then
Contr_Typ := Corresponding_Concurrent_Type (Contr_Typ);
......@@ -8917,12 +8927,12 @@ package body Sem_Ch3 is
-- be implemented by an entry.
if Impl_Kind = Name_By_Entry
and then Ekind (Wrapped_Entity (Alias (Subp))) /= E_Entry
and then Ekind (Impl_Subp) /= E_Entry
then
Error_Msg_Node_2 := Iface_Alias;
Error_Msg_NE
("type & must implement abstract subprogram & with an entry",
Alias (Subp), Contr_Typ);
Subp_Alias, Contr_Typ);
elsif Impl_Kind = Name_By_Protected_Procedure then
......@@ -8934,19 +8944,17 @@ package body Sem_Ch3 is
Error_Msg_Node_2 := Contr_Typ;
Error_Msg_NE
("interface subprogram & cannot be implemented by a " &
"primitive procedure of task type &", Alias (Subp),
"primitive procedure of task type &", Subp_Alias,
Iface_Alias);
-- An interface subprogram whose implementation kind is By_
-- Protected_Procedure must be implemented by a procedure.
elsif Is_Primitive_Wrapper (Alias (Subp))
and then Ekind (Wrapped_Entity (Alias (Subp))) /= E_Procedure
then
elsif Ekind (Impl_Subp) /= E_Procedure then
Error_Msg_Node_2 := Iface_Alias;
Error_Msg_NE
("type & must implement abstract subprogram & with a " &
"procedure", Alias (Subp), Contr_Typ);
"procedure", Subp_Alias, Contr_Typ);
end if;
end if;
end Check_Pragma_Implemented;
......@@ -8966,10 +8974,11 @@ package body Sem_Ch3 is
-- Ada 2012 (AI05-0030): The implementation kinds of an overridden
-- and overriding subprogram are different. In general this is an
-- error except when the implementation kind of the overridden
-- subprograms is By_Any.
-- subprograms is By_Any or Optional.
if Iface_Kind /= Subp_Kind
and then Iface_Kind /= Name_By_Any
and then Iface_Kind /= Name_Optional
then
if Iface_Kind = Name_By_Entry then
Error_Msg_N
......
gcc/ada/sem_ch6.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- --
......@@ -3138,7 +3138,6 @@ package body Sem_Ch6 is
Set_Defining_Unit_Name (Specification (Null_Body),
Make_Defining_Identifier (Loc, Chars (Defining_Entity (N))));
Set_Corresponding_Body (N, Defining_Entity (Null_Body));
Form := First (Parameter_Specifications (Specification (Null_Body)));
while Present (Form) loop
......@@ -3192,7 +3191,13 @@ package body Sem_Ch6 is
then
Set_Has_Completion (Designator);
if Present (Null_Body) then
-- Null procedures are always inlined, but generic formal subprograms
-- which appear as such in the internal instance of formal packages,
-- need no completion and are not marked Inline.
if Present (Null_Body)
and then Nkind (N) /= N_Formal_Concrete_Subprogram_Declaration
then
Set_Corresponding_Body (N, Defining_Entity (Null_Body));
Set_Body_To_Inline (N, Null_Body);
Set_Is_Inlined (Designator);
......
gcc/ada/sem_prag.adb
......@@ -473,6 +473,9 @@ package body Sem_Prag is
N1, N2, N3 : Name_Id);
procedure Check_Arg_Is_One_Of
(Arg : Node_Id;
N1, N2, N3, N4 : Name_Id);
procedure Check_Arg_Is_One_Of
(Arg : Node_Id;
N1, N2, N3, N4, N5 : Name_Id);
-- Check the specified argument Arg to make sure that it is an
-- identifier whose name matches either N1 or N2 (or N3, N4, N5 if
......@@ -1178,6 +1181,24 @@ package body Sem_Prag is
procedure Check_Arg_Is_One_Of
(Arg : Node_Id;
N1, N2, N3, N4 : Name_Id)
is
Argx : constant Node_Id := Get_Pragma_Arg (Arg);
begin
Check_Arg_Is_Identifier (Argx);
if Chars (Argx) /= N1
and then Chars (Argx) /= N2
and then Chars (Argx) /= N3
and then Chars (Argx) /= N4
then
Error_Pragma_Arg ("invalid argument for pragma%", Argx);
end if;
end Check_Arg_Is_One_Of;
procedure Check_Arg_Is_One_Of
(Arg : Node_Id;
N1, N2, N3, N4, N5 : Name_Id)
is
Argx : constant Node_Id := Get_Pragma_Arg (Arg);
......@@ -9325,7 +9346,11 @@ package body Sem_Prag is
-----------------
-- pragma Implemented (procedure_LOCAL_NAME, implementation_kind);
-- implementation_kind ::= By_Entry | By_Protected_Procedure | By_Any
-- implementation_kind ::=
-- By_Entry | By_Protected_Procedure | By_Any | Optional
-- "By_Any" and "Optional" are treated as synonyms in order to
-- support Ada 2012 aspect Synchronization.
when Pragma_Implemented => Implemented : declare
Proc_Id : Entity_Id;
......@@ -9337,8 +9362,11 @@ package body Sem_Prag is
Check_No_Identifiers;
Check_Arg_Is_Identifier (Arg1);
Check_Arg_Is_Local_Name (Arg1);
Check_Arg_Is_One_Of
(Arg2, Name_By_Any, Name_By_Entry, Name_By_Protected_Procedure);
Check_Arg_Is_One_Of (Arg2,
Name_By_Any,
Name_By_Entry,
Name_By_Protected_Procedure,
Name_Optional);
-- Extract the name of the local procedure
......
gcc/ada/snames.ads-tmpl
......@@ -678,6 +678,7 @@ package Snames is
Name_No_Task_Attributes_Package : constant Name_Id := N + $;
Name_Nominal : constant Name_Id := N + $;
Name_On : constant Name_Id := N + $;
Name_Optional : constant Name_Id := N + $;
Name_Policy : constant Name_Id := N + $;
Name_Parameter_Types : constant Name_Id := N + $;
Name_Reference : constant Name_Id := N + $;
......
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