+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
# 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) ; \
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;
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;
- end if;
- while Curs.Node /= 0 loop
- Node := Curs.Node;
- Delete (C, Curs);
- Curs := Next (Container, (Node => Node));
- end loop;
+ else
+ while Curs.Node /= 0 loop
+ Node := Curs.Node;
+ Delete (C, Curs);
+ Curs := Next (Container, (Node => Node));
+ end loop;
- return C;
+ return C;
+ end if;
end First_To_Previous;
----------
if Container.Last = 0 then
return No_Element;
end if;
+
return (Node => Container.Last);
end Last;
if Container.Length = 0 then
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;
+ 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;
+ return No_Element;
+ end if;
end Reverse_Find;
------------
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;
- end if;
- while Curs.Node /= Current.Node loop
- Node := Curs.Node;
- Delete (C, Curs);
- Curs := Next (Container, (Node => Node));
- end loop;
+ else
+ while Curs.Node /= Current.Node loop
+ Node := Curs.Node;
+ Delete (C, Curs);
+ Curs := Next (Container, (Node => Node));
+ end loop;
- return C;
+ return C;
+ end if;
end Current_To_Last;
---------------------
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
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;
- end if;
- while Curs.Node /= 0 loop
- Node := Curs.Node;
- Delete (C, Curs);
- Curs := Next (Container, (Node => Node));
- end loop;
+ else
+ while Curs.Node /= 0 loop
+ Node := Curs.Node;
+ Delete (C, Curs);
+ Curs := Next (Container, (Node => Node));
+ end loop;
- return C;
+ return C;
+ end if;
end First_To_Previous;
----------
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;
- end if;
- while Curs.Node /= Current.Node loop
- Node := Curs.Node;
- Delete (C, Curs);
- Curs := Next (Container, (Node => Node));
- end loop;
+ else
+ while Curs.Node /= Current.Node loop
+ Node := Curs.Node;
+ Delete (C, Curs);
+ Curs := Next (Container, (Node => Node));
+ end loop;
- return C;
+ return C;
+ end if;
end Current_To_Last;
---------------------
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;
- end if;
- while Curs.Node /= 0 loop
- Node := Curs.Node;
- Delete (C, Curs);
- Curs := Next (Container, (Node => Node));
- end loop;
+ else
+ while Curs.Node /= 0 loop
+ Node := Curs.Node;
+ Delete (C, Curs);
+ Curs := Next (Container, (Node => Node));
+ end loop;
- return C;
+ return C;
+ end if;
end First_To_Previous;
----------
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;
- end if;
- while Curs.Node /= Current.Node loop
- Node := Curs.Node;
- Delete (C, Curs);
- Curs := Next (Container, (Node => Node));
- end loop;
+ else
+ while Curs.Node /= Current.Node loop
+ Node := Curs.Node;
+ Delete (C, Curs);
+ Curs := Next (Container, (Node => Node));
+ end loop;
- return C;
+ return C;
+ end if;
end Current_To_Last;
------------
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;
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;
- end if;
- while Curs.Node /= 0 loop
- Node := Curs.Node;
- Delete (C, Curs);
- Curs := Next (Container, (Node => Node));
- end loop;
+ else
+ while Curs.Node /= 0 loop
+ Node := Curs.Node;
+ Delete (C, Curs);
+ Curs := Next (Container, (Node => Node));
+ end loop;
- return C;
+ return C;
+ end if;
end First_To_Previous;
-----------
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;
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;
- end if;
- while Curs.Node /= 0 loop
- Node := Curs.Node;
- Delete (C, Curs);
- Curs := Next (Container, (Node => Node));
- end loop;
+ else
+ while Curs.Node /= 0 loop
+ Node := Curs.Node;
+ Delete (C, Curs);
+ Curs := Next (Container, (Node => Node));
+ end loop;
- return C;
+ return C;
+ end if;
end First_To_Previous;
-----------
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;
- end if;
- while C.Last /= Container.Last - Current.Index + 1 loop
- Delete_First (C);
- end loop;
+ else
+ while C.Last /= Container.Last - Current.Index + 1 loop
+ Delete_First (C);
+ end loop;
- return C;
+ return C;
+ end if;
end Current_To_Last;
------------
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;
---------------------
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;
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;
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);
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;
--------------
when others => Errm := N_OTHERS;
end case;
+
return Value (Errm);
end Socket_Error_Message;
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");
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
-- 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;