[multiple changes]

2014-02-24  Robert Dewar  <dewar@adacore.com>

	* a-direct.adb, sem_ch5.adb, a-cfdlli.adb, a-cfhase.adb, a-tags.adb,
	s-filatt.ads, a-cforma.adb, sem_ch6.adb, g-socthi-mingw.adb,
	a-cfhama.adb, a-cforse.adb, a-cofove.adb: Minor reformatting and code
	reorganization.

2014-02-24  Thomas Quinot  <quinot@adacore.com>

	* Make-generated.in (OSCONS_CPP, OSCONS_EXTRACT): Make sure
	that the source directory containing s-oscons-tmplt.c is on the
	include path, so that all internal header files are available.

From-SVN: r208081
This commit is contained in:
Arnaud Charlet 2014-02-24 17:58:19 +01:00
parent 2810861847
commit 1b31321b18
14 changed files with 173 additions and 138 deletions

View File

@ -1,3 +1,16 @@
2014-02-24 Robert Dewar <dewar@adacore.com>
* a-direct.adb, sem_ch5.adb, a-cfdlli.adb, a-cfhase.adb, a-tags.adb,
s-filatt.ads, a-cforma.adb, sem_ch6.adb, g-socthi-mingw.adb,
a-cfhama.adb, a-cforse.adb, a-cofove.adb: Minor reformatting and code
reorganization.
2014-02-24 Thomas Quinot <quinot@adacore.com>
* Make-generated.in (OSCONS_CPP, OSCONS_EXTRACT): Make sure
that the source directory containing s-oscons-tmplt.c is on the
include path, so that all internal header files are available.
2014-02-24 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Loop_Parameter_Specification): If the

View File

