[multiple changes]

2013-10-15  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Constituent): When
	a state acts as a constituent of another state, ensure that
	the said state has a Part_Of dependency in its corresponding
	aspect/pragma Abstract_State.

2013-10-15  Robert Dewar  <dewar@adacore.com>

	* par-ch4.adb (P_If_expression): Handle redundant ELSE cleanly.

2013-10-15  Thomas Quinot  <quinot@adacore.com>

	* atree.ads (New_Copy, Relocate_Node): Improve documentation
	(note that these subprograms reset Is_Overloaded).

2013-10-15  Thomas Quinot  <quinot@adacore.com>

	* checks.adb (Check_Needed): Handle the case where the test in
	the left operand of the short circuit is wrapped in a qualified
	expression, type conversion, or expression with actions.

2013-10-15  Thomas Quinot  <quinot@adacore.com>

	* sem_type.adb, sem_type.ads (Save_Interps): Also propagate
	Is_Overloaded to New_N, for consistency.

2013-10-15  Ed Schonberg  <schonberg@adacore.com>

	* a-tienau.adb (Put): Use file parameter to query values of
	current column and line length.

From-SVN: r203595
This commit is contained in:
Arnaud Charlet 2013-10-15 12:33:29 +02:00
parent 99f9794783
commit ef163a0a63
8 changed files with 116 additions and 29 deletions

View File

@ -1,3 +1,35 @@
2013-10-15 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Constituent): When
a state acts as a constituent of another state, ensure that
the said state has a Part_Of dependency in its corresponding
aspect/pragma Abstract_State.
2013-10-15 Robert Dewar <dewar@adacore.com>
* par-ch4.adb (P_If_expression): Handle redundant ELSE cleanly.
2013-10-15 Thomas Quinot <quinot@adacore.com>
* atree.ads (New_Copy, Relocate_Node): Improve documentation
(note that these subprograms reset Is_Overloaded).
2013-10-15 Thomas Quinot <quinot@adacore.com>
* checks.adb (Check_Needed): Handle the case where the test in
the left operand of the short circuit is wrapped in a qualified
expression, type conversion, or expression with actions.
2013-10-15 Thomas Quinot <quinot@adacore.com>
* sem_type.adb, sem_type.ads (Save_Interps): Also propagate
Is_Overloaded to New_N, for consistency.
2013-10-15 Ed Schonberg <schonberg@adacore.com>
* a-tienau.adb (Put): Use file parameter to query values of
current column and line length.
2013-10-15 Robert Dewar <dewar@adacore.com> 2013-10-15 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, exp_ch11.adb, a-except-2005.adb, a-except-2005.ads: * sem_prag.adb, exp_ch11.adb, a-except-2005.adb, a-except-2005.ads:

View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -126,19 +126,19 @@ package body Ada.Text_IO.Enumeration_Aux is
Actual_Width : constant Count := Count'Max (Count (Width), Item'Length); Actual_Width : constant Count := Count'Max (Count (Width), Item'Length);
begin begin
-- Deal with limited line length -- Deal with limited line length of output file
if Line_Length /= 0 then if Line_Length (File) /= 0 then
-- If actual width exceeds line length, raise Layout_Error -- If actual width exceeds line length, raise Layout_Error
if Actual_Width > Line_Length then if Actual_Width > Line_Length (File) then
raise Layout_Error; raise Layout_Error;
end if; end if;
-- If full width cannot fit on current line move to new line -- If full width cannot fit on current line move to new line
if Actual_Width + (Col - 1) > Line_Length then if Actual_Width + (Col (File) - 1) > Line_Length (File) then
New_Line (File); New_Line (File);
end if; end if;
end if; end if;

View File

