OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

2014-06-11 Sergey Rybin <rybin@adacore.com frybin> 

* gnat_ugn.texi, vms_data.ads: add description of gnatstub -W<par>
	option to specify the result file encoding.

2014-06-11  Robert Dewar  <dewar@adacore.com>

	* errout.ads, sem_ch12.adb: Minor reformatting.
	* debug.adb, erroutc.adb: Remove -gnatd.q debug switch.
	* lib-xref.adb: Minor reformatting.
	* restrict.adb: Minor code reorganization (put routines in
	alpha order).

From-SVN: r211455
This commit is contained in:
Arnaud Charlet 2014-06-11 14:25:22 +02:00
parent 2c8d828a5f
commit 810241a5bf
9 changed files with 161 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/ada/ChangeLog
View File

@ -1,3 +1,16 @@
2014-06-11 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: add description of gnatstub -W<par>
option to specify the result file encoding.
2014-06-11 Robert Dewar <dewar@adacore.com>
* errout.ads, sem_ch12.adb: Minor reformatting.
* debug.adb, erroutc.adb: Remove -gnatd.q debug switch.
* lib-xref.adb: Minor reformatting.
* restrict.adb: Minor code reorganization (put routines in
alpha order).
2014-06-11 Yannick Moy <moy@adacore.com>
* einfo.ads: Minor typo in comment

8
gcc/ada/debug.adb
View File

@ -107,7 +107,7 @@ package body Debug is
-- d.n Print source file names
-- d.o Generate .NET listing of CIL code
-- d.p Enable the .NET CIL verifier
-- d.q Quit on badly tagged warning message
-- d.q
-- d.r Enable OK_To_Reorder_Components in non-variant records
-- d.s Disable expansion of slice move, use memmove
-- d.t Disable static allocation of library level dispatch tables
@ -561,12 +561,6 @@ package body Debug is
-- disabled by default and this flag is used to enable it. In the
-- future we will reverse this functionality.
-- d.q All warning and info messages are supposed to be tagged with one
-- of the extended warning sequences such as ?? or <x<. The use of a
-- single ? or < is allowed for transitional purposes, but these are
-- intended to disappear. This debug switch makes it fatal to have a
-- warning presented which is not tagged (Program Error is raised).
-- d.r Forces the flag OK_To_Reorder_Components to be set in all record
-- base types that have no discriminants.

3
gcc/ada/errout.ads
View File

@ -282,7 +282,8 @@ package Errout is
-- status of continuations is determined only by the parent message
-- which is being continued. It is allowable to put ? in continuation
-- messages, and the usual style is to include it, since it makes it
-- clear that the continuation is part of a warning message.
-- clear that the continuation is part of a warning message, but it is
-- not necessary to go through any computational effort to include it.
--
-- Note: this usage is obsolete, use ?? ?*? ?$? ?x? ?X? to specify
-- the string to be added when Warn_Doc_Switch is set to True. If this

12
gcc/ada/erroutc.adb
View File

@ -756,14 +756,12 @@ package body Erroutc is
end;
end if;
-- Bomb if untagged warning message and -gnatd.q set
-- Bomb if untagged warning message. This code can be uncommented
-- for debugging when looking for untagged warning messages.
if Debug_Flag_Dot_Q
and then Is_Warning_Msg
and then Warning_Msg_Char = ' '
then
raise Program_Error;
end if;
-- if Is_Warning_Msg and then Warning_Msg_Char = ' ' then
-- raise Program_Error;
-- end if;
-- Unconditional message (! insertion)

28
gcc/ada/gnat_ugn.texi
View File

@ -14539,7 +14539,7 @@ is made; this is the default.
@cindex @option{^--par_threshold^/MAX_PAR^} (@command{gnatpp})
If the number of parameter specifications is greater than @var{nnn}
(or equal to @var{nnn} in case of a function), start each specification from
a new line. The default for @var{nnn} is 3.
a new line. This feature is disabled by default.
@end table
@node Setting the Source Search Path
@ -19520,6 +19520,32 @@ conventions. If this switch is omitted the default name for the body will be
obtained
from the argument file name according to the GNAT file naming conventions.
@item ^-W^/RESULT_ENCODING=^@var{e}
@cindex @option{^-W^/RESULT_ENCODING=^} (@command{gnatstub})
Specify the wide character encoding method for the output body file.
@var{e} is one of the following:
@itemize @bullet
@item ^h^HEX^
Hex encoding
@item ^u^UPPER^
Upper half encoding
@item ^s^SHIFT_JIS^
Shift/JIS encoding
@item ^e^EUC^
EUC encoding
@item ^8^UTF8^
UTF-8 encoding
@item ^b^BRACKETS^
Brackets encoding (default value)
@end itemize
@item ^-q^/QUIET^
@cindex @option{^-q^/QUIET^} (@command{gnatstub})
Quiet mode: do not generate a confirmation when a body is

