diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2003-12-01 13:29:28 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2003-12-01 13:29:28 +0000 |
commit | 9988dae3912ad46db3f81b489a1417c6d294fde4 (patch) | |
tree | c0ac6a55329023fb31e9b9e80f35357a07004365 /gcc/ada | |
parent | 1b50d7560a9c09ef6a6123511b4acdcd8a86d994 (diff) | |
download | gcc-9988dae3912ad46db3f81b489a1417c6d294fde4.tar.gz |
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
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@74100 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 45 | ||||
-rw-r--r-- | gcc/ada/Make-lang.in | 33 | ||||
-rw-r--r-- | gcc/ada/Makefile.in | 64 | ||||
-rw-r--r-- | gcc/ada/a-except.adb | 2 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 6 | ||||
-rw-r--r-- | gcc/ada/exp_ch6.adb | 15 | ||||
-rw-r--r-- | gcc/ada/fmap.adb | 2 | ||||
-rw-r--r-- | gcc/ada/g-socket.adb | 12 | ||||
-rw-r--r-- | gcc/ada/g-socket.ads | 10 | ||||
-rw-r--r-- | gcc/ada/mlib-prj.adb | 39 | ||||
-rw-r--r-- | gcc/ada/rtsfind.adb | 3 | ||||
-rw-r--r-- | gcc/ada/s-exnint.adb | 6 | ||||
-rw-r--r-- | gcc/ada/s-exnint.ads | 5 | ||||
-rw-r--r-- | gcc/ada/sem_ch5.adb | 54 | ||||
-rw-r--r-- | gcc/ada/switch-c.adb | 25 |
15 files changed, 175 insertions, 146 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1d55f66fa1f..dbcf21f623b 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 5c47dc1f0a0..aa26bb04251 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 6b4960740ff..4983adc5299 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 d6a6f5ff3c6..cf12af818c7 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 86ff9947620..192e89805d4 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 b0023aa1f44..809eb0b9b2c 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 f65d88781a0..0c7ec893ce2 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 97967a5b8e7..5ad723bab26 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 f78241c4178..27841d8c9d2 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 70fefe57a62..93025586b31 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 4999e0bad3b..3d0acf16026 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 432922147af..10b51d877d9 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 d601b86d537..d35547b7bb5 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 d819cc4d106..ecb00348fa0 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 5f4e6cabadc..837be568d1b 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; |