Skip to content

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

[multiple changes] 

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb: Additional semantic checks for aspects involved in
	iterators.

2011-08-29  Matthew Heaney  <heaney@adacore.com>

	* a-comutr.ads, a-comutr.adb, a-cimutr.ads, a-cimutr.adb,
	a-cbmutr.ads, a-cbmutr.adb (Find_In_Subtree): Remove superfluous
	Container parameter.
	(Ancestor_Find): ditto.

2011-08-29  Robert Dewar  <dewar@adacore.com>

	* par-endh.adb: Minor reformatting.

From-SVN: r178190
parent b970af39
Showing with 376 additions and 121 deletions
gcc/ada/ChangeLog
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb: Additional semantic checks for aspects involved in
iterators.
2011-08-29 Matthew Heaney <heaney@adacore.com>
* a-comutr.ads, a-comutr.adb, a-cimutr.ads, a-cimutr.adb,
a-cbmutr.ads, a-cbmutr.adb (Find_In_Subtree): Remove superfluous
Container parameter.
(Ancestor_Find): ditto.
2011-08-29 Thomas Quinot <quinot@adacore.com>
* par-endh.adb: Minor reformatting.
z
2011-08-29 Tristan Gingold <gingold@adacore.com>
* a-exexpr-gcc.adb (Unwind_Action) Rewrite as an integer with constants.
......
gcc/ada/a-cbmutr.adb
......@@ -286,21 +286,21 @@ package body Ada.Containers.Bounded_Multiway_Trees is
-------------------
function Ancestor_Find
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor
(Position : Cursor;
Item : Element_Type) return Cursor
is
R : constant Count_Type := Root_Node (Container);
N : Count_Type;
R, N : Count_Type;
begin
if Position = No_Element then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor not in container";
end if;
-- Commented-out pending ruling by ARG. ???
-- if Position.Container /= Container'Unrestricted_Access then
-- raise Program_Error with "Position cursor not in container";
-- end if;
-- AI-0136 says to raise PE if Position equals the root node. This does
-- not seem correct, as this value is just the limiting condition of the
......@@ -311,13 +311,14 @@ package body Ada.Containers.Bounded_Multiway_Trees is
-- raise Program_Error with "Position cursor designates root";
-- end if;
R := Root_Node (Position.Container.all);
N := Position.Node;
while N /= R loop
if Container.Elements (N) = Item then
return Cursor'(Container'Unrestricted_Access, N);
if Position.Container.Elements (N) = Item then
return Cursor'(Position.Container, N);
end if;
N := Container.Nodes (N).Parent;
N := Position.Container.Nodes (N).Parent;
end loop;
return No_Element;
......@@ -1289,9 +1290,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is
---------------------
function Find_In_Subtree
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor
(Position : Cursor;
Item : Element_Type) return Cursor
is
Result : Count_Type;
......@@ -1300,27 +1300,35 @@ package body Ada.Containers.Bounded_Multiway_Trees is
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor not in container";
end if;
-- Commented-out pending ruling by ARG. ???
if Container.Count = 0 then
-- if Position.Container /= Container'Unrestricted_Access then
-- raise Program_Error with "Position cursor not in container";
-- end if;
if Position.Container.Count = 0 then
pragma Assert (Is_Root (Position));
return No_Element;
end if;
if Is_Root (Position) then
Result := Find_In_Children (Container, Position.Node, Item);
Result := Find_In_Children
(Container => Position.Container.all,
Subtree => Position.Node,
Item => Item);
else
Result := Find_In_Subtree (Container, Position.Node, Item);
Result := Find_In_Subtree
(Container => Position.Container.all,
Subtree => Position.Node,
Item => Item);
end if;
if Result = 0 then
return No_Element;
end if;
return Cursor'(Container'Unrestricted_Access, Result);
return Cursor'(Position.Container, Result);
end Find_In_Subtree;
function Find_In_Subtree
......
gcc/ada/a-cbmutr.ads
......@@ -113,22 +113,36 @@ package Ada.Containers.Bounded_Multiway_Trees is
Item : Element_Type) return Cursor;
-- This version of the AI:
-- 10-06-02 AI05-0136-1/07
-- declares Find_In_Subtree with a Container parameter, but this seems
-- incorrect. We need a ruling from the ARG about whether this really was
-- intended. ???
-- 10-06-02 AI05-0136-1/07
-- declares Find_In_Subtree this way:
--
-- function Find_In_Subtree
-- (Container : Tree;
-- Item : Element_Type;
-- Position : Cursor) return Cursor;
--
-- It seems that the Container parameter is there by mistake, but we need
-- an official ruling from the ARG. ???
function Find_In_Subtree
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor;
(Position : Cursor;
Item : Element_Type) return Cursor;
-- This version of the AI:
-- 10-06-02 AI05-0136-1/07
-- declares Ancestor_Find this way:
--
-- function Ancestor_Find
-- (Container : Tree;
-- Item : Element_Type;
-- Position : Cursor) return Cursor;
--
-- It seems that the Container parameter is there by mistake, but we need
-- an official ruling from the ARG. ???
function Ancestor_Find
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor;
(Position : Cursor;
Item : Element_Type) return Cursor;
function Contains
(Container : Tree;
......
gcc/ada/a-cimutr.adb
......@@ -164,21 +164,21 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
-------------------
function Ancestor_Find
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor
(Position : Cursor;
Item : Element_Type) return Cursor
is
R : constant Tree_Node_Access := Root_Node (Container);
N : Tree_Node_Access;
R, N : Tree_Node_Access;
begin
if Position = No_Element then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor not in container";
end if;
-- Commented-out pending ARG ruling. ???
-- if Position.Container /= Container'Unrestricted_Access then
-- raise Program_Error with "Position cursor not in container";
-- end if;
-- AI-0136 says to raise PE if Position equals the root node. This does
-- not seem correct, as this value is just the limiting condition of the
......@@ -188,10 +188,11 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
-- raise Program_Error with "Position cursor designates root";
-- end if;
R := Root_Node (Position.Container.all);
N := Position.Node;
while N /= R loop
if N.Element.all = Item then
return Cursor'(Container'Unrestricted_Access, N);
return Cursor'(Position.Container, N);
end if;
N := N.Parent;
......@@ -974,9 +975,8 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
---------------------
function Find_In_Subtree
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor
(Position : Cursor;
Item : Element_Type) return Cursor
is
Result : Tree_Node_Access;
......@@ -985,9 +985,11 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor not in container";
end if;
-- Commented-out pending ruling from ARG. ???
-- if Position.Container /= Container'Unrestricted_Access then
-- raise Program_Error with "Position cursor not in container";
-- end if;
if Is_Root (Position) then
Result := Find_In_Children (Position.Node, Item);
......@@ -1000,7 +1002,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
return No_Element;
end if;
return Cursor'(Container'Unrestricted_Access, Result);
return Cursor'(Position.Container, Result);
end Find_In_Subtree;
function Find_In_Subtree
......
gcc/ada/a-cimutr.ads
......@@ -113,15 +113,37 @@ package Ada.Containers.Indefinite_Multiway_Trees is
(Container : Tree;
Item : Element_Type) return Cursor;
-- This version of the AI:
-- 10-06-02 AI05-0136-1/07
-- declares Find_In_Subtree this way:
--
-- function Find_In_Subtree
-- (Container : Tree;
-- Item : Element_Type;
-- Position : Cursor) return Cursor;
--
-- It seems that the Container parameter is there by mistake, but we need
-- an official ruling from the ARG. ???
function Find_In_Subtree
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor;
(Position : Cursor;
Item : Element_Type) return Cursor;
-- This version of the AI:
-- 10-06-02 AI05-0136-1/07
-- declares Ancestor_Find this way:
--
-- function Ancestor_Find
-- (Container : Tree;
-- Item : Element_Type;
-- Position : Cursor) return Cursor;
--
-- It seems that the Container parameter is there by mistake, but we need
-- an official ruling from the ARG. ???
function Ancestor_Find
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor;
(Position : Cursor;
Item : Element_Type) return Cursor;
function Contains
(Container : Tree;
......
gcc/ada/a-comutr.adb
......@@ -163,21 +163,21 @@ package body Ada.Containers.Multiway_Trees is
-------------------
function Ancestor_Find
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor
(Position : Cursor;
Item : Element_Type) return Cursor
is
R : constant Tree_Node_Access := Root_Node (Container);
N : Tree_Node_Access;
R, N : Tree_Node_Access;
begin
if Position = No_Element then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor not in container";
end if;
-- Commented-out pending official ruling from ARG. ???
-- if Position.Container /= Container'Unrestricted_Access then
-- raise Program_Error with "Position cursor not in container";
-- end if;
-- AI-0136 says to raise PE if Position equals the root node. This does
-- not seem correct, as this value is just the limiting condition of the
......@@ -187,10 +187,11 @@ package body Ada.Containers.Multiway_Trees is
-- raise Program_Error with "Position cursor designates root";
-- end if;
R := Root_Node (Position.Container.all);
N := Position.Node;
while N /= R loop
if N.Element = Item then
return Cursor'(Container'Unrestricted_Access, N);
return Cursor'(Position.Container, N);
end if;
N := N.Parent;
......@@ -950,9 +951,8 @@ package body Ada.Containers.Multiway_Trees is
---------------------
function Find_In_Subtree
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor
(Position : Cursor;
Item : Element_Type) return Cursor
is
Result : Tree_Node_Access;
......@@ -961,9 +961,11 @@ package body Ada.Containers.Multiway_Trees is
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor not in container";
end if;
-- Commented out pending official ruling by ARG. ???
-- if Position.Container /= Container'Unrestricted_Access then
-- raise Program_Error with "Position cursor not in container";
-- end if;
if Is_Root (Position) then
Result := Find_In_Children (Position.Node, Item);
......@@ -976,7 +978,7 @@ package body Ada.Containers.Multiway_Trees is
return No_Element;
end if;
return Cursor'(Container'Unrestricted_Access, Result);
return Cursor'(Position.Container, Result);
end Find_In_Subtree;
function Find_In_Subtree
......
gcc/ada/a-comutr.ads
......@@ -113,15 +113,37 @@ package Ada.Containers.Multiway_Trees is
(Container : Tree;
Item : Element_Type) return Cursor;
-- This version of the AI:
-- 10-06-02 AI05-0136-1/07
-- declares Find_In_Subtree this way:
--
-- function Find_In_Subtree
-- (Container : Tree;
-- Item : Element_Type;
-- Position : Cursor) return Cursor;
--
-- It seems that the Container parameter is there by mistake, but we need
-- an official ruling from the ARG. ???
function Find_In_Subtree
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor;
(Position : Cursor;
Item : Element_Type) return Cursor;
-- This version of the AI:
-- 10-06-02 AI05-0136-1/07
-- declares Ancestor_Find this way:
--
-- function Ancestor_Find
-- (Container : Tree;
-- Item : Element_Type;
-- Position : Cursor) return Cursor;
--
-- It seems that the Container parameter is there by mistake, but we need
-- an official ruling from the ARG. ???
function Ancestor_Find
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor;
(Position : Cursor;
Item : Element_Type) return Cursor;
function Contains
(Container : Tree;
......
gcc/ada/par-endh.adb
......@@ -799,10 +799,10 @@ package body Endh is
-- In the following test we protect the call to Comes_From_Source
-- against lines containing previously reported syntax errors.
elsif (Etyp = E_Loop
or else Etyp = E_Name
or else Etyp = E_Suspicious_Is
or else Etyp = E_Bad_Is)
elsif (Etyp = E_Loop or else
Etyp = E_Name or else
Etyp = E_Suspicious_Is or else
Etyp = E_Bad_Is)
and then Comes_From_Source (L)
then
return True;
......@@ -818,7 +818,6 @@ package body Endh is
procedure Output_End_Deleted is
begin
if End_Type = E_Loop then
Error_Msg_SC ("no LOOP for this `END LOOP`!");
......@@ -1042,9 +1041,9 @@ package body Endh is
-- We also reserve an end with a name before the end of file if the
-- name is the one we expect at the outer level.
if (Token = Tok_EOF
or else Token = Tok_With
or else Token = Tok_Separate)
if (Token = Tok_EOF or else
Token = Tok_With or else
Token = Tok_Separate)
and then End_Type >= E_Name
and then (not End_Labl_Present
or else Same_Label (End_Labl, Scope.Table (1).Labl))
......
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