[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:
parent
99f9794783
commit
ef163a0a63
|
@ -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:
|
||||||
|
|
|
@ -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;
|
||||||
|
|
|
@ -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,
|
||||||
|
|
|
@ -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);
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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",
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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,
|
||||||
|
|
Loading…
Reference in New Issue