@ -68,26 +68,30 @@ $(ADA_GEN_SUBDIR)/stamp-nmake: $(ADA_GEN_SUBDIR)/sinfo.ads $(ADA_GEN_SUBDIR)/nma
# GCC_FOR_TARGET has paths relative to the gcc directory, so we need to adjust
# for running it from $(ADA_GEN_SUBDIR)/bldtools/oscons
OSCONS_CC=`echo "$(GCC_FOR_TARGET)" \
| sed -e 's^\./xgcc^../../../xgcc^' -e 's^-B./^-B../../../^'`
OSCONS_CC=$(subst ./xgcc,../../../xgcc,$(subst -B./, -B../../../,$(GCC_FOR_TARGET)))
OSCONS_SRCDIR=$${_oscons_srcdir}
OSCONS_CPP=$(OSCONS_CC) $(GNATLIBCFLAGS) -E -C \
-DTARGET=\"$(target)\" s-oscons-tmplt.c > s-oscons-tmplt.i
OSCONS_EXTRACT=$(OSCONS_CC) -S s-oscons-tmplt.i
-DTARGET=\"$(target)\" -I$(OSCONS_SRCDIR) s-oscons-tmplt.c > s-oscons-tmplt.i
OSCONS_EXTRACT=$(OSCONS_CC) -I$(OSCONS_SRCDIR) -S s-oscons-tmplt.i
# Note: if you need to build with a non-GNU compiler, you could adapt the
# following definitions (written for VMS DEC-C)
#OSCONS_CPP=../../../$(DECC) -E /comment=as_is -DNATIVE \
# -DTARGET='""$(target)""' s-oscons-tmplt.c
# -DTARGET='""$(target)""' -I$(OSCONS_SRCDIR) s-oscons-tmplt.c
#
#OSCONS_EXTRACT=../../../$(DECC) -DNATIVE \
# -DTARGET='""$(target)""' s-oscons-tmplt.c ; \
# -DTARGET='""$(target)""' -I$(OSCONS_SRCDIR) s-oscons-tmplt.c ; \
# ld -o s-oscons-tmplt.exe s-oscons-tmplt.obj; \
# ./s-oscons-tmplt.exe > s-oscons-tmplt.s
$(ADA_GEN_SUBDIR)/s-oscons.ads : $(ADA_GEN_SUBDIR)/s-oscons-tmplt.c $(ADA_GEN_SUBDIR)/gsocket.h $(ADA_GEN_SUBDIR)/adaint.h $(ADA_GEN_SUBDIR)/xoscons.adb $(ADA_GEN_SUBDIR)/xutil.ads $(ADA_GEN_SUBDIR)/xutil.adb
# Note: the first dependency of s-oscons.ads *must* remain s-oscons-tmplt.c, as
# we use $(<D) to locate the main ada/ source directory and pass it to OSCONS_CPP
# as a -I argument.
$(ADA_GEN_SUBDIR)/s-oscons.ads : $(ADA_GEN_SUBDIR)/s-oscons-tmplt.c $(ADA_GEN_SUBDIR)/xoscons.adb $(ADA_GEN_SUBDIR)/xutil.ads $(ADA_GEN_SUBDIR)/xutil.adb
-$(MKDIR) $(ADA_GEN_SUBDIR)/bldtools/oscons
$(RM) $(addprefix $(ADA_GEN_SUBDIR)/bldtools/oscons/,$(notdir $^))
$(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/oscons
_oscons_srcdir=`cd $(<D) && pwd` ; \
(cd $(ADA_GEN_SUBDIR)/bldtools/oscons ; gnatmake -q xoscons ; \
$(RM) s-oscons-tmplt.i s-oscons-tmplt.s ; \
$(OSCONS_CPP) ; \

View File

@ -507,7 +507,8 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
function First_To_Previous
(Container : List;
Current : Cursor) return List is
Current : Cursor) return List
is
Curs : Cursor := Current;
C : List (Container.Capacity) := Copy (Container, Container.Capacity);
Node : Count_Type;
@ -515,19 +516,19 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
begin
if Curs = No_Element then
return C;
end if;
if not Has_Element (Container, Curs) then
elsif not Has_Element (Container, Curs) then
raise Constraint_Error;
else
while Curs.Node /= 0 loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end if;
while Curs.Node /= 0 loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end First_To_Previous;
----------
@ -907,6 +908,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
if Container.Last = 0 then
return No_Element;
end if;
return (Node => Container.Last);
end Last;
@ -1192,16 +1194,18 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
if Container.Length = 0 then
return No_Element;
else
while CFirst /= 0 loop
if Container.Nodes (CFirst).Element = Item then
return (Node => CFirst);
else
CFirst := Container.Nodes (CFirst).Prev;
end if;
end loop;
return No_Element;
end if;
while CFirst /= 0 loop
if Container.Nodes (CFirst).Element = Item then
return (Node => CFirst);
end if;
CFirst := Container.Nodes (CFirst).Prev;
end loop;
return No_Element;
end Reverse_Find;
------------

View File

@ -242,26 +242,26 @@ package body Ada.Containers.Formal_Hashed_Maps is
function Current_To_Last (Container : Map; Current : Cursor) return Map is
Curs : Cursor := First (Container);
C : Map (Container.Capacity, Container.Modulus) :=
Copy (Container, Container.Capacity);
Copy (Container, Container.Capacity);
Node : Count_Type;
begin
if Curs = No_Element then
Clear (C);
return C;
end if;
if Current /= No_Element and not Has_Element (Container, Current) then
elsif Current /= No_Element and not Has_Element (Container, Current) then
raise Constraint_Error;
else
while Curs.Node /= Current.Node loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end if;
while Curs.Node /= Current.Node loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end Current_To_Last;
---------------------
@ -467,7 +467,7 @@ package body Ada.Containers.Formal_Hashed_Maps is
Current : Cursor) return Map is
Curs : Cursor;
C : Map (Container.Capacity, Container.Modulus) :=
Copy (Container, Container.Capacity);
Copy (Container, Container.Capacity);
Node : Count_Type;
begin
@ -475,19 +475,19 @@ package body Ada.Containers.Formal_Hashed_Maps is
if Curs = No_Element then
return C;
end if;
if not Has_Element (Container, Curs) then
elsif not Has_Element (Container, Curs) then
raise Constraint_Error;
else
while Curs.Node /= 0 loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end if;
while Curs.Node /= 0 loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end First_To_Previous;
----------

View File

