[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Mon, 1 Dec 2003 13:29:28 +0000 (14:29 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Mon, 1 Dec 2003 13:29:28 +0000 (14:29 +0100)
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

15 files changed:
gcc/ada/ChangeLog
gcc/ada/Make-lang.in
gcc/ada/Makefile.in
gcc/ada/a-except.adb
gcc/ada/exp_ch4.adb
gcc/ada/exp_ch6.adb
gcc/ada/fmap.adb
gcc/ada/g-socket.adb
gcc/ada/g-socket.ads
gcc/ada/mlib-prj.adb
gcc/ada/rtsfind.adb
gcc/ada/s-exnint.adb
gcc/ada/s-exnint.ads
gcc/ada/sem_ch5.adb
gcc/ada/switch-c.adb

index 1d55f66..dbcf21f 100644 (file)
@@ -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.
index 5c47dc1..aa26bb0 100644 (file)
@@ -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 \
index 6b49607..4983adc 100644 (file)
@@ -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 \
index d6a6f5f..cf12af8 100644 (file)
@@ -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;
index 86ff994..192e898 100644 (file)
@@ -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)
index b0023aa..809eb0b 100644 (file)
@@ -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
index f65d887..0c7ec89 100644 (file)
@@ -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;
index 97967a5..5ad723b 100644 (file)
@@ -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 --
    ---------
index f78241c..27841d8 100644 (file)
@@ -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
index 70fefe5..9302558 100644 (file)
@@ -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;
index 4999e0b..3d0acf1 100644 (file)
@@ -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;
index 4329221..10b51d8 100644 (file)
@@ -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);
 
index d601b86..d35547b 100644 (file)
@@ -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;
index d819cc4..ecb0034 100644 (file)
@@ -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;
index 5f4e6ca..837be56 100644 (file)
@@ -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;