From fbc67f84889a4d53b9c17f6a33368ee1f6f7a0e5 Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 14 Aug 2007 08:39:55 +0000 Subject: [PATCH] 2007-08-14 Robert Dewar Ed Schonberg * opt.ads: Warning for non-local exception propagation now off by default New switch -gnatI to disable representation clauses Implement new pragma Implicit_Packing * usage.adb: Warning for non-local exception propagation now off by default Add warning for unchecked conversion of pointers wi different conventions. New switch -gnatI to disable representation clauses * usage.adb: new switch -gnatyS * gnat_ugn.texi: For the gnatcheck Non_Qualified_Aggregates rule add a note that aggregates of anonymous array types are not flagged. -gnatwc now includes membership tests optimized away -gnatw.x warnings are now off by default Added conditional compilation Appendix Add documentation of -gnatI Add documentation for new -gnatyS style check Update documentation about SAL and auto-init on Windows. * gnat_rm.texi: Add documentation for pragma Check_Name and 'Enabled attribute Document that Eliminate on dispatching operation is ignored Document IDE attributes VCS_Repository_Root and VCS_Patch_Root. Document pragma Main Document pragma Implicit_Packing * sem_ch13.adb: Add warning for unchecked conversion of pointers wi different conventions New switch -gnatI to disable representation clauses * switch-c.adb (Scan_Front_End_Switches): When a -gnat switch is not recognized, report the invalid characters including "-gnat" instead of just the first character in the switch. New switch -gnatI to disable representation clauses Set Warn_On_Object_Renames_Function true for -gnatg * vms_data.ads: Add doc for /IGNORE_REP_CLAUSES Add STATEMENTS_AFTER_THEN_ELSE as synonym for -gnatyS Add qualifier /ADD_PROJECT_SEARCH_DIR= for different tools, equivalent to switch -aP (add directory to project search dir). * par-prag.adb: Implement new pragma Implicit_Packing * sem_prag.adb (Analyze_Pragma, case Complex_Representation): Mark the type as having a non-standard representation, to force expansion on conversion to related types. (Analyze_Pragma): Warn on misspelled pragma (Analyze_Pragma, case Convention_Identifier): Fix checking of second arg Ensure consistent use of # in error messages Implement pragma Implicit_Packing git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127421 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gnat_rm.texi | 155 ++++++++- gcc/ada/gnat_ugn.texi | 590 +++++++++++++++++++++++++++++++++-- gcc/ada/opt.ads | 71 +++-- gcc/ada/par-prag.adb | 2 + gcc/ada/sem_ch13.adb | 107 ++++--- gcc/ada/sem_prag.adb | 378 ++++++++++++++-------- gcc/ada/switch-c.adb | 95 +++--- gcc/ada/usage.adb | 16 +- gcc/ada/vms_data.ads | 848 ++++++++++++++++++++++++++++---------------------- 9 files changed, 1619 insertions(+), 643 deletions(-) diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 902498f..ce2daf3 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -108,6 +108,7 @@ Implementation Defined Pragmas * Pragma Assert:: * Pragma Ast_Entry:: * Pragma C_Pass_By_Copy:: +* Pragma Check_Name:: * Pragma Comment:: * Pragma Common_Object:: * Pragma Compile_Time_Error:: @@ -137,6 +138,7 @@ Implementation Defined Pragmas * Pragma Finalize_Storage_Only:: * Pragma Float_Representation:: * Pragma Ident:: +* Pragma Implicit_Packing:: * Pragma Import_Exception:: * Pragma Import_Function:: * Pragma Import_Object:: @@ -158,6 +160,7 @@ Implementation Defined Pragmas * Pragma Linker_Section:: * Pragma Long_Float:: * Pragma Machine_Attribute:: +* Pragma Main:: * Pragma Main_Storage:: * Pragma No_Body:: * Pragma No_Return:: @@ -217,6 +220,7 @@ Implementation Defined Attributes * Elab_Body:: * Elab_Spec:: * Emax:: +* Enabled:: * Enum_Rep:: * Epsilon:: * Fixed_Value:: @@ -673,6 +677,7 @@ consideration, the use of these pragmas should be minimized. * Pragma Assert:: * Pragma Ast_Entry:: * Pragma C_Pass_By_Copy:: +* Pragma Check_Name:: * Pragma Comment:: * Pragma Common_Object:: * Pragma Compile_Time_Error:: @@ -702,6 +707,7 @@ consideration, the use of these pragmas should be minimized. * Pragma Finalize_Storage_Only:: * Pragma Float_Representation:: * Pragma Ident:: +* Pragma Implicit_Packing:: * Pragma Import_Exception:: * Pragma Import_Function:: * Pragma Import_Object:: @@ -723,6 +729,7 @@ consideration, the use of these pragmas should be minimized. * Pragma Linker_Section:: * Pragma Long_Float:: * Pragma Machine_Attribute:: +* Pragma Main:: * Pragma Main_Storage:: * Pragma No_Body:: * Pragma No_Return:: @@ -1012,6 +1019,36 @@ 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 Check_Name +@unnumberedsec Pragma Check_Name +@cindex Defining check names +@cindex Check names, defining +@findex Check_Name +@noindent +Syntax: +@smallexample @c ada +pragma Check_Name (check_name_IDENTIFIER); +@end smallexample + +@noindent +This is a configuration pragma which defines a new implementation +defined check name (unless IDENTIFIER matches one of the predefined +check names, in which case the pragma has no effect). Check names +are global to a partition, so if two more more configuration pragmas +are present in a partition mentioning the same name, only one new +check name is introduced. + +An implementation defined check name introduced with this pragma may +be used in only three contexts: @code{pragma Suppress}, +@code{pragma Unsuppress}, +and as the prefix of a @code{Check_Name'Enabled} attribute reference. For +any of these three cases, the check name must be visible. A check +name is visible if it is in the configuration pragmas applying to +the current unit, or if it appears at the start of any unit that +is part of the dependency set of the current unit (e.g. units that +are mentioned in @code{with} clauses. + +Normally the default mechanism for passing C convention records to C @node Pragma Comment @unnumberedsec Pragma Comment @findex Comment @@ -1550,7 +1587,7 @@ always given as strings. At the moment, this form of distinguishing overloaded subprograms is implemented only partially, so we do not recommend using it for practical subprogram elimination. -Note, that in case of a parameterless procedure its profile is represented +Note that in case of a parameterless procedure its profile is represented as @code{Parameter_Types => ("")} Alternatively, the @code{Source_Location} parameter is used to specify @@ -1602,6 +1639,11 @@ Note that any change in the source files that includes removing, splitting of adding lines may make the set of Eliminate pragmas using SOURCE_LOCATION parameter illegal. +It is legal to use pragma Eliminate where the referenced entity is a +dispatching operation, but it is not clear what this would mean, since +in general the call does not know which entity is actually being called. +Consequently, a pragma Eliminate for a dispatching operation is ignored. + @node Pragma Export_Exception @unnumberedsec Pragma Export_Exception @cindex OpenVMS @@ -2117,6 +2159,41 @@ maximum allowed length is 31 characters, so if it is important to maintain compatibility with this compiler, you should obey this length limit. +@node Pragma Implicit_Packing +@unnumberedsec Pragma Implicit_Packing +@findex Implicit_Packing +@noindent +Syntax: + +@smallexample @c ada +pragma Implicit_Packing; +@end smallexample + +@noindent +This is a configuration pragma that requests implicit packing for packed +arrays for which a size clause is given but no explicit pragma Pack or +specification of Component_Size is present. Consider this example: + +@smallexample @c ada +type R is array (0 .. 7) of Boolean; +for R'Size use 8; +@end smallexample + +@noindent +In accordance with the recommendation in the RM (RM 13.3(53)), a Size clause +does not change the layout of a composite object. So the Size clause in the +above example is normally rejected, since the default layout of the array uses +8-bit components, and thus the array requires a minimum of 64 bits. + +If this declaration is compiled in a region of code covered by an occurrence +of the configuration pragma Implicit_Packing, then the Size clause in this +and similar examples will cause implicit packing and thus be accepted. For +this implicit packing to occur, the type in question must be an array of small +components whose size is known at compile time, and the Size clause must +specify the exact size that corresponds to the length of the array multiplied +by the size in bits of the component type. +@cindex Array packing + @node Pragma Import_Exception @unnumberedsec Pragma Import_Exception @cindex OpenVMS @@ -2916,6 +2993,27 @@ defined for each machine. See the GCC manual for further information. It is not possible to specify attributes defined by other languages, only attributes defined by the machine the code is intended to run on. +@node Pragma Main +@unnumberedsec Pragma Main +@cindex OpenVMS +@findex Main +@noindent +Syntax: + +@smallexample @c ada +pragma Main + (MAIN_OPTION [, MAIN_OPTION]); + +MAIN_OPTION ::= + [STACK_SIZE =>] static_integer_EXPRESSION +| [TASK_STACK_SIZE_DEFAULT =>] static_integer_EXPRESSION +| [TIME_SLICING_ENABLED =>] static_boolean_EXPRESSION +@end smallexample + +@noindent +This pragma is provided for compatibility with OpenVMS VAX Systems. It has +no effect in GNAT, other than being syntax checked. + @node Pragma Main_Storage @unnumberedsec Pragma Main_Storage @cindex OpenVMS @@ -2930,7 +3028,6 @@ pragma Main_Storage MAIN_STORAGE_OPTION ::= [WORKING_STORAGE =>] static_SIMPLE_EXPRESSION | [TOP_GUARD =>] static_SIMPLE_EXPRESSION - @end smallexample @noindent @@ -3181,7 +3278,7 @@ enumeration literal case). Syntax: @smallexample @c ada -pragma Passive ([Semaphore | No]); +pragma Passive [(Semaphore | No)]; @end smallexample @noindent @@ -3202,7 +3299,7 @@ optimized. GNAT does not attempt to optimize any tasks in this manner Syntax: @smallexample @c ada -pragma Persistent_BSS [local_NAME] +pragma Persistent_BSS [(local_NAME)] @end smallexample @noindent @@ -4567,6 +4664,7 @@ consideration, you should minimize the use of these attributes. * Elab_Body:: * Elab_Spec:: * Emax:: +* Enabled:: * Enum_Rep:: * Epsilon:: * Fixed_Value:: @@ -4806,6 +4904,27 @@ The @code{Emax} attribute is provided for compatibility with Ada 83. See the Ada 83 reference manual for an exact description of the semantics of this attribute. +@node Enabled +@unnumberedsec Enabled +@findex Enabled +@noindent +The @code{Enabled} attribute allows an application program to check at compile +time to see if the designated check is currently enabled. The prefix is a +simple identifier, referencing any predefined check name (other than +@code{All_Checks}) or a check name introduced by pragma Check_Name. If +no argument is given for the attribute, the check is for the general state +of the check, if an argument is given, then it is an entity name, and the +check indicates whether an @code{Suppress} or @code{Unsuppress} has been +given naming the entity (if not, then the argument is ignored). + +Note that instantiations inherit the check status at the point of the +instantiation, so a useful idiom is to have a library package that +introduces a check name with @code{pragma Check_Name}, and then contains +generic packages or subprograms which use the @code{Enabled} attribute +to see if the check is enabled. A user of this package can then issue +a @code{pragma Suppress} or @code{pragma Unsuppress} before instantiating +the package or subprogram, controlling whether the check will be present. + @node Enum_Rep @unnumberedsec Enum_Rep @cindex Representation of enums @@ -5847,7 +5966,8 @@ Followed. @code{Size} clause on a composite subtype should not affect the internal layout of components. @end cartouche -Followed. +Followed. But note that this can be overridden by use of the implementation +pragma Implicit_Packing in the case of packed arrays. @sp 1 @cartouche @@ -7322,7 +7442,12 @@ the last line is a single @code{LF} character (@code{16#0A#}). @strong{42}. Implementation-defined check names. See 11.5(27). @end cartouche @noindent -No implementation-defined check names are supported. +The implementation defined check name Alignment_Check controls checking of +address clause values for proper alignment (that is, the address supplied +must be consistent with the alignment of the type). + +In addition, a user program can add implementation-defined check names +by means of the pragma Check_Name. @sp 1 @cartouche @@ -7667,7 +7792,11 @@ This restriction ensures that the generated code does not contain any implicit @code{for} loops, either by modifying the generated code where possible, or by rejecting any construct that would otherwise generate an implicit -@code{for} loop. +@code{for} loop. If this restriction is active, it is possible to build +large array aggregates with all static components without generating an +intermediate temporary, and without generating a loop to initialize individual +components..Otherwise, a loop is created for arrays larger than about 5000 +scalar components. @item No_Initialize_Scalars @findex No_Initialize_Scalars @@ -7773,7 +7902,7 @@ throughout a partition. In the case of aggregates with others, if the aggregate has a dynamic size, there is no way to eliminate the elaboration code (such dynamic -bounds would be incompatible with @code{Preelaborate} in any case. If +bounds would be incompatible with @code{Preelaborate} in any case). If the bounds are static, then use of this restriction actually modifies the code choice of the compiler to avoid generating a loop, and instead generate the aggregate statically if possible, no matter how many times @@ -15638,6 +15767,16 @@ doing the check-in. This is a simple attribute. Its value is a string that specifies the command used by the VCS to check the validity of a log file. +@item VCS_Repository_Root +The VCS repository root path. This is used to create tags or branches +of the repository. For subversion the value should be the @code{URL} +as specified to check-out the working copy of the repository. + +@item VCS_Patch_Root +The local root directory to use for building patch file. All patch chunks +will be relative to this path. The root project directory is used if +this value is not defined. + @end table @node Package Renamings diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 12a79ba..ec77d30 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -205,6 +205,7 @@ AdaCore@* * Platform-Specific Information for the Run-Time Libraries:: * Example of Binder Output File:: * Elaboration Order Handling in GNAT:: +* Conditional Compilation:: * Inline Assembler:: * Compatibility and Porting Guide:: @ifset unw @@ -418,7 +419,6 @@ File Name Krunching Using gnatkr * Examples of gnatkr Usage:: Preprocessing Using gnatprep - * Using gnatprep:: * Switches for gnatprep:: * Form of Definitions File:: @@ -610,6 +610,13 @@ Elaboration Order Handling in GNAT * Summary of Procedures for Elaboration Control:: * Other Elaboration Order Considerations:: +Conditional Compilation +* Use of Boolean Constants:: +* Debugging - A Special Case:: +* Conditionalizing Declarations:: +* Use of Alternative Implementations:: +* Preprocessing:: + Inline Assembler * Basic Assembler Syntax:: @@ -784,7 +791,7 @@ file names on operating systems with a limit on the length of names. @item @ref{Preprocessing Using gnatprep}, describes @code{gnatprep}, a preprocessor utility that allows a single source file to be used to -generate multiple or parameterized source files, by means of macro +generate multiple or parameterized source files by means of macro substitution. @ifset vms @@ -870,6 +877,10 @@ output file for a sample program. you deal with elaboration order issues. @item +@ref{Conditional Compilation}, describes how to model conditional compilation, +both with Ada in general and with GNAT facilities in particular. + +@item @ref{Inline Assembler}, shows how to use the inline assembly facility in an Ada program. @@ -3893,10 +3904,16 @@ Identifier character set @ifclear vms (@var{c}=1/2/3/4/8/9/p/f/n/w). @end ifclear -@ifset vms For details of the possible selections for @var{c}, see @ref{Character Set Control}. -@end ifset + +@item ^-gnatI^IGNORE_REP_CLAUSES^ +@cindex @option{^-gnatI^IGNORE_REP_CLAUSES^} (@command{gcc}) +Ignore representation clauses. When this switch is used, all +representation clauses are treated as comments. This is useful +when initially porting code where you want to ignore rep clause +problems, and also for compiling foreign code (particularly +for use with ASIS). @item -gnatjnn @cindex @option{-gnatjnn} (@command{gcc}) @@ -4757,6 +4774,12 @@ then it will warn that the ``>'' or ``<'' part of the test is useless and that the operator could be replaced by ``=''. An example would be comparing a @code{Natural} variable <= 0. +This warning option also generates warnings if +one or both tests is optimized away in a membership test for integer +values if the result can be determined at compile time. Range tests on +enumeration types are not included, since it is common for such tests +to include an end point. + This warning can also be turned on using @option{-gnatwa}. @item -gnatwC @@ -5195,7 +5218,7 @@ This switch activates warnings for exception usage when pragma Restrictions (No_Exception_Propagation) is in effect. Warnings are given for implicit or explicit exception raises which are not covered by a local handler, and for exception handlers which do not cover a local raise. The default is that these -warnings are given. +warnings are not given. @item -gnatw.X @emph{Disable warnings for No_Exception_Propagation mode.} @@ -5867,6 +5890,14 @@ corresponding declaration. No specific casing style is imposed on identifiers. The only requirement is for consistency of references with declarations. +@item ^S^STATEMENTS_AFTER_THEN_ELSE^ +@emph{Check no statements after THEN/ELSE.} +If the ^letter S^word STATEMENTS_AFTER_THEN_ELSE^ appears in the +string after @option{-gnaty} then it is not permitted to write any +statements on the same line as a THEN OR ELSE keyword following the +keyword in an IF statement. OR ELSE and AND THEN are not affected, +and a special exception allows a pragma to appear after ELSE. + @item ^s^SPECS^ @emph{Check separate specs.} If the ^letter s^word SPECS^ appears in the string after @option{-gnaty} then @@ -6644,6 +6675,7 @@ the @option{-gnatR} switch). For @option{-gnatR1} (which is the default, so @option{-gnatR} with no parameter has the same effect), size and alignment information is listed for declared array and record types. For @option{-gnatR2}, size and alignment information is listed for all +declared types and objects. Finally @code{-gnatR3} includes symbolic expressions for values that are computed at run time for variant records. These symbolic expressions have a mostly obvious format with #n being used to represent the value of the n'th @@ -7406,7 +7438,7 @@ and the actual size needed for the current allocation request). For certain targets, notably VxWorks 653, the secondary stack is allocated by carving off a fixed ratio chunk of the -primary task stack. The -D option is used to defined the +primary task stack. The -D option is used to define the size of the environment task's secondary stack. @item ^-e^/ELABORATION_DEPENDENCIES^ @@ -15362,6 +15394,11 @@ GNAT-style comment beginning @item ^-c4^/COMMENTS_LAYOUT=REFORMAT^ Reformat comment blocks +@item ^-c5^/COMMENTS_LAYOUT=KEEP_SPECIAL^ +Keep unchanged special form comments + +Reformat comment blocks + @cindex @option{^-l@var{n}^/CONSTRUCT_LAYOUT^} (@command{gnatpp}) @item ^-l1^/CONSTRUCT_LAYOUT=GNAT^ GNAT-style layout (this is the default) @@ -15383,6 +15420,11 @@ stops. Do not place the keyword @code{is} on a separate line in a subprogram body in case if the specification occupies more then one line. +@cindex @option{^--separate-loop-then^/SEPARATE_LOOP_THEN^} (@command{gnatpp}) +@item ^--separate-loop-then^/SEPARATE_LOOP_THEN^ +Place the keyword @code{loop} in FOR and WHILE loop statements and the +keywird @code{then} in IF statements on a separate line. + @end table @ifclear vms @@ -15814,6 +15856,14 @@ comments may be reformatted in typical word processor style (that is, moving words between lines and putting as many words in a line as possible). +@noindent +The @option{^-c5^/COMMENTS_LAYOUT=KEEP_SPECIAL^} switch specifies, that comments +that has a special format (that is, a character that is neither a letter nor digit +not white space nor line break immediatelly following the leading @code{--} of +the comment) should be without any change moved from the argument source +into reformatted source. This switch allows to preserve comments that are used +as a special marks in the code (e.g. SPARK annotation). + @node Construct Layout @subsection Construct Layout @@ -16867,10 +16917,12 @@ $ gnatkr very_long_unit_name.ads/count=0 --> very_long_unit_name.ads @findex gnatprep @noindent -The @code{gnatprep} utility provides -a simple preprocessing capability for Ada programs. -It is designed for use with GNAT, but is not dependent on any special -features of GNAT. +This chapter discusses how to use GNAT's @code{gnatprep} utility for simple +preprocessing. +Although designed for use with GNAT, @code{gnatprep} does not depend on any +special GNAT features. +For further discussion of conditional compilation in general, see +@ref{Conditional Compilation}. @menu * Using gnatprep:: @@ -16879,6 +16931,7 @@ features of GNAT. * Form of Input Text for gnatprep:: @end menu + @node Using gnatprep @section Using @code{gnatprep} @@ -19781,7 +19834,7 @@ This rule has no parameters. @noindent Flag each call to a predefined relational operator (``<'', ``>'', ``<='', -``>='', ``='' and ``/='') for the predefined @code{Boolean} type. +``>='', ``='' and ``/='') for the predefined Boolean type. (This rule is useful in enforcing the SPARK language restrictions.) Calls to predefined relational operators of any type derived from @@ -20364,6 +20417,7 @@ A non-qualified aggregate is an aggregate that is not the expression of a qualified expression. A string literal is not considered an aggregate, but an array aggregate of a string type is considered as a normal aggregate. +Aggregates of anonymous array types are not flagged. This rule has no parameters. @@ -23309,7 +23363,7 @@ from HP Ada 83. @item @code{PASSIVE} -@item @code{PSET_OBJECT} +@item @code{PSECT_OBJECT} @item @code{SHARE_GENERIC} @@ -25510,9 +25564,9 @@ and in fact there is no correct order. If one of the two expressions is true, and the other is false, then one of the above orders is correct, and the other is incorrect. For example, -if @code{expression_1} = 1 and @code{expression_2} /= 2, -then the call to @code{Func_2} -will occur, but not the call to @code{Func_1.} +if @code{expression_1} /= 1 and @code{expression_2} = 2, +then the call to @code{Func_1} +will occur, but not the call to @code{Func_2.} This means that it is essential to elaborate the body of @code{Unit_1} before the body of @code{Unit_2}, so the first @@ -25801,7 +25855,7 @@ this case, an Ada compiler must diagnose the situation at bind time, and refuse to build an executable program. @item One or more orders exist, all incorrect -One or more acceptable elaboration orders exists, and all of them +One or more acceptable elaboration orders exist, and all of them generate an elaboration order problem. In this case, the binder can build an executable program, but @code{Program_Error} will be raised when the program is run. @@ -26976,8 +27030,8 @@ of errors. One switch that is useful in this testing is the @option{^-p (pessimistic elaboration order)^/PESSIMISTIC_ELABORATION_ORDER^} switch for @code{gnatbind}. -Normally the binder tries to find an order that has the best chance of -of avoiding elaboration problems. With this switch, the binder +Normally the binder tries to find an order that has the best chance +of avoiding elaboration problems. However, if this switch is used, the binder plays a devil's advocate role, and tries to choose the order that has the best chance of failing. If your program works even with this switch, then it has a better chance of being error free, but this is still @@ -27205,8 +27259,472 @@ difference, by looking at the two elaboration orders that are chosen, and figuring out which is correct, and then adding the necessary @code{Elaborate} or @code{Elaborate_All} pragmas to ensure the desired order. + + +@c ******************************* +@node Conditional Compilation +@appendix Conditional Compilation +@c ******************************* +@cindex Conditional compilation + +@noindent +It is often necessary to arrange for a single source program +to serve multiple purposes, where it is compiled in different +ways to achieve these different goals. Some examples of the +need for this feature are + +@itemize @bullet +@item Adapting a program to a different hardware environment +@item Adapting a program to a different target architecture +@item Turning debugging features on and off +@item Arranging for a program to compile with different compilers +@end itemize + +@noindent +In C, or C++, the typical approach would be to use the preprocessor +that is defined as part of the language. The Ada language does not +contain such a feature. This is not an oversight, but rather a very +deliberate design decision, based on the experience that overuse of +the preprocessing features in C and C++ can result in programs that +are extremely difficult to maintain. For example, if we have ten +switches that can be on or off, this means that there are a thousand +separate programs, any one of which might not even be syntactically +correct, and even if syntactically correct, the resulting program +might not work correctly. Testing all combinations can quickly become +impossible. + +Nevertheless, the need to tailor programs certainly exists, and in +this Appendix we will discuss how this can +be achieved using Ada in general, and GNAT in particular. + +@menu +* Use of Boolean Constants:: +* Debugging - A Special Case:: +* Conditionalizing Declarations:: +* Use of Alternative Implementations:: +* Preprocessing:: +@end menu + +@node Use of Boolean Constants +@section Use of Boolean Constants + +@noindent +In the case where the difference is simply which code +sequence is executed, the cleanest solution is to use Boolean +constants to control which code is executed. + +@smallexample @c ada +@group +FP_Initialize_Required : constant Boolean := True; +... +if FP_Initialize_Required then +... +end if; +@end group +@end smallexample + +@noindent +Not only will the code inside the @code{if} statement not be executed if +the constant Boolean is @code{False}, but it will also be completely +deleted from the program. +However, the code is only deleted after the @code{if} statement +has been checked for syntactic and semantic correctness. +(In contrast, with preprocessors the code is deleted before the +compiler ever gets to see it, so it is not checked until the switch +is turned on.) +@cindex Preprocessors (contrasted with conditional compilation) + +Typically the Boolean constants will be in a separate package, +something like: + +@smallexample @c ada +@group +package Config is + FP_Initialize_Required : constant Boolean := True; + Reset_Available : constant Boolean := False; + ... +end Config; +@end group +@end smallexample + +@noindent +The @code{Config} package exists in multiple forms for the various targets, +with an appropriate script selecting the version of @code{Config} needed. +Then any other unit requiring conditional compilation can do a @code{with} +of @code{Config} to make the constants visible. + + +@node Debugging - A Special Case +@section Debugging - A Special Case + +@noindent +A common use of conditional code is to execute statements (for example +dynamic checks, or output of intermediate results) under control of a +debug switch, so that the debugging behavior can be turned on and off. +This can be done using a Boolean constant to control whether the code +is active: + +@smallexample @c ada +@group +if Debugging then + Put_Line ("got to the first stage!"); +end if; +@end group +@end smallexample + +@noindent +or + +@smallexample @c ada +@group +if Debugging and then Temperature > 999.0 then + raise Temperature_Crazy; +end if; +@end group +@end smallexample + +@noindent +Since this is a common case, there are special features to deal with +this in a convenient manner. For the case of tests, Ada 2005 has added +a pragma @code{Assert} that can be used for such tests. This pragma is modeled +@cindex pragma @code{Assert} +on the @code{Assert} pragma that has always been available in GNAT, so this +feature may be used with GNAT even if you are not using Ada 2005 features. +The use of pragma @code{Assert} is described in the +@cite{GNAT Reference Manual}, but as an example, the last test could be written: + +@smallexample @c ada +pragma Assert (Temperature <= 999.0, "Temperature Crazy"); +@end smallexample + +@noindent +or simply + +@smallexample @c ada +pragma Assert (Temperature <= 999.0); +@end smallexample + +@noindent +In both cases, if assertions are active and the temperature is excessive, +the exception @code{Assert_Failure} will be raised, with the given string in +the first case or a string indicating the location of the pragma in the second +case used as the exception message. + +You can turn assertions on and off by using the @code{Assertion_Policy} +pragma. +@cindex pragma @code{Assertion_Policy} +This is an Ada 2005 pragma which is implemented in all modes by +GNAT, but only in the latest versions of GNAT which include Ada 2005 +capability. Alternatively, you can use the @option{-gnata} switch +@cindex @option{-gnata} switch +to enable assertions from the command line (this is recognized by all versions +of GNAT). + +For the example above with the @code{Put_Line}, the GNAT-specific pragma +@code{Debug} can be used: +@cindex pragma @code{Debug} + +@smallexample @c ada +pragma Debug (Put_Line ("got to the first stage!")); +@end smallexample + +@noindent +If debug pragmas are enabled, the argument, which must be of the form of +a procedure call, is executed (in this case, @code{Put_Line} will be called). +Only one call can be present, but of course a special debugging procedure +containing any code you like can be included in the program and then +called in a pragma @code{Debug} argument as needed. + +One advantage of pragma @code{Debug} over the @code{if Debugging then} +construct is that pragma @code{Debug} can appear in declarative contexts, +such as at the very beginning of a procedure, before local declarations have +been elaborated. + +Debug pragmas are enabled using either the @option{-gnata} switch that also +controls assertions, or with a separate Debug_Policy pragma. +@cindex pragma @code{Debug_Policy} +The latter pragma is new in the Ada 2005 versions of GNAT (but it can be used +in Ada 95 and Ada 83 programs as well), and is analogous to +pragma @code{Assertion_Policy} to control assertions. + +@code{Assertion_Policy} and @code{Debug_Policy} are configuration pragmas, +and thus they can appear in @file{gnat.adc} if you are not using a +project file, or in the file designated to contain configuration pragmas +in a project file. +They then apply to all subsequent compilations. In practice the use of +the @option{-gnata} switch is often the most convenient method of controlling +the status of these pragmas. + +Note that a pragma is not a statement, so in contexts where a statement +sequence is required, you can't just write a pragma on its own. You have +to add a @code{null} statement. + +@smallexample @c ada +@group +if ... then + ... -- some statements +else + pragma Assert (Num_Cases < 10); + null; +end if; +@end group +@end smallexample + + +@node Conditionalizing Declarations +@section Conditionalizing Declarations + +@noindent +In some cases, it may be necessary to conditionalize declarations to meet +different requirements. For example we might want a bit string whose length +is set to meet some hardware message requirement. + +In some cases, it may be possible to do this using declare blocks controlled +by conditional constants: + +@smallexample @c ada +@group +if Small_Machine then + declare + X : Bit_String (1 .. 10); + begin + ... + end; +else + declare + X : Large_Bit_String (1 .. 1000); + begin + ... + end; +end if; +@end group +@end smallexample + +@noindent +Note that in this approach, both declarations are analyzed by the +compiler so this can only be used where both declarations are legal, +even though one of them will not be used. + +Another approach is to define integer constants, e.g. @code{Bits_Per_Word}, or +Boolean constants, e.g. @code{Little_Endian}, and then write declarations +that are parameterized by these constants. For example + +@smallexample @c ada +@group +for Rec use + Field1 at 0 range Boolean'Pos (Little_Endian) * 10 .. Bits_Per_Word; +end record; +@end group +@end smallexample + +@noindent +If @code{Bits_Per_Word} is set to 32, this generates either + +@smallexample @c ada +@group +for Rec use + Field1 at 0 range 0 .. 32; +end record; +@end group +@end smallexample + +@noindent +for the big endian case, or + +@smallexample @c ada +@group +for Rec use record + Field1 at 0 range 10 .. 32; +end record; +@end group +@end smallexample + +@noindent +for the little endian case. Since a powerful subset of Ada expression +notation is usable for creating static constants, clever use of this +feature can often solve quite difficult problems in conditionalizing +compilation (note incidentally that in Ada 95, the little endian +constant was introduced as @code{System.Default_Bit_Order}, so you do not +need to define this one yourself). + + +@node Use of Alternative Implementations +@section Use of Alternative Implementations + +@noindent +In some cases, none of the approaches described above are adequate. This +can occur for example if the set of declarations required is radically +different for two different configurations. + +In this situation, the official Ada way of dealing with conditionalizing +such code is to write separate units for the different cases. As long as +this does not result in excessive duplication of code, this can be done +without creating maintenance problems. The approach is to share common +code as far as possible, and then isolate the code and declarations +that are different. Subunits are often a convenient method for breaking +out a piece of a unit that is to be conditionalized, with separate files +for different versions of the subunit for different targets, where the +build script selects the right one to give to the compiler. +@cindex Subunits (and conditional compilation) + +As an example, consider a situation where a new feature in Ada 2005 +allows something to be done in a really nice way. But your code must be able +to compile with an Ada 95 compiler. Conceptually you want to say: + +@smallexample @c ada +@group +if Ada_2005 then + ... neat Ada 2005 code +else + ... not quite as neat Ada 95 code +end if; +@end group +@end smallexample + +@noindent +where @code{Ada_2005} is a Boolean constant. + +But this won't work when @code{Ada_2005} is set to @code{False}, +since the @code{then} clause will be illegal for an Ada 95 compiler. +(Recall that although such unreachable code would eventually be deleted +by the compiler, it still needs to be legal. If it uses features +introduced in Ada 2005, it will be illegal in Ada 95.) + +So instead we write + +@smallexample @c ada +procedure Insert is separate; +@end smallexample + +@noindent +Then we have two files for the subunit @code{Insert}, with the two sets of +code. +If the package containing this is called @code{File_Queries}, then we might +have two files + +@itemize @bullet +@item @file{file_queries-insert-2005.adb} +@item @file{file_queries-insert-95.adb} +@end itemize + +@noindent +and the build script renames the appropriate file to + +@smallexample +file_queries-insert.adb +@end smallexample + +@noindent +and then carries out the compilation. + +This can also be done with project files' naming schemes. For example: + +@smallexample @c project +For Body ("File_Queries.Insert") use "file_queries-insert-2005.ada"; +@end smallexample + +@noindent +Note also that with project files it is desirable to use a different extension +than @file{ads} / @file{adb} for alternativee versions. Otherwise a naming +conflict may arise through another commonly used feature: to declare as part +of the project a set of directories containing all the sources obeying the +default naming scheme. + +The use of alternative units is certainly feasible in all situations, +and for example the Ada part of the GNAT run-time is conditionalized +based on the target architecture using this approach. As a specific example, +consider the implementation of the AST feature in VMS. There is one +spec: + +@smallexample +s-asthan.ads +@end smallexample + +@noindent +which is the same for all architectures, and three bodies: + +@table @file +@item s-asthan.adb +used for all non-VMS operating systems +@item s-asthan-vms-alpha.adb +used for VMS on the Alpha +@item s-asthan-vms-ia64.adb +used for VMS on the ia64 +@end table + +@noindent +The dummy version @file{s-asthan.adb} simply raises exceptions noting that +this operating system feature is not available, and the two remaining +versions interface with the corresponding versions of VMS to provide +VMS-compatible AST handling. The GNAT build script knows the architecture +and operating system, and automatically selects the right version, +renaming it if necessary to @file{s-asthan.adb} before the run-time build. + +Another style for arranging alternative implementations is through Ada's +access-to-subprogram facility. +In case some functionality is to be conditionally included, +you can declare an access-to-procedure variable @code{Ref} that is initialized +to designate a ``do nothing'' procedure, and then invoke @code{Ref.all} +when appropriate. +In some library package, set @code{Ref} to @code{Proc'Access} for some +procedure @code{Proc} that performs the relevant processing. +The initialization only occurs if the library package is included in the +program. +The same idea can also be implemented using tagged types and dispatching +calls. + + +@node Preprocessing +@section Preprocessing +@cindex Preprocessing + +@noindent +Although it is quite possible to conditionalize code without the use of +C-style preprocessing, as described earlier in this section, it is +nevertheless convenient in some cases to use the C approach. Moreover, +older Ada compilers have often provided some preprocessing capability, +so legacy code may depend on this approach, even though it is not +standard. + +To accommodate such use, GNAT provides a preprocessor (modeled to a large +extent on the various preprocessors that have been used +with legacy code on other compilers, to enable easier transition). + +The preprocessor may be used in two separate modes. It can be used quite +separately from the compiler, to generate a separate output source file +that is then fed to the compiler as a separate step. This is the +@code{gnatprep} utility, whose use is fully described in +@ref{Preprocessing Using gnatprep}. +@cindex @code{gnatprep} + +The preprocessing language allows such constructs as + +@smallexample +@group +#if DEBUG or PRIORITY > 4 then + bunch of declarations +#else + completely different bunch of declarations +#end if; +@end group +@end smallexample + +@noindent +The values of the symbols @code{DEBUG} and @code{PRIORITY} can be +defined either on the command line or in a separate file. + +The other way of running the preprocessor is even closer to the C style and +often more convenient. In this approach the preprocessing is integrated into +the compilation process. The compiler is fed the preprocessor input which +includes @code{#if} lines etc, and then the compiler carries out the +preprocessing internally and processes the resulting output. +For more details on this approach, see @ref{Integrated Preprocessing}. + + +@c ******************************* @node Inline Assembler @appendix Inline Assembler +@c ******************************* @noindent If you need to write low-level software that interacts directly @@ -29346,8 +29864,8 @@ provided by @file{API.dll} you must statically link against the DLL or an import library which contains a jump table with an entry for each routine and variable exported by the DLL. In the Microsoft world this import library is called @file{API.lib}. When using GNAT this import -library is called either @file{libAPI.a} or @file{libapi.a} (names are -case insensitive). +library is called either @file{libAPI.dll.a}, @file{libapi.dll.a}, +@file{libAPI.a} or @file{libapi.a} (names are case insensitive). After you have linked your application with the DLL or the import library and you run your application, here is what happens: @@ -29377,7 +29895,7 @@ routines and routines in the application using the DLL. @end itemize @item -The entries in the jump table (from the import library @file{libAPI.a} +The entries in the jump table (from the import library @file{libAPI.dll.a} or @file{API.lib} or automatically created when linking against a DLL) which is part of your application are initialized with the addresses of the routines and variables in @file{API.dll}. @@ -29427,7 +29945,7 @@ The Ada spec for the routines and/or variables you want to access in header files provided with the DLL. @item -The import library (@file{libAPI.a} or @file{API.lib}). As previously +The import library (@file{libAPI.dll.a} or @file{API.lib}). As previously mentioned an import library is a statically linked library containing the import table which will be filled at load time to point to the actual @file{API.dll} routines. Sometimes you don't have an import library for the @@ -29450,7 +29968,8 @@ $ gnatmake my_ada_app -largs -lAPI @noindent The argument @option{-largs -lAPI} at the end of the @command{gnatmake} command tells the GNAT linker to look first for a library named @file{API.lib} -(Microsoft-style name) and if not found for a library named @file{libAPI.a} +(Microsoft-style name) and if not found for a libraries named +@file{libAPI.dll.a}, @file{API.dll.a} or @file{libAPI.a}. (GNAT-style name). Note that if the Ada package spec for @file{API.dll} contains the following pragma @@ -29526,10 +30045,11 @@ can have @code{C} or @code{Stdcall} convention. @noindent If a Microsoft-style import library @file{API.lib} or a GNAT-style -import library @file{libAPI.a} is available with @file{API.dll} you -can skip this section. You can also skip this section if -@file{API.dll} is built with GNU tools as in this case it is possible -to link directly against the DLL. Otherwise read on. +import library @file{libAPI.dll.a} or @file{libAPI.a} is available +with @file{API.dll} you can skip this section. You can also skip this +section if @file{API.dll} or @file{libAPI.dll} is built with GNU tools +as in this case it is possible to link directly against the +DLL. Otherwise read on. @node The Definition File @subsubsection The Definition File @@ -29633,7 +30153,7 @@ definition file and add the right suffix. @end enumerate @item -Build the import library @code{libAPI.a}, using @code{gnatdll} +Build the import library @code{libAPI.dll.a}, using @code{gnatdll} (@pxref{Using gnatdll}) as follows: @smallexample @@ -29757,7 +30277,13 @@ $ gnatmake main -Iapilib -bargs -shared -largs -Lapilib -lAPI @cindex DLLs, building @noindent -There is nothing specific to Windows in this area. @pxref{Library Projects}. +There is nothing specific to Windows in the build process. +@pxref{Library Projects}. + +@noindent +Due to a system limitation, it is not possible under Windows to create threads +when inside the @code{DllMain} routine which is used for auto-initialization +of shared libraries, so it is not possible to have library level tasks in SALs. @node Building DLLs with gnatdll @section Building DLLs with gnatdll @@ -30155,7 +30681,7 @@ Binder options. Pass @var{opts} to the binder. @code{gnatdll} to do anything. The name of the generated import library is obtained algorithmically from @var{dllfile} as shown in the following example: if @var{dllfile} is @code{xyz.dll}, the import library name is -@code{libxyz.a}. The name of the definition file to use (if not specified +@code{libxyz.dll.a}. The name of the definition file to use (if not specified by option @option{-e}) is obtained algorithmically from @var{dllfile} as shown in the following example: if @var{dllfile} is @code{xyz.dll}, the definition @@ -30227,7 +30753,7 @@ $ gnatdll -d api.dll api.ali @end smallexample @noindent -The above command creates two files: @file{libapi.a} (the import +The above command creates two files: @file{libapi.dll.a} (the import library) and @file{api.dll} (the actual DLL). If you want to create only the DLL, just type: @@ -30305,7 +30831,7 @@ $ gnatlink api -o api.jnk api.exp -mdll @item @code{gnatdll} builds the new export table using the new base file and -generates the DLL import library @file{libAPI.a}. +generates the DLL import library @file{libAPI.dll.a}. @smallexample @group diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 14d04db..69676a9 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -386,11 +386,6 @@ package Opt is -- Set to True if -gnato (enable overflow checks) switch is set, -- but not -gnatp. - Overflow_Checks_Unsuppressed : Boolean := False; - -- GNAT - -- Set to True if at least one pragma Unsuppress - -- (All_Checks|Overflow_Checks) has been processed. - Error_Msg_Line_Length : Nat := 0; -- GNAT -- Records the error message line length limit. If this is set to zero, @@ -533,11 +528,6 @@ package Opt is -- GNAT -- True if High Level Optimizer is activated (-gnatH switch) - Implementation_Unit_Warnings : Boolean := True; - -- GNAT - -- Set True to active warnings for use of implementation internal units. - -- Can be controlled by use of -gnatwi/-gnatwI. - Identifier_Character_Set : Character; -- GNAT -- This variable indicates the character set to be used for identifiers. @@ -561,6 +551,23 @@ package Opt is -- default value appropriate to the system (in Osint.Initialize), and then -- reset if a command line switch is used to change the setting. + Ignore_Rep_Clauses : Boolean := False; + -- GNAT + -- Set True to ignore all representation clauses. Useful when compiling + -- code from foreign compilers for checking or ASIS purposes. Can be + -- set True by use of -gnatI. + + Implementation_Unit_Warnings : Boolean := True; + -- GNAT + -- Set True to active warnings for use of implementation internal units. + -- Can be controlled by use of -gnatwi/-gnatwI. + + Implicit_Packing : Boolean := False; + -- GNAT + -- If set True, then a Size attribute clause on an array is allowed to + -- cause implicit packing instead of generating an error message. Set by + -- use of pragma Implicit_Packing. + Ineffective_Inline_Warnings : Boolean := False; -- GNAT -- Set True to activate warnings if front-end inlining (-gnatN) is not @@ -842,6 +849,11 @@ package Opt is -- GNATBIND -- True if output of list of objects is requested (-O switch set) + Overflow_Checks_Unsuppressed : Boolean := False; + -- GNAT + -- Set to True if at least one pragma Unsuppress + -- (All_Checks|Overflow_Checks) has been processed. + Persistent_BSS_Mode : Boolean := False; -- GNAT -- True if a Persistent_BSS configuration pragma is in effect, causing @@ -1178,12 +1190,12 @@ package Opt is -- variable that is at least partially uninitialized. Set to false to -- suppress such warnings. The default is that such warnings are enabled. - Warn_On_Non_Local_Exception : Boolean := True; + Warn_On_Non_Local_Exception : Boolean := False; -- GNAT -- Set to True to generate warnings for non-local exception raises and also -- handlers that can never handle a local raise. This warning is only ever -- generated if pragma Restrictions (No_Exception_Propagation) is set. The - -- default is to generate the warnings if the restriction is set. + -- default is not to generate the warnings even if the restriction is set. Warn_On_Obsolescent_Feature : Boolean := False; -- GNAT @@ -1375,9 +1387,9 @@ package Opt is -- parameter Internal_Unit is True for an internal or predefined unit, and -- affects the way the switches are set (see above). Main_Unit is true if -- switches are being set for the main unit (this affects setting of the - -- assert/debug pragm switches, which are normally set false by default for - -- an internal unit, except when the internal unit is the main unit, in - -- which case we use the command line settings). + -- assert/debug pragma switches, which are normally set false by default + -- for an internal unit, except when the internal unit is the main unit, + -- in which case we use the command line settings). procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type); -- This procedure restores a set of switch values previously saved by a @@ -1392,15 +1404,6 @@ package Opt is -- Other Global Flags -- ------------------------ - Static_Dispatch_Tables : constant Boolean; - -- This flag indicates if the backend supports generation of statically - -- allocated dispatch tables. If it is True, then the front end will - -- generate static aggregates for dispatch tables that contain forward - -- references to addresses of subprograms not seen yet, and the back end - -- must be prepared to handle this case. If it is False, then the front - -- end generates assignments to initialize the dispatch table, and there - -- are no such forward references. - Expander_Active : Boolean := False; -- A flag that indicates if expansion is active (True) or deactivated -- (False). When expansion is deactivated all calls to expander routines @@ -1411,6 +1414,18 @@ package Opt is -- be in the spec of Expander, but it is referenced by Errout, and it -- really seems wrong for Errout to depend on Expander. + Static_Dispatch_Tables : Boolean := True; + -- This flag indicates if the backend supports generation of statically + -- allocated dispatch tables. If it is True, then the front end will + -- generate static aggregates for dispatch tables that contain forward + -- references to addresses of subprograms not seen yet, and the back end + -- must be prepared to handle this case. If it is False, then the front + -- end generates assignments to initialize the dispatch table, and there + -- are no such forward references. By default we build statically allocated + -- dispatch tables for all library level tagged types in all platforms.This + -- behavior can be disabled using switch -gnatd.t which will set this flag + -- to False and revert to the previous dynamic behavior. + ----------------------- -- Tree I/O Routines -- ----------------------- @@ -1474,6 +1489,10 @@ private -- not let client code in the compiler test GCC_Version directly, but -- instead use deferred constants for relevant feature tags. + -- Note: there currently are no such constants defined in this section, + -- since the compiler front end is currently entirely independent of the + -- GCC version, which is a desirable state of affairs. + function get_gcc_version return Int; pragma Import (C, get_gcc_version, "get_gcc_version"); @@ -1482,8 +1501,4 @@ private -- Indicates which version of gcc is in use (3 = 3.x, 4 = 4.x). Note that -- gcc 2.8.1 (which used to be a value of 2) is no longer supported. - Static_Dispatch_Tables : constant Boolean := GCC_Version >= 4; - -- GCC version 4 can handle the static dispatch tables, but not version 3. - -- Also we need -funit-at-a-time, which should also be tested here ??? - end Opt; diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 6e791b5..1001f64 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_Check_Name | Pragma_CIL_Constructor | Pragma_Compile_Time_Error | Pragma_Compile_Time_Warning | @@ -1091,6 +1092,7 @@ begin Pragma_Finalize_Storage_Only | Pragma_Float_Representation | Pragma_Ident | + Pragma_Implicit_Packing | Pragma_Import | Pragma_Import_Exception | Pragma_Import_Function | diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 981fc40..53d9bf2 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -458,7 +458,7 @@ package body Sem_Ch13 is if Warn_On_Obsolescent_Feature then Error_Msg_N - ("at clause is an obsolescent feature ('R'M 'J.7(2))?", N); + ("at clause is an obsolescent feature (RM J.7(2))?", N); Error_Msg_N ("\use address attribute definition clause instead?", N); end if; @@ -634,6 +634,11 @@ package body Sem_Ch13 is -- Start of processing for Analyze_Attribute_Definition_Clause begin + if Ignore_Rep_Clauses then + Rewrite (N, Make_Null_Statement (Sloc (N))); + return; + end if; + Analyze (Nam); Ent := Entity (Nam); @@ -752,7 +757,7 @@ package body Sem_Ch13 is if Warn_On_Obsolescent_Feature then Error_Msg_N ("attaching interrupt to task entry is an " & - "obsolescent feature ('R'M 'J.7.1)?", N); + "obsolescent feature (RM J.7.1)?", N); Error_Msg_N ("\use interrupt procedure instead?", N); end if; @@ -810,7 +815,7 @@ package body Sem_Ch13 is elsif Present (Renamed_Object (U_Ent)) then Error_Msg_N ("address clause not allowed" - & " for a renaming declaration ('R'M 13.1(6))", Nam); + & " for a renaming declaration (RM 13.1(6))", Nam); -- Imported variables can have an address clause, but then -- the import is pretty meaningless except to suppress @@ -1060,6 +1065,15 @@ package body Sem_Ch13 is Error_Msg_N ("% attribute unsupported in this configuration", Nam); end if; + + if not Is_Library_Level_Entity (U_Ent) then + Error_Msg_NE + ("?non-unique external tag supplied for &", N, U_Ent); + Error_Msg_N + ("?\same external tag applies to all subprogram calls", N); + Error_Msg_N + ("?\corresponding internal tag cannot be obtained", N); + end if; end External_Tag; ----------- @@ -1452,7 +1466,7 @@ package body Sem_Ch13 is if Warn_On_Obsolescent_Feature then Error_Msg_N ("storage size clause for task is an " & - "obsolescent feature ('R'M 'J.9)?", N); + "obsolescent feature (RM J.9)?", N); Error_Msg_N ("\use Storage_Size pragma instead?", N); end if; @@ -1721,6 +1735,10 @@ package body Sem_Ch13 is Max : Uint; begin + if Ignore_Rep_Clauses then + return; + end if; + -- First some basic error checks Find_Type (Ident); @@ -2022,6 +2040,10 @@ package body Sem_Ch13 is -- Points to N_Pragma node if Complete_Representation pragma present begin + if Ignore_Rep_Clauses then + return; + end if; + Find_Type (Ident); Rectype := Entity (Ident); @@ -2075,7 +2097,7 @@ package body Sem_Ch13 is if Warn_On_Obsolescent_Feature then Error_Msg_N - ("mod clause is an obsolescent feature ('R'M 'J.8)?", N); + ("mod clause is an obsolescent feature (RM J.8)?", N); Error_Msg_N ("\use alignment attribute definition clause instead?", N); end if; @@ -2084,10 +2106,10 @@ package body Sem_Ch13 is Analyze_List (P); end if; - -- In ASIS_Mode mode, expansion is disabled, but we must - -- convert the Mod clause into an alignment clause anyway, so - -- that the back-end can compute and back-annotate properly the - -- size and alignment of types that may include this record. + -- In ASIS_Mode mode, expansion is disabled, but we must convert + -- the Mod clause into an alignment clause anyway, so that the + -- back-end can compute and back-annotate properly the size and + -- alignment of types that may include this record. -- This seems dubious, this destroys the source tree in a manner -- not detectable by ASIS ??? @@ -2115,8 +2137,8 @@ package body Sem_Ch13 is end; end if; - -- Clear any existing component clauses for the type (this happens - -- with derived types, where we are now overriding the original) + -- Clear any existing component clauses for the type (this happens with + -- derived types, where we are now overriding the original) Comp := First_Component_Or_Discriminant (Rectype); while Present (Comp) loop @@ -2587,7 +2609,7 @@ package body Sem_Ch13 is Next_Component_Or_Discriminant (Comp); end loop; - -- If no Complete_Representation pragma, warn if missing components + -- If no Complete_Representation pragma, warn if missing components elsif Warn_On_Unrepped_Components and then not Warnings_Off (Rectype) @@ -2713,7 +2735,7 @@ package body Sem_Ch13 is Nod, U_Ent); Error_Msg_NE ("address for& cannot" & - " depend on another address clause! ('R'M 13.1(22))!", + " depend on another address clause! (RM 13.1(22))!", Nod, U_Ent); elsif In_Same_Source_Unit (Entity (Nod), U_Ent) @@ -2725,7 +2747,7 @@ package body Sem_Ch13 is Error_Msg_Name_1 := Chars (Entity (Nod)); Error_Msg_Name_2 := Chars (U_Ent); Error_Msg_N - ("\% must be defined before % ('R'M 13.1(22))!", + ("\% must be defined before % (RM 13.1(22))!", Nod); end if; @@ -2746,7 +2768,7 @@ package body Sem_Ch13 is Nod, U_Ent); Error_Msg_N ("\address cannot depend on component" & - " of discriminated record ('R'M 13.1(22))!", + " of discriminated record (RM 13.1(22))!", Nod); else Check_At_Constant_Address (Prefix (Nod)); @@ -2859,7 +2881,7 @@ package body Sem_Ch13 is Error_Msg_Name_1 := Chars (Ent); Error_Msg_Name_2 := Chars (U_Ent); Error_Msg_N - ("\% must be defined before % ('R'M 13.1(22))!", + ("\% must be defined before % (RM 13.1(22))!", Nod); end if; @@ -2875,11 +2897,11 @@ package body Sem_Ch13 is Error_Msg_Name_1 := Chars (Ent); Error_Msg_N ("\reference to variable% not allowed" - & " ('R'M 13.1(22))!", Nod); + & " (RM 13.1(22))!", Nod); else Error_Msg_N ("non-static expression not allowed" - & " ('R'M 13.1(22))!", Nod); + & " (RM 13.1(22))!", Nod); end if; end if; @@ -2987,7 +3009,7 @@ package body Sem_Ch13 is Nod, U_Ent); Error_Msg_NE - ("\function & is not pure ('R'M 13.1(22))!", + ("\function & is not pure (RM 13.1(22))!", Nod, Entity (Name (Nod))); else @@ -3002,7 +3024,7 @@ package body Sem_Ch13 is ("invalid address clause for initialized object &!", Nod, U_Ent); Error_Msg_NE - ("\must be constant defined before& ('R'M 13.1(22))!", + ("\must be constant defined before& (RM 13.1(22))!", Nod, U_Ent); end case; end Check_Expr_Constants; @@ -4005,6 +4027,17 @@ package body Sem_Ch13 is return; end if; + -- Warn if conversion between two different convention pointers + + if Is_Access_Type (Target) + and then Is_Access_Type (Source) + and then Convention (Target) /= Convention (Source) + and then Warn_On_Unchecked_Conversion + then + Error_Msg_N + ("?conversion between pointers with different conventions!", N); + end if; + -- Make entry in unchecked conversion table for later processing -- by Validate_Unchecked_Conversions, which will check sizes and -- alignments (using values set by the back-end where possible). @@ -4093,7 +4126,7 @@ package body Sem_Ch13 is if Source_Siz /= Target_Siz then Error_Msg_N - ("types for unchecked conversion have different sizes?", + ("?types for unchecked conversion have different sizes!", Enode); if All_Errors_Mode then @@ -4111,18 +4144,18 @@ package body Sem_Ch13 is then if Source_Siz > Target_Siz then Error_Msg_N - ("\^ high order bits of source will be ignored?", + ("\?^ high order bits of source will be ignored!", Enode); elsif Is_Unsigned_Type (Source) then Error_Msg_N - ("\source will be extended with ^ high order " & - "zero bits?", Enode); + ("\?source will be extended with ^ high order " & + "zero bits?!", Enode); else Error_Msg_N - ("\source will be extended with ^ high order " & - "sign bits?", + ("\?source will be extended with ^ high order " & + "sign bits!", Enode); end if; @@ -4130,25 +4163,25 @@ package body Sem_Ch13 is if Is_Discrete_Type (Target) then if Bytes_Big_Endian then Error_Msg_N - ("\target value will include ^ undefined " & - "low order bits?", + ("\?target value will include ^ undefined " & + "low order bits!", Enode); else Error_Msg_N - ("\target value will include ^ undefined " & - "high order bits?", + ("\?target value will include ^ undefined " & + "high order bits!", Enode); end if; else Error_Msg_N - ("\^ trailing bits of target value will be " & - "undefined?", Enode); + ("\?^ trailing bits of target value will be " & + "undefined!", Enode); end if; else pragma Assert (Source_Siz > Target_Siz); Error_Msg_N - ("\^ trailing bits of source will be ignored?", + ("\?^ trailing bits of source will be ignored!", Enode); end if; end if; @@ -4185,13 +4218,13 @@ package body Sem_Ch13 is Error_Msg_Uint_2 := Source_Align; Error_Msg_Node_2 := D_Source; Error_Msg_NE - ("alignment of & (^) is stricter than " & - "alignment of & (^)?", Enode, D_Target); + ("?alignment of & (^) is stricter than " & + "alignment of & (^)!", Enode, D_Target); if All_Errors_Mode then Error_Msg_N - ("\resulting access value may have invalid " & - "alignment?", Enode); + ("\?resulting access value may have invalid " & + "alignment!", Enode); end if; end if; end; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 5f4b95d2..e58cfc3 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -32,6 +32,7 @@ with Atree; use Atree; with Casing; use Casing; +with Checks; use Checks; with Csets; use Csets; with Debug; use Debug; with Einfo; use Einfo; @@ -2106,9 +2107,9 @@ package body Sem_Prag is begin -- Ada 2005 (AI-430): Check invalid attempt to change convention -- for an overridden dispatching operation. Technically this is - -- an amendment and should only be done in Ada 2005 mode. - -- However, this is clearly a mistake, since the problem that is - -- addressed by this AI is that there is a clear gap in the RM! + -- an amendment and should only be done in Ada 2005 mode. However, + -- this is clearly a mistake, since the problem that is addressed + -- by this AI is that there is a clear gap in the RM! if Is_Dispatching_Operation (E) and then Present (Overridden_Operation (E)) @@ -2138,10 +2139,10 @@ package body Sem_Prag is Set_Convention (Class_Wide_Type (E), C); end if; - -- If the entity is a record type, then check for special case - -- of C_Pass_By_Copy, which is treated the same as C except that - -- the special record flag is set. This convention is also only - -- permitted on record types (see AI95-00131). + -- If the entity is a record type, then check for special case of + -- C_Pass_By_Copy, which is treated the same as C except that the + -- special record flag is set. This convention is only permitted + -- on record types (see AI95-00131). if Cname = Name_C_Pass_By_Copy then if Is_Record_Type (E) then @@ -2193,11 +2194,11 @@ package body Sem_Prag is elsif Is_Convention_Name (Cname) then C := Get_Convention_Id (Chars (Expression (Arg1))); - -- In DEC VMS, it seems that there is an undocumented feature - -- that any unrecognized convention is treated as the default, - -- which for us is convention C. It does not seem so terrible - -- to do this unconditionally, silently in the VMS case, and - -- with a warning in the non-VMS case. + -- In DEC VMS, it seems that there is an undocumented feature that + -- any unrecognized convention is treated as the default, which for + -- us is convention C. It does not seem so terrible to do this + -- unconditionally, silently in the VMS case, and with a warning + -- in the non-VMS case. else if Warn_On_Export_Import and not OpenVMS_On_Target then @@ -2225,9 +2226,9 @@ package body Sem_Prag is E := Entity (Id); - -- Go to renamed subprogram if present, since convention applies - -- to the actual renamed entity, not to the renaming entity. - -- If subprogram is inherited, go to parent subprogram. + -- Go to renamed subprogram if present, since convention applies to + -- the actual renamed entity, not to the renaming entity. If the + -- subprogram is inherited, go to parent subprogram. if Is_Subprogram (E) and then Present (Alias (E)) @@ -2581,9 +2582,8 @@ package body Sem_Prag is then Error_Msg_Sloc := Sloc (Def_Id); Error_Pragma_Arg - ("no initialization allowed for declaration of& #", - "\imported entities cannot be initialized ('R'M' 'B.1(24))", - Arg1); + ("imported entities cannot be initialized (RM B.1(24))", + "\no initialization allowed for & declared#", Arg1); else Set_Imported (Def_Id); Note_Possible_Modification (Arg_Internal); @@ -2847,9 +2847,9 @@ package body Sem_Prag is -- Here we have the Export case which can set the entity as exported - -- But does not do so if the specified external name is null, - -- since that is taken as a signal in DEC Ada 83 (with which - -- we want to be compatible) to request no external name. + -- But does not do so if the specified external name is null, since + -- that is taken as a signal in DEC Ada 83 (with which we want to be + -- compatible) to request no external name. elsif Nkind (Arg_External) = N_String_Literal and then String_Length (Strval (Arg_External)) = 0 @@ -2942,7 +2942,6 @@ package body Sem_Prag is if Present (Expressions (Arg_Mechanism)) then Mname := First (Expressions (Arg_Mechanism)); - while Present (Mname) loop if No (Formal) then Error_Pragma_Arg @@ -2959,7 +2958,6 @@ package body Sem_Prag is if Present (Component_Associations (Arg_Mechanism)) then Massoc := First (Component_Associations (Arg_Mechanism)); - while Present (Massoc) loop Choice := First (Choices (Massoc)); @@ -3121,7 +3119,7 @@ package body Sem_Prag is Error_Msg_Sloc := Sloc (Def_Id); Error_Pragma_Arg ("no initialization allowed for declaration of& #", - "\imported entities cannot be initialized ('R'M' 'B.1(24))", + "\imported entities cannot be initialized (RM B.1(24))", Arg2); else @@ -3243,9 +3241,9 @@ package body Sem_Prag is N_Subprogram_Renaming_Declaration then Error_Msg_Sloc := Sloc (Def_Id); - Error_Msg_NE ("cannot import&#," & - " already completed by a renaming", - N, Def_Id); + Error_Msg_NE + ("cannot import&, renaming already provided for " & + "declaration #", N, Def_Id); end if; end; @@ -3698,7 +3696,6 @@ package body Sem_Prag is and then Ekind (Scope (E)) = E_Package then Par := Parent (E); - while Present (Par) loop if Nkind (Par) = N_Package_Body then Error_Msg_Sloc := Sloc (E); @@ -3974,18 +3971,20 @@ package body Sem_Prag is -------------------------------- procedure Suppress_Unsuppress_Echeck (E : Entity_Id; C : Check_Id) is - ESR : constant Entity_Check_Suppress_Record := - (Entity => E, - Check => C, - Suppress => Suppress_Case); - begin Set_Checks_May_Be_Suppressed (E); if In_Package_Spec then - Global_Entity_Suppress.Append (ESR); + Push_Global_Suppress_Stack_Entry + (Entity => E, + Check => C, + Suppress => Suppress_Case); + else - Local_Entity_Suppress.Append (ESR); + Push_Local_Suppress_Stack_Entry + (Entity => E, + Check => C, + Suppress => Suppress_Case); end if; -- If this is a first subtype, and the base type is distinct, @@ -4013,11 +4012,11 @@ package body Sem_Prag is Check_No_Identifier (Arg1); Check_Arg_Is_Identifier (Arg1); - if not Is_Check_Name (Chars (Expression (Arg1))) then + C := Get_Check_Id (Chars (Expression (Arg1))); + + if C = No_Check_Id then Error_Pragma_Arg ("argument of pragma% is not valid check name", Arg1); - else - C := Get_Check_Id (Chars (Expression (Arg1))); end if; if not Suppress_Case @@ -4034,10 +4033,10 @@ package body Sem_Prag is if C = All_Checks then - -- For All_Checks, we set all specific checks with the - -- exception of Elaboration_Check, which is handled specially - -- because of not wanting All_Checks to have the effect of - -- deactivating static elaboration order processing. + -- For All_Checks, we set all specific predefined checks with + -- the exception of Elaboration_Check, which is handled + -- specially because of not wanting All_Checks to have the + -- effect of deactivating static elaboration order processing. for J in Scope_Suppress'Range loop if J /= Elaboration_Check then @@ -4045,24 +4044,23 @@ package body Sem_Prag is end if; end loop; - -- If not All_Checks, just set appropriate entry. Note that we - -- will set Elaboration_Check if this is explicitly specified. + -- If not All_Checks, and predefined check, then set appropriate + -- scope entry. Note that we will set Elaboration_Check if this + -- is explicitly specified. - else + elsif C in Predefined_Check_Id then Scope_Suppress (C) := Suppress_Case; end if; - -- Also make an entry in the Local_Entity_Suppress table. See - -- extended description in the package spec of Sem for details. + -- Also make an entry in the Local_Entity_Suppress table - Local_Entity_Suppress.Append - ((Entity => Empty, - Check => C, - Suppress => Suppress_Case)); + Push_Local_Suppress_Stack_Entry + (Entity => Empty, + Check => C, + Suppress => Suppress_Case); - -- Case of two arguments present, where the check is - -- suppressed for a specified entity (given as the second - -- argument of the pragma) + -- Case of two arguments present, where the check is suppressed for + -- a specified entity (given as the second argument of the pragma) else Check_Optional_Identifier (Arg2, Name_On); @@ -4091,7 +4089,7 @@ package body Sem_Prag is and then Scope (E) /= Current_Scope then Error_Pragma_Arg - ("entity in pragma% is not in package spec ('R'M 11.5(7))", + ("entity in pragma% is not in package spec (RM 11.5(7))", Arg2); end if; @@ -4277,18 +4275,23 @@ package body Sem_Prag is procedure Set_Imported (E : Entity_Id) is begin - Error_Msg_Sloc := Sloc (E); + -- Error message if already imported or exported if Is_Exported (E) or else Is_Imported (E) then - Error_Msg_NE ("import of& declared# not allowed", N, E); - if Is_Exported (E) then - Error_Msg_N ("\entity was previously exported", N); + Error_Msg_NE ("entity& was previously exported", N, E); else - Error_Msg_N ("\entity was previously imported", N); + Error_Msg_NE ("entity& was previously imported", N, E); end if; - Error_Pragma ("\(pragma% applies to all previous entities)"); + Error_Msg_Name_1 := Chars (N); + Error_Msg_N + ("\(pragma% applies to all previous entities)", N); + + Error_Msg_Sloc := Sloc (E); + Error_Msg_NE ("\import not allowed for& declared#", N, E); + + -- Here if not previously imported or exported, OK to import else Set_Is_Imported (E); @@ -4515,16 +4518,32 @@ package body Sem_Prag is -- Start of processing for Analyze_Pragma begin + -- Deal with unrecognized pragma + if not Is_Pragma_Name (Chars (N)) then if Warn_On_Unrecognized_Pragma then - Error_Pragma ("unrecognized pragma%?"); - else - return; + Error_Msg_Name_1 := Chars (N); + Error_Msg_N ("?unrecognized pragma%!", N); + + for PN in First_Pragma_Name .. Last_Pragma_Name loop + if Is_Bad_Spelling_Of + (Get_Name_String (Chars (N)), + Get_Name_String (PN)) + then + Error_Msg_Name_1 := PN; + Error_Msg_N ("\?possible misspelling of %!", N); + exit; + end if; + end loop; end if; - else - Prag_Id := Get_Pragma_Id (Chars (N)); + + return; end if; + -- Here to start processing for recognized pragma + + Prag_Id := Get_Pragma_Id (Chars (N)); + -- Preset arguments Arg1 := Empty; @@ -4598,9 +4617,25 @@ package body Sem_Prag is when Pragma_Ada_83 => GNAT_Pragma; + Check_Arg_Count (0); + + -- We really should check unconditionally for proper configuration + -- pragma placement, since we really don't want mixed Ada modes + -- within a single unit, and the GNAT reference manual has always + -- said this was a configuration pragma, but we did not check and + -- are hesitant to add the check now. + + -- However, we really cannot tolerate mixing Ada 2005 with Ada 83 + -- or Ada 95, so we must check if we are in Ada 2005 mode. + + if Ada_Version >= Ada_05 then + Check_Valid_Configuration_Pragma; + end if; + + -- Now set Ada 83 mode + Ada_Version := Ada_83; Ada_Version_Explicit := Ada_Version; - Check_Arg_Count (0); ------------ -- Ada_95 -- @@ -4613,9 +4648,25 @@ package body Sem_Prag is when Pragma_Ada_95 => GNAT_Pragma; + Check_Arg_Count (0); + + -- We really should check unconditionally for proper configuration + -- pragma placement, since we really don't want mixed Ada modes + -- within a single unit, and the GNAT reference manual has always + -- said this was a configuration pragma, but we did not check and + -- are hesitant to add the check now. + + -- However, we really cannot tolerate mixing Ada 2005 with Ada 83 + -- or Ada 95, so we must check if we are in Ada 2005 mode. + + if Ada_Version >= Ada_05 then + Check_Valid_Configuration_Pragma; + end if; + + -- Now set Ada 95 mode + Ada_Version := Ada_95; Ada_Version_Explicit := Ada_Version; - Check_Arg_Count (0); --------------------- -- Ada_05/Ada_2005 -- @@ -4648,6 +4699,17 @@ package body Sem_Prag is else Check_Arg_Count (0); + + -- For Ada_2005 we unconditionally enforce the documented + -- configuration pragma placement, since we do not want to + -- tolerate mixed modes in a unit involving Ada 2005. That + -- would cause real difficulties for those cases where there + -- are incompatibilities between Ada 95 and Ada 2005. + + Check_Valid_Configuration_Pragma; + + -- Now set Ada 2005 mode + Ada_Version := Ada_05; Ada_Version_Explicit := Ada_05; end if; @@ -4702,10 +4764,11 @@ package body Sem_Prag is Check_Arg_Is_Identifier (Arg1); declare - Arg : Node_Id := Arg2; + Arg : Node_Id; Exp : Node_Id; begin + Arg := Arg2; while Present (Arg) loop Exp := Expression (Arg); Analyze (Exp); @@ -5174,6 +5237,40 @@ package body Sem_Prag is end if; end C_Pass_By_Copy; + ---------------- + -- Check_Name -- + ---------------- + + -- pragma Check_Name (check_IDENTIFIER); + + when Pragma_Check_Name => + Check_No_Identifiers; + GNAT_Pragma; + Check_Valid_Configuration_Pragma; + Check_Arg_Count (1); + Check_Arg_Is_Identifier (Arg1); + + declare + Nam : constant Name_Id := Chars (Expression (Arg1)); + + begin + for J in Check_Names.First .. Check_Names.Last loop + if Check_Names.Table (J) = Nam then + return; + end if; + end loop; + + Check_Names.Append (Nam); + end; + + --------------------- + -- CIL_Constructor -- + --------------------- + + -- pragma CIL_Constructor ([Entity =>] LOCAL_NAME); + + -- Processing for this pragma is shared with Java_Constructor + ------------- -- Comment -- ------------- @@ -5275,6 +5372,13 @@ package body Sem_Prag is else Set_Has_Complex_Representation (Base_Type (E)); + + -- We need to treat the type has having a non-standard + -- representation, for back-end purposes, even though in + -- general a complex will have the default representation + -- of a record with two real components. + + Set_Has_Non_Standard_Rep (Base_Type (E)); end if; end Complex_Representation; @@ -5435,7 +5539,7 @@ package body Sem_Prag is Check_Optional_Identifier (Arg1, Name_Name); Check_Optional_Identifier (Arg2, Name_Convention); Check_Arg_Is_Identifier (Arg1); - Check_Arg_Is_Identifier (Arg1); + Check_Arg_Is_Identifier (Arg2); Idnam := Chars (Expression (Arg1)); Cname := Chars (Expression (Arg2)); @@ -5850,7 +5954,6 @@ package body Sem_Prag is Arg := Arg1; Outr : while Present (Arg) loop Citem := First (List_Containing (N)); - Innr : while Citem /= N loop if Nkind (Citem) = N_With_Clause and then Same_Name (Name (Citem), Expression (Arg)) @@ -6388,7 +6491,7 @@ package body Sem_Prag is null; else Error_Msg_Sloc := Sloc (System_Extend_Pragma_Arg); - Error_Pragma ("pragma% conflicts with that at#"); + Error_Pragma ("pragma% conflicts with that #"); end if; else @@ -6747,6 +6850,17 @@ package body Sem_Prag is end; end Ident; + ----------------------- + -- Implicit_Packing -- + ----------------------- + + -- pragma Implicit_Packing; + + when Pragma_Implicit_Packing => + GNAT_Pragma; + Check_Arg_Count (0); + Implicit_Packing := True; + ------------ -- Import -- ------------ @@ -7435,6 +7549,8 @@ package body Sem_Prag is -- pragma Java_Constructor ([Entity =>] LOCAL_NAME); + -- Also handles pragma CIL_Constructor + when Pragma_CIL_Constructor | Pragma_Java_Constructor => Java_Constructor : declare Id : Entity_Id; @@ -7660,7 +7776,7 @@ package body Sem_Prag is -- differences in processing between Link_With -- and Linker_Options). - declare + Arg_Store : declare C : constant Char_Code := Get_Char_Code (' '); S : constant String_Id := Strval (Expr_Value_S (Expression (Arg))); @@ -7670,6 +7786,10 @@ package body Sem_Prag is procedure Skip_Spaces; -- Advance F past any spaces + ----------------- + -- Skip_Spaces -- + ----------------- + procedure Skip_Spaces is begin while F <= L and then Get_String_Char (S, F) = C loop @@ -7677,6 +7797,8 @@ package body Sem_Prag is end loop; end Skip_Spaces; + -- Start of processing for Arg_Store + begin Skip_Spaces; -- skip leading spaces @@ -7695,7 +7817,7 @@ package body Sem_Prag is F := F + 1; end if; end loop; - end; + end Arg_Store; Arg := Next (Arg); @@ -7986,12 +8108,13 @@ package body Sem_Prag is -- Main -- ---------- - -- pragma Main_Storage - -- (MAIN_STORAGE_OPTION [, MAIN_STORAGE_OPTION]); + -- pragma Main + -- (MAIN_OPTION [, MAIN_OPTION]); - -- MAIN_STORAGE_OPTION ::= - -- [WORKING_STORAGE =>] static_SIMPLE_EXPRESSION - -- | [TOP_GUARD =>] static_SIMPLE_EXPRESSION + -- MAIN_OPTION ::= + -- [STACK_SIZE =>] static_integer_EXPRESSION + -- | [TASK_STACK_SIZE_DEFAULT =>] static_integer_EXPRESSION + -- | [TIME_SLICING_ENABLED =>] static_boolean_EXPRESSION when Pragma_Main => Main : declare Args : Args_List (1 .. 3); @@ -8507,7 +8630,7 @@ package body Sem_Prag is or else Is_Atomic (Component_Type (Typ)) then Error_Pragma - ("?pragma% ignored, cannot pack atomic components"); + ("?pragma% ignored, cannot pack atomic components"); end if; -- If we had an explicit component size given, then we do not @@ -8615,6 +8738,14 @@ package body Sem_Prag is end if; Set_Known_To_Have_Preelab_Init (Ent); + + if Has_Pragma_Preelab_Init (Ent) + and then Warn_On_Redundant_Constructs + then + Error_Pragma ("?duplicate pragma%!"); + else + Set_Has_Pragma_Preelab_Init (Ent); + end if; end Preelab_Init; ------------- @@ -8956,8 +9087,9 @@ package body Sem_Prag is then Error_Msg_Sloc := Specific_Dispatching.Table (J).Pragma_Loc; - Error_Pragma ("priority range overlaps with" & - " Priority_Specific_Dispatching#"); + Error_Pragma + ("priority range overlaps with " + & "Priority_Specific_Dispatching#"); end if; end loop; @@ -8966,8 +9098,9 @@ package body Sem_Prag is if Task_Dispatching_Policy /= ' ' then Error_Msg_Sloc := Task_Dispatching_Policy_Sloc; - Error_Pragma ("Priority_Specific_Dispatching incompatible" & - " with Task_Dispatching_Policy#"); + Error_Pragma + ("Priority_Specific_Dispatching incompatible " + & "with Task_Dispatching_Policy#"); end if; -- The use of Priority_Specific_Dispatching forces ceiling @@ -8975,8 +9108,9 @@ package body Sem_Prag is if Locking_Policy /= ' ' and then Locking_Policy /= 'C' then Error_Msg_Sloc := Locking_Policy_Sloc; - Error_Pragma ("Priority_Specific_Dispatching incompatible" & - " with Locking_Policy#"); + Error_Pragma + ("Priority_Specific_Dispatching incompatible " + & "with Locking_Policy#"); -- Set the Ceiling_Locking policy, but preserve System_Location -- since we like the error message with the run time name. @@ -9663,12 +9797,11 @@ package body Sem_Prag is -- Static_Elaboration_Desired -- -------------------------------- - -- Syntax ??? + -- pragma Static_Elaboration_Desired (DIRECT_NAME); when Pragma_Static_Elaboration_Desired => - - -- GNAT_Pragma??? - -- Check number of arguments ??? + GNAT_Pragma; + Check_At_Most_N_Arguments (1); if Is_Compilation_Unit (Current_Scope) and then Ekind (Current_Scope) = E_Package @@ -10362,7 +10495,6 @@ package body Sem_Prag is end if; Discr := First_Discriminant (Typ); - while Present (Discr) loop if No (Discriminant_Default_Value (Discr)) then Error_Msg_N @@ -10377,10 +10509,8 @@ package body Sem_Prag is Comp := First (Component_Items (Clist)); while Present (Comp) loop - Check_Component (Comp); Next (Comp); - end loop; if No (Clist) or else No (Variant_Part (Clist)) then @@ -10514,9 +10644,10 @@ package body Sem_Prag is if Is_In_Context_Clause then - -- The arguments must all be units mentioned in a with - -- clause in the same context clause. Note we already checked - -- (in Par.Prag) that the arguments are either identifiers or + -- The arguments must all be units mentioned in a with clause + -- in the same context clause. Note we already checked (in + -- Par.Prag) that the arguments are either identifiers or + -- selected components. Arg_Node := Arg1; while Present (Arg_Node) loop @@ -10881,36 +11012,29 @@ package body Sem_Prag is String_To_Name_Buffer (Strval (Expr_Value_S (Expression (Arg2)))); - -- Configuration pragma case - - if Is_Configuration_Pragma then - if Chars (Argx) = Name_On then - Error_Pragma - ("pragma Warnings (On, string) cannot be " & - "used as configuration pragma"); - - else - Set_Specific_Warning_Off - (No_Location, Name_Buffer (1 .. Name_Len)); - end if; - - -- Normal (non-configuration pragma) case - - else - if Chars (Argx) = Name_Off then - Set_Specific_Warning_Off - (Loc, Name_Buffer (1 .. Name_Len)); - - elsif Chars (Argx) = Name_On then - Set_Specific_Warning_On - (Loc, Name_Buffer (1 .. Name_Len), Err); - - if Err then - Error_Msg - ("?pragma Warnings On with no " & - "matching Warnings Off", - Loc); - end if; + -- Note on configuration pragma case: If this is a + -- configuration pragma, then for an OFF pragma, we + -- just set Config True in the call, which is all + -- that needs to be done. For the case of ON, this + -- is normally an error, unless it is canceling the + -- effect of a previous OFF pragma in the same file. + -- In any other case, an error will be signalled (ON + -- with no matching OFF). + + if Chars (Argx) = Name_Off then + Set_Specific_Warning_Off + (Loc, Name_Buffer (1 .. Name_Len), + Config => Is_Configuration_Pragma); + + elsif Chars (Argx) = Name_On then + Set_Specific_Warning_On + (Loc, Name_Buffer (1 .. Name_Len), Err); + + if Err then + Error_Msg + ("?pragma Warnings On with no " & + "matching Warnings Off", + Loc); end if; end if; end if; @@ -11104,6 +11228,7 @@ package body Sem_Prag is Pragma_Atomic => 0, Pragma_Atomic_Components => 0, Pragma_Attach_Handler => -1, + Pragma_Check_Name => 0, Pragma_CIL_Constructor => -1, Pragma_CPP_Class => 0, Pragma_CPP_Constructor => 0, @@ -11143,6 +11268,7 @@ package body Sem_Prag is Pragma_Finalize_Storage_Only => 0, Pragma_Float_Representation => 0, Pragma_Ident => -1, + Pragma_Implicit_Packing => 0, Pragma_Import => +2, Pragma_Import_Exception => 0, Pragma_Import_Function => 0, diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 57fd313..1a6a28d 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -178,7 +178,7 @@ package body Switch.C is -- There are no other switches not starting with -gnat else - Bad_Switch (C); + Bad_Switch (Switch_Chars); end if; -- Case of switch starting with -gnat @@ -260,8 +260,10 @@ package body Switch.C is elsif C = '.' then Dot := True; + elsif Dot then + Bad_Switch ("-gnatd." & Switch_Chars (Ptr .. Max)); else - Bad_Switch (C); + Bad_Switch ("-gnatd" & Switch_Chars (Ptr .. Max)); end if; end loop; @@ -289,7 +291,7 @@ package body Switch.C is -- so we must always have a character after the e. if Ptr > Max then - Bad_Switch (C); + Bad_Switch ("-gnate"); end if; case Switch_Chars (Ptr) is @@ -308,7 +310,7 @@ package body Switch.C is end if; if Ptr > Max then - Bad_Switch (C); + Bad_Switch ("-gnatec"); end if; declare @@ -351,7 +353,7 @@ package body Switch.C is Ptr := Ptr + 1; if Ptr > Max then - Bad_Switch (C); + Bad_Switch ("-gnateD"); end if; Add_Symbol_Definition (Switch_Chars (Ptr .. Max)); @@ -390,7 +392,7 @@ package body Switch.C is end if; if Ptr > Max then - Bad_Switch (C); + Bad_Switch ("-gnatem"); end if; Mapping_File_Name := @@ -411,7 +413,7 @@ package body Switch.C is end if; if Ptr > Max then - Bad_Switch (C); + Bad_Switch ("-gnatep"); end if; Preprocessing_Data_File := @@ -432,7 +434,7 @@ package body Switch.C is -- All other -gnate? switches are unassigned when others => - Bad_Switch (C); + Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max)); end case; -- -gnatE (dynamic elaboration checks) @@ -472,23 +474,24 @@ package body Switch.C is -- Set default warnings for -gnatg - Check_Unreferenced := True; - Check_Unreferenced_Formals := True; - Check_Withs := True; - Constant_Condition_Warnings := True; - Implementation_Unit_Warnings := True; - Ineffective_Inline_Warnings := True; - Warn_On_Assumed_Low_Bound := True; - Warn_On_Bad_Fixed_Value := True; - Warn_On_Constant := True; - Warn_On_Export_Import := True; - Warn_On_Modified_Unread := True; - Warn_On_No_Value_Assigned := True; - Warn_On_Non_Local_Exception := False; - Warn_On_Obsolescent_Feature := True; - Warn_On_Redundant_Constructs := True; - Warn_On_Unchecked_Conversion := True; - Warn_On_Unrecognized_Pragma := True; + Check_Unreferenced := True; + Check_Unreferenced_Formals := True; + Check_Withs := True; + Constant_Condition_Warnings := True; + Implementation_Unit_Warnings := True; + Ineffective_Inline_Warnings := True; + Warn_On_Assumed_Low_Bound := True; + Warn_On_Bad_Fixed_Value := True; + Warn_On_Constant := True; + Warn_On_Export_Import := True; + Warn_On_Modified_Unread := True; + Warn_On_No_Value_Assigned := True; + Warn_On_Non_Local_Exception := False; + Warn_On_Obsolescent_Feature := True; + Warn_On_Redundant_Constructs := True; + Warn_On_Object_Renames_Function := True; + Warn_On_Unchecked_Conversion := True; + Warn_On_Unrecognized_Pragma := True; Set_GNAT_Style_Check_Options; @@ -514,7 +517,7 @@ package body Switch.C is when 'i' => if Ptr = Max then - Bad_Switch (C); + Bad_Switch ("-gnati"); end if; Ptr := Ptr + 1; @@ -532,9 +535,15 @@ package body Switch.C is Ptr := Ptr + 1; else - Bad_Switch (C); + Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max)); end if; + -- Processing for I switch + + when 'I' => + Ptr := Ptr + 1; + Ignore_Rep_Clauses := True; + -- Processing for j switch when 'j' => @@ -679,7 +688,7 @@ package body Switch.C is List_Representation_Info_Mechanisms := True; else - Bad_Switch (C); + Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max)); end if; Ptr := Ptr + 1; @@ -745,7 +754,7 @@ package body Switch.C is Ptr := Ptr + 1; if Ptr > Max then - Bad_Switch (C); + Bad_Switch ("-gnatV"); else declare @@ -756,7 +765,7 @@ package body Switch.C is (Switch_Chars (Ptr .. Max), OK, Ptr); if not OK then - Bad_Switch (C); + Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max)); end if; for Index in First_Char + 1 .. Max loop @@ -775,7 +784,7 @@ package body Switch.C is Ptr := Ptr + 1; if Ptr > Max then - Bad_Switch (C); + Bad_Switch ("-gnatw"); end if; while Ptr <= Max loop @@ -790,7 +799,7 @@ package body Switch.C is if Set_Dot_Warning_Switch (C) then Store_Compilation_Switch ("-gnatw." & C); else - Bad_Switch (C); + Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max)); end if; -- Normal case, no dot @@ -799,7 +808,7 @@ package body Switch.C is if Set_Warning_Switch (C) then Store_Compilation_Switch ("-gnatw" & C); else - Bad_Switch (C); + Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max)); end if; end if; @@ -814,7 +823,7 @@ package body Switch.C is Ptr := Ptr + 1; if Ptr > Max then - Bad_Switch (C); + Bad_Switch ("-gnatW"); end if; begin @@ -822,7 +831,7 @@ package body Switch.C is Get_WC_Encoding_Method (Switch_Chars (Ptr)); exception when Constraint_Error => - Bad_Switch (C); + Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max)); end; Upper_Half_Encoding := @@ -906,7 +915,7 @@ package body Switch.C is Distribution_Stub_Mode := Generate_Caller_Stub_Body; when others => - Bad_Switch (C); + Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max)); end case; Ptr := Ptr + 1; @@ -923,13 +932,13 @@ package body Switch.C is when '8' => if Ptr = Max then - Bad_Switch (C); + Bad_Switch ("-gnat8"); end if; Ptr := Ptr + 1; if Switch_Chars (Ptr) /= '3' then - Bad_Switch (C); + Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; Ada_Version := Ada_83; @@ -940,13 +949,13 @@ package body Switch.C is when '9' => if Ptr = Max then - Bad_Switch (C); + Bad_Switch ("-gnat9"); end if; Ptr := Ptr + 1; if Switch_Chars (Ptr) /= '5' then - Bad_Switch (C); + Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; Ada_Version := Ada_95; @@ -957,13 +966,13 @@ package body Switch.C is when '0' => if Ptr = Max then - Bad_Switch (C); + Bad_Switch ("-gnat0"); end if; Ptr := Ptr + 1; if Switch_Chars (Ptr) /= '5' then - Bad_Switch (C); + Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; Ada_Version := Ada_05; @@ -978,7 +987,7 @@ package body Switch.C is -- Anything else is an error (illegal switch character) when others => - Bad_Switch (C); + Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max)); end case; if Store_Switch then diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 037c6b1..1b4729e 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -215,6 +215,11 @@ begin Write_Switch_Char ("i?"); Write_Line ("Identifier char set (?=1/2/3/4/5/8/9/p/f/n/w)"); + -- Line for -gnatI switch + + Write_Switch_Char ("I"); + Write_Line ("Ignore all representation clauses"); + -- Line for -gnatj switch Write_Switch_Char ("jnn"); @@ -420,13 +425,13 @@ begin "assumption"); Write_Line (" x* turn on warnings for export/import"); Write_Line (" X turn off warnings for export/import"); - Write_Line (" .x* turn on warnings for non-local exceptions"); - Write_Line (" .X turn off warnings for non-local exceptions"); + Write_Line (" .x turn on warnings for non-local exceptions"); + Write_Line (" .X* turn off warnings for non-local exceptions"); Write_Line (" y* turn on warnings for Ada 2005 incompatibility"); Write_Line (" Y turn off warnings for Ada 2005 incompatibility"); - Write_Line (" z* turn on size/align warnings for " & + Write_Line (" z* turn on convention/size/align warnings for " & "unchecked conversion"); - Write_Line (" Z turn off size/align warnings for " & + Write_Line (" Z turn off convention/size/align warnings for " & "unchecked conversion"); Write_Line (" * indicates default in above list"); @@ -480,11 +485,12 @@ begin Write_Line (" Lnn check max nest level < nn "); Write_Line (" m check line length <= 79 characters"); Write_Line (" n check casing of package Standard identifiers"); - Write_Line (" Mnn check line length <= nn characters"); + Write_Line (" Mnn check line length <= nn characters"); Write_Line (" o check subprogram bodies in alphabetical order"); Write_Line (" p check pragma casing"); Write_Line (" r check casing for identifier references"); Write_Line (" s check separate subprogram specs present"); + Write_Line (" S check separate lines after THEN or ELSE"); Write_Line (" t check token separation rules"); Write_Line (" u check no unnecessary blank lines"); Write_Line (" x check extra parentheses around conditionals"); diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 9f4cb6d..f6565b5 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -191,6 +191,12 @@ package VMS_Data is -- Switches for GNAT BIND -- ---------------------------- + S_Bind_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_Bind_Bind : aliased constant S := "/BIND_FILE=" & "ADA " & "-A " & @@ -621,54 +627,61 @@ package VMS_Data is -- consists of elaboration of these units in an appropriate order. Bind_Switches : aliased constant Switches := - (S_Bind_Bind 'Access, - S_Bind_Build 'Access, - S_Bind_Current 'Access, - S_Bind_Debug 'Access, - S_Bind_DebugX 'Access, - S_Bind_Elab 'Access, - S_Bind_Error 'Access, - S_Bind_Ext 'Access, - S_Bind_Force 'Access, - S_Bind_Help 'Access, - S_Bind_Init 'Access, - S_Bind_Library 'Access, - S_Bind_Linker 'Access, - S_Bind_Main 'Access, - S_Bind_Mess 'Access, - S_Bind_Nostinc 'Access, - S_Bind_Nostlib 'Access, - S_Bind_No_Time 'Access, - S_Bind_Object 'Access, - S_Bind_Order 'Access, - S_Bind_Output 'Access, - S_Bind_OutputX 'Access, - S_Bind_Pess 'Access, - S_Bind_Project 'Access, - S_Bind_Read 'Access, - S_Bind_ReadX 'Access, - S_Bind_Rename 'Access, - S_Bind_Report 'Access, - S_Bind_ReportX 'Access, - S_Bind_Restr 'Access, - S_Bind_Return 'Access, - S_Bind_RTS 'Access, - S_Bind_Search 'Access, - S_Bind_Shared 'Access, - S_Bind_Slice 'Access, - S_Bind_Source 'Access, - S_Bind_Static 'Access, - S_Bind_Store 'Access, - S_Bind_Time 'Access, - S_Bind_Verbose 'Access, - S_Bind_Warn 'Access, - S_Bind_WarnX 'Access, - S_Bind_Zero 'Access); + (S_Bind_Add 'Access, + S_Bind_Bind 'Access, + S_Bind_Build 'Access, + S_Bind_Current 'Access, + S_Bind_Debug 'Access, + S_Bind_DebugX 'Access, + S_Bind_Elab 'Access, + S_Bind_Error 'Access, + S_Bind_Ext 'Access, + S_Bind_Force 'Access, + S_Bind_Help 'Access, + S_Bind_Init 'Access, + S_Bind_Library 'Access, + S_Bind_Linker 'Access, + S_Bind_Main 'Access, + S_Bind_Mess 'Access, + S_Bind_Nostinc 'Access, + S_Bind_Nostlib 'Access, + S_Bind_No_Time 'Access, + S_Bind_Object 'Access, + S_Bind_Order 'Access, + S_Bind_Output 'Access, + S_Bind_OutputX 'Access, + S_Bind_Pess 'Access, + S_Bind_Project 'Access, + S_Bind_Read 'Access, + S_Bind_ReadX 'Access, + S_Bind_Rename 'Access, + S_Bind_Report 'Access, + S_Bind_ReportX 'Access, + S_Bind_Restr 'Access, + S_Bind_Return 'Access, + S_Bind_RTS 'Access, + S_Bind_Search 'Access, + S_Bind_Shared 'Access, + S_Bind_Slice 'Access, + S_Bind_Source 'Access, + S_Bind_Static 'Access, + S_Bind_Store 'Access, + S_Bind_Time 'Access, + S_Bind_Verbose 'Access, + S_Bind_Warn 'Access, + S_Bind_WarnX 'Access, + S_Bind_Zero 'Access); ----------------------------- -- Switches for GNAT CHECK -- ----------------------------- + S_Check_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_Check_All : aliased constant S := "/ALL " & "-a"; -- /NOALL (D) @@ -792,7 +805,8 @@ package VMS_Data is -- information. Check_Switches : aliased constant Switches := - (S_Check_All 'Access, + (S_Check_Add 'Access, + S_Check_All 'Access, S_Check_Ext 'Access, S_Check_Files 'Access, S_Check_Help 'Access, @@ -887,19 +901,25 @@ package VMS_Data is -- information. Chop_Switches : aliased constant Switches := - (S_Chop_Comp 'Access, - S_Chop_File 'Access, - S_Chop_Help 'Access, - S_Chop_Over 'Access, - S_Chop_Pres 'Access, - S_Chop_Quiet 'Access, - S_Chop_Ref 'Access, - S_Chop_Verb 'Access); + (S_Chop_Comp 'Access, + S_Chop_File 'Access, + S_Chop_Help 'Access, + S_Chop_Over 'Access, + S_Chop_Pres 'Access, + S_Chop_Quiet 'Access, + S_Chop_Ref 'Access, + S_Chop_Verb 'Access); ----------------------------- -- Switches for GNAT CLEAN -- ----------------------------- + S_Clean_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_Clean_Compil : aliased constant S := "/COMPILER_FILES_ONLY " & "-c"; -- /NOCOMPILER_FILES_ONLY (D) @@ -1044,21 +1064,22 @@ package VMS_Data is -- Verbose mode. Clean_Switches : aliased constant Switches := - (S_Clean_Compil 'Access, - S_Clean_Current'Access, - S_Clean_Delete 'Access, - S_Clean_Dirobj 'Access, - S_Clean_Ext 'Access, - S_Clean_Full 'Access, - S_Clean_Help 'Access, - S_Clean_Index 'Access, - S_Clean_Mess 'Access, - S_Clean_Object 'Access, - S_Clean_Project'Access, - S_Clean_Quiet 'Access, - S_Clean_Recurs 'Access, - S_Clean_Search 'Access, - S_Clean_Verbose'Access); + (S_Clean_Add 'Access, + S_Clean_Compil 'Access, + S_Clean_Current'Access, + S_Clean_Delete 'Access, + S_Clean_Dirobj 'Access, + S_Clean_Ext 'Access, + S_Clean_Full 'Access, + S_Clean_Help 'Access, + S_Clean_Index 'Access, + S_Clean_Mess 'Access, + S_Clean_Object 'Access, + S_Clean_Project'Access, + S_Clean_Quiet 'Access, + S_Clean_Recurs 'Access, + S_Clean_Search 'Access, + S_Clean_Verbose'Access); ------------------------------- -- Switches for GNAT COMPILE -- @@ -1101,6 +1122,12 @@ package VMS_Data is -- Allows GNAT to recognize all implemented proposed Ada 2005 -- extensions. See features file for list of implemented features. + S_GCC_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_GCC_Asm : aliased constant S := "/ASM " & "-S,!-c"; -- /NOASM (D) @@ -1521,7 +1548,15 @@ package VMS_Data is "-gnati1"; -- NODOC (see /IDENTIFIER_CHARACTER_SET) - S_GCC_Immed : aliased constant S := "/IMMEDIATE_ERRORS " & + S_GCC_Ignore : aliased constant S := "/IGNORE_REP_CLAUSES " & + "-gnatI"; + -- /IGNORE_REP_CLAUSES + -- + -- Causes all representation clauses to be ignored and treated as + -- comments. Useful when compiling foreign code (for example when ASIS + -- is used to analyze such code). + + S_GCC_Immed : aliased constant S := "/IMMEDIATE_ERRORS " & "-gnatdO"; -- /NOIMMEDIATE_ERRORS (D) -- /IMMEDIATE_ERRORS @@ -2016,6 +2051,8 @@ package VMS_Data is "-gnatyr " & "SPECS " & "-gnatys " & + "STATEMENTS_AFTER_THEN_ELSE " & + "-gnatyS " & "TOKEN " & "-gnatyt " & "UNNECESSARY_BLANK_LINES " & @@ -3059,85 +3096,93 @@ package VMS_Data is -- tools cannot be used. GCC_Switches : aliased constant Switches := - (S_GCC_Ada_83 'Access, - S_GCC_Ada_95 'Access, - S_GCC_Ada_05 'Access, - S_GCC_Asm 'Access, - S_GCC_Checks 'Access, - S_GCC_ChecksX 'Access, - S_GCC_Compres 'Access, - S_GCC_Config 'Access, - S_GCC_Current 'Access, - S_GCC_Debug 'Access, - S_GCC_DebugX 'Access, - S_GCC_Data 'Access, - S_GCC_Dist 'Access, - S_GCC_DistX 'Access, - S_GCC_Error 'Access, - S_GCC_ErrorX 'Access, - S_GCC_Expand 'Access, - S_GCC_Extend 'Access, - S_GCC_Ext 'Access, - S_GCC_File 'Access, - S_GCC_Force 'Access, - S_GCC_Full 'Access, - S_GCC_GNAT 'Access, - S_GCC_Help 'Access, - S_GCC_Ident 'Access, - S_GCC_IdentX 'Access, - S_GCC_Immed 'Access, - S_GCC_Inline 'Access, - S_GCC_InlineX 'Access, - S_GCC_Intsrc 'Access, - S_GCC_Just 'Access, - S_GCC_JustX 'Access, - S_GCC_Length 'Access, - S_GCC_List 'Access, - S_GCC_Output 'Access, - S_GCC_Mapping 'Access, - S_GCC_Mess 'Access, - S_GCC_Nesting 'Access, - S_GCC_Noadc 'Access, - S_GCC_Noload 'Access, - S_GCC_Nostinc 'Access, - S_GCC_Nostlib 'Access, - S_GCC_Opt 'Access, - S_GCC_OptX 'Access, - S_GCC_Polling 'Access, - S_GCC_Project 'Access, - S_GCC_Psta 'Access, - S_GCC_Report 'Access, - S_GCC_ReportX 'Access, - S_GCC_Repinfo 'Access, - S_GCC_RepinfX 'Access, - S_GCC_RTS 'Access, - S_GCC_Search 'Access, - S_GCC_Style 'Access, - S_GCC_StyleX 'Access, - S_GCC_Symbol 'Access, - S_GCC_Syntax 'Access, - S_GCC_Table 'Access, - S_GCC_Trace 'Access, - S_GCC_Tree 'Access, - S_GCC_Trys 'Access, - S_GCC_Units 'Access, - S_GCC_Unique 'Access, - S_GCC_Upcase 'Access, - S_GCC_Valid 'Access, - S_GCC_Verbose 'Access, - S_GCC_Verb_Asm'Access, - S_GCC_Warn 'Access, - S_GCC_WarnX 'Access, - S_GCC_Wide 'Access, - S_GCC_WideX 'Access, - S_GCC_No_Back 'Access, - S_GCC_Xdebug 'Access, - S_GCC_Xref 'Access); + (S_GCC_Ada_83 'Access, + S_GCC_Ada_95 'Access, + S_GCC_Ada_05 'Access, + S_GCC_Add 'Access, + S_GCC_Asm 'Access, + S_GCC_Checks 'Access, + S_GCC_ChecksX 'Access, + S_GCC_Compres 'Access, + S_GCC_Config 'Access, + S_GCC_Current 'Access, + S_GCC_Debug 'Access, + S_GCC_DebugX 'Access, + S_GCC_Data 'Access, + S_GCC_Dist 'Access, + S_GCC_DistX 'Access, + S_GCC_Error 'Access, + S_GCC_ErrorX 'Access, + S_GCC_Expand 'Access, + S_GCC_Extend 'Access, + S_GCC_Ext 'Access, + S_GCC_File 'Access, + S_GCC_Force 'Access, + S_GCC_Full 'Access, + S_GCC_GNAT 'Access, + S_GCC_Help 'Access, + S_GCC_Ident 'Access, + S_GCC_IdentX 'Access, + S_GCC_Ignore 'Access, + S_GCC_Immed 'Access, + S_GCC_Inline 'Access, + S_GCC_InlineX 'Access, + S_GCC_Intsrc 'Access, + S_GCC_Just 'Access, + S_GCC_JustX 'Access, + S_GCC_Length 'Access, + S_GCC_List 'Access, + S_GCC_Output 'Access, + S_GCC_Mapping 'Access, + S_GCC_Mess 'Access, + S_GCC_Nesting 'Access, + S_GCC_Noadc 'Access, + S_GCC_Noload 'Access, + S_GCC_Nostinc 'Access, + S_GCC_Nostlib 'Access, + S_GCC_Opt 'Access, + S_GCC_OptX 'Access, + S_GCC_Polling 'Access, + S_GCC_Project 'Access, + S_GCC_Psta 'Access, + S_GCC_Report 'Access, + S_GCC_ReportX 'Access, + S_GCC_Repinfo 'Access, + S_GCC_RepinfX 'Access, + S_GCC_RTS 'Access, + S_GCC_Search 'Access, + S_GCC_Style 'Access, + S_GCC_StyleX 'Access, + S_GCC_Symbol 'Access, + S_GCC_Syntax 'Access, + S_GCC_Table 'Access, + S_GCC_Trace 'Access, + S_GCC_Tree 'Access, + S_GCC_Trys 'Access, + S_GCC_Units 'Access, + S_GCC_Unique 'Access, + S_GCC_Upcase 'Access, + S_GCC_Valid 'Access, + S_GCC_Verbose 'Access, + S_GCC_Verb_Asm'Access, + S_GCC_Warn 'Access, + S_GCC_WarnX 'Access, + S_GCC_Wide 'Access, + S_GCC_WideX 'Access, + S_GCC_No_Back 'Access, + S_GCC_Xdebug 'Access, + S_GCC_Xref 'Access); ---------------------------- -- Switches for GNAT ELIM -- ---------------------------- + S_Elim_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_Elim_All : aliased constant S := "/ALL " & "-a"; -- /NOALL (D) @@ -3248,7 +3293,8 @@ package VMS_Data is -- being processed. Elim_Switches : aliased constant Switches := - (S_Elim_All 'Access, + (S_Elim_Add 'Access, + S_Elim_All 'Access, S_Elim_Bind 'Access, S_Elim_Comp 'Access, S_Elim_Config 'Access, @@ -3265,6 +3311,12 @@ package VMS_Data is -- Switches for GNAT FIND -- ---------------------------- + S_Find_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_Find_All : aliased constant S := "/ALL_FILES " & "-a"; -- /NOALL_FILES (D) @@ -3428,23 +3480,24 @@ package VMS_Data is -- specify more than one file. Find_Switches : aliased constant Switches := - (S_Find_All 'Access, - S_Find_Deriv 'Access, - S_Find_Expr 'Access, - S_Find_Ext 'Access, - S_Find_Full 'Access, - S_Find_Ignore 'Access, - S_Find_Mess 'Access, - S_Find_Nostinc 'Access, - S_Find_Nostlib 'Access, - S_Find_Object 'Access, - S_Find_Print 'Access, - S_Find_Project 'Access, - S_Find_Prj 'Access, - S_Find_Ref 'Access, - S_Find_Search 'Access, - S_Find_Source 'Access, - S_Find_Types 'Access); + (S_Find_Add 'Access, + S_Find_All 'Access, + S_Find_Deriv 'Access, + S_Find_Expr 'Access, + S_Find_Ext 'Access, + S_Find_Full 'Access, + S_Find_Ignore 'Access, + S_Find_Mess 'Access, + S_Find_Nostinc 'Access, + S_Find_Nostlib 'Access, + S_Find_Object 'Access, + S_Find_Print 'Access, + S_Find_Project 'Access, + S_Find_Prj 'Access, + S_Find_Ref 'Access, + S_Find_Search 'Access, + S_Find_Source 'Access, + S_Find_Types 'Access); ------------------------------ -- Switches for GNAT KRUNCH -- @@ -3462,12 +3515,18 @@ package VMS_Data is -- be specified. Krunch_Switches : aliased constant Switches := - (1 .. 1 => S_Krunch_Count 'Access); + (1 .. 1 => S_Krunch_Count 'Access); ---------------------------- -- Switches for GNAT LINK -- ---------------------------- + S_Link_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_Link_Bind : aliased constant S := "/BIND_FILE=" & "ADA " & "-A " & @@ -3653,30 +3712,37 @@ package VMS_Data is -- Any other switch that will be transmited to the underlying linker. Link_Switches : aliased constant Switches := - (S_Link_Bind 'Access, - S_Link_Debug 'Access, - S_Link_Nodebug 'Access, - S_Link_Execut 'Access, - S_Link_Ext 'Access, - S_Link_Forlink 'Access, - S_Link_Force 'Access, - S_Link_Ident 'Access, - S_Link_Libdir 'Access, - S_Link_Library 'Access, - S_Link_Mess 'Access, - S_Link_Nocomp 'Access, - S_Link_Nofiles 'Access, - S_Link_Noinhib 'Access, - S_Link_Project 'Access, - S_Link_Return 'Access, - S_Link_Static 'Access, - S_Link_Verb 'Access, - S_Link_ZZZZZ 'Access); + (S_Link_Add 'Access, + S_Link_Bind 'Access, + S_Link_Debug 'Access, + S_Link_Nodebug 'Access, + S_Link_Execut 'Access, + S_Link_Ext 'Access, + S_Link_Forlink 'Access, + S_Link_Force 'Access, + S_Link_Ident 'Access, + S_Link_Libdir 'Access, + S_Link_Library 'Access, + S_Link_Mess 'Access, + S_Link_Nocomp 'Access, + S_Link_Nofiles 'Access, + S_Link_Noinhib 'Access, + S_Link_Project 'Access, + S_Link_Return 'Access, + S_Link_Static 'Access, + S_Link_Verb 'Access, + S_Link_ZZZZZ 'Access); ---------------------------- -- Switches for GNAT LIST -- ---------------------------- + S_List_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_List_All : aliased constant S := "/ALL_UNITS " & "-a"; -- /NOALL_UNITS (D) @@ -3809,19 +3875,20 @@ package VMS_Data is -- When looking for source files also look in the specified directories. List_Switches : aliased constant Switches := - (S_List_All 'Access, - S_List_Allproj 'Access, - S_List_Current 'Access, - S_List_Depend 'Access, - S_List_Ext 'Access, - S_List_Files 'Access, - S_List_Mess 'Access, - S_List_Nostinc 'Access, - S_List_Object 'Access, - S_List_Output 'Access, - S_List_Project 'Access, - S_List_Search 'Access, - S_List_Source 'Access); + (S_List_Add 'Access, + S_List_All 'Access, + S_List_Allproj 'Access, + S_List_Current 'Access, + S_List_Depend 'Access, + S_List_Ext 'Access, + S_List_Files 'Access, + S_List_Mess 'Access, + S_List_Nostinc 'Access, + S_List_Object 'Access, + S_List_Output 'Access, + S_List_Project 'Access, + S_List_Search 'Access, + S_List_Source 'Access); ---------------------------- -- Switches for GNAT MAKE -- @@ -3871,6 +3938,12 @@ package VMS_Data is -- have been previously compiled and must be up to date, -- and the main program need to have been bound. + S_Make_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_Make_All : aliased constant S := "/ALL_FILES " & "-a"; -- /NOALL_FILES (D) @@ -4311,58 +4384,65 @@ package VMS_Data is -- necessary. Make_Switches : aliased constant Switches := - (S_Make_Actions 'Access, - S_Make_All 'Access, - S_Make_Allproj 'Access, - S_Make_Bind 'Access, - S_Make_Comp 'Access, - S_Make_Cond 'Access, - S_Make_Cont 'Access, - S_Make_Current 'Access, - S_Make_Dep 'Access, - S_Make_Dirobj 'Access, - S_Make_Doobj 'Access, - S_Make_Execut 'Access, - S_Make_Ext 'Access, - S_Make_Force 'Access, - S_Make_Full 'Access, - S_Make_Hi_Verb 'Access, - S_Make_Inplace 'Access, - S_Make_Index 'Access, - S_Make_Library 'Access, - S_Make_Link 'Access, - S_Make_Low_Verb'Access, - S_Make_Make 'Access, - S_Make_Mapping 'Access, - S_Make_Med_Verb'Access, - S_Make_Mess 'Access, - S_Make_Minimal 'Access, - S_Make_Missing 'Access, - S_Make_Nolink 'Access, - S_Make_Nomain 'Access, - S_Make_Nonpro 'Access, - S_Make_Nostinc 'Access, - S_Make_Nostlib 'Access, - S_Make_Object 'Access, - S_Make_Proc 'Access, - S_Make_Nojobs 'Access, - S_Make_Project 'Access, - S_Make_Quiet 'Access, - S_Make_Reason 'Access, - S_Make_RTS 'Access, - S_Make_Search 'Access, - S_Make_Skip 'Access, - S_Make_Source 'Access, - S_Make_Stand 'Access, - S_Make_Switch 'Access, - S_Make_Unique 'Access, - S_Make_Use_Map 'Access, - S_Make_Verbose 'Access); + (S_Make_Add 'Access, + S_Make_Actions 'Access, + S_Make_All 'Access, + S_Make_Allproj 'Access, + S_Make_Bind 'Access, + S_Make_Comp 'Access, + S_Make_Cond 'Access, + S_Make_Cont 'Access, + S_Make_Current 'Access, + S_Make_Dep 'Access, + S_Make_Dirobj 'Access, + S_Make_Doobj 'Access, + S_Make_Execut 'Access, + S_Make_Ext 'Access, + S_Make_Force 'Access, + S_Make_Full 'Access, + S_Make_Hi_Verb 'Access, + S_Make_Inplace 'Access, + S_Make_Index 'Access, + S_Make_Library 'Access, + S_Make_Link 'Access, + S_Make_Low_Verb'Access, + S_Make_Make 'Access, + S_Make_Mapping 'Access, + S_Make_Med_Verb'Access, + S_Make_Mess 'Access, + S_Make_Minimal 'Access, + S_Make_Missing 'Access, + S_Make_Nolink 'Access, + S_Make_Nomain 'Access, + S_Make_Nonpro 'Access, + S_Make_Nostinc 'Access, + S_Make_Nostlib 'Access, + S_Make_Object 'Access, + S_Make_Proc 'Access, + S_Make_Nojobs 'Access, + S_Make_Project 'Access, + S_Make_Quiet 'Access, + S_Make_Reason 'Access, + S_Make_RTS 'Access, + S_Make_Search 'Access, + S_Make_Skip 'Access, + S_Make_Source 'Access, + S_Make_Stand 'Access, + S_Make_Switch 'Access, + S_Make_Unique 'Access, + S_Make_Use_Map 'Access, + S_Make_Verbose 'Access); ------------------------------ -- Switches for GNAT METRIC -- ------------------------------ + S_Metric_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_Metric_All_Prjs : aliased constant S := "/ALL_PROJECTS " & "-U"; -- /NOALL_PROJECTS (D) @@ -4591,22 +4671,23 @@ package VMS_Data is -- Place the XML output into the specified file Metric_Switches : aliased constant Switches := - (S_Metric_All_Prjs 'Access, - S_Metric_Debug 'Access, - S_Metric_Direct 'Access, - S_Metric_Element 'Access, - S_Metric_Ext 'Access, - S_Metric_Files 'Access, - S_Metric_Format 'Access, - S_Metric_Globout 'Access, - S_Metric_Line 'Access, - S_Metric_Mess 'Access, - S_Metric_Project 'Access, - S_Metric_Quiet 'Access, - S_Metric_Suffix 'Access, - S_Metric_Suppress 'Access, - S_Metric_Verbose 'Access, - S_Metric_XMLout 'Access); + (S_Metric_Add 'Access, + S_Metric_All_Prjs 'Access, + S_Metric_Debug 'Access, + S_Metric_Direct 'Access, + S_Metric_Element 'Access, + S_Metric_Ext 'Access, + S_Metric_Files 'Access, + S_Metric_Format 'Access, + S_Metric_Globout 'Access, + S_Metric_Line 'Access, + S_Metric_Mess 'Access, + S_Metric_Project 'Access, + S_Metric_Quiet 'Access, + S_Metric_Suffix 'Access, + S_Metric_Suppress 'Access, + S_Metric_Verbose 'Access, + S_Metric_XMLout 'Access); ---------------------------- -- Switches for GNAT NAME -- @@ -4704,14 +4785,14 @@ package VMS_Data is -- those whose names end with '_NT.ADA'. Name_Switches : aliased constant Switches := - (S_Name_Conf 'Access, - S_Name_Dirs 'Access, - S_Name_Dfile 'Access, - S_Name_Frng 'Access, - S_Name_Help 'Access, - S_Name_Proj 'Access, - S_Name_Verbose 'Access, - S_Name_Excl 'Access); + (S_Name_Conf 'Access, + S_Name_Dirs 'Access, + S_Name_Dfile 'Access, + S_Name_Frng 'Access, + S_Name_Help 'Access, + S_Name_Proj 'Access, + S_Name_Verbose 'Access, + S_Name_Excl 'Access); ---------------------------------- -- Switches for GNAT PREPROCESS -- @@ -4788,19 +4869,25 @@ package VMS_Data is -- /UNDEFINED Prep_Switches : aliased constant Switches := - (S_Prep_Assoc 'Access, - S_Prep_Blank 'Access, - S_Prep_Com 'Access, - S_Prep_Ref 'Access, - S_Prep_Remove 'Access, - S_Prep_Replace 'Access, - S_Prep_Symbols 'Access, - S_Prep_Undef 'Access); + (S_Prep_Assoc 'Access, + S_Prep_Blank 'Access, + S_Prep_Com 'Access, + S_Prep_Ref 'Access, + S_Prep_Remove 'Access, + S_Prep_Replace 'Access, + S_Prep_Symbols 'Access, + S_Prep_Undef 'Access); ------------------------------ -- Switches for GNAT PRETTY -- ------------------------------ + S_Pretty_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_Pretty_Align : aliased constant S := "/ALIGN=" & "DEFAULT " & "-A12345 " & @@ -4871,7 +4958,9 @@ package VMS_Data is "GNAT_BEGINNING " & "-c3 " & "REFORMAT " & - "-c4"; + "-c4 " & + "KEEP_SPECIAL " & + "-c5"; -- /COMMENTS_LAYOUT[=layout-option, layout-option, ...] -- -- Set the comment layout. By default, comments use the GNAT style @@ -4884,6 +4973,7 @@ package VMS_Data is -- STANDARD_INDENT Standard comment line indentation -- GNAT_BEGINNING GNAT style comment beginning -- REFORMAT Reformat comment blocks + -- KEEP_SPECIAL Keep unchanged special form comments -- -- All combinations of layout options are allowed, except for DEFAULT -- and STANDARD_INDENT which are mutually exclusive, and also if @@ -4992,6 +5082,13 @@ package VMS_Data is -- Do not place the IS keyword on a separate line in a subprogram body in -- case if the specification occupies more then one line. + S_Pretty_Sep_Loop_Then : aliased constant S := "/SEPARATE_LOOP_THEN " & + "--separate-loop-then"; + -- /SEPARATE_LOOP_THEN + -- + -- Place the THEN keyword in IF statement and the LOOP keyword in for- + -- and while-loops on a separate line. + S_Pretty_Eol : aliased constant S := "/END_OF_LINE=" & "DOS " & "--eol=dos " & @@ -5299,42 +5396,44 @@ package VMS_Data is -- By default such warnings are not activated. Pretty_Switches : aliased constant Switches := - (S_Pretty_Align 'Access, - S_Pretty_All_Prjs 'Access, - S_Pretty_Attrib 'Access, - S_Pretty_Comments 'Access, - S_Pretty_Compact_Is'Access, - S_Pretty_Config 'Access, - S_Pretty_Constr 'Access, - S_Pretty_Comind 'Access, - S_Pretty_Current 'Access, - S_Pretty_Dico 'Access, - S_Pretty_Eol 'Access, - S_Pretty_Ext 'Access, - S_Pretty_Encoding 'Access, - S_Pretty_Files 'Access, - S_Pretty_Forced 'Access, - S_Pretty_Formfeed 'Access, - S_Pretty_Indent 'Access, - S_Pretty_Keyword 'Access, - S_Pretty_Maxlen 'Access, - S_Pretty_Maxind 'Access, - S_Pretty_Mess 'Access, - S_Pretty_Names 'Access, - S_Pretty_No_Backup 'Access, - S_Pretty_No_Labels 'Access, - S_Pretty_Notabs 'Access, - S_Pretty_Output 'Access, - S_Pretty_Override 'Access, - S_Pretty_Pragma 'Access, - S_Pretty_Replace 'Access, - S_Pretty_Project 'Access, - S_Pretty_RTS 'Access, - S_Pretty_Search 'Access, - S_Pretty_Specific 'Access, - S_Pretty_Standard 'Access, - S_Pretty_Verbose 'Access, - S_Pretty_Warnings 'Access); + (S_Pretty_Add 'Access, + S_Pretty_Align 'Access, + S_Pretty_All_Prjs 'Access, + S_Pretty_Attrib 'Access, + S_Pretty_Comments 'Access, + S_Pretty_Compact_Is 'Access, + S_Pretty_Config 'Access, + S_Pretty_Constr 'Access, + S_Pretty_Comind 'Access, + S_Pretty_Current 'Access, + S_Pretty_Dico 'Access, + S_Pretty_Eol 'Access, + S_Pretty_Ext 'Access, + S_Pretty_Encoding 'Access, + S_Pretty_Files 'Access, + S_Pretty_Forced 'Access, + S_Pretty_Formfeed 'Access, + S_Pretty_Indent 'Access, + S_Pretty_Keyword 'Access, + S_Pretty_Maxlen 'Access, + S_Pretty_Maxind 'Access, + S_Pretty_Mess 'Access, + S_Pretty_Names 'Access, + S_Pretty_No_Backup 'Access, + S_Pretty_No_Labels 'Access, + S_Pretty_Notabs 'Access, + S_Pretty_Output 'Access, + S_Pretty_Override 'Access, + S_Pretty_Pragma 'Access, + S_Pretty_Replace 'Access, + S_Pretty_Project 'Access, + S_Pretty_RTS 'Access, + S_Pretty_Search 'Access, + S_Pretty_Sep_Loop_Then 'Access, + S_Pretty_Specific 'Access, + S_Pretty_Standard 'Access, + S_Pretty_Verbose 'Access, + S_Pretty_Warnings 'Access); ------------------------------ -- Switches for GNAT SHARED -- @@ -5406,18 +5505,24 @@ package VMS_Data is -- Any other switch transmitted to the underlying linker. Shared_Switches : aliased constant Switches := - (S_Shared_Debug 'Access, - S_Shared_Image 'Access, - S_Shared_Ident 'Access, - S_Shared_Nofiles 'Access, - S_Shared_Noinhib 'Access, - S_Shared_Verb 'Access, - S_Shared_ZZZZZ 'Access); + (S_Shared_Debug 'Access, + S_Shared_Image 'Access, + S_Shared_Ident 'Access, + S_Shared_Nofiles 'Access, + S_Shared_Noinhib 'Access, + S_Shared_Verb 'Access, + S_Shared_ZZZZZ 'Access); ----------------------------- -- Switches for GNAT STACK -- ----------------------------- + S_Stack_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_Stack_All : aliased constant S := "/ALL_SUBPROGRAMS " & "-a"; -- /NOALL_SUBPROGRAMS (D) @@ -5574,29 +5679,36 @@ package VMS_Data is -- INDIRECT Turn on warnings for indirect calls Stack_Switches : aliased constant Switches := - (S_Stack_All 'Access, - S_Stack_All_Cycles 'Access, - S_Stack_All_Prjs 'Access, - S_Stack_Debug 'Access, - S_Stack_Directory 'Access, - S_Stack_Entries 'Access, - S_Stack_Files 'Access, - S_Stack_Help 'Access, - S_Stack_List 'Access, - S_Stack_Order 'Access, - S_Stack_Path 'Access, - S_Stack_Project 'Access, - S_Stack_Output 'Access, - S_Stack_Regexp 'Access, - S_Stack_Unbounded 'Access, - S_Stack_Unknown 'Access, - S_Stack_Verbose 'Access, - S_Stack_Warnings 'Access); + (S_Stack_Add 'Access, + S_Stack_All 'Access, + S_Stack_All_Cycles 'Access, + S_Stack_All_Prjs 'Access, + S_Stack_Debug 'Access, + S_Stack_Directory 'Access, + S_Stack_Entries 'Access, + S_Stack_Files 'Access, + S_Stack_Help 'Access, + S_Stack_List 'Access, + S_Stack_Order 'Access, + S_Stack_Path 'Access, + S_Stack_Project 'Access, + S_Stack_Output 'Access, + S_Stack_Regexp 'Access, + S_Stack_Unbounded 'Access, + S_Stack_Unknown 'Access, + S_Stack_Verbose 'Access, + S_Stack_Warnings 'Access); ---------------------------- -- Switches for GNAT STUB -- ---------------------------- + S_Stub_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_Stub_Config : aliased constant S := "/CONFIGURATION_PRAGMAS_FILE=<" & "-gnatec>"; -- /CONFIGURATION_PRAGMAS_FILE=filespec @@ -5765,26 +5877,33 @@ package VMS_Data is -- Verbose mode: generate version information. Stub_Switches : aliased constant Switches := - (S_Stub_Config 'Access, - S_Stub_Current 'Access, - S_Stub_Ext 'Access, - S_Stub_Full 'Access, - S_Stub_Header 'Access, - S_Stub_Indent 'Access, - S_Stub_Keep 'Access, - S_Stub_Length 'Access, - S_Stub_Mess 'Access, - S_Stub_Output 'Access, - S_Stub_Project 'Access, - S_Stub_Quiet 'Access, - S_Stub_Search 'Access, - S_Stub_Tree 'Access, - S_Stub_Verbose 'Access); + (S_Stub_Add 'Access, + S_Stub_Config 'Access, + S_Stub_Current 'Access, + S_Stub_Ext 'Access, + S_Stub_Full 'Access, + S_Stub_Header 'Access, + S_Stub_Indent 'Access, + S_Stub_Keep 'Access, + S_Stub_Length 'Access, + S_Stub_Mess 'Access, + S_Stub_Output 'Access, + S_Stub_Project 'Access, + S_Stub_Quiet 'Access, + S_Stub_Search 'Access, + S_Stub_Tree 'Access, + S_Stub_Verbose 'Access); ---------------------------- -- Switches for GNAT XREF -- ---------------------------- + S_Xref_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & + "-aP*"; + -- /ADD_PROJECT_SEARCH_PATH==(directory[,...]) + -- + -- Add directories to the project search path. + S_Xref_All : aliased constant S := "/ALL_FILES " & "-a"; -- /NOALL_FILES (D) @@ -5923,20 +6042,21 @@ package VMS_Data is -- Print a 'tags' file for vi. Xref_Switches : aliased constant Switches := - (S_Xref_All 'Access, - S_Xref_Deriv 'Access, - S_Xref_Ext 'Access, - S_Xref_Full 'Access, - S_Xref_Global 'Access, - S_Xref_Mess 'Access, - S_Xref_Nostinc 'Access, - S_Xref_Nostlib 'Access, - S_Xref_Object 'Access, - S_Xref_Project 'Access, - S_Xref_Prj 'Access, - S_Xref_Search 'Access, - S_Xref_Source 'Access, - S_Xref_Output 'Access, - S_Xref_Tags 'Access); + (S_Xref_Add 'Access, + S_Xref_All 'Access, + S_Xref_Deriv 'Access, + S_Xref_Ext 'Access, + S_Xref_Full 'Access, + S_Xref_Global 'Access, + S_Xref_Mess 'Access, + S_Xref_Nostinc 'Access, + S_Xref_Nostlib 'Access, + S_Xref_Object 'Access, + S_Xref_Project 'Access, + S_Xref_Prj 'Access, + S_Xref_Search 'Access, + S_Xref_Source 'Access, + S_Xref_Output 'Access, + S_Xref_Tags 'Access); end VMS_Data; -- 2.7.4