-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
procedure Abort_Handler (Sig : Signal) is
pragma Warnings (Off, Sig);
- T : Task_ID := Self;
+ T : constant Task_ID := Self;
Result : Interfaces.C.int;
Old_Set : aliased sigset_t;
+2004-01-21 Javier Miranda <miranda@gnat.com>
+
+ * exp_aggr.adb (Build_Record_Aggr_Code): Do not build the master
+ entity if already built in the current scope.
+
+ * exp_ch9.adb (Build_Master_Entity): Do not set the has_master_entity
+ reminder in internal scopes. Required for nested limited aggregates.
+
+2004-01-21 Doug Rupp <rupp@gnat.com>
+
+ * Makefile.in (hyphen): New variable, default value '-'. Set to '_' on
+ VMS. Replace all occurences of libgnat- and libgnarl- with
+ libgnat$(hyphen) and libgnarl$(hyphen).
+ Fixed shared library build problem on VMS.
+
+2004-01-21 Robert Dewar <dewar@gnat.com>
+
+ * mlib-prj.adb: Minor reformatting
+
+2004-01-21 Thomas Quinot <quinot@act-europe.fr>
+
+ * prj-tree.adb, 7staprop.adb, vms_conv.adb, xr_tabls.adb: Add missing
+ 'constant' keywords for declaration of pointers that are not modified.
+
+ * exp_pakd.adb: Fix English in comment.
+
+2004-01-21 Ed Schonberg <schonberg@gnat.com>
+
+ PR ada/10889
+ * sem_ch3.adb (Analyze_Subtype_Declaration): For an array subtype,
+ copy all attributes of the parent, including the foreign language
+ convention.
+
+2004-01-21 Sergey Rybin <rybin@act-europe.fr>
+
+ PR ada/10565
+ * sem_ch9.adb (Analyze_Delay_Alternative): Add expression type check
+ for 'delay until' statement.
+
2004-01-20 Kelley Cook <kcook@gcc.gnu.org>
* Make-lang.in: Replace $(docdir) with doc.
arext = .a
soext = .so
shext =
+hyphen = -
# Define this as & to perform parallel make on a Sequent.
# Note that this has some bugs, and it seems currently necessary
ifeq ($(strip $(filter-out alpha% ia64 dec vms% openvms% alphavms%,$(host))),)
soext = .exe
+hyphen = _
.SUFFIXES: .sym
# for shared libraries on some targets, e.g. on HP-UX where the x
# permission is required.
for file in gnat gnarl; do \
- if [ -f rts/lib$$file-$(LIBRARY_VERSION)$(soext) ]; then \
- $(INSTALL) rts/lib$$file-$(LIBRARY_VERSION)$(soext) \
+ if [ -f rts/lib$$file$(hyphen)$(LIBRARY_VERSION)$(soext) ]; then \
+ $(INSTALL) rts/lib$$file$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(DESTDIR)$(ADA_RTL_OBJ_DIR); \
fi; \
if [ -f rts/lib$$file$(soext) ]; then \
- $(LN_S) lib$$file-$(LIBRARY_VERSION)$(soext) \
+ $(LN_S) lib$$file$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(DESTDIR)$(ADA_RTL_OBJ_DIR)/lib$$file$(soext); \
fi; \
done
gnatlib
$(RM) rts/libgnat$(soext) rts/libgnarl$(soext)
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
- -o libgnat-$(LIBRARY_VERSION)$(soext) \
+ -o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \
- $(SO_OPTS)libgnat-$(LIBRARY_VERSION)$(soext) $(MISCLIB) -lm
+ $(SO_OPTS)libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
+ $(MISCLIB) -lm
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
- -o libgnarl-$(LIBRARY_VERSION)$(soext) \
+ -o libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(GNATRTL_TASKING_OBJS) \
- $(SO_OPTS)libgnarl-$(LIBRARY_VERSION)$(soext) $(THREADSLIB)
- cd rts; $(LN_S) libgnat-$(LIBRARY_VERSION)$(soext) libgnat$(soext)
- cd rts; $(LN_S) libgnarl-$(LIBRARY_VERSION)$(soext) libgnarl$(soext)
+ $(SO_OPTS)libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
+ $(THREADSLIB)
+ cd rts; $(LN_S) libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
+ libgnat$(soext)
+ cd rts; $(LN_S) libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
+ libgnarl$(soext)
gnatlib-shared-dual:
$(MAKE) $(FLAGS_TO_PASS) \
gnatlib
$(RM) rts/libgnat$(soext) rts/libgnarl$(soext)
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
- -o libgnat-$(LIBRARY_VERSION)$(soext) \
+ -o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \
- $(SO_OPTS)libgnat-$(LIBRARY_VERSION)$(soext) $(MISCLIB)
+ $(SO_OPTS)libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) $(MISCLIB)
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
- -o libgnarl-$(LIBRARY_VERSION)$(soext) \
+ -o libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(GNATRTL_TASKING_OBJS) \
- $(SO_OPTS)libgnarl-$(LIBRARY_VERSION)$(soext) \
- $(THREADSLIB) -Wl,libgnat-$(LIBRARY_VERSION)$(soext)
+ $(SO_OPTS)libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
+ $(THREADSLIB) -Wl,libgnat$(hyphen)$(LIBRARY_VERSION)$(soext)
gnatlib-shared-vms:
$(MAKE) $(FLAGS_TO_PASS) \
$(SHLIB_SYMVEC) >> SYMVEC_$$$$.opt && \
echo "case_sensitive=NO" >> SYMVEC_$$$$.opt && \
../../xgcc -g -B../../ -nostartfiles -shared -shared-libgcc \
- -o libgnat_$(LIBRARY_VERSION)$(soext) libgnat.a \
+ -o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) libgnat.a \
sys\$$library:trace.exe \
--for-linker=/noinform \
--for-linker=SYMVEC_$$$$.opt \
$(SHLIB_SYMVEC) >> SYMVEC_$$$$.opt && \
echo "case_sensitive=NO" >> SYMVEC_$$$$.opt && \
../../xgcc -g -B../../ -nostartfiles -shared -shared-libgcc \
- -o libgnarl_$(LIBRARY_VERSION)$(soext) \
- libgnarl.a libgnat_$(LIBRARY_VERSION)$(soext) \
+ -o libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
+ libgnarl.a libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
sys\$$library:trace.exe \
--for-linker=/noinform \
--for-linker=SYMVEC_$$$$.opt \
if not Inside_Init_Proc and not Inside_Allocator then
Build_Activation_Chain_Entity (N);
- Build_Master_Entity (Etype (N));
+ if not Has_Master_Entity (Current_Scope) then
+ Build_Master_Entity (Etype (N));
+ end if;
end if;
end if;
end;
Loc : constant Source_Ptr := Sloc (E);
P : Node_Id;
Decl : Node_Id;
-
+ S : Entity_Id := Scope (E);
begin
- -- Nothing to do if we already built a master entity for this scope
- -- or if there is no task hierarchy.
+ -- Ada0Y (AI-287): Do not set/get the has_master_entity reminder in
+ -- internal scopes. Required for nested limited aggregates.
+
+ if not Extensions_Allowed then
+
+ -- Nothing to do if we already built a master entity for this scope
+ -- or if there is no task hierarchy.
+
+ if Has_Master_Entity (Scope (E))
+ or else Restrictions (No_Task_Hierarchy)
+ then
+ return;
+ end if;
+ else
+
+ -- Ada0Y (AI-287): Similar to the Ãprevious casebut skipping internal
+ -- scopes. If we are not inside an internal scope this code is
+ -- equivalent to the previous code.
+
+ while Is_Internal (S) loop
+ S := Scope (S);
+ end loop;
+
+ if Has_Master_Entity (S)
+ or else Restrictions (No_Task_Hierarchy)
+ then
+ return;
+ end if;
- if Has_Master_Entity (Scope (E))
- or else Restrictions (No_Task_Hierarchy)
- then
- return;
end if;
-- Otherwise first build the master entity
P := Parent (E);
Insert_Before (P, Decl);
Analyze (Decl);
- Set_Has_Master_Entity (Scope (E));
+
+ -- Ada0Y (AI-287): Set the has_marter_entity reminder in the
+ -- non-internal scope selected above.
+
+ if not Extensions_Allowed then
+ Set_Has_Master_Entity (Scope (E));
+ else
+ Set_Has_Master_Entity (S);
+ end if;
-- Now mark the containing scope as a task master
Set_Parent (Len_Expr, Typ);
Analyze_Per_Use_Expression (Len_Expr, Standard_Integer);
- -- Use a modular type if possible. We can do this if we are we
- -- have static bounds, and the length is small enough, and the
- -- length is not zero. We exclude the zero length case because the
- -- size of things is always at least one, and the zero length object
- -- would have an anomous size.
+ -- Use a modular type if possible. We can do this if we have
+ -- static bounds, and the length is small enough, and the length
+ -- is not zero. We exclude the zero length case because the size
+ -- of things is always at least one, and the zero length object
+ -- would have an anomalous size.
if Compile_Time_Known_Value (Len_Expr) then
Len_Bits := Expr_Value (Len_Expr) * Csize;
-----------------
procedure Add_ALI_For (Source : Name_Id) is
- ALI : constant String := ALI_File_Name (Get_Name_String (Source));
+ ALI : constant String := ALI_File_Name (Get_Name_String (Source));
ALI_Id : Name_Id;
+
begin
if Bind then
Add_Argument (ALI);
Element : Project_Element;
begin
- -- Nothing to do if process has already been processed.
+ -- Nothing to do if process has already been processed
if not Processed_Projects.Get (Data.Name) then
Processed_Projects.Set (Data.Name, True);
Library_ALIs.Reset;
Interface_ALIs.Reset;
Processed_ALIs.Reset;
+
for Source in 1 .. Com.Units.Last loop
Unit := Com.Units.Table (Source);
exit when not Bind;
end if;
end loop;
-
end;
-- Continue setup and call gnatbind if Bind is True
if Bind then
+
-- Get an eventual --RTS from the ALI file
if First_ALI /= No_Name then
Com.Fail ("could not bind standalone library ",
Get_Name_String (Data.Library_Name));
end if;
-
end if;
-- Compile the binder generated file only if Link is true
-- If in the object directory of an extended project,
-- do not consider generated object files.
- if In_Main_Object_Directory or else
- Last < 5 or else
- Filename (1 .. B_Start'Length) /= B_Start
+ if In_Main_Object_Directory
+ or else Last < 5
+ or else Filename (1 .. B_Start'Length) /= B_Start
then
Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Filename (1 .. Last);
Check_Libs (ALI_File);
else
- -- The object file is a foreign object
- -- file.
+ -- Object file is a foreign object file
Foreigns.Increment_Last;
Foreigns.Table (Foreigns.Last) :=
if Object_Files'Length = 0 then
Com.Fail ("no object files for library """ &
Lib_Filename.all & '"');
-
end if;
if not Opt.Quiet_Output then
Copy_Dir := Projects.Table (For_Project).Library_Dir;
Clean (Copy_Dir);
- -- Call the procedure to build the library, depending on the build
- -- mode.
+ -- Call procedure to build the library, depending on the build mode
case The_Build_Mode is
when Dynamic | Relocatable =>
null;
end case;
- -- We need to copy the ALI files from the object directory
- -- to the library directory, so that the linker find them there,
- -- and does not need to look in the object directory where it would
- -- also find the object files; and we don't want that: we want the
- -- linker to use the library.
+ -- We need to copy the ALI files from the object directory to
+ -- the library directory, so that the linker find them there,
+ -- and does not need to look in the object directory where it
+ -- would also find the object files; and we don't want that:
+ -- we want the linker to use the library.
-- Copy the ALI files and make the copies read-only. For interfaces,
-- mark the copies as interfaces.
and then Projects.Table (For_Project).Library_Src_Dir /= No_Name
then
-- Clean the interface copy directory, if it is not also the
- -- library directory. If it is also the library directory, it has
- -- already been cleaned before the generation of the library.
+ -- library directory. If it is also the library directory, it
+ -- has already been cleaned before generation of the library.
if Projects.Table (For_Project).Library_Src_Dir /= Copy_Dir then
Copy_Dir := Projects.Table (For_Project).Library_Src_Dir;
procedure Check_Context is
begin
- -- check that each object file exists
+ -- Check that each object file exists
for F in Object_Files'Range loop
Check (Object_Files (F).all);
if Is_Obj (Name_Buffer (1 .. Name_Len))
and then Name_Buffer (1 .. B_Start'Length) /= B_Start
then
-
-- Get the object file time stamp
Obj_TS := File_Stamp (Name_Find);
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2004 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- --
function Project_File_Includes_Unkept_Comments
(Node : Project_Node_Id) return Boolean
is
- Declaration : constant Project_Node_Id :=
- Project_Declaration_Of (Node);
+ Declaration : constant Project_Node_Id := Project_Declaration_Of (Node);
begin
return Project_Nodes.Table (Declaration).Flag1;
end Project_File_Includes_Unkept_Comments;
----------
procedure Save (S : out Comment_State) is
- Cmts : Comments_Ptr := new Comment_Array (1 .. Comments.Last);
+ Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
+
begin
for J in 1 .. Comments.Last loop
Cmts (J) := Comments.Table (J);
elsif End_Of_Line_Node /= Empty_Node then
declare
Zones : constant Project_Node_Id :=
- Comment_Zones_Of (End_Of_Line_Node);
+ Comment_Zones_Of (End_Of_Line_Node);
begin
Project_Nodes.Table (Zones).Value := Comment_Id;
end;
(Node : Project_Node_Id;
To : Project_Node_Id)
is
- Zone : constant Project_Node_Id :=
- Comment_Zones_Of (Node);
+ Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
begin
Project_Nodes.Table (Zone).Field2 := To;
end Set_First_Comment_After;
(Node : Project_Node_Id;
To : Project_Node_Id)
is
- Zone : constant Project_Node_Id :=
- Comment_Zones_Of (Node);
+ Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
begin
Project_Nodes.Table (Zone).Comments := To;
end Set_First_Comment_After_End;
To : Project_Node_Id)
is
- Zone : constant Project_Node_Id :=
- Comment_Zones_Of (Node);
+ Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
begin
Project_Nodes.Table (Zone).Field1 := To;
end Set_First_Comment_Before;
(Node : Project_Node_Id;
To : Project_Node_Id)
is
- Zone : constant Project_Node_Id :=
- Comment_Zones_Of (Node);
+ Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
begin
Project_Nodes.Table (Zone).Field2 := To;
end Set_First_Comment_Before_End;
(Node : Project_Node_Id;
To : Boolean)
is
- Declaration : constant Project_Node_Id :=
- Project_Declaration_Of (Node);
+ Declaration : constant Project_Node_Id := Project_Declaration_Of (Node);
begin
Project_Nodes.Table (Declaration).Flag1 := To;
end Set_Project_File_Includes_Unkept_Comments;
case Ekind (T) is
when Array_Kind =>
- Set_Ekind (Id, E_Array_Subtype);
-
- -- Shouldn't we call Copy_Array_Subtype_Attributes here???
-
- Set_First_Index (Id, First_Index (T));
- Set_Is_Aliased (Id, Is_Aliased (T));
- Set_Is_Constrained (Id, Is_Constrained (T));
+ Set_Ekind (Id, E_Array_Subtype);
+ Copy_Array_Subtype_Attributes (Id, T);
when Decimal_Fixed_Point_Kind =>
Set_Ekind (Id, E_Decimal_Fixed_Point_Subtype);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
Pre_Analyze_And_Resolve (Expr);
end if;
+ if Nkind (Delay_Statement (N)) = N_Delay_Until_Statement and then
+ not Is_RTE (Base_Type (Etype (Expr)), RO_CA_Time) and then
+ not Is_RTE (Base_Type (Etype (Expr)), RO_RT_Time)
+ then
+ Error_Msg_N ("expect Time types for `DELAY UNTIL`", Expr);
+ end if;
+
Check_Restriction (No_Fixed_Point, Expr);
else
Analyze (Delay_Statement (N));
for C in Real_Command_Type loop
declare
- Command : Item_Ptr := new Command_Item;
+ Command : constant Item_Ptr := new Command_Item;
Last_Switch : Item_Ptr;
-- Last switch in list
P := P + 1; -- bump past =
while P <= SS'Last loop
declare
- Opt : Item_Ptr := new Option_Item;
+ Opt : constant Item_Ptr := new Option_Item;
Q : Natural;
+
begin
-- Link new option item into options list
-- The first one must be a command name
if Arg_Num = 1 and then Arg_Idx = Argv'First then
-
Command := Matching_Name (Arg.all, Commands);
if Command = null then
if Sw.Translation = T_File
and then Sw.Unix_String
- (Sw.Unix_String'Last)
- /= '='
+ (Sw.Unix_String'Last) /= '='
then
Put (' ');
end if;
Put ("=nnn");
Set_Col (53);
- if Sw.Unix_String (Sw.Unix_String'First)
- = '`'
+ if Sw.Unix_String
+ (Sw.Unix_String'First) = '`'
then
Put (Sw.Unix_String
(Sw.Unix_String'First + 1
Put ("=xyz");
Set_Col (53);
- if Sw.Unix_String (Sw.Unix_String'First)
- = '`'
+ if Sw.Unix_String
+ (Sw.Unix_String'First) = '`'
then
Put (Sw.Unix_String
(Sw.Unix_String'First + 1
Put (Sw.Unix_String.all);
- if Sw.Unix_String (Sw.Unix_String'Last)
- /= '='
+ if Sw.Unix_String
+ (Sw.Unix_String'Last) /= '='
then
Put (' ');
end if;
when File | Optional_File =>
declare
Normal_File : constant String_Access :=
- To_Canonical_File_Spec
- (Arg.all);
+ To_Canonical_File_Spec
+ (Arg.all);
begin
Place (' ');
when Unlimited_Files =>
declare
- Normal_File :
- constant String_Access :=
- To_Canonical_File_Spec (Arg.all);
+ Normal_File : constant String_Access :=
+ To_Canonical_File_Spec
+ (Arg.all);
- File_Is_Wild : Boolean := False;
- File_List : String_Access_List_Access;
+ File_Is_Wild : Boolean := False;
+ File_List : String_Access_List_Access;
begin
for J in Arg'Range loop
(Arg_Num + 1));
Arg_Num := Arg_Num + 1;
Arg_Idx := Argv'First;
- Next_Arg_Idx
- := Get_Arg_End (Argv.all, Arg_Idx);
+ Next_Arg_Idx :=
+ Get_Arg_End (Argv.all, Arg_Idx);
Arg := new String'
(Argv (Arg_Idx .. Next_Arg_Idx));
goto Tryagain_After_Coalesce;
declare
Dir_Is_Wild : Boolean := False;
Dir_Maybe_Is_Wild : Boolean := False;
+
Dir_List : String_Access_List_Access;
+
begin
P2 := SwP;
while P2 < Endp
and then Arg (P2 + 1) /= ','
loop
-
-- A wildcard directory spec on
-- VMS will contain either * or
-- % or ...
end loop;
if Dir_Is_Wild then
- Dir_List := To_Canonical_File_List
- (Arg (SwP .. P2), True);
+ Dir_List :=
+ To_Canonical_File_List
+ (Arg (SwP .. P2), True);
for J in Dir_List.all'Range loop
Place_Unix_Switches
-- here
if Sw.Unix_String
- (Sw.Unix_String'Last) /= '='
+ (Sw.Unix_String'Last) /= '='
then
Place (' ');
end if;
if Sw.Translation = T_File
and then Sw.Unix_String
- (Sw.Unix_String'Last) /= '='
+ (Sw.Unix_String'Last) /= '='
then
Place (' ');
end if;
end if;
when T_Numeric =>
- if
- OK_Integer (Arg (SwP + 2 .. Arg'Last))
- then
+ if OK_Integer (Arg (SwP + 2 .. Arg'Last)) then
Place_Unix_Switches (Sw.Unix_String);
Place (Arg (SwP + 2 .. Arg'Last));
end if;
when T_Alphanumplus =>
- if
- OK_Alphanumerplus
- (Arg (SwP + 2 .. Arg'Last))
+ if OK_Alphanumerplus
+ (Arg (SwP + 2 .. Arg'Last))
then
Place_Unix_Switches (Sw.Unix_String);
Place (Arg (SwP + 2 .. Arg'Last));
-- A String value must be extended to the
-- end of the Argv, otherwise strings like
-- "foo/bar" get split at the slash.
- --
+
-- The begining and ending of the string
-- are flagged with embedded nulls which
-- are removed when building the Spawn
-- difficult to embed them.
Place_Unix_Switches (Sw.Unix_String);
+
if Next_Arg_Idx /= Argv'Last then
Next_Arg_Idx := Argv'Last;
Arg := new String'
SwP := SwP + 1;
end loop;
end if;
+
Place (ASCII.NUL);
Place (Arg (SwP + 2 .. Arg'Last));
Place (ASCII.NUL);
Sw.Unix_String'First + 5));
if Sw.Unix_String
- (Sw.Unix_String'First + 7 ..
- Sw.Unix_String'Last) =
- "MAKE"
+ (Sw.Unix_String'First + 7 ..
+ Sw.Unix_String'Last) = "MAKE"
then
Make_Commands_Active := null;
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2004 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- --
(Sorted : Boolean := True)
return Declaration_Array_Access
is
- Arr : Declaration_Array_Access :=
+ Arr : constant Declaration_Array_Access :=
new Declaration_Array (1 .. Entities_Count);
Decl : Declaration_Reference := Entities_HTable.Get_First;
Index : Natural := Arr'First;
projects / thirdparty / gcc.git / commitdiff
