* Pragma Assert::
* Pragma Ast_Entry::
* Pragma C_Pass_By_Copy::
+* Pragma Check_Name::
* Pragma Comment::
* Pragma Common_Object::
* Pragma Compile_Time_Error::
* Pragma Finalize_Storage_Only::
* Pragma Float_Representation::
* Pragma Ident::
+* Pragma Implicit_Packing::
* Pragma Import_Exception::
* Pragma Import_Function::
* Pragma Import_Object::
* Pragma Linker_Section::
* Pragma Long_Float::
* Pragma Machine_Attribute::
+* Pragma Main::
* Pragma Main_Storage::
* Pragma No_Body::
* Pragma No_Return::
* Elab_Body::
* Elab_Spec::
* Emax::
+* Enabled::
* Enum_Rep::
* Epsilon::
* Fixed_Value::
* Pragma Assert::
* Pragma Ast_Entry::
* Pragma C_Pass_By_Copy::
+* Pragma Check_Name::
* Pragma Comment::
* Pragma Common_Object::
* Pragma Compile_Time_Error::
* Pragma Finalize_Storage_Only::
* Pragma Float_Representation::
* Pragma Ident::
+* Pragma Implicit_Packing::
* Pragma Import_Exception::
* Pragma Import_Function::
* Pragma Import_Object::
* Pragma Linker_Section::
* Pragma Long_Float::
* Pragma Machine_Attribute::
+* Pragma Main::
* Pragma Main_Storage::
* Pragma No_Body::
* Pragma No_Return::
@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
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
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
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
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
MAIN_STORAGE_OPTION ::=
[WORKING_STORAGE =>] static_SIMPLE_EXPRESSION
| [TOP_GUARD =>] static_SIMPLE_EXPRESSION
-
@end smallexample
@noindent
Syntax:
@smallexample @c ada
-pragma Passive ([Semaphore | No]);
+pragma Passive [(Semaphore | No)];
@end smallexample
@noindent
Syntax:
@smallexample @c ada
-pragma Persistent_BSS [local_NAME]
+pragma Persistent_BSS [(local_NAME)]
@end smallexample
@noindent
* Elab_Body::
* Elab_Spec::
* Emax::
+* Enabled::
* Enum_Rep::
* Epsilon::
* Fixed_Value::
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
@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
@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
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
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
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
* 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
* Examples of gnatkr Usage::
Preprocessing Using gnatprep
-
* Using gnatprep::
* Switches for gnatprep::
* Form of Definitions File::
* 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::
@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
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.
@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})
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
(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.}
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
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
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^
@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)
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
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
@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::
* Form of Input Text for gnatprep::
@end menu
+
@node Using gnatprep
@section Using @code{gnatprep}
@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
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.
@item @code{PASSIVE}
-@item @code{PSET_OBJECT}
+@item @code{PSECT_OBJECT}
@item @code{SHARE_GENERIC}
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
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.
@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
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
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:
@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}.
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
@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
@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
@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
@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
@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
@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:
@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
-- 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,
-- 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.
-- 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
-- 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
-- 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
-- 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
-- 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
-- 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 --
-----------------------
-- 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");
-- 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;
Pragma_Atomic |
Pragma_Atomic_Components |
Pragma_Attach_Handler |
+ Pragma_Check_Name |
Pragma_CIL_Constructor |
Pragma_Compile_Time_Error |
Pragma_Compile_Time_Warning |
Pragma_Finalize_Storage_Only |
Pragma_Float_Representation |
Pragma_Ident |
+ Pragma_Implicit_Packing |
Pragma_Import |
Pragma_Import_Exception |
Pragma_Import_Function |
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;
-- 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);
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;
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
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;
-----------
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;
Max : Uint;
begin
+ if Ignore_Rep_Clauses then
+ return;
+ end if;
+
-- First some basic error checks
Find_Type (Ident);
-- 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);
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;
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 ???
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
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)
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)
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;
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));
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;
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;
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
("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;
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).
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
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;
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;
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;
with Atree; use Atree;
with Casing; use Casing;
+with Checks; use Checks;
with Csets; use Csets;
with Debug; use Debug;
with Einfo; use Einfo;
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))
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
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
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))
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);
-- 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
if Present (Expressions (Arg_Mechanism)) then
Mname := First (Expressions (Arg_Mechanism));
-
while Present (Mname) loop
if No (Formal) then
Error_Pragma_Arg
if Present (Component_Associations (Arg_Mechanism)) then
Massoc := First (Component_Associations (Arg_Mechanism));
-
while Present (Massoc) loop
Choice := First (Choices (Massoc));
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
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;
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);
--------------------------------
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,
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
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
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);
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;
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);
-- 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;
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 --
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 --
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;
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);
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 --
-------------
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;
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));
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))
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
end;
end Ident;
+ -----------------------
+ -- Implicit_Packing --
+ -----------------------
+
+ -- pragma Implicit_Packing;
+
+ when Pragma_Implicit_Packing =>
+ GNAT_Pragma;
+ Check_Arg_Count (0);
+ Implicit_Packing := True;
+
------------
-- Import --
------------
-- pragma Java_Constructor ([Entity =>] LOCAL_NAME);
+ -- Also handles pragma CIL_Constructor
+
when Pragma_CIL_Constructor | Pragma_Java_Constructor =>
Java_Constructor : declare
Id : Entity_Id;
-- 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)));
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
end loop;
end Skip_Spaces;
+ -- Start of processing for Arg_Store
+
begin
Skip_Spaces; -- skip leading spaces
F := F + 1;
end if;
end loop;
- end;
+ end Arg_Store;
Arg := Next (Arg);
-- 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);
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
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;
-------------
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;
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
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.
-- 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
end if;
Discr := First_Discriminant (Typ);
-
while Present (Discr) loop
if No (Discriminant_Default_Value (Discr)) then
Error_Msg_N
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
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
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;
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,
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,
-- 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
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;
-- 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
end if;
if Ptr > Max then
- Bad_Switch (C);
+ Bad_Switch ("-gnatec");
end if;
declare
Ptr := Ptr + 1;
if Ptr > Max then
- Bad_Switch (C);
+ Bad_Switch ("-gnateD");
end if;
Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
end if;
if Ptr > Max then
- Bad_Switch (C);
+ Bad_Switch ("-gnatem");
end if;
Mapping_File_Name :=
end if;
if Ptr > Max then
- Bad_Switch (C);
+ Bad_Switch ("-gnatep");
end if;
Preprocessing_Data_File :=
-- All other -gnate? switches are unassigned
when others =>
- Bad_Switch (C);
+ Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max));
end case;
-- -gnatE (dynamic elaboration checks)
-- 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;
when 'i' =>
if Ptr = Max then
- Bad_Switch (C);
+ Bad_Switch ("-gnati");
end if;
Ptr := Ptr + 1;
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' =>
List_Representation_Info_Mechanisms := True;
else
- Bad_Switch (C);
+ Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
end if;
Ptr := Ptr + 1;
Ptr := Ptr + 1;
if Ptr > Max then
- Bad_Switch (C);
+ Bad_Switch ("-gnatV");
else
declare
(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
Ptr := Ptr + 1;
if Ptr > Max then
- Bad_Switch (C);
+ Bad_Switch ("-gnatw");
end if;
while Ptr <= Max loop
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
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;
Ptr := Ptr + 1;
if Ptr > Max then
- Bad_Switch (C);
+ Bad_Switch ("-gnatW");
end if;
begin
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 :=
Distribution_Stub_Mode := Generate_Caller_Stub_Body;
when others =>
- Bad_Switch (C);
+ Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max));
end case;
Ptr := Ptr + 1;
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;
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;
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;
-- 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
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");
"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");
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");
-- 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 " &
-- 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)
-- 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,
-- 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)
-- 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 --
-- 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)
"-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
"-gnatyr " &
"SPECS " &
"-gnatys " &
+ "STATEMENTS_AFTER_THEN_ELSE " &
+ "-gnatyS " &
"TOKEN " &
"-gnatyt " &
"UNNECESSARY_BLANK_LINES " &
-- 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)
-- 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,
-- 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)
-- 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 --
-- 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 " &
-- 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)
-- 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 --
-- 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)
-- 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)
-- 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 --
-- 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 --
-- /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 " &
"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
-- 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
-- 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 " &
-- 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 --
-- 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)
-- 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
-- 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)
-- 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;
projects / platform / upstream / linaro-gcc.git / commitdiff