[multiple changes]

2004-03-02  Emmanuel Briot  <briot@act-europe.fr>

	* ali.adb (Read_Instantiation_Instance): Do not modify the
	current_file_num when reading information about instantiations, since
	this corrupts files in later references.

2004-03-02  Vincent Celier  <celier@gnat.com>

	* bcheck.adb (Check_Consistency): Get the full path of an ALI file
	before checking if it is read-only.

	* bld.adb (Recursive_Process): Concatenate <PROJECT>.src_dirs in front
	of SRC_DIRS and eliminate duplicates.

	* gprcmd.adb: Replace command "path" with command "path_sep" to return
	the path separator.
	(Usage): Document path_sep

	* Makefile.generic: For Ada and GNU C++ cases, link directly with the
	C++ compiler. No need for a script.
	Replace use of C*_INCLUDE_PATH env var for GCC compilers with CPATH.
	Do not call gprcmd to build the C*_INCLUDE_PATHs, do it with function
	subst.

	* prj-env.adb (For_All_Source_Dirs): Only add source dirs in project
	where there are Ada sources.
	(Set_Ada_Paths): Only add to the include path the source dirs of project
	with Ada sources.
	(Add_To_Path): Add the Display_Values of the directories, not their
	Values.

	* prj-nmsc.adb (Find_Sources): Set flag Sources_Present in the project
	data.

	* prj-nmsc.adb (Add_ALI_For): Make sure that the element Display_Value
	is not No_Name.
	(Find_Source_Dirs): Set Display_Value to a non canonicalized value, only
	Value is canonicalized.
	(Language_Independent_Check): Do not copy Value to Display_Value when
	canonicalizing Value.

	* prj-part.adb (Post_Parse_Context_Clause): Compare canonical cased
	path to find limited with cycles.
	(Parse_Single_Project): Use canonical cased path to find the end of a
	with cycle.

2004-03-02  Ed Schonberg  <schonberg@gnat.com>

	* sem_ch10.adb (Optional_Subunit): Verify that unit contains a subunit
	and not a child unit.

	* sinfo.ads, sinfo.adb: Rearrange flags so that Private_Present can
	appear in a with_clause.

	* decl.c (gnat_to_gnu_type): If entity is a generic type, which can
	only happen in type_annotate mode, do not try to elaborate it.

	* exp_util.adb (Force_Evaluation): If expression is a selected
	component on the left of an assignment, use a renaming rather than a
	temporary to remove side effects.

	* freeze.adb (Freeze_Entity): Do not freeze a global entity within an
	inlined instance body, which is analyzed before the end of the
	enclosing scope.

2004-03-02  Robert Dewar  <dewar@gnat.com>

	* par-ch10.adb, par-ch3.adb, par-ch4.adb, scng.adb,
	sem_ch4.adb: Use new feature for substitution of keywords in VMS

	* errout.ads, errout.adb: Implement new circuit for substitution of
	keywords in VMS.

	* sem_case.adb (Analyze_Choices): Place message properly when case is
	a subtype reference rather than an explicit range.

	* sem_elim.adb, s-tpobop.ads, exp_ch2.adb: Minor reformatting

2004-03-02  Doug Rupp  <rupp@gnat.com>

	* init.c (__gnat_initialize)[VMS]: Resignal RDB-E-STREAM_EOF.

2004-03-02  Thomas Quinot  <quinot@act-europe.fr>

	* s-tporft.adb: Add missing locking around call to Initialize_ATCB.

2004-03-02  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* utils.c (finish_record_type): Do not set DECL_NONADDRESSABLE for a
	BLKmode bitfield.

From-SVN: r78758

gcc/ada/ChangeLog