@ -268,26 +268,26 @@ package body Ada.Containers.Formal_Hashed_Sets is
function Current_To_Last (Container : Set; Current : Cursor) return Set is
Curs : Cursor := First (Container);
C : Set (Container.Capacity, Container.Modulus) :=
Copy (Container, Container.Capacity);
Copy (Container, Container.Capacity);
Node : Count_Type;
begin
if Curs = No_Element then
Clear (C);
return C;
end if;
if Current /= No_Element and not Has_Element (Container, Current) then
elsif Current /= No_Element and not Has_Element (Container, Current) then
raise Constraint_Error;
else
while Curs.Node /= Current.Node loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end if;
while Curs.Node /= Current.Node loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end Current_To_Last;
---------------------
@ -661,28 +661,29 @@ package body Ada.Containers.Formal_Hashed_Sets is
function First_To_Previous
(Container : Set;
Current : Cursor) return Set is
Current : Cursor) return Set
is
Curs : Cursor := Current;
C : Set (Container.Capacity, Container.Modulus) :=
Copy (Container, Container.Capacity);
Copy (Container, Container.Capacity);
Node : Count_Type;
begin
if Curs = No_Element then
return C;
end if;
if not Has_Element (Container, Curs) then
elsif not Has_Element (Container, Curs) then
raise Constraint_Error;
else
while Curs.Node /= 0 loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end if;
while Curs.Node /= 0 loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end First_To_Previous;
----------

View File

@ -336,18 +336,18 @@ package body Ada.Containers.Formal_Ordered_Maps is
Clear (C);
return C;
end if;
if Current /= No_Element and not Has_Element (Container, Current) then
elsif Current /= No_Element and not Has_Element (Container, Current) then
raise Constraint_Error;
else
while Curs.Node /= Current.Node loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end if;
while Curs.Node /= Current.Node loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end Current_To_Last;
------------
@ -524,7 +524,8 @@ package body Ada.Containers.Formal_Ordered_Maps is
function First_To_Previous
(Container : Map;
Current : Cursor) return Map is
Current : Cursor) return Map
is
Curs : Cursor := Current;
C : Map (Container.Capacity) := Copy (Container, Container.Capacity);
Node : Count_Type;
@ -532,19 +533,19 @@ package body Ada.Containers.Formal_Ordered_Maps is
begin
if Curs = No_Element then
return C;
end if;
if not Has_Element (Container, Curs) then
elsif not Has_Element (Container, Curs) then
raise Constraint_Error;
else
while Curs.Node /= 0 loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end if;
while Curs.Node /= 0 loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end First_To_Previous;
-----------

View File

@ -600,7 +600,8 @@ package body Ada.Containers.Formal_Ordered_Sets is
function First_To_Previous
(Container : Set;
Current : Cursor) return Set is
Current : Cursor) return Set
is
Curs : Cursor := Current;
C : Set (Container.Capacity) := Copy (Container, Container.Capacity);
Node : Count_Type;
@ -608,19 +609,19 @@ package body Ada.Containers.Formal_Ordered_Sets is
begin
if Curs = No_Element then
return C;
end if;
if not Has_Element (Container, Curs) then
elsif not Has_Element (Container, Curs) then
raise Constraint_Error;
else
while Curs.Node /= 0 loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end if;
while Curs.Node /= 0 loop
Node := Curs.Node;
Delete (C, Curs);
Curs := Next (Container, (Node => Node));
end loop;
return C;
end First_To_Previous;
-----------

View File

@ -319,24 +319,25 @@ package body Ada.Containers.Formal_Vectors is
function Current_To_Last
(Container : Vector;
Current : Cursor) return Vector is
Current : Cursor) return Vector
is
C : Vector (Container.Capacity) := Copy (Container, Container.Capacity);
begin
if Current = No_Element then
Clear (C);
return C;
end if;
if not Has_Element (Container, Current) then
elsif not Has_Element (Container, Current) then
raise Constraint_Error;
else
while C.Last /= Container.Last - Current.Index + 1 loop
Delete_First (C);
end loop;
return C;
end if;
while C.Last /= Container.Last - Current.Index + 1 loop
Delete_First (C);
end loop;
return C;
end Current_To_Last;
------------
@ -610,22 +611,24 @@ package body Ada.Containers.Formal_Vectors is
function First_To_Previous
(Container : Vector;
Current : Cursor) return Vector is
Current : Cursor) return Vector
is
C : Vector (Container.Capacity) := Copy (Container, Container.Capacity);
begin
if Current = No_Element then
return C;
end if;
if not Has_Element (Container, Current) then
elsif not Has_Element (Container, Current) then
raise Constraint_Error;
end if;
while C.Last /= Current.Index - 1 loop
Delete_Last (C);
end loop;
return C;
else
while C.Last /= Current.Index - 1 loop
Delete_Last (C);
end loop;
return C;
end if;
end First_To_Previous;
---------------------

