[multiple changes]
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. From-SVN: r76271
This commit is contained in:
Arnaud Charlet
parent
1ef82ef2e4
commit
adc04486ee
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -218,7 +218,7 @@ package body System.Task_Primitives.Operations is
|
|||
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;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,42 @@
|
|||
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.
|
||||
|
|
|
|||
|
|
@ -144,6 +144,7 @@ exeext =
|
|||
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
|
||||
|
|
@ -1126,6 +1127,7 @@ endif
|
|||
ifeq ($(strip $(filter-out alpha% ia64 dec vms% openvms% alphavms%,$(host))),)
|
||||
|
||||
soext = .exe
|
||||
hyphen = _
|
||||
|
||||
.SUFFIXES: .sym
|
||||
|
||||
|
|
@ -1704,12 +1706,12 @@ install-gnatlib: ../stamp-gnatlib
|
|||
# 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
|
||||
|
|
@ -1892,15 +1894,19 @@ gnatlib-shared-default:
|
|||
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) \
|
||||
|
|
@ -1944,14 +1950,14 @@ gnatlib-shared-win32:
|
|||
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) \
|
||||
|
|
@ -1965,7 +1971,7 @@ gnatlib-shared-vms:
|
|||
$(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 \
|
||||
|
|
@ -1975,8 +1981,8 @@ gnatlib-shared-vms:
|
|||
$(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 \
|
||||
|
|
|
|||
|
|
@ -1949,7 +1949,9 @@ package body Exp_Aggr is
|
|||
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -1198,15 +1198,37 @@ package body Exp_Ch9 is
|
|||
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
|
||||
|
|
@ -1226,7 +1248,15 @@ package body Exp_Ch9 is
|
|||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -1061,11 +1061,11 @@ package body Exp_Pakd is
|
|||
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;
|
||||
|
|
|
|||
|
|
@ -389,8 +389,9 @@ package body MLib.Prj is
|
|||
-----------------
|
||||
|
||||
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);
|
||||
|
|
@ -665,7 +666,7 @@ package body MLib.Prj is
|
|||
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);
|
||||
|
|
@ -879,6 +880,7 @@ package body MLib.Prj is
|
|||
Library_ALIs.Reset;
|
||||
Interface_ALIs.Reset;
|
||||
Processed_ALIs.Reset;
|
||||
|
||||
for Source in 1 .. Com.Units.Last loop
|
||||
Unit := Com.Units.Table (Source);
|
||||
|
||||
|
|
@ -924,12 +926,12 @@ package body MLib.Prj is
|
|||
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
|
||||
|
|
@ -991,7 +993,6 @@ package body MLib.Prj is
|
|||
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
|
||||
|
|
@ -1196,9 +1197,9 @@ package body MLib.Prj is
|
|||
-- 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);
|
||||
|
|
@ -1233,8 +1234,7 @@ package body MLib.Prj is
|
|||
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) :=
|
||||
|
|
@ -1338,7 +1338,6 @@ package body MLib.Prj is
|
|||
if Object_Files'Length = 0 then
|
||||
Com.Fail ("no object files for library """ &
|
||||
Lib_Filename.all & '"');
|
||||
|
||||
end if;
|
||||
|
||||
if not Opt.Quiet_Output then
|
||||
|
|
@ -1470,8 +1469,7 @@ package body MLib.Prj is
|
|||
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 =>
|
||||
|
|
@ -1501,11 +1499,11 @@ package body MLib.Prj is
|
|||
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.
|
||||
|
|
@ -1521,8 +1519,8 @@ package body MLib.Prj is
|
|||
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;
|
||||
|
|
@ -1558,7 +1556,7 @@ package body MLib.Prj is
|
|||
|
||||
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);
|
||||
|
|
@ -1609,7 +1607,6 @@ package body MLib.Prj is
|
|||
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);
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -1242,8 +1242,7 @@ package body Prj.Tree is
|
|||
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;
|
||||
|
|
@ -1329,7 +1328,8 @@ package body Prj.Tree is
|
|||
----------
|
||||
|
||||
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);
|
||||
|
|
@ -1393,7 +1393,7 @@ package body Prj.Tree is
|
|||
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;
|
||||
|
|
@ -1722,8 +1722,7 @@ package body Prj.Tree is
|
|||
(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;
|
||||
|
|
@ -1736,8 +1735,7 @@ package body Prj.Tree is
|
|||
(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;
|
||||
|
|
@ -1751,8 +1749,7 @@ package body Prj.Tree is
|
|||
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;
|
||||
|
|
@ -1765,8 +1762,7 @@ package body Prj.Tree is
|
|||
(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;
|
||||
|
|
@ -2275,8 +2271,7 @@ package body Prj.Tree is
|
|||
(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;
|
||||
|
|
|
|||
|
|
@ -2115,13 +2115,8 @@ package body Sem_Ch3 is
|
|||
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -483,6 +483,13 @@ package body Sem_Ch9 is
|
|||
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));
|
||||
|
|
|
|||
|
|
@ -793,7 +793,7 @@ package body VMS_Conv is
|
|||
|
||||
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
|
||||
|
|
@ -975,8 +975,9 @@ package body VMS_Conv is
|
|||
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
|
||||
|
||||
|
|
@ -1088,7 +1089,6 @@ package body VMS_Conv is
|
|||
-- 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
|
||||
|
|
@ -1159,8 +1159,7 @@ package body VMS_Conv is
|
|||
|
||||
if Sw.Translation = T_File
|
||||
and then Sw.Unix_String
|
||||
(Sw.Unix_String'Last)
|
||||
/= '='
|
||||
(Sw.Unix_String'Last) /= '='
|
||||
then
|
||||
Put (' ');
|
||||
end if;
|
||||
|
|
@ -1171,8 +1170,8 @@ package body VMS_Conv is
|
|||
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
|
||||
|
|
@ -1187,8 +1186,8 @@ package body VMS_Conv is
|
|||
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
|
||||
|
|
@ -1208,8 +1207,8 @@ package body VMS_Conv is
|
|||
|
||||
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;
|
||||
|
|
@ -1297,8 +1296,8 @@ package body VMS_Conv is
|
|||
when File | Optional_File =>
|
||||
declare
|
||||
Normal_File : constant String_Access :=
|
||||
To_Canonical_File_Spec
|
||||
(Arg.all);
|
||||
To_Canonical_File_Spec
|
||||
(Arg.all);
|
||||
|
||||
begin
|
||||
Place (' ');
|
||||
|
|
@ -1314,12 +1313,12 @@ package body VMS_Conv is
|
|||
|
||||
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
|
||||
|
|
@ -1599,8 +1598,8 @@ package body VMS_Conv is
|
|||
(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;
|
||||
|
|
@ -1621,14 +1620,15 @@ package body VMS_Conv is
|
|||
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 ...
|
||||
|
|
@ -1660,8 +1660,9 @@ package body VMS_Conv is
|
|||
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
|
||||
|
|
@ -1696,7 +1697,7 @@ package body VMS_Conv is
|
|||
-- here
|
||||
|
||||
if Sw.Unix_String
|
||||
(Sw.Unix_String'Last) /= '='
|
||||
(Sw.Unix_String'Last) /= '='
|
||||
then
|
||||
Place (' ');
|
||||
end if;
|
||||
|
|
@ -1722,7 +1723,7 @@ package body VMS_Conv is
|
|||
|
||||
if Sw.Translation = T_File
|
||||
and then Sw.Unix_String
|
||||
(Sw.Unix_String'Last) /= '='
|
||||
(Sw.Unix_String'Last) /= '='
|
||||
then
|
||||
Place (' ');
|
||||
end if;
|
||||
|
|
@ -1733,9 +1734,7 @@ package body VMS_Conv is
|
|||
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));
|
||||
|
||||
|
|
@ -1748,9 +1747,8 @@ package body VMS_Conv is
|
|||
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));
|
||||
|
|
@ -1768,7 +1766,7 @@ package body VMS_Conv is
|
|||
-- 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
|
||||
|
|
@ -1778,6 +1776,7 @@ package body VMS_Conv is
|
|||
-- 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'
|
||||
|
|
@ -1789,6 +1788,7 @@ package body VMS_Conv is
|
|||
SwP := SwP + 1;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
Place (ASCII.NUL);
|
||||
Place (Arg (SwP + 2 .. Arg'Last));
|
||||
Place (ASCII.NUL);
|
||||
|
|
@ -1803,9 +1803,8 @@ package body VMS_Conv is
|
|||
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;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -1413,7 +1413,7 @@ package body Xr_Tabls is
|
|||
(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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue