From f8c59c050940a36f5aef5b1873bf253935c78fa7 Mon Sep 17 00:00:00 2001
From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Wed, 11 Jun 2014 14:55:03 +0200
Subject: [PATCH] [multiple changes]
2014-06-11 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb: Minor reformatting.
2014-06-11 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Check_Clause_Syntax): Add new
local variable Outputs. Account for the case where multiple
output items appear as an aggregate.
2014-06-11 Robert Dewar <dewar@adacore.com>
* sem_warn.adb (Output_Obsolescent_Entity_Warnings): Tag warning
with ?j? not ??.
2014-06-11 Ed Schonberg <schonberg@adacore.com>
* einfo.ads: Minor reformatting.
2014-06-11 Hristian Kirtchev <kirtchev@adacore.com>
* a-cbdlli.adb, a-cdlili.adb, a-cidlli.adb, a-crdlli.adb (Insert): Add
new variable First_Node. Update the position after all insertions have
taken place to First_Node.
2014-06-11 Robert Dewar <dewar@adacore.com>
* debug.adb: Remove debug flag -gnatd.1, no longer needed.
* layout.adb (Layout_Type): Remove test of -gnatd.1.
From-SVN: r211465
---
gcc/ada/ChangeLog | 60 ++++++++++++++++++++++++++++++++++++++++++++
gcc/ada/a-cbdlli.adb | 15 ++++++-----
gcc/ada/a-cdlili.adb | 22 +++++++++-------
gcc/ada/a-cidlli.adb | 11 +++++---
gcc/ada/a-crdlli.adb | 17 +++++++------
gcc/ada/debug.adb | 11 +-------
gcc/ada/einfo.ads | 5 ++--
gcc/ada/layout.adb | 4 ---
gcc/ada/sem_ch13.adb | 5 +++-
gcc/ada/sem_prag.adb | 30 ++++++++++++++++------
gcc/ada/sem_warn.adb | 4 +--
11 files changed, 132 insertions(+), 52 deletions(-)
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6371700a2979..57b9ce962a92 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,63 @@
+2014-06-11 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch13.adb: Minor reformatting.
+
+2014-06-11 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_prag.adb (Check_Clause_Syntax): Add new
+ local variable Outputs. Account for the case where multiple
+ output items appear as an aggregate.
+
+2014-06-11 Robert Dewar <dewar@adacore.com>
+
+ * sem_warn.adb (Output_Obsolescent_Entity_Warnings): Tag warning
+ with ?j? not ??.
+
+2014-06-11 Ed Schonberg <schonberg@adacore.com>
+
+ * einfo.ads: Minor reformatting.
+
+2014-06-11 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * a-cbdlli.adb, a-cdlili.adb, a-cidlli.adb, a-crdlli.adb (Insert): Add
+ new variable First_Node. Update the position after all insertions have
+ taken place to First_Node.
+
+2014-06-11 Robert Dewar <dewar@adacore.com>
+
+ * debug.adb: Remove debug flag -gnatd.1, no longer needed.
+ * layout.adb (Layout_Type): Remove test of -gnatd.1.
+
+2014-06-11 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch13.adb: Minor reformatting.
+
+2014-06-11 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_prag.adb (Check_Clause_Syntax): Add new
+ local variable Outputs. Account for the case where multiple
+ output items appear as an aggregate.
+
+2014-06-11 Robert Dewar <dewar@adacore.com>
+
+ * sem_warn.adb (Output_Obsolescent_Entity_Warnings): Tag warning
+ with ?j? not ??.
+
+2014-06-11 Ed Schonberg <schonberg@adacore.com>
+
+ * einfo.ads: Minor reformatting.
+
+2014-06-11 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * a-cbdlli.adb, a-cdlili.adb, a-cidlli.adb, a-crdlli.adb (Insert): Add
+ new variable First_Node. Update the position after all insertions have
+ taken place to First_Node.
+
+2014-06-11 Robert Dewar <dewar@adacore.com>
+
+ * debug.adb: Remove debug flag -gnatd.1, no longer needed.
+ * layout.adb (Layout_Type): Remove test of -gnatd.1.
+
2014-06-11 Thomas Quinot <quinot@adacore.com>
* freeze.ads: Minor reformatting.
diff --git a/gcc/ada/a-cbdlli.adb b/gcc/ada/a-cbdlli.adb
index d36239abc9c3..d0b6c12d5789 100644
--- a/gcc/ada/a-cbdlli.adb
+++ b/gcc/ada/a-cbdlli.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-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- --
@@ -1067,7 +1067,8 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
Position : out Cursor;
Count : Count_Type := 1)
is
- New_Node : Count_Type;
+ First_Node : Count_Type;
+ New_Node : Count_Type;
begin
if Before.Container /= null then
@@ -1094,13 +1095,15 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
end if;
Allocate (Container, New_Item, New_Node);
- Insert_Internal (Container, Before.Node, New_Node => New_Node);
- Position := Cursor'(Container'Unchecked_Access, Node => New_Node);
+ First_Node := New_Node;
+ Insert_Internal (Container, Before.Node, New_Node);
for Index in Count_Type'(2) .. Count loop
- Allocate (Container, New_Item, New_Node => New_Node);
- Insert_Internal (Container, Before.Node, New_Node => New_Node);
+ Allocate (Container, New_Item, New_Node);
+ Insert_Internal (Container, Before.Node, New_Node);
end loop;
+
+ Position := Cursor'(Container'Unchecked_Access, First_Node);
end Insert;
procedure Insert
diff --git a/gcc/ada/a-cdlili.adb b/gcc/ada/a-cdlili.adb
index 9bd8899e2dd1..eae608c05b22 100644
--- a/gcc/ada/a-cdlili.adb
+++ b/gcc/ada/a-cdlili.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-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- --
@@ -942,7 +942,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
Position : out Cursor;
Count : Count_Type := 1)
is
- New_Node : Node_Access;
+ First_Node : Node_Access;
+ New_Node : Node_Access;
begin
if Before.Container /= null then
@@ -966,15 +967,16 @@ package body Ada.Containers.Doubly_Linked_Lists is
"attempt to tamper with cursors (list is busy)";
else
- New_Node := new Node_Type'(New_Item, null, null);
+ New_Node := new Node_Type'(New_Item, null, null);
+ First_Node := New_Node;
Insert_Internal (Container, Before.Node, New_Node);
- Position := Cursor'(Container'Unchecked_Access, New_Node);
-
for J in 2 .. Count loop
New_Node := new Node_Type'(New_Item, null, null);
Insert_Internal (Container, Before.Node, New_Node);
end loop;
+
+ Position := Cursor'(Container'Unchecked_Access, First_Node);
end if;
end Insert;
@@ -996,7 +998,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
Position : out Cursor;
Count : Count_Type := 1)
is
- New_Node : Node_Access;
+ First_Node : Node_Access;
+ New_Node : Node_Access;
begin
if Before.Container /= null then
@@ -1021,15 +1024,16 @@ package body Ada.Containers.Doubly_Linked_Lists is
"attempt to tamper with cursors (list is busy)";
else
- New_Node := new Node_Type;
+ New_Node := new Node_Type;
+ First_Node := New_Node;
Insert_Internal (Container, Before.Node, New_Node);
- Position := Cursor'(Container'Unchecked_Access, New_Node);
-
for J in 2 .. Count loop
New_Node := new Node_Type;
Insert_Internal (Container, Before.Node, New_Node);
end loop;
+
+ Position := Cursor'(Container'Unchecked_Access, First_Node);
end if;
end Insert;
diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb
index f1fc3d3beb28..c41be78fcf3c 100644
--- a/gcc/ada/a-cidlli.adb
+++ b/gcc/ada/a-cidlli.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-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- --
@@ -983,7 +983,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
Position : out Cursor;
Count : Count_Type := 1)
is
- New_Node : Node_Access;
+ First_Node : Node_Access;
+ New_Node : Node_Access;
begin
if Before.Container /= null then
@@ -1026,7 +1027,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
Element : Element_Access := new Element_Type'(New_Item);
begin
- New_Node := new Node_Type'(Element, null, null);
+ New_Node := new Node_Type'(Element, null, null);
+ First_Node := New_Node;
exception
when others =>
@@ -1035,7 +1037,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
end;
Insert_Internal (Container, Before.Node, New_Node);
- Position := Cursor'(Container'Unchecked_Access, New_Node);
for J in 2 .. Count loop
declare
@@ -1050,6 +1051,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
Insert_Internal (Container, Before.Node, New_Node);
end loop;
+
+ Position := Cursor'(Container'Unchecked_Access, First_Node);
end Insert;
procedure Insert
diff --git a/gcc/ada/a-crdlli.adb b/gcc/ada/a-crdlli.adb
index 8d5fe9f5c565..0c6f5dccbb7a 100644
--- a/gcc/ada/a-crdlli.adb
+++ b/gcc/ada/a-crdlli.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-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- --
@@ -614,7 +614,8 @@ package body Ada.Containers.Restricted_Doubly_Linked_Lists is
Position : out Cursor;
Count : Count_Type := 1)
is
- J : Count_Type;
+ First_Node : Count_Type;
+ New_Node : Count_Type;
begin
if Before.Container /= null then
@@ -638,14 +639,16 @@ package body Ada.Containers.Restricted_Doubly_Linked_Lists is
-- raise Program_Error;
-- end if;
- Allocate (Container, New_Item, New_Node => J);
- Insert_Internal (Container, Before.Node, New_Node => J);
- Position := Cursor'(Container'Unrestricted_Access, Node => J);
+ Allocate (Container, New_Item, New_Node);
+ First_Node := New_Node;
+ Insert_Internal (Container, Before.Node, New_Node);
for Index in 2 .. Count loop
- Allocate (Container, New_Item, New_Node => J);
- Insert_Internal (Container, Before.Node, New_Node => J);
+ Allocate (Container, New_Item, New_Node);
+ Insert_Internal (Container, Before.Node, New_Node);
end loop;
+
+ Position := Cursor'(Container'Unrestricted_Access, First_Node);
end Insert;
procedure Insert
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 67a3e2ba4176..eaab4ffbebeb 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -155,7 +155,7 @@ package body Debug is
-- d8 Force opposite endianness in packed stuff
-- d9 Allow lock free implementation
- -- d.1 Activate thin-as-default for subprogram anonymous access types
+ -- d.1
-- d.2
-- d.3
-- d.4
@@ -733,15 +733,6 @@ package body Debug is
-- d9 This allows lock free implementation for protected objects
-- (see Exp_Ch9).
- -- d.1 Right now, we have a problem with anonymous access types in the
- -- context of subprogram formal parameter types and return types. The
- -- problem occurs when in one place (e.g. the subprogram spec), the
- -- designated type is unknown (e.g. private) and we choose to use a
- -- thin pointer representation. Then in another place, we can see the
- -- full declaration of the type, and choose a fat pointer. The fix is
- -- to always use thin pointers, but this is causing some other issues,
- -- so for now, this fix is under control of this debug flag.
-
------------------------------------------
-- Documentation for Binder Debug Flags --
------------------------------------------
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index cbe2ea92c8f3..fdadf4bc5fa7 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -4408,8 +4408,9 @@ package Einfo is
-- A special internal type used to label allocators and references to
-- objects using 'Reference. This is needed because special resolution
-- rules apply to these constructs. On the resolution pass, this type
- -- is always replaced by the actual access type, so Gigi should never
- -- see types with this Ekind.
+ -- is almost always replaced by the actual access type, but if the
+ -- context does not provide one Gigi can handle the Allocator_Type
+ -- itself as long as it has been frozen.
E_General_Access_Type,
-- An access type created by an access type declaration with the all
diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb
index 306d5db877df..f1a833bdb48f 100644
--- a/gcc/ada/layout.adb
+++ b/gcc/ada/layout.adb
@@ -2474,10 +2474,6 @@ package body Layout is
N_Function_Specification,
N_Procedure_Specification)
or else Ekind (Scope (E)) = E_Return_Statement)
-
- -- For now, debug flag -gnatd.1 must be set to enable this fix
-
- and then Debug_Flag_Dot_1
then
Init_Size (E, System_Address_Size);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 94cfd7187af6..3e1398ba1636 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -3214,7 +3214,7 @@ package body Sem_Ch13 is
Error_Msg_N ("stream subprogram must not be abstract", Expr);
return;
- -- Disable the following for now, until Polyorb issue is fixed.
+ -- Test for stream subprogram for interface type being non-null
elsif Is_Interface (U_Ent)
and then not Inside_A_Generic
@@ -3223,6 +3223,9 @@ package body Sem_Ch13 is
not Null_Present
(Specification
(Unit_Declaration_Node (Ultimate_Alias (Subp))))
+
+ -- Disable this test for now till Polyorb issue is fixed???
+
and then False
then
Error_Msg_N
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 622a2c0be20e..dc8b0e8cde10 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -24486,17 +24486,33 @@ package body Sem_Prag is
-------------------------
procedure Check_Clause_Syntax (Clause : Node_Id) is
- Input : Node_Id;
- Inputs : Node_Id;
- Output : Node_Id;
+ Input : Node_Id;
+ Inputs : Node_Id;
+ Output : Node_Id;
+ Outputs : Node_Id;
begin
-- Output items
- Output := First (Choices (Clause));
- while Present (Output) loop
- Check_Item_Syntax (Output);
- Next (Output);
+ Outputs := First (Choices (Clause));
+ while Present (Outputs) loop
+
+ -- Multiple output items
+
+ if Nkind (Outputs) = N_Aggregate then
+ Output := First (Expressions (Outputs));
+ while Present (Output) loop
+ Check_Item_Syntax (Output);
+ Next (Output);
+ end loop;
+
+ -- Single output item
+
+ else
+ Check_Item_Syntax (Outputs);
+ end if;
+
+ Next (Outputs);
end loop;
Inputs := Expression (Clause);
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index cc4337fd9e82..0043ef61b7fe 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -2924,10 +2924,10 @@ package body Sem_Warn is
if Nkind (P) = N_With_Clause then
if Ekind (E) = E_Package then
Error_Msg_NE
- ("??with of obsolescent package& declared#", N, E);
+ ("?j?with of obsolescent package& declared#", N, E);
elsif Ekind (E) = E_Procedure then
Error_Msg_NE
- ("??with of obsolescent procedure& declared#", N, E);
+ ("?j?with of obsolescent procedure& declared#", N, E);
else
Error_Msg_NE
("??with of obsolescent function& declared#", N, E);
--
GitLab