Skip to content

R
riscv-gcc-1
Commit 9686dbc7 by Arnaud Charlet
Options

[multiple changes] 

2013-04-12  Robert Dewar  <dewar@adacore.com>

	* sem.ads, opt.ads: Minor comment edits.
	* sem_warn.adb, sem_ch6.adb: Minor reformatting.

2013-04-12  Claire Dross  <dross@adacore.com>

	* a-cfdlli.adb a-cfdlli.ads (List, Not_No_Element, Iterate,
	Reverse_Iterate, Query_Element, Update_Element, Read, Write): Removed,
	not suitable for formal analysis.

2013-04-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Abstract_State): Use Defining entity
	to locate package entity, which may be a child unit.

2013-04-12  Thomas Quinot  <quinot@adacore.com>

	* g-socket.adb, g-socket.ads (Connect_Socket, version with timeout): If
	the specified timeout is 0, do not attempt to determine whether the
	connection succeeded.

2013-04-12  Doug Rupp  <rupp@adacore.com>

	* s-fileio.adb (Form_RMS Context_Key): Fix some thinkos.

From-SVN: r197904
parent 7a1f094d
Showing with 70 additions and 132 deletions
gcc/ada/ChangeLog
2013-04-12 Robert Dewar <dewar@adacore.com>
* sem.ads, opt.ads: Minor comment edits.
* sem_warn.adb, sem_ch6.adb: Minor reformatting.
2013-04-12 Claire Dross <dross@adacore.com>
* a-cfdlli.adb a-cfdlli.ads (List, Not_No_Element, Iterate,
Reverse_Iterate, Query_Element, Update_Element, Read, Write): Removed,
not suitable for formal analysis.
2013-04-12 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Analyze_Abstract_State): Use Defining entity
to locate package entity, which may be a child unit.
2013-04-12 Thomas Quinot <quinot@adacore.com>
* g-socket.adb, g-socket.ads (Connect_Socket, version with timeout): If
the specified timeout is 0, do not attempt to determine whether the
connection succeeded.
2013-04-12 Doug Rupp <rupp@adacore.com>
* s-fileio.adb (Form_RMS Context_Key): Fix some thinkos.
2013-04-12 Doug Rupp <rupp@adacore.com>
* s-fileio.adb: Minor reformatting.
......
gcc/ada/a-cfdlli.ads
......@@ -51,9 +51,9 @@
-- See detailed specifications for these subprograms
private with Ada.Streams;
private with Ada.Finalization;
with Ada.Iterator_Interfaces;
-- private with Ada.Streams;
-- private with Ada.Finalization;
-- with Ada.Iterator_Interfaces;
generic
type Element_Type is private;
......@@ -64,11 +64,8 @@ generic
package Ada.Containers.Formal_Doubly_Linked_Lists is
pragma Pure;
type List (Capacity : Count_Type) is tagged private with
Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
-- pragma Preelaborable_Initialization (List);
type List (Capacity : Count_Type) is private;
pragma Preelaborable_Initialization (List);
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
......@@ -77,17 +74,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is
No_Element : constant Cursor;
function Not_No_Element (Position : Cursor) return Boolean;
package List_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor => Cursor, Has_Element => Not_No_Element);
function Iterate (Container : List; Start : Cursor)
return List_Iterator_Interfaces.Reversible_Iterator'Class;
function Iterate (Container : List)
return List_Iterator_Interfaces.Reversible_Iterator'Class;
function "=" (Left, Right : List) return Boolean;
function Length (Container : List) return Count_Type;
......@@ -107,15 +93,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element
(Container : List; Position : Cursor;
Process : not null access procedure (Element : Element_Type));
procedure Update_Element
(Container : in out List;
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
procedure Move (Target : in out List; Source : in out List);
procedure Insert
......@@ -218,16 +195,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is
function Has_Element (Container : List; Position : Cursor) return Boolean;
procedure Iterate
(Container : List;
Process :
not null access procedure (Container : List; Position : Cursor));
procedure Reverse_Iterate
(Container : List;
Process :
not null access procedure (Container : List; Position : Cursor));
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is
......@@ -240,15 +207,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is
end Generic_Sorting;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
function Constant_Reference
(Container : List; -- SHOULD BE ALIASED ???
Position : Cursor) return Constant_Reference_Type;
function Strict_Equal (Left, Right : List) return Boolean;
-- Strict_Equal returns True if the containers are physically equal, i.e.
-- they are structurally equal (function "=" returns True) and that they
......@@ -268,7 +226,7 @@ private
type Node_Type is record
Prev : Count_Type'Base := -1;
Next : Count_Type;
Element : aliased Element_Type;
Element : Element_Type;
end record;
function "=" (L, R : Node_Type) return Boolean is abstract;
......@@ -279,73 +237,17 @@ private
type List (Capacity : Count_Type) is tagged record
Nodes : Node_Array (1 .. Capacity) := (others => <>);
Free : Count_Type'Base := -1;
Busy : Natural := 0;
Lock : Natural := 0;
Length : Count_Type := 0;
First : Count_Type := 0;
Last : Count_Type := 0;
end record;
use Ada.Streams;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out List);
for List'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : List);
for List'Write use Write;
type List_Access is access all List;
for List_Access'Storage_Size use 0;
type Cursor is record
Node : Count_Type := 0;
end record;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is null record;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
Empty_List : constant List := (0, others => <>);
No_Element : constant Cursor := (Node => 0);
use Ada.Finalization;
type Iterator is new Limited_Controlled and
List_Iterator_Interfaces.Reversible_Iterator with
record
Container : List_Access;
Node : Count_Type;
end record;
overriding procedure Finalize (Object : in out Iterator);
overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
overriding function Next
(Object : Iterator;
Position : Cursor) return Cursor;
overriding function Previous
(Object : Iterator;
Position : Cursor) return Cursor;
end Ada.Containers.Formal_Doubly_Linked_Lists;
gcc/ada/g-socket.adb
......@@ -516,10 +516,6 @@ package body GNAT.Sockets is
(Selector, R_Socket_Set, W_Socket_Set, E_Socket_Set, Status, Timeout);
end Check_Selector;
--------------------
-- Check_Selector --
--------------------
procedure Check_Selector
(Selector : Selector_Type;
R_Socket_Set : in out Socket_Set_Type;
......@@ -739,12 +735,17 @@ package body GNAT.Sockets is
-- Wait for socket to become available for writing
Wait_On_Socket
(Socket => Socket,
For_Read => False,
Timeout => Timeout,
Selector => Selector,
Status => Status);
if Timeout = 0.0 then
Status := Expired;
else
Wait_On_Socket
(Socket => Socket,
For_Read => False,
Timeout => Timeout,
Selector => Selector,
Status => Status);
end if;
-- Check error condition (the asynchronous connect may have terminated
-- with an error, e.g. ECONNREFUSED) if select(2) completed.
......
gcc/ada/g-socket.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2011, AdaCore --
-- Copyright (C) 2001-2013, AdaCore --
-- --
-- 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- --
......@@ -858,7 +858,9 @@ package GNAT.Sockets is
-- whether the operation completed successfully, timed out, or was aborted.
-- If Selector is not null, the designated selector is used to wait for the
-- socket to become available, else a private selector object is created
-- by this procedure and destroyed before it returns.
-- by this procedure and destroyed before it returns. If Timeout is 0.0,
-- no attempt is made to detect whether the connection has succeeded; it
-- is up to the user to determine this using Check_Selector later on.
procedure Control_Socket
(Socket : Socket_Type;
......
gcc/ada/opt.ads
......@@ -597,7 +597,7 @@ package Opt is
Fast_Math : Boolean := False;
-- GNAT
-- Indicates the current setting of Fast_Math mode, as set by the use
-- of a Fast_Math pragma (set on by Fast_Math (On)).
-- of a Fast_Math pragma (set True by Fast_Math (On)).
Float_Format : Character := ' ';
-- GNAT
......@@ -1274,8 +1274,8 @@ package Opt is
-- GNAT
-- Set True if Style_Check was set for the main unit. This is used to
-- renable style checks for units in the mail extended source that get
-- with'ed indirectly. It is set on by use of either the -gnatg or -gnaty
-- switches, but not by use of the Style_Checks pragma.
-- with'ed indirectly. It is set True by use of either the -gnatg or
-- -gnaty switches, but not by use of the Style_Checks pragma.
Suppress_All_Inlining : Boolean := False;
-- GNAT
......@@ -1411,7 +1411,7 @@ package Opt is
-- Flag set to force attempt at semantic analysis, even if parser errors
-- occur. This will probably cause blowups at this stage in the game. On
-- the other hand, most such blowups will be caught cleanly and simply
-- say compilation abandoned. This flag is set on by -gnatq or -gnatQ.
-- say compilation abandoned. This flag is set True by -gnatq or -gnatQ.
Unchecked_Shared_Lib_Imports : Boolean := False;
-- GPRBUILD
......
gcc/ada/s-fileio.adb
......@@ -696,12 +696,14 @@ package body System.File_IO is
Klen := KImage'Length;
To_Lower (KImage);
if Form (Index .. Index + Klen - 1) = KImage then
if Index + Klen - 1 <= Form'Last and then
Form (Index .. Index + Klen - 1) = KImage
then
case Parm is
when Force_Record_Mode =>
VMS_Form (Pos) := '"';
Pos := Pos + 1;
VMS_Form (Pos .. Pos + 7) := "ctx=rec";
VMS_Form (Pos .. Pos + 6) := "ctx=rec";
Pos := Pos + 7;
VMS_Form (Pos) := '"';
Pos := Pos + 1;
......@@ -711,7 +713,7 @@ package body System.File_IO is
when Force_Stream_Mode =>
VMS_Form (Pos) := '"';
Pos := Pos + 1;
VMS_Form (Pos .. Pos + 7) := "ctx=stm";
VMS_Form (Pos .. Pos + 6) := "ctx=stm";
Pos := Pos + 7;
VMS_Form (Pos) := '"';
Pos := Pos + 1;
......
gcc/ada/sem.ads
......@@ -429,11 +429,11 @@ package Sem is
-- compilation unit. These sections are separated by distinct occurrences
-- of package Standard. The currently active section of the scope stack
-- goes from the current scope to the first (innermost) occurrence of
-- Standard, which is additionally marked with the flag
-- Is_Active_Stack_Base. The basic visibility routine (Find_Direct_Name, in
-- Sem_Ch8) uses this contiguous section of the scope stack to determine
-- whether a given entity is or is not visible at a point. In_Open_Scopes
-- only examines the currently active section of the scope stack.
-- Standard, which is additionally marked with flag Is_Active_Stack_Base.
-- The basic visibility routine (Find_Direct_Name, in Sem_Ch8) uses this
-- contiguous section of the scope stack to determine whether a given
-- entity is or is not visible at a point. In_Open_Scopes only examines
-- the currently active section of the scope stack.
-- Similar complications arise when processing child instances. These
-- must be compiled in the context of parent instances, and therefore the
......@@ -464,7 +464,12 @@ package Sem is
-- Save contents of Local_Suppress_Stack on entry to restore on exit
Save_Check_Policy_List : Node_Id;
-- Save contents of Check_Policy_List on entry to restore on exit
-- Save contents of Check_Policy_List on entry to restore on exit. The
-- Check_Policy pragmas are chained with Check_Policy_List pointing to
-- the most recent entry. This list is searched starting here, so that
-- the search finds the most recent appicable entry. When we restore
-- Check_Policy_List on exit from the scope, the effect is to remove
-- all entries set in the scope being exited.
Save_Default_Storage_Pool : Node_Id;
-- Save contents of Default_Storage_Pool on entry to restore on exit
......
gcc/ada/sem_ch6.adb
......@@ -12242,7 +12242,7 @@ package body Sem_Ch6 is
while Present (Prag) loop
if Nkind (Prag) = N_Pragma then
-- If pragma, capture if enabled postcondition, else ignore
-- If pragma, capture if postconditions enabled, else ignore
if Pragma_Name (Prag) = Name_Postcondition
and then Check_Enabled (Name_Postcondition)
......
gcc/ada/sem_prag.adb
......@@ -7012,7 +7012,7 @@ package body Sem_Prag is
return;
end if;
Pack_Id := Defining_Unit_Name (Specification (Par));
Pack_Id := Defining_Entity (Par);
State := Expression (Arg1);
-- Multiple abstract states appear as an aggregate
......
gcc/ada/sem_warn.adb
......@@ -645,7 +645,7 @@ package body Sem_Warn is
end if;
-- If an unconditional exit statement is the last statement in the
-- loop assume that no warning is needed. without any attempt at
-- loop, assume that no warning is needed, without any attempt at
-- checking whether the exit is reachable.
elsif Exit_Stmt = Last (Statements (Loop_Statement)) then
......
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