+2004-03-02  Emmanuel Briot  <briot@act-europe.fr>
+
+	* ali.adb (Read_Instantiation_Instance): Do not modify the
+	current_file_num when reading information about instantiations, since
+	this corrupts files in later references.
+
+2004-03-02  Vincent Celier  <celier@gnat.com>
+
+	* bcheck.adb (Check_Consistency): Get the full path of an ALI file
+	before checking if it is read-only.
+
+	* bld.adb (Recursive_Process): Concatenate <PROJECT>.src_dirs in front
+	of SRC_DIRS and eliminate duplicates.
+
+	* gprcmd.adb: Replace command "path" with command "path_sep" to return
+	the path separator.
+	(Usage): Document path_sep
+
+	* Makefile.generic: For Ada and GNU C++ cases, link directly with the
+	C++ compiler. No need for a script.
+	Replace use of C*_INCLUDE_PATH env var for GCC compilers with CPATH.
+	Do not call gprcmd to build the C*_INCLUDE_PATHs, do it with function
+	subst.
+
+	* prj-env.adb (For_All_Source_Dirs): Only add source dirs in project
+	where there are Ada sources.
+	(Set_Ada_Paths): Only add to the include path the source dirs of project
+	with Ada sources.
+	(Add_To_Path): Add the Display_Values of the directories, not their
+	Values.
+
+	* prj-nmsc.adb (Find_Sources): Set flag Sources_Present in the project
+	data.
+
+	* prj-nmsc.adb (Add_ALI_For): Make sure that the element Display_Value
+	is not No_Name.
+	(Find_Source_Dirs): Set Display_Value to a non canonicalized value, only
+	Value is canonicalized.
+	(Language_Independent_Check): Do not copy Value to Display_Value when
+	canonicalizing Value.
+
+	* prj-part.adb (Post_Parse_Context_Clause): Compare canonical cased
+	path to find limited with cycles.
+	(Parse_Single_Project): Use canonical cased path to find the end of a
+	with cycle.
+
+2004-03-02  Ed Schonberg  <schonberg@gnat.com>
+
+	* sem_ch10.adb (Optional_Subunit): Verify that unit contains a subunit
+	and not a child unit.
+
+	* sinfo.ads, sinfo.adb: Rearrange flags so that Private_Present can
+	appear in a with_clause.
+
+	* decl.c (gnat_to_gnu_type): If entity is a generic type, which can
+	only happen in type_annotate mode, do not try to elaborate it.
+
+	* exp_util.adb (Force_Evaluation): If expression is a selected
+	component on the left of an assignment, use a renaming rather than a
+	temporary to remove side effects.
+
+	* freeze.adb (Freeze_Entity): Do not freeze a global entity within an
+	inlined instance body, which is analyzed before the end of the
+	enclosing scope.
+
+2004-03-02  Robert Dewar  <dewar@gnat.com>
+
+	* par-ch10.adb, par-ch3.adb, par-ch4.adb, scng.adb,
+	sem_ch4.adb: Use new feature for substitution of keywords in VMS
+
+	* errout.ads, errout.adb: Implement new circuit for substitution of
+	keywords in VMS.
+
+	* sem_case.adb (Analyze_Choices): Place message properly when case is
+	a subtype reference rather than an explicit range.
+
+	* sem_elim.adb, s-tpobop.ads, exp_ch2.adb: Minor reformatting
+
+2004-03-02  Doug Rupp  <rupp@gnat.com>
+
+	* init.c (__gnat_initialize)[VMS]: Resignal RDB-E-STREAM_EOF.
+
+2004-03-02  Thomas Quinot  <quinot@act-europe.fr>
+
+	* s-tporft.adb: Add missing locking around call to Initialize_ATCB.
+
+2004-03-02  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* utils.c (finish_record_type): Do not set DECL_NONADDRESSABLE for a
+	BLKmode bitfield.
+
 2004-02-25  Robert Dewar  <dewar@gnat.com>
 
 	* 51osinte.ads, 52osinte.ads, 53osinte.ads, 54osinte.ads,

gcc/ada/Makefile.generic

@@ -230,20 +230,16 @@ ifeq ($(filter c++,$(LANGUAGES)),c++)
 
    ifeq ($(filter ada,$(LANGUAGES)),ada)
       # C++ and Ada mixed
-      LINKER = $(OBJ_DIR)/c++linker
       LARGS = --LINK=$(LINKER)
 
       ifeq ($(strip $(filter-out %gcc %g++,$(CXX))),)
-         # Case of GNU C++ and GNAT
-
-$(LINKER): Makefile.$(PROJECT_BASE)
-	@echo \#!/bin/sh > $(LINKER)
-	@echo unset BINUTILS_ROOT >> $(LINKER)
-	@echo unset GCC_ROOT >> $(LINKER)
-	@echo $(CXX) $$\* >> $(LINKER)
-	@chmod +x $(LINKER)
+         # Case of GNAT and a GNU C++ compiler
+$(LINKER):
 
       else
+         # Case of GNAT and a non GNU C++ compiler
+         LINKER = $(OBJ_DIR)/c++linker
+
 $(LINKER): Makefile.$(PROJECT_BASE)
 	@echo \#!/bin/sh > $(LINKER)
 	@echo $(CXX) $$\* $(shell gcc -print-libgcc-file-name) >> $(LINKER)
@@ -399,10 +395,13 @@ endif
 
 ifeq ($(strip $(filter-out %gcc %g++,$(CC) $(CXX))),)
 # Compiler is GCC, take avantage of the preprocessor option -MD and
-# C*_INCLUDE_PATH environment variables
+# the CPATH environment variable
 
-export C_INCLUDE_PATH:=$(shell gprcmd path $(SRC_DIRS))$(C_INCLUDE_PATH)
-export CXX_INCLUDE_PATH:=$(shell gprcmd path $(SRC_DIRS))$(CXX_INCLUDE_PATH)
+empty:=
+space:=$(empty) $(empty)
+path_sep:=$(shell gprcmd path_sep)
+SRC_DIRS_PATH:= $(subst $(space),$(path_sep),$(SRC_DIRS))
+export CPATH:=$(SRC_DIRS_PATH)$(path_sep)$(CPATH)
 
 DEP_CFLAGS = -Wp,-MD,$(OBJ_DIR)/$(*F).d
 

gcc/ada/ali.adb

@@ -1811,6 +1811,8 @@ package body ALI is
                   ----------------------------------
 
                   procedure Read_Instantiation_Reference is
+                     Local_File_Num : Sdep_Id := Current_File_Num;
+
                   begin
                      Xref.Increment_Last;
 
@@ -1824,12 +1826,12 @@ package body ALI is
                         if Nextc = '|' then
                            XR.File_Num :=
                              Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
-                           Current_File_Num := XR.File_Num;
+                           Local_File_Num := XR.File_Num;
                            P := P + 1;
                            N := Get_Nat;
 
                         else
-                           XR.File_Num := Current_File_Num;
+                           XR.File_Num := Local_File_Num;
                         end if;
 
                         XR.Line  := N;

