diff --git a/gcc/ada/5qsystem.ads b/gcc/ada/5qsystem.ads
index cfbba6d5c53994702bc48eef0c89c08b9a9a7a82..c8b94936ded38abc4ec80c57eba1097f4ee271ae 100644
--- a/gcc/ada/5qsystem.ads
+++ b/gcc/ada/5qsystem.ads
@@ -63,9 +63,6 @@ pragma Pure (System);
-- Storage-related Declarations
type Address is new Long_Integer;
- subtype Short_Address is Address
- range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1;
- for Short_Address'Object_Size use 32;
Null_Address : constant Address;
Storage_Unit : constant := 8;
diff --git a/gcc/ada/5vinmaop.adb b/gcc/ada/5vinmaop.adb
index 42207a1ce100289e4c5abb0ea0c3a3980bc5cb1b..2cbfd0eb71558dc57eb12bdf6433bd332a23dada 100644
--- a/gcc/ada/5vinmaop.adb
+++ b/gcc/ada/5vinmaop.adb
@@ -37,6 +37,9 @@
with System.OS_Interface;
-- used for various type, constant, and operations
+with System.Aux_DEC;
+-- used for Short_Address
+
with System.Parameters;
with System.Tasking;
@@ -114,7 +117,7 @@ package body System.Interrupt_Management.Operations is
--------------------
function To_unsigned_long is new
- Unchecked_Conversion (System.Short_Address, unsigned_long);
+ Unchecked_Conversion (System.Aux_DEC.Short_Address, unsigned_long);
function Interrupt_Wait (Mask : access Interrupt_Mask)
return Interrupt_ID
diff --git a/gcc/ada/5vsystem.ads b/gcc/ada/5vsystem.ads
index 9bf3b5f2698659e859454f9dd34d1aefa916a1f9..fc4fb2e6d6f24e24320d1bdb4436bcd9e0bd74b6 100644
--- a/gcc/ada/5vsystem.ads
+++ b/gcc/ada/5vsystem.ads
@@ -63,7 +63,6 @@ pragma Pure (System);
-- Storage-related Declarations
type Address is private;
- subtype Short_Address is Address;
Null_Address : constant Address;
Storage_Unit : constant := 8;
diff --git a/gcc/ada/5xsystem.ads b/gcc/ada/5xsystem.ads
index a716fa1a708a1fd999e296eb2b380c279baba751..3ba5e692195b4905d96c45c56a1d0f88abbb4bbe 100644
--- a/gcc/ada/5xsystem.ads
+++ b/gcc/ada/5xsystem.ads
@@ -63,7 +63,6 @@ pragma Pure (System);
-- Storage-related Declarations
type Address is private;
- subtype Short_Address is Address;
Null_Address : constant Address;
Storage_Unit : constant := 8;
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c1531aa9093eae7877978873685bf94ebcf6793e..6c3ddc3eef9643c452a2ea2419ace4264b0b96e1 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,147 @@
+2004-05-10 Doug Rupp <rupp@gnat.com>
+
+ * 5qsystem.ads: Remove Short_Address subtype declaration. Moved to
+ system.aux_dec.
+
+ * s-auxdec.ads: Add Short_Address subtype (moved here from System).
+
+ * Makefile.in: [VMS]: Add translation for 5qauxdec.ads.
+
+ * init.c: [VMS] Macroize LIB$ calls for IA64 and Alpha.
+ Fixes undefined symbols in IA64 gnatlib.
+
+ * 5vinmaop.adb: Reference s-auxdec for Short_Address.
+
+ * 5xsystem.ads, 5vsystem.ads: Back out last change (addition of subtype
+ Short_Address). This will be moved to system.auxdec.
+
+2004-05-10 Thomas Quinot <quinot@act-europe.fr>
+
+ * sem_util.adb: Replace test for presence of a node that is always
+ present with a call to Discard_Node.
+
+ * sem_ch10.adb (Analyze_Compilation_Unit): Remove superfluous call to
+ Analyze on the library unit node after generation of distribution stub
+ constructs. The call was a no-op because Unit_Node has already been
+ Analyzed, and the tree fragments for the distribution stubs are
+ analyzed as they are inserted in Exp_Dist.
+ Update comment regarding to distribution stubs to reflect that we
+ do not generate stub in separate files anymore.
+
+ * einfo.ads: Clarify the fact that a tagged private type has the
+ E_Record_Type_With_Private Ekind.
+
+ * erroutc.adb: Minor reformatting
+
+ * erroutc.ads (Max_Msg_Length): Increase to cover possible larger
+ values if line length is increased using -gnatyM (noticed during code
+ reading).
+
+ * eval_fat.adb: Minor reformatting
+ Put spaces around exponentiation operator
+
+2004-05-10 Ed Schonberg <schonberg@gnat.com>
+
+ PR ada/15005
+ * sem_util.adb (Is_Dependent_Component_Of_Mutable_Object): If prefix
+ has been rewritten as an explicit dereference, retrieve type of
+ original node to check for possibly unconstrained record type.
+
+2004-05-10 Ed Schonberg <schonberg@gnat.com>
+
+ * exp_ch7.adb (Check_Visibly_Controlled): If given operation is not
+ overriding, use the operation of the parent unconditionally.
+
+ * sem_ch4.adb (Remove_Address_Interpretations): Remove address
+ operation when either operand is a literal, to avoid further
+ ambiguities.
+
+ * sem_ch6.adb (New_Overloaded_Entity): If new entity is inherited and
+ overridden by a previous explicit declaration, mark the previous entity
+ as overriding.
+
+ * sem_disp.adb (Check_Dispatching_Operation): New predicate
+ Is_Visibly_Controlled, to determine whether a declaration of a
+ primitive control operation for a derived type overrides an inherited
+ one. Add warning if the explicit declaration does not override.
+
+2004-05-10 Vincent Celier <celier@gnat.com>
+
+ * gnatls.adb (Gnatls): Initialize Snames, to avoid assertion error in
+ some cases when the sources are no longer present.
+
+ * make.adb (Collect_Arguments): Fail if an external source, not part
+ of any project need to be compiled, when switch -x has not been
+ specified.
+
+ * makeusg.adb: Document new switch -x
+
+ * opt.ads (External_Unit_Compilation_Allowed): New Boolean flag,
+ defaulted to False.
+
+ * switch-m.adb (Scan_Make_Switches): New switch -x
+
+ * vms_data.ads: Add VMS qualifier /NON_PROJECT_UNIT_COMPILATION for
+ gnatmake switch -x.
+
+ * gnat_ugn.texi: Document new gnatmake switch -x
+
+2004-05-10 Eric Botcazou <ebotcazou@act-europe.fr>
+
+ * misc.c (gnat_init_options): Set flag_zero_initialized_in_bss to 0.
+
+ * utils.c (create_var_decl): Do not modify the DECL_COMMON flag.
+ (process_attributes): Likewise.
+
+2004-05-10 Joel Brobecker <brobecker@gnat.com>
+
+ * s-inmaop.ads: Fix spelling mistake in one of the comments.
+
+2004-05-10 Robert Dewar <dewar@gnat.com>
+
+ * gnat_ugn.texi: Document that for config pragma files, the maximum
+ line length is always 32767.
+
+ * gnat_rm.texi: For pragma Eliminate, note that concatenation of string
+ literals is now allowed.
+
+ * gnat-style.texi: Remove statement about splitting long lines before
+ an operator rather than after, since we do not follow this rule at all.
+ Clarify rule (really lack of rule) for spaces around exponentiation
+
+ * sem_elim.adb: Allow concatenation of string literals as well as a
+ single string literal for pragma arguments.
+
+ * sem_prag.ads, sem_prag.adb: (Is_Config_Static_String): New function
+
+ * a-textio.adb (Terminate_Line): Do not add line feed if nothing
+ written for append case.
+
+ * frontend.adb: Changes to avoid checking max line length in config
+ pragma files.
+
+ * g-os_lib.ads: Minor reformatting
+
+ * mlib-utl.adb: Do not define Max_Line_Length locally (definition was
+ wrong in any case. Instead use standard value. Noticed during code
+ reading.
+
+ * opt.ads (Max_Line_Length): New field, used to implement removal of
+ limitation on length of lines when scanning config pragma files.
+
+ * osint.ads, prj-dect.adb, prj-strt.adb, prj-tree.adb,
+ makeutl.ads, makeutl.adb: Minor reformatting
+
+ * scn.adb: Do not check line length while scanning config pragma files
+ Do not check line length while scanning out license information
+
+ * scng.adb: Changes to avoid line length checks while parsing config
+ pragma files.
+
+2004-05-10 GNAT Script <nobody@gnat.com>
+
+ * Make-lang.in: Makefile automatically updated
+
2004-05-05 Arnaud Charlet <charlet@act-europe.fr>
* osint.adb (Find_Program_Name): Fix handling of VMS version
diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in
index 5cf5d62d425ba30b212071f6502cf9107cc77ae8..0a6775a438f86724cd893fbee7a90ece8157c89f 100644
--- a/gcc/ada/Make-lang.in
+++ b/gcc/ada/Make-lang.in
@@ -1698,10 +1698,9 @@ ada/exp_ch7.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/erroutc.ads ada/exp_ch11.ads ada/exp_ch7.ads ada/exp_ch7.adb \
ada/exp_ch9.ads ada/exp_dbug.ads ada/exp_tss.ads ada/exp_util.ads \
ada/exp_util.adb ada/fname.ads ada/fname-uf.ads ada/freeze.ads \
- ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads \
- ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
- ada/inline.ads ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
- ada/lib-sort.adb ada/namet.ads ada/nlists.ads ada/nlists.adb \
+ ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \
+ ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
+ ada/itypes.ads ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \
ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/sem.ads \
ada/sem_ch3.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_eval.ads \
@@ -3261,14 +3260,15 @@ ada/sem_elim.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
ada/errout.ads ada/erroutc.ads ada/gnat.ads ada/g-htable.ads \
ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
ada/namet.ads ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
- ada/sem_elim.ads ada/sem_elim.adb ada/sinfo.ads ada/sinfo.adb \
- ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \
- ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
- ada/s-htable.adb ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads \
- ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
- ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
- ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
- ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
+ ada/sem_elim.ads ada/sem_elim.adb ada/sem_prag.ads ada/sinfo.ads \
+ ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
+ ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \
+ ada/s-htable.ads ada/s-htable.adb ada/s-imgenu.ads ada/s-memory.ads \
+ ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
+ ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
+ ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
+ ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
+ ada/unchdeal.ads ada/urealp.ads
ada/sem_eval.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in
index f35622436fe002b2f40367958685920bafba9934..6b075b8a3d339e39c6c514d7a3e89308866174d6 100644
--- a/gcc/ada/Makefile.in
+++ b/gcc/ada/Makefile.in
@@ -1145,6 +1145,7 @@ endif
ifeq ($(strip $(filter-out alpha% ia64 dec hp vms% openvms% alphavms%,$(targ))),)
ifeq ($(strip $(filter-out ia64 hp vms% openvms%,$(targ))),)
LIBGNAT_TARGET_PAIRS_AUX1 = \
+ s-auxdec.ads<5qauxdec.ads \
s-crtl.ads<5xcrtl.ads \
s-osinte.adb<5xosinte.adb \
s-osinte.ads<5xosinte.ads \
diff --git a/gcc/ada/a-textio.adb b/gcc/ada/a-textio.adb
index 98766ce9bf3a08b4723779bc8159ebd0fc3d5af9..7afb804ff9c7daf0e640f1f4df6089d5855098e1 100644
--- a/gcc/ada/a-textio.adb
+++ b/gcc/ada/a-textio.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- --
@@ -1678,8 +1678,12 @@ package body Ada.Text_IO is
-- because it is too much of a nuisance to have these odd line
-- feeds when nothing has been written to the file.
+ -- We also avoid this for files opened in append mode, in
+ -- accordance with (RM A.8.2(10))
+
elsif (File /= Standard_Err and then File /= Standard_Out)
and then (File.Line = 1 and then File.Page = 1)
+ and then Mode (File) = Out_File
then
New_Line (File);
end if;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 9548da438ff2978df900c8ec1331ffb0bb535a9b..6487a22012e5fd36e40bd34772e5d35cf34bf94a 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3383,18 +3383,19 @@ package Einfo is
-- A record subtype, created by a record subtype declaration.
E_Record_Type_With_Private,
- -- Used for types defined by a private extension declaration. Includes
- -- the fields for both private types and for record types (with the
- -- sole exception of Corresponding_Concurrent_Type which is obviously
- -- not needed). This entity is considered to be both a record type and
+ -- Used for types defined by a private extension declaration, and
+ -- for tagged private types. Includes the fields for both private
+ -- types and for record types (with the sole exception of
+ -- Corresponding_Concurrent_Type which is obviously not needed).
+ -- This entity is considered to be both a record type and
-- a private type.
E_Record_Subtype_With_Private,
-- A subtype of a type defined by a private extension declaration.
E_Private_Type,
- -- A private type, created by a private type declaration that does
- -- not have the keyword limited.
+ -- A private type, created by a private type declaration
+ -- that has neither the keyword limited nor the keyword tagged.
E_Private_Subtype,
-- A subtype of a private type, created by a subtype declaration used
@@ -3402,7 +3403,7 @@ package Einfo is
E_Limited_Private_Type,
-- A limited private type, created by a private type declaration that
- -- has the keyword limited.
+ -- has the keyword limited, but not the keyword tagged.
E_Limited_Private_Subtype,
-- A subtype of a limited private type, created by a subtype declaration
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index e46c7cd6314d34b23f4535875459f472312bde3f..31c97d5bc5543109fc865c1832e109467c0471c9 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.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- --
@@ -33,7 +33,6 @@
with Casing; use Casing;
with Debug; use Debug;
with Err_Vars; use Err_Vars;
-with Hostparm;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
@@ -71,7 +70,6 @@ package body Erroutc is
function Buffer_Ends_With (S : String) return Boolean is
Len : constant Natural := S'Length;
-
begin
return
Msglen > Len
@@ -466,6 +464,10 @@ package body Erroutc is
-- Returns True for a message that is to be purged. Also adjusts
-- error counts appropriately.
+ ------------------
+ -- To_Be_Purged --
+ ------------------
+
function To_Be_Purged (E : Error_Msg_Id) return Boolean is
begin
if E /= No_Error_Msg
diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index b0af72df446c8c94c6a0020a38bf8b117fe34bc7..cde38932df3cc1d5782b383c120d8fd41c4d2a54 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -27,7 +27,6 @@
-- This packages contains global variables and routines common to error
-- reporting packages, including Errout and Prj.Err.
-with Hostparm;
with Table;
with Types; use Types;
@@ -77,11 +76,12 @@ package Erroutc is
Manual_Quote_Mode : Boolean := False;
-- Set True in manual quotation mode
- Max_Msg_Length : constant := 256 + 2 * Hostparm.Max_Line_Length;
- -- Maximum length of error message. The addition of Max_Line_Length
+ Max_Msg_Length : constant := 1024 + 2 * Int (Column_Number'Last);
+ -- Maximum length of error message. The addition of 2 * Column_Number'Last
-- ensures that two insertion tokens of maximum length can be accomodated.
- -- The value of 256 is an arbitrary value that should be more than long
- -- enough to accomodate any reasonable message.
+ -- The value of 1024 is an arbitrary value that should be more than long
+ -- enough to accomodate any reasonable message (and for that matter, some
+ -- pretty unreasonable messages!)
Msg_Buffer : String (1 .. Max_Msg_Length);
-- Buffer used to prepare error messages
diff --git a/gcc/ada/eval_fat.adb b/gcc/ada/eval_fat.adb
index d083c32ba5cde5dbe5592d429516dd7515c08d17..2d4399303012be76fd7025e589b27c97585b150d 100644
--- a/gcc/ada/eval_fat.adb
+++ b/gcc/ada/eval_fat.adb
@@ -40,8 +40,8 @@ package body Eval_Fat is
type Radix_Power_Table is array (Int range 1 .. 4) of Int;
- Radix_Powers : constant Radix_Power_Table
- := (Radix**1, Radix**2, Radix**3, Radix**4);
+ Radix_Powers : constant Radix_Power_Table :=
+ (Radix ** 1, Radix ** 2, Radix ** 3, Radix ** 4);
function Float_Radix return T renames Ureal_2;
-- Radix expressed in real form
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index e78d9954082149d5b0c2a63edf7c75dd69c0b9ac..287b4efc7922abbfe036d3f525c4835b11900739 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -37,10 +37,8 @@ with Exp_Ch11; use Exp_Ch11;
with Exp_Dbug; use Exp_Dbug;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
-with Fname; use Fname;
with Freeze; use Freeze;
with Hostparm; use Hostparm;
-with Lib; use Lib;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
@@ -818,28 +816,16 @@ package body Exp_Ch7 is
begin
if Is_Derived_Type (Typ)
and then Comes_From_Source (E)
- and then Is_Overriding_Operation (E)
- and then
- (not Is_Predefined_File_Name
- (Unit_File_Name (Get_Source_Unit (Root_Type (Typ)))))
+ and then not Is_Overriding_Operation (E)
then
- -- We know that the explicit operation on the type overrode
+ -- We know that the explicit operation on the type does not override
-- the inherited operation of the parent, and that the derivation
-- is from a private type that is not visibly controlled.
Parent_Type := Etype (Typ);
Op := Find_Prim_Op (Parent_Type, Name_Of (Prim));
- if Present (Op)
- and then Is_Hidden (Op)
- and then Scope (Scope (Typ)) /= Scope (Op)
- and then not In_Open_Scopes (Scope (Typ))
- then
- -- If the parent operation is not visible, and the derived
- -- type is not declared in a child unit, then the explicit
- -- operation does not override, and we must use the operation
- -- of the parent.
-
+ if Present (Op) then
E := Op;
-- Wrap the object to be initialized into the proper
diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index f4f36f56aaf4f8302a22ea753480644cd56f57f5..35645bd0812dbcbab76f97a80c45b94f5413c701 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.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- --
@@ -124,10 +124,12 @@ begin
begin
-- We always analyze config files with style checks off, since
-- we don't want a miscellaneous gnat.adc that is around to
- -- discombobulate intended -gnatg or -gnaty compilations.
+ -- discombobulate intended -gnatg or -gnaty compilations. We
+ -- also disconnect checking for maximum line length.
Opt.Style_Check := False;
Style_Check := False;
+ Opt.Max_Line_Length := Int (Column_Number'Last);
-- Capture current suppress options, which may get modified
@@ -191,6 +193,7 @@ begin
-- Restore style check, but if config file turned on checks, leave on!
Opt.Style_Check := Save_Style_Check or Style_Check;
+ Opt.Max_Line_Length := Hostparm.Max_Line_Length;
-- Capture any modifications to suppress options from config pragmas
diff --git a/gcc/ada/g-os_lib.ads b/gcc/ada/g-os_lib.ads
index a8968c25c6cc2ea616eed8554a607538bba19231..bd4201fc5f7fbd2ba79b699c3aaa2651f353c885 100644
--- a/gcc/ada/g-os_lib.ads
+++ b/gcc/ada/g-os_lib.ads
@@ -93,6 +93,7 @@ pragma Elaborate_Body (OS_Lib);
-- Time/Date Stuff --
---------------------
+ type OS_Time is private;
-- The OS's notion of time is represented by the private type OS_Time.
-- This is the type returned by the File_Time_Stamp functions to obtain
-- the time stamp of a specified file. Functions and a procedure (modeled
@@ -102,8 +103,8 @@ pragma Elaborate_Body (OS_Lib);
-- cases but rather the actual (time-zone independent) time stamp of the
-- file (of course in Unix systems, this *is* in GMT form).
- type OS_Time is private;
Invalid_Time : constant OS_Time;
+ -- A special unique value used to flag an invalid time stamp value
subtype Year_Type is Integer range 1900 .. 2099;
subtype Month_Type is Integer range 1 .. 12;
@@ -111,6 +112,8 @@ pragma Elaborate_Body (OS_Lib);
subtype Hour_Type is Integer range 0 .. 23;
subtype Minute_Type is Integer range 0 .. 59;
subtype Second_Type is Integer range 0 .. 59;
+ -- Declarations similar to those in Calendar, breaking down the time
+
function GM_Year (Date : OS_Time) return Year_Type;
function GM_Month (Date : OS_Time) return Month_Type;
@@ -118,6 +121,7 @@ pragma Elaborate_Body (OS_Lib);
function GM_Hour (Date : OS_Time) return Hour_Type;
function GM_Minute (Date : OS_Time) return Minute_Type;
function GM_Second (Date : OS_Time) return Second_Type;
+ -- Functions to extract information from OS_Time value
function "<" (X, Y : OS_Time) return Boolean;
function ">" (X, Y : OS_Time) return Boolean;
@@ -135,6 +139,8 @@ pragma Elaborate_Body (OS_Lib);
Hour : out Hour_Type;
Minute : out Minute_Type;
Second : out Second_Type);
+ -- Analogous to the routine of similar name in Calendar, takes an OS_Time
+ -- and splits it into its component parts with obvious meanings.
----------------
-- File Stuff --
diff --git a/gcc/ada/gnat-style.texi b/gcc/ada/gnat-style.texi
index 2fa0941258941fe33d02870fe1a42d7876ca5176..ee425de5f293de7ed03c3a3784db8d0e535f8a09 100644
--- a/gcc/ada/gnat-style.texi
+++ b/gcc/ada/gnat-style.texi
@@ -382,17 +382,17 @@ one context, where comments explain their purpose.
@itemize @bullet
@item
-Every operator must be surrounded by spaces, except for the
-exponentiation operator.
+Every operator must be surrounded by spaces. An exception is that
+this rule does not apply to the exponentiation operator, for which
+there are no specific layout rules. The reason for this exception
+is that sometimes it makes clearer reading to leave out the spaces
+around exponentiation.
@cindex Operators
@smallexample @c adanocomment
E := A * B**2 + 3 * (C - D);
@end smallexample
-@item
-When folding a long line, fold before an operator, not after.
-
@item
Use parentheses where they clarify the intended association of operands
with operators:
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index ec766614392239892627df8359639710c98f8511..614064ff313ac86aa269016ea3026a2f884bd88d 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -1356,10 +1356,12 @@ FUNCTION_PROFILE ::= [Parameter_Types => PARAMETER_TYPES,]
Result_Type => result_SUBTYPE_NAME]
PARAMETER_TYPES ::= (SUBTYPE_NAME @{, SUBTYPE_NAME@})
-SUBTYPE_NAME ::= STRING_LITERAL
+SUBTYPE_NAME ::= STRING_VALUE
SOURCE_LOCATION ::= Source_Location => SOURCE_TRACE
-SOURCE_TRACE ::= STRING_LITERAL
+SOURCE_TRACE ::= STRING_VALUE
+
+STRING_VALUE ::= STRING_LITERAL @{& STRING_LITERAL@}
@end smallexample
@noindent
@@ -1388,7 +1390,7 @@ subprograms denoted by the first two parameters.
Use PARAMETER_AND_RESULT_TYPE_PROFILE to specify the profile of the subprogram
to be eliminated in a manner similar to that used for the extended
@code{Import} and @code{Export} pragmas, except that the subtype names are
-always given as string literals. At the moment, this form of distinguishing
+always given as strings. At the moment, this form of distinguishing
overloaded subprograms is implemented only partially, so we do not recommend
using it for practical subprogram elimination.
@@ -1398,8 +1400,8 @@ as @code{Parameter_Types => ("")}
Alternatively, the @code{Source_Location} parameter is used to specify
which overloaded alternative is to be eliminated by pointing to the
location of the DEFINING_PROGRAM_UNIT_NAME of this subprogram in the
-source text. The string literal submitted as SOURCE_TRACE should have
-the following format:
+source text. The string literal (or concatenation of string literals)
+given as SOURCE_TRACE must have the following format:
@smallexample @c ada
SOURCE_TRACE ::= SOURCE_LOCATION@{LBRACKET SOURCE_LOCATION RBRACKET@}
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 2b908fb2e8b55789eea4b4f19e87df2dc292c6d3..5ae1a892124d010689cdfc6c6a81c851bd79fb1d 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -8334,6 +8334,15 @@ decides are necessary.
Indicates the verbosity of the parsing of GNAT project files.
See @ref{Switches Related to Project Files}.
+@item ^-x^/NON_PROJECT_UNIT_COMPILATION^
+@cindex @option{^-x^/NON_PROJECT_UNIT_COMPILATION^} (@code{gnatmake})
+Indicates that sources that are not part of any Project File may be compiled.
+Normally, when using Project Files, only sources that are part of a Project
+File may be compile. When this switch is used, a source outside of all Project
+Files may be compiled. The ALI file and the object file will be put in the
+object directory of the main Project. The compilation switches used will only
+be those specified on the command line.
+
@item ^-X^/EXTERNAL_REFERENCE=^@var{name=value}
Indicates that external variable @var{name} has the value @var{value}.
The Project Manager will use this value for occurrences of
@@ -17566,7 +17575,9 @@ by @command{gnatstub} to compile an argument source file.
@cindex @option{^-gnatyM^/MAX_LINE_LENGTH^} (@command{gnatstub})
(@var{n} is a non-negative integer). Set the maximum line length in the
body stub to @var{n}; the default is 79. The maximum value that can be
-specified is 32767.
+specified is 32767. Note that in the special case of configuration
+pragma files, the maximum is always 32767 regardless of whether or
+not this switch appears.
@item ^-gnaty^/STYLE_CHECKS=^@var{n}
@cindex @option{^-gnaty^/STYLE_CHECKS=^} (@command{gnatstub})
diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb
index 6b3d07e7065443fd65e1244a854324a7c9f51d65..1e491f2a7d3294cdcab518ea02ba536d2e59e2e8 100644
--- a/gcc/ada/gnatls.adb
+++ b/gcc/ada/gnatls.adb
@@ -38,6 +38,7 @@ with Osint; use Osint;
with Osint.L; use Osint.L;
with Output; use Output;
with Rident; use Rident;
+with Snames;
with Targparm; use Targparm;
with Types; use Types;
@@ -938,6 +939,7 @@ begin
Namet.Initialize;
Csets.Initialize;
+ Snames.Initialize;
-- Loop to scan out arguments
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index e43821eab673a8ce3fbde4e0c9f4389de37bb84e..b27e059ed9d16f64fb8c367cf8c3e3cf92809189 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -1281,7 +1281,17 @@ __gnat_initialize (void)
#elif defined (VMS)
-#ifdef IN_RTS
+#ifdef __IA64
+#define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
+#define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
+#define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE
+#else
+#define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
+#define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
+#define lib_get_invo_handle LIB$GET_INVO_HANDLE
+#endif
+
+#if defined (IN_RTS) && !defined (__IA64)
/* The prehandler actually gets control first on a condition. It swaps the
stack pointer and calls the handler (__gnat_error_handler). */
@@ -1464,10 +1474,10 @@ __gnat_error_handler (int *sigargs, void *mechargs)
mstate = (long *) (*Get_Machine_State_Addr) ();
if (mstate != 0)
{
- LIB$GET_CURR_INVO_CONTEXT (&curr_icb);
- LIB$GET_PREV_INVO_CONTEXT (&curr_icb);
- LIB$GET_PREV_INVO_CONTEXT (&curr_icb);
- curr_invo_handle = LIB$GET_INVO_HANDLE (&curr_icb);
+ lib_get_curr_invo_context (&curr_icb);
+ lib_get_prev_invo_context (&curr_icb);
+ lib_get_prev_invo_context (&curr_icb);
+ curr_invo_handle = lib_get_invo_handle (&curr_icb);
*mstate = curr_invo_handle;
}
Raise_From_Signal_Handler (exception, msg);
@@ -1477,7 +1487,7 @@ void
__gnat_install_handler (void)
{
long prvhnd;
-#ifdef IN_RTS
+#if defined (IN_RTS) && !defined (__IA64)
char *c;
c = (char *) xmalloc (2049);
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index ee0926c54641c40c2ea8844e4ccaeb2b32cb86a8..a4b2a41ff9fdc1df6e8391f34c62486b3782ef2c 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -1727,10 +1727,16 @@ package body Make is
Project => Arguments_Project,
Path => Arguments_Path_Name);
- -- If the source is not a source of a project file,
- -- we simply add the saved gcc switches.
+ -- If the source is not a source of a project file, check if
+ -- this is allowed.
if Arguments_Project = No_Project then
+ if not External_Unit_Compilation_Allowed then
+ Make_Failed ("external source, not part of any projects, " &
+ "cannot be compiled (", Source_File_Name, ")");
+ end if;
+
+ -- If it is allowed, simply add the saved gcc switches
Add_Arguments (The_Saved_Gcc_Switches.all);
diff --git a/gcc/ada/makeusg.adb b/gcc/ada/makeusg.adb
index 268f75492eb898ae2e4f082e872b95ddb2f92eee..ed7140f84d70baec4609200429cd4d78f4305470 100644
--- a/gcc/ada/makeusg.adb
+++ b/gcc/ada/makeusg.adb
@@ -191,6 +191,12 @@ begin
Write_Str (" -vPx Specify verbosity when parsing GNAT Project Files");
Write_Eol;
+ -- Line for -x
+
+ Write_Str (" -x " &
+ "Allow compilation of needed units external to the projects");
+ Write_Eol;
+
-- Line for -X
Write_Str (" -Xnm=val Specify an external reference for GNAT " &
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index eb92cd76dafb3bbc9d640358bb593157c54c98a6..926affc54c7acbf735e16a37353315246fe45c47 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -24,14 +24,14 @@
-- --
------------------------------------------------------------------------------
-with Namet; use Namet;
-with Osint; use Osint;
-with Prj; use Prj;
+with Namet; use Namet;
+with Osint; use Osint;
+with Prj; use Prj;
with Prj.Ext;
with Prj.Util;
-with Snames; use Snames;
+with Snames; use Snames;
with Table;
-with Types; use Types;
+with Types; use Types;
with System.HTable;
@@ -44,6 +44,8 @@ package body Makeutl is
-- Identify either a mono-unit source (when Index = 0) or a specific unit
-- in a multi-unit source.
+ -- There follow many global undocumented declarations, comments needed ???
+
Max_Mask_Num : constant := 2048;
subtype Mark_Num is Union_Id range 0 .. Max_Mask_Num - 1;
@@ -91,9 +93,9 @@ package body Makeutl is
if Last_Linker_Option = Linker_Options_Buffer'Last then
declare
New_Buffer : constant String_List_Access :=
- new String_List
- (1 .. Linker_Options_Buffer'Last +
- Linker_Option_Initial_Count);
+ new String_List
+ (1 .. Linker_Options_Buffer'Last +
+ Linker_Option_Initial_Count);
begin
New_Buffer (Linker_Options_Buffer'Range) :=
Linker_Options_Buffer.all;
@@ -158,7 +160,6 @@ package body Makeutl is
or else Equal_Pos >= Finish
then
return False;
-
else
Prj.Ext.Add
(External_Name => Argv (Start .. Equal_Pos - 1),
@@ -173,8 +174,7 @@ package body Makeutl is
function Is_Marked
(Source_File : File_Name_Type;
- Index : Int := 0)
- return Boolean
+ Index : Int := 0) return Boolean
is
begin
return Marks.Get (K => (File => Source_File, Index => Index));
@@ -185,21 +185,21 @@ package body Makeutl is
-----------------------------
function Linker_Options_Switches
- (Project : Project_Id)
- return String_List
+ (Project : Project_Id) return String_List
is
+ procedure Recursive_Add_Linker_Options (Proj : Project_Id);
+ -- The recursive routine used to add linker options
----------------------------------
-- Recursive_Add_Linker_Options --
----------------------------------
- procedure Recursive_Add_Linker_Options (Proj : Project_Id);
-
procedure Recursive_Add_Linker_Options (Proj : Project_Id) is
- Data : Project_Data;
+ Data : Project_Data;
Linker_Package : Package_Id;
- Options : Variable_Value;
- Imported : Project_List;
+ Options : Variable_Value;
+ Imported : Project_List;
+
begin
if Proj /= No_Project then
Data := Projects.Table (Proj);
@@ -239,6 +239,8 @@ package body Makeutl is
end if;
end Recursive_Add_Linker_Options;
+ -- Start of processing for Linker_Options_Switches
+
begin
Linker_Opts.Init;
@@ -382,7 +384,6 @@ package body Makeutl is
is
begin
if Switch /= null then
-
declare
Sw : String (1 .. Switch'Length);
Start : Positive;
@@ -458,6 +459,7 @@ package body Makeutl is
Start : Natural;
Finish : Natural;
Result : Int := 0;
+
begin
Get_Name_String (ALI_File);
@@ -486,9 +488,9 @@ package body Makeutl is
-- the character that precedes a unit index, this is not the ALI file
-- of a unit in a multi-unit source.
- if Start > Finish or else
- Start = 1 or else
- Name_Buffer (Start - 1) /= Multi_Unit_Index_Character
+ if Start > Finish
+ or else Start = 1
+ or else Name_Buffer (Start - 1) /= Multi_Unit_Index_Character
then
return 0;
end if;
@@ -496,8 +498,8 @@ package body Makeutl is
-- Build the index from the digit(s)
while Start <= Finish loop
- Result := (Result * 10) + Character'Pos (Name_Buffer (Start))
- - Character'Pos ('0');
+ Result := Result * 10 +
+ Character'Pos (Name_Buffer (Start)) - Character'Pos ('0');
Start := Start + 1;
end loop;
diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads
index b5cfaf7be3d8827fbd369af7dd1c5f0b209cbf6e..0a3f11a0aafa9caa66338880d80129252c931eb4 100644
--- a/gcc/ada/makeutl.ads
+++ b/gcc/ada/makeutl.ads
@@ -24,37 +24,45 @@
-- --
------------------------------------------------------------------------------
-with GNAT.OS_Lib; use GNAT.OS_Lib;
with Osint;
-with Prj; use Prj;
-with Types; use Types;
+with Prj; use Prj;
+with Types; use Types;
+
+with GNAT.OS_Lib; use GNAT.OS_Lib;
package Makeutl is
type Fail_Proc is access procedure
- (S1 : String; S2 : String := ""; S3 : String := "");
+ (S1 : String;
+ S2 : String := "";
+ S3 : String := "");
Do_Fail : Fail_Proc := Osint.Fail'Access;
+ -- Comment required ???
function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
-- Find the index of a unit in a source file. Return zero if the file
-- is not a multi-unit source file.
function Is_External_Assignment (Argv : String) return Boolean;
- -- Verify that an external assignment switch is syntactically correct.
- -- Correct forms are
+ -- Verify that an external assignment switch is syntactically correct
+ --
+ -- Correct forms are:
+ --
-- -Xname=value
-- -X"name=other value"
+ --
-- Assumptions: 'First = 1, Argv (1 .. 2) = "-X"
-- When this function returns True, the external assignment has
-- been entered by a call to Prj.Ext.Add, so that in a project
-- file, External ("name") will return "value".
+ function Linker_Options_Switches (Project : Project_Id) return String_List;
+ -- Comment required ???
+
-- Package Mains is used to store the mains specified on the command line
-- and to retrieve them when a project file is used, to verify that the
-- files exist and that they belong to a project file.
- function Linker_Options_Switches (Project : Project_Id) return String_List;
-
package Mains is
-- Mains are stored in a table. An index is used to retrieve the mains
@@ -100,8 +108,7 @@ package Makeutl is
function Is_Marked
(Source_File : File_Name_Type;
- Index : Int := 0)
- return Boolean;
+ Index : Int := 0) return Boolean;
-- Returns True if the unit was previously marked.
procedure Delete_All_Marks;
diff --git a/gcc/ada/misc.c b/gcc/ada/misc.c
index f40d2728367121cd3c67bdb1d60d9ad26438f171..dca2b0fe9f2d864840b25f33102dcd2e4d938bbf 100644
--- a/gcc/ada/misc.c
+++ b/gcc/ada/misc.c
@@ -320,6 +320,9 @@ gnat_init_options (unsigned int argc, const char **argv)
save_argc = argc;
save_argv = argv;
+ /* Uninitialized really means uninitialized in Ada. */
+ flag_zero_initialized_in_bss = 0;
+
return CL_Ada;
}
@@ -972,4 +975,3 @@ fp_size_to_prec (int size)
abort ();
}
-
diff --git a/gcc/ada/mlib-utl.adb b/gcc/ada/mlib-utl.adb
index 7c3a4ee707f926edf5c91f2eb729cb3d940d5a76..152d272b0350e9fd79363ec5bf4baa6f9b7b2f7d 100644
--- a/gcc/ada/mlib-utl.adb
+++ b/gcc/ada/mlib-utl.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2003, Ada Core Technologies, Inc. --
+-- Copyright (C) 2002-2004, Ada Core Technologies, 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- --
@@ -64,7 +64,6 @@ package body MLib.Utl is
Success : Boolean;
Line_Length : Natural := 0;
- Max_Line_Length : constant := 200; -- arbitrary
begin
Initialize;
@@ -82,9 +81,12 @@ package body MLib.Utl is
Line_Length := Ar_Name'Length;
for J in Arguments'Range loop
+
-- Make sure the Output buffer does not overflow
- if Line_Length + 1 + Arguments (J)'Length > Max_Line_Length then
+ if Line_Length + 1 + Arguments (J)'Length >
+ Integer (Opt.Max_Line_Length)
+ then
Write_Eol;
Line_Length := 0;
end if;
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 90babc28861ca170de703041d30b7e9cb40ea4cf..eb34e50f3fcbd4a98e6295b9a6ba58e2af490cdd 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -398,6 +398,11 @@ package Opt is
-- effect if an explicit Link_Name is supplied (a link name is always
-- used exactly as given).
+ External_Unit_Compilation_Allowed : Boolean := False;
+ -- GNATMAKE
+ -- When True (set by gnatmake switch -x), allow compilation of sources
+ -- that are not part of any project file.
+
Float_Format : Character := ' ';
-- GNAT
-- A non-blank value indicates that a Float_Format pragma has been
@@ -659,6 +664,15 @@ package Opt is
-- extension, as set by the appropriate switch. If no switch is given,
-- then this value is initialized by Osint to the appropriate value.
+ Max_Line_Length : Int := Hostparm.Max_Line_Length;
+ -- This is a copy of Max_Line_Length used by the scanner. It is usually
+ -- set to be a copy of Hostparm.Max_Line_Length, and is used to check
+ -- the maximum line length in the scanner when style checking is inactive.
+ -- The only time it is set to a different value is during the scanning of
+ -- configuration pragma files, where we want to turn off all checking and
+ -- in particular we want to allow long lines. So we reset this value to
+ -- Column_Number'Last during scanning of configuration pragma files.
+
Maximum_Processes : Positive := 1;
-- GNATMAKE
-- Maximum number of processes that should be spawned to carry out
diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb
index 0e83dbb7d061dec65904fd4d025ec1568b47805a..aa45a7a03b427fc433f2b036362df582f889c926 100644
--- a/gcc/ada/osint.adb
+++ b/gcc/ada/osint.adb
@@ -1029,7 +1029,6 @@ package body Osint is
if Command_Name (Cindex2) in '0' .. '9' then
for J in reverse Cindex1 .. Cindex2 loop
-
if Command_Name (J) = '.' or Command_Name (J) = ';' then
Cindex2 := J - 1;
exit;
diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads
index f6e69c74814678be8c26cd558199100f9a53cb42..6e5672d1aca7408c7bc6732309be3979b77dac86 100644
--- a/gcc/ada/osint.ads
+++ b/gcc/ada/osint.ads
@@ -93,10 +93,14 @@ package Osint is
-- gives the total number of filenames found on the command line.
No_Index : constant := -1;
+ -- Value used in Add_File to indicate that no index is specified
+ -- for a main.
procedure Add_File (File_Name : String; Index : Int := No_Index);
-- Called by the subprogram processing the command line for each
- -- file name found.
+ -- file name found. The index, when not defaulted to No_Index
+ -- is the index of the subprogram in its source, zero indicating
+ -- that the source is not multi-unit.
procedure Find_Program_Name;
-- Put simple name of current program being run (excluding the directory
diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb
index 89233fa90eb765f1a21f3e5f2c2bb7378c74be47..0db8d9150bdffbec5a6fda91ccaafcec668af1a4 100644
--- a/gcc/ada/prj-dect.adb
+++ b/gcc/ada/prj-dect.adb
@@ -197,8 +197,8 @@ package body Prj.Dect is
-- Set, if appropriate the index case insensitivity flag
elsif Attributes.Table (Current_Attribute).Kind_2 in
- Case_Insensitive_Associative_Array ..
- Optional_Index_Case_Insensitive_Associative_Array
+ Case_Insensitive_Associative_Array ..
+ Optional_Index_Case_Insensitive_Associative_Array
then
Set_Case_Insensitive (Attribute, To => True);
end if;
@@ -257,15 +257,16 @@ package body Prj.Dect is
Expect (Tok_Integer_Literal, "integer literal");
if Token = Tok_Integer_Literal then
+
+ -- Set the source index value from given literal
+
declare
Index : constant Int :=
UI_To_Int (Int_Literal_Value);
begin
if Index = 0 then
Error_Msg ("index cannot be zero", Token_Ptr);
-
else
- -- Set the index
Set_Source_Index_Of (Attribute, To => Index);
end if;
end;
diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb
index 8dade50791560b096489e1c56a93e17dff63f099..cc1bd83db80189fcdf1ef2e53715cdfc2e27600c 100644
--- a/gcc/ada/prj-strt.adb
+++ b/gcc/ada/prj-strt.adb
@@ -1205,6 +1205,8 @@ package body Prj.Strt is
Scan;
+ -- Check for possible index expression
+
if Token = Tok_At then
if not Optional_Index then
Error_Msg ("index not allowed here", Token_Ptr);
@@ -1214,6 +1216,8 @@ package body Prj.Strt is
Scan;
end if;
+ -- Set the index value
+
else
Scan;
Expect (Tok_Integer_Literal, "integer literal");
@@ -1224,9 +1228,7 @@ package body Prj.Strt is
begin
if Index = 0 then
Error_Msg ("index cannot be zero", Token_Ptr);
-
else
- -- Set the index
Set_Source_Index_Of (Term_Id, To => Index);
end if;
end;
diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb
index 993d1ecf451be357b51d903012332c98dd399db6..2a67b57c5b122dfcdd201f67da2ea07303f2d1a0 100644
--- a/gcc/ada/prj-tree.adb
+++ b/gcc/ada/prj-tree.adb
@@ -2361,8 +2361,8 @@ package body Prj.Tree is
(Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration)
- and then
- Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
+ and then
+ Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
if Project_Nodes.Table (Node).Kind = N_Variable_Reference then
Project_Nodes.Table (Node).Field3 := To;
@@ -2400,9 +2400,9 @@ package body Prj.Tree is
pragma Assert
(Node /= Empty_Node
and then
- (Project_Nodes.Table (Node).Kind = N_Literal_String
- or else
- Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
+ (Project_Nodes.Table (Node).Kind = N_Literal_String
+ or else
+ Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
return Project_Nodes.Table (Node).Src_Index;
end Source_Index_Of;
@@ -2410,9 +2410,7 @@ package body Prj.Tree is
-- String_Type_Of --
--------------------
- function String_Type_Of
- (Node : Project_Node_Id) return Project_Node_Id
- is
+ function String_Type_Of (Node : Project_Node_Id) return Project_Node_Id is
begin
pragma Assert
(Node /= Empty_Node
diff --git a/gcc/ada/s-auxdec.ads b/gcc/ada/s-auxdec.ads
index c517ae5ee308bbf30713a37cae5c87f3a989a75d..2d34ff111c977e2cc7b644a0fd11d23ebaf3ce74 100644
--- a/gcc/ada/s-auxdec.ads
+++ b/gcc/ada/s-auxdec.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1996-2002 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- --
@@ -42,6 +42,16 @@ with Unchecked_Conversion;
package System.Aux_DEC is
pragma Elaborate_Body (Aux_DEC);
+ subtype Short_Address is Address;
+ -- In some versions of System.Aux_DEC, notably that for VMS on the
+ -- ia64, there are two address types (64-bit and 32-bit), and the
+ -- name Short_Address is used for the short address form. To avoid
+ -- difficulties (in regression tests and elsewhere) with units that
+ -- reference Short_Address, it is provided for other targets as a
+ -- synonum for the normal Address type, and, as in the case where
+ -- the lengths are different, Address and Short_Address can be
+ -- freely inter-converted.
+
type Integer_8 is range -2 ** (8 - 1) .. +2 ** (8 - 1) - 1;
for Integer_8'Size use 8;
diff --git a/gcc/ada/s-inmaop.ads b/gcc/ada/s-inmaop.ads
index d83f12184af52aa24c227f862207af3a766473dc..2bb8ef0caa1059a92b5c58ee712c299855566f2d 100644
--- a/gcc/ada/s-inmaop.ads
+++ b/gcc/ada/s-inmaop.ads
@@ -7,7 +7,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1998, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -35,78 +35,82 @@
package System.Interrupt_Management.Operations is
procedure Thread_Block_Interrupt (Interrupt : Interrupt_ID);
- -- Mask the calling thread for the interrupt
pragma Inline (Thread_Block_Interrupt);
+ -- Mask the calling thread for the interrupt
procedure Thread_Unblock_Interrupt (Interrupt : Interrupt_ID);
- -- Unmask the calling thread for the interrupt
pragma Inline (Thread_Unblock_Interrupt);
+ -- Unmask the calling thread for the interrupt
procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask);
-- Set the interrupt mask of the calling thread
+
procedure Set_Interrupt_Mask
(Mask : access Interrupt_Mask;
OMask : access Interrupt_Mask);
+ pragma Inline (Set_Interrupt_Mask);
-- Set the interrupt mask of the calling thread while returning the
-- previous Mask.
- pragma Inline (Set_Interrupt_Mask);
procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask);
- -- Get the interrupt mask of the calling thread
pragma Inline (Get_Interrupt_Mask);
+ -- Get the interrupt mask of the calling thread
function Interrupt_Wait (Mask : access Interrupt_Mask) return Interrupt_ID;
- -- Wait for the interrupts specified in Mask and return
- -- the interrupt received. Upon error it return 0.
pragma Inline (Interrupt_Wait);
+ -- Wait for the interrupts specified in Mask and return
+ -- the interrupt received. Return 0 upon error.
procedure Install_Default_Action (Interrupt : Interrupt_ID);
- -- Set the sigaction of the Interrupt to default (SIG_DFL).
pragma Inline (Install_Default_Action);
+ -- Set the sigaction of the Interrupt to default (SIG_DFL).
procedure Install_Ignore_Action (Interrupt : Interrupt_ID);
- -- Set the sigaction of the Interrupt to ignore (SIG_IGN).
pragma Inline (Install_Ignore_Action);
+ -- Set the sigaction of the Interrupt to ignore (SIG_IGN).
procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask);
- -- Get a Interrupt_Mask with all the interrupt masked
pragma Inline (Fill_Interrupt_Mask);
+ -- Get a Interrupt_Mask with all the interrupt masked
procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask);
- -- Get a Interrupt_Mask with all the interrupt unmasked
pragma Inline (Empty_Interrupt_Mask);
+ -- Get a Interrupt_Mask with all the interrupt unmasked
procedure Add_To_Interrupt_Mask
(Mask : access Interrupt_Mask;
Interrupt : Interrupt_ID);
- -- Mask the given interrupt in the Interrupt_Mask
pragma Inline (Add_To_Interrupt_Mask);
+ -- Mask the given interrupt in the Interrupt_Mask
procedure Delete_From_Interrupt_Mask
(Mask : access Interrupt_Mask;
Interrupt : Interrupt_ID);
- -- Unmask the given interrupt in the Interrupt_Mask
pragma Inline (Delete_From_Interrupt_Mask);
+ -- Unmask the given interrupt in the Interrupt_Mask
function Is_Member
(Mask : access Interrupt_Mask;
Interrupt : Interrupt_ID) return Boolean;
- -- See if a given interrupt is masked in the Interrupt_Mask
pragma Inline (Is_Member);
+ -- See if a given interrupt is masked in the Interrupt_Mask
procedure Copy_Interrupt_Mask (X : out Interrupt_Mask; Y : Interrupt_Mask);
- -- Assigment needed for limited private type Interrupt_Mask.
pragma Inline (Copy_Interrupt_Mask);
+ -- Assigment needed for limited private type Interrupt_Mask.
procedure Interrupt_Self_Process (Interrupt : Interrupt_ID);
- -- raise an Interrupt process-level
pragma Inline (Interrupt_Self_Process);
+ -- Raise an Interrupt process-level
-- The following objects serve as constants, but are initialized
-- in the body to aid portability. These actually belong to the
-- System.Interrupt_Management but since Interrupt_Mask is a
-- private type we can not have them declared there.
+ -- Why not make these deferred constants that are initialized using
+ -- function calls in the private part???
+
Environment_Mask : aliased Interrupt_Mask;
-- This mask represents the mask of Environment task when this package
-- is being elaborated, except the signals being
diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb
index 0398551d5dd0c76c5e2b527a51eb7fe0ebf1c55d..5e8fbbf22988c3360eafd75b9c4160d0cd21c749 100644
--- a/gcc/ada/scn.adb
+++ b/gcc/ada/scn.adb
@@ -26,7 +26,6 @@
with Atree; use Atree;
with Csets; use Csets;
-with Hostparm;
with Namet; use Namet;
with Opt; use Opt;
with Scans; use Scans;
@@ -99,13 +98,11 @@ package body Scn is
procedure Check_End_Of_Line is
Len : constant Int := Int (Scan_Ptr) - Int (Current_Line_Start);
-
begin
- if Len > Hostparm.Max_Line_Length then
- Error_Long_Line;
-
- elsif Style_Check then
+ if Style_Check then
Style.Check_Line_Terminator (Len);
+ elsif Len > Opt.Max_Line_Length then
+ Error_Long_Line;
end if;
end Check_End_Of_Line;
@@ -115,6 +112,7 @@ package body Scn is
function Determine_License return License_Type is
GPL_Found : Boolean := False;
+ Result : License_Type;
function Contains (S : String) return Boolean;
-- See if current comment contains successive non-blank characters
@@ -191,14 +189,17 @@ package body Scn is
or else Source (Scan_Ptr + 1) /= '-'
then
if GPL_Found then
- return GPL;
+ Result := GPL;
+ exit;
else
- return Unknown;
+ Result := Unknown;
+ exit;
end if;
elsif Contains ("Asaspecialexception") then
if GPL_Found then
- return Modified_GPL;
+ Result := Modified_GPL;
+ exit;
end if;
elsif Contains ("GNUGeneralPublicLicense") then
@@ -211,7 +212,8 @@ package body Scn is
Contains
("ThisspecificationisderivedfromtheAdaReferenceManual")
then
- return Unrestricted;
+ Result := Unrestricted;
+ exit;
end if;
Skip_EOL;
@@ -240,6 +242,8 @@ package body Scn is
end;
end if;
end loop;
+
+ return Result;
end Determine_License;
----------------------------
@@ -259,7 +263,7 @@ package body Scn is
begin
Error_Msg
("this line is too long",
- Current_Line_Start + Hostparm.Max_Line_Length);
+ Current_Line_Start + Source_Ptr (Opt.Max_Line_Length));
end Error_Long_Line;
------------------------
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index 93e340f54ac6aa1120285aa2887be4d124443df0..92b3c74810d4420ffa379f106fda3e8e33a3ae1e 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -26,7 +26,6 @@
with Csets; use Csets;
with Err_Vars; use Err_Vars;
-with Hostparm; use Hostparm;
with Namet; use Namet;
with Opt; use Opt;
with Scans; use Scans;
@@ -302,7 +301,14 @@ package body Scng is
if Style_Check and Style_Check_Max_Line_Length then
Style.Check_Line_Terminator (Len);
- elsif Len > Hostparm.Max_Line_Length then
+ -- If style checking is inactive, check maximum line length against
+ -- standard value. Note that we take this from Opt.Max_Line_Length
+ -- rather than Hostparm.Max_Line_Length because we do not want to
+ -- impose any limit during scanning of configuration pragma files,
+ -- and Opt.Max_Line_Length (normally set to Hostparm.Max_Line_Length)
+ -- is reset to Column_Number'Max during scanning of such files.
+
+ elsif Len > Opt.Max_Line_Length then
Error_Long_Line;
end if;
end Check_End_Of_Line;
@@ -359,7 +365,7 @@ package body Scng is
begin
Error_Msg
("this line is too long",
- Current_Line_Start + Hostparm.Max_Line_Length);
+ Current_Line_Start + Source_Ptr (Opt.Max_Line_Length));
end Error_Long_Line;
-------------------------------
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index c821c7c2fc07852ab9ebf21d5aef0b155417dc34..9c0da7f97f74a06d789a3220d9a5e9dff30e7db6 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -511,7 +511,7 @@ package body Sem_Ch10 is
end;
end if;
- -- Generate distribution stub files if requested and no error
+ -- Generate distribution stubs if requested and no error
if N = Main_Cunit
and then (Distribution_Stub_Mode = Generate_Receiver_Stub_Body
@@ -546,9 +546,6 @@ package body Sem_Ch10 is
Add_Stub_Constructs (N);
end if;
- -- Reanalyze the unit with the new constructs
-
- Analyze (Unit_Node);
end if;
if Nkind (Unit_Node) = N_Package_Declaration
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 954d4d343cb562a54f221f9966ca67acb824bcdd..4f9383142e5acba6b266af049ff325abb298a8e9 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -4359,17 +4359,19 @@ package body Sem_Ch4 is
-- subprograms are used to hide its operators, they will be
-- truly hidden.
- procedure Remove_Address_Interpretations;
+ type Operand_Position is (First_Op, Second_Op);
+
+ procedure Remove_Address_Interpretations (Op : Operand_Position);
-- Ambiguities may arise when the operands are literal and the
-- address operations in s-auxdec are visible. In that case, remove
-- the interpretation of a literal as Address, to retain the semantics
-- of Address as a private type.
------------------------------------
- -- Remove_Address_Intereprtations --
+ -- Remove_Address_Interpretations --
------------------------------------
- procedure Remove_Address_Interpretations is
+ procedure Remove_Address_Interpretations (Op : Operand_Position) is
Formal : Entity_Id;
begin
@@ -4378,13 +4380,11 @@ package body Sem_Ch4 is
while Present (It.Nam) loop
Formal := First_Entity (It.Nam);
- if Is_Descendent_Of_Address (Etype (Formal))
- or else
- (Present (Next_Entity (Formal))
- and then
- Is_Descendent_Of_Address
- (Etype (Next_Entity (Formal))))
- then
+ if Op = Second_Op then
+ Formal := Next_Entity (Formal);
+ end if;
+
+ if Is_Descendent_Of_Address (Etype (Formal)) then
Remove_Interp (I);
end if;
@@ -4417,38 +4417,43 @@ package body Sem_Ch4 is
Get_Next_Interp (I, It);
end loop;
- -- Remove corresponding predefined operator, which is
- -- always added to the overload set, unless it is a universal
- -- operation.
-
if No (Abstract_Op) then
return;
- -- Remove address interpretations if we have a universal
- -- interpretation. This avoids literals being interpreted
- -- as type Address, which is never appropriate.
-
elsif Nkind (N) in N_Op then
- if Nkind (N) in N_Unary_Op
- and then Present (Universal_Interpretation (Right_Opnd (N)))
- then
- Remove_Address_Interpretations;
+ -- Remove interpretations that treat literals as addresses.
+ -- This is never appropriate.
- elsif Nkind (N) in N_Binary_Op
- and then Present (Universal_Interpretation (Right_Opnd (N)))
- and then Present (Universal_Interpretation (Left_Opnd (N)))
- then
- Remove_Address_Interpretations;
+ if Nkind (N) in N_Binary_Op then
+ declare
+ U1 : constant Boolean :=
+ Present (Universal_Interpretation (Right_Opnd (N)));
+ U2 : constant Boolean :=
+ Present (Universal_Interpretation (Left_Opnd (N)));
- else
- Get_First_Interp (N, I, It);
- while Present (It.Nam) loop
- if Scope (It.Nam) = Standard_Standard then
- Remove_Interp (I);
+ begin
+ if U1 and then not U2 then
+ Remove_Address_Interpretations (Second_Op);
+
+ elsif U2 and then not U1 then
+ Remove_Address_Interpretations (First_Op);
end if;
- Get_Next_Interp (I, It);
- end loop;
+ if not (U1 and U2) then
+
+ -- Remove corresponding predefined operator, which is
+ -- always added to the overload set.
+
+ Get_First_Interp (N, I, It);
+ while Present (It.Nam) loop
+ if Scope (It.Nam) = Standard_Standard then
+ Remove_Interp (I);
+ end if;
+
+ Get_Next_Interp (I, It);
+ end loop;
+ end if;
+ end;
end if;
elsif Nkind (N) = N_Function_Call
@@ -4459,18 +4464,24 @@ package body Sem_Ch4 is
and then
Nkind (Selector_Name (Name (N))) = N_Operator_Symbol))
then
+
declare
Arg1 : constant Node_Id := First (Parameter_Associations (N));
+ U1 : constant Boolean :=
+ Present (Universal_Interpretation (Arg1));
+ U2 : constant Boolean :=
+ Present (Next (Arg1)) and then
+ Present (Universal_Interpretation (Next (Arg1)));
begin
- if Present (Universal_Interpretation (Arg1))
- and then
- (No (Next (Arg1))
- or else Present (Universal_Interpretation (Next (Arg1))))
- then
- Remove_Address_Interpretations;
+ if U1 and then not U2 then
+ Remove_Address_Interpretations (First_Op);
- else
+ elsif U2 and then not U1 then
+ Remove_Address_Interpretations (Second_Op);
+ end if;
+
+ if not (U1 and U2) then
Get_First_Interp (N, I, It);
while Present (It.Nam) loop
if Scope (It.Nam) = Standard_Standard
@@ -4486,7 +4497,7 @@ package body Sem_Ch4 is
end if;
-- If the removal has left no valid interpretations, emit
- -- error message now an label node as illegal.
+ -- error message now and label node as illegal.
if Present (Abstract_Op) then
Get_First_Interp (N, I, It);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 3d4f02eef6ff691cc82d4ebca60aca278d735977..89512b51c7e49d5157dc05d42962b5034d91ab92 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -4599,8 +4599,9 @@ package body Sem_Ch6 is
end if;
-- In any case the implicit operation remains hidden by
- -- the existing declaration.
+ -- the existing declaration, which is overriding.
+ Set_Is_Overriding_Operation (E);
return;
-- Within an instance, the renaming declarations for
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 4c538b0ff40f8499e87e1566567657600fc28630..5c85af2d600b1a28c30436cd9a526f572ec9dca9 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.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- --
@@ -41,6 +41,7 @@ with Sem_Ch6; use Sem_Ch6;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
with Snames; use Snames;
+with Stand; use Stand;
with Sinfo; use Sinfo;
with Uintp; use Uintp;
@@ -423,6 +424,27 @@ package body Sem_Disp is
Has_Dispatching_Parent : Boolean := False;
Body_Is_Last_Primitive : Boolean := False;
+ function Is_Visibly_Controlled (T : Entity_Id) return Boolean;
+ -- Check whether T is derived from a visibly controlled type.
+ -- This is true if the root type is declared in Ada.Finalization.
+ -- If T is derived instead from a private type whose full view
+ -- is controlled, an explicit Initialize/Adjust/Finalize subprogram
+ -- does not override the inherited one.
+
+ ---------------------------
+ -- Is_Visibly_Controlled --
+ ---------------------------
+
+ function Is_Visibly_Controlled (T : Entity_Id) return Boolean is
+ Root : constant Entity_Id := Root_Type (T);
+ begin
+ return Chars (Scope (Root)) = Name_Finalization
+ and then Chars (Scope (Scope (Root))) = Name_Ada
+ and then Scope (Scope (Scope (Root))) = Standard_Standard;
+ end Is_Visibly_Controlled;
+
+ -- Start of processing for Check_Dispatching_Operation
+
begin
if Ekind (Subp) /= E_Procedure and then Ekind (Subp) /= E_Function then
return;
@@ -595,8 +617,19 @@ package body Sem_Disp is
if Present (Old_Subp) then
Check_Subtype_Conformant (Subp, Old_Subp);
- Override_Dispatching_Operation (Tagged_Type, Old_Subp, Subp);
- Set_Is_Overriding_Operation (Subp);
+ if (Chars (Subp) = Name_Initialize
+ or else Chars (Subp) = Name_Adjust
+ or else Chars (Subp) = Name_Finalize)
+ and then Is_Controlled (Tagged_Type)
+ and then not Is_Visibly_Controlled (Tagged_Type)
+ then
+ Set_Is_Overriding_Operation (Subp, False);
+ Error_Msg_NE
+ ("operation does not override inherited&?", Subp, Subp);
+ else
+ Override_Dispatching_Operation (Tagged_Type, Old_Subp, Subp);
+ Set_Is_Overriding_Operation (Subp);
+ end if;
else
Add_Dispatching_Operation (Tagged_Type, Subp);
end if;
diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb
index 9f138ebf7ce81460b9436f1d991c9fd7f7ede4f4..cb07a921c87eb9f8ec77b2a0499d27695c25a693 100644
--- a/gcc/ada/sem_elim.adb
+++ b/gcc/ada/sem_elim.adb
@@ -24,19 +24,21 @@
-- --
------------------------------------------------------------------------------
-with Atree; use Atree;
-with Einfo; use Einfo;
-with Errout; use Errout;
-with Namet; use Namet;
-with Nlists; use Nlists;
-with Sinput; use Sinput;
-with Sinfo; use Sinfo;
-with Snames; use Snames;
-with Stand; use Stand;
-with Stringt; use Stringt;
+with Atree; use Atree;
+with Einfo; use Einfo;
+with Errout; use Errout;
+with Namet; use Namet;
+with Nlists; use Nlists;
+with Sem_Prag; use Sem_Prag;
+with Sinput; use Sinput;
+with Sinfo; use Sinfo;
+with Snames; use Snames;
+with Stand; use Stand;
+with Stringt; use Stringt;
with Table;
with GNAT.HTable; use GNAT.HTable;
+
package body Sem_Elim is
No_Elimination : Boolean;
@@ -774,15 +776,11 @@ package body Sem_Elim is
Data.Entity_Scope (1) := Chars (Arg_Ent);
- elsif Nkind (Arg_Entity) = N_String_Literal then
- String_To_Name_Buffer (Strval (Arg_Entity));
+ elsif Is_Config_Static_String (Arg_Entity) then
Data.Entity_Name := Name_Find;
Data.Entity_Node := Arg_Entity;
else
- Error_Msg_N
- ("wrong form for Entity_Argument parameter of pragma%",
- Arg_Unit_Name);
return;
end if;
else
@@ -794,12 +792,33 @@ package body Sem_Elim is
if Present (Arg_Parameter_Types) then
- -- Case of one name, which looks like a parenthesized literal
- -- rather than an aggregate.
+ -- Here for aggregate case
- if Nkind (Arg_Parameter_Types) = N_String_Literal
- and then Paren_Count (Arg_Parameter_Types) = 1
- then
+ if Nkind (Arg_Parameter_Types) = N_Aggregate then
+ Data.Parameter_Types :=
+ new Names
+ (1 .. List_Length (Expressions (Arg_Parameter_Types)));
+
+ Lit := First (Expressions (Arg_Parameter_Types));
+ for J in Data.Parameter_Types'Range loop
+ if Is_Config_Static_String (Lit) then
+ Data.Parameter_Types (J) := Name_Find;
+ Next (Lit);
+ else
+ return;
+ end if;
+ end loop;
+
+ -- Otherwise we must have case of one name, which looks like a
+ -- parenthesized literal rather than an aggregate.
+
+ elsif Paren_Count (Arg_Parameter_Types) /= 1 then
+ Error_Msg_N
+ ("wrong form for argument of pragma Eliminate",
+ Arg_Parameter_Types);
+ return;
+
+ elsif Is_Config_Static_String (Arg_Parameter_Types) then
String_To_Name_Buffer (Strval (Arg_Parameter_Types));
if Name_Len = 0 then
@@ -812,53 +831,21 @@ package body Sem_Elim is
Data.Parameter_Types := new Names'(1 => Name_Find);
end if;
- -- Otherwise must be an aggregate
-
- elsif Nkind (Arg_Parameter_Types) /= N_Aggregate
- or else Present (Component_Associations (Arg_Parameter_Types))
- or else No (Expressions (Arg_Parameter_Types))
- then
- Error_Msg_N
- ("Parameter_Types for pragma% must be list of string literals",
- Arg_Parameter_Types);
- return;
-
- -- Here for aggregate case
-
else
- Data.Parameter_Types :=
- new Names
- (1 .. List_Length (Expressions (Arg_Parameter_Types)));
-
- Lit := First (Expressions (Arg_Parameter_Types));
- for J in Data.Parameter_Types'Range loop
- if Nkind (Lit) /= N_String_Literal then
- Error_Msg_N
- ("parameter types for pragma% must be string literals",
- Lit);
- return;
- end if;
-
- String_To_Name_Buffer (Strval (Lit));
- Data.Parameter_Types (J) := Name_Find;
- Next (Lit);
- end loop;
+ return;
end if;
end if;
-- Process Result_Types argument
if Present (Arg_Result_Type) then
-
- if Nkind (Arg_Result_Type) /= N_String_Literal then
- Error_Msg_N
- ("Result_Type argument for pragma% must be string literal",
- Arg_Result_Type);
+ if Is_Config_Static_String (Arg_Result_Type) then
+ Data.Result_Type := Name_Find;
+ else
return;
end if;
- String_To_Name_Buffer (Strval (Arg_Result_Type));
- Data.Result_Type := Name_Find;
+ -- Here if no Result_Types argument
else
Data.Result_Type := No_Name;
@@ -867,17 +854,11 @@ package body Sem_Elim is
-- Process Source_Location argument
if Present (Arg_Source_Location) then
-
- if Nkind (Arg_Source_Location) /= N_String_Literal then
- Error_Msg_N
- ("Source_Location argument for pragma% must be string literal",
- Arg_Source_Location);
+ if Is_Config_Static_String (Arg_Source_Location) then
+ Data.Source_Location := Name_Find;
+ else
return;
end if;
-
- String_To_Name_Buffer (Strval (Arg_Source_Location));
- Data.Source_Location := Name_Find;
-
else
Data.Source_Location := No_Name;
end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index b7c3cafa0b5965689e61766e34f76ad3eacd7926..5ab5bdeed45e30689530b07a858b2ef985f4a8b8 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -9916,7 +9916,6 @@ package body Sem_Prag is
when Unknown_Pragma =>
raise Program_Error;
-
end case;
exception
@@ -9948,7 +9947,7 @@ package body Sem_Prag is
and then
(Is_Generic_Instance (Result)
or else Nkind (Parent (Declaration_Node (Result))) =
- N_Subprogram_Renaming_Declaration)
+ N_Subprogram_Renaming_Declaration)
and then Present (Alias (Result))
loop
Result := Alias (Result);
@@ -9957,6 +9956,65 @@ package body Sem_Prag is
return Result;
end Get_Base_Subprogram;
+ -----------------------------
+ -- Is_Config_Static_String --
+ -----------------------------
+
+ function Is_Config_Static_String (Arg : Node_Id) return Boolean is
+
+ function Add_Config_Static_String (Arg : Node_Id) return Boolean;
+ -- This is an internal recursive function that is just like the
+ -- outer function except that it adds the string to the name buffer
+ -- rather than placing the string in the name buffer.
+
+ ------------------------------
+ -- Add_Config_Static_String --
+ ------------------------------
+
+ function Add_Config_Static_String (Arg : Node_Id) return Boolean is
+ N : Node_Id;
+ C : Char_Code;
+
+ begin
+ N := Arg;
+
+ if Nkind (N) = N_Op_Concat then
+ if Add_Config_Static_String (Left_Opnd (N)) then
+ N := Right_Opnd (N);
+ else
+ return False;
+ end if;
+ end if;
+
+ if Nkind (N) /= N_String_Literal then
+ Error_Msg_N ("string literal expected for pragma argument", N);
+ return False;
+
+ else
+ for J in 1 .. String_Length (Strval (N)) loop
+ C := Get_String_Char (Strval (N), J);
+
+ if not In_Character_Range (C) then
+ Error_Msg
+ ("string literal contains invalid wide character",
+ Sloc (N) + 1 + Source_Ptr (J));
+ return False;
+ end if;
+
+ Add_Char_To_Name_Buffer (Get_Character (C));
+ end loop;
+ end if;
+
+ return True;
+ end Add_Config_Static_String;
+
+ -- Start of prorcessing for Is_Config_Static_String
+
+ begin
+ Name_Len := 0;
+ return Add_Config_Static_String (Arg);
+ end Is_Config_Static_String;
+
-----------------------------------------
-- Is_Non_Significant_Pragma_Reference --
-----------------------------------------
diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads
index 9ff4ede80a24efcee79b8e7e97f0420fcf5f297d..fe5cd93320a3bde1016f656ed52226b233a1a375 100644
--- a/gcc/ada/sem_prag.ads
+++ b/gcc/ada/sem_prag.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2002 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- --
@@ -59,6 +59,17 @@ package Sem_Prag is
-- False is returned, then the argument is treated as an entity reference
-- to the operator.
+ function Is_Config_Static_String (Arg : Node_Id) return Boolean;
+ -- This is called for a configuration pragma that requires either a
+ -- string literal or a concatenation of string literals. We cannot
+ -- use normal static string processing because it is too early in
+ -- the case of the pragma appearing in a configuration pragmas file.
+ -- If Arg is of an appropriate form, then this call obtains the string
+ -- (doing any necessary concatenations) and places it in Name_Buffer,
+ -- setting Name_Len to its length, and then returns True. If it is
+ -- not of the correct form, then an appropriate error message is
+ -- posted, and False is returned.
+
procedure Process_Compilation_Unit_Pragmas (N : Node_Id);
-- Called at the start of processing compilation unit N to deal with
-- any special issues regarding pragmas. In particular, we have to
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index db85ab27c958e674e032c3709d9bad9bfcc72cd0..263e701e11d3da0eb37d146336e8c8bd94276c52 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -136,9 +136,10 @@ package body Sem_Util is
Rtyp := Typ;
end if;
- if No (Compile_Time_Constraint_Error (N, Msg, Ent, Loc, Warn => Warn))
- or else not Rep
- then
+ Discard_Node (
+ Compile_Time_Constraint_Error (N, Msg, Ent, Loc, Warn => Warn));
+
+ if not Rep then
return;
end if;
@@ -3309,9 +3310,21 @@ package body Sem_Util is
P_Aliased := True;
end if;
+ -- A discriminant check on a selected component may be
+ -- expanded into a dereference when removing side-effects.
+ -- Recover the original node and its type, which may be
+ -- unconstrained.
+
+ elsif Nkind (P) = N_Explicit_Dereference
+ and then not (Comes_From_Source (P))
+ then
+ P := Original_Node (P);
+ Prefix_Type := Etype (P);
+
else
-- Check for prefix being an aliased component ???
null;
+
end if;
if Is_Access_Type (Prefix_Type)
diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb
index 67cee51013997f117a8253f97a3f0afa45cc01f7..5215fe15029ac4a4122ff9149469690a5356b734 100644
--- a/gcc/ada/switch-m.adb
+++ b/gcc/ada/switch-m.adb
@@ -672,6 +672,12 @@ package body Switch.M is
Ptr := Ptr + 1;
Verbose_Mode := True;
+ -- Processing for x switch
+
+ when 'x' =>
+ Ptr := Ptr + 1;
+ External_Unit_Compilation_Allowed := True;
+
-- Processing for z switch
when 'z' =>
diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index 01be1603930ffa86c7a95cf72de62c3221ae4f6e..4213e8a3a157ac67bfab49f771c67747d7d552fd 100644
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -1348,7 +1348,6 @@ create_var_decl (tree var_name,
|| (static_flag && ! init_const)))
assign_init = var_init, var_init = 0;
- DECL_COMMON (var_decl) = !flag_no_common;
DECL_INITIAL (var_decl) = var_init;
TREE_READONLY (var_decl) = const_flag;
DECL_EXTERNAL (var_decl) = extern_flag;
@@ -1621,7 +1620,6 @@ process_attributes (tree decl, struct attrib *attr_list)
DECL_SECTION_NAME (decl)
= build_string (IDENTIFIER_LENGTH (attr_list->name),
IDENTIFIER_POINTER (attr_list->name));
- DECL_COMMON (decl) = 0;
}
else
post_error ("?section attributes are not supported for this target",
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index 256d8a64a515e54f2246b08d552f841202725d19..ca621b033b669dcbfd3961c450fee0e0fd9110b0 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -3839,6 +3839,14 @@ package VMS_Data is
-- will execute the elaboration routines of the package and its closure,
-- then the finalization routines.
+ S_Make_Nonpro : aliased constant S := "/NON_PROJECT_UNIT_COMPILATION " &
+ "-x";
+ -- /NON_PROJECT_UNIT_COMPILATION
+ --
+ -- Normally, when using project files, a unit that is not part of any
+ -- project file, cannot be compile. These units may be compile, when
+ -- needed, if this qualifier is specified.
+
S_Make_Nostinc : aliased constant S := "/NOSTD_INCLUDES " &
"-nostdinc";
-- /NOSTD_INCLUDES
@@ -3988,6 +3996,7 @@ package VMS_Data is
S_Make_Minimal 'Access,
S_Make_Nolink 'Access,
S_Make_Nomain 'Access,
+ S_Make_Nonpro 'Access,
S_Make_Nostinc 'Access,
S_Make_Nostlib 'Access,
S_Make_Object 'Access,