diff options
| author | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-08-01 14:34:58 +0000 |
|---|---|---|
| committer | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-08-01 14:34:58 +0000 |
| commit | af6f686de1055035a20c7ed40c0cf2d586e0eaa7 (patch) | |
| tree | f033d000678e4e902727d672a6202935def58ce3 /gcc/ada | |
| parent | edf732633eb6b456e59b4f010766dd64ecf7f50f (diff) | |
| download | gcc-af6f686de1055035a20c7ed40c0cf2d586e0eaa7.tar.gz | |
2008-08-01 Basile Starynkevitch <basile@starynkevitch.net>
MELT branch merged with trunk r138450
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@138521 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
60 files changed, 2306 insertions, 2797 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 05f5a3470f6..fdb714c1cb7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,321 @@ +2008-07-31 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/decl.c (gnat_to_gnu_entity): Fix formatting. + * gcc-interface/utils.c (create_field_decl): Avoid superfluous work. + +2008-07-31 Pascal Obry <obry@adacore.com> + + * prj-nmsc.adb: Keep Object and Exec directory casing. + +2008-07-31 Jose Ruiz <ruiz@adacore.com> + + * system-rtx-rtss.ads + Change the default stack size. It is important to set the commit part. + + * s-taprop-rtx.adb + (Initialize): Get the clock resolution. + (RT_Resolution): Return the clock resolution that is indicated by the + system. + + * s-parame-vxworks.adb + Document that this body is used for RTX in RTSS (kernel) mode. + + * gcc-interface/Makefile.in + (LIBGNAT_TARGET_PAIRS for the rtx_rtss run time): Use the + s-parame-vxworks.adb body in order to have reasonable stack sizes in + RTX RTSS kernel mode. Virtual memory is not used in that case, so we + cannot ask for too big values. + +2008-07-31 Robert Dewar <dewar@adacore.com> + + * exp_aggr.adb: Minor reformatting + + * makeutl.adb: Minor reformatting + + * prj-env.adb: Minor reformatting + +2008-07-31 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_disp.adb (Prim_Op_Kind): Retrieve the full view when a private + tagged type is completed by a concurrent type. + +2008-07-31 Gary Dismukes <dismukes@adacore.com> + + * sem_aggr.adb: + (Resolve_Record_Aggregate): Bypass error that a type without + components must have a "null record" aggregate when compiling for Ada + 2005, since it's legal to give an aggregate of form (others => <>) + for such a type. + +2008-07-31 Javier Miranda <miranda@adacore.com> + + * sem_ch4.adb (Valid_First_Argument_Of): Complete its functionality to + handle synchronized types. Required to handle well the object.operation + notation applied to synchronized types. + +2008-07-31 Quentin Ochem <ochem@adacore.com> + + * s-stausa.adb (Fill_Stack): Stack_Used_When_Filling is now stored + anymore - just used internally. + Added handling of very small tasks - when the theoretical size is + already full at the point of the call. + (Report_Result): Fixed result computation, Stack_Used_When_Filling does + not need to be added to the result. + +2008-07-31 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_ch6.adb (Disambiguate_Spec): Continue the disambiguation if the + corresponding spec is a primitive wrapper. Update comment. + +2008-07-31 Hristian Kirtchev <kirtchev@adacore.com> + + * bindgen.adb Comment reformatting. Update the list of run-time globals. + (Gen_Adainit_Ada): Add the declaration, import and value set for + configuration flag Canonical_Streams. + (Gen_Adainit_C): Add the declaration and initial value of external + symbol __gl_canonical_streams. + + * init.c: Update the list of global values computed by the binder. + + * opt.ads: Add flag Canonical_Streams. + + * par-prag.adb (Prag): Include Pragma_Canonical_Streams to the list of + semantically handled pragmas. + + * sem_prag.adb: Add an entry into enumeration type Sig_Flags. + (Analyze_Pragma): Add case for pragma Canonical_Streams. + + * snames.adb: Add character value for name Canonical_Streams. + + * snames.ads: + Add Name_Canonical_Streams to the list of configuration pragmas. + Add Pragma_Canonical_Streams to enumeration type Pragma_Id. + + * snames.h: Add a definition for Pragma_Canonical_Streams. + + * s-ststop.adb: + Add a flag and import to seize the value of external symbol + __gl_canonical_streams. Update comment and initial value of constant + Use_Block_IO. + + * gnat_rm.texi: Add section of pragma Canonical_Streams. + + * gnat_ugn.texi: + Add pragma Canonical_Streams to the list of configuration pragmas. + +2008-07-31 Ed Schonberg <schonberg@adacore.com> + + * sem_ch10.adb (Build_Unit_Name): If the unit name in a with_clause + has the form A.B.C and B is a unit renaming, analyze its compilation + unit and add a with_clause on A.b to the context. + +2008-07-31 Vincent Celier <celier@adacore.com> + + * makeutl.adb (Executable_Prefix_Path): If Locate_Exec_On_Path fails, + return the empty string, instead of raising Constraint_Error. + +2008-07-31 Gary Dismukes <dismukes@adacore.com> + + * checks.ads (Apply_Accessibility_Check): Add parameter Insert_Node. + + * checks.adb (Apply_Accessibility_Check): Insert the check on + Insert_Node. + + * exp_attr.adb: + (Expand_N_Attribute_Refernce, Attribute_Access): Pass attribute node + to new parameter Insert_Node on call to Apply_Accessibility_Check. + Necessary to distinguish the insertion node because the dereferenced + formal may come from a rename, but the check must be inserted in + front of the attribute. + + * exp_ch4.adb: + (Expand_N_Allocator): Pass actual for new Insert_Node parameter on + call to Apply_Accessibility_Check. + (Expand_N_Type_Conversion): Pass actual for new Insert_Node parameter + on call to Apply_Accessibility_Check. + Minor reformatting + +2008-07-31 Javier Miranda <miranda@adacore.com> + + * sem_type.adb (Has_Compatible_Type): Complete support for synchronized + types when the candidate type is a synchronized type. + + * sem_res.adb (Resolve_Actuals): Reorganize code handling synchronized + types, and complete management of synchronized types adding missing + code to handle formal that is a synchronized type. + + * sem_ch4.adb (Try_Primitive_Operation): Avoid testing attributes that + are not available and cause the compiler to blowup. Found compiling + test with switch -gnatc + + * sem_ch6.adb (Check_Synchronized_Overriding): Remove local subprogram + Has_Correct_Formal_Mode plus code cleanup. + +2008-07-31 Bob Duff <duff@adacore.com> + + * sinput.adb (Skip_Line_Terminators): Fix handling of LF/CR -- it was + recognized as two end-of-lines, but it should be just one. + +2008-07-31 Thomas Quinot <quinot@adacore.com> + + * exp_ch9.adb: Minor reformatting + + * tbuild.ads: Fix several occurrences of incorrectly referring to + Name_Find as Find_Name. + +2008-07-31 Ed Schonberg <schonberg@adacore.com> + + * exp_aggr.adb (Aggr_Size_OK): If the aggregate has a single component + and the context is an object declaration with non-static bounds, treat + the aggregate as non-static. + +2008-07-31 Vincent Celier <celier@adacore.com> + + * prj-part.adb, prj-part.ads, prj.adb, prj.ads, prj-env.adb: + Move back spec of Parse_Single_Project to body, as it is not called + outside of package Prj.Part. + (Project_Data): Remove components Linker_Name, Linker_Path and + Minimum_Linker_Options as they are no longer set. + Remove function There_Are_Ada_Sources from package Prj and move code + in the only place it was used, in Prj.Env.Set_Ada_Paths. + +2008-07-31 Arnaud Charlet <charlet@adacore.com> + + * mlib-utl.ads: Fix typo. + +2008-07-31 Robert Dewar <dewar@adacore.com> + + * sem_ch12.adb: Minor reformatting + +2008-07-31 Sergey Rybin <rybin@adacore.com> + + * gnat_ugn.texi: Change the description of the + Overly_Nested_Control_Structures: now the rule always requires a + positive parameter for '+R' option + +2008-07-31 Thomas Quinot <quinot@adacore.com> + + * g-pehage.adb: Minor reformatting + +2008-07-31 Pascal Obry <obry@adacore.com> + + * s-finimp.ads: Minor reformatting. + +2008-07-31 Vincent Celier <celier@adacore.com> + + * s-regexp.ads: Minor comment fix + +2008-07-31 Arnaud Charlet <charlet@adacore.com> + + * s-direio.adb (Reset): Replace pragma Unmodified by Warnings (Off), + so that we can compile this file successfully with -gnatc. + +2008-07-31 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_attr.adb (Find_Stream_Subprogram): Check the base type instead + of the type when looking for stream subprograms for type String, + Wide_String and Wide_Wide_String. + + * s-ststop.adb: Change the initialization expression of constant + Use_Block_IO. + +2008-07-31 Geert Bosch <bosch@adacore.com> + + * arit64.c: + New file implementing __gnat_mulv64 signed integer multiplication with + overflow checking + + * fe.h (Backend_Overflow_Checks_On_Target): Define for use by Gigi + + * gcc-interface/gigi.h: + (standard_types): Add ADT_mulv64_decl + (mulv64_decl): Define subprogram declaration for __gnat_mulv64 + + * gcc-interface/utils.c: + (init_gigi_decls): Add initialization of mulv64_decl + + * gcc-interface/trans.c: + (build_unary_op_trapv): New function + (build_binary_op_trapv): New function + (gnat_to_gnu): Use the above functions instead of + build_{unary,binary}_op + + * gcc-interface/Makefile.in + (LIBGNAT_SRCS): Add arit64.c + (LIBGNAT_OBJS): Add arit64.o + +2008-07-31 Vincent Celier <celier@adacore.com> + + * prj-nmsc.adb (Check_Library_Attributes): Check if Linker'Switches or + Linker'Default_Switches are declared. Warn if they are declared. + +2008-07-31 Ed Schonberg <schonberg@adacore.com> + + * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): Use + Insert_Actions to place the pointer declaration in the code, rather + than Insert_Before_And_Analyze, so that insertions of temporaries are + kept in the proper order when transient scopes are present. + + +2008-07-31 Robert Dewar <dewar@adacore.com> + + * einfo.adb (Spec_PPC): Now defined for generic subprograms + + * einfo.ads (Spec_PPC): Now defined for generic subprograms + + * sem_prag.adb (Check_Precondition_Postcondition): Handle generic + subprogram case + +2008-07-31 Vincent Celier <celier@adacore.com> + + * s-os_lib.adb: Minor comment fix + +2008-07-31 Ed Schonberg <schonberg@adacore.com> + + * sem_ch6.adb (Analyze_Generic_Subprogram_Body): After analysis, + transfer pre/postconditions from generic copy to original tree, so that + they will appear in each instance. + (Process_PPCs): Do not transform postconditions into a procedure in a + generic context, to prevent double expansion of check pragmas. + + * sem_attr.adb: In an instance, the prefix of the 'result attribute + can be the renaming of the + current instance, so check validity of the name accordingly. + +2008-07-31 Robert Dewar <dewar@adacore.com> + + * mlib-utl.ads: Minor reformatting + +2008-07-31 Ed Schonberg <schonberg@adacore.com> + + sem_attr.adb: 'Result can have an ambiguous prefix, and is resolved + from context. This attribute must be usable in Ada95 mode. + The attribute can appear in the body of a function marked + Inline_Always, but in this case the postocondition is not enforced. + + sem_prag.adb (Check_Precondition_Postcondition): within the expansion + of an inlined call pre- and postconditions are legal + +2008-07-31 Vincent Celier <celier@adacore.com> + + * prj.adb, prj.ads, clean.adb, prj-nmsc.adb: Remove declarations that + were for gprmake only + +2008-07-31 Robert Dewar <dewar@adacore.com> + + * gnat_ugn.texi: Update -gnatN documentation. + + * gnat_rm.texi: Add note about pre/postcondition + pragmas not checked in conjunction with front-end inlining. + +2008-07-31 Robert Dewar <dewar@adacore.com> + + * g-pehage.adb, g-pehage.ads: Minor reformatting + +2008-07-31 Arnaud Charlet <charlet@adacore.com> + + * mlib-utl.ads, prj-makr.ads: Add comments. + 2008-07-30 Aaron W. LaFramboise <aaronavay62@aaronwl.com> * gcc-interface/Makefile.in (EXTRA_GNATRTL_NONTASKING_OBJS) diff --git a/gcc/ada/arit64.c b/gcc/ada/arit64.c new file mode 100644 index 00000000000..c21f67c9418 --- /dev/null +++ b/gcc/ada/arit64.c @@ -0,0 +1,58 @@ +/**************************************************************************** + * * + * GNAT COMPILER COMPONENTS * + * * + * A R I T 6 4 . C * + * * + * C Implementation File * + * * + * Copyright (C) 2008, 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- * + * ware Foundation; either version 2, or (at your option) any later ver- * + * sion. GNAT is distributed in the hope that it will be useful, but WITH- * + * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * + * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License * + * for more details. You should have received a copy of the GNU General * + * Public License distributed with GNAT; see file COPYING. If not, write * + * to the Free Software Foundation, 51 Franklin Street, Fifth Floor, * + * Boston, MA 02110-1301, USA. * + * * + * As a special exception, if you link this file with other files to * + * produce an executable, this file does not by itself cause the resulting * + * executable to be covered by the GNU General Public License. This except- * + * ion does not however invalidate any other reasons why the executable * + * file might be covered by the GNU Public License. * + * * + * GNAT was originally developed by the GNAT team at New York University. * + * Extensive contributions were provided by Ada Core Technologies Inc. * + * * + ****************************************************************************/ + +extern void __gnat_rcheck_10(char *file, int line) + __attribute__ ((__noreturn__)); + +long long int __gnat_mulv64 (long long int x, long long int y) +{ + unsigned neg = (x >= 0) ^ (y >= 0); + long long unsigned xa = x >= 0 ? (long long unsigned) x + : -(long long unsigned) x; + long long unsigned ya = y >= 0 ? (long long unsigned) y + : -(long long unsigned) y; + unsigned xhi = (unsigned) (xa >> 32); + unsigned yhi = (unsigned) (ya >> 32); + unsigned xlo = (unsigned) xa; + unsigned ylo = (unsigned) ya; + long long unsigned mid + = xhi ? (long long unsigned) xhi * (long long unsigned) ylo + : (long long unsigned) yhi * (long long unsigned) xlo; + long long unsigned low = (long long unsigned) xlo * (long long unsigned) ylo; + + if ((xhi && yhi) || mid + (low >> 32) > 0x7fffffff + neg) + __gnat_rcheck_10 (__FILE__, __LINE__); + + low += ((long long unsigned) (unsigned) mid) << 32; + + return (long long int) (neg ? -low : low); +} diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index d29857fb5fc..204496a9f11 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -126,39 +126,39 @@ package body Bindgen is -- Detect_Blocking : Integer; -- Default_Stack_Size : Integer; -- Leap_Seconds_Support : Integer; - - -- Main_Priority is the priority value set by pragma Priority in the - -- main program. If no such pragma is present, the value is -1. - - -- Time_Slice_Value is the time slice value set by pragma Time_Slice - -- in the main program, or by the use of a -Tnnn parameter for the - -- binder (if both are present, the binder value overrides). The - -- value is in milliseconds. A value of zero indicates that time - -- slicing should be suppressed. If no pragma is present, and no - -- -T switch was used, the value is -1. - - -- WC_Encoding shows the wide character encoding method used for - -- the main program. This is one of the encoding letters defined - -- in System.WCh_Con.WC_Encoding_Letters. - - -- Locking_Policy is a space if no locking policy was specified - -- for the partition. If a locking policy was specified, the value - -- is the upper case first character of the locking policy name, - -- for example, 'C' for Ceiling_Locking. - - -- Queuing_Policy is a space if no queuing policy was specified - -- for the partition. If a queuing policy was specified, the value - -- is the upper case first character of the queuing policy name - -- for example, 'F' for FIFO_Queuing. - - -- Task_Dispatching_Policy is a space if no task dispatching policy - -- was specified for the partition. If a task dispatching policy - -- was specified, the value is the upper case first character of - -- the policy name, e.g. 'F' for FIFO_Within_Priorities. - - -- Priority_Specific_Dispatching is the address of a string used to - -- store the task dispatching policy specified for the different priorities - -- in the partition. The length of this string is determined by the last + -- Canonical_Streams : Integer; + + -- Main_Priority is the priority value set by pragma Priority in the main + -- program. If no such pragma is present, the value is -1. + + -- Time_Slice_Value is the time slice value set by pragma Time_Slice in the + -- main program, or by the use of a -Tnnn parameter for the binder (if both + -- are present, the binder value overrides). The value is in milliseconds. + -- A value of zero indicates that time slicing should be suppressed. If no + -- pragma is present, and no -T switch was used, the value is -1. + + -- WC_Encoding shows the wide character encoding method used for the main + -- program. This is one of the encoding letters defined in + -- System.WCh_Con.WC_Encoding_Letters. + + -- Locking_Policy is a space if no locking policy was specified for the + -- partition. If a locking policy was specified, the value is the upper + -- case first character of the locking policy name, for example, 'C' for + -- Ceiling_Locking. + + -- Queuing_Policy is a space if no queuing policy was specified for the + -- partition. If a queuing policy was specified, the value is the upper + -- case first character of the queuing policy name for example, 'F' for + -- FIFO_Queuing. + + -- Task_Dispatching_Policy is a space if no task dispatching policy was + -- specified for the partition. If a task dispatching policy was specified, + -- the value is the upper case first character of the policy name, e.g. 'F' + -- for FIFO_Within_Priorities. + + -- Priority_Specific_Dispatching is the address of a string used to store + -- the task dispatching policy specified for the different priorities in + -- the partition. The length of this string is determined by the last -- priority for which such a pragma applies (the string will be a null -- string if no specific dispatching policies were used). If pragma were -- present, the entries apply to the priorities in sequence from the first @@ -182,12 +182,12 @@ package body Bindgen is -- such a pragma is given (the string will be a null string if no pragmas -- were used). If pragma were present the entries apply to the interrupts -- in sequence from the first interrupt, and are set to one of four - -- possible settings: 'n' for not specified, 'u' for user, 'r' for - -- run time, 's' for system, see description of Interrupt_State pragma - -- for further details. + -- possible settings: 'n' for not specified, 'u' for user, 'r' for run + -- time, 's' for system, see description of Interrupt_State pragma for + -- further details. - -- Num_Interrupt_States is the length of the Interrupt_States string. - -- It will be set to zero if no Interrupt_State pragmas are present. + -- Num_Interrupt_States is the length of the Interrupt_States string. It + -- will be set to zero if no Interrupt_State pragmas are present. -- Unreserve_All_Interrupts is set to one if at least one unit in the -- partition had a pragma Unreserve_All_Interrupts, and zero otherwise. @@ -201,18 +201,21 @@ package body Bindgen is -- this partition, and to zero if longjmp/setjmp exceptions are used. -- the use of zero - -- Detect_Blocking indicates whether pragma Detect_Blocking is - -- active or not. A value of zero indicates that the pragma is not - -- present, while a value of 1 signals its presence in the - -- partition. + -- Detect_Blocking indicates whether pragma Detect_Blocking is active or + -- not. A value of zero indicates that the pragma is not present, while a + -- value of 1 signals its presence in the partition. - -- Default_Stack_Size is the default stack size used when creating an - -- Ada task with no explicit Storize_Size clause. + -- Default_Stack_Size is the default stack size used when creating an Ada + -- task with no explicit Storize_Size clause. -- Leap_Seconds_Support denotes whether leap seconds have been enabled or -- disabled. A value of zero indicates that leap seconds are turned "off", -- while a value of one signifies "on" status. + -- Canonical_Streams indicates whether stream-related optimizations are + -- active. A value of zero indicates that all optimizations are active, + -- while a value of one signifies that they have been disabled. + ----------------------- -- Local Subprograms -- ----------------------- @@ -593,6 +596,9 @@ package body Bindgen is WBI (" Leap_Seconds_Support : Integer;"); WBI (" pragma Import (C, Leap_Seconds_Support, " & """__gl_leap_seconds_support"");"); + WBI (" Canonical_Streams : Integer;"); + WBI (" pragma Import (C, Canonical_Streams, " & + """__gl_canonical_streams"");"); -- Import entry point for elaboration time signal handler -- installation, and indication of if it's been called previously. @@ -761,6 +767,17 @@ package body Bindgen is Set_String (";"); Write_Statement_Buffer; + Set_String (" Canonical_Streams := "); + + if Canonical_Streams then + Set_Int (1); + else + Set_Int (0); + end if; + + Set_String (";"); + Write_Statement_Buffer; + -- Generate call to Install_Handler WBI (""); @@ -1042,6 +1059,18 @@ package body Bindgen is Set_String (";"); Write_Statement_Buffer; + WBI (" extern int __gl_canonical_streams;"); + Set_String (" __gl_canonical_streams = "); + + if Canonical_Streams then + Set_Int (1); + else + Set_Int (0); + end if; + + Set_String (";"); + Write_Statement_Buffer; + WBI (""); -- Install elaboration time signal handler diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index aea61397dc9..6eb7ebbbbc3 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -470,7 +470,11 @@ package body Checks is -- Apply_Accessibility_Check -- ------------------------------- - procedure Apply_Accessibility_Check (N : Node_Id; Typ : Entity_Id) is + procedure Apply_Accessibility_Check + (N : Node_Id; + Typ : Entity_Id; + Insert_Node : Node_Id) + is Loc : constant Source_Ptr := Sloc (N); Param_Ent : constant Entity_Id := Param_Entity (N); Param_Level : Node_Id; @@ -501,7 +505,7 @@ package body Checks is -- Raise Program_Error if the accessibility level of the the access -- parameter is deeper than the level of the target access type. - Insert_Action (N, + Insert_Action (Insert_Node, Make_Raise_Program_Error (Loc, Condition => Make_Op_Gt (Loc, diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index 0c9049471b4..7b231473c81 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -102,11 +102,15 @@ package Checks is -- Determines whether an expression node requires a runtime access -- check and if so inserts the appropriate run-time check. - procedure Apply_Accessibility_Check (N : Node_Id; Typ : Entity_Id); + procedure Apply_Accessibility_Check + (N : Node_Id; + Typ : Entity_Id; + Insert_Node : Node_Id); -- Given a name N denoting an access parameter, emits a run-time -- accessibility check (if necessary), checking that the level of -- the object denoted by the access parameter is not deeper than the -- level of the type Typ. Program_Error is raised if the check fails. + -- Insert_Node indicates the node where the check should be inserted. procedure Apply_Address_Clause_Check (E : Entity_Id; N : Node_Id); -- E is the entity for an object which has an address clause. If checks diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 5db4c4efc67..30aa9a45c41 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -826,9 +826,6 @@ package body Clean is Index2 : Int; Lib_File : File_Name_Type; - Source_Id : Other_Source_Id; - Source : Other_Source; - Global_Archive : Boolean := False; begin @@ -881,7 +878,7 @@ package body Clean is -- Source_Dirs or Source_Files is specified as an empty list, -- so always look for Ada units in extending projects. - if Data.Langs (Ada_Language_Index) + if Data.Ada_Sources_Present or else Data.Extends /= No_Project then for Unit in Unit_Table.First .. @@ -1044,40 +1041,6 @@ package body Clean is end if; end if; - if Data.Other_Sources_Present then - - -- There is non-Ada code: delete the object files and - -- the dependency files if they exist. - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := - Project_Tree.Other_Sources.Table (Source_Id); - - if Is_Regular_File - (Get_Name_String (Source.Object_Name)) - then - Delete (Obj_Dir, Get_Name_String (Source.Object_Name)); - end if; - - if - Is_Regular_File (Get_Name_String (Source.Dep_Name)) - then - Delete (Obj_Dir, Get_Name_String (Source.Dep_Name)); - end if; - - Source_Id := Source.Next; - end loop; - - -- If it is a library with only non Ada sources, delete - -- the fake archive and the dependency file, if they exist. - - if Data.Library - and then not Data.Langs (Ada_Language_Index) - then - Clean_Archive (Project, Global => False); - end if; - end if; end; end if; diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 01d384ec4f6..255b7a0cdcc 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -2579,7 +2579,7 @@ package body Einfo is function Spec_PPC_List (Id : E) return N is begin - pragma Assert (Is_Subprogram (Id)); + pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id)); return Node24 (Id); end Spec_PPC_List; @@ -5044,7 +5044,7 @@ package body Einfo is procedure Set_Spec_PPC_List (Id : E; V : N) is begin - pragma Assert (Is_Subprogram (Id)); + pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id)); Set_Node24 (Id, V); end Set_Spec_PPC_List; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 8316a68018a..c7182dbe04f 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3527,10 +3527,11 @@ package Einfo is -- the corresponding parameter entities in the spec. -- Spec_PPC_List (Node24) --- Present in subprogram entities. Points to a list of Precondition --- and Postcondition N_Pragma nodes for preconditions and postconditions --- declared in the spec. The last pragma encountered is at the head of --- this list, so it is in reverse order of textual appearance. +-- Present in subprogram and generic subprogram entities. Points to a +-- list of Precondition and Postcondition pragma nodes for preconditions +-- and postconditions declared in the spec. The last pragma encountered +-- is at the head of this list, so it is in reverse order of textual +-- appearance. -- Storage_Size_Variable (Node15) [implementation base type only] -- Present in access types and task type entities. This flag is set @@ -5277,7 +5278,7 @@ package Einfo is -- Generic_Renamings (Elist23) (for instance) -- Inner_Instances (Elist23) (for generic proc) -- Protection_Object (Node23) (for concurrent kind) - -- Spec_PPC_List (Node24) (non-generic case only) + -- Spec_PPC_List (Node24) -- Interface_Alias (Node25) -- Static_Initialization (Node26) (init_proc only) -- Overridden_Operation (Node26) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 40ff3796671..eaff8e89a9e 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -28,6 +28,7 @@ with Checks; use Checks; with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; +with Errout; use Errout; with Expander; use Expander; with Exp_Util; use Exp_Util; with Exp_Ch3; use Exp_Ch3; @@ -169,12 +170,15 @@ package body Exp_Aggr is -- Local Subprograms for Array Aggregate Expansion -- ----------------------------------------------------- - function Aggr_Size_OK (Typ : Entity_Id) return Boolean; + function Aggr_Size_OK (N : Node_Id; Typ : Entity_Id) return Boolean; -- Very large static aggregates present problems to the back-end, and -- are transformed into assignments and loops. This function verifies -- that the total number of components of an aggregate is acceptable -- for transformation into a purely positional static form. It is called -- prior to calling Flatten. + -- This function also detects and warns about one-component aggregates + -- that appear in a non-static context. Even if the component value is + -- static, such an aggregate must be expanded into an assignment. procedure Convert_Array_Aggr_In_Allocator (Decl : Node_Id; @@ -291,7 +295,7 @@ package body Exp_Aggr is -- Aggr_Size_OK -- ------------------ - function Aggr_Size_OK (Typ : Entity_Id) return Boolean is + function Aggr_Size_OK (N : Node_Id; Typ : Entity_Id) return Boolean is Lo : Node_Id; Hi : Node_Id; Indx : Node_Id; @@ -399,6 +403,43 @@ package body Exp_Aggr is return True; end if; + -- One-component aggregates are suspicious, and if the context type + -- is an object declaration with non-static bounds it will trip gcc; + -- such an aggregate must be expanded into a single assignment. + + if Hiv = Lov + and then Nkind (Parent (N)) = N_Object_Declaration + then + declare + Index_Type : constant Entity_Id := + Etype + (First_Index + (Etype (Defining_Identifier (Parent (N))))); + Indx : Node_Id; + + begin + if not Compile_Time_Known_Value (Type_Low_Bound (Index_Type)) + or else not Compile_Time_Known_Value + (Type_High_Bound (Index_Type)) + then + if Present (Component_Associations (N)) then + Indx := + First (Choices (First (Component_Associations (N)))); + if Is_Entity_Name (Indx) + and then not Is_Type (Entity (Indx)) + then + Error_Msg_N + ("single component aggregate in non-static context?", + Indx); + Error_Msg_N ("\maybe subtype name was meant?", Indx); + end if; + end if; + + return False; + end if; + end; + end if; + declare Rng : constant Uint := Hiv - Lov + 1; @@ -3847,7 +3888,7 @@ package body Exp_Aggr is -- assignments to the target anyway, but it is conceivable that -- it will eventually be able to treat such aggregates statically??? - if Aggr_Size_OK (Typ) + if Aggr_Size_OK (N, Typ) and then Flatten (N, First_Index (Typ), First_Index (Base_Type (Typ))) then if Static_Components then @@ -6383,7 +6424,7 @@ package body Exp_Aggr is elsif Nkind (Expression (Expr)) /= N_Integer_Literal then return False; - elsif not Aggr_Size_OK (Typ) then + elsif not Aggr_Size_OK (N, Typ) then return False; end if; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 1637863cf45..84bc808b86f 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -651,6 +651,37 @@ package body Exp_Attr is Btyp_DDT : constant Entity_Id := Directly_Designated_Type (Btyp); Ref_Object : constant Node_Id := Get_Referenced_Object (Pref); + function Enclosing_Object (N : Node_Id) return Node_Id; + -- If N denotes a compound name (selected component, indexed + -- component, or slice), returns the name of the outermost + -- such enclosing object. Otherwise returns N. If the object + -- is a renaming, then the renamed object is returned. + + ---------------------- + -- Enclosing_Object -- + ---------------------- + + function Enclosing_Object (N : Node_Id) return Node_Id is + Obj_Name : Node_Id; + + begin + Obj_Name := N; + while Nkind_In (Obj_Name, N_Selected_Component, + N_Indexed_Component, + N_Slice) + loop + Obj_Name := Prefix (Obj_Name); + end loop; + + return Get_Referenced_Object (Obj_Name); + end Enclosing_Object; + + -- Local declarations + + Enc_Object : constant Node_Id := Enclosing_Object (Ref_Object); + + -- Start of processing for Access_Cases + begin -- In order to improve the text of error messages, the designated -- type of access-to-subprogram itypes is set by the semantics as @@ -800,35 +831,31 @@ package body Exp_Attr is end; -- If the prefix of an Access attribute is a dereference of an - -- access parameter (or a renaming of such a dereference) and - -- the context is a general access type (but not an anonymous - -- access type), then rewrite the attribute as a conversion of - -- the access parameter to the context access type. This will - -- result in an accessibility check being performed, if needed. - - -- (X.all'Access => Acc_Type (X)) - - -- Note: Limit the expansion of an attribute applied to a - -- dereference of an access parameter so that it's only done - -- for 'Access. This fixes a problem with 'Unrestricted_Access - -- that leads to errors in the case where the attribute type - -- is access-to-variable and the access parameter is - -- access-to-constant. The conversion is only done to get - -- accessibility checks, so it makes sense to limit it to - -- 'Access. - - elsif Nkind (Ref_Object) = N_Explicit_Dereference - and then Is_Entity_Name (Prefix (Ref_Object)) + -- access parameter (or a renaming of such a dereference, or a + -- subcomponent of such a dereference) and the context is a + -- general access type (but not an anonymous access type), then + -- apply an accessibility check to the access parameter. We used + -- to rewrite the access parameter as a type conversion, but that + -- could only be done if the immediate prefix of the Access + -- attribute was the dereference, and didn't handle cases where + -- the attribute is applied to a subcomponent of the dereference, + -- since there's generally no available, appropriate access type + -- to convert to in that case. The attribute is passed as the + -- point to insert the check, because the access parameter may + -- come from a renaming, possibly in a different scope, and the + -- check must be associated with the attribute itself. + + elsif Id = Attribute_Access + and then Nkind (Enc_Object) = N_Explicit_Dereference + and then Is_Entity_Name (Prefix (Enc_Object)) and then Ekind (Btyp) = E_General_Access_Type - and then Ekind (Entity (Prefix (Ref_Object))) in Formal_Kind - and then Ekind (Etype (Entity (Prefix (Ref_Object)))) + and then Ekind (Entity (Prefix (Enc_Object))) in Formal_Kind + and then Ekind (Etype (Entity (Prefix (Enc_Object)))) = E_Anonymous_Access_Type and then Present (Extra_Accessibility - (Entity (Prefix (Ref_Object)))) + (Entity (Prefix (Enc_Object)))) then - Rewrite (N, - Convert_To (Typ, New_Copy_Tree (Prefix (Ref_Object)))); - Analyze_And_Resolve (N, Typ); + Apply_Accessibility_Check (Prefix (Enc_Object), Typ, N); -- Ada 2005 (AI-251): If the designated type is an interface we -- add an implicit conversion to force the displacement of the @@ -5314,7 +5341,8 @@ package body Exp_Attr is (Typ : Entity_Id; Nam : TSS_Name_Type) return Entity_Id is - Ent : constant Entity_Id := TSS (Typ, Nam); + Base_Typ : constant Entity_Id := Base_Type (Typ); + Ent : constant Entity_Id := TSS (Typ, Nam); begin if Present (Ent) then @@ -5340,7 +5368,7 @@ package body Exp_Attr is -- String as defined in package Ada - if Typ = Standard_String then + if Base_Typ = Standard_String then if Nam = TSS_Stream_Input then return RTE (RE_String_Input); @@ -5356,7 +5384,7 @@ package body Exp_Attr is -- Wide_String as defined in package Ada - elsif Typ = Standard_Wide_String then + elsif Base_Typ = Standard_Wide_String then if Nam = TSS_Stream_Input then return RTE (RE_Wide_String_Input); @@ -5372,7 +5400,7 @@ package body Exp_Attr is -- Wide_Wide_String as defined in package Ada - elsif Typ = Standard_Wide_Wide_String then + elsif Base_Typ = Standard_Wide_Wide_String then if Nam = TSS_Stream_Input then return RTE (RE_Wide_Wide_String_Input); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 798da67036e..ba09aa69807 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3440,7 +3440,8 @@ package body Exp_Ch4 is and then Ekind (Etype (Nod)) = E_Anonymous_Access_Type then - Apply_Accessibility_Check (Nod, Typ); + Apply_Accessibility_Check + (Nod, Typ, Insert_Node => Nod); end if; Next_Elmt (Discr); @@ -7552,9 +7553,9 @@ package body Exp_Ch4 is -- Apply an accessibility check when the conversion operand is an -- access parameter (or a renaming thereof), unless conversion was - -- expanded from an unchecked or unrestricted access attribute. Note - -- that other checks may still need to be applied below (such as - -- tagged type checks). + -- expanded from an Unchecked_ or Unrestricted_Access attribute. + -- Note that other checks may still need to be applied below (such + -- as tagged type checks). if Is_Entity_Name (Operand) and then @@ -7568,9 +7569,10 @@ package body Exp_Ch4 is and then (Nkind (Original_Node (N)) /= N_Attribute_Reference or else Attribute_Name (Original_Node (N)) = Name_Access) then - Apply_Accessibility_Check (Operand, Target_Type); + Apply_Accessibility_Check + (Operand, Target_Type, Insert_Node => Operand); - -- If the level of the operand type is statically deeper then the + -- If the level of the operand type is statically deeper than the -- level of the target type, then force Program_Error. Note that this -- can only occur for cases where the attribute is within the body of -- an instantiation (otherwise the conversion will already have been diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index cddc0210241..d1d43cf3974 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1,4 +1,4 @@ ------------------------------------------------------------------------------ +------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- @@ -2070,16 +2070,16 @@ package body Exp_Ch6 is if Ekind (Etype (Prev)) in Private_Kind and then not Has_Discriminants (Base_Type (Etype (Prev))) then - Add_Extra_Actual ( - New_Occurrence_Of (Standard_False, Loc), - Extra_Constrained (Formal)); + Add_Extra_Actual + (New_Occurrence_Of (Standard_False, Loc), + Extra_Constrained (Formal)); elsif Is_Constrained (Etype (Formal)) or else not Has_Discriminants (Etype (Prev)) then - Add_Extra_Actual ( - New_Occurrence_Of (Standard_True, Loc), - Extra_Constrained (Formal)); + Add_Extra_Actual + (New_Occurrence_Of (Standard_True, Loc), + Extra_Constrained (Formal)); -- Do not produce extra actuals for Unchecked_Union parameters. -- Jump directly to the end of the loop. @@ -2220,7 +2220,7 @@ package body Exp_Ch6 is else Add_Extra_Actual (Make_Integer_Literal (Loc, - Intval => Scope_Depth (Standard_Standard)), + Intval => Scope_Depth (Standard_Standard)), Extra_Accessibility (Formal)); end if; end; @@ -2231,11 +2231,25 @@ package body Exp_Ch6 is else Add_Extra_Actual (Make_Integer_Literal (Loc, - Intval => Type_Access_Level (Etype (Prev_Orig))), + Intval => Type_Access_Level (Etype (Prev_Orig))), Extra_Accessibility (Formal)); end if; - -- All cases other than thunks + -- If the actual is an access discriminant, then pass the level + -- of the enclosing object (RM05-3.10.2(12.4/2)). + + elsif Nkind (Prev_Orig) = N_Selected_Component + and then Ekind (Entity (Selector_Name (Prev_Orig))) = + E_Discriminant + and then Ekind (Etype (Entity (Selector_Name (Prev_Orig)))) = + E_Anonymous_Access_Type + then + Add_Extra_Actual + (Make_Integer_Literal (Loc, + Intval => Object_Access_Level (Prefix (Prev_Orig))), + Extra_Accessibility (Formal)); + + -- All other cases else case Nkind (Prev_Orig) is @@ -2246,20 +2260,20 @@ package body Exp_Ch6 is -- For X'Access, pass on the level of the prefix X when Attribute_Access => - Add_Extra_Actual ( - Make_Integer_Literal (Loc, - Intval => - Object_Access_Level (Prefix (Prev_Orig))), - Extra_Accessibility (Formal)); + Add_Extra_Actual + (Make_Integer_Literal (Loc, + Intval => + Object_Access_Level (Prefix (Prev_Orig))), + Extra_Accessibility (Formal)); -- Treat the unchecked attributes as library-level when Attribute_Unchecked_Access | Attribute_Unrestricted_Access => - Add_Extra_Actual ( - Make_Integer_Literal (Loc, - Intval => Scope_Depth (Standard_Standard)), - Extra_Accessibility (Formal)); + Add_Extra_Actual + (Make_Integer_Literal (Loc, + Intval => Scope_Depth (Standard_Standard)), + Extra_Accessibility (Formal)); -- No other cases of attributes returning access -- values that can be passed to access parameters @@ -2274,19 +2288,19 @@ package body Exp_Ch6 is -- current scope level. when N_Allocator => - Add_Extra_Actual ( - Make_Integer_Literal (Loc, - Scope_Depth (Current_Scope) + 1), - Extra_Accessibility (Formal)); + Add_Extra_Actual + (Make_Integer_Literal (Loc, + Intval => Scope_Depth (Current_Scope) + 1), + Extra_Accessibility (Formal)); -- For other cases we simply pass the level of the -- actual's access type. when others => - Add_Extra_Actual ( - Make_Integer_Literal (Loc, - Intval => Type_Access_Level (Etype (Prev_Orig))), - Extra_Accessibility (Formal)); + Add_Extra_Actual + (Make_Integer_Literal (Loc, + Intval => Type_Access_Level (Etype (Prev_Orig))), + Extra_Accessibility (Formal)); end case; end if; @@ -5496,7 +5510,7 @@ package body Exp_Ch6 is if Is_Constrained (Underlying_Type (Result_Subt)) then Insert_After_And_Analyze (Object_Decl, Ptr_Typ_Decl); else - Insert_Before_And_Analyze (Object_Decl, Ptr_Typ_Decl); + Insert_Action (Object_Decl, Ptr_Typ_Decl); end if; -- Finally, create an access object initialized to a reference to the diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 574d01f0ac8..2a91413d570 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -1634,7 +1634,7 @@ package body Exp_Ch9 is -- when a protected entry wrapper must override an interface -- level procedure with interface access as first parameter. - -- O.all.Subp_Id (Formal_1 .. Formal_N) + -- O.all.Subp_Id (Formal_1, ..., Formal_N) if Nkind (Parameter_Type (First_Formal)) = N_Access_Definition diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 864206951f6..ac25171abf7 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -6042,6 +6042,13 @@ package body Exp_Disp is Full_Typ := Corresponding_Concurrent_Type (Typ); end if; + -- When a private tagged type is completed by a concurrent type, + -- retrieve the full view. + + if Is_Private_Type (Full_Typ) then + Full_Typ := Full_View (Full_Typ); + end if; + if Ekind (Prim_Op) = E_Function then -- Protected function diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index 2e21af503de..e69f798db5d 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -219,8 +219,10 @@ extern void Set_Has_No_Elaboration_Code (Node_Id, Boolean); /* targparm: */ +#define Backend_Overflow_Checks_On_Target targparm__backend_overflow_checks_on_target #define Stack_Check_Probes_On_Target targparm__stack_check_probes_on_target #define Stack_Check_Limits_On_Target targparm__stack_check_limits_on_target +extern Boolean Backend_Overflow_Checks_On_Target; extern Boolean Stack_Check_Probes_On_Target; extern Boolean Stack_Check_Limits_On_Target; diff --git a/gcc/ada/g-pehage.adb b/gcc/ada/g-pehage.adb index c779fac7ca7..129cecc7659 100644 --- a/gcc/ada/g-pehage.adb +++ b/gcc/ada/g-pehage.adb @@ -49,8 +49,8 @@ package body GNAT.Perfect_Hash_Generators is -- h (w) = (g (f1 (w)) + g (f2 (w))) mod m - -- where f1 and f2 are functions that map strings into integers, and g is a - -- function that maps integers into [0, m-1]. h can be order preserving. + -- where f1 and f2 are functions that map strings into integers, and g is + -- a function that maps integers into [0, m-1]. h can be order preserving. -- For instance, let W = {w_0, ..., w_i, ..., w_m-1}, h can be defined -- such that h (w_i) = i. @@ -132,10 +132,10 @@ package body GNAT.Perfect_Hash_Generators is package WT is new GNAT.Table (Word_Type, Word_Id, 0, 32, 32); package IT is new GNAT.Table (Integer, Integer, 0, 32, 32); -- The two main tables. WT is used to store the words in their initial - -- version and in their reduced version (that is words reduced to - -- their significant characters). As an instance of GNAT.Table, WT does - -- not initialize string pointers to null. This initialization has to be - -- done manually when the table is allocated. IT is used to store several + -- version and in their reduced version (that is words reduced to their + -- significant characters). As an instance of GNAT.Table, WT does not + -- initialize string pointers to null. This initialization has to be done + -- manually when the table is allocated. IT is used to store several -- tables of components containing only integers. function Image (Int : Integer; W : Natural := 0) return String; @@ -591,7 +591,7 @@ package body GNAT.Perfect_Hash_Generators is -- Start of processing for Assign_Values_To_Vertices begin - -- Value -1 denotes an unitialized value as it is supposed to + -- Value -1 denotes an uninitialized value as it is supposed to -- be in the range 0 .. NK. if G = No_Table then @@ -1141,11 +1141,10 @@ package body GNAT.Perfect_Hash_Generators is Tries : Positive := Default_Tries) is begin - -- Deallocated the part of the table concerning the reduced - -- words. Initial words are already present in the table. We - -- may have reduced words already there because a previous - -- computation failed. We are currently retrying and the - -- reduced words have to be deallocated. + -- Deallocate the part of the table concerning the reduced words. + -- Initial words are already present in the table. We may have reduced + -- words already there because a previous computation failed. We are + -- currently retrying and the reduced words have to be deallocated. for W in NK .. WT.Last loop Free_Word (WT.Table (W)); diff --git a/gcc/ada/g-pehage.ads b/gcc/ada/g-pehage.ads index 277a2a4580b..8b75f2e8803 100644 --- a/gcc/ada/g-pehage.ads +++ b/gcc/ada/g-pehage.ads @@ -99,18 +99,18 @@ package GNAT.Perfect_Hash_Generators is K_To_V : Float := Default_K_To_V; Optim : Optimization := CPU_Time; Tries : Positive := Default_Tries); - -- Initialize the generator and its internal structures. Set the - -- ratio of vertices over keys in the random graphs. This value - -- has to be greater than 2.0 in order for the algorithm to - -- succeed. The word set is not modified (in particular when it is - -- already set). For instance, it is possible to run several times - -- the generator with different settings on the same words. - - -- A classical way of doing is to Insert all the words and then to - -- invoke Initialize and Compute. If Compute fails to find a - -- perfect hash function, invoke Initialize another time with - -- other configuration parameters (probably with a greater K_To_V - -- ratio). Once successful, invoke Produce and Finalize. + -- Initialize the generator and its internal structures. Set the ratio of + -- vertices over keys in the random graphs. This value has to be greater + -- than 2.0 in order for the algorithm to succeed. The word set is not + -- modified (in particular when it is already set). For instance, it is + -- possible to run several times the generator with different settings on + -- the same words. + -- + -- A classical way of doing is to Insert all the words and then to invoke + -- Initialize and Compute. If Compute fails to find a perfect hash + -- function, invoke Initialize another time with other configuration + -- parameters (probably with a greater K_To_V ratio). Once successful, + -- invoke Produce and Finalize. procedure Finalize; -- Deallocate the internal structures and the words table @@ -219,8 +219,8 @@ package GNAT.Perfect_Hash_Generators is Length_2 : out Natural); -- Return the definition of the table Name. This includes the length of -- dimensions 1 and 2 and the size of an unsigned integer item. When - -- Length_2 is zero, the table has only one dimension. All the ranges start - -- from zero. + -- Length_2 is zero, the table has only one dimension. All the ranges + -- start from zero. function Value (Name : Table_Name; diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 9ac7b8b7a92..acc523d8abb 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -1335,7 +1335,9 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),) EH_MECHANISM=-gcc else - LIBGNAT_TARGET_PAIRS += system.ads<system-rtx-rtss.ads + LIBGNAT_TARGET_PAIRS += \ + system.ads<system-rtx-rtss.ads \ + s-parame.adb<s-parame-vxworks.adb EH_MECHANISM= endif @@ -1715,13 +1717,13 @@ endif # go into the directory. The pthreads emulation is built in the threads # subdirectory and copied. LIBGNAT_SRCS = adaint.c adaint.h argv.c cio.c cstreams.c \ - errno.c exit.c cal.c ctrl_c.c env.c env.h \ + errno.c exit.c cal.c ctrl_c.c env.c env.h arit64.c \ raise.h raise.c sysdep.c aux-io.c init.c initialize.c seh_init.c \ final.c tracebak.c tb-alvms.c tb-alvxw.c tb-gcc.c expect.c mkdir.c \ socket.c gsocket.h targext.c $(EXTRA_LIBGNAT_SRCS) LIBGNAT_OBJS = adaint.o argv.o cio.o cstreams.o ctrl_c.o errno.o exit.o env.o \ - raise.o sysdep.o aux-io.o init.o initialize.o seh_init.o cal.o \ + raise.o sysdep.o aux-io.o init.o initialize.o seh_init.o cal.o arit64.o \ final.o tracebak.o expect.o mkdir.o socket.o targext.o $(EXTRA_LIBGNAT_OBJS) # NOTE ??? - when the -I option for compiling Ada code is made to work, diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index b02b9a04132..f8ebf5a58be 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -3062,7 +3062,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Discard old fields that are outside the new type. This avoids confusing code scanning it to decide - how to pass it to functions on some platforms. */ + how to pass it to functions on some platforms. */ if (TREE_CODE (gnu_new_pos) == INTEGER_CST && TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST && !integer_zerop (gnu_size) diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 8055359863c..f44fec89abd 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -394,6 +394,9 @@ enum standard_datatypes /* Likewise for freeing memory. */ ADT_free_decl, + /* Function decl node for 64-bit multiplication with overflow checking */ + ADT_mulv64_decl, + /* Types and decls used by our temporary exception mechanism. See init_gigi_decls for details. */ ADT_jmpbuf_type, @@ -425,6 +428,7 @@ extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1]; #define malloc_decl gnat_std_decls[(int) ADT_malloc_decl] #define malloc32_decl gnat_std_decls[(int) ADT_malloc32_decl] #define free_decl gnat_std_decls[(int) ADT_free_decl] +#define mulv64_decl gnat_std_decls[(int) ADT_mulv64_decl] #define jmpbuf_type gnat_std_decls[(int) ADT_jmpbuf_type] #define jmpbuf_ptr_type gnat_std_decls[(int) ADT_jmpbuf_ptr_type] #define get_jmpbuf_decl gnat_std_decls[(int) ADT_get_jmpbuf_decl] diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 9d3f807c6e6..f8e1d49eaa2 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -205,6 +205,8 @@ static void process_decls (List_Id, List_Id, Node_Id, bool, bool); static tree emit_range_check (tree, Node_Id); static tree emit_index_check (tree, tree, tree, tree); static tree emit_check (tree, tree, int); +static tree build_unary_op_trapv (enum tree_code, tree, tree); +static tree build_binary_op_trapv (enum tree_code, tree, tree, tree); static tree convert_with_check (Entity_Id, tree, bool, bool, bool); static bool smaller_packable_type_p (tree, tree); static bool addressable_p (tree, tree); @@ -3939,7 +3941,22 @@ gnat_to_gnu (Node_Id gnat_node) gnu_rhs = convert (gnu_type, gnu_rhs); } - gnu_result = build_binary_op (code, gnu_type, gnu_lhs, gnu_rhs); + /* Instead of expanding overflow checks for addition, subtraction + and multiplication itself, the front end will leave this to + the back end when Backend_Overflow_Checks_On_Target is set. + As the GCC back end itself does not know yet how to properly + do overflow checking, do it here. The goal is to push + the expansions further into the back end over time. */ + if (Do_Overflow_Check (gnat_node) && Backend_Overflow_Checks_On_Target + && (Nkind (gnat_node) == N_Op_Add + || Nkind (gnat_node) == N_Op_Subtract + || Nkind (gnat_node) == N_Op_Multiply) + && !TYPE_UNSIGNED (gnu_type) + && !FLOAT_TYPE_P (gnu_type)) + gnu_result + = build_binary_op_trapv (code, gnu_type, gnu_lhs, gnu_rhs); + else + gnu_result = build_binary_op (code, gnu_type, gnu_lhs, gnu_rhs); /* If this is a logical shift with the shift count not verified, we must return zero if it is too large. We cannot compensate @@ -4004,8 +4021,14 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result_type = get_unpadded_type (Base_Type (Full_View (Etype (gnat_node)))); - gnu_result = build_unary_op (gnu_codes[Nkind (gnat_node)], - gnu_result_type, gnu_expr); + if (Do_Overflow_Check (gnat_node) + && !TYPE_UNSIGNED (gnu_result_type) + && !FLOAT_TYPE_P (gnu_result_type)) + gnu_result = build_unary_op_trapv (gnu_codes[Nkind (gnat_node)], + gnu_result_type, gnu_expr); + else + gnu_result = build_unary_op (gnu_codes[Nkind (gnat_node)], + gnu_result_type, gnu_expr); break; case N_Allocator: @@ -5875,6 +5898,159 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2, } } +/* Make a unary operation of kind CODE using build_unary_op, but guard + the operation by an overflow check. CODE can be one of NEGATE_EXPR + or ABS_EXPR. GNU_TYPE is the type desired for the result. + Usually the operation is to be performed in that type. */ + +static tree +build_unary_op_trapv (enum tree_code code, + tree gnu_type, + tree operand) +{ + gcc_assert ((code == NEGATE_EXPR) || (code == ABS_EXPR)); + + operand = save_expr (operand); + + return emit_check (build_binary_op (EQ_EXPR, integer_type_node, + operand, TYPE_MIN_VALUE (gnu_type)), + build_unary_op (code, gnu_type, operand), + CE_Overflow_Check_Failed); +} + +/* Make a binary operation of kind CODE using build_binary_op, but + guard the operation by an overflow check. CODE can be one of + PLUS_EXPR, MINUS_EXPR or MULT_EXPR. GNU_TYPE is the type desired + for the result. Usually the operation is to be performed in that type. */ + +static tree +build_binary_op_trapv (enum tree_code code, + tree gnu_type, + tree left, + tree right) +{ + tree lhs = save_expr (left); + tree rhs = save_expr (right); + tree type_max = TYPE_MAX_VALUE (gnu_type); + tree type_min = TYPE_MIN_VALUE (gnu_type); + tree gnu_expr; + tree tmp1, tmp2; + tree zero = convert (gnu_type, integer_zero_node); + tree rhs_ge_zero; + tree check_pos; + tree check_neg; + + int precision = TYPE_PRECISION (gnu_type); + + /* Prefer a constant rhs to simplify checks */ + + if (TREE_CONSTANT (lhs) && !TREE_CONSTANT (rhs) + && commutative_tree_code (code)) + { + tree tmp = lhs; + lhs = rhs; + rhs = tmp; + } + + /* In the case the right-hand size is still not constant, try to + use an exact operation in a wider type. */ + + if (!TREE_CONSTANT (rhs)) + { + int needed_precision = code == MULT_EXPR ? 2 * precision : precision + 1; + + if (code == MULT_EXPR && precision == 64) + { + return build_call_2_expr (mulv64_decl, lhs, rhs); + } + else if (needed_precision <= LONG_LONG_TYPE_SIZE) + { + tree calc_type = gnat_type_for_size (needed_precision, 0); + tree result; + tree check; + + result = build_binary_op (code, calc_type, + convert (calc_type, lhs), + convert (calc_type, rhs)); + + check = build_binary_op + (TRUTH_ORIF_EXPR, integer_type_node, + build_binary_op (LT_EXPR, integer_type_node, result, + convert (calc_type, type_min)), + build_binary_op (GT_EXPR, integer_type_node, result, + convert (calc_type, type_max))); + + result = convert (gnu_type, result); + + return emit_check (check, result, CE_Overflow_Check_Failed); + } + } + + gnu_expr = build_binary_op (code, gnu_type, lhs, rhs); + rhs_ge_zero = build_binary_op (GE_EXPR, integer_type_node, rhs, zero); + + switch (code) + { + case PLUS_EXPR: + /* When rhs >= 0, overflow when lhs > type_max - rhs */ + check_pos = build_binary_op (GT_EXPR, integer_type_node, lhs, + build_binary_op (MINUS_EXPR, gnu_type, + type_max, rhs)), + + /* When rhs < 0, overflow when lhs < type_min - rhs */ + check_neg = build_binary_op (LT_EXPR, integer_type_node, lhs, + build_binary_op (MINUS_EXPR, gnu_type, + type_min, rhs)); + break; + + case MINUS_EXPR: + /* When rhs >= 0, overflow when lhs < type_min + rhs */ + check_pos = build_binary_op (LT_EXPR, integer_type_node, lhs, + build_binary_op (PLUS_EXPR, gnu_type, + type_min, rhs)), + + /* When rhs < 0, overflow when lhs > type_max + rhs */ + check_neg = build_binary_op (GT_EXPR, integer_type_node, lhs, + build_binary_op (PLUS_EXPR, gnu_type, + type_max, rhs)); + break; + + case MULT_EXPR: + /* The check here is designed to be efficient if the rhs is constant, + Four different check expressions determine wether X * C overflows, + depending on C. + C == 0 => false + C > 0 => X > type_max / C || X < type_min / C + C == -1 => X == type_min + C < -1 => X > type_min / C || X < type_max / C */ + + tmp1 = build_binary_op (TRUNC_DIV_EXPR, gnu_type, type_max, rhs); + tmp2 = build_binary_op (TRUNC_DIV_EXPR, gnu_type, type_min, rhs); + + check_pos = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node, + build_binary_op (NE_EXPR, integer_type_node, zero, rhs), + build_binary_op (TRUTH_ORIF_EXPR, integer_type_node, + build_binary_op (GT_EXPR, integer_type_node, lhs, tmp1), + build_binary_op (LT_EXPR, integer_type_node, lhs, tmp2))); + + check_neg = fold_build3 (COND_EXPR, integer_type_node, + build_binary_op (EQ_EXPR, integer_type_node, rhs, + build_int_cst (gnu_type, -1)), + build_binary_op (EQ_EXPR, integer_type_node, lhs, type_min), + build_binary_op (TRUTH_ORIF_EXPR, integer_type_node, + build_binary_op (GT_EXPR, integer_type_node, lhs, tmp2), + build_binary_op (LT_EXPR, integer_type_node, lhs, tmp1))); + break; + + default: + gcc_unreachable(); + } + + return emit_check (fold_build3 (COND_EXPR, integer_type_node, rhs_ge_zero, + check_pos, check_neg), + gnu_expr, CE_Overflow_Check_Failed); +} + /* Emit code for a range check. GNU_EXPR is the expression to be checked, GNAT_RANGE_TYPE the gnat type or subtype containing the bounds against which we have to check. */ diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 882293895cc..2105abdcb29 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -542,6 +542,7 @@ void init_gigi_decls (tree long_long_float_type, tree exception_type) { tree endlink, decl; + tree int64_type = gnat_type_for_size (64, 0); unsigned int i; /* Set the types that GCC and Gigi use from the front end. We would like @@ -630,6 +631,13 @@ init_gigi_decls (tree long_long_float_type, tree exception_type) endlink)), NULL_TREE, false, true, true, NULL, Empty); + /* This is used for 64-bit multiplication with overflow checking. */ + mulv64_decl + = create_subprog_decl (get_identifier ("__gnat_mulv64"), NULL_TREE, + build_function_type_list (int64_type, int64_type, + int64_type, NULL_TREE), + NULL_TREE, false, true, true, NULL, Empty); + /* Make the types and functions used for exception processing. */ jmpbuf_type = build_array_type (gnat_type_for_mode (Pmode, 0), @@ -1747,7 +1755,7 @@ create_field_decl (tree field_name, tree field_type, tree record_type, of a copy. This is the case for true bitfields, but the DECL_BIT_FIELD value we have at this point is not accurate enough, so we don't account for this here and let finish_record_type decide. */ - if (!type_for_nonaliased_component_p (field_type)) + if (!addressable && !type_for_nonaliased_component_p (field_type)) addressable = 1; DECL_NONADDRESSABLE_P (field_decl) = !addressable; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 1d875a1f3c4..8c1759471ef 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -104,6 +104,7 @@ Implementation Defined Pragmas * Pragma Assert:: * Pragma Ast_Entry:: * Pragma C_Pass_By_Copy:: +* Pragma Canonical_Streams:: * Pragma Check:: * Pragma Check_Name:: * Pragma Check_Policy:: @@ -705,6 +706,7 @@ consideration, the use of these pragmas should be minimized. * Pragma Assert:: * Pragma Ast_Entry:: * Pragma C_Pass_By_Copy:: +* Pragma Canonical_Streams:: * Pragma Check:: * Pragma Check_Name:: * Pragma Check_Policy:: @@ -1057,6 +1059,27 @@ You can also pass records by copy by specifying the convention @code{Import} and @code{Export} pragmas, which allow specification of passing mechanisms on a parameter by parameter basis. +@node Pragma Canonical_Streams +@unnumberedsec Canonical Streams +@cindex Canonical streams +@findex Canonical_Streams +@noindent +Syntax: +@smallexample @c ada +pragma Canonical_Streams; +@end smallexample + +@noindent +This configuration pragma affects the behavior of stream attributes of any +@code{String}, @code{Wide_String} or @code{Wide_Wide_String} based type. When +this pragma is present, @code{'Input}, @code{'Output}, @code{'Read} and +@code{'Write} exibit Ada 95 canonical behavior, in other words, streaming of +values is done character by character. + +@noindent +The use of this pragma is intended to bypass any implementation-related +optimizations allowed by Ada 2005 RM 13.13.2 (56/2) Implementation Permission. + @node Pragma Check @unnumberedsec Pragma Check @cindex Assertions @@ -3792,6 +3815,13 @@ package Sort is end Sort; @end smallexample +@noindent +Note: postcondition pragmas associated with subprograms that are +marked as Inline_Always, or those marked as Inline with front-end +inlining (-gnatN option set) are accepted and legality-checked +by the compiler, but are ignored at run-time even if postcondition +checking is enabled. + @node Pragma Precondition @unnumberedsec Pragma Precondition @cindex Preconditions @@ -3826,13 +3856,22 @@ package Math_Functions is end Math_Functions; @end smallexample -@code{Postcondition} pragmas may appear either immediate following the +@noindent +@code{Precondition} pragmas may appear either immediate following the (separate) declaration of a subprogram, or at the start of the declarations of a subprogram body. Only other pragmas may intervene (that is appear between the subprogram declaration and its postconditions, or appear before the postcondition in the declaration sequence in a subprogram body). +Note: postcondition pragmas associated with subprograms that are +marked as Inline_Always, or those marked as Inline with front-end +inlining (-gnatN option set) are accepted and legality-checked +by the compiler, but are ignored at run-time even if postcondition +checking is enabled. + + + @node Pragma Profile (Ravenscar) @unnumberedsec Pragma Profile (Ravenscar) @findex Ravenscar diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index b55f398be8a..e64cebfb32e 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -2368,7 +2368,7 @@ that for inlining to actually occur as a result of the use of this switch, it is necessary to compile in optimizing mode. @cindex @option{-gnatN} switch -The use of @option{-gnatN} activates a more extensive inlining optimization +The use of @option{-gnatN} activates inlining optimization that is performed by the front end of the compiler. This inlining does not require that the code generation be optimized. Like @option{-gnatn}, the use of this switch generates additional dependencies. @@ -2376,6 +2376,12 @@ Note that @option{-gnatN} automatically implies @option{-gnatn} so it is not necessary to specify both options. +When using a gcc-based back end (in practice this means using any version +of GNAT other than the JGNAT, .NET or GNAAMP versions), then the use of +@option{-gnatN} is deprecated, and the use of @option{-gnatn} is preferred. +Historically front end inlining was more extensive than the gcc back end +inlining, but that is no longer the case. + @item If an object file @file{O} depends on the proper body of a subunit through inlining or instantiation, it depends on the parent unit of the subunit. @@ -10919,6 +10925,7 @@ recognized by GNAT: Ada_2005 Assertion_Policy C_Pass_By_Copy + Canonical_Streams Check_Name Check_Policy Compile_Time_Error @@ -21535,7 +21542,7 @@ The control structures checked are the following: @end itemize @noindent -The rule may have the following parameter for the @option{+R} option: +The rule has the following parameter for the @option{+R} option: @table @emph @item N @@ -21544,18 +21551,12 @@ level that is not flagged @end table @noindent -If the parameter for the @option{+R} option is not a positive integer, -the parameter is ignored and the rule is turned ON with the most recently -specified maximal non-flagged nesting level. +If the parameter for the @option{+R} option is not specified or +if it is not a positive integer, @option{+R} option is ignored. If more then one option is specified for the gnatcheck call, the later option and new parameter override the previous one(s). -A @option{+R} option with no parameter turns the rule ON using the maximal -non-flagged nesting level specified by the most recent @option{+R} option with -a parameter, or the value 4 if there is no such previous @option{+R} option. - - @node Parameters_Out_Of_Order @subsection @code{Parameters_Out_Of_Order} diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 24a6437f26b..47fc71e6fff 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -102,6 +102,7 @@ int __gl_zero_cost_exceptions = 0; int __gl_detect_blocking = 0; int __gl_default_stack_size = -1; int __gl_leap_seconds_support = 0; +int __gl_canonical_streams = 0; /* Indication of whether synchronous signal handler has already been installed by a previous call to adainit. */ diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 1755ade229c..3d0ee62eaed 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -246,7 +246,15 @@ package body Makeutl is -- If we get here, the user has typed the executable name with no -- directory prefix. - return Get_Install_Dir (Locate_Exec_On_Path (Exec_Name).all); + declare + Path : constant String_Access := Locate_Exec_On_Path (Exec_Name); + begin + if Path = null then + return ""; + else + return Get_Install_Dir (Path.all); + end if; + end; end Executable_Prefix_Path; ---------- diff --git a/gcc/ada/mlib-utl.ads b/gcc/ada/mlib-utl.ads index fc5894f70e2..237c678d1a7 100644 --- a/gcc/ada/mlib-utl.ads +++ b/gcc/ada/mlib-utl.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2007, AdaCore -- +-- Copyright (C) 2001-2008, AdaCore -- -- -- -- 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- -- @@ -47,10 +47,13 @@ package MLib.Utl is procedure Ar (Output_File : String; Objects : Argument_List); - -- Run ar to move all the binaries inside the archive. If ranlib is on the - -- path, run it also. Output_File is the path name of the archive to + -- Run ar to move all the binaries inside the archive. If ranlib is on + -- the path, run it also. Output_File is the path name of the archive to -- create. Objects is the list of the path names of the object files to be - -- put in the archive. + -- put in the archive. This procedure currently assumes that it is always + -- called in the context of gnatmake. If other executables start using this + -- procedure, an additional parameter would need to be added, and calls to + -- Osint.Program_Name updated accordingly in the body. function Lib_Directory return String; -- Return the directory containing libgnat diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 600231c737a..7ffa2d5d855 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -283,6 +283,11 @@ package Opt is -- is set True, or if pragma No_Run_Time is used. See the spec of Rtsfind -- for details on the handling of the latter pragma. + Canonical_Streams : Boolean := False; + -- GNATBIND + -- Set to True if configuration pragma Canonical_Streams is present. It + -- controls the canonical behaviour of stream operations for String types. + Constant_Condition_Warnings : Boolean := False; -- GNAT -- Set to True to activate warnings on constant conditions diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index c8b84ab189e..7e68cbea1cb 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1054,6 +1054,7 @@ begin Pragma_Atomic | Pragma_Atomic_Components | Pragma_Attach_Handler | + Pragma_Canonical_Streams | Pragma_Check | Pragma_Check_Name | Pragma_Check_Policy | diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index dd52f353287..1744716342d 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -2353,18 +2353,38 @@ package body Prj.Env is (Data.Object_Directory.Name, In_Tree); end if; - -- For a non-library project, add the object - -- directory, if it is not a virtual project, and if - -- there are Ada sources or if the project is an - -- extending project. If there are no Ada sources, - -- adding the object directory could disrupt the order - -- of the object dirs in the path. - - elsif not Data.Virtual - and then There_Are_Ada_Sources (In_Tree, Project) - then - Add_To_Object_Path - (Data.Object_Directory.Name, In_Tree); + -- For a non-library project, add object directory if + -- it is not a virtual project, and if there are Ada + -- sources in the project or one of the projects it + -- extends. If there are no Ada sources, adding the + -- object directory could disrupt the order of the + -- object dirs in the path. + + elsif not Data.Virtual then + declare + Add_Object_Dir : Boolean := False; + Prj : Project_Id := Project; + + begin + while not Add_Object_Dir + and then Prj /= No_Project + loop + if In_Tree.Projects.Table + (Prj).Ada_Sources /= Nil_String + then + Add_Object_Dir := True; + + else + Prj := + In_Tree.Projects.Table (Prj).Extends; + end if; + end loop; + + if Add_Object_Dir then + Add_To_Object_Path + (Data.Object_Directory.Name, In_Tree); + end if; + end; end if; end if; end if; diff --git a/gcc/ada/prj-makr.ads b/gcc/ada/prj-makr.ads index 50a97e93b51..b3a658fc3e9 100644 --- a/gcc/ada/prj-makr.ads +++ b/gcc/ada/prj-makr.ads @@ -73,6 +73,11 @@ package Prj.Makr is -- check for non Ada sources. -- -- At least one of Name_Patterns and Foreign_Patterns is not empty + -- + -- Note that this procedure currently assumes that it is only used by + -- gnatname. If other processes start using it, then an additional + -- parameter would need to be added, and call to Osint.Program_Name + -- updated accordingly in the body. procedure Finalize; -- Write the configuration pragmas file or the project file indicated in a diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index d84ba7fbbf7..3aa90ddfbd1 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -65,9 +65,6 @@ package body Prj.Nmsc is ALI_Suffix : constant String := ".ali"; -- File suffix for ali files - Object_Suffix : constant String := Get_Target_Object_Suffix.all; - -- File suffix for object files - type Name_Location is record Name : File_Name_Type; Location : Source_Ptr; @@ -267,20 +264,6 @@ package body Prj.Nmsc is Data : in out Project_Data); -- Check the configuration attributes for the project - procedure Check_For_Source - (File_Name : File_Name_Type; - Path_Name : Path_Name_Type; - Project : Project_Id; - In_Tree : Project_Tree_Ref; - Data : in out Project_Data; - Location : Source_Ptr; - Language : Language_Index; - Suffix : String; - Naming_Exception : Boolean); - -- Check if a file, with name File_Name and path Path_Name, in a source - -- directory is a source for language Language in project Project of - -- project tree In_Tree. ??? - procedure Check_If_Externally_Built (Project : Project_Id; In_Tree : Project_Tree_Ref; @@ -369,15 +352,6 @@ package body Prj.Nmsc is -- Current_Dir should represent the current directory, and is passed for -- efficiency to avoid system calls to recompute it. - procedure Find_Sources - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Data : in out Project_Data; - For_Language : Language_Index; - Current_Dir : String); - -- Find all the sources in all of the source directories of a project for - -- a specified language. - procedure Search_Directories (Project : Project_Id; In_Tree : Project_Tree_Ref; @@ -467,8 +441,7 @@ package body Prj.Nmsc is -- Source_Names. procedure Find_Explicit_Sources - (Lang : Language_Index; - Current_Dir : String; + (Current_Dir : String; Project : Project_Id; In_Tree : Project_Tree_Ref; Data : in out Project_Data); @@ -566,16 +539,6 @@ package body Prj.Nmsc is -- Current_Dir should represent the current directory, and is passed for -- efficiency to avoid system calls to recompute it. - procedure Record_Other_Sources - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Data : in out Project_Data; - Language : Language_Index; - Naming_Exceptions : Boolean); - -- Record the sources of a language in a project. When Naming_Exceptions is - -- True, mark the found sources as such, to later remove those that are not - -- named in a list of sources. - procedure Remove_Source (Id : Source_Id; Replaced_By : Source_Id; @@ -597,13 +560,6 @@ package body Prj.Nmsc is (Data : Project_Data; In_Tree : Project_Tree_Ref); -- List all the source directories of a project - function Suffix_For - (Language : Language_Index; - Naming : Naming_Data; - In_Tree : Project_Tree_Ref) return File_Name_Type; - -- Get the suffix for the source of a language from a package naming. If - -- not specified, return the default for the language. - procedure Warn_If_Not_Sources (Project : Project_Id; In_Tree : Project_Tree_Ref; @@ -2449,287 +2405,6 @@ package body Prj.Nmsc is end loop; end Check_Configuration; - ---------------------- - -- Check_For_Source -- - ---------------------- - - procedure Check_For_Source - (File_Name : File_Name_Type; - Path_Name : Path_Name_Type; - Project : Project_Id; - In_Tree : Project_Tree_Ref; - Data : in out Project_Data; - Location : Source_Ptr; - Language : Language_Index; - Suffix : String; - Naming_Exception : Boolean) - is - Name : String := Get_Name_String (File_Name); - Real_Location : Source_Ptr := Location; - - begin - Canonical_Case_File_Name (Name); - - -- A file is a source of a language if Naming_Exception is True (case - -- of naming exceptions) or if its file name ends with the suffix. - - if Naming_Exception - or else - (Name'Length > Suffix'Length - and then - Name (Name'Last - Suffix'Length + 1 .. Name'Last) = Suffix) - then - if Real_Location = No_Location then - Real_Location := Data.Location; - end if; - - declare - Path_Id : Path_Name_Type; - C_Path_Id : Path_Name_Type; - -- The path name id (in canonical case) - - File_Id : File_Name_Type; - -- The file name id (in canonical case) - - Obj_Id : File_Name_Type; - -- The object file name - - Obj_Path_Id : Path_Name_Type; - -- The object path name - - Dep_Id : File_Name_Type; - -- The dependency file name - - Dep_Path_Id : Path_Name_Type; - -- The dependency path name - - Dot_Pos : Natural := 0; - -- Position of the last dot in Name - - Source : Other_Source; - Source_Id : Other_Source_Id := Data.First_Other_Source; - - begin - -- Get the file name id - - if Osint.File_Names_Case_Sensitive then - File_Id := File_Name; - else - Name_Len := Name'Length; - Name_Buffer (1 .. Name_Len) := Name; - File_Id := Name_Find; - end if; - - -- Get the path name id - - Path_Id := Path_Name; - - if Osint.File_Names_Case_Sensitive then - C_Path_Id := Path_Name; - else - declare - C_Path : String := Get_Name_String (Path_Name); - begin - Canonical_Case_File_Name (C_Path); - Name_Len := C_Path'Length; - Name_Buffer (1 .. Name_Len) := C_Path; - C_Path_Id := Name_Find; - end; - end if; - - -- Find the position of the last dot - - for J in reverse Name'Range loop - if Name (J) = '.' then - Dot_Pos := J; - exit; - end if; - end loop; - - if Dot_Pos <= Name'First then - Dot_Pos := Name'Last + 1; - end if; - - -- Compute the object file name - - Get_Name_String (File_Id); - Name_Len := Dot_Pos - Name'First; - - for J in Object_Suffix'Range loop - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Object_Suffix (J); - end loop; - - Obj_Id := Name_Find; - - -- Compute the object path name - - Get_Name_String (Data.Object_Directory.Display_Name); - - if Name_Buffer (Name_Len) /= Directory_Separator - and then Name_Buffer (Name_Len) /= '/' - then - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Directory_Separator; - end if; - - Add_Str_To_Name_Buffer (Get_Name_String (Obj_Id)); - Obj_Path_Id := Name_Find; - - -- Compute the dependency file name - - Get_Name_String (File_Id); - Name_Len := Dot_Pos - Name'First + 1; - Name_Buffer (Name_Len) := '.'; - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := 'd'; - Dep_Id := Name_Find; - - -- Compute the dependency path name - - Get_Name_String (Data.Object_Directory.Display_Name); - - if Name_Buffer (Name_Len) /= Directory_Separator - and then Name_Buffer (Name_Len) /= '/' - then - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Directory_Separator; - end if; - - Add_Str_To_Name_Buffer (Get_Name_String (Dep_Id)); - Dep_Path_Id := Name_Find; - - -- Check if source is already in the list of source for this - -- project: it may have already been specified as a naming - -- exception for the same language or an other language, or - -- they may be two identical file names in different source - -- directories. - - while Source_Id /= No_Other_Source loop - Source := In_Tree.Other_Sources.Table (Source_Id); - - if Source.File_Name = File_Id then - -- Two sources of different languages cannot have the same - -- file name. - - if Source.Language /= Language then - Error_Msg_File_1 := File_Name; - Error_Msg - (Project, In_Tree, - "{ cannot be a source of several languages", - Real_Location); - return; - - -- No problem if a file has already been specified as - -- a naming exception of this language. - - elsif Source.Path_Name = C_Path_Id then - - -- Reset the naming exception flag, if this is not a - -- naming exception. - - if not Naming_Exception then - In_Tree.Other_Sources.Table - (Source_Id).Naming_Exception := False; - end if; - - return; - - -- There are several files with the same names, but the - -- order of the source directories is known (no /**): - -- only the first one encountered is kept, the other ones - -- are ignored. - - elsif Data.Known_Order_Of_Source_Dirs then - return; - - -- But it is an error if the order of the source directories - -- is not known. - - else - Error_Msg_File_1 := File_Name; - Error_Msg - (Project, In_Tree, - "{ is found in several source directories", - Real_Location); - return; - end if; - - -- Two sources with different file names cannot have the same - -- object file name. - - elsif Source.Object_Name = Obj_Id then - Error_Msg_File_1 := File_Id; - Error_Msg_File_2 := Source.File_Name; - Error_Msg_File_3 := Obj_Id; - Error_Msg - (Project, In_Tree, - "{ and { have the same object file {", - Real_Location); - return; - end if; - - Source_Id := Source.Next; - end loop; - - if Current_Verbosity = High then - Write_Str (" found "); - Display_Language_Name (Language); - Write_Str (" source """); - Write_Str (Get_Name_String (File_Name)); - Write_Line (""""); - Write_Str (" object path = "); - Write_Line (Get_Name_String (Obj_Path_Id)); - end if; - - -- Create the Other_Source record - - Source := - (Language => Language, - File_Name => File_Id, - Path_Name => Path_Id, - Source_TS => File_Stamp (Path_Id), - Object_Name => Obj_Id, - Object_Path => Obj_Path_Id, - Object_TS => File_Stamp (Obj_Path_Id), - Dep_Name => Dep_Id, - Dep_Path => Dep_Path_Id, - Dep_TS => File_Stamp (Dep_Path_Id), - Naming_Exception => Naming_Exception, - Next => No_Other_Source); - - -- And add it to the Other_Sources table - - Other_Source_Table.Increment_Last (In_Tree.Other_Sources); - In_Tree.Other_Sources.Table - (Other_Source_Table.Last (In_Tree.Other_Sources)) := Source; - - -- There are sources of languages other than Ada in this project - - Data.Other_Sources_Present := True; - - -- And there are sources of this language in this project - - Set (Language, True, Data, In_Tree); - - -- Add this source to the list of sources of languages other than - -- Ada of the project. - - if Data.First_Other_Source = No_Other_Source then - Data.First_Other_Source := - Other_Source_Table.Last (In_Tree.Other_Sources); - - else - In_Tree.Other_Sources.Table (Data.Last_Other_Source).Next := - Other_Source_Table.Last (In_Tree.Other_Sources); - end if; - - Data.Last_Other_Source := - Other_Source_Table.Last (In_Tree.Other_Sources); - end; - end if; - end Check_For_Source; - ------------------------------- -- Check_If_Externally_Built -- ------------------------------- @@ -4429,6 +4104,47 @@ package body Prj.Nmsc is end if; end if; + -- Check if Linker'Switches or Linker'Default_Switches are declared. + -- Warn if they are declared, as it is a common error to think that + -- library are "linked" with Linker switches. + + if Data.Library then + declare + Linker_Package_Id : constant Package_Id := + Util.Value_Of + (Name_Linker, Data.Decl.Packages, In_Tree); + Linker_Package : Package_Element; + Switches : Array_Element_Id := No_Array_Element; + + begin + if Linker_Package_Id /= No_Package then + Linker_Package := In_Tree.Packages.Table (Linker_Package_Id); + + Switches := + Value_Of + (Name => Name_Switches, + In_Arrays => Linker_Package.Decl.Arrays, + In_Tree => In_Tree); + + if Switches = No_Array_Element then + Switches := + Value_Of + (Name => Name_Default_Switches, + In_Arrays => Linker_Package.Decl.Arrays, + In_Tree => In_Tree); + end if; + + if Switches /= No_Array_Element then + Error_Msg + (Project, In_Tree, + "?Linker switches not taken into account in library " & + "projects", + No_Location); + end if; + end if; + end; + end if; + if Data.Extends /= No_Project then In_Tree.Projects.Table (Data.Extends).Library := False; end if; @@ -4683,11 +4399,8 @@ package body Prj.Nmsc is (Name => Name_Ada, Next => No_Name_List); -- Attribute Languages is not specified. So, it defaults to - -- a project of language Ada only. - - Data.Langs (Ada_Language_Index) := True; - - -- No sources of languages other than Ada + -- a project of language Ada only. No sources of languages + -- other than Ada Data.Other_Sources_Present := False; @@ -4757,13 +4470,10 @@ package body Prj.Nmsc is NL_Id : Name_List_Index := No_Name_List; begin - if Get_Mode = Ada_Only then - - -- Assume that there is no language specified yet + -- Assume there are no language declared - Data.Other_Sources_Present := False; - Data.Ada_Sources_Present := False; - end if; + Data.Ada_Sources_Present := False; + Data.Other_Sources_Present := False; -- If there are no languages declared, there are no sources @@ -4820,21 +4530,9 @@ package body Prj.Nmsc is (Lang_Name, No_Name_List); if Get_Mode = Ada_Only then - Index := Language_Indexes.Get (Lang_Name); - - if Index = No_Language_Index then - Add_Language_Name (Lang_Name); - Index := Last_Language_Index; - end if; - - Set (Index, True, Data, In_Tree); - Set (Language_Processing => - Default_Language_Processing_Data, - For_Language => Index, - In_Project => Data, - In_Tree => In_Tree); + -- Check for language Ada - if Index = Ada_Language_Index then + if Lang_Name = Name_Ada then Data.Ada_Sources_Present := True; else @@ -5936,155 +5634,6 @@ package body Prj.Nmsc is end Find_Ada_Sources; - ------------------ - -- Find_Sources -- - ------------------ - - procedure Find_Sources - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Data : in out Project_Data; - For_Language : Language_Index; - Current_Dir : String) - is - Source_Dir : String_List_Id; - Element : String_Element; - Dir : Dir_Type; - Current_Source : String_List_Id := Nil_String; - Source_Recorded : Boolean := False; - - begin - if Current_Verbosity = High then - Write_Line ("Looking for sources:"); - end if; - - -- Loop through subdirectories - - Source_Dir := Data.Source_Dirs; - while Source_Dir /= Nil_String loop - begin - Source_Recorded := False; - Element := In_Tree.String_Elements.Table (Source_Dir); - - if Element.Value /= No_Name then - Get_Name_String (Element.Display_Value); - - declare - Source_Directory : constant String := - Name_Buffer (1 .. Name_Len) & - Directory_Separator; - - Dir_Last : constant Natural := - Compute_Directory_Last (Source_Directory); - - begin - if Current_Verbosity = High then - Write_Str ("Source_Dir = "); - Write_Line (Source_Directory); - end if; - - -- We look to every entry in the source directory - - Open (Dir, Source_Directory - (Source_Directory'First .. Dir_Last)); - - loop - Read (Dir, Name_Buffer, Name_Len); - - if Current_Verbosity = High then - Write_Str (" Checking "); - Write_Line (Name_Buffer (1 .. Name_Len)); - end if; - - exit when Name_Len = 0; - - declare - File_Name : constant File_Name_Type := Name_Find; - Path : constant String := - Normalize_Pathname - (Name => Name_Buffer (1 .. Name_Len), - Directory => Source_Directory - (Source_Directory'First .. Dir_Last), - Resolve_Links => Opt.Follow_Links_For_Files, - Case_Sensitive => True); - Path_Name : Path_Name_Type; - - begin - Name_Len := Path'Length; - Name_Buffer (1 .. Name_Len) := Path; - Path_Name := Name_Find; - - if For_Language = Ada_Language_Index then - - -- We attempt to register it as a source. However, - -- there is no error if the file does not contain - -- a valid source. But there is an error if we have - -- a duplicate unit name. - - Record_Ada_Source - (File_Name => File_Name, - Path_Name => Path_Name, - Project => Project, - In_Tree => In_Tree, - Data => Data, - Location => No_Location, - Current_Source => Current_Source, - Source_Recorded => Source_Recorded, - Current_Dir => Current_Dir); - - else - Check_For_Source - (File_Name => File_Name, - Path_Name => Path_Name, - Project => Project, - In_Tree => In_Tree, - Data => Data, - Location => No_Location, - Language => For_Language, - Suffix => - Body_Suffix_Of (For_Language, Data, In_Tree), - Naming_Exception => False); - end if; - end; - end loop; - - Close (Dir); - end; - end if; - - exception - when Directory_Error => - null; - end; - - if Source_Recorded then - In_Tree.String_Elements.Table (Source_Dir).Flag := - True; - end if; - - Source_Dir := Element.Next; - end loop; - - if Current_Verbosity = High then - Write_Line ("end Looking for sources."); - end if; - - if For_Language = Ada_Language_Index then - - -- If we have looked for sources and found none, then it is an error, - -- except if it is an extending project. If a non extending project - -- is not supposed to contain any source files, then never call - -- Find_Sources. - - if Current_Source /= Nil_String then - Data.Ada_Sources_Present := True; - - elsif Data.Extends = No_Project then - Report_No_Sources (Project, "Ada", In_Tree, Data.Location); - end if; - end if; - end Find_Sources; - -------------------------------- -- Free_Ada_Naming_Exceptions -- -------------------------------- @@ -6556,7 +6105,7 @@ package body Prj.Nmsc is -- We set the object directory to its default - Data.Object_Directory := Data.Directory; + Data.Object_Directory := Data.Directory; if Object_Dir.Value /= Empty_String then Get_Name_String (Object_Dir.Value); @@ -6621,7 +6170,7 @@ package body Prj.Nmsc is (Project, In_Tree, Name_Find, - Data.Directory.Name, + Data.Directory.Display_Name, Data.Object_Directory.Name, Data.Object_Directory.Display_Name, Create => "object", @@ -6664,7 +6213,7 @@ package body Prj.Nmsc is (Project, In_Tree, File_Name_Type (Exec_Dir.Value), - Data.Directory.Name, + Data.Directory.Display_Name, Data.Exec_Directory.Name, Data.Exec_Directory.Display_Name, Create => "exec", @@ -6762,7 +6311,7 @@ package body Prj.Nmsc is Data.Object_Directory := No_Path_Information; end if; - Data.Source_Dirs := Nil_String; + Data.Source_Dirs := Nil_String; else declare @@ -6774,8 +6323,7 @@ package body Prj.Nmsc is Source_Dir := Source_Dirs.Values; while Source_Dir /= Nil_String loop - Element := - In_Tree.String_Elements.Table (Source_Dir); + Element := In_Tree.String_Elements.Table (Source_Dir); Find_Source_Dirs (File_Name_Type (Element.Value), Element.Location); Source_Dir := Element.Next; @@ -6795,8 +6343,7 @@ package body Prj.Nmsc is Source_Dir := Excluded_Source_Dirs.Values; while Source_Dir /= Nil_String loop - Element := - In_Tree.String_Elements.Table (Source_Dir); + Element := In_Tree.String_Elements.Table (Source_Dir); Find_Source_Dirs (File_Name_Type (Element.Value), Element.Location, @@ -6900,6 +6447,7 @@ package body Prj.Nmsc is if not Prj.Util.Is_Valid (File) then Error_Msg (Project, In_Tree, "file does not exist", Location); + else -- Read the lines one by one @@ -7005,9 +6553,9 @@ package body Prj.Nmsc is Last : Natural := File'Last; Standard_GNAT : Boolean; Spec : constant File_Name_Type := - Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming); + Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming); Body_Suff : constant File_Name_Type := - Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming); + Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming); begin Standard_GNAT := Spec = Default_Ada_Spec_Suffix @@ -7606,8 +7154,7 @@ package body Prj.Nmsc is --------------------------- procedure Find_Explicit_Sources - (Lang : Language_Index; - Current_Dir : String; + (Current_Dir : String; Project : Project_Id; In_Tree : Project_Tree_Ref; Data : in out Project_Data) @@ -7654,18 +7201,9 @@ package body Prj.Nmsc is Data.Ada_Sources_Present := Current /= Nil_String; end if; - -- If we are processing other languages in the case of gprmake, - -- we should not reset the list of sources, which was already - -- initialized for the Ada files. - - if Get_Mode /= Ada_Only or else Lang /= Ada_Language_Index then + if Get_Mode = Multi_Language then if Current = Nil_String then - case Get_Mode is - when Ada_Only => - Data.Source_Dirs := Nil_String; - when Multi_Language => - Data.First_Language_Processing := No_Language_Index; - end case; + Data.First_Language_Processing := No_Language_Index; -- This project contains no source. For projects that -- don't extend other projects, this also means that @@ -7743,17 +7281,8 @@ package body Prj.Nmsc is end loop; if Get_Mode = Ada_Only then - if Lang = Ada_Language_Index then - Get_Path_Names_And_Record_Ada_Sources - (Project, In_Tree, Data, Current_Dir); - else - Record_Other_Sources - (Project => Project, - In_Tree => In_Tree, - Data => Data, - Language => Lang, - Naming_Exceptions => False); - end if; + Get_Path_Names_And_Record_Ada_Sources + (Project, In_Tree, Data, Current_Dir); end if; end; @@ -7787,18 +7316,8 @@ package body Prj.Nmsc is if Get_Mode = Ada_Only then -- Look in the source directories to find those sources - if Lang = Ada_Language_Index then - Get_Path_Names_And_Record_Ada_Sources - (Project, In_Tree, Data, Current_Dir); - - else - Record_Other_Sources - (Project => Project, - In_Tree => In_Tree, - Data => Data, - Language => Lang, - Naming_Exceptions => False); - end if; + Get_Path_Names_And_Record_Ada_Sources + (Project, In_Tree, Data, Current_Dir); end if; end if; end; @@ -7808,22 +7327,9 @@ package body Prj.Nmsc is -- specified. Find all the files that satisfy the naming -- scheme in all the source directories. - case Get_Mode is - when Ada_Only => - if Lang = Ada_Language_Index then - Find_Ada_Sources (Project, In_Tree, Data, Current_Dir); - else - -- Find all the files that satisfy the naming scheme in - -- all the source directories. All the naming exceptions - -- that effectively exist are also part of the source - -- of this language. - - Find_Sources (Project, In_Tree, Data, Lang, Current_Dir); - end if; - - when Multi_Language => - null; - end case; + if Get_Mode = Ada_Only then + Find_Ada_Sources (Project, In_Tree, Data, Current_Dir); + end if; end if; if Get_Mode = Multi_Language then @@ -7888,7 +7394,6 @@ package body Prj.Nmsc is end if; if Get_Mode = Ada_Only - and then Lang = Ada_Language_Index and then Data.Extends = No_Project then -- We should have found at least one source, if not report an error @@ -8829,9 +8334,6 @@ package body Prj.Nmsc is procedure Remove_Locally_Removed_Files_From_Units; -- Mark all locally removed sources as such in the Units table - procedure Process_Other_Sources_In_Ada_Only_Mode; - -- Find sources for language other than Ada when in Ada_Only mode - procedure Process_Sources_In_Multi_Language_Mode; -- Find all source files when in multi language mode @@ -8896,116 +8398,6 @@ package body Prj.Nmsc is end Remove_Locally_Removed_Files_From_Units; -------------------------------------------- - -- Process_Other_Sources_In_Ada_Only_Mode -- - -------------------------------------------- - - procedure Process_Other_Sources_In_Ada_Only_Mode is - begin - -- Set Source_Present to False. It will be set back to True - -- whenever a source is found. - - Data.Other_Sources_Present := False; - for Lang in Ada_Language_Index + 1 .. Last_Language_Index loop - - -- For each language (other than Ada) in the project file - - if Is_Present (Lang, Data, In_Tree) then - - -- Reset the indication that there are sources of this - -- language. It will be set back to True whenever we find - -- a source of the language. - - Set (Lang, False, Data, In_Tree); - - -- First, get the source suffix for the language - - Set (Suffix => Suffix_For (Lang, Data.Naming, In_Tree), - For_Language => Lang, - In_Project => Data, - In_Tree => In_Tree); - - -- Then, deal with the naming exceptions, if any - - Source_Names.Reset; - - declare - Naming_Exceptions : constant Variable_Value := - Value_Of - (Index => Language_Names.Table (Lang), - Src_Index => 0, - In_Array => Data.Naming.Implementation_Exceptions, - In_Tree => In_Tree); - Element_Id : String_List_Id; - Element : String_Element; - File_Id : File_Name_Type; - Source_Found : Boolean := False; - - begin - -- If there are naming exceptions, look through them one - -- by one. - - if Naming_Exceptions /= Nil_Variable_Value then - Element_Id := Naming_Exceptions.Values; - - while Element_Id /= Nil_String loop - Element := In_Tree.String_Elements.Table (Element_Id); - - if Osint.File_Names_Case_Sensitive then - File_Id := File_Name_Type (Element.Value); - else - Get_Name_String (Element.Value); - Canonical_Case_File_Name - (Name_Buffer (1 .. Name_Len)); - File_Id := Name_Find; - end if; - - -- Put each naming exception in the Source_Names hash - -- table, but if there are repetition, don't bother - -- after the first instance. - - if Source_Names.Get (File_Id) = No_Name_Location then - Source_Found := True; - Source_Names.Set - (File_Id, - (Name => File_Id, - Location => Element.Location, - Source => No_Source, - Except => False, - Found => False)); - end if; - - Element_Id := Element.Next; - end loop; - - -- If there is at least one naming exception, record - -- those that are found in the source directories. - - if Source_Found then - Record_Other_Sources - (Project => Project, - In_Tree => In_Tree, - Data => Data, - Language => Lang, - Naming_Exceptions => True); - end if; - - end if; - end; - - -- Now, check if a list of sources is declared either through - -- a string list (attribute Source_Files) or a text file - -- (attribute Source_List_File). If a source list is declared, - -- we will consider only those naming exceptions that are - -- on the list. - - Source_Names.Reset; - Find_Explicit_Sources - (Lang, Current_Dir, Project, In_Tree, Data); - end if; - end loop; - end Process_Other_Sources_In_Ada_Only_Mode; - - -------------------------------------------- -- Process_Sources_In_Multi_Language_Mode -- -------------------------------------------- @@ -9077,7 +8469,7 @@ package body Prj.Nmsc is end loop; Find_Explicit_Sources - (Ada_Language_Index, Current_Dir, Project, In_Tree, Data); + (Current_Dir, Project, In_Tree, Data); -- Mark as such the sources that are declared as excluded @@ -9219,15 +8611,10 @@ package body Prj.Nmsc is case Get_Mode is when Ada_Only => if Is_A_Language (In_Tree, Data, Name_Ada) then - Find_Explicit_Sources - (Ada_Language_Index, Current_Dir, Project, In_Tree, Data); + Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data); Remove_Locally_Removed_Files_From_Units; end if; - if Data.Other_Sources_Present then - Process_Other_Sources_In_Ada_Only_Mode; - end if; - when Multi_Language => if Data.First_Language_Processing /= No_Language_Index then Process_Sources_In_Multi_Language_Mode; @@ -9456,7 +8843,6 @@ package body Prj.Nmsc is if Current_Source = Nil_String then Data.Ada_Sources := String_Element_Table.Last (In_Tree.String_Elements); - Data.Sources := Data.Ada_Sources; else In_Tree.String_Elements.Table (Current_Source).Next := String_Element_Table.Last (In_Tree.String_Elements); @@ -9531,7 +8917,6 @@ package body Prj.Nmsc is then if Previous_Source = Nil_String then Data.Ada_Sources := Nil_String; - Data.Sources := Nil_String; else In_Tree.String_Elements.Table (Previous_Source).Next := Nil_String; @@ -9624,179 +9009,6 @@ package body Prj.Nmsc is end if; end Record_Ada_Source; - -------------------------- - -- Record_Other_Sources -- - -------------------------- - - procedure Record_Other_Sources - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Data : in out Project_Data; - Language : Language_Index; - Naming_Exceptions : Boolean) - is - Source_Dir : String_List_Id; - Element : String_Element; - Path : Path_Name_Type; - Dir : Dir_Type; - Canonical_Name : File_Name_Type; - Name_Str : String (1 .. 1_024); - Last : Natural := 0; - NL : Name_Location; - First_Error : Boolean := True; - Suffix : constant String := - Body_Suffix_Of (Language, Data, In_Tree); - - begin - Source_Dir := Data.Source_Dirs; - while Source_Dir /= Nil_String loop - Element := In_Tree.String_Elements.Table (Source_Dir); - - declare - Dir_Path : constant String := - Get_Name_String (Element.Display_Value); - begin - if Current_Verbosity = High then - Write_Str ("checking directory """); - Write_Str (Dir_Path); - Write_Str (""" for "); - - if Naming_Exceptions then - Write_Str ("naming exceptions"); - else - Write_Str ("sources"); - end if; - - Write_Str (" of Language "); - Display_Language_Name (Language); - end if; - - Open (Dir, Dir_Path); - - loop - Read (Dir, Name_Str, Last); - exit when Last = 0; - - if Is_Regular_File - (Dir_Path & Directory_Separator & Name_Str (1 .. Last)) - then - Name_Len := Last; - Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Canonical_Name := Name_Find; - NL := Source_Names.Get (Canonical_Name); - - if NL /= No_Name_Location then - if NL.Found then - if not Data.Known_Order_Of_Source_Dirs then - Error_Msg_File_1 := Canonical_Name; - Error_Msg - (Project, In_Tree, - "{ is found in several source directories", - NL.Location); - end if; - - else - NL.Found := True; - Source_Names.Set (Canonical_Name, NL); - Name_Len := Dir_Path'Length; - Name_Buffer (1 .. Name_Len) := Dir_Path; - Add_Char_To_Name_Buffer (Directory_Separator); - Add_Str_To_Name_Buffer (Name_Str (1 .. Last)); - Path := Name_Find; - - Check_For_Source - (File_Name => Canonical_Name, - Path_Name => Path, - Project => Project, - In_Tree => In_Tree, - Data => Data, - Location => NL.Location, - Language => Language, - Suffix => Suffix, - Naming_Exception => Naming_Exceptions); - end if; - end if; - end if; - end loop; - - Close (Dir); - end; - - Source_Dir := Element.Next; - end loop; - - if not Naming_Exceptions then - NL := Source_Names.Get_First; - - -- It is an error if a source file name in a source list or - -- in a source list file is not found. - - while NL /= No_Name_Location loop - if not NL.Found then - Err_Vars.Error_Msg_File_1 := NL.Name; - - if First_Error then - Error_Msg - (Project, In_Tree, "source file { cannot be found", - NL.Location); - First_Error := False; - - else - Error_Msg - (Project, In_Tree, "\source file { cannot be found", - NL.Location); - end if; - end if; - - NL := Source_Names.Get_Next; - end loop; - - -- Any naming exception of this language that is not in a list - -- of sources must be removed. - - declare - Source_Id : Other_Source_Id; - Prev_Id : Other_Source_Id; - Source : Other_Source; - - begin - Prev_Id := No_Other_Source; - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := In_Tree.Other_Sources.Table (Source_Id); - - if Source.Language = Language - and then Source.Naming_Exception - then - if Current_Verbosity = High then - Write_Str ("Naming exception """); - Write_Str (Get_Name_String (Source.File_Name)); - Write_Str (""" is not in the list of sources,"); - Write_Line (" so it is removed."); - end if; - - if Prev_Id = No_Other_Source then - Data.First_Other_Source := Source.Next; - else - In_Tree.Other_Sources.Table (Prev_Id).Next := Source.Next; - end if; - - Source_Id := Source.Next; - - if Source_Id = No_Other_Source then - Data.Last_Other_Source := Prev_Id; - end if; - - else - Prev_Id := Source_Id; - Source_Id := Source.Next; - end if; - end loop; - end; - end if; - end Record_Other_Sources; - ------------------- -- Remove_Source -- ------------------- @@ -9971,52 +9183,6 @@ package body Prj.Nmsc is Write_Line ("end Source_Dirs."); end Show_Source_Dirs; - ---------------- - -- Suffix_For -- - ---------------- - - function Suffix_For - (Language : Language_Index; - Naming : Naming_Data; - In_Tree : Project_Tree_Ref) return File_Name_Type - is - Suffix : constant Variable_Value := - Value_Of - (Index => Language_Names.Table (Language), - Src_Index => 0, - In_Array => Naming.Body_Suffix, - In_Tree => In_Tree); - - begin - -- If no suffix for this language in package Naming, use the default - - if Suffix = Nil_Variable_Value then - Name_Len := 0; - - case Language is - when Ada_Language_Index => - Add_Str_To_Name_Buffer (".adb"); - - when C_Language_Index => - Add_Str_To_Name_Buffer (".c"); - - when C_Plus_Plus_Language_Index => - Add_Str_To_Name_Buffer (".cpp"); - - when others => - return No_File; - end case; - - -- Otherwise use the one specified - - else - Get_Name_String (Suffix.Value); - end if; - - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - return Name_Find; - end Suffix_For; - ------------------------- -- Warn_If_Not_Sources -- ------------------------- diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 67c913378dd..901875ad204 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -149,6 +149,30 @@ package body Prj.Part is -- does not (because it is already extended), but other projects that it -- imports may need to be virtually extended. + type Extension_Origin is (None, Extending_Simple, Extending_All); + -- Type of parameter From_Extended for procedures Parse_Single_Project and + -- Post_Parse_Context_Clause. Extending_All means that we are parsing the + -- tree rooted at an extending all project. + + procedure Parse_Single_Project + (In_Tree : Project_Node_Tree_Ref; + Project : out Project_Node_Id; + Extends_All : out Boolean; + Path_Name : String; + Extended : Boolean; + From_Extended : Extension_Origin; + In_Limited : Boolean; + Packages_To_Check : String_List_Access; + Depth : Natural; + Current_Dir : String); + -- Parse a project file. + -- Recursive procedure: it calls itself for imported and extended + -- projects. When From_Extended is not None, if the project has already + -- been parsed and is an extended project A, return the ultimate + -- (not extended) project that extends A. When In_Limited is True, + -- the importing path includes at least one "limited with". + -- When parsing configuration projects, do not allow a depth > 1. + procedure Pre_Parse_Context_Clause (In_Tree : Project_Node_Tree_Ref; Context_Clause : out With_Id); diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads index 8e366bc4fff..e1c69c5ab83 100644 --- a/gcc/ada/prj-part.ads +++ b/gcc/ada/prj-part.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2008, 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- -- @@ -49,28 +49,4 @@ package Prj.Part is -- Current_Directory is used for optimization purposes only, avoiding extra -- system calls. - type Extension_Origin is (None, Extending_Simple, Extending_All); - -- Type of parameter From_Extended for procedures Parse_Single_Project and - -- Post_Parse_Context_Clause. Extending_All means that we are parsing the - -- tree rooted at an extending all project. - - procedure Parse_Single_Project - (In_Tree : Project_Node_Tree_Ref; - Project : out Project_Node_Id; - Extends_All : out Boolean; - Path_Name : String; - Extended : Boolean; - From_Extended : Extension_Origin; - In_Limited : Boolean; - Packages_To_Check : String_List_Access; - Depth : Natural; - Current_Dir : String); - -- Parse a project file. - -- Recursive procedure: it calls itself for imported and extended - -- projects. When From_Extended is not None, if the project has already - -- been parsed and is an extended project A, return the ultimate - -- (not extended) project that extends A. When In_Limited is True, - -- the importing path includes at least one "limited with". - -- When parsing configuration projects, do not allow a depth > 1. - end Prj.Part; diff --git a/gcc/ada/prj-util.ads b/gcc/ada/prj-util.ads index e2a9558e5eb..0efdfbb5b03 100644 --- a/gcc/ada/prj-util.ads +++ b/gcc/ada/prj-util.ads @@ -146,14 +146,14 @@ package Prj.Util is -- the last character of each line, if possible. type Text_File is limited private; - -- Represents a text file. Default is invalid text file + -- Represents a text file (default is invalid text file) function Is_Valid (File : Text_File) return Boolean; - -- Returns True if File designates an open text file that - -- has not yet been closed. + -- Returns True if File designates an open text file that has not yet been + -- closed. procedure Open (File : out Text_File; Name : String); - -- Open a text file. If this procedure fails, File is invalid + -- Open a text file to read (file is invalid if text file cannot be opened) function End_Of_File (File : Text_File) return Boolean; -- Returns True if the end of the text file File has been reached. Fails if @@ -163,7 +163,7 @@ package Prj.Util is (File : Text_File; Line : out String; Last : out Natural); - -- Reads a line from an open text file. Fails if File is invalid + -- Reads a line from an open text file (fails if file is invalid) procedure Close (File : in out Text_File); -- Close an open text file. File becomes invalid. Fails if File is already diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index d838b114442..23623f5feda 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -32,9 +32,11 @@ with Prj.Attr; with Prj.Env; with Prj.Err; use Prj.Err; with Snames; use Snames; +with Table; with Uintp; use Uintp; with System.Case_Util; use System.Case_Util; +with System.HTable; package body Prj is @@ -50,8 +52,6 @@ package body Prj is The_Empty_String : Name_Id; - Name_C_Plus_Plus : Name_Id; - Default_Ada_Spec_Suffix_Id : File_Name_Type; Default_Ada_Body_Suffix_Id : File_Name_Type; Slash_Id : Path_Name_Type; @@ -83,9 +83,7 @@ package body Prj is Specs => No_Array_Element, Bodies => No_Array_Element, Specification_Exceptions => No_Array_Element, - Implementation_Exceptions => No_Array_Element, - Impl_Suffixes => No_Impl_Suffixes, - Supp_Suffixes => No_Supp_Language_Index); + Implementation_Exceptions => No_Array_Element); Project_Empty : constant Project_Data := (Qualifier => Unspecified, @@ -113,8 +111,9 @@ package body Prj is Lib_Auto_Init => False, Libgnarl_Needed => Unknown, Symbol_Data => No_Symbols, + Ada_Sources_Present => True, + Other_Sources_Present => True, Ada_Sources => Nil_String, - Sources => Nil_String, First_Source => No_Source, Last_Source => No_Source, Interfaces_Defined => False, @@ -144,25 +143,12 @@ package body Prj is Objects_Path_File_Without_Libs => No_Path, Config_File_Name => No_Path, Config_File_Temp => False, - Linker_Name => No_File, - Linker_Path => No_Path, - Minimum_Linker_Options => No_Name_List, Config_Checked => False, Checked => False, Seen => False, Need_To_Build_Lib => False, Depth => 0, - Unkept_Comments => False, - Langs => No_Languages, - Supp_Languages => No_Supp_Language_Index, - Ada_Sources_Present => True, - Other_Sources_Present => True, - First_Other_Source => No_Other_Source, - Last_Other_Source => No_Other_Source, - First_Lang_Processing => - Default_First_Language_Processing_Data, - Supp_Language_Processing => - No_Supp_Language_Index); + Unkept_Comments => False); package Temp_Files is new Table.Table (Table_Component_Type => Path_Name_Type, @@ -174,18 +160,6 @@ package body Prj is -- Table to store the path name of all the created temporary files, so that -- they can be deleted at the end, or when the program is interrupted. - ----------------------- - -- Add_Language_Name -- - ----------------------- - - procedure Add_Language_Name (Name : Name_Id) is - begin - Last_Language_Index := Last_Language_Index + 1; - Language_Indexes.Set (Name, Last_Language_Index); - Language_Names.Increment_Last; - Language_Names.Table (Last_Language_Index) := Name; - end Add_Language_Name; - ------------------- -- Add_To_Buffer -- ------------------- @@ -341,21 +315,6 @@ package body Prj is return ""; end Body_Suffix_Of; - function Body_Suffix_Of - (Language : Language_Index; - In_Project : Project_Data; - In_Tree : Project_Tree_Ref) return String - is - Suffix_Id : constant File_Name_Type := - Suffix_Of (Language, In_Project, In_Tree); - begin - if Suffix_Id /= No_File then - return Get_Name_String (Suffix_Id); - else - return "." & Get_Name_String (Language_Names.Table (Language)); - end if; - end Body_Suffix_Of; - ----------------------------- -- Default_Ada_Body_Suffix -- ----------------------------- @@ -430,17 +389,6 @@ package body Prj is Write_Str (Name_Buffer (1 .. Name_Len)); end Display_Language_Name; - --------------------------- - -- Display_Language_Name -- - --------------------------- - - procedure Display_Language_Name (Language : Language_Index) is - begin - Get_Name_String (Language_Names.Table (Language)); - To_Upper (Name_Buffer (1 .. 1)); - Write_Str (Name_Buffer (1 .. Name_Len)); - end Display_Language_Name; - ---------------- -- Empty_File -- ---------------- @@ -638,22 +586,12 @@ package body Prj is Name_Len := 1; Name_Buffer (1) := '/'; Slash_Id := Name_Find; - Name_Len := 3; - Name_Buffer (1 .. 3) := "c++"; - Name_C_Plus_Plus := Name_Find; Prj.Env.Initialize; Prj.Attr.Initialize; Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project)); Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends)); Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External)); - - Language_Indexes.Reset; - Last_Language_Index := No_Language_Index; - Language_Names.Init; - Add_Language_Name (Name_Ada); - Add_Language_Name (Name_C); - Add_Language_Name (Name_C_Plus_Plus); end if; if Tree /= No_Project_Tree then @@ -729,84 +667,6 @@ package body Prj is return False; end Is_Extending; - ---------------- - -- Is_Present -- - ---------------- - - function Is_Present - (Language : Language_Index; - In_Project : Project_Data; - In_Tree : Project_Tree_Ref) return Boolean - is - begin - case Language is - when No_Language_Index => - return False; - - when First_Language_Indexes => - return In_Project.Langs (Language); - - when others => - declare - Supp : Supp_Language; - Supp_Index : Supp_Language_Index; - - begin - Supp_Index := In_Project.Supp_Languages; - while Supp_Index /= No_Supp_Language_Index loop - Supp := In_Tree.Present_Languages.Table (Supp_Index); - - if Supp.Index = Language then - return Supp.Present; - end if; - - Supp_Index := Supp.Next; - end loop; - - return False; - end; - end case; - end Is_Present; - - --------------------------------- - -- Language_Processing_Data_Of -- - --------------------------------- - - function Language_Processing_Data_Of - (Language : Language_Index; - In_Project : Project_Data; - In_Tree : Project_Tree_Ref) return Language_Processing_Data - is - begin - case Language is - when No_Language_Index => - return Default_Language_Processing_Data; - - when First_Language_Indexes => - return In_Project.First_Lang_Processing (Language); - - when others => - declare - Supp : Supp_Language_Data; - Supp_Index : Supp_Language_Index; - - begin - Supp_Index := In_Project.Supp_Language_Processing; - while Supp_Index /= No_Supp_Language_Index loop - Supp := In_Tree.Supp_Languages.Table (Supp_Index); - - if Supp.Index = Language then - return Supp.Data; - end if; - - Supp_Index := Supp.Next; - end loop; - - return Default_Language_Processing_Data; - end; - end case; - end Language_Processing_Data_Of; - ----------------------- -- Objects_Exist_For -- ----------------------- @@ -980,13 +840,6 @@ package body Prj is begin Prj.Env.Initialize; - -- gprmake tables - - Present_Language_Table.Init (Tree.Present_Languages); - Supp_Suffix_Table.Init (Tree.Supp_Suffixes); - Supp_Language_Table.Init (Tree.Supp_Languages); - Other_Source_Table.Init (Tree.Other_Sources); - -- Visible tables Language_Data_Table.Init (Tree.Languages_Data); @@ -1040,144 +893,6 @@ package body Prj is and then Left.Separate_Suffix = Right.Separate_Suffix; end Same_Naming_Scheme; - --------- - -- Set -- - --------- - - procedure Set - (Language : Language_Index; - Present : Boolean; - In_Project : in out Project_Data; - In_Tree : Project_Tree_Ref) - is - begin - case Language is - when No_Language_Index => - null; - - when First_Language_Indexes => - In_Project.Langs (Language) := Present; - - when others => - declare - Supp : Supp_Language; - Supp_Index : Supp_Language_Index; - - begin - Supp_Index := In_Project.Supp_Languages; - while Supp_Index /= No_Supp_Language_Index loop - Supp := In_Tree.Present_Languages.Table (Supp_Index); - - if Supp.Index = Language then - In_Tree.Present_Languages.Table (Supp_Index).Present := - Present; - return; - end if; - - Supp_Index := Supp.Next; - end loop; - - Supp := (Index => Language, Present => Present, - Next => In_Project.Supp_Languages); - Present_Language_Table.Increment_Last - (In_Tree.Present_Languages); - Supp_Index := - Present_Language_Table.Last (In_Tree.Present_Languages); - In_Tree.Present_Languages.Table (Supp_Index) := - Supp; - In_Project.Supp_Languages := Supp_Index; - end; - end case; - end Set; - - procedure Set - (Language_Processing : Language_Processing_Data; - For_Language : Language_Index; - In_Project : in out Project_Data; - In_Tree : Project_Tree_Ref) - is - begin - case For_Language is - when No_Language_Index => - null; - - when First_Language_Indexes => - In_Project.First_Lang_Processing (For_Language) := - Language_Processing; - - when others => - declare - Supp : Supp_Language_Data; - Supp_Index : Supp_Language_Index; - - begin - Supp_Index := In_Project.Supp_Language_Processing; - while Supp_Index /= No_Supp_Language_Index loop - Supp := In_Tree.Supp_Languages.Table (Supp_Index); - - if Supp.Index = For_Language then - In_Tree.Supp_Languages.Table - (Supp_Index).Data := Language_Processing; - return; - end if; - - Supp_Index := Supp.Next; - end loop; - - Supp := (Index => For_Language, Data => Language_Processing, - Next => In_Project.Supp_Language_Processing); - Supp_Language_Table.Increment_Last - (In_Tree.Supp_Languages); - Supp_Index := Supp_Language_Table.Last - (In_Tree.Supp_Languages); - In_Tree.Supp_Languages.Table (Supp_Index) := Supp; - In_Project.Supp_Language_Processing := Supp_Index; - end; - end case; - end Set; - - procedure Set - (Suffix : File_Name_Type; - For_Language : Language_Index; - In_Project : in out Project_Data; - In_Tree : Project_Tree_Ref) - is - begin - case For_Language is - when No_Language_Index => - null; - - when First_Language_Indexes => - In_Project.Naming.Impl_Suffixes (For_Language) := Suffix; - - when others => - declare - Supp : Supp_Suffix; - Supp_Index : Supp_Language_Index; - - begin - Supp_Index := In_Project.Naming.Supp_Suffixes; - while Supp_Index /= No_Supp_Language_Index loop - Supp := In_Tree.Supp_Suffixes.Table (Supp_Index); - - if Supp.Index = For_Language then - In_Tree.Supp_Suffixes.Table (Supp_Index).Suffix := Suffix; - return; - end if; - - Supp_Index := Supp.Next; - end loop; - - Supp := (Index => For_Language, Suffix => Suffix, - Next => In_Project.Naming.Supp_Suffixes); - Supp_Suffix_Table.Increment_Last (In_Tree.Supp_Suffixes); - Supp_Index := Supp_Suffix_Table.Last (In_Tree.Supp_Suffixes); - In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp; - In_Project.Naming.Supp_Suffixes := Supp_Index; - end; - end case; - end Set; - --------------------- -- Set_Body_Suffix -- --------------------- @@ -1426,45 +1141,6 @@ package body Prj is end if; end Standard_Naming_Data; - --------------- - -- Suffix_Of -- - --------------- - - function Suffix_Of - (Language : Language_Index; - In_Project : Project_Data; - In_Tree : Project_Tree_Ref) return File_Name_Type - is - begin - case Language is - when No_Language_Index => - return No_File; - - when First_Language_Indexes => - return In_Project.Naming.Impl_Suffixes (Language); - - when others => - declare - Supp : Supp_Suffix; - Supp_Index : Supp_Language_Index; - - begin - Supp_Index := In_Project.Naming.Supp_Suffixes; - while Supp_Index /= No_Supp_Language_Index loop - Supp := In_Tree.Supp_Suffixes.Table (Supp_Index); - - if Supp.Index = Language then - return Supp.Suffix; - end if; - - Supp_Index := Supp.Next; - end loop; - - return No_File; - end; - end case; - end Suffix_Of; - ------------------- -- Switches_Name -- ------------------- @@ -1476,29 +1152,6 @@ package body Prj is return Extend_Name (Source_File_Name, Switches_Dependency_Suffix); end Switches_Name; - --------------------------- - -- There_Are_Ada_Sources -- - --------------------------- - - function There_Are_Ada_Sources - (In_Tree : Project_Tree_Ref; - Project : Project_Id) return Boolean - is - Prj : Project_Id; - - begin - Prj := Project; - while Prj /= No_Project loop - if In_Tree.Projects.Table (Prj).Ada_Sources /= Nil_String then - return True; - end if; - - Prj := In_Tree.Projects.Table (Prj).Extends; - end loop; - - return False; - end There_Are_Ada_Sources; - ----------- -- Value -- ----------- diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 5d8caa79cd3..9af43b388ce 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -32,15 +32,12 @@ with Casing; use Casing; with Namet; use Namet; with Scans; use Scans; -with Table; with Types; use Types; with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables; with GNAT.Dynamic_Tables; with GNAT.OS_Lib; use GNAT.OS_Lib; -with System.HTable; - package Prj is Subdirs_Option : constant String := "--subdirs="; @@ -838,164 +835,6 @@ package Prj is -- Similar to 'Value (but avoid use of this attribute in compiler) -- Raises Constraint_Error if not a Casing_Type image. - -- Declarations for gprmake: - - First_Language_Index : constant Language_Index := 1; - First_Language_Indexes_Last : constant Language_Index := 5; - - Ada_Language_Index : constant Language_Index := - First_Language_Index; - C_Language_Index : constant Language_Index := - Ada_Language_Index + 1; - C_Plus_Plus_Language_Index : constant Language_Index := - C_Language_Index + 1; - - Last_Language_Index : Language_Index := No_Language_Index; - - subtype First_Language_Indexes is Language_Index - range First_Language_Index .. First_Language_Indexes_Last; - - package Language_Indexes is new System.HTable.Simple_HTable - (Header_Num => Header_Num, - Element => Language_Index, - No_Element => No_Language_Index, - Key => Name_Id, - Hash => Hash, - Equal => "="); - -- Mapping of language names to language indexes - - package Language_Names is new Table.Table - (Table_Component_Type => Name_Id, - Table_Index_Type => Language_Index, - Table_Low_Bound => 1, - Table_Initial => 4, - Table_Increment => 100, - Table_Name => "Prj.Language_Names"); - -- The table for the name of programming languages - - procedure Add_Language_Name (Name : Name_Id); - - procedure Display_Language_Name (Language : Language_Index); - - type Languages_In_Project is array (First_Language_Indexes) of Boolean; - -- Set of supported languages used in a project - - No_Languages : constant Languages_In_Project := (others => False); - -- No supported languages are used - - type Supp_Language_Index is new Nat; - No_Supp_Language_Index : constant Supp_Language_Index := 0; - - type Supp_Language is record - Index : Language_Index := No_Language_Index; - Present : Boolean := False; - Next : Supp_Language_Index := No_Supp_Language_Index; - end record; - - package Present_Language_Table is new GNAT.Dynamic_Tables - (Table_Component_Type => Supp_Language, - Table_Index_Type => Supp_Language_Index, - Table_Low_Bound => 1, - Table_Initial => 4, - Table_Increment => 100); - -- The table for the presence of languages with an index that is outside - -- of First_Language_Indexes. - - type Impl_Suffix_Array is array (First_Language_Indexes) of File_Name_Type; - -- Suffixes for the non spec sources of the different supported languages - -- in a project. - - No_Impl_Suffixes : constant Impl_Suffix_Array := (others => No_File); - -- A default value for the non spec source suffixes - - type Supp_Suffix is record - Index : Language_Index := No_Language_Index; - Suffix : File_Name_Type := No_File; - Next : Supp_Language_Index := No_Supp_Language_Index; - end record; - - package Supp_Suffix_Table is new GNAT.Dynamic_Tables - (Table_Component_Type => Supp_Suffix, - Table_Index_Type => Supp_Language_Index, - Table_Low_Bound => 1, - Table_Initial => 4, - Table_Increment => 100); - -- The table for the presence of languages with an index that is outside - -- of First_Language_Indexes. - - type Lang_Kind is (GNU, Other); - - type Language_Processing_Data is record - Compiler_Drivers : Name_List_Index := No_Name_List; - Compiler_Paths : Name_Id := No_Name; - Compiler_Kinds : Lang_Kind := GNU; - Dependency_Options : Name_List_Index := No_Name_List; - Compute_Dependencies : Name_List_Index := No_Name_List; - Include_Options : Name_List_Index := No_Name_List; - Binder_Drivers : Name_Id := No_Name; - Binder_Driver_Paths : Name_Id := No_Name; - end record; - - Default_Language_Processing_Data : - constant Language_Processing_Data := - (Compiler_Drivers => No_Name_List, - Compiler_Paths => No_Name, - Compiler_Kinds => GNU, - Dependency_Options => No_Name_List, - Compute_Dependencies => No_Name_List, - Include_Options => No_Name_List, - Binder_Drivers => No_Name, - Binder_Driver_Paths => No_Name); - - type First_Language_Processing_Data is - array (First_Language_Indexes) of Language_Processing_Data; - - Default_First_Language_Processing_Data : - constant First_Language_Processing_Data := - (others => Default_Language_Processing_Data); - - type Supp_Language_Data is record - Index : Language_Index := No_Language_Index; - Data : Language_Processing_Data := Default_Language_Processing_Data; - Next : Supp_Language_Index := No_Supp_Language_Index; - end record; - - package Supp_Language_Table is new GNAT.Dynamic_Tables - (Table_Component_Type => Supp_Language_Data, - Table_Index_Type => Supp_Language_Index, - Table_Low_Bound => 1, - Table_Initial => 4, - Table_Increment => 100); - -- The table for language data when there are more languages than - -- in First_Language_Indexes. - - type Other_Source_Id is new Nat; - No_Other_Source : constant Other_Source_Id := 0; - - type Other_Source is record - Language : Language_Index; -- language of the source - File_Name : File_Name_Type; -- source file simple name - Path_Name : Path_Name_Type; -- source full path name - Source_TS : Time_Stamp_Type; -- source file time stamp - Object_Name : File_Name_Type; -- object file simple name - Object_Path : Path_Name_Type; -- object full path name - Object_TS : Time_Stamp_Type; -- object file time stamp - Dep_Name : File_Name_Type; -- dependency file simple name - Dep_Path : Path_Name_Type; -- dependency full path name - Dep_TS : Time_Stamp_Type; -- dependency file time stamp - Naming_Exception : Boolean := False; -- True if a naming exception - Next : Other_Source_Id := No_Other_Source; - end record; - -- Data for a source in a language other than Ada - - package Other_Source_Table is new GNAT.Dynamic_Tables - (Table_Component_Type => Other_Source, - Table_Index_Type => Other_Source_Id, - Table_Low_Bound => 1, - Table_Initial => 200, - Table_Increment => 100); - -- The table for sources of languages other than Ada - -- The following record contains data for a naming scheme type Naming_Data is record @@ -1044,10 +883,6 @@ package Prj is -- An associative array listing body file names that do not have the -- body suffix. Not used by Ada. Indexed by programming language name. - -- For gprmake: - - Impl_Suffixes : Impl_Suffix_Array := No_Impl_Suffixes; - Supp_Suffixes : Supp_Language_Index := No_Supp_Language_Index; end record; function Spec_Suffix_Of @@ -1407,12 +1242,15 @@ package Prj is -- Sources -- ------------- + Ada_Sources_Present : Boolean := True; + -- True if there are Ada sources in the project + + Other_Sources_Present : Boolean := True; + -- True if there are non-Ada sources in the project + Ada_Sources : String_List_Id := Nil_String; -- The list of all the Ada source file names (gnatmake only) - Sources : String_List_Id := Nil_String; - -- Identical to Ada_Sources (for upward compatibility with GPS) - First_Source : Source_Id := No_Source; Last_Source : Source_Id := No_Source; -- Head and tail of the list of sources @@ -1451,20 +1289,6 @@ package Prj is -- use this field directly outside of the project manager, use -- Prj.Env.Ada_Include_Path instead. - ------------- - -- Linking -- - ------------- - - Linker_Name : File_Name_Type := No_File; - -- Value of attribute Language_Processing'Linker in the project file - - Linker_Path : Path_Name_Type := No_Path; - -- Path of linker when attribute Language_Processing'Linker is specified - - Minimum_Linker_Options : Name_List_Index := No_Name_List; - -- List of options specified in attribute - -- Language_Processing'Minimum_Linker_Options. - ------------------- -- Miscellaneous -- ------------------- @@ -1515,32 +1339,6 @@ package Prj is -- True if there are comments in the project sources that cannot be kept -- in the project tree. - ------------------ - -- For gprmake -- - ------------------ - - Langs : Languages_In_Project := No_Languages; - Supp_Languages : Supp_Language_Index := No_Supp_Language_Index; - -- Indicate the different languages of the source of this project - - Ada_Sources_Present : Boolean := True; - -- True if there are Ada sources in the project - - Other_Sources_Present : Boolean := True; - -- True if there are sources from languages other than Ada in the - -- project. - - First_Other_Source : Other_Source_Id := No_Other_Source; - -- First source of a language other than Ada - - Last_Other_Source : Other_Source_Id := No_Other_Source; - -- Last source of a language other than Ada - - First_Lang_Processing : First_Language_Processing_Data := - Default_First_Language_Processing_Data; - Supp_Language_Processing : Supp_Language_Index := - No_Supp_Language_Index; - -- Language configurations end record; function Empty_Project (Tree : Project_Tree_Ref) return Project_Data; @@ -1560,12 +1358,6 @@ package Prj is -- Return True when Language_Name (which must be lower case) is one of the -- languages used for the project. - function There_Are_Ada_Sources - (In_Tree : Project_Tree_Ref; - Project : Project_Id) return Boolean; - -- ??? needs comment - -- ??? Name sounds strange, suggested replacement: Ada_Sources_Present - Project_Error : exception; -- Raised by some subprograms in Prj.Attr @@ -1664,13 +1456,6 @@ package Prj is Files_HT : Files_Htable.Instance; Source_Paths_HT : Source_Paths_Htable.Instance; - -- For gprmake: - - Present_Languages : Present_Language_Table.Instance; - Supp_Suffixes : Supp_Suffix_Table.Instance; - Supp_Languages : Supp_Language_Table.Instance; - Other_Sources : Other_Source_Table.Instance; - -- Private part Private_Part : Private_Project_Tree_Data; @@ -1743,59 +1528,6 @@ package Prj is (Source_File_Name : File_Name_Type) return File_Name_Type; -- Returns the switches file name corresponding to a source file name - -- For gprmake - - function Body_Suffix_Of - (Language : Language_Index; - In_Project : Project_Data; - In_Tree : Project_Tree_Ref) return String; - -- Returns the suffix of sources of language Language in project In_Project - -- in project tree In_Tree. - - function Is_Present - (Language : Language_Index; - In_Project : Project_Data; - In_Tree : Project_Tree_Ref) return Boolean; - -- Return True when Language is one of the languages used in - -- project In_Project. - - procedure Set - (Language : Language_Index; - Present : Boolean; - In_Project : in out Project_Data; - In_Tree : Project_Tree_Ref); - -- Indicate if Language is or not a language used in project In_Project - - function Language_Processing_Data_Of - (Language : Language_Index; - In_Project : Project_Data; - In_Tree : Project_Tree_Ref) return Language_Processing_Data; - -- Return the Language_Processing_Data for language Language in project - -- In_Project. Return the default when no Language_Processing_Data are - -- defined for the language. - - procedure Set - (Language_Processing : Language_Processing_Data; - For_Language : Language_Index; - In_Project : in out Project_Data; - In_Tree : Project_Tree_Ref); - -- Set the Language_Processing_Data for language Language in project - -- In_Project. - - function Suffix_Of - (Language : Language_Index; - In_Project : Project_Data; - In_Tree : Project_Tree_Ref) return File_Name_Type; - -- Return the suffix for language Language in project In_Project. Return - -- No_Name when no suffix is defined for the language. - - procedure Set - (Suffix : File_Name_Type; - For_Language : Language_Index; - In_Project : in out Project_Data; - In_Tree : Project_Tree_Ref); - -- Set the suffix for language Language in project In_Project - ---------------- -- Temp Files -- ---------------- diff --git a/gcc/ada/s-direio.adb b/gcc/ada/s-direio.adb index c764a1c658e..8a6dd435e7c 100644 --- a/gcc/ada/s-direio.adb +++ b/gcc/ada/s-direio.adb @@ -251,9 +251,12 @@ package body System.Direct_IO is ----------- procedure Reset (File : in out File_Type; Mode : FCB.File_Mode) is - pragma Unmodified (File); + pragma Warnings (Off, File); -- File is actually modified via Unrestricted_Access below, but -- GNAT will generate a warning anyway. + -- Note that we do not use pragma Unmodified here, since in -gnatc + -- mode, GNAT will complain that File is modified for + -- "File.Index := 1;" begin FIO.Reset (AP (File)'Unrestricted_Access, Mode); @@ -262,9 +265,8 @@ package body System.Direct_IO is end Reset; procedure Reset (File : in out File_Type) is - pragma Unmodified (File); - -- File is actually modified via Unrestricted_Access below, but - -- GNAT will generate a warning anyway. + pragma Warnings (Off, File); + -- See above (other Reset procedure) for explanations on this pragma begin FIO.Reset (AP (File)'Unrestricted_Access); diff --git a/gcc/ada/s-finimp.ads b/gcc/ada/s-finimp.ads index 5bd1be1f8fd..7895326f85f 100644 --- a/gcc/ada/s-finimp.ads +++ b/gcc/ada/s-finimp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -66,7 +66,7 @@ package System.Finalization_Implementation is -- packages. They will be finalized after the main program completion. procedure Finalize_Global_List; - -- The procedure to be called in order to finalize the global list; + -- The procedure to be called in order to finalize the global list procedure Attach_To_Final_List (L : in out SFR.Finalizable_Ptr; @@ -102,7 +102,7 @@ package System.Finalization_Implementation is -- return object to the caller's finalization list. procedure Finalize_List (L : SFR.Finalizable_Ptr); - -- Call Finalize on each element of the list L; + -- Call Finalize on each element of the list L procedure Finalize_One (Obj : in out SFR.Finalizable); -- Call Finalize on Obj and remove its final list diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 5655b3c0d7c..6df7fa4a7c8 100755 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -792,9 +792,9 @@ package body System.OS_Lib is -- If it is not a digit, then there are no available -- temp file names. Return Invalid_FD. There is almost - -- no that this code will be ever be executed, since - -- it would mean that there are one million temp files - -- in the same directory! + -- no chance that this code will be ever be executed, + -- since it would mean that there are one million temp + -- files in the same directory! SSL.Unlock_Task.all; FD := Invalid_FD; diff --git a/gcc/ada/s-parame-vxworks.adb b/gcc/ada/s-parame-vxworks.adb index 240a9d8f716..21838ddcc41 100644 --- a/gcc/ada/s-parame-vxworks.adb +++ b/gcc/ada/s-parame-vxworks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -31,7 +31,7 @@ -- -- ------------------------------------------------------------------------------ --- Version used on all VxWorks and Nucleus targets +-- Version used on all VxWorks, Nucleus, and RTX RTSS targets package body System.Parameters is diff --git a/gcc/ada/s-regexp.ads b/gcc/ada/s-regexp.ads index d114f0d0ae6..a1f9bf732cf 100755 --- a/gcc/ada/s-regexp.ads +++ b/gcc/ada/s-regexp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2007, AdaCore -- +-- Copyright (C) 1998-2008, AdaCore -- -- -- -- 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- -- @@ -109,7 +109,7 @@ package System.Regexp is Glob : Boolean := False; Case_Sensitive : Boolean := True) return Regexp; -- Compiles a regular expression S. If the syntax of the given - -- expression is invalid (does not match above grammar, Error_In_Regexp + -- expression is invalid (does not match above grammar), Error_In_Regexp -- is raised. If Glob is True, the pattern is considered as a 'globbing -- pattern', that is a pattern as given by the second grammar above. -- As a special case, if Pattern is the empty string it will always diff --git a/gcc/ada/s-stausa.adb b/gcc/ada/s-stausa.adb index 700c685ea27..d9b972d8b28 100644 --- a/gcc/ada/s-stausa.adb +++ b/gcc/ada/s-stausa.adb @@ -258,20 +258,29 @@ package body System.Stack_Usage is -- big, the more an "instrumentation threshold at writing" error is -- likely to happen. - Current_Stack_Level : aliased Integer; + Stack_Used_When_Filling : Integer; + Current_Stack_Level : aliased Integer; begin -- Readjust the pattern size. When we arrive in this function, there is -- already a given amount of stack used, that we won't analyze. - Analyzer.Stack_Used_When_Filling := + Stack_Used_When_Filling := Stack_Size (Analyzer.Bottom_Of_Stack, To_Stack_Address (Current_Stack_Level'Address)) + Natural (Current_Stack_Level'Size); - Analyzer.Pattern_Size := - Analyzer.Pattern_Size - Analyzer.Stack_Used_When_Filling; + if Stack_Used_When_Filling > Analyzer.Pattern_Size then + -- In this case, the known size of the stack is too small, we've + -- already taken more than expected, so there's no possible + -- computation + + Analyzer.Pattern_Size := 0; + else + Analyzer.Pattern_Size := + Analyzer.Pattern_Size - Stack_Used_When_Filling; + end if; declare Stack : aliased Stack_Slots @@ -282,10 +291,15 @@ package body System.Stack_Usage is Analyzer.Stack_Overlay_Address := Stack'Address; - Analyzer.Bottom_Pattern_Mark := - To_Stack_Address (Stack (Bottom_Slot_Index_In (Stack))'Address); - Analyzer.Top_Pattern_Mark := - To_Stack_Address (Stack (Top_Slot_Index_In (Stack))'Address); + if Analyzer.Pattern_Size /= 0 then + Analyzer.Bottom_Pattern_Mark := + To_Stack_Address (Stack (Bottom_Slot_Index_In (Stack))'Address); + Analyzer.Top_Pattern_Mark := + To_Stack_Address (Stack (Top_Slot_Index_In (Stack))'Address); + else + Analyzer.Bottom_Pattern_Mark := To_Stack_Address (Stack'Address); + Analyzer.Bottom_Pattern_Mark := To_Stack_Address (Stack'Address); + end if; -- If Arr has been packed, the following assertion must be true (we -- add the size of the element whose address is: @@ -539,20 +553,28 @@ package body System.Stack_Usage is ------------------- procedure Report_Result (Analyzer : Stack_Analyzer) is - Measure : constant Natural := - Stack_Size - (Analyzer.Topmost_Touched_Mark, - Analyzer.Bottom_Of_Stack) - + Analyzer.Stack_Used_When_Filling; - - Result : constant Task_Result := + Result : Task_Result := (Task_Name => Analyzer.Task_Name, Max_Size => Analyzer.Stack_Size, - Min_Measure => Measure, - Max_Measure => Measure + Analyzer.Stack_Size - - Analyzer.Pattern_Size); + Min_Measure => 0, + Max_Measure => 0); begin + if Analyzer.Pattern_Size = 0 then + -- If we have that result, it means that we didn't do any computation + -- at all. In other words, we used at least everything (and possibly + -- more). + + Result.Min_Measure := Analyzer.Stack_Size; + Result.Max_Measure := Analyzer.Stack_Size; + else + Result.Min_Measure := Stack_Size + (Analyzer.Topmost_Touched_Mark, + Analyzer.Bottom_Of_Stack); + Result.Max_Measure := Result.Min_Measure + + (Analyzer.Stack_Size - Analyzer.Pattern_Size); + end if; + if Analyzer.Result_Id in Result_Array'Range then -- If the result can be stored, then store it in Result_Array diff --git a/gcc/ada/s-stausa.ads b/gcc/ada/s-stausa.ads index 8a6e2b67cb5..2aa9dd70d2d 100644 --- a/gcc/ada/s-stausa.ads +++ b/gcc/ada/s-stausa.ads @@ -304,10 +304,6 @@ private Result_Id : Positive; -- Id of the result. If less than value given to gnatbind -u corresponds -- to the location in the result array of result for the current task. - - Stack_Used_When_Filling : Natural := 0; - -- Amount of stack that was already used when actually filling the - -- memory, and therefore not analyzed. end record; Environment_Task_Analyzer : Stack_Analyzer; diff --git a/gcc/ada/s-ststop.adb b/gcc/ada/s-ststop.adb index 8d181087e97..7dca75fbbe0 100644 --- a/gcc/ada/s-ststop.adb +++ b/gcc/ada/s-ststop.adb @@ -92,17 +92,23 @@ package body System.Strings.Stream_Ops is subtype String_Block is String_Type (1 .. C_In_Default_Block); - -- Block IO is used in the following two scenarios: + Flag : Integer; + pragma Import (C, Flag, "__gl_canonical_streams"); + -- This imported value is used to determine whether configuration pragma + -- Canonical_Streams is present. A value of zero indicates whether any + -- stream-related optimizations are enabled, while a value of one + -- indicates a disabled status. - -- 1) When the size of the character type equals that of the stream - -- element type, regardless of endianness. + Canonical_Streams : constant Boolean := Flag = 1; - -- 2) When using the standard stream IO routines for elementary - -- types which guarantees the same endianness over partitions. + -- Block IO is used when the low level can support block IO, the size + -- of the character type is a multiple of the stream element type and + -- the compilation can use stream optimizations. Use_Block_IO : constant Boolean := - C_Size = SE_Size - or else Stream_Attributes.Block_IO_OK; + Stream_Attributes.Block_IO_OK + and then C_Size mod SE_Size = 0 + and then not Canonical_Streams; -- Conversions to and from Default_Block diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 4f50dc01789..d16b7d6b8c4 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -2770,7 +2770,17 @@ package body Sem_Aggr is Error_Msg_N ("record aggregate cannot be null", N); return; - elsif No (First_Entity (Typ)) then + -- If the type has no components, then the aggregate should either + -- have "null record", or in Ada 2005 it could instead have a single + -- component association given by "others => <>". For Ada 95 we flag + -- an error at this point, but for Ada 2005 we proceed with checking + -- the associations below, which will catch the case where it's not + -- an aggregate with "others => <>". Note that the legality of a <> + -- aggregate for a null record type was established by AI05-016. + + elsif No (First_Entity (Typ)) + and then Ada_Version < Ada_05 + then Error_Msg_N ("record aggregate must be null", N); return; end if; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 14f9102d369..4b599151f8e 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1898,6 +1898,7 @@ package body Sem_Attr is and then Aname /= Name_Address and then Aname /= Name_Code_Address and then Aname /= Name_Count + and then Aname /= Name_Result and then Aname /= Name_Unchecked_Access then Error_Attr ("ambiguous prefix for % attribute", P); @@ -3741,6 +3742,16 @@ package body Sem_Attr is PS : constant Entity_Id := Scope (CS); begin + -- If the enclosing subprogram is always inlined, the enclosing + -- postcondition will not be propagated to the expanded call. + + if Has_Pragma_Inline_Always (PS) + and then Warn_On_Redundant_Constructs + then + Error_Msg_N + ("postconditions on inlined functions not enforced?", N); + end if; + -- If we are in the scope of a function and in Spec_Expression mode, -- this is likely the prescan of the postcondition pragma, and we -- just set the proper type. If there is an error it will be caught @@ -3775,9 +3786,23 @@ package body Sem_Attr is then -- Check OK prefix - if Nkind (P) /= N_Identifier - or else Chars (P) /= Chars (PS) + if (Nkind (P) = N_Identifier + or else Nkind (P) = N_Operator_Symbol) + and then Chars (P) = Chars (PS) + then + null; + + -- Within an instance, the prefix designates the local renaming + -- of the original generic. + + elsif Is_Entity_Name (P) + and then Ekind (Entity (P)) = E_Function + and then Present (Alias (Entity (P))) + and then Chars (Alias (Entity (P))) = Chars (PS) then + null; + + else Error_Msg_NE ("incorrect prefix for % attribute, expected &", P, PS); Error_Attr; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 540b2a6d85d..626bee47c1a 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -2660,13 +2660,18 @@ package body Sem_Ch10 is P : Node_Id; function Build_Unit_Name (Nam : Node_Id) return Node_Id; - -- Comment required here ??? + -- Build name to be used in implicit with_clause. In most cases this + -- is the source name, but if renamings are present we must make the + -- original unit visible, not the one it renames. The entity in the + -- use clause is the renamed unit, but the identifier is the one from + -- the source, which allows us to recover the unit renaming. --------------------- -- Build_Unit_Name -- --------------------- function Build_Unit_Name (Nam : Node_Id) return Node_Id is + Ent : Entity_Id; Renaming : Entity_Id; Result : Node_Id; @@ -2695,12 +2700,34 @@ package body Sem_Ch10 is end if; else + Ent := Entity (Nam); + + if Present (Entity (Selector_Name (Nam))) + and then Chars (Entity (Selector_Name (Nam))) /= Chars (Ent) + and then + Nkind (Unit_Declaration_Node (Entity (Selector_Name (Nam)))) + = N_Package_Renaming_Declaration + then + + -- The name in the with_clause is of the form A.B.C, and B + -- is given by a renaming declaration. In that case we may + -- not have analyzed the unit for B, but replaced it directly + -- in lib-load with the unit it renames. We have to make A.B + -- visible, so analyze the declaration for B now, in case it + -- has not been done yet. + + Ent := Entity (Selector_Name (Nam)); + Analyze + (Parent + (Unit_Declaration_Node (Entity (Selector_Name (Nam))))); + end if; + Result := Make_Expanded_Name (Loc, Chars => Chars (Entity (Nam)), Prefix => Build_Unit_Name (Prefix (Nam)), - Selector_Name => New_Occurrence_Of (Entity (Nam), Loc)); - Set_Entity (Result, Entity (Nam)); + Selector_Name => New_Occurrence_Of (Ent, Loc)); + Set_Entity (Result, Ent); return Result; end if; end Build_Unit_Name; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index cae84097d1a..b2e7d852487 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -2413,10 +2413,9 @@ package body Sem_Ch12 is Error_Msg_N ("no visible entity matches specification", Def); end if; - else - - -- Several interpretations. Disambiguate as for a renaming. + -- More than one interpretation, so disambiguate as for a renaming + else declare I : Interp_Index; I1 : Interp_Index := 0; @@ -2427,7 +2426,6 @@ package body Sem_Ch12 is Subp := Any_Id; Get_First_Interp (Def, I, It); while Present (It.Nam) loop - if Entity_Matches_Spec (It.Nam, Nam) then if Subp /= Any_Id then It1 := Disambiguate (Def, I1, I, Etype (Subp)); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index e14fb436d6b..d6983b1e648 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6380,9 +6380,15 @@ package body Sem_Ch4 is ----------------------------- function Valid_First_Argument_Of (Op : Entity_Id) return Boolean is - Typ : constant Entity_Id := Etype (First_Formal (Op)); + Typ : Entity_Id := Etype (First_Formal (Op)); begin + if Is_Concurrent_Type (Typ) + and then Present (Corresponding_Record_Type (Typ)) + then + Typ := Corresponding_Record_Type (Typ); + end if; + -- Simple case. Object may be a subtype of the tagged type or -- may be the corresponding record of a synchronized type. @@ -6414,6 +6420,10 @@ package body Sem_Ch4 is -- corresponding record (base) type. if Is_Concurrent_Type (Obj_Type) then + if not Present (Corresponding_Record_Type (Obj_Type)) then + return False; + end if; + Corr_Type := Base_Type (Corresponding_Record_Type (Obj_Type)); Elmt := First_Elmt (Primitive_Operations (Corr_Type)); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 04413a19602..6583b72537d 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -891,6 +891,37 @@ package body Sem_Ch6 is end if; Set_Actual_Subtypes (N, Current_Scope); + Process_PPCs (N, Gen_Id, Body_Id); + + -- If the generic unit carries pre- or post-conditions, copy them + -- to the original generic tree, so that they are properly added + -- to any instantiation. + + declare + Orig : constant Node_Id := Original_Node (N); + Cond : Node_Id; + + begin + Cond := First (Declarations (N)); + while Present (Cond) loop + if Nkind (Cond) = N_Pragma + and then Pragma_Name (Cond) = Name_Check + then + Prepend (New_Copy_Tree (Cond), Declarations (Orig)); + + elsif Nkind (Cond) = N_Pragma + and then Pragma_Name (Cond) = Name_Postcondition + then + Set_Ekind (Defining_Entity (Orig), Ekind (Gen_Id)); + Prepend (New_Copy_Tree (Cond), Declarations (Orig)); + else + exit; + end if; + + Next (Cond); + end loop; + end; + Analyze_Declarations (Declarations (N)); Check_Completion; Analyze (Handled_Statement_Sequence (N)); @@ -1533,9 +1564,14 @@ package body Sem_Ch6 is -- Subprogram_Specification. In such cases, we undo the change -- made by the analysis of the specification and try to find the -- spec again. + -- Note that wrappers already have their corresponding specs and + -- bodies set during their creation, so if the candidate spec is + -- a wrapper, then we definately need to swap all types to their + -- original concurrent status. - if No (Spec_N) then - + if No (Spec_N) + or else Is_Primitive_Wrapper (Spec_N) + then -- Restore all references of corresponding record types to the -- original concurrent types. @@ -1874,6 +1910,10 @@ package body Sem_Ch6 is end if; end if; + if Chars (Body_Id) = Name_uPostconditions then + Set_Has_Postconditions (Current_Scope); + end if; + -- Place subprogram on scope stack, and make formals visible. If there -- is a spec, the visible entity remains that of the spec. @@ -6564,12 +6604,6 @@ package body Sem_Ch6 is In_Scope : Boolean; Typ : Entity_Id; - function Has_Correct_Formal_Mode - (Tag_Typ : Entity_Id; - Subp : Entity_Id) return Boolean; - -- For an overridden subprogram Subp, check whether the mode of its - -- first parameter is correct depending on the kind of Tag_Typ. - function Matches_Prefixed_View_Profile (Prim_Params : List_Id; Iface_Params : List_Id) return Boolean; @@ -6578,39 +6612,6 @@ package body Sem_Ch6 is -- Iface_Params. Also determine if the type of first parameter of -- Iface_Params is an implemented interface. - ----------------------------- - -- Has_Correct_Formal_Mode -- - ----------------------------- - - function Has_Correct_Formal_Mode - (Tag_Typ : Entity_Id; - Subp : Entity_Id) return Boolean - is - Formal : constant Node_Id := First_Formal (Subp); - - begin - -- In order for an entry or a protected procedure to override, the - -- first parameter of the overridden routine must be of mode - -- "out", "in out" or access-to-variable. - - if (Ekind (Subp) = E_Entry - or else Ekind (Subp) = E_Procedure) - and then Is_Protected_Type (Tag_Typ) - and then Ekind (Formal) /= E_In_Out_Parameter - and then Ekind (Formal) /= E_Out_Parameter - and then Nkind (Parameter_Type (Parent (Formal))) /= - N_Access_Definition - then - return False; - end if; - - -- All other cases are OK since a task entry or routine does not - -- have a restriction on the mode of the first parameter of the - -- overridden interface routine. - - return True; - end Has_Correct_Formal_Mode; - ----------------------------------- -- Matches_Prefixed_View_Profile -- ----------------------------------- @@ -6688,15 +6689,15 @@ package body Sem_Ch6 is Iface_Id := Defining_Identifier (Iface_Param); Iface_Typ := Find_Parameter_Type (Iface_Param); - if Is_Access_Type (Iface_Typ) then - Iface_Typ := Directly_Designated_Type (Iface_Typ); - end if; - Prim_Id := Defining_Identifier (Prim_Param); Prim_Typ := Find_Parameter_Type (Prim_Param); - if Is_Access_Type (Prim_Typ) then - Prim_Typ := Directly_Designated_Type (Prim_Typ); + if Ekind (Iface_Typ) = E_Anonymous_Access_Type + and then Ekind (Prim_Typ) = E_Anonymous_Access_Type + and then Is_Concurrent_Type (Designated_Type (Prim_Typ)) + then + Iface_Typ := Designated_Type (Iface_Typ); + Prim_Typ := Designated_Type (Prim_Typ); end if; -- Case of multiple interface types inside a parameter profile @@ -6829,60 +6830,63 @@ package body Sem_Ch6 is while Present (Hom) loop Subp := Hom; - -- Entries can override abstract or null interface - -- procedures - - if Ekind (Def_Id) = E_Entry - and then Ekind (Subp) = E_Procedure - and then Nkind (Parent (Subp)) = N_Procedure_Specification - and then (Is_Abstract_Subprogram (Subp) - or else Null_Present (Parent (Subp))) + if Subp = Def_Id + or else not Is_Overloadable (Subp) + or else not Is_Primitive (Subp) + or else not Is_Dispatching_Operation (Subp) + or else not Is_Interface (Find_Dispatching_Type (Subp)) then - while Present (Alias (Subp)) loop - Subp := Alias (Subp); - end loop; - - if Matches_Prefixed_View_Profile - (Parameter_Specifications (Parent (Def_Id)), - Parameter_Specifications (Parent (Subp))) - then - Candidate := Subp; - - -- Absolute match - - if Has_Correct_Formal_Mode (Typ, Candidate) then - Overridden_Subp := Candidate; - return; - end if; - end if; + null; - -- Procedures can override abstract or null interface - -- procedures + -- Entries and procedures can override abstract or null + -- interface procedures - elsif Ekind (Def_Id) = E_Procedure + elsif (Ekind (Def_Id) = E_Procedure + or else Ekind (Def_Id) = E_Entry) and then Ekind (Subp) = E_Procedure - and then Nkind (Parent (Subp)) = N_Procedure_Specification - and then (Is_Abstract_Subprogram (Subp) - or else Null_Present (Parent (Subp))) and then Matches_Prefixed_View_Profile (Parameter_Specifications (Parent (Def_Id)), Parameter_Specifications (Parent (Subp))) then Candidate := Subp; - -- Absolute match + -- For an overridden subprogram Subp, check whether the mode + -- of its first parameter is correct depending on the kind + -- of synchronized type. - if Has_Correct_Formal_Mode (Typ, Candidate) then - Overridden_Subp := Candidate; - return; - end if; + declare + Formal : constant Node_Id := First_Formal (Candidate); + + begin + -- In order for an entry or a protected procedure to + -- override, the first parameter of the overridden + -- routine must be of mode "out", "in out" or + -- access-to-variable. + + if (Ekind (Candidate) = E_Entry + or else Ekind (Candidate) = E_Procedure) + and then Is_Protected_Type (Typ) + and then Ekind (Formal) /= E_In_Out_Parameter + and then Ekind (Formal) /= E_Out_Parameter + and then Nkind (Parameter_Type (Parent (Formal))) + /= N_Access_Definition + then + null; + + -- All other cases are OK since a task entry or routine + -- does not have a restriction on the mode of the first + -- parameter of the overridden interface routine. + + else + Overridden_Subp := Candidate; + return; + end if; + end; -- Functions can override abstract interface functions elsif Ekind (Def_Id) = E_Function and then Ekind (Subp) = E_Function - and then Nkind (Parent (Subp)) = N_Function_Specification - and then Is_Abstract_Subprogram (Subp) and then Matches_Prefixed_View_Profile (Parameter_Specifications (Parent (Def_Id)), Parameter_Specifications (Parent (Subp))) @@ -7752,9 +7756,17 @@ package body Sem_Ch6 is -- procedure. Note that it is only at the outer level that we -- do this fiddling, for the spec cases, the already preanalyzed -- parameters are not affected. + -- For a postcondition pragma within a generic, preserve the pragma + -- for later expansion. Set_Analyzed (CP, False); + if Nam = Name_Postcondition + and then not Expander_Active + then + return CP; + end if; + -- Change pragma into corresponding pragma Check Prepend_To (Pragma_Argument_Associations (CP), @@ -7827,7 +7839,15 @@ package body Sem_Ch6 is end if; Analyze (Prag); - Append (Grab_PPC (Name_Postcondition), Plist); + + -- If expansion is disabled, as in a generic unit, + -- save pragma for later expansion. + + if not Expander_Active then + Prepend (Grab_PPC (Name_Postcondition), Declarations (N)); + else + Append (Grab_PPC (Name_Postcondition), Plist); + end if; end if; Next (Prag); @@ -7860,16 +7880,23 @@ package body Sem_Ch6 is Plist := Empty_List; end if; - Append (Grab_PPC (Name_Postcondition), Plist); + if not Expander_Active then + Prepend (Grab_PPC (Name_Postcondition), Declarations (N)); + else + Append (Grab_PPC (Name_Postcondition), Plist); + end if; end if; Prag := Next_Pragma (Prag); end loop; end if; - -- If we had any postconditions, build the procedure + -- If we had any postconditions and expansion is enabled,, build + -- the Postconditions procedure. - if Present (Plist) then + if Present (Plist) + and then Expander_Active + then Subp := Defining_Entity (N); if Etype (Subp) /= Standard_Void_Type then diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 3feba8002d9..8d162e6b37b 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -583,6 +583,7 @@ package body Sem_Prag is -- expression, returns True if so, False if non-static or not String. procedure Pragma_Misplaced; + pragma No_Return (Pragma_Misplaced); -- Issue fatal error message for misplaced pragma procedure Process_Atomic_Shared_Volatile; @@ -1350,9 +1351,57 @@ package body Sem_Prag is procedure Check_Precondition_Postcondition (In_Body : out Boolean) is P : Node_Id; - S : Entity_Id; PO : Node_Id; + procedure Chain_PPC (PO : Node_Id); + -- If PO is a subprogram declaration node (or a generic subprogram + -- declaration node), then the precondition/postcondition applies + -- to this subprogram and the processing for the pragma is completed. + -- Otherwise the pragma is misplaced. + + --------------- + -- Chain_PPC -- + --------------- + + procedure Chain_PPC (PO : Node_Id) is + S : Node_Id; + + begin + if not Nkind_In (PO, N_Subprogram_Declaration, + N_Generic_Subprogram_Declaration) + then + Pragma_Misplaced; + end if; + + -- Here if we have subprogram or generic subprogram declaration + + S := Defining_Unit_Name (Specification (PO)); + + -- Analyze the pragma unless it appears within a package spec, + -- which is the case where we delay the analysis of the PPC until + -- the end of the package declarations (for details, see + -- Analyze_Package_Specification.Analyze_PPCs). + + if Ekind (Scope (S)) /= E_Package + and then + Ekind (Scope (S)) /= E_Generic_Package + then + Analyze_PPC_In_Decl_Part (N, S); + end if; + + -- Chain spec PPC pragma to list for subprogram + + Set_Next_Pragma (N, Spec_PPC_List (S)); + Set_Spec_PPC_List (S, N); + + -- Return indicating spec case + + In_Body := False; + return; + end Chain_PPC; + + -- Start of processing for Check_Precondition_Postcondition + begin if not Is_List_Member (N) then Pragma_Misplaced; @@ -1362,6 +1411,14 @@ package body Sem_Prag is Set_PPC_Enabled (N, Check_Enabled (Pname)); + -- If we are within an inlined body, the legality of the pragma + -- has been checked already. + + if In_Inlined_Body then + In_Body := True; + return; + end if; + -- Search prior declarations P := N; @@ -1379,37 +1436,11 @@ package body Sem_Prag is elsif not Comes_From_Source (PO) then null; - -- Here if we hit a subprogram declaration - - elsif Nkind (PO) = N_Subprogram_Declaration then - S := Defining_Unit_Name (Specification (PO)); - - -- Analyze the pragma unless it appears within a package spec, - -- which is the case where we delay the analysis of the PPC - -- until the end of the package declarations (for details, - -- see Analyze_Package_Specification.Analyze_PPCs). - - if Ekind (Scope (S)) /= E_Package - and then - Ekind (Scope (S)) /= E_Generic_Package - then - Analyze_PPC_In_Decl_Part (N, S); - end if; - - -- Chain spec PPC pragma to list for subprogram - - Set_Next_Pragma (N, Spec_PPC_List (S)); - Set_Spec_PPC_List (S, N); - - -- Return indicating spec case - - In_Body := False; - return; - - -- If we encounter any other declaration moving back, misplaced + -- Only remaining possibility is subprogram declaration else - Pragma_Misplaced; + Chain_PPC (PO); + return; end if; end loop; @@ -1422,11 +1453,16 @@ package body Sem_Prag is In_Body := True; return; - -- If not, it was misplaced + -- See if it is in the pragmas after a library level subprogram - else - Pragma_Misplaced; + elsif Nkind (Parent (N)) = N_Compilation_Unit_Aux then + Chain_PPC (Unit (Parent (Parent (N)))); + return; end if; + + -- If we fall through, pragma was misplaced + + Pragma_Misplaced; end Check_Precondition_Postcondition; ----------------------------- @@ -5504,6 +5540,18 @@ package body Sem_Prag is end if; end C_Pass_By_Copy; + ----------------------- + -- Canonical_Streams -- + ----------------------- + + -- pragma Canonical_Streams; + + when Pragma_Canonical_Streams => + GNAT_Pragma; + Check_Arg_Count (0); + Check_Valid_Configuration_Pragma; + Canonical_Streams := True; + ----------- -- Check -- ----------- @@ -12045,6 +12093,7 @@ package body Sem_Prag is Pragma_Atomic => 0, Pragma_Atomic_Components => 0, Pragma_Attach_Handler => -1, + Pragma_Canonical_Streams => -1, Pragma_Check => 99, Pragma_Check_Name => 0, Pragma_Check_Policy => 0, diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index a6d42f73637..e0118685ea0 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3218,16 +3218,48 @@ package body Sem_Res is -- or because it is a generic actual, so use base type to -- locate concurrent type. - if Is_Concurrent_Type (Etype (A)) - and then Etype (F) = - Corresponding_Record_Type (Base_Type (Etype (A))) - then - Rewrite (A, - Unchecked_Convert_To - (Corresponding_Record_Type (Etype (A)), A)); - end if; + A_Typ := Base_Type (Etype (A)); + F_Typ := Base_Type (Etype (F)); + + declare + Full_A_Typ : Entity_Id; + + begin + if Present (Full_View (A_Typ)) then + Full_A_Typ := Base_Type (Full_View (A_Typ)); + else + Full_A_Typ := A_Typ; + end if; - Resolve (A, Etype (F)); + -- Tagged synchronized type (case 1): the actual is a + -- concurrent type + + if Is_Concurrent_Type (A_Typ) + and then Corresponding_Record_Type (A_Typ) = F_Typ + then + Rewrite (A, + Unchecked_Convert_To + (Corresponding_Record_Type (A_Typ), A)); + Resolve (A, Etype (F)); + + -- Tagged synchronized type (case 2): the formal is a + -- concurrent type + + elsif Ekind (Full_A_Typ) = E_Record_Type + and then Present + (Corresponding_Concurrent_Type (Full_A_Typ)) + and then Is_Concurrent_Type (F_Typ) + and then Present (Corresponding_Record_Type (F_Typ)) + and then Full_A_Typ = Corresponding_Record_Type (F_Typ) + then + Resolve (A, Corresponding_Record_Type (F_Typ)); + + -- Common case + + else + Resolve (A, Etype (F)); + end if; + end; end if; A_Typ := Etype (A); diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 4a170d82ce3..aae54d1f67e 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -2106,11 +2106,18 @@ package body Sem_Type is -- to check whether it is a proper descendant. or else - (Is_Concurrent_Type (Etype (N)) + (Is_Record_Type (Typ) + and then Is_Concurrent_Type (Etype (N)) and then Present (Corresponding_Record_Type (Etype (N))) and then Covers (Typ, Corresponding_Record_Type (Etype (N)))) or else + (Is_Concurrent_Type (Typ) + and then Is_Record_Type (Etype (N)) + and then Present (Corresponding_Record_Type (Typ)) + and then Covers (Corresponding_Record_Type (Typ), Etype (N))) + + or else (not Is_Tagged_Type (Typ) and then Ekind (Typ) /= E_Anonymous_Access_Type and then Covers (Etype (N), Typ)); diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 957dfae2625..aaea3c8c15d 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -657,7 +657,7 @@ package body Sinput is end if; elsif Chr = LF then - if Source (P) = CR then + if Source (P + 1) = CR then P := P + 2; else P := P + 1; diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index 6d3144092cf..82d03e75d23 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -565,12 +565,12 @@ package Sinput is procedure Skip_Line_Terminators (P : in out Source_Ptr; Physical : out Boolean); - -- On entry, P points to a line terminator that has been encountered, - -- which is one of FF,LF,VT,CR or a wide character sequence whose value is - -- in category Separator,Line or Separator,Paragraph. The purpose of this - -- P points just past the character that was scanned. The purpose of this - -- routine is to distinguish physical and logical line endings. A physical - -- line ending is one of: + -- On entry, P points to a line terminator that has been encountered, which + -- is one of FF,LF,VT,CR or a wide character sequence whose value is in + -- category Separator,Line or Separator,Paragraph. P points just past the + -- character that was scanned. The purpose of this routine is to + -- distinguish physical and logical line endings. A physical line ending is + -- one of: -- -- CR on its own (MAC System 7) -- LF on its own (Unix and unix-like systems) diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index 7d4cdddc479..e97ef15c19c 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -183,6 +183,7 @@ package body Snames is "ada_2005#" & "assertion_policy#" & "c_pass_by_copy#" & + "canonical_streams#" & "check_name#" & "check_policy#" & "compile_time_error#" & diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index c2001e68aa4..3a93bef1fa6 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -341,21 +341,22 @@ package Snames is Name_Ada_2005 : constant Name_Id := N + 122; -- GNAT Name_Assertion_Policy : constant Name_Id := N + 123; -- Ada 05 Name_C_Pass_By_Copy : constant Name_Id := N + 124; -- GNAT - Name_Check_Name : constant Name_Id := N + 125; -- GNAT - Name_Check_Policy : constant Name_Id := N + 126; -- GNAT - Name_Compile_Time_Error : constant Name_Id := N + 127; -- GNAT - Name_Compile_Time_Warning : constant Name_Id := N + 128; -- GNAT - Name_Compiler_Unit : constant Name_Id := N + 129; -- GNAT - Name_Component_Alignment : constant Name_Id := N + 130; -- GNAT - Name_Convention_Identifier : constant Name_Id := N + 131; -- GNAT - Name_Debug_Policy : constant Name_Id := N + 132; -- GNAT - Name_Detect_Blocking : constant Name_Id := N + 133; -- Ada 05 - Name_Discard_Names : constant Name_Id := N + 134; - Name_Elaboration_Checks : constant Name_Id := N + 135; -- GNAT - Name_Eliminate : constant Name_Id := N + 136; -- GNAT - Name_Extend_System : constant Name_Id := N + 137; -- GNAT - Name_Extensions_Allowed : constant Name_Id := N + 138; -- GNAT - Name_External_Name_Casing : constant Name_Id := N + 139; -- GNAT + Name_Canonical_Streams : constant Name_Id := N + 125; -- GNAT + Name_Check_Name : constant Name_Id := N + 126; -- GNAT + Name_Check_Policy : constant Name_Id := N + 127; -- GNAT + Name_Compile_Time_Error : constant Name_Id := N + 128; -- GNAT + Name_Compile_Time_Warning : constant Name_Id := N + 129; -- GNAT + Name_Compiler_Unit : constant Name_Id := N + 130; -- GNAT + Name_Component_Alignment : constant Name_Id := N + 131; -- GNAT + Name_Convention_Identifier : constant Name_Id := N + 132; -- GNAT + Name_Debug_Policy : constant Name_Id := N + 133; -- GNAT + Name_Detect_Blocking : constant Name_Id := N + 134; -- Ada 05 + Name_Discard_Names : constant Name_Id := N + 135; + Name_Elaboration_Checks : constant Name_Id := N + 136; -- GNAT + Name_Eliminate : constant Name_Id := N + 137; -- GNAT + Name_Extend_System : constant Name_Id := N + 138; -- GNAT + Name_Extensions_Allowed : constant Name_Id := N + 139; -- GNAT + Name_External_Name_Casing : constant Name_Id := N + 140; -- GNAT -- Note: Fast_Math is not in this list because its name matches -- GNAT -- the name of the corresponding attribute. However, it is @@ -363,49 +364,49 @@ package Snames is -- functions Get_Pragma_Id, Is_[Configuration_]Pragma_Id, and -- correctly recognize and process Fast_Math. - Name_Favor_Top_Level : constant Name_Id := N + 140; -- GNAT - Name_Float_Representation : constant Name_Id := N + 141; -- GNAT - Name_Implicit_Packing : constant Name_Id := N + 142; -- GNAT - Name_Initialize_Scalars : constant Name_Id := N + 143; -- GNAT - Name_Interrupt_State : constant Name_Id := N + 144; -- GNAT - Name_License : constant Name_Id := N + 145; -- GNAT - Name_Locking_Policy : constant Name_Id := N + 146; - Name_Long_Float : constant Name_Id := N + 147; -- VMS - Name_No_Run_Time : constant Name_Id := N + 148; -- GNAT - Name_No_Strict_Aliasing : constant Name_Id := N + 149; -- GNAT - Name_Normalize_Scalars : constant Name_Id := N + 150; - Name_Optimize_Alignment : constant Name_Id := N + 151; -- GNAT - Name_Persistent_BSS : constant Name_Id := N + 152; -- GNAT - Name_Polling : constant Name_Id := N + 153; -- GNAT - Name_Priority_Specific_Dispatching : constant Name_Id := N + 154; -- Ada 05 - Name_Profile : constant Name_Id := N + 155; -- Ada 05 - Name_Profile_Warnings : constant Name_Id := N + 156; -- GNAT - Name_Propagate_Exceptions : constant Name_Id := N + 157; -- GNAT - Name_Queuing_Policy : constant Name_Id := N + 158; - Name_Ravenscar : constant Name_Id := N + 159; -- GNAT - Name_Restricted_Run_Time : constant Name_Id := N + 160; -- GNAT - Name_Restrictions : constant Name_Id := N + 161; - Name_Restriction_Warnings : constant Name_Id := N + 162; -- GNAT - Name_Reviewable : constant Name_Id := N + 163; - Name_Source_File_Name : constant Name_Id := N + 164; -- GNAT - Name_Source_File_Name_Project : constant Name_Id := N + 165; -- GNAT - Name_Style_Checks : constant Name_Id := N + 166; -- GNAT - Name_Suppress : constant Name_Id := N + 167; - Name_Suppress_Exception_Locations : constant Name_Id := N + 168; -- GNAT - Name_Task_Dispatching_Policy : constant Name_Id := N + 169; - Name_Universal_Data : constant Name_Id := N + 170; -- AAMP - Name_Unsuppress : constant Name_Id := N + 171; -- GNAT - Name_Use_VADS_Size : constant Name_Id := N + 172; -- GNAT - Name_Validity_Checks : constant Name_Id := N + 173; -- GNAT - Name_Warnings : constant Name_Id := N + 174; -- GNAT - Name_Wide_Character_Encoding : constant Name_Id := N + 175; -- GNAT - Last_Configuration_Pragma_Name : constant Name_Id := N + 175; + Name_Favor_Top_Level : constant Name_Id := N + 141; -- GNAT + Name_Float_Representation : constant Name_Id := N + 142; -- GNAT + Name_Implicit_Packing : constant Name_Id := N + 143; -- GNAT + Name_Initialize_Scalars : constant Name_Id := N + 144; -- GNAT + Name_Interrupt_State : constant Name_Id := N + 145; -- GNAT + Name_License : constant Name_Id := N + 146; -- GNAT + Name_Locking_Policy : constant Name_Id := N + 147; + Name_Long_Float : constant Name_Id := N + 148; -- VMS + Name_No_Run_Time : constant Name_Id := N + 149; -- GNAT + Name_No_Strict_Aliasing : constant Name_Id := N + 150; -- GNAT + Name_Normalize_Scalars : constant Name_Id := N + 151; + Name_Optimize_Alignment : constant Name_Id := N + 152; -- GNAT + Name_Persistent_BSS : constant Name_Id := N + 153; -- GNAT + Name_Polling : constant Name_Id := N + 154; -- GNAT + Name_Priority_Specific_Dispatching : constant Name_Id := N + 155; -- Ada 05 + Name_Profile : constant Name_Id := N + 156; -- Ada 05 + Name_Profile_Warnings : constant Name_Id := N + 157; -- GNAT + Name_Propagate_Exceptions : constant Name_Id := N + 158; -- GNAT + Name_Queuing_Policy : constant Name_Id := N + 159; + Name_Ravenscar : constant Name_Id := N + 160; -- GNAT + Name_Restricted_Run_Time : constant Name_Id := N + 161; -- GNAT + Name_Restrictions : constant Name_Id := N + 162; + Name_Restriction_Warnings : constant Name_Id := N + 163; -- GNAT + Name_Reviewable : constant Name_Id := N + 164; + Name_Source_File_Name : constant Name_Id := N + 165; -- GNAT + Name_Source_File_Name_Project : constant Name_Id := N + 166; -- GNAT + Name_Style_Checks : constant Name_Id := N + 167; -- GNAT + Name_Suppress : constant Name_Id := N + 168; + Name_Suppress_Exception_Locations : constant Name_Id := N + 169; -- GNAT + Name_Task_Dispatching_Policy : constant Name_Id := N + 170; + Name_Universal_Data : constant Name_Id := N + 171; -- AAMP + Name_Unsuppress : constant Name_Id := N + 172; -- GNAT + Name_Use_VADS_Size : constant Name_Id := N + 173; -- GNAT + Name_Validity_Checks : constant Name_Id := N + 174; -- GNAT + Name_Warnings : constant Name_Id := N + 175; -- GNAT + Name_Wide_Character_Encoding : constant Name_Id := N + 176; -- GNAT + Last_Configuration_Pragma_Name : constant Name_Id := N + 176; -- Remaining pragma names - Name_Abort_Defer : constant Name_Id := N + 176; -- GNAT - Name_All_Calls_Remote : constant Name_Id := N + 177; - Name_Annotate : constant Name_Id := N + 178; -- GNAT + Name_Abort_Defer : constant Name_Id := N + 177; -- GNAT + Name_All_Calls_Remote : constant Name_Id := N + 178; + Name_Annotate : constant Name_Id := N + 179; -- GNAT -- Note: AST_Entry is not in this list because its name matches -- VMS -- the name of the corresponding attribute. However, it is @@ -413,77 +414,77 @@ package Snames is -- functions Get_Pragma_Id and Is_Pragma_Id correctly recognize -- and process Name_AST_Entry. - Name_Assert : constant Name_Id := N + 179; -- Ada 05 - Name_Asynchronous : constant Name_Id := N + 180; - Name_Atomic : constant Name_Id := N + 181; - Name_Atomic_Components : constant Name_Id := N + 182; - Name_Attach_Handler : constant Name_Id := N + 183; - Name_Check : constant Name_Id := N + 184; -- GNAT - Name_CIL_Constructor : constant Name_Id := N + 185; -- GNAT - Name_Comment : constant Name_Id := N + 186; -- GNAT - Name_Common_Object : constant Name_Id := N + 187; -- GNAT - Name_Complete_Representation : constant Name_Id := N + 188; -- GNAT - Name_Complex_Representation : constant Name_Id := N + 189; -- GNAT - Name_Controlled : constant Name_Id := N + 190; - Name_Convention : constant Name_Id := N + 191; - Name_CPP_Class : constant Name_Id := N + 192; -- GNAT - Name_CPP_Constructor : constant Name_Id := N + 193; -- GNAT - Name_CPP_Virtual : constant Name_Id := N + 194; -- GNAT - Name_CPP_Vtable : constant Name_Id := N + 195; -- GNAT - Name_Debug : constant Name_Id := N + 196; -- GNAT - Name_Elaborate : constant Name_Id := N + 197; -- Ada 83 - Name_Elaborate_All : constant Name_Id := N + 198; - Name_Elaborate_Body : constant Name_Id := N + 199; - Name_Export : constant Name_Id := N + 200; - Name_Export_Exception : constant Name_Id := N + 201; -- VMS - Name_Export_Function : constant Name_Id := N + 202; -- GNAT - Name_Export_Object : constant Name_Id := N + 203; -- GNAT - Name_Export_Procedure : constant Name_Id := N + 204; -- GNAT - Name_Export_Value : constant Name_Id := N + 205; -- GNAT - Name_Export_Valued_Procedure : constant Name_Id := N + 206; -- GNAT - Name_External : constant Name_Id := N + 207; -- GNAT - Name_Finalize_Storage_Only : constant Name_Id := N + 208; -- GNAT - Name_Ident : constant Name_Id := N + 209; -- VMS - Name_Implemented_By_Entry : constant Name_Id := N + 210; -- Ada 05 - Name_Import : constant Name_Id := N + 211; - Name_Import_Exception : constant Name_Id := N + 212; -- VMS - Name_Import_Function : constant Name_Id := N + 213; -- GNAT - Name_Import_Object : constant Name_Id := N + 214; -- GNAT - Name_Import_Procedure : constant Name_Id := N + 215; -- GNAT - Name_Import_Valued_Procedure : constant Name_Id := N + 216; -- GNAT - Name_Inline : constant Name_Id := N + 217; - Name_Inline_Always : constant Name_Id := N + 218; -- GNAT - Name_Inline_Generic : constant Name_Id := N + 219; -- GNAT - Name_Inspection_Point : constant Name_Id := N + 220; - Name_Interface_Name : constant Name_Id := N + 221; -- GNAT - Name_Interrupt_Handler : constant Name_Id := N + 222; - Name_Interrupt_Priority : constant Name_Id := N + 223; - Name_Java_Constructor : constant Name_Id := N + 224; -- GNAT - Name_Java_Interface : constant Name_Id := N + 225; -- GNAT - Name_Keep_Names : constant Name_Id := N + 226; -- GNAT - Name_Link_With : constant Name_Id := N + 227; -- GNAT - Name_Linker_Alias : constant Name_Id := N + 228; -- GNAT - Name_Linker_Constructor : constant Name_Id := N + 229; -- GNAT - Name_Linker_Destructor : constant Name_Id := N + 230; -- GNAT - Name_Linker_Options : constant Name_Id := N + 231; - Name_Linker_Section : constant Name_Id := N + 232; -- GNAT - Name_List : constant Name_Id := N + 233; - Name_Machine_Attribute : constant Name_Id := N + 234; -- GNAT - Name_Main : constant Name_Id := N + 235; -- GNAT - Name_Main_Storage : constant Name_Id := N + 236; -- GNAT - Name_Memory_Size : constant Name_Id := N + 237; -- Ada 83 - Name_No_Body : constant Name_Id := N + 238; -- GNAT - Name_No_Return : constant Name_Id := N + 239; -- GNAT - Name_Obsolescent : constant Name_Id := N + 240; -- GNAT - Name_Optimize : constant Name_Id := N + 241; - Name_Pack : constant Name_Id := N + 242; - Name_Page : constant Name_Id := N + 243; - Name_Passive : constant Name_Id := N + 244; -- GNAT - Name_Postcondition : constant Name_Id := N + 245; -- GNAT - Name_Precondition : constant Name_Id := N + 246; -- GNAT - Name_Preelaborable_Initialization : constant Name_Id := N + 247; -- Ada 05 - Name_Preelaborate : constant Name_Id := N + 248; - Name_Preelaborate_05 : constant Name_Id := N + 249; -- GNAT + Name_Assert : constant Name_Id := N + 180; -- Ada 05 + Name_Asynchronous : constant Name_Id := N + 181; + Name_Atomic : constant Name_Id := N + 182; + Name_Atomic_Components : constant Name_Id := N + 183; + Name_Attach_Handler : constant Name_Id := N + 184; + Name_Check : constant Name_Id := N + 185; -- GNAT + Name_CIL_Constructor : constant Name_Id := N + 186; -- GNAT + Name_Comment : constant Name_Id := N + 187; -- GNAT + Name_Common_Object : constant Name_Id := N + 188; -- GNAT + Name_Complete_Representation : constant Name_Id := N + 189; -- GNAT + Name_Complex_Representation : constant Name_Id := N + 190; -- GNAT + Name_Controlled : constant Name_Id := N + 191; + Name_Convention : constant Name_Id := N + 192; + Name_CPP_Class : constant Name_Id := N + 193; -- GNAT + Name_CPP_Constructor : constant Name_Id := N + 194; -- GNAT + Name_CPP_Virtual : constant Name_Id := N + 195; -- GNAT + Name_CPP_Vtable : constant Name_Id := N + 196; -- GNAT + Name_Debug : constant Name_Id := N + 197; -- GNAT + Name_Elaborate : constant Name_Id := N + 198; -- Ada 83 + Name_Elaborate_All : constant Name_Id := N + 199; + Name_Elaborate_Body : constant Name_Id := N + 200; + Name_Export : constant Name_Id := N + 201; + Name_Export_Exception : constant Name_Id := N + 202; -- VMS + Name_Export_Function : constant Name_Id := N + 203; -- GNAT + Name_Export_Object : constant Name_Id := N + 204; -- GNAT + Name_Export_Procedure : constant Name_Id := N + 205; -- GNAT + Name_Export_Value : constant Name_Id := N + 206; -- GNAT + Name_Export_Valued_Procedure : constant Name_Id := N + 207; -- GNAT + Name_External : constant Name_Id := N + 208; -- GNAT + Name_Finalize_Storage_Only : constant Name_Id := N + 209; -- GNAT + Name_Ident : constant Name_Id := N + 210; -- VMS + Name_Implemented_By_Entry : constant Name_Id := N + 211; -- Ada 05 + Name_Import : constant Name_Id := N + 212; + Name_Import_Exception : constant Name_Id := N + 213; -- VMS + Name_Import_Function : constant Name_Id := N + 214; -- GNAT + Name_Import_Object : constant Name_Id := N + 215; -- GNAT + Name_Import_Procedure : constant Name_Id := N + 216; -- GNAT + Name_Import_Valued_Procedure : constant Name_Id := N + 217; -- GNAT + Name_Inline : constant Name_Id := N + 218; + Name_Inline_Always : constant Name_Id := N + 219; -- GNAT + Name_Inline_Generic : constant Name_Id := N + 220; -- GNAT + Name_Inspection_Point : constant Name_Id := N + 221; + Name_Interface_Name : constant Name_Id := N + 222; -- GNAT + Name_Interrupt_Handler : constant Name_Id := N + 223; + Name_Interrupt_Priority : constant Name_Id := N + 224; + Name_Java_Constructor : constant Name_Id := N + 225; -- GNAT + Name_Java_Interface : constant Name_Id := N + 226; -- GNAT + Name_Keep_Names : constant Name_Id := N + 227; -- GNAT + Name_Link_With : constant Name_Id := N + 228; -- GNAT + Name_Linker_Alias : constant Name_Id := N + 229; -- GNAT + Name_Linker_Constructor : constant Name_Id := N + 230; -- GNAT + Name_Linker_Destructor : constant Name_Id := N + 231; -- GNAT + Name_Linker_Options : constant Name_Id := N + 232; + Name_Linker_Section : constant Name_Id := N + 233; -- GNAT + Name_List : constant Name_Id := N + 234; + Name_Machine_Attribute : constant Name_Id := N + 235; -- GNAT + Name_Main : constant Name_Id := N + 236; -- GNAT + Name_Main_Storage : constant Name_Id := N + 237; -- GNAT + Name_Memory_Size : constant Name_Id := N + 238; -- Ada 83 + Name_No_Body : constant Name_Id := N + 239; -- GNAT + Name_No_Return : constant Name_Id := N + 240; -- GNAT + Name_Obsolescent : constant Name_Id := N + 241; -- GNAT + Name_Optimize : constant Name_Id := N + 242; + Name_Pack : constant Name_Id := N + 243; + Name_Page : constant Name_Id := N + 244; + Name_Passive : constant Name_Id := N + 245; -- GNAT + Name_Postcondition : constant Name_Id := N + 246; -- GNAT + Name_Precondition : constant Name_Id := N + 247; -- GNAT + Name_Preelaborable_Initialization : constant Name_Id := N + 248; -- Ada 05 + Name_Preelaborate : constant Name_Id := N + 249; + Name_Preelaborate_05 : constant Name_Id := N + 250; -- GNAT -- Note: Priority is not in this list because its name matches -- the name of the corresponding attribute. However, it is @@ -491,16 +492,16 @@ package Snames is -- functions Get_Pragma_Id and Is_Pragma_Id correctly recognize -- and process Priority. Priority is a standard Ada 95 pragma. - Name_Psect_Object : constant Name_Id := N + 250; -- VMS - Name_Pure : constant Name_Id := N + 251; - Name_Pure_05 : constant Name_Id := N + 252; -- GNAT - Name_Pure_Function : constant Name_Id := N + 253; -- GNAT - Name_Relative_Deadline : constant Name_Id := N + 254; -- Ada 05 - Name_Remote_Call_Interface : constant Name_Id := N + 255; - Name_Remote_Types : constant Name_Id := N + 256; - Name_Share_Generic : constant Name_Id := N + 257; -- GNAT - Name_Shared : constant Name_Id := N + 258; -- Ada 83 - Name_Shared_Passive : constant Name_Id := N + 259; + Name_Psect_Object : constant Name_Id := N + 251; -- VMS + Name_Pure : constant Name_Id := N + 252; + Name_Pure_05 : constant Name_Id := N + 253; -- GNAT + Name_Pure_Function : constant Name_Id := N + 254; -- GNAT + Name_Relative_Deadline : constant Name_Id := N + 255; -- Ada 05 + Name_Remote_Call_Interface : constant Name_Id := N + 256; + Name_Remote_Types : constant Name_Id := N + 257; + Name_Share_Generic : constant Name_Id := N + 258; -- GNAT + Name_Shared : constant Name_Id := N + 259; -- Ada 83 + Name_Shared_Passive : constant Name_Id := N + 260; -- Note: Storage_Size is not in this list because its name -- matches the name of the corresponding attribute. However, @@ -511,30 +512,30 @@ package Snames is -- Note: Storage_Unit is also omitted from the list because -- of a clash with an attribute name, and is treated similarly. - Name_Source_Reference : constant Name_Id := N + 260; -- GNAT - Name_Static_Elaboration_Desired : constant Name_Id := N + 261; -- GNAT - Name_Stream_Convert : constant Name_Id := N + 262; -- GNAT - Name_Subtitle : constant Name_Id := N + 263; -- GNAT - Name_Suppress_All : constant Name_Id := N + 264; -- GNAT - Name_Suppress_Debug_Info : constant Name_Id := N + 265; -- GNAT - Name_Suppress_Initialization : constant Name_Id := N + 266; -- GNAT - Name_System_Name : constant Name_Id := N + 267; -- Ada 83 - Name_Task_Info : constant Name_Id := N + 268; -- GNAT - Name_Task_Name : constant Name_Id := N + 269; -- GNAT - Name_Task_Storage : constant Name_Id := N + 270; -- VMS - Name_Time_Slice : constant Name_Id := N + 271; -- GNAT - Name_Title : constant Name_Id := N + 272; -- GNAT - Name_Unchecked_Union : constant Name_Id := N + 273; -- GNAT - Name_Unimplemented_Unit : constant Name_Id := N + 274; -- GNAT - Name_Universal_Aliasing : constant Name_Id := N + 275; -- GNAT - Name_Unmodified : constant Name_Id := N + 276; -- GNAT - Name_Unreferenced : constant Name_Id := N + 277; -- GNAT - Name_Unreferenced_Objects : constant Name_Id := N + 278; -- GNAT - Name_Unreserve_All_Interrupts : constant Name_Id := N + 279; -- GNAT - Name_Volatile : constant Name_Id := N + 280; - Name_Volatile_Components : constant Name_Id := N + 281; - Name_Weak_External : constant Name_Id := N + 282; -- GNAT - Last_Pragma_Name : constant Name_Id := N + 282; + Name_Source_Reference : constant Name_Id := N + 261; -- GNAT + Name_Static_Elaboration_Desired : constant Name_Id := N + 262; -- GNAT + Name_Stream_Convert : constant Name_Id := N + 263; -- GNAT + Name_Subtitle : constant Name_Id := N + 264; -- GNAT + Name_Suppress_All : constant Name_Id := N + 265; -- GNAT + Name_Suppress_Debug_Info : constant Name_Id := N + 266; -- GNAT + Name_Suppress_Initialization : constant Name_Id := N + 267; -- GNAT + Name_System_Name : constant Name_Id := N + 268; -- Ada 83 + Name_Task_Info : constant Name_Id := N + 269; -- GNAT + Name_Task_Name : constant Name_Id := N + 270; -- GNAT + Name_Task_Storage : constant Name_Id := N + 271; -- VMS + Name_Time_Slice : constant Name_Id := N + 272; -- GNAT + Name_Title : constant Name_Id := N + 273; -- GNAT + Name_Unchecked_Union : constant Name_Id := N + 274; -- GNAT + Name_Unimplemented_Unit : constant Name_Id := N + 275; -- GNAT + Name_Universal_Aliasing : constant Name_Id := N + 276; -- GNAT + Name_Unmodified : constant Name_Id := N + 277; -- GNAT + Name_Unreferenced : constant Name_Id := N + 278; -- GNAT + Name_Unreferenced_Objects : constant Name_Id := N + 279; -- GNAT + Name_Unreserve_All_Interrupts : constant Name_Id := N + 280; -- GNAT + Name_Volatile : constant Name_Id := N + 281; + Name_Volatile_Components : constant Name_Id := N + 282; + Name_Weak_External : constant Name_Id := N + 283; -- GNAT + Last_Pragma_Name : constant Name_Id := N + 283; -- Language convention names for pragma Convention/Export/Import/Interface -- Note that Name_C is not included in this list, since it was already @@ -545,119 +546,119 @@ package Snames is -- Entry and Protected, this is because these conventions cannot be -- specified by a pragma. - First_Convention_Name : constant Name_Id := N + 283; - Name_Ada : constant Name_Id := N + 283; - Name_Assembler : constant Name_Id := N + 284; - Name_CIL : constant Name_Id := N + 285; - Name_COBOL : constant Name_Id := N + 286; - Name_CPP : constant Name_Id := N + 287; - Name_Fortran : constant Name_Id := N + 288; - Name_Intrinsic : constant Name_Id := N + 289; - Name_Java : constant Name_Id := N + 290; - Name_Stdcall : constant Name_Id := N + 291; - Name_Stubbed : constant Name_Id := N + 292; - Last_Convention_Name : constant Name_Id := N + 292; + First_Convention_Name : constant Name_Id := N + 284; + Name_Ada : constant Name_Id := N + 284; + Name_Assembler : constant Name_Id := N + 285; + Name_CIL : constant Name_Id := N + 286; + Name_COBOL : constant Name_Id := N + 287; + Name_CPP : constant Name_Id := N + 288; + Name_Fortran : constant Name_Id := N + 289; + Name_Intrinsic : constant Name_Id := N + 290; + Name_Java : constant Name_Id := N + 291; + Name_Stdcall : constant Name_Id := N + 292; + Name_Stubbed : constant Name_Id := N + 293; + Last_Convention_Name : constant Name_Id := N + 293; -- The following names are preset as synonyms for Assembler - Name_Asm : constant Name_Id := N + 293; - Name_Assembly : constant Name_Id := N + 294; + Name_Asm : constant Name_Id := N + 294; + Name_Assembly : constant Name_Id := N + 295; -- The following names are preset as synonyms for C - Name_Default : constant Name_Id := N + 295; + Name_Default : constant Name_Id := N + 296; -- Name_External (previously defined as pragma) -- The following names are preset as synonyms for CPP - Name_C_Plus_Plus : constant Name_Id := N + 296; + Name_C_Plus_Plus : constant Name_Id := N + 297; -- The following names are present as synonyms for Stdcall - Name_DLL : constant Name_Id := N + 297; - Name_Win32 : constant Name_Id := N + 298; + Name_DLL : constant Name_Id := N + 298; + Name_Win32 : constant Name_Id := N + 299; -- Other special names used in processing pragmas - Name_As_Is : constant Name_Id := N + 299; - Name_Assertion : constant Name_Id := N + 300; - Name_Attribute_Name : constant Name_Id := N + 301; - Name_Body_File_Name : constant Name_Id := N + 302; - Name_Boolean_Entry_Barriers : constant Name_Id := N + 303; - Name_Casing : constant Name_Id := N + 304; - Name_Code : constant Name_Id := N + 305; - Name_Component : constant Name_Id := N + 306; - Name_Component_Size_4 : constant Name_Id := N + 307; - Name_Copy : constant Name_Id := N + 308; - Name_D_Float : constant Name_Id := N + 309; - Name_Descriptor : constant Name_Id := N + 310; - Name_Dot_Replacement : constant Name_Id := N + 311; - Name_Dynamic : constant Name_Id := N + 312; - Name_Entity : constant Name_Id := N + 313; - Name_Entry_Count : constant Name_Id := N + 314; - Name_External_Name : constant Name_Id := N + 315; - Name_First_Optional_Parameter : constant Name_Id := N + 316; - Name_Form : constant Name_Id := N + 317; - Name_G_Float : constant Name_Id := N + 318; - Name_Gcc : constant Name_Id := N + 319; - Name_Gnat : constant Name_Id := N + 320; - Name_GPL : constant Name_Id := N + 321; - Name_IEEE_Float : constant Name_Id := N + 322; - Name_Ignore : constant Name_Id := N + 323; - Name_Info : constant Name_Id := N + 324; - Name_Internal : constant Name_Id := N + 325; - Name_Link_Name : constant Name_Id := N + 326; - Name_Lowercase : constant Name_Id := N + 327; - Name_Max_Entry_Queue_Depth : constant Name_Id := N + 328; - Name_Max_Entry_Queue_Length : constant Name_Id := N + 329; - Name_Max_Size : constant Name_Id := N + 330; - Name_Mechanism : constant Name_Id := N + 331; - Name_Message : constant Name_Id := N + 332; - Name_Mixedcase : constant Name_Id := N + 333; - Name_Modified_GPL : constant Name_Id := N + 334; - Name_Name : constant Name_Id := N + 335; - Name_NCA : constant Name_Id := N + 336; - Name_No : constant Name_Id := N + 337; - Name_No_Dependence : constant Name_Id := N + 338; - Name_No_Dynamic_Attachment : constant Name_Id := N + 339; - Name_No_Dynamic_Interrupts : constant Name_Id := N + 340; - Name_No_Requeue : constant Name_Id := N + 341; - Name_No_Requeue_Statements : constant Name_Id := N + 342; - Name_No_Task_Attributes : constant Name_Id := N + 343; - Name_No_Task_Attributes_Package : constant Name_Id := N + 344; - Name_On : constant Name_Id := N + 345; - Name_Parameter_Types : constant Name_Id := N + 346; - Name_Reference : constant Name_Id := N + 347; - Name_Restricted : constant Name_Id := N + 348; - Name_Result_Mechanism : constant Name_Id := N + 349; - Name_Result_Type : constant Name_Id := N + 350; - Name_Runtime : constant Name_Id := N + 351; - Name_SB : constant Name_Id := N + 352; - Name_Secondary_Stack_Size : constant Name_Id := N + 353; - Name_Section : constant Name_Id := N + 354; - Name_Semaphore : constant Name_Id := N + 355; - Name_Simple_Barriers : constant Name_Id := N + 356; - Name_Spec_File_Name : constant Name_Id := N + 357; - Name_State : constant Name_Id := N + 358; - Name_Static : constant Name_Id := N + 359; - Name_Stack_Size : constant Name_Id := N + 360; - Name_Subunit_File_Name : constant Name_Id := N + 361; - Name_Task_Stack_Size_Default : constant Name_Id := N + 362; - Name_Task_Type : constant Name_Id := N + 363; - Name_Time_Slicing_Enabled : constant Name_Id := N + 364; - Name_Top_Guard : constant Name_Id := N + 365; - Name_UBA : constant Name_Id := N + 366; - Name_UBS : constant Name_Id := N + 367; - Name_UBSB : constant Name_Id := N + 368; - Name_Unit_Name : constant Name_Id := N + 369; - Name_Unknown : constant Name_Id := N + 370; - Name_Unrestricted : constant Name_Id := N + 371; - Name_Uppercase : constant Name_Id := N + 372; - Name_User : constant Name_Id := N + 373; - Name_VAX_Float : constant Name_Id := N + 374; - Name_VMS : constant Name_Id := N + 375; - Name_Vtable_Ptr : constant Name_Id := N + 376; - Name_Working_Storage : constant Name_Id := N + 377; + Name_As_Is : constant Name_Id := N + 300; + Name_Assertion : constant Name_Id := N + 301; + Name_Attribute_Name : constant Name_Id := N + 302; + Name_Body_File_Name : constant Name_Id := N + 303; + Name_Boolean_Entry_Barriers : constant Name_Id := N + 304; + Name_Casing : constant Name_Id := N + 305; + Name_Code : constant Name_Id := N + 306; + Name_Component : constant Name_Id := N + 307; + Name_Component_Size_4 : constant Name_Id := N + 308; + Name_Copy : constant Name_Id := N + 309; + Name_D_Float : constant Name_Id := N + 310; + Name_Descriptor : constant Name_Id := N + 311; + Name_Dot_Replacement : constant Name_Id := N + 312; + Name_Dynamic : constant Name_Id := N + 313; + Name_Entity : constant Name_Id := N + 314; + Name_Entry_Count : constant Name_Id := N + 315; + Name_External_Name : constant Name_Id := N + 316; + Name_First_Optional_Parameter : constant Name_Id := N + 317; + Name_Form : constant Name_Id := N + 318; + Name_G_Float : constant Name_Id := N + 319; + Name_Gcc : constant Name_Id := N + 320; + Name_Gnat : constant Name_Id := N + 321; + Name_GPL : constant Name_Id := N + 322; + Name_IEEE_Float : constant Name_Id := N + 323; + Name_Ignore : constant Name_Id := N + 324; + Name_Info : constant Name_Id := N + 325; + Name_Internal : constant Name_Id := N + 326; + Name_Link_Name : constant Name_Id := N + 327; + Name_Lowercase : constant Name_Id := N + 328; + Name_Max_Entry_Queue_Depth : constant Name_Id := N + 329; + Name_Max_Entry_Queue_Length : constant Name_Id := N + 330; + Name_Max_Size : constant Name_Id := N + 331; + Name_Mechanism : constant Name_Id := N + 332; + Name_Message : constant Name_Id := N + 333; + Name_Mixedcase : constant Name_Id := N + 334; + Name_Modified_GPL : constant Name_Id := N + 335; + Name_Name : constant Name_Id := N + 336; + Name_NCA : constant Name_Id := N + 337; + Name_No : constant Name_Id := N + 338; + Name_No_Dependence : constant Name_Id := N + 339; + Name_No_Dynamic_Attachment : constant Name_Id := N + 340; + Name_No_Dynamic_Interrupts : constant Name_Id := N + 341; + Name_No_Requeue : constant Name_Id := N + 342; + Name_No_Requeue_Statements : constant Name_Id := N + 343; + Name_No_Task_Attributes : constant Name_Id := N + 344; + Name_No_Task_Attributes_Package : constant Name_Id := N + 345; + Name_On : constant Name_Id := N + 346; + Name_Parameter_Types : constant Name_Id := N + 347; + Name_Reference : constant Name_Id := N + 348; + Name_Restricted : constant Name_Id := N + 349; + Name_Result_Mechanism : constant Name_Id := N + 350; + Name_Result_Type : constant Name_Id := N + 351; + Name_Runtime : constant Name_Id := N + 352; + Name_SB : constant Name_Id := N + 353; + Name_Secondary_Stack_Size : constant Name_Id := N + 354; + Name_Section : constant Name_Id := N + 355; + Name_Semaphore : constant Name_Id := N + 356; + Name_Simple_Barriers : constant Name_Id := N + 357; + Name_Spec_File_Name : constant Name_Id := N + 358; + Name_State : constant Name_Id := N + 359; + Name_Static : constant Name_Id := N + 360; + Name_Stack_Size : constant Name_Id := N + 361; + Name_Subunit_File_Name : constant Name_Id := N + 362; + Name_Task_Stack_Size_Default : constant Name_Id := N + 363; + Name_Task_Type : constant Name_Id := N + 364; + Name_Time_Slicing_Enabled : constant Name_Id := N + 365; + Name_Top_Guard : constant Name_Id := N + 366; + Name_UBA : constant Name_Id := N + 367; + Name_UBS : constant Name_Id := N + 368; + Name_UBSB : constant Name_Id := N + 369; + Name_Unit_Name : constant Name_Id := N + 370; + Name_Unknown : constant Name_Id := N + 371; + Name_Unrestricted : constant Name_Id := N + 372; + Name_Uppercase : constant Name_Id := N + 373; + Name_User : constant Name_Id := N + 374; + Name_VAX_Float : constant Name_Id := N + 375; + Name_VMS : constant Name_Id := N + 376; + Name_Vtable_Ptr : constant Name_Id := N + 377; + Name_Working_Storage : constant Name_Id := N + 378; -- Names of recognized attributes. The entries with the comment "Ada 83" -- are attributes that are defined in Ada 83, but not in Ada 95. These @@ -671,175 +672,175 @@ package Snames is -- The entries marked VMS are recognized only in OpenVMS implementations -- of GNAT, and are treated as illegal in all other contexts. - First_Attribute_Name : constant Name_Id := N + 378; - Name_Abort_Signal : constant Name_Id := N + 378; -- GNAT - Name_Access : constant Name_Id := N + 379; - Name_Address : constant Name_Id := N + 380; - Name_Address_Size : constant Name_Id := N + 381; -- GNAT - Name_Aft : constant Name_Id := N + 382; - Name_Alignment : constant Name_Id := N + 383; - Name_Asm_Input : constant Name_Id := N + 384; -- GNAT - Name_Asm_Output : constant Name_Id := N + 385; -- GNAT - Name_AST_Entry : constant Name_Id := N + 386; -- VMS - Name_Bit : constant Name_Id := N + 387; -- GNAT - Name_Bit_Order : constant Name_Id := N + 388; - Name_Bit_Position : constant Name_Id := N + 389; -- GNAT - Name_Body_Version : constant Name_Id := N + 390; - Name_Callable : constant Name_Id := N + 391; - Name_Caller : constant Name_Id := N + 392; - Name_Code_Address : constant Name_Id := N + 393; -- GNAT - Name_Component_Size : constant Name_Id := N + 394; - Name_Compose : constant Name_Id := N + 395; - Name_Constrained : constant Name_Id := N + 396; - Name_Count : constant Name_Id := N + 397; - Name_Default_Bit_Order : constant Name_Id := N + 398; -- GNAT - Name_Definite : constant Name_Id := N + 399; - Name_Delta : constant Name_Id := N + 400; - Name_Denorm : constant Name_Id := N + 401; - Name_Digits : constant Name_Id := N + 402; - Name_Elaborated : constant Name_Id := N + 403; -- GNAT - Name_Emax : constant Name_Id := N + 404; -- Ada 83 - Name_Enabled : constant Name_Id := N + 405; -- GNAT - Name_Enum_Rep : constant Name_Id := N + 406; -- GNAT - Name_Enum_Val : constant Name_Id := N + 407; -- GNAT - Name_Epsilon : constant Name_Id := N + 408; -- Ada 83 - Name_Exponent : constant Name_Id := N + 409; - Name_External_Tag : constant Name_Id := N + 410; - Name_Fast_Math : constant Name_Id := N + 411; -- GNAT - Name_First : constant Name_Id := N + 412; - Name_First_Bit : constant Name_Id := N + 413; - Name_Fixed_Value : constant Name_Id := N + 414; -- GNAT - Name_Fore : constant Name_Id := N + 415; - Name_Has_Access_Values : constant Name_Id := N + 416; -- GNAT - Name_Has_Discriminants : constant Name_Id := N + 417; -- GNAT - Name_Has_Tagged_Values : constant Name_Id := N + 418; -- GNAT - Name_Identity : constant Name_Id := N + 419; - Name_Img : constant Name_Id := N + 420; -- GNAT - Name_Integer_Value : constant Name_Id := N + 421; -- GNAT - Name_Invalid_Value : constant Name_Id := N + 422; -- GNAT - Name_Large : constant Name_Id := N + 423; -- Ada 83 - Name_Last : constant Name_Id := N + 424; - Name_Last_Bit : constant Name_Id := N + 425; - Name_Leading_Part : constant Name_Id := N + 426; - Name_Length : constant Name_Id := N + 427; - Name_Machine_Emax : constant Name_Id := N + 428; - Name_Machine_Emin : constant Name_Id := N + 429; - Name_Machine_Mantissa : constant Name_Id := N + 430; - Name_Machine_Overflows : constant Name_Id := N + 431; - Name_Machine_Radix : constant Name_Id := N + 432; - Name_Machine_Rounding : constant Name_Id := N + 433; -- Ada 05 - Name_Machine_Rounds : constant Name_Id := N + 434; - Name_Machine_Size : constant Name_Id := N + 435; -- GNAT - Name_Mantissa : constant Name_Id := N + 436; -- Ada 83 - Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 437; - Name_Maximum_Alignment : constant Name_Id := N + 438; -- GNAT - Name_Mechanism_Code : constant Name_Id := N + 439; -- GNAT - Name_Mod : constant Name_Id := N + 440; -- Ada 05 - Name_Model_Emin : constant Name_Id := N + 441; - Name_Model_Epsilon : constant Name_Id := N + 442; - Name_Model_Mantissa : constant Name_Id := N + 443; - Name_Model_Small : constant Name_Id := N + 444; - Name_Modulus : constant Name_Id := N + 445; - Name_Null_Parameter : constant Name_Id := N + 446; -- GNAT - Name_Object_Size : constant Name_Id := N + 447; -- GNAT - Name_Old : constant Name_Id := N + 448; -- GNAT - Name_Partition_ID : constant Name_Id := N + 449; - Name_Passed_By_Reference : constant Name_Id := N + 450; -- GNAT - Name_Pool_Address : constant Name_Id := N + 451; - Name_Pos : constant Name_Id := N + 452; - Name_Position : constant Name_Id := N + 453; - Name_Priority : constant Name_Id := N + 454; -- Ada 05 - Name_Range : constant Name_Id := N + 455; - Name_Range_Length : constant Name_Id := N + 456; -- GNAT - Name_Result : constant Name_Id := N + 457; -- GNAT - Name_Round : constant Name_Id := N + 458; - Name_Safe_Emax : constant Name_Id := N + 459; -- Ada 83 - Name_Safe_First : constant Name_Id := N + 460; - Name_Safe_Large : constant Name_Id := N + 461; -- Ada 83 - Name_Safe_Last : constant Name_Id := N + 462; - Name_Safe_Small : constant Name_Id := N + 463; -- Ada 83 - Name_Scale : constant Name_Id := N + 464; - Name_Scaling : constant Name_Id := N + 465; - Name_Signed_Zeros : constant Name_Id := N + 466; - Name_Size : constant Name_Id := N + 467; - Name_Small : constant Name_Id := N + 468; - Name_Storage_Size : constant Name_Id := N + 469; - Name_Storage_Unit : constant Name_Id := N + 470; -- GNAT - Name_Stream_Size : constant Name_Id := N + 471; -- Ada 05 - Name_Tag : constant Name_Id := N + 472; - Name_Target_Name : constant Name_Id := N + 473; -- GNAT - Name_Terminated : constant Name_Id := N + 474; - Name_To_Address : constant Name_Id := N + 475; -- GNAT - Name_Type_Class : constant Name_Id := N + 476; -- GNAT - Name_UET_Address : constant Name_Id := N + 477; -- GNAT - Name_Unbiased_Rounding : constant Name_Id := N + 478; - Name_Unchecked_Access : constant Name_Id := N + 479; - Name_Unconstrained_Array : constant Name_Id := N + 480; - Name_Universal_Literal_String : constant Name_Id := N + 481; -- GNAT - Name_Unrestricted_Access : constant Name_Id := N + 482; -- GNAT - Name_VADS_Size : constant Name_Id := N + 483; -- GNAT - Name_Val : constant Name_Id := N + 484; - Name_Valid : constant Name_Id := N + 485; - Name_Value_Size : constant Name_Id := N + 486; -- GNAT - Name_Version : constant Name_Id := N + 487; - Name_Wchar_T_Size : constant Name_Id := N + 488; -- GNAT - Name_Wide_Wide_Width : constant Name_Id := N + 489; -- Ada 05 - Name_Wide_Width : constant Name_Id := N + 490; - Name_Width : constant Name_Id := N + 491; - Name_Word_Size : constant Name_Id := N + 492; -- GNAT + First_Attribute_Name : constant Name_Id := N + 379; + Name_Abort_Signal : constant Name_Id := N + 379; -- GNAT + Name_Access : constant Name_Id := N + 380; + Name_Address : constant Name_Id := N + 381; + Name_Address_Size : constant Name_Id := N + 382; -- GNAT + Name_Aft : constant Name_Id := N + 383; + Name_Alignment : constant Name_Id := N + 384; + Name_Asm_Input : constant Name_Id := N + 385; -- GNAT + Name_Asm_Output : constant Name_Id := N + 386; -- GNAT + Name_AST_Entry : constant Name_Id := N + 387; -- VMS + Name_Bit : constant Name_Id := N + 388; -- GNAT + Name_Bit_Order : constant Name_Id := N + 389; + Name_Bit_Position : constant Name_Id := N + 390; -- GNAT + Name_Body_Version : constant Name_Id := N + 391; + Name_Callable : constant Name_Id := N + 392; + Name_Caller : constant Name_Id := N + 393; + Name_Code_Address : constant Name_Id := N + 394; -- GNAT + Name_Component_Size : constant Name_Id := N + 395; + Name_Compose : constant Name_Id := N + 396; + Name_Constrained : constant Name_Id := N + 397; + Name_Count : constant Name_Id := N + 398; + Name_Default_Bit_Order : constant Name_Id := N + 399; -- GNAT + Name_Definite : constant Name_Id := N + 400; + Name_Delta : constant Name_Id := N + 401; + Name_Denorm : constant Name_Id := N + 402; + Name_Digits : constant Name_Id := N + 403; + Name_Elaborated : constant Name_Id := N + 404; -- GNAT + Name_Emax : constant Name_Id := N + 405; -- Ada 83 + Name_Enabled : constant Name_Id := N + 406; -- GNAT + Name_Enum_Rep : constant Name_Id := N + 407; -- GNAT + Name_Enum_Val : constant Name_Id := N + 408; -- GNAT + Name_Epsilon : constant Name_Id := N + 409; -- Ada 83 + Name_Exponent : constant Name_Id := N + 410; + Name_External_Tag : constant Name_Id := N + 411; + Name_Fast_Math : constant Name_Id := N + 412; -- GNAT + Name_First : constant Name_Id := N + 413; + Name_First_Bit : constant Name_Id := N + 414; + Name_Fixed_Value : constant Name_Id := N + 415; -- GNAT + Name_Fore : constant Name_Id := N + 416; + Name_Has_Access_Values : constant Name_Id := N + 417; -- GNAT + Name_Has_Discriminants : constant Name_Id := N + 418; -- GNAT + Name_Has_Tagged_Values : constant Name_Id := N + 419; -- GNAT + Name_Identity : constant Name_Id := N + 420; + Name_Img : constant Name_Id := N + 421; -- GNAT + Name_Integer_Value : constant Name_Id := N + 422; -- GNAT + Name_Invalid_Value : constant Name_Id := N + 423; -- GNAT + Name_Large : constant Name_Id := N + 424; -- Ada 83 + Name_Last : constant Name_Id := N + 425; + Name_Last_Bit : constant Name_Id := N + 426; + Name_Leading_Part : constant Name_Id := N + 427; + Name_Length : constant Name_Id := N + 428; + Name_Machine_Emax : constant Name_Id := N + 429; + Name_Machine_Emin : constant Name_Id := N + 430; + Name_Machine_Mantissa : constant Name_Id := N + 431; + Name_Machine_Overflows : constant Name_Id := N + 432; + Name_Machine_Radix : constant Name_Id := N + 433; + Name_Machine_Rounding : constant Name_Id := N + 434; -- Ada 05 + Name_Machine_Rounds : constant Name_Id := N + 435; + Name_Machine_Size : constant Name_Id := N + 436; -- GNAT + Name_Mantissa : constant Name_Id := N + 437; -- Ada 83 + Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 438; + Name_Maximum_Alignment : constant Name_Id := N + 439; -- GNAT + Name_Mechanism_Code : constant Name_Id := N + 440; -- GNAT + Name_Mod : constant Name_Id := N + 441; -- Ada 05 + Name_Model_Emin : constant Name_Id := N + 442; + Name_Model_Epsilon : constant Name_Id := N + 443; + Name_Model_Mantissa : constant Name_Id := N + 444; + Name_Model_Small : constant Name_Id := N + 445; + Name_Modulus : constant Name_Id := N + 446; + Name_Null_Parameter : constant Name_Id := N + 447; -- GNAT + Name_Object_Size : constant Name_Id := N + 448; -- GNAT + Name_Old : constant Name_Id := N + 449; -- GNAT + Name_Partition_ID : constant Name_Id := N + 450; + Name_Passed_By_Reference : constant Name_Id := N + 451; -- GNAT + Name_Pool_Address : constant Name_Id := N + 452; + Name_Pos : constant Name_Id := N + 453; + Name_Position : constant Name_Id := N + 454; + Name_Priority : constant Name_Id := N + 455; -- Ada 05 + Name_Range : constant Name_Id := N + 456; + Name_Range_Length : constant Name_Id := N + 457; -- GNAT + Name_Result : constant Name_Id := N + 458; -- GNAT + Name_Round : constant Name_Id := N + 459; + Name_Safe_Emax : constant Name_Id := N + 460; -- Ada 83 + Name_Safe_First : constant Name_Id := N + 461; + Name_Safe_Large : constant Name_Id := N + 462; -- Ada 83 + Name_Safe_Last : constant Name_Id := N + 463; + Name_Safe_Small : constant Name_Id := N + 464; -- Ada 83 + Name_Scale : constant Name_Id := N + 465; + Name_Scaling : constant Name_Id := N + 466; + Name_Signed_Zeros : constant Name_Id := N + 467; + Name_Size : constant Name_Id := N + 468; + Name_Small : constant Name_Id := N + 469; + Name_Storage_Size : constant Name_Id := N + 470; + Name_Storage_Unit : constant Name_Id := N + 471; -- GNAT + Name_Stream_Size : constant Name_Id := N + 472; -- Ada 05 + Name_Tag : constant Name_Id := N + 473; + Name_Target_Name : constant Name_Id := N + 474; -- GNAT + Name_Terminated : constant Name_Id := N + 475; + Name_To_Address : constant Name_Id := N + 476; -- GNAT + Name_Type_Class : constant Name_Id := N + 477; -- GNAT + Name_UET_Address : constant Name_Id := N + 478; -- GNAT + Name_Unbiased_Rounding : constant Name_Id := N + 479; + Name_Unchecked_Access : constant Name_Id := N + 480; + Name_Unconstrained_Array : constant Name_Id := N + 481; + Name_Universal_Literal_String : constant Name_Id := N + 482; -- GNAT + Name_Unrestricted_Access : constant Name_Id := N + 483; -- GNAT + Name_VADS_Size : constant Name_Id := N + 484; -- GNAT + Name_Val : constant Name_Id := N + 485; + Name_Valid : constant Name_Id := N + 486; + Name_Value_Size : constant Name_Id := N + 487; -- GNAT + Name_Version : constant Name_Id := N + 488; + Name_Wchar_T_Size : constant Name_Id := N + 489; -- GNAT + Name_Wide_Wide_Width : constant Name_Id := N + 490; -- Ada 05 + Name_Wide_Width : constant Name_Id := N + 491; + Name_Width : constant Name_Id := N + 492; + Name_Word_Size : constant Name_Id := N + 493; -- GNAT -- Attributes that designate attributes returning renamable functions, -- i.e. functions that return other than a universal value and that -- have non-universal arguments. - First_Renamable_Function_Attribute : constant Name_Id := N + 493; - Name_Adjacent : constant Name_Id := N + 493; - Name_Ceiling : constant Name_Id := N + 494; - Name_Copy_Sign : constant Name_Id := N + 495; - Name_Floor : constant Name_Id := N + 496; - Name_Fraction : constant Name_Id := N + 497; - Name_Image : constant Name_Id := N + 498; - Name_Input : constant Name_Id := N + 499; - Name_Machine : constant Name_Id := N + 500; - Name_Max : constant Name_Id := N + 501; - Name_Min : constant Name_Id := N + 502; - Name_Model : constant Name_Id := N + 503; - Name_Pred : constant Name_Id := N + 504; - Name_Remainder : constant Name_Id := N + 505; - Name_Rounding : constant Name_Id := N + 506; - Name_Succ : constant Name_Id := N + 507; - Name_Truncation : constant Name_Id := N + 508; - Name_Value : constant Name_Id := N + 509; - Name_Wide_Image : constant Name_Id := N + 510; - Name_Wide_Wide_Image : constant Name_Id := N + 511; - Name_Wide_Value : constant Name_Id := N + 512; - Name_Wide_Wide_Value : constant Name_Id := N + 513; - Last_Renamable_Function_Attribute : constant Name_Id := N + 513; + First_Renamable_Function_Attribute : constant Name_Id := N + 494; + Name_Adjacent : constant Name_Id := N + 494; + Name_Ceiling : constant Name_Id := N + 495; + Name_Copy_Sign : constant Name_Id := N + 496; + Name_Floor : constant Name_Id := N + 497; + Name_Fraction : constant Name_Id := N + 498; + Name_Image : constant Name_Id := N + 499; + Name_Input : constant Name_Id := N + 500; + Name_Machine : constant Name_Id := N + 501; + Name_Max : constant Name_Id := N + 502; + Name_Min : constant Name_Id := N + 503; + Name_Model : constant Name_Id := N + 504; + Name_Pred : constant Name_Id := N + 505; + Name_Remainder : constant Name_Id := N + 506; + Name_Rounding : constant Name_Id := N + 507; + Name_Succ : constant Name_Id := N + 508; + Name_Truncation : constant Name_Id := N + 509; + Name_Value : constant Name_Id := N + 510; + Name_Wide_Image : constant Name_Id := N + 511; + Name_Wide_Wide_Image : constant Name_Id := N + 512; + Name_Wide_Value : constant Name_Id := N + 513; + Name_Wide_Wide_Value : constant Name_Id := N + 514; + Last_Renamable_Function_Attribute : constant Name_Id := N + 514; -- Attributes that designate procedures - First_Procedure_Attribute : constant Name_Id := N + 514; - Name_Output : constant Name_Id := N + 514; - Name_Read : constant Name_Id := N + 515; - Name_Write : constant Name_Id := N + 516; - Last_Procedure_Attribute : constant Name_Id := N + 516; + First_Procedure_Attribute : constant Name_Id := N + 515; + Name_Output : constant Name_Id := N + 515; + Name_Read : constant Name_Id := N + 516; + Name_Write : constant Name_Id := N + 517; + Last_Procedure_Attribute : constant Name_Id := N + 517; -- Remaining attributes are ones that return entities - First_Entity_Attribute_Name : constant Name_Id := N + 517; - Name_Elab_Body : constant Name_Id := N + 517; -- GNAT - Name_Elab_Spec : constant Name_Id := N + 518; -- GNAT - Name_Storage_Pool : constant Name_Id := N + 519; + First_Entity_Attribute_Name : constant Name_Id := N + 518; + Name_Elab_Body : constant Name_Id := N + 518; -- GNAT + Name_Elab_Spec : constant Name_Id := N + 519; -- GNAT + Name_Storage_Pool : constant Name_Id := N + 520; -- These attributes are the ones that return types - First_Type_Attribute_Name : constant Name_Id := N + 520; - Name_Base : constant Name_Id := N + 520; - Name_Class : constant Name_Id := N + 521; - Name_Stub_Type : constant Name_Id := N + 522; - Last_Type_Attribute_Name : constant Name_Id := N + 522; - Last_Entity_Attribute_Name : constant Name_Id := N + 522; - Last_Attribute_Name : constant Name_Id := N + 522; + First_Type_Attribute_Name : constant Name_Id := N + 521; + Name_Base : constant Name_Id := N + 521; + Name_Class : constant Name_Id := N + 522; + Name_Stub_Type : constant Name_Id := N + 523; + Last_Type_Attribute_Name : constant Name_Id := N + 523; + Last_Entity_Attribute_Name : constant Name_Id := N + 523; + Last_Attribute_Name : constant Name_Id := N + 523; -- Names of recognized locking policy identifiers @@ -847,10 +848,10 @@ package Snames is -- name (e.g. C for Ceiling_Locking). If new policy names are added, -- the first character must be distinct. - First_Locking_Policy_Name : constant Name_Id := N + 523; - Name_Ceiling_Locking : constant Name_Id := N + 523; - Name_Inheritance_Locking : constant Name_Id := N + 524; - Last_Locking_Policy_Name : constant Name_Id := N + 524; + First_Locking_Policy_Name : constant Name_Id := N + 524; + Name_Ceiling_Locking : constant Name_Id := N + 524; + Name_Inheritance_Locking : constant Name_Id := N + 525; + Last_Locking_Policy_Name : constant Name_Id := N + 525; -- Names of recognized queuing policy identifiers @@ -858,10 +859,10 @@ package Snames is -- name (e.g. F for FIFO_Queuing). If new policy names are added, -- the first character must be distinct. - First_Queuing_Policy_Name : constant Name_Id := N + 525; - Name_FIFO_Queuing : constant Name_Id := N + 525; - Name_Priority_Queuing : constant Name_Id := N + 526; - Last_Queuing_Policy_Name : constant Name_Id := N + 526; + First_Queuing_Policy_Name : constant Name_Id := N + 526; + Name_FIFO_Queuing : constant Name_Id := N + 526; + Name_Priority_Queuing : constant Name_Id := N + 527; + Last_Queuing_Policy_Name : constant Name_Id := N + 527; -- Names of recognized task dispatching policy identifiers @@ -869,283 +870,283 @@ package Snames is -- name (e.g. F for FIFO_Within_Priorities). If new policy names -- are added, the first character must be distinct. - First_Task_Dispatching_Policy_Name : constant Name_Id := N + 527; - Name_EDF_Across_Priorities : constant Name_Id := N + 527; - Name_FIFO_Within_Priorities : constant Name_Id := N + 528; - Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 529; - Name_Round_Robin_Within_Priorities : constant Name_Id := N + 530; - Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 530; + First_Task_Dispatching_Policy_Name : constant Name_Id := N + 528; + Name_EDF_Across_Priorities : constant Name_Id := N + 528; + Name_FIFO_Within_Priorities : constant Name_Id := N + 529; + Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 530; + Name_Round_Robin_Within_Priorities : constant Name_Id := N + 531; + Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 531; -- Names of recognized checks for pragma Suppress - First_Check_Name : constant Name_Id := N + 531; - Name_Access_Check : constant Name_Id := N + 531; - Name_Accessibility_Check : constant Name_Id := N + 532; - Name_Alignment_Check : constant Name_Id := N + 533; -- GNAT - Name_Discriminant_Check : constant Name_Id := N + 534; - Name_Division_Check : constant Name_Id := N + 535; - Name_Elaboration_Check : constant Name_Id := N + 536; - Name_Index_Check : constant Name_Id := N + 537; - Name_Length_Check : constant Name_Id := N + 538; - Name_Overflow_Check : constant Name_Id := N + 539; - Name_Range_Check : constant Name_Id := N + 540; - Name_Storage_Check : constant Name_Id := N + 541; - Name_Tag_Check : constant Name_Id := N + 542; - Name_Validity_Check : constant Name_Id := N + 543; -- GNAT - Name_All_Checks : constant Name_Id := N + 544; - Last_Check_Name : constant Name_Id := N + 544; + First_Check_Name : constant Name_Id := N + 532; + Name_Access_Check : constant Name_Id := N + 532; + Name_Accessibility_Check : constant Name_Id := N + 533; + Name_Alignment_Check : constant Name_Id := N + 534; -- GNAT + Name_Discriminant_Check : constant Name_Id := N + 535; + Name_Division_Check : constant Name_Id := N + 536; + Name_Elaboration_Check : constant Name_Id := N + 537; + Name_Index_Check : constant Name_Id := N + 538; + Name_Length_Check : constant Name_Id := N + 539; + Name_Overflow_Check : constant Name_Id := N + 540; + Name_Range_Check : constant Name_Id := N + 541; + Name_Storage_Check : constant Name_Id := N + 542; + Name_Tag_Check : constant Name_Id := N + 543; + Name_Validity_Check : constant Name_Id := N + 544; -- GNAT + Name_All_Checks : constant Name_Id := N + 545; + Last_Check_Name : constant Name_Id := N + 545; -- Names corresponding to reserved keywords, excluding those already -- declared in the attribute list (Access, Delta, Digits, Mod, Range). - Name_Abort : constant Name_Id := N + 545; - Name_Abs : constant Name_Id := N + 546; - Name_Accept : constant Name_Id := N + 547; - Name_And : constant Name_Id := N + 548; - Name_All : constant Name_Id := N + 549; - Name_Array : constant Name_Id := N + 550; - Name_At : constant Name_Id := N + 551; - Name_Begin : constant Name_Id := N + 552; - Name_Body : constant Name_Id := N + 553; - Name_Case : constant Name_Id := N + 554; - Name_Constant : constant Name_Id := N + 555; - Name_Declare : constant Name_Id := N + 556; - Name_Delay : constant Name_Id := N + 557; - Name_Do : constant Name_Id := N + 558; - Name_Else : constant Name_Id := N + 559; - Name_Elsif : constant Name_Id := N + 560; - Name_End : constant Name_Id := N + 561; - Name_Entry : constant Name_Id := N + 562; - Name_Exception : constant Name_Id := N + 563; - Name_Exit : constant Name_Id := N + 564; - Name_For : constant Name_Id := N + 565; - Name_Function : constant Name_Id := N + 566; - Name_Generic : constant Name_Id := N + 567; - Name_Goto : constant Name_Id := N + 568; - Name_If : constant Name_Id := N + 569; - Name_In : constant Name_Id := N + 570; - Name_Is : constant Name_Id := N + 571; - Name_Limited : constant Name_Id := N + 572; - Name_Loop : constant Name_Id := N + 573; - Name_New : constant Name_Id := N + 574; - Name_Not : constant Name_Id := N + 575; - Name_Null : constant Name_Id := N + 576; - Name_Of : constant Name_Id := N + 577; - Name_Or : constant Name_Id := N + 578; - Name_Others : constant Name_Id := N + 579; - Name_Out : constant Name_Id := N + 580; - Name_Package : constant Name_Id := N + 581; - Name_Pragma : constant Name_Id := N + 582; - Name_Private : constant Name_Id := N + 583; - Name_Procedure : constant Name_Id := N + 584; - Name_Raise : constant Name_Id := N + 585; - Name_Record : constant Name_Id := N + 586; - Name_Rem : constant Name_Id := N + 587; - Name_Renames : constant Name_Id := N + 588; - Name_Return : constant Name_Id := N + 589; - Name_Reverse : constant Name_Id := N + 590; - Name_Select : constant Name_Id := N + 591; - Name_Separate : constant Name_Id := N + 592; - Name_Subtype : constant Name_Id := N + 593; - Name_Task : constant Name_Id := N + 594; - Name_Terminate : constant Name_Id := N + 595; - Name_Then : constant Name_Id := N + 596; - Name_Type : constant Name_Id := N + 597; - Name_Use : constant Name_Id := N + 598; - Name_When : constant Name_Id := N + 599; - Name_While : constant Name_Id := N + 600; - Name_With : constant Name_Id := N + 601; - Name_Xor : constant Name_Id := N + 602; + Name_Abort : constant Name_Id := N + 546; + Name_Abs : constant Name_Id := N + 547; + Name_Accept : constant Name_Id := N + 548; + Name_And : constant Name_Id := N + 549; + Name_All : constant Name_Id := N + 550; + Name_Array : constant Name_Id := N + 551; + Name_At : constant Name_Id := N + 552; + Name_Begin : constant Name_Id := N + 553; + Name_Body : constant Name_Id := N + 554; + Name_Case : constant Name_Id := N + 555; + Name_Constant : constant Name_Id := N + 556; + Name_Declare : constant Name_Id := N + 557; + Name_Delay : constant Name_Id := N + 558; + Name_Do : constant Name_Id := N + 559; + Name_Else : constant Name_Id := N + 560; + Name_Elsif : constant Name_Id := N + 561; + Name_End : constant Name_Id := N + 562; + Name_Entry : constant Name_Id := N + 563; + Name_Exception : constant Name_Id := N + 564; + Name_Exit : constant Name_Id := N + 565; + Name_For : constant Name_Id := N + 566; + Name_Function : constant Name_Id := N + 567; + Name_Generic : constant Name_Id := N + 568; + Name_Goto : constant Name_Id := N + 569; + Name_If : constant Name_Id := N + 570; + Name_In : constant Name_Id := N + 571; + Name_Is : constant Name_Id := N + 572; + Name_Limited : constant Name_Id := N + 573; + Name_Loop : constant Name_Id := N + 574; + Name_New : constant Name_Id := N + 575; + Name_Not : constant Name_Id := N + 576; + Name_Null : constant Name_Id := N + 577; + Name_Of : constant Name_Id := N + 578; + Name_Or : constant Name_Id := N + 579; + Name_Others : constant Name_Id := N + 580; + Name_Out : constant Name_Id := N + 581; + Name_Package : constant Name_Id := N + 582; + Name_Pragma : constant Name_Id := N + 583; + Name_Private : constant Name_Id := N + 584; + Name_Procedure : constant Name_Id := N + 585; + Name_Raise : constant Name_Id := N + 586; + Name_Record : constant Name_Id := N + 587; + Name_Rem : constant Name_Id := N + 588; + Name_Renames : constant Name_Id := N + 589; + Name_Return : constant Name_Id := N + 590; + Name_Reverse : constant Name_Id := N + 591; + Name_Select : constant Name_Id := N + 592; + Name_Separate : constant Name_Id := N + 593; + Name_Subtype : constant Name_Id := N + 594; + Name_Task : constant Name_Id := N + 595; + Name_Terminate : constant Name_Id := N + 596; + Name_Then : constant Name_Id := N + 597; + Name_Type : constant Name_Id := N + 598; + Name_Use : constant Name_Id := N + 599; + Name_When : constant Name_Id := N + 600; + Name_While : constant Name_Id := N + 601; + Name_With : constant Name_Id := N + 602; + Name_Xor : constant Name_Id := N + 603; -- Names of intrinsic subprograms -- Note: Asm is missing from this list, since Asm is a legitimate -- convention name. So is To_Address, which is a GNAT attribute. - First_Intrinsic_Name : constant Name_Id := N + 603; - Name_Divide : constant Name_Id := N + 603; - Name_Enclosing_Entity : constant Name_Id := N + 604; - Name_Exception_Information : constant Name_Id := N + 605; - Name_Exception_Message : constant Name_Id := N + 606; - Name_Exception_Name : constant Name_Id := N + 607; - Name_File : constant Name_Id := N + 608; - Name_Generic_Dispatching_Constructor : constant Name_Id := N + 609; - Name_Import_Address : constant Name_Id := N + 610; - Name_Import_Largest_Value : constant Name_Id := N + 611; - Name_Import_Value : constant Name_Id := N + 612; - Name_Is_Negative : constant Name_Id := N + 613; - Name_Line : constant Name_Id := N + 614; - Name_Rotate_Left : constant Name_Id := N + 615; - Name_Rotate_Right : constant Name_Id := N + 616; - Name_Shift_Left : constant Name_Id := N + 617; - Name_Shift_Right : constant Name_Id := N + 618; - Name_Shift_Right_Arithmetic : constant Name_Id := N + 619; - Name_Source_Location : constant Name_Id := N + 620; - Name_Unchecked_Conversion : constant Name_Id := N + 621; - Name_Unchecked_Deallocation : constant Name_Id := N + 622; - Name_To_Pointer : constant Name_Id := N + 623; - Last_Intrinsic_Name : constant Name_Id := N + 623; + First_Intrinsic_Name : constant Name_Id := N + 604; + Name_Divide : constant Name_Id := N + 604; + Name_Enclosing_Entity : constant Name_Id := N + 605; + Name_Exception_Information : constant Name_Id := N + 606; + Name_Exception_Message : constant Name_Id := N + 607; + Name_Exception_Name : constant Name_Id := N + 608; + Name_File : constant Name_Id := N + 609; + Name_Generic_Dispatching_Constructor : constant Name_Id := N + 610; + Name_Import_Address : constant Name_Id := N + 611; + Name_Import_Largest_Value : constant Name_Id := N + 612; + Name_Import_Value : constant Name_Id := N + 613; + Name_Is_Negative : constant Name_Id := N + 614; + Name_Line : constant Name_Id := N + 615; + Name_Rotate_Left : constant Name_Id := N + 616; + Name_Rotate_Right : constant Name_Id := N + 617; + Name_Shift_Left : constant Name_Id := N + 618; + Name_Shift_Right : constant Name_Id := N + 619; + Name_Shift_Right_Arithmetic : constant Name_Id := N + 620; + Name_Source_Location : constant Name_Id := N + 621; + Name_Unchecked_Conversion : constant Name_Id := N + 622; + Name_Unchecked_Deallocation : constant Name_Id := N + 623; + Name_To_Pointer : constant Name_Id := N + 624; + Last_Intrinsic_Name : constant Name_Id := N + 624; -- Names used in processing intrinsic calls - Name_Free : constant Name_Id := N + 624; + Name_Free : constant Name_Id := N + 625; -- Reserved words used only in Ada 95 - First_95_Reserved_Word : constant Name_Id := N + 625; - Name_Abstract : constant Name_Id := N + 625; - Name_Aliased : constant Name_Id := N + 626; - Name_Protected : constant Name_Id := N + 627; - Name_Until : constant Name_Id := N + 628; - Name_Requeue : constant Name_Id := N + 629; - Name_Tagged : constant Name_Id := N + 630; - Last_95_Reserved_Word : constant Name_Id := N + 630; + First_95_Reserved_Word : constant Name_Id := N + 626; + Name_Abstract : constant Name_Id := N + 626; + Name_Aliased : constant Name_Id := N + 627; + Name_Protected : constant Name_Id := N + 628; + Name_Until : constant Name_Id := N + 629; + Name_Requeue : constant Name_Id := N + 630; + Name_Tagged : constant Name_Id := N + 631; + Last_95_Reserved_Word : constant Name_Id := N + 631; subtype Ada_95_Reserved_Words is Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word; -- Miscellaneous names used in semantic checking - Name_Raise_Exception : constant Name_Id := N + 631; + Name_Raise_Exception : constant Name_Id := N + 632; -- Additional reserved words and identifiers used in GNAT Project Files -- Note that Name_External is already previously declared - Name_Ada_Roots : constant Name_Id := N + 632; - Name_Aggregate : constant Name_Id := N + 633; - Name_Archive_Builder : constant Name_Id := N + 634; - Name_Archive_Builder_Append_Option : constant Name_Id := N + 635; - Name_Archive_Indexer : constant Name_Id := N + 636; - Name_Archive_Suffix : constant Name_Id := N + 637; - Name_Binder : constant Name_Id := N + 638; - Name_Binder_Prefix : constant Name_Id := N + 639; - Name_Body_Suffix : constant Name_Id := N + 640; - Name_Builder : constant Name_Id := N + 641; - Name_Builder_Switches : constant Name_Id := N + 642; - Name_Compiler : constant Name_Id := N + 643; - Name_Compiler_Kind : constant Name_Id := N + 644; - Name_Config_Body_File_Name : constant Name_Id := N + 645; - Name_Config_Body_File_Name_Pattern : constant Name_Id := N + 646; - Name_Config_File_Switches : constant Name_Id := N + 647; - Name_Config_File_Unique : constant Name_Id := N + 648; - Name_Config_Spec_File_Name : constant Name_Id := N + 649; - Name_Config_Spec_File_Name_Pattern : constant Name_Id := N + 650; - Name_Configuration : constant Name_Id := N + 651; - Name_Cross_Reference : constant Name_Id := N + 652; - Name_Default_Language : constant Name_Id := N + 653; - Name_Default_Switches : constant Name_Id := N + 654; - Name_Dependency_Driver : constant Name_Id := N + 655; - Name_Dependency_File_Kind : constant Name_Id := N + 656; - Name_Dependency_Switches : constant Name_Id := N + 657; - Name_Driver : constant Name_Id := N + 658; - Name_Excluded_Source_Dirs : constant Name_Id := N + 659; - Name_Excluded_Source_Files : constant Name_Id := N + 660; - Name_Excluded_Source_List_File : constant Name_Id := N + 661; - Name_Exec_Dir : constant Name_Id := N + 662; - Name_Executable : constant Name_Id := N + 663; - Name_Executable_Suffix : constant Name_Id := N + 664; - Name_Extends : constant Name_Id := N + 665; - Name_Externally_Built : constant Name_Id := N + 666; - Name_Finder : constant Name_Id := N + 667; - Name_Global_Configuration_Pragmas : constant Name_Id := N + 668; - Name_Global_Config_File : constant Name_Id := N + 669; - Name_Gnatls : constant Name_Id := N + 670; - Name_Gnatstub : constant Name_Id := N + 671; - Name_Implementation : constant Name_Id := N + 672; - Name_Implementation_Exceptions : constant Name_Id := N + 673; - Name_Implementation_Suffix : constant Name_Id := N + 674; - Name_Include_Switches : constant Name_Id := N + 675; - Name_Include_Path : constant Name_Id := N + 676; - Name_Include_Path_File : constant Name_Id := N + 677; - Name_Inherit_Source_Path : constant Name_Id := N + 678; - Name_Language_Kind : constant Name_Id := N + 679; - Name_Language_Processing : constant Name_Id := N + 680; - Name_Languages : constant Name_Id := N + 681; - Name_Library : constant Name_Id := N + 682; - Name_Library_Ali_Dir : constant Name_Id := N + 683; - Name_Library_Auto_Init : constant Name_Id := N + 684; - Name_Library_Auto_Init_Supported : constant Name_Id := N + 685; - Name_Library_Builder : constant Name_Id := N + 686; - Name_Library_Dir : constant Name_Id := N + 687; - Name_Library_GCC : constant Name_Id := N + 688; - Name_Library_Interface : constant Name_Id := N + 689; - Name_Library_Kind : constant Name_Id := N + 690; - Name_Library_Name : constant Name_Id := N + 691; - Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 692; - Name_Library_Options : constant Name_Id := N + 693; - Name_Library_Partial_Linker : constant Name_Id := N + 694; - Name_Library_Reference_Symbol_File : constant Name_Id := N + 695; - Name_Library_Src_Dir : constant Name_Id := N + 696; - Name_Library_Support : constant Name_Id := N + 697; - Name_Library_Symbol_File : constant Name_Id := N + 698; - Name_Library_Symbol_Policy : constant Name_Id := N + 699; - Name_Library_Version : constant Name_Id := N + 700; - Name_Library_Version_Switches : constant Name_Id := N + 701; - Name_Linker : constant Name_Id := N + 702; - Name_Linker_Executable_Option : constant Name_Id := N + 703; - Name_Linker_Lib_Dir_Option : constant Name_Id := N + 704; - Name_Linker_Lib_Name_Option : constant Name_Id := N + 705; - Name_Local_Config_File : constant Name_Id := N + 706; - Name_Local_Configuration_Pragmas : constant Name_Id := N + 707; - Name_Locally_Removed_Files : constant Name_Id := N + 708; - Name_Map_File_Option : constant Name_Id := N + 709; - Name_Mapping_File_Switches : constant Name_Id := N + 710; - Name_Mapping_Spec_Suffix : constant Name_Id := N + 711; - Name_Mapping_Body_Suffix : constant Name_Id := N + 712; - Name_Metrics : constant Name_Id := N + 713; - Name_Naming : constant Name_Id := N + 714; - Name_Object_Generated : constant Name_Id := N + 715; - Name_Objects_Linked : constant Name_Id := N + 716; - Name_Objects_Path : constant Name_Id := N + 717; - Name_Objects_Path_File : constant Name_Id := N + 718; - Name_Object_Dir : constant Name_Id := N + 719; - Name_Pic_Option : constant Name_Id := N + 720; - Name_Pretty_Printer : constant Name_Id := N + 721; - Name_Prefix : constant Name_Id := N + 722; - Name_Project : constant Name_Id := N + 723; - Name_Roots : constant Name_Id := N + 724; - Name_Required_Switches : constant Name_Id := N + 725; - Name_Run_Path_Option : constant Name_Id := N + 726; - Name_Runtime_Project : constant Name_Id := N + 727; - Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 728; - Name_Shared_Library_Prefix : constant Name_Id := N + 729; - Name_Shared_Library_Suffix : constant Name_Id := N + 730; - Name_Separate_Suffix : constant Name_Id := N + 731; - Name_Source_Dirs : constant Name_Id := N + 732; - Name_Source_Files : constant Name_Id := N + 733; - Name_Source_List_File : constant Name_Id := N + 734; - Name_Spec : constant Name_Id := N + 735; - Name_Spec_Suffix : constant Name_Id := N + 736; - Name_Specification : constant Name_Id := N + 737; - Name_Specification_Exceptions : constant Name_Id := N + 738; - Name_Specification_Suffix : constant Name_Id := N + 739; - Name_Stack : constant Name_Id := N + 740; - Name_Switches : constant Name_Id := N + 741; - Name_Symbolic_Link_Supported : constant Name_Id := N + 742; - Name_Sync : constant Name_Id := N + 743; - Name_Synchronize : constant Name_Id := N + 744; - Name_Toolchain_Description : constant Name_Id := N + 745; - Name_Toolchain_Version : constant Name_Id := N + 746; - Name_Runtime_Library_Dir : constant Name_Id := N + 747; + Name_Ada_Roots : constant Name_Id := N + 633; + Name_Aggregate : constant Name_Id := N + 634; + Name_Archive_Builder : constant Name_Id := N + 635; + Name_Archive_Builder_Append_Option : constant Name_Id := N + 636; + Name_Archive_Indexer : constant Name_Id := N + 637; + Name_Archive_Suffix : constant Name_Id := N + 638; + Name_Binder : constant Name_Id := N + 639; + Name_Binder_Prefix : constant Name_Id := N + 640; + Name_Body_Suffix : constant Name_Id := N + 641; + Name_Builder : constant Name_Id := N + 642; + Name_Builder_Switches : constant Name_Id := N + 643; + Name_Compiler : constant Name_Id := N + 644; + Name_Compiler_Kind : constant Name_Id := N + 645; + Name_Config_Body_File_Name : constant Name_Id := N + 646; + Name_Config_Body_File_Name_Pattern : constant Name_Id := N + 647; + Name_Config_File_Switches : constant Name_Id := N + 648; + Name_Config_File_Unique : constant Name_Id := N + 649; + Name_Config_Spec_File_Name : constant Name_Id := N + 650; + Name_Config_Spec_File_Name_Pattern : constant Name_Id := N + 651; + Name_Configuration : constant Name_Id := N + 652; + Name_Cross_Reference : constant Name_Id := N + 653; + Name_Default_Language : constant Name_Id := N + 654; + Name_Default_Switches : constant Name_Id := N + 655; + Name_Dependency_Driver : constant Name_Id := N + 656; + Name_Dependency_File_Kind : constant Name_Id := N + 657; + Name_Dependency_Switches : constant Name_Id := N + 658; + Name_Driver : constant Name_Id := N + 659; + Name_Excluded_Source_Dirs : constant Name_Id := N + 660; + Name_Excluded_Source_Files : constant Name_Id := N + 661; + Name_Excluded_Source_List_File : constant Name_Id := N + 662; + Name_Exec_Dir : constant Name_Id := N + 663; + Name_Executable : constant Name_Id := N + 664; + Name_Executable_Suffix : constant Name_Id := N + 665; + Name_Extends : constant Name_Id := N + 666; + Name_Externally_Built : constant Name_Id := N + 667; + Name_Finder : constant Name_Id := N + 668; + Name_Global_Configuration_Pragmas : constant Name_Id := N + 669; + Name_Global_Config_File : constant Name_Id := N + 670; + Name_Gnatls : constant Name_Id := N + 671; + Name_Gnatstub : constant Name_Id := N + 672; + Name_Implementation : constant Name_Id := N + 673; + Name_Implementation_Exceptions : constant Name_Id := N + 674; + Name_Implementation_Suffix : constant Name_Id := N + 675; + Name_Include_Switches : constant Name_Id := N + 676; + Name_Include_Path : constant Name_Id := N + 677; + Name_Include_Path_File : constant Name_Id := N + 678; + Name_Inherit_Source_Path : constant Name_Id := N + 679; + Name_Language_Kind : constant Name_Id := N + 680; + Name_Language_Processing : constant Name_Id := N + 681; + Name_Languages : constant Name_Id := N + 682; + Name_Library : constant Name_Id := N + 683; + Name_Library_Ali_Dir : constant Name_Id := N + 684; + Name_Library_Auto_Init : constant Name_Id := N + 685; + Name_Library_Auto_Init_Supported : constant Name_Id := N + 686; + Name_Library_Builder : constant Name_Id := N + 687; + Name_Library_Dir : constant Name_Id := N + 688; + Name_Library_GCC : constant Name_Id := N + 689; + Name_Library_Interface : constant Name_Id := N + 690; + Name_Library_Kind : constant Name_Id := N + 691; + Name_Library_Name : constant Name_Id := N + 692; + Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 693; + Name_Library_Options : constant Name_Id := N + 694; + Name_Library_Partial_Linker : constant Name_Id := N + 695; + Name_Library_Reference_Symbol_File : constant Name_Id := N + 696; + Name_Library_Src_Dir : constant Name_Id := N + 697; + Name_Library_Support : constant Name_Id := N + 698; + Name_Library_Symbol_File : constant Name_Id := N + 699; + Name_Library_Symbol_Policy : constant Name_Id := N + 700; + Name_Library_Version : constant Name_Id := N + 701; + Name_Library_Version_Switches : constant Name_Id := N + 702; + Name_Linker : constant Name_Id := N + 703; + Name_Linker_Executable_Option : constant Name_Id := N + 704; + Name_Linker_Lib_Dir_Option : constant Name_Id := N + 705; + Name_Linker_Lib_Name_Option : constant Name_Id := N + 706; + Name_Local_Config_File : constant Name_Id := N + 707; + Name_Local_Configuration_Pragmas : constant Name_Id := N + 708; + Name_Locally_Removed_Files : constant Name_Id := N + 709; + Name_Map_File_Option : constant Name_Id := N + 710; + Name_Mapping_File_Switches : constant Name_Id := N + 711; + Name_Mapping_Spec_Suffix : constant Name_Id := N + 712; + Name_Mapping_Body_Suffix : constant Name_Id := N + 713; + Name_Metrics : constant Name_Id := N + 714; + Name_Naming : constant Name_Id := N + 715; + Name_Object_Generated : constant Name_Id := N + 716; + Name_Objects_Linked : constant Name_Id := N + 717; + Name_Objects_Path : constant Name_Id := N + 718; + Name_Objects_Path_File : constant Name_Id := N + 719; + Name_Object_Dir : constant Name_Id := N + 720; + Name_Pic_Option : constant Name_Id := N + 721; + Name_Pretty_Printer : constant Name_Id := N + 722; + Name_Prefix : constant Name_Id := N + 723; + Name_Project : constant Name_Id := N + 724; + Name_Roots : constant Name_Id := N + 725; + Name_Required_Switches : constant Name_Id := N + 726; + Name_Run_Path_Option : constant Name_Id := N + 727; + Name_Runtime_Project : constant Name_Id := N + 728; + Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 729; + Name_Shared_Library_Prefix : constant Name_Id := N + 730; + Name_Shared_Library_Suffix : constant Name_Id := N + 731; + Name_Separate_Suffix : constant Name_Id := N + 732; + Name_Source_Dirs : constant Name_Id := N + 733; + Name_Source_Files : constant Name_Id := N + 734; + Name_Source_List_File : constant Name_Id := N + 735; + Name_Spec : constant Name_Id := N + 736; + Name_Spec_Suffix : constant Name_Id := N + 737; + Name_Specification : constant Name_Id := N + 738; + Name_Specification_Exceptions : constant Name_Id := N + 739; + Name_Specification_Suffix : constant Name_Id := N + 740; + Name_Stack : constant Name_Id := N + 741; + Name_Switches : constant Name_Id := N + 742; + Name_Symbolic_Link_Supported : constant Name_Id := N + 743; + Name_Sync : constant Name_Id := N + 744; + Name_Synchronize : constant Name_Id := N + 745; + Name_Toolchain_Description : constant Name_Id := N + 746; + Name_Toolchain_Version : constant Name_Id := N + 747; + Name_Runtime_Library_Dir : constant Name_Id := N + 748; -- Other miscellaneous names used in front end - Name_Unaligned_Valid : constant Name_Id := N + 748; + Name_Unaligned_Valid : constant Name_Id := N + 749; -- Ada 2005 reserved words - First_2005_Reserved_Word : constant Name_Id := N + 749; - Name_Interface : constant Name_Id := N + 749; - Name_Overriding : constant Name_Id := N + 750; - Name_Synchronized : constant Name_Id := N + 751; - Last_2005_Reserved_Word : constant Name_Id := N + 751; + First_2005_Reserved_Word : constant Name_Id := N + 750; + Name_Interface : constant Name_Id := N + 750; + Name_Overriding : constant Name_Id := N + 751; + Name_Synchronized : constant Name_Id := N + 752; + Last_2005_Reserved_Word : constant Name_Id := N + 752; subtype Ada_2005_Reserved_Words is Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 751; + Last_Predefined_Name : constant Name_Id := N + 752; --------------------------------------- -- Subtypes Defining Name Categories -- @@ -1386,6 +1387,7 @@ package Snames is Pragma_Ada_2005, Pragma_Assertion_Policy, Pragma_C_Pass_By_Copy, + Pragma_Canonical_Streams, Pragma_Check_Name, Pragma_Check_Policy, Pragma_Compile_Time_Error, diff --git a/gcc/ada/snames.h b/gcc/ada/snames.h index 80ed0392a30..5c52b59ac57 100644 --- a/gcc/ada/snames.h +++ b/gcc/ada/snames.h @@ -227,169 +227,170 @@ extern unsigned char Get_Pragma_Id (int); #define Pragma_Ada_2005 3 #define Pragma_Assertion_Policy 4 #define Pragma_C_Pass_By_Copy 5 -#define Pragma_Check_Name 6 -#define Pragma_Check_Policy 7 -#define Pragma_Compile_Time_Error 8 -#define Pragma_Compile_Time_Warning 9 -#define Pragma_Compiler_Unit 10 -#define Pragma_Component_Alignment 11 -#define Pragma_Convention_Identifier 12 -#define Pragma_Debug_Policy 13 -#define Pragma_Detect_Blocking 14 -#define Pragma_Discard_Names 15 -#define Pragma_Elaboration_Checks 16 -#define Pragma_Eliminate 17 -#define Pragma_Extend_System 18 -#define Pragma_Extensions_Allowed 19 -#define Pragma_External_Name_Casing 20 -#define Pragma_Favor_Top_Level 21 -#define Pragma_Float_Representation 22 -#define Pragma_Implicit_Packing 23 -#define Pragma_Initialize_Scalars 24 -#define Pragma_Interrupt_State 25 -#define Pragma_License 26 -#define Pragma_Locking_Policy 27 -#define Pragma_Long_Float 28 -#define Pragma_No_Run_Time 29 -#define Pragma_No_Strict_Aliasing 30 -#define Pragma_Normalize_Scalars 31 -#define Pragma_Optimize_Alignment 32 -#define Pragma_Polling 33 +#define Pragma_Canonical_Streams 6 +#define Pragma_Check_Name 7 +#define Pragma_Check_Policy 8 +#define Pragma_Compile_Time_Error 9 +#define Pragma_Compile_Time_Warning 10 +#define Pragma_Compiler_Unit 11 +#define Pragma_Component_Alignment 12 +#define Pragma_Convention_Identifier 13 +#define Pragma_Debug_Policy 14 +#define Pragma_Detect_Blocking 15 +#define Pragma_Discard_Names 16 +#define Pragma_Elaboration_Checks 17 +#define Pragma_Eliminate 18 +#define Pragma_Extend_System 19 +#define Pragma_Extensions_Allowed 20 +#define Pragma_External_Name_Casing 21 +#define Pragma_Favor_Top_Level 22 +#define Pragma_Float_Representation 23 +#define Pragma_Implicit_Packing 24 +#define Pragma_Initialize_Scalars 25 +#define Pragma_Interrupt_State 26 +#define Pragma_License 27 +#define Pragma_Locking_Policy 28 +#define Pragma_Long_Float 29 +#define Pragma_No_Run_Time 30 +#define Pragma_No_Strict_Aliasing 31 +#define Pragma_Normalize_Scalars 32 +#define Pragma_Optimize_Alignment 33 #define Pragma_Persistent_BSS 34 -#define Pragma_Priority_Specific_Dispatching 35 -#define Pragma_Profile 36 -#define Pragma_Profile_Warnings 37 -#define Pragma_Propagate_Exceptions 38 -#define Pragma_Queuing_Policy 39 -#define Pragma_Ravenscar 40 -#define Pragma_Restricted_Run_Time 41 -#define Pragma_Restrictions 42 -#define Pragma_Restriction_Warnings 43 -#define Pragma_Reviewable 44 -#define Pragma_Source_File_Name 45 -#define Pragma_Source_File_Name_Project 46 -#define Pragma_Style_Checks 47 -#define Pragma_Suppress 48 -#define Pragma_Suppress_Exception_Locations 49 -#define Pragma_Task_Dispatching_Policy 50 -#define Pragma_Universal_Data 51 -#define Pragma_Unsuppress 52 -#define Pragma_Use_VADS_Size 53 -#define Pragma_Validity_Checks 54 -#define Pragma_Warnings 55 -#define Pragma_Wide_Character_Encoding 56 -#define Pragma_Abort_Defer 57 -#define Pragma_All_Calls_Remote 58 -#define Pragma_Annotate 59 -#define Pragma_Assert 60 -#define Pragma_Asynchronous 61 -#define Pragma_Atomic 62 -#define Pragma_Atomic_Components 63 -#define Pragma_Attach_Handler 64 -#define Pragma_Check 65 -#define Pragma_CIL_Constructor 66 -#define Pragma_Comment 67 -#define Pragma_Common_Object 68 -#define Pragma_Complete_Representation 69 -#define Pragma_Complex_Representation 70 -#define Pragma_Controlled 71 -#define Pragma_Convention 72 -#define Pragma_CPP_Class 73 -#define Pragma_CPP_Constructor 74 -#define Pragma_CPP_Virtual 75 -#define Pragma_CPP_Vtable 76 -#define Pragma_Debug 77 -#define Pragma_Elaborate 78 -#define Pragma_Elaborate_All 79 -#define Pragma_Elaborate_Body 80 -#define Pragma_Export 81 -#define Pragma_Export_Exception 82 -#define Pragma_Export_Function 83 -#define Pragma_Export_Object 84 -#define Pragma_Export_Procedure 85 -#define Pragma_Export_Value 86 -#define Pragma_Export_Valued_Procedure 87 -#define Pragma_External 88 -#define Pragma_Finalize_Storage_Only 89 -#define Pragma_Ident 90 -#define Pragma_Implemented_By_Entry 91 -#define Pragma_Import 92 -#define Pragma_Import_Exception 93 -#define Pragma_Import_Function 94 -#define Pragma_Import_Object 95 -#define Pragma_Import_Procedure 96 -#define Pragma_Import_Valued_Procedure 97 -#define Pragma_Inline 98 -#define Pragma_Inline_Always 99 -#define Pragma_Inline_Generic 100 -#define Pragma_Inspection_Point 101 -#define Pragma_Interface_Name 102 -#define Pragma_Interrupt_Handler 103 -#define Pragma_Interrupt_Priority 104 -#define Pragma_Java_Constructor 105 -#define Pragma_Java_Interface 106 -#define Pragma_Keep_Names 107 -#define Pragma_Link_With 108 -#define Pragma_Linker_Alias 109 -#define Pragma_Linker_Constructor 110 -#define Pragma_Linker_Destructor 111 -#define Pragma_Linker_Options 112 -#define Pragma_Linker_Section 113 -#define Pragma_List 114 -#define Pragma_Machine_Attribute 115 -#define Pragma_Main 116 -#define Pragma_Main_Storage 117 -#define Pragma_Memory_Size 118 -#define Pragma_No_Body 119 -#define Pragma_No_Return 120 -#define Pragma_Obsolescent 121 -#define Pragma_Optimize 122 -#define Pragma_Pack 123 -#define Pragma_Page 124 -#define Pragma_Passive 125 -#define Pragma_Postcondition 126 -#define Pragma_Precondition 127 -#define Pragma_Preelaborable_Initialization 128 -#define Pragma_Preelaborate 129 -#define Pragma_Preelaborate_05 130 -#define Pragma_Psect_Object 131 -#define Pragma_Pure 132 -#define Pragma_Pure_05 133 -#define Pragma_Pure_Function 134 -#define Pragma_Relative_Deadline 135 -#define Pragma_Remote_Call_Interface 136 -#define Pragma_Remote_Types 137 -#define Pragma_Share_Generic 138 -#define Pragma_Shared 139 -#define Pragma_Shared_Passive 140 -#define Pragma_Source_Reference 141 -#define Pragma_Static_Elaboration_Desired 142 -#define Pragma_Stream_Convert 143 -#define Pragma_Subtitle 144 -#define Pragma_Suppress_All 145 -#define Pragma_Suppress_Debug_Info 146 -#define Pragma_Suppress_Initialization 147 -#define Pragma_System_Name 148 -#define Pragma_Task_Info 149 -#define Pragma_Task_Name 150 -#define Pragma_Task_Storage 151 -#define Pragma_Time_Slice 152 -#define Pragma_Title 153 -#define Pragma_Unchecked_Union 154 -#define Pragma_Unimplemented_Unit 155 -#define Pragma_Universal_Aliasing 156 -#define Pragma_Unmodified 157 -#define Pragma_Unreferenced 158 -#define Pragma_Unreferenced_Objects 159 -#define Pragma_Unreserve_All_Interrupts 160 -#define Pragma_Volatile 161 -#define Pragma_Volatile_Components 162 -#define Pragma_Weak_External 163 -#define Pragma_AST_Entry 164 -#define Pragma_Fast_Math 165 -#define Pragma_Interface 166 -#define Pragma_Priority 167 -#define Pragma_Storage_Size 168 -#define Pragma_Storage_Unit 169 +#define Pragma_Polling 35 +#define Pragma_Priority_Specific_Dispatching 36 +#define Pragma_Profile 37 +#define Pragma_Profile_Warnings 38 +#define Pragma_Propagate_Exceptions 39 +#define Pragma_Queuing_Policy 40 +#define Pragma_Ravenscar 41 +#define Pragma_Restricted_Run_Time 42 +#define Pragma_Restrictions 43 +#define Pragma_Restriction_Warnings 44 +#define Pragma_Reviewable 45 +#define Pragma_Source_File_Name 46 +#define Pragma_Source_File_Name_Project 47 +#define Pragma_Style_Checks 48 +#define Pragma_Suppress 49 +#define Pragma_Suppress_Exception_Locations 50 +#define Pragma_Task_Dispatching_Policy 51 +#define Pragma_Universal_Data 52 +#define Pragma_Unsuppress 53 +#define Pragma_Use_VADS_Size 54 +#define Pragma_Validity_Checks 55 +#define Pragma_Warnings 56 +#define Pragma_Wide_Character_Encoding 57 +#define Pragma_Abort_Defer 58 +#define Pragma_All_Calls_Remote 59 +#define Pragma_Annotate 60 +#define Pragma_Assert 61 +#define Pragma_Asynchronous 62 +#define Pragma_Atomic 63 +#define Pragma_Atomic_Components 64 +#define Pragma_Attach_Handler 65 +#define Pragma_Check 66 +#define Pragma_CIL_Constructor 67 +#define Pragma_Comment 68 +#define Pragma_Common_Object 69 +#define Pragma_Complete_Representation 70 +#define Pragma_Complex_Representation 71 +#define Pragma_Controlled 72 +#define Pragma_Convention 73 +#define Pragma_CPP_Class 74 +#define Pragma_CPP_Constructor 75 +#define Pragma_CPP_Virtual 76 +#define Pragma_CPP_Vtable 77 +#define Pragma_Debug 78 +#define Pragma_Elaborate 79 +#define Pragma_Elaborate_All 80 +#define Pragma_Elaborate_Body 81 +#define Pragma_Export 82 +#define Pragma_Export_Exception 83 +#define Pragma_Export_Function 84 +#define Pragma_Export_Object 85 +#define Pragma_Export_Procedure 86 +#define Pragma_Export_Value 87 +#define Pragma_Export_Valued_Procedure 88 +#define Pragma_External 89 +#define Pragma_Finalize_Storage_Only 90 +#define Pragma_Ident 91 +#define Pragma_Implemented_By_Entry 92 +#define Pragma_Import 93 +#define Pragma_Import_Exception 94 +#define Pragma_Import_Function 95 +#define Pragma_Import_Object 96 +#define Pragma_Import_Procedure 97 +#define Pragma_Import_Valued_Procedure 98 +#define Pragma_Inline 99 +#define Pragma_Inline_Always 100 +#define Pragma_Inline_Generic 101 +#define Pragma_Inspection_Point 102 +#define Pragma_Interface_Name 103 +#define Pragma_Interrupt_Handler 104 +#define Pragma_Interrupt_Priority 105 +#define Pragma_Java_Constructor 106 +#define Pragma_Java_Interface 107 +#define Pragma_Keep_Names 108 +#define Pragma_Link_With 109 +#define Pragma_Linker_Alias 110 +#define Pragma_Linker_Constructor 111 +#define Pragma_Linker_Destructor 112 +#define Pragma_Linker_Options 113 +#define Pragma_Linker_Section 114 +#define Pragma_List 115 +#define Pragma_Machine_Attribute 116 +#define Pragma_Main 117 +#define Pragma_Main_Storage 118 +#define Pragma_Memory_Size 119 +#define Pragma_No_Body 120 +#define Pragma_No_Return 121 +#define Pragma_Obsolescent 122 +#define Pragma_Optimize 123 +#define Pragma_Pack 124 +#define Pragma_Page 125 +#define Pragma_Passive 126 +#define Pragma_Postcondition 127 +#define Pragma_Precondition 128 +#define Pragma_Preelaborable_Initialization 129 +#define Pragma_Preelaborate 130 +#define Pragma_Preelaborate_05 131 +#define Pragma_Psect_Object 132 +#define Pragma_Pure 133 +#define Pragma_Pure_05 134 +#define Pragma_Pure_Function 135 +#define Pragma_Relative_Deadline 136 +#define Pragma_Remote_Call_Interface 137 +#define Pragma_Remote_Types 138 +#define Pragma_Share_Generic 139 +#define Pragma_Shared 140 +#define Pragma_Shared_Passive 141 +#define Pragma_Source_Reference 142 +#define Pragma_Static_Elaboration_Desired 143 +#define Pragma_Stream_Convert 144 +#define Pragma_Subtitle 145 +#define Pragma_Suppress_All 146 +#define Pragma_Suppress_Debug_Info 147 +#define Pragma_Suppress_Initialization 148 +#define Pragma_System_Name 149 +#define Pragma_Task_Info 150 +#define Pragma_Task_Name 151 +#define Pragma_Task_Storage 152 +#define Pragma_Time_Slice 153 +#define Pragma_Title 154 +#define Pragma_Unchecked_Union 155 +#define Pragma_Unimplemented_Unit 156 +#define Pragma_Universal_Aliasing 157 +#define Pragma_Unmodified 158 +#define Pragma_Unreferenced 159 +#define Pragma_Unreferenced_Objects 160 +#define Pragma_Unreserve_All_Interrupts 161 +#define Pragma_Volatile 162 +#define Pragma_Volatile_Components 163 +#define Pragma_Weak_External 164 +#define Pragma_AST_Entry 165 +#define Pragma_Fast_Math 166 +#define Pragma_Interface 167 +#define Pragma_Priority 168 +#define Pragma_Storage_Size 169 +#define Pragma_Storage_Unit 170 /* End of snames.h (C version of Snames package spec) */ diff --git a/gcc/ada/tbuild.ads b/gcc/ada/tbuild.ads index 14028630021..cca0d200bf5 100644 --- a/gcc/ada/tbuild.ads +++ b/gcc/ada/tbuild.ads @@ -214,7 +214,7 @@ package Tbuild is -- Suffix is also a single upper case letter other than O,Q,U,W,X and is a -- required parameter (T is permitted). The constructed name is stored - -- using Find_Name so that it can be located using a subsequent Find_Name + -- using Name_Find so that it can be located using a subsequent Name_Find -- operation (i.e. it is properly hashed into the names table). The upper -- case letter given as the Suffix argument ensures that the name does -- not clash with any Ada identifier name. These generated names are @@ -228,7 +228,7 @@ package Tbuild is -- Suffix & Suffix_Index'Image -- where Suffix is a single upper case letter other than O,Q,U,W,X and is -- a required parameter (T is permitted). The constructed name is stored - -- using Find_Name so that it can be located using a subsequent Find_Name + -- using Name_Find so that it can be located using a subsequent Name_Find -- operation (i.e. it is properly hashed into the names table). The upper -- case letter given as the Suffix argument ensures that the name does -- not clash with any Ada identifier name. These generated names are |