procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2014-01-20  Robert Dewar  <dewar@adacore.com>

	* errout.ads, errout.adb: Implement >? >x? >X? sequences in error
	messages.
	* sem_ch6.adb (Check_Statement_Sequence): Missing return is an
	error in GNATprove mode.

2014-01-20  Ed Schonberg  <schonberg@adacore.com>

	* par-ch4.adb (Is_Parameterless_Attribute): The Ada2012 attribute
	reference 'Old takes no parameters, and thus can appear as a
	prefix of a slice.

2014-01-20  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_aggr.adb: Fix minor typos.

From-SVN: r206839
This commit is contained in:
Arnaud Charlet 2014-01-20 16:57:15 +01:00
parent a61524283e
commit b465ef6f25
6 changed files with 61 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
gcc/ada/ChangeLog
View file

@ -1,3 +1,20 @@
2014-01-20 Robert Dewar <dewar@adacore.com>
* errout.ads, errout.adb: Implement >? >x? >X? sequences in error
messages.
* sem_ch6.adb (Check_Statement_Sequence): Missing return is an
error in GNATprove mode.
2014-01-20 Ed Schonberg <schonberg@adacore.com>
* par-ch4.adb (Is_Parameterless_Attribute): The Ada2012 attribute
reference 'Old takes no parameters, and thus can appear as a
prefix of a slice.
2014-01-20 Eric Botcazou <ebotcazou@adacore.com>
* exp_aggr.adb: Fix minor typos.
2014-01-20 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Analyze_Attribute, case 'Constrained): In an

15
gcc/ada/errout.adb
View file

@ -2713,7 +2713,8 @@ package body Errout is
P : Natural; -- Current index;
procedure Set_Msg_Insertion_Warning;
-- Deal with ? ?? ?x? ?X? insertion sequences
-- Deal with ? ?? ?x? ?X? insertion sequences (also < <? <x? <X?). The
-- caller has already bumped the pointer past the initial ? or <.
-------------------------------
-- Set_Msg_Insertion_Warning --
@ -2819,14 +2820,12 @@ package body Errout is
when '<' =>
-- If tagging of messages is enabled, and this is a warning,
-- then it is treated as being [enabled by default].
-- Note: the prescan already set Is_Warning_Msg True if and
-- only if Error_Msg_Warn is set to True. If Error_Msg_Warn
-- is False, the call to Set_Msg_Insertion_Warning here does
-- no harm, since Warning_Msg_Char is ignored in that case.
if Error_Msg_Warn
and Warning_Doc_Switch
then
Warning_Msg_Char := '?';
end if;
Set_Msg_Insertion_Warning;
when '|' =>
null; -- already dealt with

7
gcc/ada/errout.ads
View file

@ -64,7 +64,6 @@ package Errout is
-- are active (see errout.ads for details). If this switch is False, then
-- these sequences are ignored (i.e. simply equivalent to a single ?). The
-- -gnatw.d switch sets this flag True, -gnatw.D sets this flag False.
-- Note: always ignored in VMS mode where we do not provide this feature.
-----------------------------------
-- Suppression of Error Messages --
@ -305,8 +304,10 @@ package Errout is
-- Insertion character < (Less Than: conditional warning message)
-- The character < appearing anywhere in a message is used for a
-- conditional error message. If Error_Msg_Warn is True, then the
-- effect is the same as ? described above. If Error_Msg_Warn is
-- False, then there is no effect.
-- effect is the same as ? described above, and in particular <? and
-- <X? have the effect of ?? and ?X? respectively. If Error_Msg_Warn
-- is False, then the < <? or <X? sequence is ignored and the message
-- is treated as a error rather than a warning.
-- Insertion character A-Z (Upper case letter: Ada reserved word)
-- If two or more upper case letters appear in the message, they are

24
gcc/ada/exp_aggr.adb
View file