@ -462,25 +462,26 @@ package Atree is
-- with copying aspect specifications where this is required. -- with copying aspect specifications where this is required.
function New_Copy (Source : Node_Id) return Node_Id; function New_Copy (Source : Node_Id) return Node_Id;
-- This function allocates a completely new node, and then initializes it -- This function allocates a completely new node, and then initializes
-- by copying the contents of the source node into it. The contents of the -- it by copying the contents of the source node into it. The contents of
-- source node is not affected. The target node is always marked as not -- the source node is not affected. The target node is always marked as
-- being in a list (even if the source is a list member). The new node will -- not being in a list (even if the source is a list member), and not
-- have an extension if the source has an extension. New_Copy (Empty) -- overloaded. The new node will have an extension if the source has
-- returns Empty and New_Copy (Error) returns Error. Note that, unlike -- an extension. New_Copy (Empty) returns Empty, and New_Copy (Error)
-- Copy_Separate_Tree, New_Copy does not recursively copy any descendents, -- returns Error. Note that, unlike Copy_Separate_Tree, New_Copy does not
-- so in general parent pointers are not set correctly for the descendents -- recursively copy any descendents, so in general parent pointers are not
-- of the copied node. Both normal and extended nodes (entities) may be -- set correctly for the descendents of the copied node. Both normal and
-- copied using New_Copy. -- extended nodes (entities) may be copied using New_Copy.
function Relocate_Node (Source : Node_Id) return Node_Id; function Relocate_Node (Source : Node_Id) return Node_Id;
-- Source is a non-entity node that is to be relocated. A new node is -- Source is a non-entity node that is to be relocated. A new node is
-- allocated and the contents of Source are copied to this node using -- allocated, and the contents of Source are copied to this node, using
-- Copy_Node. The parent pointers of descendents of the node are then -- New_Copy. The parent pointers of descendents of the node are then
-- adjusted to point to the relocated copy. The original node is not -- adjusted to point to the relocated copy. The original node is not
-- modified, but the parent pointers of its descendents are no longer -- modified, but the parent pointers of its descendents are no longer
-- valid. This routine is used in conjunction with the tree rewrite -- valid. The new copy is always marked as not overloaded. This routine is
-- routines (see descriptions of Replace/Rewrite). -- used in conjunction with the tree rewrite routines (see descriptions of
-- Replace/Rewrite).
-- --
-- Note that the resulting node has the same parent as the source node, and -- Note that the resulting node has the same parent as the source node, and
-- is thus still attached to the tree. It is valid for Source to be Empty, -- is thus still attached to the tree. It is valid for Source to be Empty,

View File

@ -3554,6 +3554,32 @@ package body Checks is
L : Node_Id; L : Node_Id;
R : Node_Id; R : Node_Id;
function Left_Expression (Op : Node_Id) return Node_Id;
-- Return the relevant expression from the left operand of the given
-- short circuit form: this is LO itself, except if LO is a qualified
-- expression, a type conversion, or an expression with actions, in
-- which case this is Left_Expression (Expression (LO)).
---------------------
-- Left_Expression --
---------------------
function Left_Expression (Op : Node_Id) return Node_Id is
LE : Node_Id := Left_Opnd (Op);
begin
while Nkind_In (LE,
N_Qualified_Expression,
N_Type_Conversion,
N_Expression_With_Actions)
loop
LE := Expression (LE);
end loop;
return LE;
end Left_Expression;
-- Start of processing for Check_Needed
begin begin
-- Always check if not simple entity -- Always check if not simple entity
@ -3587,37 +3613,40 @@ package body Checks is
elsif K = N_Op_Or then elsif K = N_Op_Or then
exit when N = Right_Opnd (P) exit when N = Right_Opnd (P)
and then Nkind (Left_Opnd (P)) = N_Op_Eq; and then Nkind (Left_Expression (P)) = N_Op_Eq;
elsif K = N_Or_Else then elsif K = N_Or_Else then
exit when (N = Right_Opnd (P) exit when (N = Right_Opnd (P)
or else or else
(Is_List_Member (N) (Is_List_Member (N)
and then List_Containing (N) = Actions (P))) and then List_Containing (N) = Actions (P)))
and then Nkind (Left_Opnd (P)) = N_Op_Eq; and then Nkind (Left_Expression (P)) = N_Op_Eq;
-- Similar test for the And/And then case, where the left operand -- Similar test for the And/And then case, where the left operand
-- is an inequality test. -- is an inequality test.
elsif K = N_Op_And then elsif K = N_Op_And then
exit when N = Right_Opnd (P) exit when N = Right_Opnd (P)
and then Nkind (Left_Opnd (P)) = N_Op_Ne; and then Nkind (Left_Expression (P)) = N_Op_Ne;
elsif K = N_And_Then then elsif K = N_And_Then then
exit when (N = Right_Opnd (P) exit when (N = Right_Opnd (P)
or else or else
(Is_List_Member (N) (Is_List_Member (N)
and then List_Containing (N) = Actions (P))) and then List_Containing (N) = Actions (P)))
and then Nkind (Left_Opnd (P)) = N_Op_Ne; and then Nkind (Left_Expression (P)) = N_Op_Ne;
end if; end if;
N := P; N := P;
end loop; end loop;
-- If we fall through the loop, then we have a conditional with an -- If we fall through the loop, then we have a conditional with an
-- appropriate test as its left operand. So test further. -- appropriate test as its left operand, so look further.
L := Left_Expression (P);
-- L is an "=" or "/=" operator: extract its operands
L := Left_Opnd (P);
R := Right_Opnd (L); R := Right_Opnd (L);
L := Left_Opnd (L); L := Left_Opnd (L);

