diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 22 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 99 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 24 | ||||
| -rw-r--r-- | gcc/ada/fmap.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/osint.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/osint.ads | 15 | ||||
| -rw-r--r-- | gcc/ada/output.ads | 79 | ||||
| -rw-r--r-- | gcc/ada/s-rannum.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-vxworks.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/scng.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/sinput-c.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/switch-m.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/tree_io.ads | 6 |
15 files changed, 183 insertions, 133 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c39dff1b..0dd0ed3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2010-06-22 Emmanuel Briot <briot@adacore.com> + + * fmap.adb, scng.adb, switch-m.ads, sinput-c.adb, opt.ads, output.ads, + tree_io.ads, osint.adb, osint.ads: Use configuration pragmas to prevent + warnings on use of internal GNAT units. + +2010-06-22 Jose Ruiz <ruiz@adacore.com> + + * s-taprop-vxworks.adb (Set_Priority): Update comments. + +2010-06-22 Paul Hilfinger <hilfinger@adacore.com> + + * s-rannum.adb: Make stylistic change to remove mystery constant in + Extract_Value. Image_Numeral_Length: new symbolic constant. + +2010-06-22 Ed Schonberg <schonberg@adacore.com> + + * einfo.ads, einfo.adb: Make Is_Protected_Interface, + Is_Synchronized_Interface, Is_Task_Interface into computable + predicates, to free three flags in entity nodes. + * sem_ch3.adb: Remove setting of these flags. + 2010-06-22 Robert Dewar <dewar@adacore.com> * uintp.adb, osint.adb, prj-conf.adb, prj-part.adb, prj.adb: Minor diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 07144c3..357d0bd 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -455,9 +455,6 @@ package body Einfo is -- Is_Primitive_Wrapper Flag195 -- Was_Hidden Flag196 -- Is_Limited_Interface Flag197 - -- Is_Protected_Interface Flag198 - -- Is_Synchronized_Interface Flag199 - -- Is_Task_Interface Flag200 -- Has_Anon_Block_Suffix Flag201 -- Itype_Printed Flag202 @@ -511,6 +508,10 @@ package body Einfo is -- Is_Underlying_Record_View Flag246 -- OK_To_Rename Flag247 + -- (unused) Flag198 + -- (unused) Flag199 + -- (unused) Flag200 + ----------------------- -- Local subprograms -- ----------------------- @@ -1942,12 +1943,6 @@ package body Einfo is return Flag245 (Id); end Is_Private_Primitive; - function Is_Protected_Interface (Id : E) return B is - begin - pragma Assert (Is_Interface (Id)); - return Flag198 (Id); - end Is_Protected_Interface; - function Is_Public (Id : E) return B is begin pragma Assert (Nkind (Id) in N_Entity); @@ -2007,12 +2002,6 @@ package body Einfo is return Flag28 (Id); end Is_Statically_Allocated; - function Is_Synchronized_Interface (Id : E) return B is - begin - pragma Assert (Is_Interface (Id)); - return Flag199 (Id); - end Is_Synchronized_Interface; - function Is_Tag (Id : E) return B is begin pragma Assert (Nkind (Id) in N_Entity); @@ -2024,12 +2013,6 @@ package body Einfo is return Flag55 (Id); end Is_Tagged_Type; - function Is_Task_Interface (Id : E) return B is - begin - pragma Assert (Is_Interface (Id)); - return Flag200 (Id); - end Is_Task_Interface; - function Is_Thunk (Id : E) return B is begin pragma Assert (Is_Subprogram (Id)); @@ -4390,12 +4373,6 @@ package body Einfo is Set_Flag245 (Id, V); end Set_Is_Private_Primitive; - procedure Set_Is_Protected_Interface (Id : E; V : B := True) is - begin - pragma Assert (Is_Interface (Id)); - Set_Flag198 (Id, V); - end Set_Is_Protected_Interface; - procedure Set_Is_Public (Id : E; V : B := True) is begin pragma Assert (Nkind (Id) in N_Entity); @@ -4461,12 +4438,6 @@ package body Einfo is Set_Flag28 (Id, V); end Set_Is_Statically_Allocated; - procedure Set_Is_Synchronized_Interface (Id : E; V : B := True) is - begin - pragma Assert (Is_Interface (Id)); - Set_Flag199 (Id, V); - end Set_Is_Synchronized_Interface; - procedure Set_Is_Tag (Id : E; V : B := True) is begin pragma Assert (Ekind_In (Id, E_Component, E_Constant)); @@ -4478,12 +4449,6 @@ package body Einfo is Set_Flag55 (Id, V); end Set_Is_Tagged_Type; - procedure Set_Is_Task_Interface (Id : E; V : B := True) is - begin - pragma Assert (Is_Interface (Id)); - Set_Flag200 (Id, V); - end Set_Is_Task_Interface; - procedure Set_Is_Thunk (Id : E; V : B := True) is begin Set_Flag225 (Id, V); @@ -6112,6 +6077,22 @@ package body Einfo is and then Is_Protected_Type (Scope (Id)); end Is_Protected_Component; + ---------------------------- + -- Is_Protected_Interface -- + ---------------------------- + + function Is_Protected_Interface (Id : E) return B is + Typ : constant Entity_Id := Base_Type (Id); + begin + if not Is_Interface (Typ) then + return False; + elsif Is_Class_Wide_Type (Typ) then + return Is_Protected_Interface (Etype (Typ)); + else + return Protected_Present (Type_Definition (Parent (Typ))); + end if; + end Is_Protected_Interface; + ------------------------------ -- Is_Protected_Record_Type -- ------------------------------ @@ -6158,6 +6139,43 @@ package body Einfo is and then Is_Character_Type (Component_Type (Id))); end Is_String_Type; + ------------------------------- + -- Is_Synchronized_Interface -- + ------------------------------- + + function Is_Synchronized_Interface (Id : E) return B is + Typ : constant Entity_Id := Base_Type (Id); + + begin + if not Is_Interface (Typ) then + return False; + + elsif Is_Class_Wide_Type (Typ) then + return Is_Synchronized_Interface (Etype (Typ)); + + else + return Protected_Present (Type_Definition (Parent (Typ))) + or else Synchronized_Present (Type_Definition (Parent (Typ))) + or else Task_Present (Type_Definition (Parent (Typ))); + end if; + end Is_Synchronized_Interface; + + ----------------------- + -- Is_Task_Interface -- + ----------------------- + + function Is_Task_Interface (Id : E) return B is + Typ : constant Entity_Id := Base_Type (Id); + begin + if not Is_Interface (Typ) then + return False; + elsif Is_Class_Wide_Type (Typ) then + return Is_Task_Interface (Etype (Typ)); + else + return Task_Present (Type_Definition (Parent (Typ))); + end if; + end Is_Task_Interface; + ------------------------- -- Is_Task_Record_Type -- ------------------------- @@ -6927,7 +6945,6 @@ package body Einfo is W ("Is_Private_Composite", Flag107 (Id)); W ("Is_Private_Descendant", Flag53 (Id)); W ("Is_Private_Primitive", Flag245 (Id)); - W ("Is_Protected_Interface", Flag198 (Id)); W ("Is_Public", Flag10 (Id)); W ("Is_Pure", Flag44 (Id)); W ("Is_Pure_Unit_Access_Type", Flag189 (Id)); @@ -6938,11 +6955,9 @@ package body Einfo is W ("Is_Renaming_Of_Object", Flag112 (Id)); W ("Is_Return_Object", Flag209 (Id)); W ("Is_Shared_Passive", Flag60 (Id)); - W ("Is_Synchronized_Interface", Flag199 (Id)); W ("Is_Statically_Allocated", Flag28 (Id)); W ("Is_Tag", Flag78 (Id)); W ("Is_Tagged_Type", Flag55 (Id)); - W ("Is_Task_Interface", Flag200 (Id)); W ("Is_Thunk", Flag225 (Id)); W ("Is_Trivial_Subprogram", Flag235 (Id)); W ("Is_True_Constant", Flag163 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index d5f43ae..3d846fe 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2477,7 +2477,7 @@ package Einfo is -- Applicable to all entities, true if the entity denotes a private -- component of a protected type. --- Is_Protected_Interface (Flag198) +-- Is_Protected_Interface (Synthesized) -- Present in types that are interfaces. True if interface is declared -- protected, or is derived from protected interfaces. @@ -2584,7 +2584,7 @@ package Einfo is -- Applies to all entities, true for function, procedure and operator -- entities. --- Is_Synchronized_Interface (Flag199) +-- Is_Synchronized_Interface (synthesized) -- Present in types that are interfaces. True if interface is declared -- synchronized, task, or protected, or is derived from a synchronized -- interface. @@ -2598,7 +2598,7 @@ package Einfo is -- Is_Tagged_Type (Flag55) -- Present in all entities. Set for an entity for a tagged type. --- Is_Task_Interface (Flag200) +-- Is_Task_Interface (Synthesized) -- Present in types that are interfaces. True if interface is declared as -- a task interface, or if it is derived from task interfaces. @@ -4641,10 +4641,7 @@ package Einfo is -- Is_Eliminated (Flag124) -- Is_Frozen (Flag4) -- Is_Generic_Actual_Type (Flag94) - -- Is_Protected_Interface (Flag198) -- Is_RACW_Stub_Type (Flag244) - -- Is_Synchronized_Interface (Flag199) - -- Is_Task_Interface (Flag200) -- Is_Non_Static_Subtype (Flag109) -- Is_Packed (Flag51) (base type only) -- Is_Private_Composite (Flag107) @@ -5915,7 +5912,6 @@ package Einfo is function Is_Private_Composite (Id : E) return B; function Is_Private_Descendant (Id : E) return B; function Is_Private_Primitive (Id : E) return B; - function Is_Protected_Interface (Id : E) return B; function Is_Public (Id : E) return B; function Is_Pure (Id : E) return B; function Is_Pure_Unit_Access_Type (Id : E) return B; @@ -5927,10 +5923,8 @@ package Einfo is function Is_Return_Object (Id : E) return B; function Is_Shared_Passive (Id : E) return B; function Is_Statically_Allocated (Id : E) return B; - function Is_Synchronized_Interface (Id : E) return B; function Is_Tag (Id : E) return B; function Is_Tagged_Type (Id : E) return B; - function Is_Task_Interface (Id : E) return B; function Is_Thunk (Id : E) return B; function Is_Trivial_Subprogram (Id : E) return B; function Is_True_Constant (Id : E) return B; @@ -6140,9 +6134,12 @@ package Einfo is function Is_Package_Or_Generic_Package (Id : E) return B; function Is_Prival (Id : E) return B; function Is_Protected_Component (Id : E) return B; + function Is_Protected_Interface (Id : E) return B; function Is_Protected_Record_Type (Id : E) return B; function Is_Standard_Character_Type (Id : E) return B; function Is_String_Type (Id : E) return B; + function Is_Synchronized_Interface (Id : E) return B; + function Is_Task_Interface (Id : E) return B; function Is_Task_Record_Type (Id : E) return B; function Is_Wrapper_Package (Id : E) return B; function Next_Component (Id : E) return E; @@ -6478,7 +6475,6 @@ package Einfo is procedure Set_Is_Private_Composite (Id : E; V : B := True); procedure Set_Is_Private_Descendant (Id : E; V : B := True); procedure Set_Is_Private_Primitive (Id : E; V : B := True); - procedure Set_Is_Protected_Interface (Id : E; V : B := True); procedure Set_Is_Public (Id : E; V : B := True); procedure Set_Is_Pure (Id : E; V : B := True); procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True); @@ -6490,10 +6486,8 @@ package Einfo is procedure Set_Is_Return_Object (Id : E; V : B := True); procedure Set_Is_Shared_Passive (Id : E; V : B := True); procedure Set_Is_Statically_Allocated (Id : E; V : B := True); - procedure Set_Is_Synchronized_Interface (Id : E; V : B := True); procedure Set_Is_Tag (Id : E; V : B := True); procedure Set_Is_Tagged_Type (Id : E; V : B := True); - procedure Set_Is_Task_Interface (Id : E; V : B := True); procedure Set_Is_Thunk (Id : E; V : B := True); procedure Set_Is_Trivial_Subprogram (Id : E; V : B := True); procedure Set_Is_True_Constant (Id : E; V : B := True); @@ -7170,7 +7164,6 @@ package Einfo is pragma Inline (Is_Private_Descendant); pragma Inline (Is_Private_Primitive); pragma Inline (Is_Private_Type); - pragma Inline (Is_Protected_Interface); pragma Inline (Is_Protected_Type); pragma Inline (Is_Public); pragma Inline (Is_Pure); @@ -7188,10 +7181,8 @@ package Einfo is pragma Inline (Is_Signed_Integer_Type); pragma Inline (Is_Statically_Allocated); pragma Inline (Is_Subprogram); - pragma Inline (Is_Synchronized_Interface); pragma Inline (Is_Tag); pragma Inline (Is_Tagged_Type); - pragma Inline (Is_Task_Interface); pragma Inline (Is_True_Constant); pragma Inline (Is_Task_Type); pragma Inline (Is_Thunk); @@ -7570,7 +7561,6 @@ package Einfo is pragma Inline (Set_Is_Private_Composite); pragma Inline (Set_Is_Private_Descendant); pragma Inline (Set_Is_Private_Primitive); - pragma Inline (Set_Is_Protected_Interface); pragma Inline (Set_Is_Public); pragma Inline (Set_Is_Pure); pragma Inline (Set_Is_Pure_Unit_Access_Type); @@ -7582,10 +7572,8 @@ package Einfo is pragma Inline (Set_Is_Return_Object); pragma Inline (Set_Is_Shared_Passive); pragma Inline (Set_Is_Statically_Allocated); - pragma Inline (Set_Is_Synchronized_Interface); pragma Inline (Set_Is_Tag); pragma Inline (Set_Is_Tagged_Type); - pragma Inline (Set_Is_Task_Interface); pragma Inline (Set_Is_Thunk); pragma Inline (Set_Is_Trivial_Subprogram); pragma Inline (Set_Is_True_Constant); diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index 8de27ec..2dd07c0 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2010, 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- -- @@ -23,6 +23,10 @@ -- -- ------------------------------------------------------------------------------ +-- This unit is used by gnatcoll +pragma Warnings (Off, "*is an internal GNAT unit"); +pragma Warnings (Off, "*use * instead"); + with Opt; use Opt; with Osint; use Osint; with Output; use Output; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 626947b..9319f2d 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -38,6 +38,10 @@ -- use the Project Manager. These tools include gnatmake, gnatname, the gnat -- driver, gnatclean, gprbuild and gprclean. +-- This unit is used by gnatcoll +pragma Warnings (Off, "*is an internal GNAT unit"); +pragma Warnings (Off, "*use * instead"); + with Hostparm; use Hostparm; with Types; use Types; diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 7d16e2a..bbce919 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -23,11 +23,9 @@ -- -- ------------------------------------------------------------------------------ -with Unchecked_Conversion; - -with System.Case_Util; use System.Case_Util; - -with GNAT.HTable; +-- This unit is used by gnatcoll +pragma Warnings (Off, "*is an internal GNAT unit"); +pragma Warnings (Off, "*use * instead"); with Alloc; with Debug; @@ -40,6 +38,12 @@ with Sdefault; use Sdefault; with Table; with Targparm; use Targparm; +with Unchecked_Conversion; + +with System.Case_Util; use System.Case_Util; + +with GNAT.HTable; + package body Osint is Running_Program : Program_Type := Unspecified; diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index ae827ba..08d074a 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -26,12 +26,16 @@ -- This package contains the low level, operating system routines used in the -- compiler and binder for command line processing and file input output. +-- This unit is used by gnatcoll +pragma Warnings (Off, "*is an internal GNAT unit"); +pragma Warnings (Off, "*use * instead"); + with Namet; use Namet; with Types; use Types; -with System.Storage_Elements; -with System.OS_Lib; use System.OS_Lib; with System; use System; +with System.OS_Lib; use System.OS_Lib; +with System.Storage_Elements; pragma Elaborate_All (System.OS_Lib); -- For the call to function Get_Target_Object_Suffix in the private part @@ -39,9 +43,8 @@ pragma Elaborate_All (System.OS_Lib); package Osint is Multi_Unit_Index_Character : Character := '~'; - -- The character before the index of the unit in a multi-unit source, in - -- ALI and object file names. This is not a constant, because it is changed - -- to '$' on VMS. + -- The character before the index of the unit in a multi-unit source in ALI + -- and object file names. Changed to '$' on VMS. Ada_Include_Path : constant String := "ADA_INCLUDE_PATH"; Ada_Objects_Path : constant String := "ADA_OBJECTS_PATH"; diff --git a/gcc/ada/output.ads b/gcc/ada/output.ads index d88272c..0f12178 100644 --- a/gcc/ada/output.ads +++ b/gcc/ada/output.ads @@ -33,40 +33,43 @@ -- writing error messages and informational output. It is also used by the -- debug source file output routines (see Sprint.Print_Debug_Line). -with System.OS_Lib; use System.OS_Lib; +-- This unit is used by gnatcoll +pragma Warnings (Off, "*is an internal GNAT unit"); +pragma Warnings (Off, "*use * instead"); with Hostparm; use Hostparm; with Types; use Types; +with System.OS_Lib; use System.OS_Lib; + package Output is pragma Elaborate_Body; type Output_Proc is access procedure (S : String); - -- This type is used for the Set_Special_Output procedure. If this - -- procedure is called, then instead of lines being written to - -- standard error or standard output, a call is made to the given - -- procedure for each line, passing the line with an end of line - -- character (which is a single ASCII.LF character, even in systems - -- which normally use CR/LF or some other sequence for line end). + -- This type is used for the Set_Special_Output procedure. If Output_Proc + -- is called, then instead of lines being written to standard error or + -- standard output, a call is made to the given procedure for each line, + -- passing the line with an end of line character (which is a single + -- ASCII.LF character, even in systems which normally use CR/LF or some + -- other sequence for line end). ----------------- -- Subprograms -- ----------------- procedure Set_Special_Output (P : Output_Proc); - -- Sets subsequent output to call procedure P. If P is null, then - -- the call cancels the effect of a previous call, reverting the - -- output to standard error or standard output depending on the - -- mode at the time of previous call. Any exception generated by - -- by calls to P is simply propagated to the caller of the routine - -- causing the write operation. + -- Sets subsequent output to call procedure P. If P is null, then the call + -- cancels the effect of a previous call, reverting the output to standard + -- error or standard output depending on the mode at the time of previous + -- call. Any exception generated by by calls to P is simply propagated to + -- the caller of the routine causing the write operation. procedure Cancel_Special_Output; - -- Cancels the effect of a call to Set_Special_Output, if any. - -- The output is then directed to standard error or standard output - -- depending on the last call to Set_Standard_Error or Set_Standard_Output. - -- It is never an error to call Cancel_Special_Output. It has the same - -- effect as calling Set_Special_Output (null). + -- Cancels the effect of a call to Set_Special_Output, if any. The output + -- is then directed to standard error or standard output depending on the + -- last call to Set_Standard_Error or Set_Standard_Output. It is never an + -- error to call Cancel_Special_Output. It has the same effect as calling + -- Set_Special_Output (null). procedure Ignore_Output (S : String); -- Does nothing. To disable output, pass Ignore_Output'Access to @@ -81,16 +84,16 @@ package Output is procedure Set_Standard_Output; -- Sets subsequent output to appear on the standard output file (whatever - -- that might mean for the host operating system, if anything) when - -- no special output is in effect. When a special output is in effect, - -- the output will appear on standard output only after special output - -- has been cancelled. Output to standard output is the default mode - -- before any call to either of the Set procedures. + -- that might mean for the host operating system, if anything) when no + -- special output is in effect. When a special output is in effect, the + -- output will appear on standard output only after special output has been + -- cancelled. Output to standard output is the default mode before any call + -- to either of the Set procedures. procedure Set_Output (FD : File_Descriptor); -- Sets subsequent output to appear on the given file descriptor when no - -- special output is in effect. When a special output is in effect, - -- the output will appear on the given file descriptor only after special + -- special output is in effect. When a special output is in effect, the + -- output will appear on the given file descriptor only after special -- output has been cancelled. procedure Indent; @@ -109,36 +112,36 @@ package Output is -- If last character in buffer matches C, erase it, otherwise no effect procedure Write_Eol; - -- Write an end of line (whatever is required by the system in use, - -- e.g. CR/LF for DOS, or LF for Unix) to the standard output file. - -- This routine also empties the line buffer, actually writing it - -- to the file. Note that Write_Eol is the only routine that causes - -- any actual output to be written. Trailing spaces are removed. + -- Write an end of line (whatever is required by the system in use, e.g. + -- CR/LF for DOS, or LF for Unix) to the standard output file. This routine + -- also empties the line buffer, actually writing it to the file. Note that + -- Write_Eol is the only routine that causes any actual output to be + -- written. Trailing spaces are removed. procedure Write_Eol_Keep_Blanks; -- Similar as Write_Eol, except that trailing spaces are not removed procedure Write_Int (Val : Int); - -- Write an integer value with no leading blanks or zeroes. Negative - -- values are preceded by a minus sign). + -- Write an integer value with no leading blanks or zeroes. Negative values + -- are preceded by a minus sign). procedure Write_Spaces (N : Nat); -- Write N spaces procedure Write_Str (S : String); -- Write a string of characters to the standard output file. Note that - -- end of line is normally handled separately using WRITE_EOL, but it - -- is allowed for the string to contain LF (but not CR) characters, - -- which are properly interpreted as end of line characters. The string - -- may also contain horizontal tab characters. + -- end of line is normally handled separately using WRITE_EOL, but it is + -- allowable for the string to contain LF (but not CR) characters, which + -- are properly interpreted as end of line characters. The string may also + -- contain horizontal tab characters. procedure Write_Line (S : String); -- Equivalent to Write_Str (S) followed by Write_Eol; function Column return Pos; pragma Inline (Column); - -- Returns the number of the column about to be written (e.g. a value - -- of 1 means the current line is empty). + -- Returns the number of the column about to be written (e.g. a value of 1 + -- means the current line is empty). ------------------------- -- Buffer Save/Restore -- diff --git a/gcc/ada/s-rannum.adb b/gcc/ada/s-rannum.adb index 085c4bf..c3865a6 100644 --- a/gcc/ada/s-rannum.adb +++ b/gcc/ada/s-rannum.adb @@ -119,6 +119,7 @@ package body System.Random_Numbers is (Year => 2000, Month => 1, Day => 1, Seconds => 0.0); -- First Year 2000 day + Image_Numeral_Length : constant := Max_Image_Width / N; subtype Image_String is String (1 .. Max_Image_Width); -- Utility functions @@ -526,9 +527,9 @@ package body System.Random_Numbers is ------------------- function Extract_Value (S : String; Index : Integer) return State_Val is + Start : constant Integer := S'First + Index * Image_Numeral_Length; begin - return State_Val'Value (S (S'First + Index * 11 .. - S'First + Index * 11 + 10)); + return State_Val'Value (S (Start .. Start + Image_Numeral_Length - 1)); end Extract_Value; end System.Random_Numbers; diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index a8ea3c4..2cf8131 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -745,10 +745,12 @@ package body System.Task_Primitives.Operations is (T.Common.LL.Thread, To_VxWorks_Priority (int (Prio))); pragma Assert (Result = 0); - -- Note: in VxWorks, the task is placed at the end of the priority queue - -- instead of the head. This is not the behavior required by Annex D, - -- but we consider it an acceptable variation (RM 1.1.3(6)), given this - -- is the built-in behavior of the operating system. + -- Note: in VxWorks 6.6 (or earlier), the task is placed at the end of + -- the priority queue instead of the head. This is not the behavior + -- required by Annex D (RM D.2.3(5/2)), but we consider it an acceptable + -- variation (RM 1.1.3(6)), given this is the built-in behavior of the + -- operating system. VxWorks versions starting from 6.7 implement the + -- required Annex D semantics. -- In older versions we attempted to better approximate the Annex D -- required behavior, but this simulation was not entirely accurate, diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index 5a2dc00..383d884 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -23,6 +23,11 @@ -- -- ------------------------------------------------------------------------------ +-- This unit is used by gnatcoll +pragma Warnings (Off, "*is an internal GNAT unit"); +pragma Warnings (Off, "*use of this unit is non-portable*"); +pragma Warnings (Off, "*use * instead"); + with Csets; use Csets; with Err_Vars; use Err_Vars; with Hostparm; use Hostparm; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index fa48a54..1cb03ba 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2166,17 +2166,6 @@ package body Sem_Ch3 is or else Synchronized_Present (Def) or else Task_Present (Def)); - Set_Is_Protected_Interface (T, Protected_Present (Def)); - Set_Is_Task_Interface (T, Task_Present (Def)); - - -- Type is a synchronized interface if it includes the keyword task, - -- protected, or synchronized. - - Set_Is_Synchronized_Interface - (T, Synchronized_Present (Def) - or else Protected_Present (Def) - or else Task_Present (Def)); - Set_Interfaces (T, New_Elmt_List); Set_Primitive_Operations (T, New_Elmt_List); @@ -2186,9 +2175,6 @@ package body Sem_Ch3 is if Present (CW) then Set_Is_Interface (CW); Set_Is_Limited_Interface (CW, Is_Limited_Interface (T)); - Set_Is_Protected_Interface (CW, Is_Protected_Interface (T)); - Set_Is_Synchronized_Interface (CW, Is_Synchronized_Interface (T)); - Set_Is_Task_Interface (CW, Is_Task_Interface (T)); end if; -- Check runtime support for synchronized interfaces diff --git a/gcc/ada/sinput-c.adb b/gcc/ada/sinput-c.adb index 4997346..3c7a882 100644 --- a/gcc/ada/sinput-c.adb +++ b/gcc/ada/sinput-c.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -23,6 +23,10 @@ -- -- ------------------------------------------------------------------------------ +-- This unit is used by gnatcoll +pragma Warnings (Off, "*is an internal GNAT unit"); +pragma Warnings (Off, "*use * instead"); + with Opt; use Opt; with System; use System; diff --git a/gcc/ada/switch-m.ads b/gcc/ada/switch-m.ads index 6a80023..9ae4860 100644 --- a/gcc/ada/switch-m.ads +++ b/gcc/ada/switch-m.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2010, 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- -- @@ -29,7 +29,12 @@ -- switches that are recognized. In addition, package Debug documents -- the otherwise undocumented debug switches that are also recognized. +-- This unit is used by gnatcoll +pragma Warnings (Off, "*is an internal GNAT unit"); +pragma Warnings (Off, "*use * instead"); + with System.OS_Lib; use System.OS_Lib; + with Prj.Tree; package Switch.M is diff --git a/gcc/ada/tree_io.ads b/gcc/ada/tree_io.ads index c436054..f70c92f 100644 --- a/gcc/ada/tree_io.ads +++ b/gcc/ada/tree_io.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -34,6 +34,10 @@ -- create and close routines are elsewhere (in Osint in the compiler, and in -- the tree read driver for the tree read interface). +-- This unit is used by gnatcoll +pragma Warnings (Off, "*is an internal GNAT unit"); +pragma Warnings (Off, "*use * instead"); + with Types; use Types; with System; use System; |