gcc/ada/bcheck.adb

@@ -572,6 +572,8 @@ package body Bcheck is
       Src : Source_Id;
       --  Source file Id for this Sdep entry
 
+      ALI_Path_Id : Name_Id;
+
    begin
       --  First, we go through the source table to see if there are any cases
       --  in which we should go after source files and compute checksums of
@@ -655,18 +657,17 @@ package body Bcheck is
                   end if;
 
                else
-                  if Osint.Is_Readonly_Library (ALIs.Table (A).Afile) then
-                     Error_Msg_Name_2 :=
-                       Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library);
-
+                  ALI_Path_Id :=
+                    Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library);
+                  if Osint.Is_Readonly_Library (ALI_Path_Id) then
                      if Tolerate_Consistency_Errors then
                         Error_Msg ("?% should be recompiled");
-                        Error_Msg_Name_1 := Error_Msg_Name_2;
+                        Error_Msg_Name_1 := ALI_Path_Id;
                         Error_Msg ("?(% is obsolete and read-only)");
 
                      else
                         Error_Msg ("% must be compiled");
-                        Error_Msg_Name_1 := Error_Msg_Name_2;
+                        Error_Msg_Name_1 := ALI_Path_Id;
                         Error_Msg ("(% is obsolete and read-only)");
                      end if;
 

gcc/ada/bld.adb

@@ -3120,11 +3120,14 @@ package body Bld is
                   end if;
                end if;
 
-               --  Add source dirs of this project file to variable SRC_DIRS
+               --  Add source dirs of this project file to variable SRC_DIRS.
+               --  Put them in front, and remove duplicates.
 
-               Put ("SRC_DIRS:=$(SRC_DIRS) $(");
+               Put ("SRC_DIRS:=$(");
                Put (Uname);
-               Put (".src_dirs)");
+               Put (".src_dirs) $(filter-out $(");
+               Put (Uname);
+               Put (".src_dirs),$(SRC_DIRS))");
                New_Line;
 
                --  Set OBJ_DIR to the object directory

gcc/ada/decl.c

@@ -114,6 +114,10 @@ gnat_to_gnu_type (Entity_Id gnat_entity)
 {
   tree gnu_decl;
 
+  /* The back end never attempts to annotate generic types */
+  if (Is_Generic_Type (gnat_entity) && type_annotate_only)
+     return void_type_node;
+
   /* Convert the ada entity type into a GCC TYPE_DECL node.  */
   gnu_decl = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
   if (TREE_CODE (gnu_decl) != TYPE_DECL)

gcc/ada/errout.adb

@@ -37,6 +37,7 @@ with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Erroutc;  use Erroutc;
 with Fname;    use Fname;
+with Hostparm; use Hostparm;
 with Lib;      use Lib;
 with Namet;    use Namet;
 with Opt;      use Opt;
@@ -187,6 +188,14 @@ package body Errout is
    --  'Class appended to its name (see Add_Class procedure), and is
    --  otherwise unchanged.
 
+   procedure VMS_Convert;
+   --  This procedure has no effect if called when the host is not OpenVMS.
+   --  If the host is indeed OpenVMS, then the error message stored in
+   --  Msg_Buffer is scanned for appearences of switch names which need
+   --  converting to corresponding VMS qualifer names. See Gnames/Vnames
+   --  table in Errout spec for precise definition of the conversion that
+   --  is performed by this routine in OpenVMS mode.
+
    -----------------------
    -- Change_Error_Text --
    -----------------------
@@ -2258,6 +2267,8 @@ package body Errout is
                Set_Msg_Char (C);
          end case;
       end loop;
+
+      VMS_Convert;
    end Set_Msg_Text;
 
    ----------------
@@ -2485,4 +2496,53 @@ package body Errout is
       end if;
    end Unwind_Internal_Type;
 
+   -----------------
+   -- VMS_Convert --
+   -----------------
+
+   procedure VMS_Convert is
+      P : Natural;
+      L : Natural;
+      N : Natural;
+
+   begin
+      if not OpenVMS then
+         return;
+      end if;
+
+      P := Msg_Buffer'First;
+      loop
+         if P >= Msglen then
+            return;
+         end if;
+
+         if Msg_Buffer (P) = '-' then
+            for G in Gnames'Range loop
+               L := Gnames (G)'Length;
+
+               --  See if we have "-ggg switch", where ggg is Gnames entry
+
+               if P + L + 7 <= Msglen
+                 and then Msg_Buffer (P + 1 .. P + L) = Gnames (G).all
+                 and then Msg_Buffer (P + L + 1 .. P + L + 7) = " switch"
+               then
+                  --  Replace by "/vvv qualifier", where vvv is Vnames entry
+
+                  N := Vnames (G)'Length;
+                  Msg_Buffer (P + N + 11 .. Msglen + N - L + 3) :=
+                    Msg_Buffer (P + L + 8 .. Msglen);
+                  Msg_Buffer (P) := '/';
+                  Msg_Buffer (P + 1 .. P + N) := Vnames (G).all;
+                  Msg_Buffer (P + N + 1 .. P + N + 10) := " qualifier";
+                  P := P + N + 10;
+                  Msglen := Msglen + N - L + 3;
+                  exit;
+               end if;
+            end loop;
+         end if;
+
+         P := P + 1;
+      end loop;
+   end VMS_Convert;
+
 end Errout;

gcc/ada/errout.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -276,6 +276,43 @@ package Errout is
    --      to be non-serious, and does not cause Serious_Errors_Detected
    --      to be incremented (so expansion is not prevented by such a msg).
 
+   ----------------------------------------
+   -- Specialization of Messages for VMS --
+   ----------------------------------------
+
+   --  Some messages mention gcc-style switch names. When using an OpenVMS
+   --  host, such switch names must be converted to their corresponding VMS
+   --  qualifer. The following table controls this translation. In each case
+   --  the original message must contain the string "-xxx switch", where xxx
+   --  is the Gname? entry from below, and this string will be replaced by
+   --  "/yyy qualifier", where yyy is the corresponding Vname? entry.
+
+   Gname1 : aliased constant String := "fno-strict-aliasing";
+   Vname1 : aliased constant String := "OPTIMIZE=NO_ALIASING";
+
+   Gname2 : aliased constant String := "gnatX";
+   Vname2 : aliased constant String := "EXTENSIONS_ALLOWED";
+
+   Gname3 : aliased constant String := "gnatW";
+   Vname3 : aliased constant String := "WIDE_CHARACTER_ENCODING";
+
+   Gname4 : aliased constant String := "gnatf";
+   Vname4 : aliased constant String := "REPORT_ERRORS=FULL";
+
+   type Cstring_Ptr is access constant String;
+
+   Gnames : array (Nat range <>) of Cstring_Ptr :=
+              (Gname1'Access,
+               Gname2'Access,
+               Gname3'Access,
+               Gname4'Access);
+
+   Vnames : array (Nat range <>) of Cstring_Ptr :=
+              (Vname1'Access,
+               Vname2'Access,
+               Vname3'Access,
+               Vname4'Access);
+
    -----------------------------------------------------
    -- Global Values Used for Error Message Insertions --
    -----------------------------------------------------

gcc/ada/exp_ch2.adb

@@ -695,6 +695,7 @@ package body Exp_Ch2 is
    --  where rec is a selector whose Entry_Formal link points to the formal
    --  For a formal of a task entity, the formal is rewritten as a local
    --  renaming.
+
    --  In addition, a formal that is marked volatile because it is aliased
    --  through an address clause is rewritten as dereference as well.
 

gcc/ada/exp_util.adb

@@ -1320,8 +1320,41 @@ package body Exp_Util is
    ----------------------
 
    procedure Force_Evaluation (Exp : Node_Id; Name_Req : Boolean := False) is
+      Component_In_Lhs : Boolean := False;
+      Par              : Node_Id;
+
    begin
-      Remove_Side_Effects (Exp, Name_Req, Variable_Ref => True);
+      --  Loop to determine whether there is a component reference in
+      --  the left hand side if this appears on the left side of an
+      --  assignment statement. Needed to determine if form of result
+      --  must be a variable.
+
+      Par := Exp;
+      while Present (Par)
+        and then Nkind (Par) = N_Selected_Component
+      loop
+         if Nkind (Parent (Par)) = N_Assignment_Statement
+           and then Par = Name (Parent (Par))
+         then
+            Component_In_Lhs := True;
+            exit;
+         else
+            Par := Parent (Par);
+         end if;
+      end loop;
+
+      --  If the expression is a selected component, it is being evaluated
+      --  as part of a discriminant check. If it is part of a left-hand
+      --  side, this is the last use of its value and it is safe to create
+      --  a renaming for it, rather than a temporary. In addition, if it
+      --  is not an addressable field, creating a temporary may be a problem
+      --  for gigi, or might drop the value of the assignment. Therefore,
+      --  if the expression is on the lhs of an assignment, remove side
+      --  effects without requiring a temporary, and create a renaming.
+      --  (See remove_side_effects for details).
+
+      Remove_Side_Effects
+        (Exp, Name_Req, Variable_Ref => not Component_In_Lhs);
    end Force_Evaluation;
 
    ------------------------

gcc/ada/freeze.adb

@@ -1909,6 +1909,35 @@ package body Freeze is
                S := Scope (S);
             end loop;
          end;
+
+      --  Similarly, an inlined instance body may make reference to global
+      --  entities, but these references cannot be the proper freezing point
+      --  for them, and the the absence of inlining freezing will take place
+      --  in their own scope. Normally instance bodies are analyzed after
+      --  the enclosing compilation, and everything has been frozen at the
+      --  proper place, but with front-end inlining an instance body is
+      --  compiled before the end of the enclosing scope, and as a result
+      --  out-of-order freezing must be prevented.
+
+      elsif Front_End_Inlining
+        and then  In_Instance_Body
+        and then Present (Scope (E))
+      then
+         declare
+            S : Entity_Id := Scope (E);
+         begin
+            while Present (S) loop
+               if Is_Generic_Instance (S) then
+                  exit;
+               else
+                  S := Scope (S);
+               end if;
+            end loop;
+
+            if No (S) then
+               return No_List;
+            end if;
+         end;
       end if;
 
       --  Here to freeze the entity

gcc/ada/gprcmd.adb

@@ -372,8 +372,8 @@ procedure Gprcmd is
                                 "copy file time stamp from file1 to file2");
       Put_Line (Standard_Error, "  prefix      " &
                                 "get the prefix of the GNAT installation");
-      Put_Line (Standard_Error, "  path        " &
-                                "convert a directory list into a path list");
+      Put_Line (Standard_Error, "  path_sep    " &
+                                "returns the path separator");
       Put_Line (Standard_Error, "  linkopts      " &
                                 "process attribute Linker'Linker_Options");
       Put_Line (Standard_Error, "  ignore      " &
@@ -530,11 +530,8 @@ begin
 
       --  For "path" just add path separator after each directory argument
 
-      elsif Cmd = "path" then
-         for J in 2 .. Argument_Count loop
-            Put (Argument (J));
-            Put (Path_Separator);
-         end loop;
+      elsif Cmd = "path_sep" then
+         Put (Path_Separator);
 
       --  Check the linker options for relative paths. Insert the project
       --  base dir before relative paths.

gcc/ada/init.c

@@ -1401,6 +1401,9 @@ __gnat_error_handler (int *sigargs, void *mechargs)
     case 1381050: /* Nickerson bug #33 ??? */
       return SS$_RESIGNAL;
 
+    case 20480426: /* RDB-E-STREAM_EOF */
+      return SS$_RESIGNAL;
+
     case 11829410: /* Resignalled as Use_Error for CE10VRC */
       return SS$_RESIGNAL;
 

gcc/ada/par-ch10.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -30,7 +30,6 @@ pragma Style_Checks (All_Checks);
 
 with Fname;    use Fname;
 with Fname.UF; use Fname.UF;
-with Hostparm; use Hostparm;
 with Uname;    use Uname;
 
 separate (Par)
@@ -796,15 +795,8 @@ package body Ch10 is
 
             if not Extensions_Allowed then
                Error_Msg_SP ("`LIMITED WITH` is an Ada0X extension");
-
-               if OpenVMS then
-                  Error_Msg_SP
-                    ("\unit must be compiled with " &
-                     "'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
-               else
-                  Error_Msg_SP
-                    ("\unit must be compiled with -gnatX switch");
-               end if;
+               Error_Msg_SP
+                 ("\unit must be compiled with -gnatX switch");
             end if;
          else
             Has_Limited := False;
@@ -819,15 +811,7 @@ package body Ch10 is
 
                if not Extensions_Allowed then
                   Error_Msg_SP ("`WITH TYPE` is a non-standard extension");
-
-                  if OpenVMS then
-                     Error_Msg_SP
-                       ("\unit must be compiled with " &
-                        "'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
-                  else
-                     Error_Msg_SP
-                       ("\unit must be compiled with -gnatX switch");
-                  end if;
+                  Error_Msg_SP ("\unit must be compiled with -gnatX switch");
                end if;
 
                Scan;  -- past TYPE

gcc/ada/par-ch3.adb

@@ -28,7 +28,6 @@ pragma Style_Checks (All_Checks);
 --  Turn off subprogram body ordering check. Subprograms are in order
 --  by RM section rather than alphabetical
 
-with Hostparm; use Hostparm;
 with Sinfo.CN; use Sinfo.CN;
 
 separate (Par)
@@ -1325,15 +1324,7 @@ package body Ch3 is
                Error_Msg_SP
                  ("generalized use of anonymous access types " &
                   "is an Ada 0Y extension");
-
-               if OpenVMS then
-                  Error_Msg_SP
-                    ("\unit must be compiled with " &
-                     "'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
-               else
-                  Error_Msg_SP
-                    ("\unit must be compiled with -gnatX switch");
-               end if;
+               Error_Msg_SP ("\unit must be compiled with -gnatX switch");
             end if;
 
             Acc_Node := P_Access_Definition;
@@ -2125,15 +2116,7 @@ package body Ch3 is
             Error_Msg_SP
               ("generalized use of anonymous access types " &
                "is an Ada 0Y extension");
-
-            if OpenVMS then
-               Error_Msg_SP
-                 ("\unit must be compiled with " &
-                  "'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
-            else
-               Error_Msg_SP
-                 ("\unit must be compiled with -gnatX switch");
-            end if;
+            Error_Msg_SP ("\unit must be compiled with -gnatX switch");
          end if;
 
          Set_Subtype_Indication (CompDef_Node, Empty);
@@ -2862,15 +2845,7 @@ package body Ch3 is
                   Error_Msg_SP
                     ("Generalized use of anonymous access types " &
                      "is an Ada0X extension");
-
-                  if OpenVMS then
-                     Error_Msg_SP
-                       ("\unit must be compiled with " &
-                        "'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
-                  else
-                     Error_Msg_SP
-                       ("\unit must be compiled with -gnatX switch");
-                  end if;
+                  Error_Msg_SP ("\unit must be compiled with -gnatX switch");
                end if;
 
                Set_Subtype_Indication (CompDef_Node, Empty);

gcc/ada/par-ch4.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -28,8 +28,6 @@ pragma Style_Checks (All_Checks);
 --  Turn off subprogram body ordering check. Subprograms are in order
 --  by RM section rather than alphabetical
 
-with Hostparm; use Hostparm;
-
 separate (Par)
 package body Ch4 is
 
@@ -1411,15 +1409,7 @@ package body Ch4 is
          if not Extensions_Allowed then
             Error_Msg_SP
               ("(Ada 0Y) limited aggregates are an Ada0X extension");
-
-            if OpenVMS then
-               Error_Msg_SP
-                 ("\unit must be compiled with " &
-                  "'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
-            else
-               Error_Msg_SP
-                 ("\unit must be compiled with -gnatX switch");
-            end if;
+            Error_Msg_SP ("\unit must be compiled with -gnatX switch");
          end if;
 
          Set_Box_Present (Assoc_Node);

gcc/ada/prj-env.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 2001-2004 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -61,25 +61,25 @@ package body Prj.Env is
    --  platforms, except on VMS where the logical names are deassigned, thus
    --  avoiding the pollution of the environment of the caller.
 
-   package Namings is new Table.Table (
-     Table_Component_Type => Naming_Data,
-     Table_Index_Type     => Naming_Id,
-     Table_Low_Bound      => 1,
-     Table_Initial        => 5,
-     Table_Increment      => 100,
-     Table_Name           => "Prj.Env.Namings");
+   package Namings is new Table.Table
+     (Table_Component_Type => Naming_Data,
+      Table_Index_Type     => Naming_Id,
+      Table_Low_Bound      => 1,
+      Table_Initial        => 5,
+      Table_Increment      => 100,
+      Table_Name           => "Prj.Env.Namings");
 
    Default_Naming : constant Naming_Id := Namings.First;
 
    Fill_Mapping_File : Boolean := True;
 
-   package Path_Files is new Table.Table (
-     Table_Component_Type => Name_Id,
-     Table_Index_Type     => Natural,
-     Table_Low_Bound      => 1,
-     Table_Initial        => 50,
-     Table_Increment      => 50,
-     Table_Name           => "Prj.Env.Path_Files");
+   package Path_Files is new Table.Table
+     (Table_Component_Type => Name_Id,
+      Table_Index_Type     => Natural,
+      Table_Low_Bound      => 1,
+      Table_Initial        => 50,
+      Table_Increment      => 50,
+      Table_Name           => "Prj.Env.Path_Files");
    --  Table storing all the temp path file names.
    --  Used by Delete_All_Path_Files.
 
@@ -322,7 +322,7 @@ package body Prj.Env is
    begin
       while Current /= Nil_String loop
          Source_Dir := String_Elements.Table (Current);
-         Add_To_Path (Get_Name_String (Source_Dir.Value));
+         Add_To_Path (Get_Name_String (Source_Dir.Display_Value));
          Current := Source_Dir.Next;
       end loop;
    end Add_To_Path;
@@ -1420,13 +1420,16 @@ package body Prj.Env is
             The_String : String_Element;
 
          begin
-            --  Call action with the name of every source directorie
-
-            while Current /= Nil_String loop
-               The_String := String_Elements.Table (Current);
-               Action (Get_Name_String (The_String.Value));
-               Current := The_String.Next;
-            end loop;
+            --  If there are Ada sources, call action with the name of every
+            --  source directory.
+
+            if Projects.Table (Project).Sources_Present then
+               while Current /= Nil_String loop
+                  The_String := String_Elements.Table (Current);
+                  Action (Get_Name_String (The_String.Value));
+                  Current := The_String.Next;
+               end loop;
+            end if;
          end;
 
          --  If we are extending a project, visit it
@@ -1866,8 +1869,11 @@ package body Prj.Env is
                if Process_Source_Dirs then
 
                   --  Add to path all source directories of this project
+                  --  if there are Ada sources.
 
-                  Add_To_Path_File (Data.Source_Dirs, Source_FD);
+                  if Projects.Table (Project).Sources_Present then
+                     Add_To_Path_File (Data.Source_Dirs, Source_FD);
+                  end if;
                end if;
 
                if Process_Object_Dirs then

gcc/ada/prj-part.adb

@@ -759,6 +759,7 @@ package body Prj.Part is
                   begin
                      Name_Len := Normed'Length;
                      Name_Buffer (1 .. Name_Len) := Normed;
+                     Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
                      Canonical_Path_Name := Name_Find;
 
                      for Index in 1 .. Project_Stack.Last loop
@@ -886,7 +887,9 @@ package body Prj.Part is
             for Current in reverse 1 .. Project_Stack.Last loop
                Error_Msg_Name_1 := Project_Stack.Table (Current).Path_Name;
 
-               if Error_Msg_Name_1 /= Canonical_Path_Name then
+               if Project_Stack.Table (Current).Canonical_Path_Name /=
+                    Canonical_Path_Name
+               then
                   Error_Msg
                     ("\  { which itself is imported by", Token_Ptr);
 

gcc/ada/s-tpobop.ads

@@ -110,7 +110,10 @@ package System.Tasking.Protected_Objects.Operations is
    --
    --  This must be called with abortion deferred and with the corresponding
    --  object locked.
-   --  If Unlock_Object, then Object is unlocked on return.
+   --
+   --  If Unlock_Object is set True, then Object is unlocked on return,
+   --  otherwise Object remains locked and the caller is responsible for
+   --  the required unlock.
 
    procedure Complete_Entry_Body (Object : Entries.Protection_Entries_Access);
    --  Called from within an entry body procedure, indicates that the

gcc/ada/s-tporft.adb

@@ -63,11 +63,13 @@ begin
 
    --  Finish initialization
 
+   Lock_RTS;
    System.Tasking.Initialize_ATCB
      (Self_Id, null, Null_Address, Null_Task,
       Foreign_Task_Elaborated'Access,
       System.Priority'First, Task_Info.Unspecified_Task_Info, 0, Self_Id,
       Succeeded);
+   Unlock_RTS;
    pragma Assert (Succeeded);
 
    Self_Id.Master_of_Task := 0;

gcc/ada/scng.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -333,15 +333,7 @@ package body Scng is
 
       procedure Error_Illegal_Wide_Character is
       begin
-         if OpenVMS then
-            Error_Msg_S
-              ("illegal wide character, check " &
-                 "'/'W'I'D'E'_'C'H'A'R'A'C'T'E'R'_'E'N'C'O'D'I'N'G qualifier");
-         else
-            Error_Msg_S
-              ("illegal wide character, check -gnatW switch");
-         end if;
-
+         Error_Msg_S ("illegal wide character, check -gnatW switch");
          Scan_Ptr := Scan_Ptr + 1;
       end Error_Illegal_Wide_Character;
 

gcc/ada/sem_case.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1996-2004 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -556,6 +556,9 @@ package body Sem_Case is
       is
          E : Entity_Id;
 
+         Enode : Node_Id;
+         --  This is where we post error messages for bounds out of range
+
          Nb_Choices        : constant Nat := Choice_Table'Length;
          Sort_Choice_Table : Sort_Choice_Table_Type (0 .. Nb_Choices);
 
@@ -638,24 +641,55 @@ package body Sem_Case is
                end if;
             end if;
 
-            --  Check for bound out of range.
+            --  Check for low bound out of range
 
             if Lo_Val < Bounds_Lo then
+
+               --  If the choice is an entity name, then it is a type, and
+               --  we want to post the message on the reference to this
+               --  entity. Otherwise we want to post it on the lower bound
+               --  of the range.
+
+               if Is_Entity_Name (Choice) then
+                  Enode := Choice;
+               else
+                  Enode := Lo;
+               end if;
+
+               --  Specialize message for integer/enum type
+
                if Is_Integer_Type (Bounds_Type) then
                   Error_Msg_Uint_1 := Bounds_Lo;
-                  Error_Msg_N ("minimum allowed choice value is^", Lo);
+                  Error_Msg_N ("minimum allowed choice value is^", Enode);
                else
                   Error_Msg_Name_1 := Choice_Image (Bounds_Lo, Bounds_Type);
-                  Error_Msg_N ("minimum allowed choice value is%", Lo);
+                  Error_Msg_N ("minimum allowed choice value is%", Enode);
                end if;
+            end if;
+
+            --  Check for high bound out of range
+
+            if Hi_Val > Bounds_Hi then
+
+               --  If the choice is an entity name, then it is a type, and
+               --  we want to post the message on the reference to this
+               --  entity. Otherwise we want to post it on the upper bound
+               --  of the range.
+
+               if Is_Entity_Name (Choice) then
+                  Enode := Choice;
+               else
+                  Enode := Hi;
+               end if;
+
+               --  Specialize message for integer/enum type
 
-            elsif Hi_Val > Bounds_Hi then
                if Is_Integer_Type (Bounds_Type) then
                   Error_Msg_Uint_1 := Bounds_Hi;
-                  Error_Msg_N ("maximum allowed choice value is^", Hi);
+                  Error_Msg_N ("maximum allowed choice value is^", Enode);
                else
                   Error_Msg_Name_1 := Choice_Image (Bounds_Hi, Bounds_Type);
-                  Error_Msg_N ("maximum allowed choice value is%", Hi);
+                  Error_Msg_N ("maximum allowed choice value is%", Enode);
                end if;
             end if;
 

gcc/ada/sem_ch10.adb

@@ -958,9 +958,15 @@ package body Sem_Ch10 is
          then
             Comp_Unit := Cunit (Unum);
 
-            Set_Corresponding_Stub (Unit (Comp_Unit), N);
-            Analyze_Subunit (Comp_Unit);
-            Set_Library_Unit (N, Comp_Unit);
+            if Nkind (Unit (Comp_Unit)) /= N_Subunit then
+               Error_Msg_N
+                 ("expected SEPARATE subunit, found child unit",
+                  Cunit_Entity (Unum));
+            else
+               Set_Corresponding_Stub (Unit (Comp_Unit), N);
+               Analyze_Subunit (Comp_Unit);
+               Set_Library_Unit (N, Comp_Unit);
+            end if;
 
          elsif Unum = No_Unit
            and then Present (Nam)

gcc/ada/sem_ch4.adb

@@ -29,7 +29,6 @@ with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Errout;   use Errout;
 with Exp_Util; use Exp_Util;
-with Hostparm; use Hostparm;
 with Itypes;   use Itypes;
 with Lib.Xref; use Lib.Xref;
 with Namet;    use Namet;
@@ -285,14 +284,7 @@ package body Sem_Ch4 is
          List_Operand_Interps (Left_Opnd  (N));
          List_Operand_Interps (Right_Opnd (N));
       else
-
-         if OpenVMS then
-            Error_Msg_N (
-               "\use '/'R'E'P'O'R'T'_'E'R'R'O'R'S'='F'U'L'L for details",
-                N);
-         else
-            Error_Msg_N ("\use -gnatf for details", N);
-         end if;
+         Error_Msg_N ("\use -gnatf switch for details", N);
       end if;
    end Ambiguous_Operands;
 

gcc/ada/sem_elim.adb

@@ -289,11 +289,11 @@ package body Sem_Elim is
 
             --  Then we need to see if the static scope matches within the
             --  compilation unit.
+
             --  At the moment, gnatelim does not consider block statements as
             --  scopes (even if a block is named)
 
             Scop := Scope (E);
-
             while Ekind (Scop) = E_Block loop
                Scop := Scope (Scop);
             end loop;
@@ -305,7 +305,6 @@ package body Sem_Elim is
                   end if;
 
                   Scop := Scope (Scop);
-
                   while Ekind (Scop) = E_Block loop
                      Scop := Scope (Scop);
                   end loop;
@@ -324,7 +323,6 @@ package body Sem_Elim is
                end if;
 
                Scop := Scope (Scop);
-
                while Ekind (Scop) = E_Block loop
                   Scop := Scope (Scop);
                end loop;

gcc/ada/sinfo.adb

@@ -861,7 +861,7 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_With_Clause);
-      return Flag15 (N);
+      return Flag14 (N);
    end Elaborate_All_Present;
 
    function Elaborate_Present
@@ -2040,7 +2040,8 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Compilation_Unit
-        or else NT (N).Nkind = N_Formal_Derived_Type_Definition);
+        or else NT (N).Nkind = N_Formal_Derived_Type_Definition
+        or else NT (N).Nkind = N_With_Clause);
       return Flag15 (N);
    end Private_Present;
 
@@ -3317,7 +3318,7 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_With_Clause);
-      Set_Flag15 (N, Val);
+      Set_Flag14 (N, Val);
    end Set_Elaborate_All_Present;
 
    procedure Set_Elaborate_Present
@@ -4487,7 +4488,8 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Compilation_Unit
-        or else NT (N).Nkind = N_Formal_Derived_Type_Definition);
+        or else NT (N).Nkind = N_Formal_Derived_Type_Definition
+        or else NT (N).Nkind = N_With_Clause);
       Set_Flag15 (N, Val);
    end Set_Private_Present;
 

gcc/ada/sinfo.ads

@@ -825,7 +825,7 @@ package Sinfo is
    --    This flag is set in the N_With_Clause node to indicate that a
    --    pragma Elaborate pragma appears for the with'ed units.
 
-   --  Elaborate_All_Present (Flag15-Sem)
+   --  Elaborate_All_Present (Flag14-Sem)
    --    This flag is set in the N_With_Clause node to indicate that a
    --    pragma Elaborate_All pragma appears for the with'ed units.
 
@@ -872,7 +872,7 @@ package Sinfo is
    --    generic templates, this is harmless.
 
    --  Entity_Or_Associated_Node (Node4-Sem)
-   --    A synonym for both Entity and Asasociated_Node. Used by convention
+   --    A synonym for both Entity and Associated_Node. Used by convention
    --    in the code when referencing this field in cases where it is not
    --    known whether the field contains an Entity or an Associated_Node.
 
@@ -5102,7 +5102,8 @@ package Sinfo is
       --  Last_Name (Flag6) (set to True if last name or only one name)
       --  Context_Installed (Flag13-Sem)
       --  Elaborate_Present (Flag4-Sem)
-      --  Elaborate_All_Present (Flag15-Sem)
+      --  Elaborate_All_Present (Flag14-Sem)
+      --  Private_Present (Flag15) set if with_clause has private keyword
       --  Implicit_With (Flag16-Sem)
       --  Limited_Present (Flag17)  set if LIMITED is present
       --  Limited_View_Installed (Flag18-Sem)
@@ -5111,6 +5112,7 @@ package Sinfo is
 
       --  Note: Limited_Present and Limited_View_Installed give support to
       --        Ada 0Y (AI-50217).
+      --  Similarly, Private_Present gives support to AI-50262.
 
       ----------------------
       -- With_Type clause --
@@ -7120,7 +7122,7 @@ package Sinfo is
      (N : Node_Id) return Boolean;    -- Flag13
 
    function Elaborate_All_Present
-     (N : Node_Id) return Boolean;    -- Flag15
+     (N : Node_Id) return Boolean;    -- Flag14
 
    function Elaborate_Present
      (N : Node_Id) return Boolean;    -- Flag4
@@ -7906,7 +7908,7 @@ package Sinfo is
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
    procedure Set_Elaborate_All_Present
-     (N : Node_Id; Val : Boolean := True);    -- Flag15
+     (N : Node_Id; Val : Boolean := True);    -- Flag14
 
    procedure Set_Elaborate_Present
      (N : Node_Id; Val : Boolean := True);    -- Flag4

gcc/ada/utils.c

@@ -791,8 +791,11 @@ finish_record_type (tree record_type,
 	DECL_BIT_FIELD (field) = 0;
 
       /* If we still have DECL_BIT_FIELD set at this point, we know the field
-	 is technically not addressable.  */
-      DECL_NONADDRESSABLE_P (field) |= DECL_BIT_FIELD (field);
+	 is technically not addressable.  Except that it can actually be
+	 addressed if the field is BLKmode and happens to be properly
+	 aligned.  */
+      DECL_NONADDRESSABLE_P (field)
+	|= DECL_BIT_FIELD (field) && DECL_MODE (field) != BLKmode;
 
       if (has_rep && ! DECL_BIT_FIELD (field))
 	TYPE_ALIGN (record_type)