[multiple changes]
2004-03-02 Emmanuel Briot <briot@act-europe.fr> * ali.adb (Read_Instantiation_Instance): Do not modify the current_file_num when reading information about instantiations, since this corrupts files in later references. 2004-03-02 Vincent Celier <celier@gnat.com> * bcheck.adb (Check_Consistency): Get the full path of an ALI file before checking if it is read-only. * bld.adb (Recursive_Process): Concatenate <PROJECT>.src_dirs in front of SRC_DIRS and eliminate duplicates. * gprcmd.adb: Replace command "path" with command "path_sep" to return the path separator. (Usage): Document path_sep * Makefile.generic: For Ada and GNU C++ cases, link directly with the C++ compiler. No need for a script. Replace use of C*_INCLUDE_PATH env var for GCC compilers with CPATH. Do not call gprcmd to build the C*_INCLUDE_PATHs, do it with function subst. * prj-env.adb (For_All_Source_Dirs): Only add source dirs in project where there are Ada sources. (Set_Ada_Paths): Only add to the include path the source dirs of project with Ada sources. (Add_To_Path): Add the Display_Values of the directories, not their Values. * prj-nmsc.adb (Find_Sources): Set flag Sources_Present in the project data. * prj-nmsc.adb (Add_ALI_For): Make sure that the element Display_Value is not No_Name. (Find_Source_Dirs): Set Display_Value to a non canonicalized value, only Value is canonicalized. (Language_Independent_Check): Do not copy Value to Display_Value when canonicalizing Value. * prj-part.adb (Post_Parse_Context_Clause): Compare canonical cased path to find limited with cycles. (Parse_Single_Project): Use canonical cased path to find the end of a with cycle. 2004-03-02 Ed Schonberg <schonberg@gnat.com> * sem_ch10.adb (Optional_Subunit): Verify that unit contains a subunit and not a child unit. * sinfo.ads, sinfo.adb: Rearrange flags so that Private_Present can appear in a with_clause. * decl.c (gnat_to_gnu_type): If entity is a generic type, which can only happen in type_annotate mode, do not try to elaborate it. * exp_util.adb (Force_Evaluation): If expression is a selected component on the left of an assignment, use a renaming rather than a temporary to remove side effects. * freeze.adb (Freeze_Entity): Do not freeze a global entity within an inlined instance body, which is analyzed before the end of the enclosing scope. 2004-03-02 Robert Dewar <dewar@gnat.com> * par-ch10.adb, par-ch3.adb, par-ch4.adb, scng.adb, sem_ch4.adb: Use new feature for substitution of keywords in VMS * errout.ads, errout.adb: Implement new circuit for substitution of keywords in VMS. * sem_case.adb (Analyze_Choices): Place message properly when case is a subtype reference rather than an explicit range. * sem_elim.adb, s-tpobop.ads, exp_ch2.adb: Minor reformatting 2004-03-02 Doug Rupp <rupp@gnat.com> * init.c (__gnat_initialize)[VMS]: Resignal RDB-E-STREAM_EOF. 2004-03-02 Thomas Quinot <quinot@act-europe.fr> * s-tporft.adb: Add missing locking around call to Initialize_ATCB. 2004-03-02 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> * utils.c (finish_record_type): Do not set DECL_NONADDRESSABLE for a BLKmode bitfield. From-SVN: r78758
This commit is contained in:
parent
c24938d49f
commit
555360a506
29 changed files with 518 additions and 282 deletions
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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 --
|
||||
-----------------------------------------------------
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
------------------------
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
-- If there are Ada sources, call action with the name of every
|
||||
-- source directory.
|
||||
|
||||
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 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
|
||||
|
|
|
@ -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);
|
||||
|
||||
if Element.Value /= No_Name then
|
||||
Found := Element.Value = Canonical_Path;
|
||||
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;
|
||||
|
||||
String_Elements.Increment_Last;
|
||||
Element :=
|
||||
(Value => Canonical_Path,
|
||||
Display_Value => Non_Canonical_Path,
|
||||
Location => No_Location,
|
||||
Flag => False,
|
||||
Next => Nil_String);
|
||||
|
||||
-- Case of first source directory
|
||||
|
||||
if Last_Source_Dir = Nil_String then
|
||||
Data.Source_Dirs := String_Elements.Last;
|
||||
|
||||
-- Here we already have source directories.
|
||||
|
||||
else
|
||||
Recursive_Dirs.Set (Canonical_Path, True);
|
||||
-- Link the previous last to the new one
|
||||
|
||||
String_Elements.Table (Last_Source_Dir).Next :=
|
||||
String_Elements.Last;
|
||||
end if;
|
||||
|
||||
-- Check if directory is already in list
|
||||
-- And register this source directory as the new last
|
||||
|
||||
while List /= Nil_String loop
|
||||
Element := String_Elements.Table (List);
|
||||
Last_Source_Dir := String_Elements.Last;
|
||||
String_Elements.Table (Last_Source_Dir) := Element;
|
||||
end if;
|
||||
|
||||
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;
|
||||
-- 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.
|
||||
|
||||
List := Element.Next;
|
||||
end loop;
|
||||
Open (Dir, The_Path (The_Path'First .. The_Path_Last));
|
||||
|
||||
-- If directory is not already in list, put it there
|
||||
loop
|
||||
Read (Dir, Name, Last);
|
||||
exit when Last = 0;
|
||||
|
||||
if Name (1 .. Last) /= "."
|
||||
and then Name (1 .. Last) /= ".."
|
||||
then
|
||||
-- Avoid . and ..
|
||||
|
||||
if not Found then
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" ");
|
||||
Write_Line (The_Path (The_Path'First .. The_Path_Last));
|
||||
Write_Str (" Checking ");
|
||||
Write_Line (Name (1 .. Last));
|
||||
end if;
|
||||
|
||||
String_Elements.Increment_Last;
|
||||
Element :=
|
||||
(Value => Canonical_Path,
|
||||
Display_Value => No_Name,
|
||||
Location => No_Location,
|
||||
Flag => False,
|
||||
Next => Nil_String);
|
||||
declare
|
||||
Path_Name : constant String :=
|
||||
Normalize_Pathname
|
||||
(Name => Name (1 .. Last),
|
||||
Directory =>
|
||||
The_Path
|
||||
(The_Path'First .. The_Path_Last));
|
||||
|
||||
-- Case of first source directory
|
||||
begin
|
||||
if Is_Directory (Path_Name) then
|
||||
|
||||
if Last_Source_Dir = Nil_String then
|
||||
Data.Source_Dirs := String_Elements.Last;
|
||||
-- We have found a new subdirectory, call self
|
||||
|
||||
-- Here we already have source directories.
|
||||
|
||||
else
|
||||
-- Link the previous last to the new one
|
||||
|
||||
String_Elements.Table (Last_Source_Dir).Next :=
|
||||
String_Elements.Last;
|
||||
end if;
|
||||
|
||||
-- And register this source directory as the new last
|
||||
|
||||
Last_Source_Dir := String_Elements.Last;
|
||||
String_Elements.Table (Last_Source_Dir) := Element;
|
||||
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.
|
||||
|
||||
Open (Dir, The_Path (The_Path'First .. The_Path_Last));
|
||||
|
||||
loop
|
||||
Read (Dir, Name, Last);
|
||||
exit when Last = 0;
|
||||
|
||||
if Name (1 .. Last) /= "."
|
||||
and then Name (1 .. Last) /= ".."
|
||||
then
|
||||
-- Avoid . and ..
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Write_Str (" Checking ");
|
||||
Write_Line (Name (1 .. Last));
|
||||
Name_Len := Path_Name'Length;
|
||||
Name_Buffer (1 .. Name_Len) := Path_Name;
|
||||
Recursive_Find_Dirs (Name_Find);
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
declare
|
||||
Path_Name : String :=
|
||||
Normalize_Pathname
|
||||
(Name => Name (1 .. Last),
|
||||
Directory =>
|
||||
The_Path
|
||||
(The_Path'First .. The_Path_Last));
|
||||
|
||||
begin
|
||||
Canonical_Case_File_Name (Path_Name);
|
||||
|
||||
if Is_Directory (Path_Name) then
|
||||
|
||||
-- We have found a new subdirectory, call self
|
||||
|
||||
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);
|
||||
end;
|
||||
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;
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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 Is_Integer_Type (Bounds_Type) then
|
||||
Error_Msg_Uint_1 := Bounds_Lo;
|
||||
Error_Msg_N ("minimum allowed choice value is^", Lo);
|
||||
|
||||
-- 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
|
||||
Error_Msg_Name_1 := Choice_Image (Bounds_Lo, Bounds_Type);
|
||||
Error_Msg_N ("minimum allowed choice value is%", Lo);
|
||||
Enode := Lo;
|
||||
end if;
|
||||
|
||||
elsif Hi_Val > Bounds_Hi then
|
||||
-- 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^", Enode);
|
||||
else
|
||||
Error_Msg_Name_1 := Choice_Image (Bounds_Lo, Bounds_Type);
|
||||
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
|
||||
|
||||
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;
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Add table
Reference in a new issue