aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2003-12-01 14:29:28 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2003-12-01 14:29:28 +0100
commit08aa9a4a1cc0bb4a94b2612a9818578fc9222cde (patch)
treec0ac6a55329023fb31e9b9e80f35357a07004365 /gcc/ada
parent80fcc7bcaefc31cabda221cf137b89fdd2d1cf8d (diff)
downloadgcc-08aa9a4a1cc0bb4a94b2612a9818578fc9222cde.zip
gcc-08aa9a4a1cc0bb4a94b2612a9818578fc9222cde.tar.gz
gcc-08aa9a4a1cc0bb4a94b2612a9818578fc9222cde.tar.bz2
[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
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog45
-rw-r--r--gcc/ada/Make-lang.in33
-rw-r--r--gcc/ada/Makefile.in64
-rw-r--r--gcc/ada/a-except.adb2
-rw-r--r--gcc/ada/exp_ch4.adb6
-rw-r--r--gcc/ada/exp_ch6.adb15
-rw-r--r--gcc/ada/fmap.adb2
-rw-r--r--gcc/ada/g-socket.adb12
-rw-r--r--gcc/ada/g-socket.ads10
-rw-r--r--gcc/ada/mlib-prj.adb39
-rw-r--r--gcc/ada/rtsfind.adb3
-rw-r--r--gcc/ada/s-exnint.adb6
-rw-r--r--gcc/ada/s-exnint.ads5
-rw-r--r--gcc/ada/sem_ch5.adb54
-rw-r--r--gcc/ada/switch-c.adb25
15 files changed, 175 insertions, 146 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1d55f66..dbcf21f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.
diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in
index 5c47dc1..aa26bb0 100644
--- a/gcc/ada/Make-lang.in
+++ b/gcc/ada/Make-lang.in
@@ -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 \
diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in
index 6b49607..4983adc 100644
--- a/gcc/ada/Makefile.in
+++ b/gcc/ada/Makefile.in
@@ -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 \
diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb
index d6a6f5f..cf12af8 100644
--- a/gcc/ada/a-except.adb
+++ b/gcc/ada/a-except.adb
@@ -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;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 86ff994..192e898 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -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)
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index b0023aa..809eb0b 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -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
diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb
index f65d887..0c7ec89 100644
--- a/gcc/ada/fmap.adb
+++ b/gcc/ada/fmap.adb
@@ -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;
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index 97967a5..5ad723b 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -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 --
---------
diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads
index f78241c..27841d8 100644
--- a/gcc/ada/g-socket.ads
+++ b/gcc/ada/g-socket.ads
@@ -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
diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb
index 70fefe5..9302558 100644
--- a/gcc/ada/mlib-prj.adb
+++ b/gcc/ada/mlib-prj.adb
@@ -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);
+ Switches : Variable_Value := Nil_Variable_Value;
+
Switch : String_List_Id := Nil_String;
+
begin
- 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;
+ 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;
diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index 4999e0b..3d0acf1 100644
--- a/gcc/ada/rtsfind.adb
+++ b/gcc/ada/rtsfind.adb
@@ -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;
diff --git a/gcc/ada/s-exnint.adb b/gcc/ada/s-exnint.adb
index 4329221..10b51d8 100644
--- a/gcc/ada/s-exnint.adb
+++ b/gcc/ada/s-exnint.adb
@@ -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);
diff --git a/gcc/ada/s-exnint.ads b/gcc/ada/s-exnint.ads
index d601b86..d35547b 100644
--- a/gcc/ada/s-exnint.ads
+++ b/gcc/ada/s-exnint.ads
@@ -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;
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index d819cc4..ecb0034 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -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;
- end if;
- -- If we fall through, we have no special message to issue!
+ -- 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);
+ Error_Msg_N ("left hand side of assignment must be a variable", N);
+ end if;
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;
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index 5f4e6ca..837be56 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -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;