From: charlet Date: Tue, 2 Mar 2004 13:50:15 +0000 (+0000) Subject: 2004-03-02 Emmanuel Briot X-Git-Tag: upstream/4.9.2~72603 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=f98319dc96d784a6cb010309c645db5b271322ba;p=platform%2Fupstream%2Flinaro-gcc.git 2004-03-02 Emmanuel Briot * 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 * bcheck.adb (Check_Consistency): Get the full path of an ALI file before checking if it is read-only. * bld.adb (Recursive_Process): Concatenate .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 * 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 * 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 * init.c (__gnat_initialize)[VMS]: Resignal RDB-E-STREAM_EOF. 2004-03-02 Thomas Quinot * s-tporft.adb: Add missing locking around call to Initialize_ATCB. 2004-03-02 Richard Kenner * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b26caea..20f8dbb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,94 @@ +2004-03-02 Emmanuel Briot + + * 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 + + * bcheck.adb (Check_Consistency): Get the full path of an ALI file + before checking if it is read-only. + + * bld.adb (Recursive_Process): Concatenate .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 + + * 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 + + * 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 + + * init.c (__gnat_initialize)[VMS]: Resignal RDB-E-STREAM_EOF. + +2004-03-02 Thomas Quinot + + * s-tporft.adb: Add missing locking around call to Initialize_ATCB. + +2004-03-02 Richard Kenner + + * utils.c (finish_record_type): Do not set DECL_NONADDRESSABLE for a + BLKmode bitfield. + 2004-02-25 Robert Dewar * 51osinte.ads, 52osinte.ads, 53osinte.ads, 54osinte.ads, diff --git a/gcc/ada/Makefile.generic b/gcc/ada/Makefile.generic index 60f5bd5..a678d24 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 2e76ee1..9561a11 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 e2a5c7a..16aeb85 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 59a4ac0..a39076b 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 ce93a169..f7e55f3 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 4ae1d6b..ed5ad56 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 58eaac6..75ebfe9 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 f7cf1ab..bc8c2ff 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 ba88516..d79ec31 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 11f8270..be1eb29 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 b6658e1..323059e 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 f160255..13b891d 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 8066aa7..017030e 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 720f6b6..c5f2464 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 838738c..0334034 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 5c3a07b..d7a47b0 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 3f32502..5c42d5c 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 d9a3797..61826c9 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 2e2ba0d..a28972b 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 b735b11..43c5da9 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 cb46bf1..f0189c1 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 10858ed..a6f8a7a 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 6047a41..c6fa436 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 c96450a..0f561d9 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 8d38002..3f99d82 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 37fcc4d..c7133d2 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 90929a3..4ebb16f 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 30939d6..37a9fbd 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)