[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
This commit is contained in:
Arnaud Charlet 2014-06-11 14:55:03 +02:00
parent 3e65bfab4a
commit f8c59c0509
11 changed files with 132 additions and 52 deletions

View File

@ -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.

View File

@ -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

View File

@ -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;

View File

@ -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

View File

@ -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

View File

@ -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 --
------------------------------------------

View File

@ -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

View File

@ -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);

View File

@ -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

View File

@ -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);

View File

@ -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);