[multiple changes]
2003-12-01 Nicolas Setton <setton@act-europe.fr> * a-except.adb (Raise_Current_Excep): Add a pragma Inspection_Point, so that the debugger can reliably access the value of the parameter, and therefore is able to display the exception name when an exception breakpoint is reached. 2003-12-01 Thomas Quinot <quinot@act-europe.fr> * fmap.adb: Fix typo in warning message. * g-socket.ads, g-socket.adb: Make Free a visible instance of Ada.Unchecked_Deallocation (no need to wrap it in a subprogram). 2003-12-01 Vincent Celier <celier@gnat.com> * mlib-prj.adb (Build_Library.Process): Do not check a withed unit if ther is no Afile. (Build_Library): Get the switches only if Default_Switches is declared in package Binder. 2003-12-01 Ed Schonberg <schonberg@gnat.com> * exp_ch6.adb (Expand_Actuals): When applying validity checks to actuals that are indexed components, reanalyze actual to ensure that packed array references are properly expanded. * sem_ch5.adb (Diagnose_Non_Variable_Lhs): Add special case for attempted assignment to a discriminant. 2003-12-01 Robert Dewar <dewar@gnat.com> * rtsfind.adb, exp_ch4.adb, s-exnint.ads, s-exnint.adb: Minor reformatting. * switch-c.adb: Minor reformatting of comments 2003-12-01 Arnaud Charlet <charlet@act-europe.fr> * Makefile.in: Clean ups. 2003-12-01 GNAT Script <nobody@gnat.com> * Make-lang.in: Makefile automatically updated From-SVN: r74100
This commit is contained in:
Arnaud Charlet
parent
80fcc7bcae
commit
08aa9a4a1c
15 changed files with 177 additions and 148 deletions
|
|
@ -1,3 +1,48 @@
|
|||
2003-12-01 Nicolas Setton <setton@act-europe.fr>
|
||||
|
||||
* a-except.adb (Raise_Current_Excep): Add a pragma Inspection_Point,
|
||||
so that the debugger can reliably access the value of the parameter,
|
||||
and therefore is able to display the exception name when an exception
|
||||
breakpoint is reached.
|
||||
|
||||
2003-12-01 Thomas Quinot <quinot@act-europe.fr>
|
||||
|
||||
* fmap.adb: Fix typo in warning message.
|
||||
|
||||
* g-socket.ads, g-socket.adb: Make Free a visible instance of
|
||||
Ada.Unchecked_Deallocation (no need to wrap it in a subprogram).
|
||||
|
||||
2003-12-01 Vincent Celier <celier@gnat.com>
|
||||
|
||||
* mlib-prj.adb (Build_Library.Process): Do not check a withed unit if
|
||||
ther is no Afile.
|
||||
(Build_Library): Get the switches only if Default_Switches is declared
|
||||
in package Binder.
|
||||
|
||||
2003-12-01 Ed Schonberg <schonberg@gnat.com>
|
||||
|
||||
* exp_ch6.adb (Expand_Actuals): When applying validity checks to
|
||||
actuals that are indexed components, reanalyze actual to ensure that
|
||||
packed array references are properly expanded.
|
||||
|
||||
* sem_ch5.adb (Diagnose_Non_Variable_Lhs): Add special case for
|
||||
attempted assignment to a discriminant.
|
||||
|
||||
2003-12-01 Robert Dewar <dewar@gnat.com>
|
||||
|
||||
* rtsfind.adb, exp_ch4.adb, s-exnint.ads, s-exnint.adb: Minor
|
||||
reformatting.
|
||||
|
||||
* switch-c.adb: Minor reformatting of comments
|
||||
|
||||
2003-12-01 Arnaud Charlet <charlet@act-europe.fr>
|
||||
|
||||
* Makefile.in: Clean ups.
|
||||
|
||||
2003-12-01 GNAT Script <nobody@gnat.com>
|
||||
|
||||
* Make-lang.in: Makefile automatically updated
|
||||
|
||||
2003-12-01 Arnaud Charlet <charlet@act-europe.fr>
|
||||
|
||||
* 5wsystem.ads: Disable zero cost exception, not ready yet.
|
||||
|
|
|
|||
|
|
@ -1417,17 +1417,17 @@ ada/cstand.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
|
|||
ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
|
||||
ada/sem_ch8.ads ada/sem_eval.ads ada/sem_mech.ads ada/sem_res.ads \
|
||||
ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sinfo.ads \
|
||||
ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
|
||||
ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
|
||||
ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
|
||||
ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
|
||||
ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
|
||||
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
|
||||
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
|
||||
ada/targparm.ads ada/tbuild.ads ada/tree_io.ads ada/ttypef.ads \
|
||||
ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
|
||||
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
|
||||
ada/widechar.ads
|
||||
ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
|
||||
ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
|
||||
ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
|
||||
ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads ada/s-htable.ads \
|
||||
ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
|
||||
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
|
||||
ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
|
||||
ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
|
||||
ada/tree_io.ads ada/ttypef.ads ada/ttypes.ads ada/types.ads \
|
||||
ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
|
||||
ada/urealp.ads ada/urealp.adb ada/widechar.ads
|
||||
|
||||
ada/debug.o : ada/debug.ads ada/debug.adb ada/system.ads
|
||||
|
||||
|
|
@ -2305,7 +2305,8 @@ ada/gnatbind.o : ada/ada.ads ada/a-except.ads ada/ali.ads ada/ali-util.ads \
|
|||
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
|
||||
ada/unchdeal.ads
|
||||
|
||||
ada/gnatvsn.o : ada/gnatvsn.ads ada/gnatvsn.adb ada/system.ads
|
||||
ada/gnatvsn.o : ada/gnatvsn.ads ada/gnatvsn.adb ada/system.ads \
|
||||
ada/s-secsta.ads ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads
|
||||
|
||||
ada/hlo.o : ada/hlo.ads ada/hlo.adb ada/output.ads ada/system.ads \
|
||||
ada/s-exctab.ads ada/s-stalib.ads ada/s-unstyp.ads ada/types.ads \
|
||||
|
|
@ -2533,9 +2534,11 @@ ada/nmake.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
|
|||
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
|
||||
ada/unchdeal.ads ada/urealp.ads
|
||||
|
||||
ada/opt.o : ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
|
||||
ada/hostparm.ads ada/opt.ads ada/opt.adb ada/system.ads \
|
||||
ada/s-exctab.ads ada/s-stalib.ads ada/s-unstyp.ads ada/s-wchcon.ads \
|
||||
ada/opt.o : ada/ada.ads ada/a-except.ads ada/gnat.ads ada/g-os_lib.ads \
|
||||
ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads \
|
||||
ada/opt.adb ada/system.ads ada/s-exctab.ads ada/s-secsta.ads \
|
||||
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
|
||||
ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
|
||||
ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads
|
||||
|
||||
ada/osint-b.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
|
||||
|
|
|
|||
|
|
@ -577,33 +577,6 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
|
|||
s-vxwork.ads<5pvxwork.ads \
|
||||
a-taside.adb<1ataside.adb \
|
||||
|
||||
CERT_LEVEL_B_TARGET_PAIRS=\
|
||||
a-tags.ads<1atags.ads \
|
||||
a-tags.adb<1atags.adb \
|
||||
a-except.adb<2aexcept.adb \
|
||||
a-except.ads<2aexcept.ads \
|
||||
a-excach.adb<2aexcach.adb \
|
||||
i-c.ads<1ic.ads \
|
||||
g-io.adb<2gio.adb \
|
||||
s-init.ads<2sinit.ads \
|
||||
s-init.adb<5zinit.adb \
|
||||
s-memory.adb<2smemory.adb \
|
||||
s-memory.ads<2smemory.ads \
|
||||
s-osinte.ads<2sosinte.ads \
|
||||
s-secsta.ads<2ssecsta.ads \
|
||||
s-secsta.adb<2ssecsta.adb \
|
||||
s-soflin.adb<2ssoflin.adb \
|
||||
s-soflin.ads<2ssoflin.ads \
|
||||
s-stalib.adb<1sstalib.adb \
|
||||
s-stalib.ads<1sstalib.ads \
|
||||
s-thread.adb<5zthread.adb \
|
||||
s-thrini.ads<2sthrini.ads \
|
||||
s-thrini.adb<5zthrini.adb \
|
||||
s-tiitho.adb<5ztiitho.adb \
|
||||
s-traceb.adb<2straceb.adb \
|
||||
s-traceb.ads<2straceb.ads \
|
||||
system.ads<5isystem.ads
|
||||
|
||||
ifeq ($(strip $(filter-out yes,$(TRACE))),)
|
||||
LIBGNAT_TARGET_PAIRS += \
|
||||
s-traces.adb<7straces.adb \
|
||||
|
|
@ -632,9 +605,6 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
|
|||
s-taprop.adb<5ztaprop.adb \
|
||||
s-taspri.ads<5ztaspri.ads \
|
||||
s-thread.adb<5zthread.adb \
|
||||
s-thrini.ads<2sthrini.ads \
|
||||
s-thrini.adb<5zthrini.adb \
|
||||
s-tiitho.adb<5ytiitho.adb \
|
||||
s-tpopsp.adb<5ztpopsp.adb \
|
||||
s-vxwork.ads<5pvxwork.ads \
|
||||
g-soccon.ads<3zsoccon.ads \
|
||||
|
|
@ -649,7 +619,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
|
|||
|
||||
EXTRA_RAVEN_SOURCES=i-vxwork.ads s-vxwork.ads
|
||||
EXTRA_RAVEN_OBJS=i-vxwork.o s-vxwork.o
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o s-thrini.o
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o
|
||||
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
|
||||
HIE_RAVEN_TARGET_PAIRS=\
|
||||
$(HIE_NONE_TARGET_PAIRS) \
|
||||
|
|
@ -681,6 +651,9 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
|
|||
CERT_LEVEL_B_TARGET_PAIRS=\
|
||||
a-tags.ads<1atags.ads \
|
||||
a-tags.adb<1atags.adb \
|
||||
a-elchha.ads<2aelchha.ads \
|
||||
a-elchha.adb<2aelchha.adb.empty \
|
||||
a-elchha.adb.full<2aelchha.adb.full \
|
||||
a-except.adb<2aexcept.adb \
|
||||
a-except.ads<2aexcept.ads \
|
||||
a-excach.adb<2aexcach.adb \
|
||||
|
|
@ -698,13 +671,12 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
|
|||
s-stalib.adb<1sstalib.adb \
|
||||
s-stalib.ads<1sstalib.ads \
|
||||
s-thread.adb<5zthread.adb \
|
||||
s-thrini.ads<2sthrini.ads \
|
||||
s-thrini.adb<5zthrini.adb \
|
||||
s-tiitho.adb<5ytiitho.adb \
|
||||
s-traceb.adb<2straceb.adb \
|
||||
s-traceb.ads<2straceb.ads \
|
||||
system.ads<5isystem.ads
|
||||
|
||||
CERT_LEVEL_B_EXTRA_OBJECT_FILES=a-elchha.adb
|
||||
|
||||
ifeq ($(strip $(filter-out yes,$(TRACE))),)
|
||||
LIBGNAT_TARGET_PAIRS += \
|
||||
s-traces.adb<7straces.adb \
|
||||
|
|
@ -1571,8 +1543,6 @@ $(COMPILABLE_HIE_SOURCES) \
|
|||
s-soflin.ads \
|
||||
s-stalib.adb \
|
||||
s-stalib.ads \
|
||||
s-thrini.adb \
|
||||
s-thrini.ads \
|
||||
s-assert.adb \
|
||||
s-assert.ads \
|
||||
s-exnint.adb \
|
||||
|
|
@ -1592,8 +1562,10 @@ $(COMPILABLE_HIE_SOURCES) \
|
|||
$(EXTRA_CERT_LEVEL_B_SOURCES)
|
||||
|
||||
NON_COMPILABLE_CERT_LEVEL_B_SOURCES= \
|
||||
a-elchha.ads \
|
||||
a-elchha.adb \
|
||||
a-elchha.adb.full \
|
||||
a-excach.adb \
|
||||
s-tiitho.adb \
|
||||
$(NON_COMPILABLE_HIE_SOURCES)
|
||||
|
||||
CERT_LEVEL_B_SOURCES = \
|
||||
|
|
@ -1605,12 +1577,10 @@ $(COMPILABLE_CERT_LEVEL_B_SOURCES)
|
|||
CERT_LEVEL_B_OBJS = \
|
||||
$(HIE_OBJS) \
|
||||
a-except.o \
|
||||
a-excach.o \
|
||||
s-init.o \
|
||||
s-memory.o \
|
||||
s-soflin.o \
|
||||
s-stalib.o \
|
||||
s-tiitho.o \
|
||||
s-thrini.o \
|
||||
s-traceb.o \
|
||||
s-assert.o \
|
||||
|
|
@ -2052,9 +2022,8 @@ rts-cert: force
|
|||
$(MAKE) $(FLAGS_TO_PASS) prepare-rts \
|
||||
RTS_NAME=cert RTS_SRCS="$(CERT_LEVEL_B_SOURCES)" \
|
||||
RTS_TARGET_PAIRS="$(CERT_LEVEL_B_TARGET_PAIRS)" \
|
||||
COMPILABLE_SOURCES="$(COMPILABLE_CERT_LEVEL_B_SOURCES)"
|
||||
-$(GNATMAKE) -Prts-cert/cert.gpr --GCC="../../../xgcc -B../../../"
|
||||
$(CHMOD) a-wx rts-cert/adalib/*.ali
|
||||
COMPILABLE_SOURCES="$(COMPILABLE_CERT_LEVEL_B_SOURCES)"
|
||||
$(GNATMAKE) -Prts-cert/cert.gpr --GCC="../../../xgcc -B../../../"
|
||||
# ... then the C files. This section will eventually be removed.
|
||||
$(foreach f,$(CERT_LEVEL_B_C_FILES), \
|
||||
$(CP) $(fsrcpfx)$(f).c rts-cert/adainclude/ ;)
|
||||
|
|
@ -2063,10 +2032,17 @@ rts-cert: force
|
|||
../../../$(GCC_FOR_TARGET) -B../../../ $(TARGET_LIBGCC2_CFLAGS) \
|
||||
$(ALL_CFLAGS) $(GNATLIBCFLAGS_FOR_C) -c ../adainclude/$(f).c \
|
||||
-I../adainclude $(INCLUDES_FOR_SUBDIR) -I../../../ ;) \
|
||||
# ... Finally, generate the libs:
|
||||
cd rts-cert/adalib ; \
|
||||
../../../xgcc -B../../../ *.o -o libgnat ; \
|
||||
$(CHMOD) a-wx *.ali ; \
|
||||
$(RM) *.o ; \
|
||||
$(MV) libgnat libgnat.o
|
||||
$(MV) libgnat libgnat.o ; \
|
||||
$(AR) $(ARFLAGS) libgnat.a libgnat.o ; \
|
||||
$(foreach f,$(CERT_LEVEL_B_EXTRA_OBJECT_FILES), \
|
||||
../../../xgcc -c -B../../../ $(GNATLIBFLAGS) ../adainclude/$(f) \
|
||||
-I../adainclude; \
|
||||
$(AR) $(ARFLAGS) libgnat.a $(subst .adb,.o,$(f))) ; \
|
||||
$(CHMOD) a-wx *.ali *.o *.a ; \
|
||||
|
||||
rts-none: force
|
||||
$(MAKE) $(FLAGS_TO_PASS) prepare-rts \
|
||||
|
|
|
|||
|
|
@ -859,6 +859,8 @@ package body Ada.Exceptions is
|
|||
-------------------------
|
||||
|
||||
procedure Raise_Current_Excep (E : Exception_Id) is
|
||||
pragma Inspection_Point (E);
|
||||
-- This is so the debugger can reliably inspect the parameter
|
||||
begin
|
||||
Process_Raise_Exception (E => E, From_Signal_Handler => False);
|
||||
end Raise_Current_Excep;
|
||||
|
|
|
|||
|
|
@ -5349,6 +5349,7 @@ package body Exp_Ch4 is
|
|||
|
||||
function Is_Procedure_Actual (N : Node_Id) return Boolean is
|
||||
Par : Node_Id := Parent (N);
|
||||
|
||||
begin
|
||||
while Present (Par)
|
||||
and then Nkind (Par) not in N_Statement_Other_Than_Procedure_Call
|
||||
|
|
@ -5448,8 +5449,9 @@ package body Exp_Ch4 is
|
|||
-- with generating the error message).
|
||||
|
||||
if not Is_Packed (Typ) then
|
||||
-- apply transformation for actuals of a function call, where
|
||||
-- Expand_Actuals is not used.
|
||||
|
||||
-- Apply transformation for actuals of a function call,
|
||||
-- where Expand_Actuals is not used.
|
||||
|
||||
if Nkind (Parent (N)) = N_Function_Call
|
||||
and then Is_Possibly_Unaligned_Slice (N)
|
||||
|
|
|
|||
|
|
@ -547,8 +547,9 @@ package body Exp_Ch6 is
|
|||
|
||||
Var := Make_Var (Expression (Actual));
|
||||
|
||||
Crep := not Same_Representation
|
||||
(Etype (Formal), Etype (Expression (Actual)));
|
||||
Crep := not Same_Representation
|
||||
(Etype (Formal), Etype (Expression (Actual)));
|
||||
|
||||
else
|
||||
V_Typ := Etype (Actual);
|
||||
Var := Make_Var (Actual);
|
||||
|
|
@ -1528,8 +1529,16 @@ package body Exp_Ch6 is
|
|||
if Validity_Checks_On then
|
||||
if Ekind (Formal) = E_In_Parameter
|
||||
and then Validity_Check_In_Params
|
||||
and then Is_Entity_Name (Actual)
|
||||
then
|
||||
-- If the actual is an indexed component of a packed
|
||||
-- type, it has not been expanded yet. It will be
|
||||
-- copied in the validity code that follows, and has
|
||||
-- to be expanded appropriately, so reanalyze it.
|
||||
|
||||
if Nkind (Actual) = N_Indexed_Component then
|
||||
Set_Analyzed (Actual, False);
|
||||
end if;
|
||||
|
||||
Ensure_Valid (Actual);
|
||||
|
||||
elsif Ekind (Formal) = E_In_Out_Parameter
|
||||
|
|
|
|||
|
|
@ -292,7 +292,7 @@ package body Fmap is
|
|||
then
|
||||
Write_Str ("warning: mapping file """);
|
||||
Write_Str (File_Name);
|
||||
Write_Line (""" is incorrectly formated");
|
||||
Write_Line (""" is incorrectly formatted");
|
||||
Empty_Tables;
|
||||
return;
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -34,7 +34,6 @@
|
|||
with Ada.Streams; use Ada.Streams;
|
||||
with Ada.Exceptions; use Ada.Exceptions;
|
||||
with Ada.Unchecked_Conversion;
|
||||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
with Interfaces.C.Strings;
|
||||
|
||||
|
|
@ -778,17 +777,6 @@ package body GNAT.Sockets is
|
|||
end if;
|
||||
end Finalize;
|
||||
|
||||
----------
|
||||
-- Free --
|
||||
----------
|
||||
|
||||
procedure Free (Stream : in out Stream_Access) is
|
||||
procedure Do_Free is new Ada.Unchecked_Deallocation
|
||||
(Ada.Streams.Root_Stream_Type'Class, Stream_Access);
|
||||
begin
|
||||
Do_Free (Stream);
|
||||
end Free;
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
---------
|
||||
|
|
|
|||
|
|
@ -54,6 +54,7 @@
|
|||
|
||||
with Ada.Exceptions;
|
||||
with Ada.Streams;
|
||||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
with System;
|
||||
|
||||
|
|
@ -902,10 +903,11 @@ package GNAT.Sockets is
|
|||
-- Return the socket address from which the last message was
|
||||
-- received.
|
||||
|
||||
procedure Free (Stream : in out Stream_Access);
|
||||
-- Destroy a stream created by one of the Stream functions above, and
|
||||
-- release associated resources. The user is responsible for calling
|
||||
-- this subprogram when the stream is not needed anymore.
|
||||
procedure Free is new Ada.Unchecked_Deallocation
|
||||
(Ada.Streams.Root_Stream_Type'Class, Stream_Access);
|
||||
-- Destroy a stream created by one of the Stream functions above,
|
||||
-- releasing the corresponding resources. The user is responsible
|
||||
-- for calling this subprogram when the stream is not needed anymore.
|
||||
|
||||
type Socket_Set_Type is limited private;
|
||||
-- This type allows to manipulate sets of sockets. It allows to
|
||||
|
|
|
|||
|
|
@ -576,7 +576,7 @@ package body MLib.Prj is
|
|||
for W in Unit_Data.First_With .. Unit_Data.Last_With loop
|
||||
Afile := Withs.Table (W).Afile;
|
||||
|
||||
if Library_ALIs.Get (Afile)
|
||||
if Afile /= No_Name and then Library_ALIs.Get (Afile)
|
||||
and then not Processed_ALIs.Get (Afile)
|
||||
then
|
||||
if not Interface_ALIs.Get (Afile) then
|
||||
|
|
@ -811,9 +811,10 @@ package body MLib.Prj is
|
|||
|
||||
declare
|
||||
Binder_Package : constant Package_Id :=
|
||||
Value_Of
|
||||
(Name => Name_Binder,
|
||||
In_Packages => Data.Decl.Packages);
|
||||
Value_Of
|
||||
(Name => Name_Binder,
|
||||
In_Packages => Data.Decl.Packages);
|
||||
|
||||
begin
|
||||
if Binder_Package /= No_Package then
|
||||
declare
|
||||
|
|
@ -823,20 +824,26 @@ package body MLib.Prj is
|
|||
In_Arrays =>
|
||||
Packages.Table
|
||||
(Binder_Package).Decl.Arrays);
|
||||
Switches : Variable_Value :=
|
||||
Value_Of
|
||||
(Index => Name_Ada, In_Array => Defaults);
|
||||
Switch : String_List_Id := Nil_String;
|
||||
begin
|
||||
if not Switches.Default then
|
||||
Switch := Switches.Values;
|
||||
Switches : Variable_Value := Nil_Variable_Value;
|
||||
|
||||
while Switch /= Nil_String loop
|
||||
Add_Argument
|
||||
(Get_Name_String
|
||||
(String_Elements.Table (Switch).Value));
|
||||
Switch := String_Elements.Table (Switch).Next;
|
||||
end loop;
|
||||
Switch : String_List_Id := Nil_String;
|
||||
|
||||
begin
|
||||
if Defaults /= No_Array_Element then
|
||||
Switches :=
|
||||
Value_Of
|
||||
(Index => Name_Ada, In_Array => Defaults);
|
||||
|
||||
if not Switches.Default then
|
||||
Switch := Switches.Values;
|
||||
|
||||
while Switch /= Nil_String loop
|
||||
Add_Argument
|
||||
(Get_Name_String
|
||||
(String_Elements.Table (Switch).Value));
|
||||
Switch := String_Elements.Table (Switch).Next;
|
||||
end loop;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -550,7 +550,6 @@ package body Rtsfind is
|
|||
declare
|
||||
Loaded : Boolean;
|
||||
pragma Warnings (Off, Loaded);
|
||||
|
||||
begin
|
||||
Loaded := Is_Loaded (U.Uname);
|
||||
end;
|
||||
|
|
@ -569,7 +568,6 @@ package body Rtsfind is
|
|||
|
||||
if U.Unum = No_Unit then
|
||||
Load_Fail ("not found", U_Id, Id);
|
||||
|
||||
elsif Fatal_Error (U.Unum) then
|
||||
Load_Fail ("had parser errors", U_Id, Id);
|
||||
end if;
|
||||
|
|
@ -601,7 +599,6 @@ package body Rtsfind is
|
|||
Set_Analyzed (Cunit (Current_Sem_Unit), True);
|
||||
|
||||
if not Analyzed (Cunit (U.Unum)) then
|
||||
|
||||
Save_Private_Visibility;
|
||||
Semantics (Cunit (U.Unum));
|
||||
Restore_Private_Visibility;
|
||||
|
|
|
|||
|
|
@ -37,11 +37,7 @@ package body System.Exn_Int is
|
|||
-- Exn_Integer --
|
||||
-----------------
|
||||
|
||||
function Exn_Integer
|
||||
(Left : Integer;
|
||||
Right : Natural)
|
||||
return Integer
|
||||
is
|
||||
function Exn_Integer (Left : Integer; Right : Natural) return Integer is
|
||||
pragma Suppress (Division_Check);
|
||||
pragma Suppress (Overflow_Check);
|
||||
|
||||
|
|
|
|||
|
|
@ -36,9 +36,6 @@
|
|||
package System.Exn_Int is
|
||||
pragma Pure (Exn_Int);
|
||||
|
||||
function Exn_Integer
|
||||
(Left : Integer;
|
||||
Right : Natural)
|
||||
return Integer;
|
||||
function Exn_Integer (Left : Integer; Right : Natural) return Integer;
|
||||
|
||||
end System.Exn_Int;
|
||||
|
|
|
|||
|
|
@ -115,11 +115,9 @@ package body Sem_Ch5 is
|
|||
-- Some special bad cases of entity names
|
||||
|
||||
elsif Is_Entity_Name (N) then
|
||||
|
||||
if Ekind (Entity (N)) = E_In_Parameter then
|
||||
Error_Msg_N
|
||||
("assignment to IN mode parameter not allowed", N);
|
||||
return;
|
||||
|
||||
-- Private declarations in a protected object are turned into
|
||||
-- constants when compiling a protected function.
|
||||
|
|
@ -133,27 +131,38 @@ package body Sem_Ch5 is
|
|||
then
|
||||
Error_Msg_N
|
||||
("protected function cannot modify protected object", N);
|
||||
return;
|
||||
|
||||
elsif Ekind (Entity (N)) = E_Loop_Parameter then
|
||||
Error_Msg_N
|
||||
("assignment to loop parameter not allowed", N);
|
||||
return;
|
||||
|
||||
else
|
||||
Error_Msg_N
|
||||
("left hand side of assignment must be a variable", N);
|
||||
end if;
|
||||
|
||||
-- For indexed components, or selected components, test prefix
|
||||
-- For indexed components or selected components, test prefix
|
||||
|
||||
elsif Nkind (N) = N_Indexed_Component
|
||||
or else Nkind (N) = N_Selected_Component
|
||||
then
|
||||
elsif Nkind (N) = N_Indexed_Component then
|
||||
Diagnose_Non_Variable_Lhs (Prefix (N));
|
||||
return;
|
||||
|
||||
-- Another special case for assignment to discriminant.
|
||||
|
||||
elsif Nkind (N) = N_Selected_Component then
|
||||
if Present (Entity (Selector_Name (N)))
|
||||
and then Ekind (Entity (Selector_Name (N))) = E_Discriminant
|
||||
then
|
||||
Error_Msg_N
|
||||
("assignment to discriminant not allowed", N);
|
||||
else
|
||||
Diagnose_Non_Variable_Lhs (Prefix (N));
|
||||
end if;
|
||||
|
||||
else
|
||||
-- If we fall through, we have no special message to issue!
|
||||
|
||||
Error_Msg_N ("left hand side of assignment must be a variable", N);
|
||||
end if;
|
||||
|
||||
-- If we fall through, we have no special message to issue!
|
||||
|
||||
Error_Msg_N ("left hand side of assignment must be a variable", N);
|
||||
end Diagnose_Non_Variable_Lhs;
|
||||
|
||||
-------------------------
|
||||
|
|
@ -396,7 +405,6 @@ package body Sem_Ch5 is
|
|||
(Nkind (Rhs) /= N_Type_Conversion
|
||||
or else Is_Constrained (Etype (Rhs)))
|
||||
then
|
||||
|
||||
-- Assignment verifies that the length of the Lsh and Rhs are equal,
|
||||
-- but of course the indices do not have to match. If the right-hand
|
||||
-- side is a type conversion to an unconstrained type, a length check
|
||||
|
|
@ -597,7 +605,7 @@ package body Sem_Ch5 is
|
|||
Process_Non_Static_Choice => Non_Static_Choice_Error,
|
||||
Process_Associated_Node => Process_Statements);
|
||||
use Case_Choices_Processing;
|
||||
-- Instantiation of the generic choice processing package.
|
||||
-- Instantiation of the generic choice processing package
|
||||
|
||||
-----------------------------
|
||||
-- Non_Static_Choice_Error --
|
||||
|
|
@ -668,11 +676,10 @@ package body Sem_Ch5 is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- If the case expression is a formal object of mode in out,
|
||||
-- then treat it as having a nonstatic subtype by forcing
|
||||
-- use of the base type (which has to get passed to
|
||||
-- Check_Case_Choices below). Also use base type when
|
||||
-- the case expression is parenthesized.
|
||||
-- If the case expression is a formal object of mode in out, then
|
||||
-- treat it as having a nonstatic subtype by forcing use of the base
|
||||
-- type (which has to get passed to Check_Case_Choices below). Also
|
||||
-- use base type when the case expression is parenthesized.
|
||||
|
||||
if Paren_Count (Exp) > 0
|
||||
or else (Is_Entity_Name (Exp)
|
||||
|
|
@ -681,7 +688,7 @@ package body Sem_Ch5 is
|
|||
Exp_Type := Exp_Btype;
|
||||
end if;
|
||||
|
||||
-- Call the instantiated Analyze_Choices which does the rest of the work
|
||||
-- Call instantiated Analyze_Choices which does the rest of the work
|
||||
|
||||
Analyze_Choices
|
||||
(N, Exp_Type, Case_Table, Last_Choice, Dont_Care, Others_Present);
|
||||
|
|
@ -778,7 +785,7 @@ package body Sem_Ch5 is
|
|||
end if;
|
||||
end loop;
|
||||
|
||||
-- Verify that if present the condition is a Boolean expression.
|
||||
-- Verify that if present the condition is a Boolean expression
|
||||
|
||||
if Present (Cond) then
|
||||
Analyze_And_Resolve (Cond, Any_Boolean);
|
||||
|
|
@ -991,7 +998,6 @@ package body Sem_Ch5 is
|
|||
|
||||
procedure Analyze_Implicit_Label_Declaration (N : Node_Id) is
|
||||
Id : constant Node_Id := Defining_Identifier (N);
|
||||
|
||||
begin
|
||||
Enter_Name (Id);
|
||||
Set_Ekind (Id, E_Label);
|
||||
|
|
@ -1003,7 +1009,6 @@ package body Sem_Ch5 is
|
|||
-- Analyze_Iteration_Scheme --
|
||||
------------------------------
|
||||
|
||||
|
||||
procedure Analyze_Iteration_Scheme (N : Node_Id) is
|
||||
procedure Check_Controlled_Array_Attribute (DS : Node_Id);
|
||||
-- If the bounds are given by a 'Range reference on a function call
|
||||
|
|
@ -1101,7 +1106,6 @@ package body Sem_Ch5 is
|
|||
|
||||
declare
|
||||
H : constant Entity_Id := Homonym (Id);
|
||||
|
||||
begin
|
||||
if Present (H)
|
||||
and then Enclosing_Dynamic_Scope (H) =
|
||||
|
|
@ -1248,7 +1252,6 @@ package body Sem_Ch5 is
|
|||
|
||||
procedure Analyze_Label (N : Node_Id) is
|
||||
pragma Warnings (Off, N);
|
||||
|
||||
begin
|
||||
Kill_Current_Values;
|
||||
end Analyze_Label;
|
||||
|
|
@ -1329,7 +1332,6 @@ package body Sem_Ch5 is
|
|||
|
||||
procedure Analyze_Null_Statement (N : Node_Id) is
|
||||
pragma Warnings (Off, N);
|
||||
|
||||
begin
|
||||
null;
|
||||
end Analyze_Null_Statement;
|
||||
|
|
|
|||
|
|
@ -296,20 +296,21 @@ package body Switch.C is
|
|||
Xref_Active := False;
|
||||
Set_Debug_Flag ('g');
|
||||
|
||||
-- Processing for e switch
|
||||
-- -gnate? (extended switches)
|
||||
|
||||
when 'e' =>
|
||||
-- Only -gnateD and -gnatep= are stored
|
||||
|
||||
Ptr := Ptr + 1;
|
||||
|
||||
-- The -gnate? switches are all double character switches
|
||||
-- so we must always have a character after the e.
|
||||
|
||||
if Ptr > Max then
|
||||
raise Bad_Switch;
|
||||
end if;
|
||||
|
||||
case Switch_Chars (Ptr) is
|
||||
|
||||
-- Configuration pragmas
|
||||
-- -gnatec (configuration pragmas)
|
||||
|
||||
when 'c' =>
|
||||
Store_Switch := False;
|
||||
|
|
@ -359,7 +360,7 @@ package body Switch.C is
|
|||
|
||||
return;
|
||||
|
||||
-- Symbol definition
|
||||
-- -gnateD switch (symbol definition)
|
||||
|
||||
when 'D' =>
|
||||
Store_Switch := False;
|
||||
|
|
@ -381,7 +382,7 @@ package body Switch.C is
|
|||
(Storing'First .. First_Stored + Max - Ptr + 2));
|
||||
return;
|
||||
|
||||
-- Full source path for brief error messages
|
||||
-- -gnatef (full source path for brief error messages)
|
||||
|
||||
when 'f' =>
|
||||
Store_Switch := False;
|
||||
|
|
@ -389,7 +390,7 @@ package body Switch.C is
|
|||
Full_Path_Name_For_Brief_Errors := True;
|
||||
return;
|
||||
|
||||
-- Mapping file
|
||||
-- -gnatem (mapping file)
|
||||
|
||||
when 'm' =>
|
||||
Store_Switch := False;
|
||||
|
|
@ -410,7 +411,7 @@ package body Switch.C is
|
|||
new String'(Switch_Chars (Ptr .. Max));
|
||||
return;
|
||||
|
||||
-- Preprocessing data file
|
||||
-- -gnatep (preprocessing data file)
|
||||
|
||||
when 'p' =>
|
||||
Store_Switch := False;
|
||||
|
|
@ -445,19 +446,21 @@ package body Switch.C is
|
|||
Store_Compilation_Switch (To_Store);
|
||||
end;
|
||||
|
||||
return;
|
||||
return;
|
||||
|
||||
-- All other -gnate? switches are unassigned
|
||||
|
||||
when others =>
|
||||
raise Bad_Switch;
|
||||
end case;
|
||||
|
||||
-- Processing for E switch
|
||||
-- -gnatE (dynamic elaboration checks)
|
||||
|
||||
when 'E' =>
|
||||
Ptr := Ptr + 1;
|
||||
Dynamic_Elaboration_Checks := True;
|
||||
|
||||
-- Processing for f switch
|
||||
-- -gnatf (full error messages)
|
||||
|
||||
when 'f' =>
|
||||
Ptr := Ptr + 1;
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue