diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-03-02 13:50:15 +0000 | 
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-03-02 13:50:15 +0000 | 
| commit | f98319dc96d784a6cb010309c645db5b271322ba (patch) | |
| tree | ffca003370276e7fdf11cb7188a875852481cff5 | |
| parent | c8657a08116e11b3b629b079f25f0f0ebd79463c (diff) | |
| download | ppe42-gcc-f98319dc96d784a6cb010309c645db5b271322ba.tar.gz ppe42-gcc-f98319dc96d784a6cb010309c645db5b271322ba.zip  | |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@78758 138bc75d-0d04-0410-961f-82ee72b054a4
| -rw-r--r-- | gcc/ada/ChangeLog | 91 | ||||
| -rw-r--r-- | gcc/ada/Makefile.generic | 23 | ||||
| -rw-r--r-- | gcc/ada/ali.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/bcheck.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/bld.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/decl.c | 4 | ||||
| -rw-r--r-- | gcc/ada/errout.adb | 60 | ||||
| -rw-r--r-- | gcc/ada/errout.ads | 39 | ||||
| -rw-r--r-- | gcc/ada/exp_ch2.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 29 | ||||
| -rw-r--r-- | gcc/ada/gprcmd.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/init.c | 3 | ||||
| -rw-r--r-- | gcc/ada/par-ch10.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/par-ch3.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/par-ch4.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 54 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 210 | ||||
| -rw-r--r-- | gcc/ada/prj-part.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/s-tpobop.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/s-tporft.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/scng.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_case.adb | 48 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_elim.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sinfo.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 12 | ||||
| -rw-r--r-- | gcc/ada/utils.c | 7 | 
29 files changed, 510 insertions, 274 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b26caea850a..20f8dbb8e12 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,94 @@ +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, diff --git a/gcc/ada/Makefile.generic b/gcc/ada/Makefile.generic index 60f5bd5fd5a..a678d241650 100644 --- a/gcc/ada/Makefile.generic +++ b/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 diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 2e76ee13825..9561a11b143 100644 --- a/gcc/ada/ali.adb +++ b/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; diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index e2a5c7ae6eb..16aeb8589ea 100644 --- a/gcc/ada/bcheck.adb +++ b/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; diff --git a/gcc/ada/bld.adb b/gcc/ada/bld.adb index 59a4ac0f587..a39076be834 100644 --- a/gcc/ada/bld.adb +++ b/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 diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index ce93a169811..f7e55f3b509 100644 --- a/gcc/ada/decl.c +++ b/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) diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 4ae1d6b70ac..ed5ad56745e 100644 --- a/gcc/ada/errout.adb +++ b/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; diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 58eaac6b299..75ebfe908a6 100644 --- a/gcc/ada/errout.ads +++ b/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 --     ----------------------------------------------------- diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index f7cf1abc16e..bc8c2ff0d4f 100644 --- a/gcc/ada/exp_ch2.adb +++ b/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. diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index ba88516f485..d79ec31e527 100644 --- a/gcc/ada/exp_util.adb +++ b/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;     ------------------------ diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 11f8270c756..be1eb29658b 100644 --- a/gcc/ada/freeze.adb +++ b/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 diff --git a/gcc/ada/gprcmd.adb b/gcc/ada/gprcmd.adb index b6658e1930d..323059e395e 100644 --- a/gcc/ada/gprcmd.adb +++ b/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. diff --git a/gcc/ada/init.c b/gcc/ada/init.c index f1602552887..13b891d93ed 100644 --- a/gcc/ada/init.c +++ b/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; diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb index 8066aa77b96..017030e05d3 100644 --- a/gcc/ada/par-ch10.adb +++ b/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 diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 720f6b64266..c5f24646bce 100644 --- a/gcc/ada/par-ch3.adb +++ b/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); diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 838738c9bd9..0334034b76d 100644 --- a/gcc/ada/par-ch4.adb +++ b/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); diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 5c3a07be0d9..d7a47b0a601 100644 --- a/gcc/ada/prj-env.adb +++ b/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 diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 3f3250243a2..5c42d5cea38 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -6,7 +6,7 @@  --                                                                          --  --                                 B o d y                                  --  --                                                                          -- ---          Copyright (C) 2000-2003 Free Software Foundation, Inc.          -- +--          Copyright (C) 2000-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- -- @@ -758,9 +758,10 @@ package body Prj.Nmsc is           --  If a non extending project is not supposed to contain           --  any source, then we never call Find_Sources. -         if Data.Extends = No_Project -           and then Current_Source = Nil_String -         then +         if Current_Source /= Nil_String then +            Data.Sources_Present := True; + +         elsif Data.Extends = No_Project then              Error_Msg                (Project,                 "there are no Ada sources in this project", @@ -1405,7 +1406,7 @@ package body Prj.Nmsc is                          String_Elements.Increment_Last;                          String_Elements.Table (String_Elements.Last) :=                            (Value    => ALI_Name_Id, -                           Display_Value => No_Name, +                           Display_Value => ALI_Name_Id,                             Location => String_Elements.Table                                                           (Interfaces).Location,                             Flag     => False, @@ -2573,10 +2574,6 @@ package body Prj.Nmsc is           Directory : constant String := Get_Name_String (From);           Element   : String_Element; -         Canonical_Directory_Id : Name_Id; -         pragma Unreferenced (Canonical_Directory_Id); -         --  Is this in fact being used for anything useful ??? -           procedure Recursive_Find_Dirs (Path : Name_Id);           --  Find all the subdirectories (recursively) of Path and add them           --  to the list of source directories of the project. @@ -2593,136 +2590,128 @@ package body Prj.Nmsc is              Element  : String_Element;              Found    : Boolean := False; -            Canonical_Path : Name_Id := No_Name; +            Non_Canonical_Path : Name_Id := No_Name; +            Canonical_Path     : Name_Id := No_Name; + +            The_Path : constant String := +                         Normalize_Pathname (Get_Name_String (Path)) & +            Directory_Separator; + +            The_Path_Last : constant Natural := +                              Compute_Directory_Last (The_Path);           begin -            Get_Name_String (Path); +            Name_Len := The_Path_Last - The_Path'First + 1; +            Name_Buffer (1 .. Name_Len) := +              The_Path (The_Path'First .. The_Path_Last); +            Non_Canonical_Path := Name_Find; +            Get_Name_String (Non_Canonical_Path);              Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); +            Canonical_Path := Name_Find; -            declare -               The_Path : constant String := -                            Normalize_Pathname -                              (Name => Name_Buffer (1 .. Name_Len)) & -                               Directory_Separator; +            --  To avoid processing the same directory several times, check +            --  if the directory is already in Recursive_Dirs. If it is, +            --  then there is nothing to do, just return. If it is not, put +            --  it there and continue recursive processing. -               The_Path_Last : constant Natural := -                                 Compute_Directory_Last (The_Path); +            if Recursive_Dirs.Get (Canonical_Path) then +               return; -            begin -               Name_Len := The_Path_Last - The_Path'First + 1; -               Name_Buffer (1 .. Name_Len) := -                 The_Path (The_Path'First .. The_Path_Last); -               Canonical_Path := Name_Find; +            else +               Recursive_Dirs.Set (Canonical_Path, True); +            end if; -               --  To avoid processing the same directory several times, check -               --  if the directory is already in Recursive_Dirs. If it is, -               --  then there is nothing to do, just return. If it is not, put -               --  it there and continue recursive processing. +            --  Check if directory is already in list -               if Recursive_Dirs.Get (Canonical_Path) then -                  return; +            while List /= Nil_String loop +               Element := String_Elements.Table (List); -               else -                  Recursive_Dirs.Set (Canonical_Path, True); +               if Element.Value /= No_Name then +                  Found := Element.Value = Canonical_Path; +                  exit when Found;                 end if; -               --  Check if directory is already in list - -               while List /= Nil_String loop -                  Element := String_Elements.Table (List); - -                  if Element.Value /= No_Name then -                     Get_Name_String (Element.Value); -                     Found := -                       The_Path (The_Path'First .. The_Path_Last) = -                       Name_Buffer (1 .. Name_Len); -                     exit when Found; -                  end if; - -                  List := Element.Next; -               end loop; - -               --  If directory is not already in list, put it there - -               if not Found then -                  if Current_Verbosity = High then -                     Write_Str  ("   "); -                     Write_Line (The_Path (The_Path'First .. The_Path_Last)); -                  end if; +               List := Element.Next; +            end loop; -                  String_Elements.Increment_Last; -                  Element := -                    (Value    => Canonical_Path, -                     Display_Value => No_Name, -                     Location => No_Location, -                     Flag     => False, -                     Next     => Nil_String); +            --  If directory is not already in list, put it there -                  --  Case of first source directory +            if not Found then +               if Current_Verbosity = High then +                  Write_Str  ("   "); +                  Write_Line (The_Path (The_Path'First .. The_Path_Last)); +               end if; -                  if Last_Source_Dir = Nil_String then -                     Data.Source_Dirs := String_Elements.Last; +               String_Elements.Increment_Last; +               Element := +                 (Value    => Canonical_Path, +                  Display_Value => Non_Canonical_Path, +                  Location => No_Location, +                  Flag     => False, +                  Next     => Nil_String); -                     --  Here we already have source directories. +               --  Case of first source directory -                  else -                     --  Link the previous last to the new one +               if Last_Source_Dir = Nil_String then +                  Data.Source_Dirs := String_Elements.Last; -                     String_Elements.Table (Last_Source_Dir).Next := -                       String_Elements.Last; -                  end if; +                  --  Here we already have source directories. -                  --  And register this source directory as the new last +               else +                  --  Link the previous last to the new one -                  Last_Source_Dir  := String_Elements.Last; -                  String_Elements.Table (Last_Source_Dir) := Element; +                  String_Elements.Table (Last_Source_Dir).Next := +                    String_Elements.Last;                 end if; -               --  Now look for subdirectories. We do that even when this -               --  directory is already in the list, because some of its -               --  subdirectories may not be in the list yet. +               --  And register this source directory as the new last -               Open (Dir, The_Path (The_Path'First .. The_Path_Last)); +               Last_Source_Dir  := String_Elements.Last; +               String_Elements.Table (Last_Source_Dir) := Element; +            end if; -               loop -                  Read (Dir, Name, Last); -                  exit when Last = 0; +            --  Now look for subdirectories. We do that even when this +            --  directory is already in the list, because some of its +            --  subdirectories may not be in the list yet. -                  if Name (1 .. Last) /= "." -                    and then Name (1 .. Last) /= ".." -                  then -                     --  Avoid . and .. +            Open (Dir, The_Path (The_Path'First .. The_Path_Last)); -                     if Current_Verbosity = High then -                        Write_Str  ("   Checking "); -                        Write_Line (Name (1 .. Last)); -                     end if; +            loop +               Read (Dir, Name, Last); +               exit when Last = 0; -                     declare -                        Path_Name : String := -                                      Normalize_Pathname -                                        (Name      => Name (1 .. Last), -                                         Directory => -                                           The_Path -                                            (The_Path'First .. The_Path_Last)); +               if Name (1 .. Last) /= "." +                 and then Name (1 .. Last) /= ".." +               then +                  --  Avoid . and .. -                     begin -                        Canonical_Case_File_Name (Path_Name); +                  if Current_Verbosity = High then +                     Write_Str  ("   Checking "); +                     Write_Line (Name (1 .. Last)); +                  end if; -                        if Is_Directory (Path_Name) then +                  declare +                     Path_Name : constant String := +                                   Normalize_Pathname +                                     (Name      => Name (1 .. Last), +                                      Directory => +                                        The_Path +                                          (The_Path'First .. The_Path_Last)); -                           --  We have found a new subdirectory, call self +                  begin +                     if Is_Directory (Path_Name) then -                           Name_Len := Path_Name'Length; -                           Name_Buffer (1 .. Name_Len) := Path_Name; -                           Recursive_Find_Dirs (Name_Find); -                        end if; -                     end; -                  end if; -               end loop; +                        --  We have found a new subdirectory, call self -               Close (Dir); -            end; +                        Name_Len := Path_Name'Length; +                        Name_Buffer (1 .. Name_Len) := Path_Name; +                        Recursive_Find_Dirs (Name_Find); +                     end if; +                  end; +               end if; +            end loop; + +            Close (Dir);           exception              when Directory_Error => @@ -2742,10 +2731,6 @@ package body Prj.Nmsc is           --  Directory    := Name_Buffer (1 .. Name_Len);           --  Why is above line commented out ??? -         Canonical_Directory_Id := Name_Find; -         --  What is purpose of above assignment ??? -         --  Are we sure it is being used ??? -           if Current_Verbosity = High then              Write_Str (Directory);              Write_Line (""")"); @@ -3098,7 +3083,6 @@ package body Prj.Nmsc is              while Current /= Nil_String loop                 Element := String_Elements.Table (Current);                 if Element.Value /= No_Name then -                  Element.Display_Value := Element.Value;                    Get_Name_String (Element.Value);                    Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));                    Element.Value := Name_Find; diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index d9a3797ccaf..61826c90507 100644 --- a/gcc/ada/prj-part.adb +++ b/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); diff --git a/gcc/ada/s-tpobop.ads b/gcc/ada/s-tpobop.ads index 2e2ba0dfb98..a28972b62a1 100644 --- a/gcc/ada/s-tpobop.ads +++ b/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 diff --git a/gcc/ada/s-tporft.adb b/gcc/ada/s-tporft.adb index b735b1145d9..43c5da9da39 100644 --- a/gcc/ada/s-tporft.adb +++ b/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; diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index cb46bf189ee..f0189c1428b 100644 --- a/gcc/ada/scng.adb +++ b/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; diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 10858ed183b..a6f8a7a35a2 100644 --- a/gcc/ada/sem_case.adb +++ b/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; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 6047a41fe3b..c6fa436ffb7 100644 --- a/gcc/ada/sem_ch10.adb +++ b/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) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index c96450a107a..0f561d9ce35 100644 --- a/gcc/ada/sem_ch4.adb +++ b/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; diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb index 8d380024b06..3f99d828fc4 100644 --- a/gcc/ada/sem_elim.adb +++ b/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; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 37fcc4d85f1..c7133d22e48 100644 --- a/gcc/ada/sinfo.adb +++ b/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; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 90929a3d343..4ebb16fc902 100644 --- a/gcc/ada/sinfo.ads +++ b/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 diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 30939d66c6a..37a9fbd0aea 100644 --- a/gcc/ada/utils.c +++ b/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)  | 