1
gcc/ada/lib-xref.adb
View File

@ -660,7 +660,6 @@ package body Lib.Xref is
(GNATprove_Mode
and then In_Extended_Main_Code_Unit (N)
and then (Typ = 'm' or else Typ = 'r' or else Typ = 's'))
then
null;

132
gcc/ada/restrict.adb
View File

@ -274,72 +274,6 @@ package body Restrict is
Check_Restriction (No_Implicit_Heap_Allocations, N);
end Check_No_Implicit_Heap_Alloc;
-------------------------------------------
-- Check_Restriction_No_Use_Of_Attribute --
--------------------------------------------
procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id) is
Id : constant Name_Id := Chars (N);
A_Id : constant Attribute_Id := Get_Attribute_Id (Id);
begin
-- Ignore call if node N is not in the main source unit, since we only
-- give messages for the main unit. This avoids giving messages for
-- aspects that are specified in withed units.
if not In_Extended_Main_Source_Unit (N) then
return;
end if;
-- If nothing set, nothing to check
if not No_Use_Of_Attribute_Set then
return;
end if;
Error_Msg_Sloc := No_Use_Of_Attribute (A_Id);
if Error_Msg_Sloc /= No_Location then
Error_Msg_Node_1 := N;
Error_Msg_Warn := No_Use_Of_Attribute_Warning (A_Id);
Error_Msg_N
("<*<violation of restriction `No_Use_Of_Attribute '='> &`#", N);
end if;
end Check_Restriction_No_Use_Of_Attribute;
----------------------------------------
-- Check_Restriction_No_Use_Of_Pragma --
----------------------------------------
procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id) is
Id : constant Node_Id := Pragma_Identifier (N);
P_Id : constant Pragma_Id := Get_Pragma_Id (Chars (Id));
begin
-- Ignore call if node N is not in the main source unit, since we only
-- give messages for the main unit. This avoids giving messages for
-- aspects that are specified in withed units.
if not In_Extended_Main_Source_Unit (N) then
return;
end if;
-- If nothing set, nothing to check
if not No_Use_Of_Pragma_Set then
return;
end if;
Error_Msg_Sloc := No_Use_Of_Pragma (P_Id);
if Error_Msg_Sloc /= No_Location then
Error_Msg_Node_1 := Id;
Error_Msg_Warn := No_Use_Of_Pragma_Warning (P_Id);
Error_Msg_N
("<*<violation of restriction `No_Use_Of_Pragma '='> &`#", Id);
end if;
end Check_Restriction_No_Use_Of_Pragma;
-----------------------------------
-- Check_Obsolescent_2005_Entity --
-----------------------------------
@ -696,6 +630,72 @@ package body Restrict is
end if;
end Check_Restriction_No_Specification_Of_Aspect;
-------------------------------------------
-- Check_Restriction_No_Use_Of_Attribute --
--------------------------------------------
procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id) is
Id : constant Name_Id := Chars (N);
A_Id : constant Attribute_Id := Get_Attribute_Id (Id);
begin
-- Ignore call if node N is not in the main source unit, since we only
-- give messages for the main unit. This avoids giving messages for
-- aspects that are specified in withed units.
if not In_Extended_Main_Source_Unit (N) then
return;
end if;
-- If nothing set, nothing to check
if not No_Use_Of_Attribute_Set then
return;
end if;
Error_Msg_Sloc := No_Use_Of_Attribute (A_Id);
if Error_Msg_Sloc /= No_Location then
Error_Msg_Node_1 := N;
Error_Msg_Warn := No_Use_Of_Attribute_Warning (A_Id);
Error_Msg_N
("<*<violation of restriction `No_Use_Of_Attribute '='> &`#", N);
end if;
end Check_Restriction_No_Use_Of_Attribute;
----------------------------------------
-- Check_Restriction_No_Use_Of_Pragma --
----------------------------------------
procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id) is
Id : constant Node_Id := Pragma_Identifier (N);
P_Id : constant Pragma_Id := Get_Pragma_Id (Chars (Id));
begin
-- Ignore call if node N is not in the main source unit, since we only
-- give messages for the main unit. This avoids giving messages for
-- aspects that are specified in withed units.
if not In_Extended_Main_Source_Unit (N) then
return;
end if;
-- If nothing set, nothing to check
if not No_Use_Of_Pragma_Set then
return;
end if;
Error_Msg_Sloc := No_Use_Of_Pragma (P_Id);
if Error_Msg_Sloc /= No_Location then
Error_Msg_Node_1 := Id;
Error_Msg_Warn := No_Use_Of_Pragma_Warning (P_Id);
Error_Msg_N
("<*<violation of restriction `No_Use_Of_Pragma '='> &`#", Id);
end if;
end Check_Restriction_No_Use_Of_Pragma;
--------------------------------------
-- Check_Wide_Character_Restriction --
--------------------------------------

