+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.
-- --
-- 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- --
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
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
-- --
-- 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- --
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
"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;
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
"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;
-- --
-- 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- --
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
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 =>
end;
Insert_Internal (Container, Before.Node, New_Node);
- Position := Cursor'(Container'Unchecked_Access, New_Node);
for J in 2 .. Count loop
declare
Insert_Internal (Container, Before.Node, New_Node);
end loop;
+
+ Position := Cursor'(Container'Unchecked_Access, First_Node);
end Insert;
procedure Insert
-- --
-- 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- --
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
-- 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
-- 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
-- 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 --
------------------------------------------
-- 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
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);
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
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
-------------------------
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);
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);
projects / gcc.git / commitdiff