diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-05-10 16:18:54 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-05-10 16:18:54 +0000 |
| commit | e161d1a33f33dd457c94a584e39ffcb8250afbf6 (patch) | |
| tree | b05f1a8a1cace3f818e7721e71eb91c837736b59 | |
| parent | 3a00c4d1c8f03bffe50ec2ac68d2eb2efea28032 (diff) | |
| download | ppe42-gcc-e161d1a33f33dd457c94a584e39ffcb8250afbf6.tar.gz ppe42-gcc-e161d1a33f33dd457c94a584e39ffcb8250afbf6.zip | |
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
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@81671 138bc75d-0d04-0410-961f-82ee72b054a4
47 files changed, 639 insertions, 284 deletions
diff --git a/gcc/ada/5qsystem.ads b/gcc/ada/5qsystem.ads index cfbba6d5c53..c8b94936ded 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 42207a1ce10..2cbfd0eb715 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 9bf3b5f2698..fc4fb2e6d6f 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 a716fa1a708..3ba5e692195 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 c1531aa9093..6c3ddc3eef9 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 5cf5d62d425..0a6775a438f 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 f35622436fe..6b075b8a3d3 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 98766ce9bf3..7afb804ff9c 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 9548da438ff..6487a22012e 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 e46c7cd6314..31c97d5bc55 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 b0af72df446..cde38932df3 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 d083c32ba5c..2d439930301 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 e78d9954082..287b4efc792 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 f4f36f56aaf..35645bd0812 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 a8968c25c6c..bd4201fc5f7 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 2fa09412589..ee425de5f29 100644 --- a/gcc/ada/gnat-style.texi +++ b/gcc/ada/gnat-style.texi @@ -382,8 +382,11 @@ 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 @@ -391,9 +394,6 @@ exponentiation operator. @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: @cindex Parenthesization of expressions diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index ec766614392..614064ff313 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 2b908fb2e8b..5ae1a892124 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 6b3d07e7065..1e491f2a7d3 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 e43821eab67..b27e059ed9d 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 ee0926c5464..a4b2a41ff9f 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 268f75492eb..ed7140f84d7 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 eb92cd76daf..926affc54c7 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 b5cfaf7be3d..0a3f11a0aaf 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 f40d2728367..dca2b0fe9f2 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 7c3a4ee707f..152d272b035 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 90babc28861..eb34e50f3fc 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 0e83dbb7d06..aa45a7a03b4 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 f6e69c74814..6e5672d1aca 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 89233fa90eb..0db8d9150bd 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 8dade507915..cc1bd83db80 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 993d1ecf451..2a67b57c5b1 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 c517ae5ee30..2d34ff111c9 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 d83f12184af..2bb8ef0caa1 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 0398551d5dd..5e8fbbf2298 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 93e340f54ac..92b3c74810d 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 c821c7c2fc0..9c0da7f97f7 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 954d4d343cb..4f9383142e5 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 3d4f02eef6f..89512b51c7e 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 4c538b0ff40..5c85af2d600 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 9f138ebf7ce..cb07a921c87 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 b7c3cafa0b5..5ab5bdeed45 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 9ff4ede80a2..fe5cd93320a 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 db85ab27c95..263e701e11d 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 67cee510139..5215fe15029 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 01be1603930..4213e8a3a15 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 256d8a64a51..ca621b033b6 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, |