21
gcc/ada/sem_ch12.adb
View File

@ -9965,11 +9965,11 @@ package body Sem_Ch12 is
Uninit_Var := Uninitialized_Variable (Decl);
elsif Nkind (Decl) = N_Formal_Type_Declaration
and then Nkind (Formal_Type_Definition (Decl))
= N_Formal_Private_Type_Definition
and then Nkind (Formal_Type_Definition (Decl)) =
N_Formal_Private_Type_Definition
then
Uninit_Var := Uninitialized_Variable
(Formal_Type_Definition (Decl));
Uninit_Var :=
Uninitialized_Variable (Formal_Type_Definition (Decl));
end if;
if Present (Uninit_Var) then
@ -9979,8 +9979,8 @@ package body Sem_Ch12 is
-- For each formal there is a subtype declaration that renames
-- the actual and has the same name as the formal. Locate the
-- formal for warning message about uninitialized variables
-- in the generic, for which the actual type should be a
-- fully initialized type.
-- in the generic, for which the actual type should be a fully
-- initialized type.
while Present (Actual) loop
exit when Ekind (Actual) = E_Package
@ -9993,10 +9993,11 @@ package body Sem_Ch12 is
then
Error_Msg_Node_2 := Formal;
Error_Msg_NE
("generic unit has uninitialzed variable& of "
& " formal private type &?v?", Actual, Uninit_Var);
Error_Msg_NE ("actual type for& should be "
& "fully initialized type?v?", Actual, Formal);
("generic unit has uninitialized variable& of "
& "formal private type &?v?", Actual, Uninit_Var);
Error_Msg_NE
("actual type for& should be fully initialized type?v?",
Actual, Formal);
exit;
end if;

37
gcc/ada/vms_data.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1996-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2014, 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- --
@ -7155,6 +7155,40 @@ package VMS_Data is
--
-- Look for source, library or object files in the default directory.
S_Stub_Encoding : aliased constant S := "/RESULT_ENCODING=" &
"BRACKETS " &
"-Wb " &
"HEX " &
"-Wh " &
"UPPER " &
"-Wu " &
"SHIFT_JIS " &
"-Ws " &
"EUC " &
"-We " &
"UTF8 " &
"-W8";
-- /RESULT_ENCODING[=encoding-type]
--
-- Specify the wide character encoding method used when writing the
-- generated body in the result file. 'encoding-type' is one of the
-- following:
--
-- BRACKETS (D) Brackets encoding.
--
-- HEX Hex ESC encoding.
--
-- UPPER Upper half encoding.
--
-- SHIFT_JIS Shift-JIS encoding.
--
-- EUC EUC Encoding.
--
-- UTF8 UTF-8 encoding.
--
-- See 'HELP GNAT COMPILE /WIDE_CHARACTER_ENCODING' for an explanation
-- about the different character encoding methods.
S_Stub_Ext : aliased constant S := "/EXTERNAL_REFERENCE=" & '"' &
"-X" & '"';
-- /EXTERNAL_REFERENCE="name=val"
@ -7349,6 +7383,7 @@ package VMS_Data is
(S_Stub_Add 'Access,
S_Stub_Config 'Access,
S_Stub_Current 'Access,
S_Stub_Encoding 'Access,
S_Stub_Ext 'Access,
S_Stub_Follow 'Access,
S_Stub_Full 'Access,