View File

@ -3120,6 +3120,14 @@ package body Ch4 is
Scan; -- Past ELSE Scan; -- Past ELSE
Append_To (Exprs, P_Expression); Append_To (Exprs, P_Expression);
-- Skip redundant ELSE parts
while Token = Tok_Else loop
Error_Msg_SC ("only one ELSE part is allowed");
Scan; -- past ELSE
Discard_Junk_Node (P_Expression);
end loop;
-- Two expression case (implied True, filled in during semantics) -- Two expression case (implied True, filled in during semantics)
else else

View File

@ -21521,6 +21521,20 @@ package body Sem_Prag is
if Ekind_In (Constit_Id, E_Abstract_State, E_Variable) then if Ekind_In (Constit_Id, E_Abstract_State, E_Variable) then
Check_Matching_Constituent (Constit_Id); Check_Matching_Constituent (Constit_Id);
-- A state can act as a constituent only when it is part
-- of another state. This relation is expressed by option
-- "Part_Of" of pragma Abstract_State.
if Ekind (Constit_Id) = E_Abstract_State
and then not Is_Part_Of (Constit_Id, State_Id)
then
Error_Msg_Name_1 := Chars (State_Id);
Error_Msg_NE
("state & is not a valid constituent of ancestor "
& "state %", Constit, Constit_Id);
end if;
else else
Error_Msg_NE Error_Msg_NE
("constituent & must denote a variable or state", ("constituent & must denote a variable or state",

View File

@ -3209,6 +3209,8 @@ package body Sem_Type is
begin begin
if Is_Overloaded (Old_N) then if Is_Overloaded (Old_N) then
Set_Is_Overloaded (New_N);
if Nkind (Old_N) = N_Selected_Component if Nkind (Old_N) = N_Selected_Component
and then Is_Overloaded (Selector_Name (Old_N)) and then Is_Overloaded (Selector_Name (Old_N))
then then

View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -124,7 +124,7 @@ package Sem_Type is
-- denotes whether an interpretation has been disabled by an abstract -- denotes whether an interpretation has been disabled by an abstract
-- operator. Add_One_Interp includes semantic processing to deal with -- operator. Add_One_Interp includes semantic processing to deal with
-- adding entries that hide one another etc. -- adding entries that hide one another etc.
--
-- For operators, the legality of the operation depends on the visibility -- For operators, the legality of the operation depends on the visibility
-- of T and its scope. If the operator is an equality or comparison, T is -- of T and its scope. If the operator is an equality or comparison, T is
-- always Boolean, and we use Opnd_Type, which is a candidate type for one -- always Boolean, and we use Opnd_Type, which is a candidate type for one
@ -158,8 +158,9 @@ package Sem_Type is
procedure Save_Interps (Old_N : Node_Id; New_N : Node_Id); procedure Save_Interps (Old_N : Node_Id; New_N : Node_Id);
-- If an overloaded node is rewritten during semantic analysis, its -- If an overloaded node is rewritten during semantic analysis, its
-- possible interpretations must be linked to the copy. This procedure -- possible interpretations must be linked to the copy. This procedure
-- transfers the overload information from Old_N, the old node, to -- transfers the overload information (Is_Overloaded flag, and list of
-- New_N, its new copy. It has no effect in the non-overloaded case. -- interpretations) from Old_N, the old node, to New_N, its new copy.
-- It has no effect in the non-overloaded case.
function Covers (T1, T2 : Entity_Id) return Boolean; function Covers (T1, T2 : Entity_Id) return Boolean;
-- This is the basic type compatibility routine. T1 is the expected type, -- This is the basic type compatibility routine. T1 is the expected type,