View File

@ -759,10 +759,11 @@ package body Ada.Directories is
if Match (Name (1 .. Last), Search.Value.Pattern) then
declare
C_Full_Name : constant String :=
Compose (To_String (Search.Value.Name), Name (1 .. Last))
& ASCII.NUL;
Full_Name : String renames C_Full_Name
(C_Full_Name'First .. C_Full_Name'Last - 1);
Compose (To_String (Search.Value.Name),
Name (1 .. Last)) & ASCII.NUL;
Full_Name : String renames
C_Full_Name
(C_Full_Name'First .. C_Full_Name'Last - 1);
Found : Boolean := False;
Attr : aliased File_Attributes;
Exists : Integer;

View File

@ -283,9 +283,9 @@ package body Ada.Tags is
procedure Set_HT_Link (T : Tag; Next : Tag) is
TSD_Ptr : constant Addr_Ptr :=
To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
TSD : constant Type_Specific_Data_Ptr :=
To_Type_Specific_Data_Ptr (TSD_Ptr.all);
To_Type_Specific_Data_Ptr (TSD_Ptr.all);
begin
TSD.HT_Link.all := Next;
end Set_HT_Link;
@ -309,8 +309,9 @@ package body Ada.Tags is
T : Tag;
E_Tag_Len : constant Integer :=
Integer (strlen (TSD.External_Tag.all'Address));
E_Tag : String (1 .. E_Tag_Len);
Integer (strlen (TSD.External_Tag.all'Address));
E_Tag : String (1 .. E_Tag_Len);
for E_Tag'Address use TSD.External_Tag.all'Address;
pragma Import (Ada, E_Tag);
@ -344,13 +345,12 @@ package body Ada.Tags is
function Descendant_Tag (External : String; Ancestor : Tag) return Tag is
Int_Tag : constant Tag := Internal_Tag (External);
begin
if not Is_Descendant_At_Same_Level (Int_Tag, Ancestor) then
raise Tag_Error;
else
return Int_Tag;
end if;
return Int_Tag;
end Descendant_Tag;
--------------

View File

@ -628,6 +628,7 @@ package body GNAT.Sockets.Thin is
when others => Errm := N_OTHERS;
end case;
return Value (Errm);
end Socket_Error_Message;

View File

@ -39,23 +39,27 @@ package System.File_Attributes is
type File_Attributes is private;
procedure Reset_Attributes (A : access File_Attributes);
function Error_Attributes (A : access File_Attributes) return Integer;
function File_Exists_Attr
(N : System.Address;
A : access File_Attributes) return Integer;
function Is_Regular_File_Attr
(N : System.Address;
A : access File_Attributes) return Integer;
function Is_Directory_Attr
(N : System.Address;
A : access File_Attributes) return Integer;
private
package SOSC renames System.OS_Constants;
type File_Attributes is new System.Storage_Elements.Storage_Array
(1 .. SOSC.SIZEOF_struct_file_attributes);
type File_Attributes is new
System.Storage_Elements.Storage_Array
(1 .. SOSC.SIZEOF_struct_file_attributes);
for File_Attributes'Alignment use Standard'Maximum_Alignment;
pragma Import (C, Reset_Attributes, "__gnat_reset_attributes");

View File

@ -2376,7 +2376,7 @@ package body Sem_Ch5 is
or else (Is_Entity_Name (DS_Copy)
and then not Is_Type (Entity (DS_Copy)))
or else (Nkind (DS_Copy) = N_Attribute_Reference
and then Attribute_Name (DS_Copy) = Name_Old)
and then Attribute_Name (DS_Copy) = Name_Old)
then
-- This is an iterator specification. Rewrite it as such and
-- analyze it to capture function calls that may require

View File

@ -372,11 +372,13 @@ package body Sem_Ch6 is
-- An expression function that is a completion freezes the
-- expression. This means freezing the return type, and if it is
-- an access type, freezing its designated type as well.
-- Note that we cannot defer this freezing to the analysis of the
-- expression itself, because a freeze node might appear in a
-- nested scope, leading to an elaboration order issue in gigi.
-- expression itself, because a freeze node might appear in a nested
-- scope, leading to an elaboration order issue in gigi.
Freeze_Before (N, Etype (Prev));
if Is_Access_Type (Etype (Prev)) then
Freeze_Before (N, Designated_Type (Etype (Prev)));
end if;