@ -81,7 +81,7 @@ package body Exp_Aggr is
function Is_Static_Dispatch_Table_Aggregate (N : Node_Id) return Boolean;
-- Returns true if N is an aggregate used to initialize the components
-- of an statically allocated dispatch table.
-- of a statically allocated dispatch table.
function Must_Slide
(Obj_Type : Entity_Id;
@ -150,7 +150,7 @@ package body Exp_Aggr is
-- aggregate
function Has_Mutable_Components (Typ : Entity_Id) return Boolean;
-- Return true if one of the component is of a discriminated type with
-- Return true if one of the components is of a discriminated type with
-- defaults. An aggregate for a type with mutable components must be
-- expanded into individual assignments.
@ -183,7 +183,7 @@ package body Exp_Aggr is
function Backend_Processing_Possible (N : Node_Id) return Boolean;
-- This function checks if array aggregate N can be processed directly
-- by the backend. If this is the case True is returned.
-- by the backend. If this is the case, True is returned.
function Build_Array_Aggr_Code
(N : Node_Id;
@ -3918,7 +3918,7 @@ package body Exp_Aggr is
-- corresponding to the same dimension have the same bounds.
-- 2. Check for packed array aggregate which can be converted to a
-- constant so that the aggregate disappeares completely.
-- constant so that the aggregate disappears completely.
-- 3. Check case of nested aggregate. Generally nested aggregates are
-- handled during the processing of the parent aggregate.
@ -4964,7 +4964,7 @@ package body Exp_Aggr is
-- If all aggregate components are compile-time known and the aggregate
-- has been flattened, nothing left to do. The same occurs if the
-- aggregate is used to initialize the components of an statically
-- aggregate is used to initialize the components of a statically
-- allocated dispatch table.
if Compile_Time_Known_Aggregate (N)
@ -5282,7 +5282,7 @@ package body Exp_Aggr is
-- form, but there are two problems with that circuit:
-- a) It is limited to very small cases due to ill-understood
-- interations with bootstrapping. That limit is removed by
-- interactions with bootstrapping. That limit is removed by
-- use of the No_Implicit_Loops restriction.
-- b) It erroneously ends up with the resulting expressions being
@ -5445,7 +5445,7 @@ package body Exp_Aggr is
-- set and constants whose expression is such an aggregate, recursively.
function Component_Not_OK_For_Backend return Boolean;
-- Check for presence of component which makes it impossible for the
-- Check for presence of a component which makes it impossible for the
-- backend to process the aggregate, thus requiring the use of a series
-- of assignment statements. Cases checked for are a nested aggregate
-- needing Late_Expansion, the presence of a tagged component which may
@ -5466,7 +5466,7 @@ package body Exp_Aggr is
function Has_Visible_Private_Ancestor (Id : E) return Boolean;
-- If any ancestor of the current type is private, the aggregate
-- cannot be built in place. We canot rely on Has_Private_Ancestor,
-- cannot be built in place. We cannot rely on Has_Private_Ancestor,
-- because it will not be set when type and its parent are in the
-- same scope, and the parent component needs expansion.
@ -5751,13 +5751,13 @@ package body Exp_Aggr is
then
Convert_To_Assignments (N, Typ);
-- If the type involved has any non-bit aligned components, then we are
-- not sure that the back end can handle this case correctly.
-- If the type involved has bit aligned components, then we are not sure
-- that the back end can handle this case correctly.
elsif Type_May_Have_Bit_Aligned_Components (Typ) then
Convert_To_Assignments (N, Typ);
-- In all other cases, build a proper aggregate handlable by gigi
-- In all other cases, build a proper aggregate to be handled by gigi
else
if Nkind (N) = N_Aggregate then
@ -6378,7 +6378,7 @@ package body Exp_Aggr is
-- At this stage we have a suitable aggregate for handling at compile
-- time. The only remaining checks are that the values of expressions
-- in the aggregate are compile-time known (checks are performed by
-- Get_Component_Val, and that any subtypes or ranges are statically
-- Get_Component_Val), and that any subtypes or ranges are statically
-- known.
-- If the aggregate is not fully positional at this stage, then

4
gcc/ada/par-ch4.adb
View file

@ -41,6 +41,7 @@ package body Ch4 is
Attribute_External_Tag => True,
Attribute_Img => True,
Attribute_Loop_Entry => True,
Attribute_Old => True,
Attribute_Stub_Type => True,
Attribute_Version => True,
Attribute_Type_Key => True,
@ -49,7 +50,8 @@ package body Ch4 is
-- string or a type. For those attributes, a left parenthesis after
-- the attribute should not be analyzed as the beginning of a parameters
-- list because it may denote a slice operation (X'Img (1 .. 2)) or
-- a type conversion (X'Class (Y)).
-- a type conversion (X'Class (Y)). The Ada2012 attribute 'Old is in
-- this category.
-- Note: Loop_Entry is in this list because, although it can take an
-- optional argument (the loop name), we can't distinguish that at parse

24
gcc/ada/sem_ch6.adb
View file

@ -7222,12 +7222,24 @@ package body Sem_Ch6 is
if Mode = 'F' then
if not Raise_Exception_Call then
Error_Msg_N
("RETURN statement missing following this statement??!",
Last_Stm);
Error_Msg_N
("\Program_Error may be raised at run time??!",
Last_Stm);
-- In GNATprove mode, it is an error to have a missing return
if GNATprove_Mode then
Error_Msg_N
("RETURN statement missing following this statement!",
Last_Stm);
-- Otherwise normal case of warning (RM insists this is legal)
else
Error_Msg_N
("RETURN statement missing following this statement??!",
Last_Stm);
Error_Msg_N
("\Program_Error may be raised at run time??!",
Last_Stm);
end if;
end if;
-- Note: we set Err even though we have not issued a warning