[multiple changes]

2004-05-27  Vincent Celier  <celier@gnat.com>

	* vms_data.ads: Add new GNAT PRETTY qualifiers /NO_BACKUP and
	COMMENTS_LAYOUT=UNTOUCHED

	* symbols-vms.adb, symbols-vms-alpha.adb: Renamed symbols-vms.adb to
	symbols-vms-alpha.adb

2004-05-27  Thomas Quinot  <quinot@act-europe.fr>

	* sem.ads: Clarify documentation on checks suppression.

	* einfo.ads (Is_Known_Non_Null): Minor comment typo fix and rephrasing.

2004-05-27  Ed Schonberg  <schonberg@gnat.com>

	* sem_util.adb (Is_Descendent_Of): Examine properly all ancestors in
	the case of multiple derivations.
	(Is_Object_Reference): For a selected component, verify that the prefix
	is itself an object and not a value.

	* sem_ch12.adb (Same_Instantiated_Constant): New name for
	Same_Instantiated_Entity.
	(Same_Instantiated_Variable): Subsidiary to
	Check_Formal_Package_Instance, to recognize actuals for in-out generic
	formals that are obtained from a previous formal package.
	(Instantiate_Subprogram_Body): Emit proper error when
	generating code and the proper body of a stub is missing.

	* sem_ch4.adb (Remove_Address_Interpretations): If the operation still
	has a universal interpretation, do the disambiguation here.

	* exp_ch4.adb (Expand_N_Type_Conversion,
	Expand_N_Unchecked_Type_Conversion): Special handling when target type
	is Address, to avoid typing anomalies when Address is a visible integer
	type.

	* exp_ch6.adb (Expand_N_Subprogram_Body): Use Is_Descendent_Of_Address
	to determine whether a subprogram should not be marked Pure, even when
	declared in a pure package.

2004-05-27  Jose Ruiz  <ruiz@act-europe.fr>

	* gnat_ugn.texi: Replace pragma Ravenscar by pragma Profile.

	* gnat_rm.texi: Replace Max_Entry_Queue_Depth by Max_Entry_Queue_Length
	Document No_Dynamic_Attachment, that supersedes No_Dynamic_Interrupts.
	Update the documentation about the Ravenscar profile, following the
	definition found in AI-249.

	* sem_prag.adb: Use FIFO_Within_Priorities and Ceiling_Locking when
	setting the Profile (Ravenscar). This must be done in addition to
	setting the required restrictions.

	* rtsfind.ads: Add the set of operations defined in package
	Ada.Interrupts.

	* exp_ch6.adb: Check whether we are violating the No_Dynamic_Attachment
	restriction.

2004-05-27  Eric Botcazou  <ebotcazou@act-europe.fr>

	lang-specs.h: Always require -c or -S and always redirect to /dev/null
	if -gnatc or -gnats is passed.

2004-05-27  Hristian Kirtchev  <kirtchev@gnat.com>

	* sem_prag.adb (Sig_Flags): A Pragma_Unchecked_Union does not count as
	a significant reference. Warnings are now properly emitted when a
	discriminated type is not referenced.

	* lib-xref.adb (Generate_Reference): A deferred constant completion,
	record representation clause or record type discriminant does not
	produce a reference to its corresponding entity. Warnings are now
	properly emitted when deferred constants and record types are not
	referenced.

2004-05-27  Geert Bosch  <bosch@gnat.com>

	* Makefile.in: Use long version of libm routines on ia64 gnu/linux.
	Fixes ACATS Annex G tests.

2004-05-27  Robert Dewar  <dewar@gnat.com>

	* rtsfind.adb (RTU_Loaded): Temporary kludge to get past bug of not
	handling WITH

2004-05-27  Arnaud Charlet  <charlet@act-europe.fr>

	* s-interr.adb (Server_Task): Take into account case of early return
	from sigwait under e.g. linux.

2004-05-27  Sergey Rybin  <rybin@act-europe.fr>

	* gnat_ugn.texi: Add description for the new gnatpp options:
	 -rnb - replace the original source without creating its backup copy
	 -c0 - do not format comments

From-SVN: r82324
This commit is contained in:
Arnaud Charlet 2004-05-27 15:09:26 +02:00
parent 062583ea1c
commit 8a36a0ccd8
19 changed files with 644 additions and 280 deletions

View File

@ -1,3 +1,101 @@
2004-05-27 Vincent Celier <celier@gnat.com>
* vms_data.ads: Add new GNAT PRETTY qualifiers /NO_BACKUP and
COMMENTS_LAYOUT=UNTOUCHED
* symbols-vms.adb, symbols-vms-alpha.adb: Renamed symbols-vms.adb to
symbols-vms-alpha.adb
2004-05-27 Thomas Quinot <quinot@act-europe.fr>
* sem.ads: Clarify documentation on checks suppression.
* einfo.ads (Is_Known_Non_Null): Minor comment typo fix and rephrasing.
2004-05-27 Ed Schonberg <schonberg@gnat.com>
* sem_util.adb (Is_Descendent_Of): Examine properly all ancestors in
the case of multiple derivations.
(Is_Object_Reference): For a selected component, verify that the prefix
is itself an object and not a value.
* sem_ch12.adb (Same_Instantiated_Constant): New name for
Same_Instantiated_Entity.
(Same_Instantiated_Variable): Subsidiary to
Check_Formal_Package_Instance, to recognize actuals for in-out generic
formals that are obtained from a previous formal package.
(Instantiate_Subprogram_Body): Emit proper error when
generating code and the proper body of a stub is missing.
* sem_ch4.adb (Remove_Address_Interpretations): If the operation still
has a universal interpretation, do the disambiguation here.
* exp_ch4.adb (Expand_N_Type_Conversion,
Expand_N_Unchecked_Type_Conversion): Special handling when target type
is Address, to avoid typing anomalies when Address is a visible integer
type.
* exp_ch6.adb (Expand_N_Subprogram_Body): Use Is_Descendent_Of_Address
to determine whether a subprogram should not be marked Pure, even when
declared in a pure package.
2004-05-27 Jose Ruiz <ruiz@act-europe.fr>
* gnat_ugn.texi: Replace pragma Ravenscar by pragma Profile.
* gnat_rm.texi: Replace Max_Entry_Queue_Depth by Max_Entry_Queue_Length
Document No_Dynamic_Attachment, that supersedes No_Dynamic_Interrupts.
Update the documentation about the Ravenscar profile, following the
definition found in AI-249.
* sem_prag.adb: Use FIFO_Within_Priorities and Ceiling_Locking when
setting the Profile (Ravenscar). This must be done in addition to
setting the required restrictions.
* rtsfind.ads: Add the set of operations defined in package
Ada.Interrupts.
* exp_ch6.adb: Check whether we are violating the No_Dynamic_Attachment
restriction.
2004-05-27 Eric Botcazou <ebotcazou@act-europe.fr>
lang-specs.h: Always require -c or -S and always redirect to /dev/null
if -gnatc or -gnats is passed.
2004-05-27 Hristian Kirtchev <kirtchev@gnat.com>
* sem_prag.adb (Sig_Flags): A Pragma_Unchecked_Union does not count as
a significant reference. Warnings are now properly emitted when a
discriminated type is not referenced.
* lib-xref.adb (Generate_Reference): A deferred constant completion,
record representation clause or record type discriminant does not
produce a reference to its corresponding entity. Warnings are now
properly emitted when deferred constants and record types are not
referenced.
2004-05-27 Geert Bosch <bosch@gnat.com>
* Makefile.in: Use long version of libm routines on ia64 gnu/linux.
Fixes ACATS Annex G tests.
2004-05-27 Robert Dewar <dewar@gnat.com>
* rtsfind.adb (RTU_Loaded): Temporary kludge to get past bug of not
handling WITH
2004-05-27 Arnaud Charlet <charlet@act-europe.fr>
* s-interr.adb (Server_Task): Take into account case of early return
from sigwait under e.g. linux.
2004-05-27 Sergey Rybin <rybin@act-europe.fr>
* gnat_ugn.texi: Add description for the new gnatpp options:
-rnb - replace the original source without creating its backup copy
-c0 - do not format comments
2004-05-24 Geert Bosch <bosch@gnat.com>
* a-numaux-x86.adb (Reduce): Reimplement using an approximation of Pi

View File

@ -1260,6 +1260,7 @@ endif
ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-linux.ads \
a-numaux.ads<a-numaux-libc-x86.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.ads<s-osinte-linux.ads \

View File

@ -1970,12 +1970,12 @@ package Einfo is
-- Present in all entities. Relevant (and can be set True) only for
-- objects of an access type. It is set if the object is currently
-- known to have a non-null value (meaning that no access checks
-- are needed). The indication can for example3 come from assignment
-- are needed). The indication can for example come from assignment
-- of an access parameter or an allocator.
--
-- Note: this flag is set according to the sequential flow of the
-- program, watching the current value of the variable. However,
-- this processing can cases of changing the value of an aliased
-- this processing can miss cases of changing the value of an aliased
-- or constant object, so even if this flag is set, it should not
-- be believed if the variable is aliased or volatile. It would
-- be a little neater to avoid the flag being set in the first

View File

@ -6221,10 +6221,17 @@ package body Exp_Ch4 is
-- Reset overflow flag, since the range check will include
-- dealing with possible overflow, and generate the check
-- If Address is either source or target type, suppress
-- range check to avoid typing anomalies when it is a visible
-- integer type.
Set_Do_Overflow_Check (N, False);
Generate_Range_Check
(Expr, Target_Type, CE_Range_Check_Failed);
if not Is_Descendent_Of_Address (Etype (Expr))
and then not Is_Descendent_Of_Address (Target_Type)
then
Generate_Range_Check
(Expr, Target_Type, CE_Range_Check_Failed);
end if;
end if;
end;
end if;
@ -6288,7 +6295,17 @@ package body Exp_Ch4 is
Val <= Expr_Value (Type_High_Bound (Target_Type))
then
Rewrite (N, Make_Integer_Literal (Sloc (N), Val));
Analyze_And_Resolve (N, Target_Type);
-- If Address is the target type, just set the type
-- to avoid a spurious type error on the literal when
-- Address is a visible integer type.
if Is_Descendent_Of_Address (Target_Type) then
Set_Etype (N, Target_Type);
else
Analyze_And_Resolve (N, Target_Type);
end if;
return;
end if;
end;

View File

@ -1833,10 +1833,27 @@ package body Exp_Ch6 is
Subp := Parent_Subp;
end if;
-- Check for violation of No_Abort_Statements
if Is_RTE (Subp, RE_Abort_Task) then
Check_Restriction (No_Abort_Statements, N);
-- Check for violation of No_Dynamic_Attachment
elsif RTU_Loaded (Ada_Interrupts)
and then (Is_RTE (Subp, RE_Is_Reserved) or else
Is_RTE (Subp, RE_Is_Attached) or else
Is_RTE (Subp, RE_Current_Handler) or else
Is_RTE (Subp, RE_Attach_Handler) or else
Is_RTE (Subp, RE_Exchange_Handler) or else
Is_RTE (Subp, RE_Detach_Handler) or else
Is_RTE (Subp, RE_Reference))
then
Check_Restriction (No_Dynamic_Attachment, N);
end if;
-- Deal with case where call is an explicit dereference
if Nkind (Name (N)) = N_Explicit_Dereference then
-- Handle case of access to protected subprogram type
@ -3189,7 +3206,7 @@ package body Exp_Ch6 is
begin
while Present (F) loop
if Is_RTE (Root_Type (Etype (F)), RE_Address) then
if Is_Descendent_Of_Address (Etype (F)) then
Set_Is_Pure (Spec_Id, False);
if Spec_Id /= Body_Id then

View File

@ -151,10 +151,10 @@ Implementation Defined Pragmas
* Pragma Obsolescent::
* Pragma Passive::
* Pragma Polling::
* Pragma Profile (Ravenscar)::
* Pragma Propagate_Exceptions::
* Pragma Psect_Object::
* Pragma Pure_Function::
* Pragma Ravenscar::
* Pragma Restricted_Run_Time::
* Pragma Restriction_Warnings::
* Pragma Source_File_Name::
@ -641,10 +641,10 @@ consideration, the use of these pragmas should be minimized.
* Pragma Obsolescent::
* Pragma Passive::
* Pragma Polling::
* Pragma Profile (Ravenscar)::
* Pragma Propagate_Exceptions::
* Pragma Psect_Object::
* Pragma Pure_Function::
* Pragma Ravenscar::
* Pragma Restricted_Run_Time::
* Pragma Restriction_Warnings::
* Pragma Source_File_Name::
@ -2804,6 +2804,147 @@ to test for an abort condition.
Note that polling can also be enabled by use of the @code{-gnatP} switch. See
the @cite{GNAT User's Guide} for details.
@node Pragma Profile (Ravenscar)
@unnumberedsec Pragma Profile (Ravenscar)
@findex Ravenscar
@noindent
Syntax:
@smallexample @c ada
pragma Profile (Ravenscar);
@end smallexample
@noindent
A configuration pragma that establishes the following set of configuration
pragmas:
@table @code
@item Task_Dispatching_Policy (FIFO_Within_Priorities)
[RM D.2.2] Tasks are dispatched following a preemptive
priority-ordered scheduling policy.
@item Locking_Policy (Ceiling_Locking)
[RM D.3] While tasks and interrupts execute a protected action, they inherit
the ceiling priority of the corresponding protected object.
@c
@c @item Detect_Blocking
@c This pragma forces the detection of potentially blocking operations within a
@c protected operation, and to raise Program_Error if that happens.
@end table
@noindent
plus the following set of restrictions:
@table @code
@item Max_Entry_Queue_Length = 1
Defines the maximum number of calls that are queued on a (protected) entry.
Note that this restrictions is checked at run time. Violation of this
restriction results in the raising of Program_Error exception at the point of
the call. For the Profile (Ravenscar) the value of Max_Entry_Queue_Length is
always 1 and hence no task can be queued on a protected entry.
@item Max_Protected_Entries = 1
[RM D.7] Specifies the maximum number of entries per protected type. The
bounds of every entry family of a protected unit shall be static, or shall be
defined by a discriminant of a subtype whose corresponding bound is static.
For the Profile (Ravenscar) the value of Max_Protected_Entries is always 1.
@item Max_Task_Entries = 0
[RM D.7] Specifies the maximum number of entries
per task. The bounds of every entry family
of a task unit shall be static, or shall be
defined by a discriminant of a subtype whose
corresponding bound is static. A value of zero
indicates that no rendezvous are possible. For
the Profile (Ravenscar), the value of Max_Task_Entries is always
0 (zero).
@item No_Abort_Statements
[RM D.7] There are no abort_statements, and there are
no calls to Task_Identification.Abort_Task.
@item No_Asynchronous_Control
[RM D.7] There are no semantic dependences on the package
Asynchronous_Task_Control.
@item No_Calendar
There are no semantic dependencies on the package Ada.Calendar.
@item No_Dynamic_Attachment
There is no call to any of the operations defined in package Ada.Interrupts
(Is_Reserved, Is_Attached, Current_Handler, Attach_Handler, Exchange_Handler,
Detach_Handler, and Reference).
@item No_Dynamic_Priorities
[RM D.7] There are no semantic dependencies on the package Dynamic_Priorities.
@item No_Implicit_Heap_Allocations
[RM D.7] No constructs are allowed to cause implicit heap allocation.
@item No_Local_Protected_Objects
Protected objects and access types that designate
such objects shall be declared only at library level.
@item No_Protected_Type_Allocators
There are no allocators for protected types or
types containing protected subcomponents.
@item No_Relative_Delay
There are no delay_relative statements.
@item No_Requeue_Statements
Requeue statements are not allowed.
@item No_Select_Statements
There are no select_statements.
@item No_Task_Allocators
[RM D.7] There are no allocators for task types
or types containing task subcomponents.
@item No_Task_Attributes_Package
There are no semantic dependencies on the Ada.Task_Attributes package.
@item No_Task_Hierarchy
[RM D.7] All (non-environment) tasks depend
directly on the environment task of the partition.
@item No_Task_Termination
Tasks which terminate are erroneous.
@item Simple_Barriers
Entry barrier condition expressions shall be either static
boolean expressions or boolean objects which are declared in
the protected type which contains the entry.
@end table
@noindent
This set of configuration pragmas and restrictions correspond to the
definition of the ``Ravenscar Profile'' for limited tasking, devised and
published by the @cite{International Real-Time Ada Workshop}, 1997,
and whose most recent description is available at
@url{ftp://ftp.openravenscar.org/openravenscar/ravenscar00.pdf}.
The original definition of the profile was revised at subsequent IRTAW
meetings. It has been included in the ISO
@cite{Guide for the Use of the Ada Programming Language in High
Integrity Systems}, and has been approved by ISO/IEC/SC22/WG9 for inclusion in
the next revision of the standard. The formal definition given by
the Ada Rapporteur Group (ARG) can be found in two Ada Issues (AI-249 and
AI-305) available at
@url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00249.TXT} and
@url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00305.TXT}
respectively.
The above set is a superset of the restrictions provided by pragma
@code{Restricted_Run_Time}, it includes six additional restrictions
(@code{Simple_Barriers}, @code{No_Select_Statements},
@code{No_Calendar}, @code{No_Implicit_Heap_Allocations},
@code{No_Relative_Delay} and @code{No_Task_Termination}). This means
that pragma @code{Profile (Ravenscar)}, like the pragma
@code{Restricted_Run_Time}, automatically causes the use of a simplified,
more efficient version of the tasking run-time system.
@node Pragma Propagate_Exceptions
@unnumberedsec Pragma Propagate_Exceptions
@findex Propagate_Exceptions
@ -2914,123 +3055,6 @@ applies to the underlying renamed function. This can be used to
disambiguate cases of overloading where some but not all functions
in a set of overloaded functions are to be designated as pure.
@node Pragma Ravenscar
@unnumberedsec Pragma Ravenscar
@findex Ravenscar
@noindent
Syntax:
@smallexample @c ada
pragma Ravenscar;
@end smallexample
@noindent
A configuration pragma that establishes the following set of restrictions:
@table @code
@item No_Abort_Statements
[RM D.7] There are no abort_statements, and there are
no calls to Task_Identification.Abort_Task.
@item No_Select_Statements
There are no select_statements.
@item No_Task_Hierarchy
[RM D.7] All (non-environment) tasks depend
directly on the environment task of the partition.
@item No_Task_Allocators
[RM D.7] There are no allocators for task types
or types containing task subcomponents.
@item No_Dynamic_Priorities
[RM D.7] There are no semantic dependencies on the package Dynamic_Priorities.
@item No_Terminate_Alternatives
[RM D.7] There are no selective_accepts with terminate_alternatives
@item No_Dynamic_Interrupts
There are no semantic dependencies on Ada.Interrupts.
@item No_Implicit_Heap_Allocations
[RM D.7] No constructs are allowed to cause implicit heap allocation
@item No_Protected_Type_Allocators
There are no allocators for protected types or
types containing protected subcomponents.
@item No_Local_Protected_Objects
Protected objects and access types that designate
such objects shall be declared only at library level.
@item No_Requeue_Statements
Requeue statements are not allowed.
@item No_Calendar
There are no semantic dependencies on the package Ada.Calendar.
@item No_Relative_Delay
There are no delay_relative_statements.
@item No_Task_Attributes_Package
There are no semantic dependencies on the Ada.Task_Attributes package.
@item Simple_Barriers
Entry barrier condition expressions shall be either static
boolean expressions or boolean objects which are declared in
the protected type which contains the entry.
@item Max_Asynchronous_Select_Nesting = 0
[RM D.7] Specifies the maximum dynamic nesting level of asynchronous_selects.
A value of zero prevents the use of any asynchronous_select.
@item Max_Task_Entries = 0
[RM D.7] Specifies the maximum number of entries
per task. The bounds of every entry family
of a task unit shall be static, or shall be
defined by a discriminant of a subtype whose
corresponding bound is static. A value of zero
indicates that no rendezvous are possible. For
the Ravenscar pragma, the value of Max_Task_Entries is always
0 (zero).
@item Max_Protected_Entries = 1
[RM D.7] Specifies the maximum number of entries per
protected type. The bounds of every entry family of
a protected unit shall be static, or shall be defined
by a discriminant of a subtype whose corresponding
bound is static. For the Ravenscar pragma the value of
Max_Protected_Entries is always 1.
@item Max_Select_Alternatives = 0
[RM D.7] Specifies the maximum number of alternatives in a selective_accept.
For the Ravenscar pragma the value is always 0.
@item No_Task_Termination
Tasks which terminate are erroneous.
@item No_Entry_Queue
No task can be queued on a protected entry. Note that this restrictions is
checked at run time. The violation of this restriction generates a
Program_Error exception.
@end table
@noindent
This set of restrictions corresponds to the definition of the ``Ravenscar
Profile'' for limited tasking, devised and published by the
@cite{International Real-Time Ada Workshop}, 1997,
and whose most recent description is available at
@url{ftp://ftp.openravenscar.org/openravenscar/ravenscar00.pdf}.
The above set is a superset of the restrictions provided by pragma
@code{Restricted_Run_Time}, it includes five additional restrictions
(@code{Simple_Barriers}, @code{No_Select_Statements},
@code{No_Calendar},
@code{No_Relative_Delay} and @code{No_Task_Termination}). This means
that pragma @code{Ravenscar}, like the pragma @code{Restricted_Run_Time},
automatically causes the use of a simplified, more efficient version
of the tasking run-time system.
@node Pragma Restricted_Run_Time
@unnumberedsec Pragma Restricted_Run_Time
@findex Restricted_Run_Time
@ -3051,7 +3075,7 @@ A configuration pragma that establishes the following set of restrictions:
@item No_Task_Allocators
@item No_Dynamic_Priorities
@item No_Terminate_Alternatives
@item No_Dynamic_Interrupts
@item No_Dynamic_Attachment
@item No_Protected_Type_Allocators
@item No_Local_Protected_Objects
@item No_Requeue_Statements
@ -5984,8 +6008,8 @@ restrictions to produce a more efficient implementation.
@end cartouche
GNAT currently takes advantage of these restrictions by providing an optimized
run time when the Ravenscar profile and the GNAT restricted run time set
of restrictions are specified. See pragma @code{Ravenscar} and pragma
@code{Restricted_Run_Time} for more details.
of restrictions are specified. See pragma @code{Profile (Ravenscar)} and
pragma @code{Restricted_Run_Time} for more details.
@cindex Time, monotonic
@unnumberedsec D.8(47-49): Monotonic Time
@ -6855,10 +6879,10 @@ for protected types are restricted to either static boolean expressions or
references to simple boolean variables defined in the private part of the
protected type. No other form of entry barriers is permitted. This is one
of the restrictions of the Ravenscar profile for limited tasking (see also
pragma @code{Ravenscar}).
pragma @code{Profile (Ravenscar)}).
@item Max_Entry_Queue_Depth => Expr
@findex Max_Entry_Queue_Depth
@item Max_Entry_Queue_Length => Expr
@findex Max_Entry_Queue_Length
This restriction is a declaration that any protected entry compiled in
the scope of the restriction has at most the specified number of
tasks waiting on the entry
@ -6879,10 +6903,10 @@ from Boolean). This is intended for use in safety critical programs
where the certification protocol requires the use of short-circuit
(and then, or else) forms for all composite boolean operations.
@item No_Dynamic_Interrupts
@findex No_Dynamic_Interrupts
This restriction ensures at compile time that there is no attempt to
dynamically associate interrupts. Only static association is allowed.
@item No_Dynamic_Attachment
@findex No_Dynamic_Attachment
This restriction ensures that there is no call to any of the operations
defined in package Ada.Interrupts.
@item No_Enumeration_Maps
@findex No_Enumeration_Maps
@ -6978,7 +7002,7 @@ on some targets.
This restriction ensures at compile time no select statements of any kind
are permitted, that is the keyword @code{select} may not appear.
This is one of the restrictions of the Ravenscar
profile for limited tasking (see also pragma @code{Ravenscar}).
profile for limited tasking (see also pragma @code{Profile (Ravenscar)}).
@item No_Standard_Storage_Pools
@findex No_Standard_Storage_Pools

View File

@ -9995,9 +9995,9 @@ recognized by @code{GNAT}:
Long_Float
Normalize_Scalars
Polling
Profile
Propagate_Exceptions
Queuing_Policy
Ravenscar
Restricted_Run_Time
Restrictions
Reviewable
@ -14647,6 +14647,9 @@ on their effect.
@table @option
@cindex @option{^-c@var{n}^/COMMENTS_LAYOUT^} (@command{gnatpp})
@item ^-c0^/COMMENTS_LAYOUT=UNTOUCHED^
All the comments remain unchanged
@item ^-c1^/COMMENTS_LAYOUT=DEFAULT^
GNAT-style comment line indentation (this is the default).
@ -14680,7 +14683,8 @@ stops.
@noindent
The @option{-c1} and @option{-c2} switches are incompatible.
The @option{-c3} and @option{-c4} switches are compatible with each other and
also with @option{-c1} and @option{-c2}.
also with @option{-c1} and @option{-c2}. The @option{-c0} switch disables all
the other comment formatting switches.
The @option{-l1}, @option{-l2}, and @option{-l3} switches are incompatible.
@end ifclear
@ -14827,6 +14831,11 @@ reading or processing the input file.
@cindex @option{^-rf^/OVERRIDING_REPLACE^} (@code{gnatpp})
Like @option{^-r^/REPLACE^} except that if the file with the specified name
already exists, it is overwritten.
@item ^-rnb^/NO_BACKUP^
@cindex @option{^-rnb^/NO_BACKUP^} (@code{gnatpp})
Replace the input source file with the reformatted output without
creating any backup copy of the input source.
@end table
@noindent

View File

@ -32,13 +32,12 @@
{"@ada",
"\
%{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
%{!gnatc*:%{!gnats*:%{!S:%{!c:\
%eone of -c, -S, -gnatc or -gnats is required for Ada}}}}\
%{!S:%{!c:%e-c or -S required for Ada}}\
gnat1 %{I*} %{k8:-gnatk8} %{w:-gnatws} %1 %{!Q:-quiet} %{nostdinc*}\
%{nostdlib*}\
-dumpbase %{.adb:%b.adb}%{.ads:%b.ads}%{!.adb:%{!.ads:%b.ada}}\
%{g*} %{O*} %{W*} %{w} %{p} %{pg:-p} %{m*} %{a} %{f*} %{d*}\
%{!S:%{o*:%w%*-gnatO}} \
%i %{S:%W{o*}%{!o*:-o %b.s}} \
%{!S:%{gnatc*|gnats*: -o %j}} \
%{gnatc*|gnats*: -o %j} \
%{!gnatc*:%{!gnats*:%(invoke_as)}}", 0, 0, 0},

View File

@ -269,6 +269,27 @@ package body Lib.Xref is
then
null;
-- Constant completion does not count as a reference
elsif Typ = 'c'
and then Ekind (E) = E_Constant
then
null;
-- Record representation clause does not count as a reference
elsif Nkind (N) = N_Identifier
and then Nkind (Parent (N)) = N_Record_Representation_Clause
then
null;
-- Discriminants do not need to produce a reference to record type
elsif Typ = 'd'
and then Nkind (Parent (N)) = N_Discriminant_Specification
then
null;
-- Any other occurrence counts as referencing the entity
else

View File

@ -147,8 +147,8 @@ package body Rtsfind is
Use_Setting : Boolean := False);
-- Load the unit whose Id is given if not already loaded. The unit is
-- loaded, analyzed, and added to the WITH list, and the entry in
-- RT_Unit_Table is updated to reflect the load. The second parameter
-- indicates the initial setting for the Is_Potentially_Use_Visible
-- RT_Unit_Table is updated to reflect the load. Use_Setting is used
-- to indicate the initial setting for the Is_Potentially_Use_Visible
-- flag of the entity for the loaded unit (if it is indeed loaded).
-- A value of False means nothing special need be done. A value of
-- True indicates that this flag must be set to True. It is needed
@ -1052,7 +1052,9 @@ package body Rtsfind is
function RTU_Loaded (U : RTU_Id) return Boolean is
begin
return Present (RT_Unit_Table (U).Entity);
return True and Present (RT_Unit_Table (U).Entity);
-- Temp kludge, return True, deals with bug of loading unit with
-- WITH not being registered as a proper rtsfind load ???
end RTU_Loaded;
--------------------

View File

@ -450,6 +450,13 @@ package Rtsfind is
RE_List_Controller, -- Ada.Finalization.List_Controller
RE_Interrupt_ID, -- Ada.Interrupts
RE_Is_Reserved, -- Ada.Interrupts
RE_Is_Attached, -- Ada.Interrupts
RE_Current_Handler, -- Ada.Interrupts
RE_Attach_Handler, -- Ada.Interrupts
RE_Exchange_Handler, -- Ada.Interrupts
RE_Detach_Handler, -- Ada.Interrupts
RE_Reference, -- Ada.Interrupts
RE_Names, -- Ada.Interupts.Names
@ -1522,6 +1529,13 @@ package Rtsfind is
RE_List_Controller => Ada_Finalization_List_Controller,
RE_Interrupt_ID => Ada_Interrupts,
RE_Is_Reserved => Ada_Interrupts,
RE_Is_Attached => Ada_Interrupts,
RE_Current_Handler => Ada_Interrupts,
RE_Attach_Handler => Ada_Interrupts,
RE_Exchange_Handler => Ada_Interrupts,
RE_Detach_Handler => Ada_Interrupts,
RE_Reference => Ada_Interrupts,
RE_Names => Ada_Interrupts_Names,

View File

@ -305,9 +305,8 @@ package body System.Interrupts is
-- Bind_Interrupt_To_Entry --
-----------------------------
-- This procedure raises a Program_Error if it tries to
-- bind an interrupt to which an Entry or a Procedure is
-- already bound.
-- This procedure raises a Program_Error if it tries to bind an
-- interrupt to which an Entry or a Procedure is already bound.
procedure Bind_Interrupt_To_Entry
(T : Task_Id;
@ -315,7 +314,7 @@ package body System.Interrupts is
Int_Ref : System.Address)
is
Interrupt : constant Interrupt_ID :=
Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
begin
if Is_Reserved (Interrupt) then
@ -324,7 +323,6 @@ package body System.Interrupts is
end if;
Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
end Bind_Interrupt_To_Entry;
---------------------
@ -383,7 +381,6 @@ package body System.Interrupts is
end if;
Interrupt_Manager.Detach_Handler (Interrupt, Static);
end Detach_Handler;
------------------------------
@ -404,8 +401,8 @@ package body System.Interrupts is
-- previous handler's binding status (ie. do not care if it is a
-- dynamic or static handler).
-- This option is needed so that during the finalization of a PO, we
-- can detach handlers attached through pragma Attach_Handler.
-- This option is needed so that during the finalization of a PO,
-- we can detach handlers attached through pragma Attach_Handler.
procedure Exchange_Handler
(Old_Handler : out Parameterless_Handler;
@ -421,12 +418,11 @@ package body System.Interrupts is
Interrupt_Manager.Exchange_Handler
(Old_Handler, New_Handler, Interrupt, Static);
end Exchange_Handler;
----------------
-- Finalize --
----------------
--------------
-- Finalize --
--------------
procedure Finalize (Object : in out Static_Interrupt_Protection) is
begin
@ -451,7 +447,7 @@ package body System.Interrupts is
-- Has_Interrupt_Or_Attach_Handler --
-------------------------------------
-- Need comments as to why these always return True
-- Need comments as to why these always return True ???
function Has_Interrupt_Or_Attach_Handler
(Object : access Dynamic_Interrupt_Protection) return Boolean
@ -602,7 +598,6 @@ package body System.Interrupts is
end loop;
return False;
end Is_Registered;
-----------------
@ -804,7 +799,6 @@ package body System.Interrupts is
else
IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
end if;
end Unbind_Handler;
--------------------------------
@ -832,6 +826,7 @@ package body System.Interrupts is
-- status of the current_Handler.
if not Static and then User_Handler (Interrupt).Static then
-- Tries to detach a static Interrupt Handler.
-- raise a program error.
@ -854,7 +849,6 @@ package body System.Interrupts is
if Old_Handler /= null then
Unbind_Handler (Interrupt);
end if;
end Unprotected_Detach_Handler;
----------------------------------
@ -866,7 +860,8 @@ package body System.Interrupts is
New_Handler : Parameterless_Handler;
Interrupt : Interrupt_ID;
Static : Boolean;
Restoration : Boolean := False) is
Restoration : Boolean := False)
is
begin
if User_Entry (Interrupt).T /= Null_Task then
@ -951,7 +946,6 @@ package body System.Interrupts is
if Old_Handler = null then
Bind_Handler (Interrupt);
end if;
end Unprotected_Exchange_Handler;
-- Start of processing for Interrupt_Manager
@ -1081,6 +1075,7 @@ package body System.Interrupts is
-- Place Task_Id info in Server_ID array.
if Server_ID (Interrupt) = Null_Task then
-- When a new Server_Task is created, it should have its
-- signal mask set to the All_Tasks_Mask.
@ -1100,6 +1095,7 @@ package body System.Interrupts is
for J in Interrupt_ID'Range loop
if not Is_Reserved (J) then
if User_Entry (J).T = T then
-- The interrupt should no longer be ingnored if
-- it was ever ignored.
@ -1111,7 +1107,7 @@ package body System.Interrupts is
end if;
end loop;
-- Indicate in ATCB that no Interrupt Entries are attached.
-- Indicate in ATCB that no Interrupt Entries are attached
T.Interrupt_Entry := False;
end Detach_Interrupt_Entries;
@ -1133,10 +1129,10 @@ package body System.Interrupts is
if User_Handler (Interrupt).H /= null
or else User_Entry (Interrupt).T /= Null_Task
then
-- This is the case where the Server_Task is waiting on
-- "sigwait." Wake it up by sending an
-- Abort_Task_Interrupt so that the Server_Task waits on
-- Cond.
-- This is the case where the Server_Task is waiting
-- on "sigwait." Wake it up by sending an
-- Abort_Task_Interrupt so that the Server_Task
-- waits on Cond.
POP.Abort_Task (Server_ID (Interrupt));
@ -1166,6 +1162,7 @@ package body System.Interrupts is
then
-- No handler is attached. Unmask the Interrupt so that
-- the default action can be carried out.
IMOP.Thread_Unblock_Interrupt
(IMNG.Interrupt_ID (Interrupt));
@ -1174,6 +1171,7 @@ package body System.Interrupts is
-- since it was being blocked and an Interrupt Hander or
-- an Entry was there. Wake it up and let it change
-- it place of waiting according to its new state.
POP.Wakeup (Server_ID (Interrupt),
Interrupt_Server_Blocked_Interrupt_Sleep);
end if;
@ -1356,69 +1354,78 @@ package body System.Interrupts is
POP.Write_Lock (Self_ID);
else
pragma Assert (Ret_Interrupt = Interrupt);
if Single_Lock then
POP.Lock_RTS;
end if;
POP.Write_Lock (Self_ID);
-- Even though we have received an Interrupt the status may
-- have changed already before we got the Self_ID lock above.
-- Therefore we make sure a Handler or an Entry is still
-- there and make appropriate call.
-- If there is no calls to make we need to regenerate the
-- Interrupt in order not to lose it.
if Ret_Interrupt /= Interrupt then
if User_Handler (Interrupt).H /= null then
Tmp_Handler := User_Handler (Interrupt).H;
-- On some systems (e.g. recent linux kernels), sigwait
-- may return unexpectedly (with errno set to EINTR).
-- RTS calls should not be made with self being locked.
POP.Unlock (Self_ID);
if Single_Lock then
POP.Unlock_RTS;
end if;
Tmp_Handler.all;
if Single_Lock then
POP.Lock_RTS;
end if;
POP.Write_Lock (Self_ID);
elsif User_Entry (Interrupt).T /= Null_Task then
Tmp_ID := User_Entry (Interrupt).T;
Tmp_Entry_Index := User_Entry (Interrupt).E;
-- RTS calls should not be made with self being locked.
if Single_Lock then
POP.Unlock_RTS;
end if;
POP.Unlock (Self_ID);
System.Tasking.Rendezvous.Call_Simple
(Tmp_ID, Tmp_Entry_Index, System.Null_Address);
POP.Write_Lock (Self_ID);
if Single_Lock then
POP.Lock_RTS;
end if;
null;
else
-- This is a situation that this task wake up
-- receiving an Interrupt and before it get the lock
-- the Interrupt is blocked. We do not
-- want to lose the interrupt in this case so that
-- regenerate the Interrupt to process level;
-- Even though we have received an Interrupt the status may
-- have changed already before we got the Self_ID lock above
-- Therefore we make sure a Handler or an Entry is still
-- there and make appropriate call.
IMOP.Interrupt_Self_Process (IMNG.Interrupt_ID (Interrupt));
-- If there is no calls to make we need to regenerate the
-- Interrupt in order not to lose it.
if User_Handler (Interrupt).H /= null then
Tmp_Handler := User_Handler (Interrupt).H;
-- RTS calls should not be made with self being locked.
POP.Unlock (Self_ID);
if Single_Lock then
POP.Unlock_RTS;
end if;
Tmp_Handler.all;
if Single_Lock then
POP.Lock_RTS;
end if;
POP.Write_Lock (Self_ID);
elsif User_Entry (Interrupt).T /= Null_Task then
Tmp_ID := User_Entry (Interrupt).T;
Tmp_Entry_Index := User_Entry (Interrupt).E;
-- RTS calls should not be made with self being locked.
if Single_Lock then
POP.Unlock_RTS;
end if;
POP.Unlock (Self_ID);
System.Tasking.Rendezvous.Call_Simple
(Tmp_ID, Tmp_Entry_Index, System.Null_Address);
POP.Write_Lock (Self_ID);
if Single_Lock then
POP.Lock_RTS;
end if;
else
-- This is a situation that this task wakes up receiving
-- an Interrupt and before it gets the lock the Interrupt
-- is blocked. We do not want to lose the interrupt in
-- this case so we regenerate the Interrupt to process
-- level.
IMOP.Interrupt_Self_Process
(IMNG.Interrupt_ID (Interrupt));
end if;
end if;
end if;
end if;
@ -1433,30 +1440,30 @@ package body System.Interrupts is
-- Undefer abort here to allow a window for this task
-- to be aborted at the time of system shutdown.
end loop;
end Server_Task;
-- Elaboration code for package System.Interrupts
begin
-- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
-- During the elaboration of this package body we want RTS to
-- inherit the interrupt mask from the Environment Task.
-- During the elaboration of this package body we want the RTS
-- to inherit the interrupt mask from the Environment Task.
-- The Environment Task should have gotten its mask from
-- The environment task should have gotten its mask from
-- the enclosing process during the RTS start up. (See
-- in s-inmaop.adb). Pass the Interrupt_Mask of the Environment
-- task to the Interrupt_Manager.
-- processing in s-inmaop.adb). Pass the Interrupt_Mask
-- of the environment task to the Interrupt_Manager.
-- Note : At this point we know that all tasks (including
-- RTS internal servers) are masked for non-reserved signals
-- (see s-taprop.adb). Only the Interrupt_Manager will have
-- masks set up differently inheriting the original Environment
-- Task's mask.
-- masks set up differently inheriting the original environment
-- task's mask.
Interrupt_Manager.Initialize (IMOP.Environment_Mask);
end System.Interrupts;

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -347,20 +347,22 @@ package Sem is
-- Handling of Check Suppression --
-----------------------------------
-- There are two kinds of suppress checks, scope based suppress checks
-- (from initial command line arguments, or from Suppress pragmas not
-- including an entity name). The scope based suppress checks are recorded
-- There are two kinds of suppress checks: scope based suppress checks,
-- and entity based suppress checks.
-- Scope based suppress chems (from initial command line arguments,
-- or from Suppress pragmas not including an entity name) are recorded
-- in the Sem.Supress variable, and all that is necessary is to save the
-- state of this variable on scope entry, and restore it on scope exit.
-- The other kind of suppress check is entity based suppress checks, from
-- Suppress pragmas giving an Entity_Id. These are handled as follows. If
-- a suppress or unsuppress pragma is encountered for a given entity, then
-- the flag Checks_May_Be_Suppressed is set in the entity and an entry is
-- made in either the Local_Entity_Suppress table (case of pragma that
-- appears in other than a package spec), or in the Global_Entity_Suppress
-- table (case of pragma that appears in a package spec, which is by the
-- rule of RM 11.5(7) applicable throughout the life of the entity).
-- Entity based suppress checks, from Suppress pragmas giving an Entity_Id,
-- are handled as follows. If a suppress or unsuppress pragma is
-- encountered for a given entity, then the flag Checks_May_Be_Suppressed
-- is set in the entity and an entry is made in either the
-- Local_Entity_Suppress table (case of pragma that appears in other than
-- a package spec), or in the Global_Entity_Suppress table (case of pragma
-- that appears in a package spec, which is by the rule of RM 11.5(7)
-- applicable throughout the life of the entity).
-- If the Checks_May_Be_Suppressed flag is set in an entity then the
-- procedure is to search first the local and then the global suppress

View File

@ -3636,12 +3636,17 @@ package body Sem_Ch12 is
-- Common error routine for mismatch between the parameters of
-- the actual instance and those of the formal package.
function Same_Instantiated_Entity (E1, E2 : Entity_Id) return Boolean;
function Same_Instantiated_Constant (E1, E2 : Entity_Id) return Boolean;
-- The formal may come from a nested formal package, and the actual
-- may have been constant-folded. To determine whether the two denote
-- the same entity we may have to traverse several definitions to
-- recover the ultimate entity that they refer to.
function Same_Instantiated_Variable (E1, E2 : Entity_Id) return Boolean;
-- Similarly, if the formal comes from a nested formal package, the
-- actual may designate the formal through multiple renamings, which
-- have to be followed to determine the original variable in question.
--------------------
-- Check_Mismatch --
--------------------
@ -3655,13 +3660,14 @@ package body Sem_Ch12 is
end if;
end Check_Mismatch;
------------------------------
-- Same_Instantiated_Entity --
------------------------------
--------------------------------
-- Same_Instantiated_Constant --
--------------------------------
function Same_Instantiated_Entity (E1, E2 : Entity_Id) return Boolean is
function Same_Instantiated_Constant
(E1, E2 : Entity_Id) return Boolean
is
Ent : Entity_Id;
begin
Ent := E2;
while Present (Ent) loop
@ -3689,7 +3695,43 @@ package body Sem_Ch12 is
end loop;
return False;
end Same_Instantiated_Entity;
end Same_Instantiated_Constant;
--------------------------------
-- Same_Instantiated_Variable --
--------------------------------
function Same_Instantiated_Variable
(E1, E2 : Entity_Id) return Boolean
is
function Original_Entity (E : Entity_Id) return Entity_Id;
-- Follow chain of renamings to the ultimate ancestor.
---------------------
-- Original_Entity --
---------------------
function Original_Entity (E : Entity_Id) return Entity_Id is
Orig : Entity_Id;
begin
Orig := E;
while Nkind (Parent (Orig)) = N_Object_Renaming_Declaration
and then Present (Renamed_Object (Orig))
and then Is_Entity_Name (Renamed_Object (Orig))
loop
Orig := Entity (Renamed_Object (Orig));
end loop;
return Orig;
end Original_Entity;
-- Start of processing for Same_Instantiated_Variable
begin
return Ekind (E1) = Ekind (E2)
and then Original_Entity (E1) = Original_Entity (E2);
end Same_Instantiated_Variable;
-- Start of processing for Check_Formal_Package_Instance
@ -3768,13 +3810,10 @@ package body Sem_Ch12 is
if Is_Entity_Name (Expr2) then
if Entity (Expr1) = Entity (Expr2) then
null;
elsif
Same_Instantiated_Entity (Entity (Expr1), Entity (Expr2))
then
null;
else
Check_Mismatch (True);
Check_Mismatch
(not Same_Instantiated_Constant
(Entity (Expr1), Entity (Expr2)));
end if;
else
Check_Mismatch (True);
@ -3783,7 +3822,7 @@ package body Sem_Ch12 is
elsif Is_Entity_Name (Original_Node (Expr1))
and then Is_Entity_Name (Expr2)
and then
Same_Instantiated_Entity
Same_Instantiated_Constant
(Entity (Original_Node (Expr1)), Entity (Expr2))
then
null;
@ -3795,9 +3834,10 @@ package body Sem_Ch12 is
Check_Mismatch (True);
end if;
elsif Ekind (E1) = E_Variable
or else Ekind (E1) = E_Package
then
elsif Ekind (E1) = E_Variable then
Check_Mismatch (not Same_Instantiated_Variable (E1, E2));
elsif Ekind (E1) = E_Package then
Check_Mismatch
(Ekind (E1) /= Ekind (E2)
or else Renamed_Object (E1) /= Renamed_Object (E2));
@ -7350,7 +7390,15 @@ package body Sem_Ch12 is
if Nkind (Gen_Body) = N_Subprogram_Body_Stub then
-- Either body is not present, or context is non-expanding, as
-- when compiling a subunit. Mark the instance as completed.
-- when compiling a subunit. Mark the instance as completed, and
-- diagnose a missing body when needed.
if Expander_Active
and then Operating_Mode = Generate_Code
then
Error_Msg_N
("missing proper body for instantiation", Gen_Body);
end if;
Set_Has_Completion (Anon_Id);
return;

View File

@ -4361,6 +4361,7 @@ package body Sem_Ch4 is
-- truly hidden.
type Operand_Position is (First_Op, Second_Op);
Univ_Type : constant Entity_Id := Universal_Interpretation (N);
procedure Remove_Address_Interpretations (Op : Operand_Position);
-- Ambiguities may arise when the operands are literal and the
@ -4451,6 +4452,25 @@ package body Sem_Ch4 is
Remove_Interp (I);
end if;
Get_Next_Interp (I, It);
end loop;
elsif Is_Overloaded (N)
and then Present (Univ_Type)
then
-- If both operands have a universal interpretation,
-- select the predefined operator and discard others.
Get_First_Interp (N, I, It);
while Present (It.Nam) loop
if Scope (It.Nam) = Standard_Standard then
Set_Etype (N, Univ_Type);
Set_Entity (N, It.Nam);
Set_Is_Overloaded (N, False);
exit;
end if;
Get_Next_Interp (I, It);
end loop;
end if;

View File

@ -561,6 +561,12 @@ package body Sem_Prag is
-- argument has the right form then the Mechanism field of Ent is
-- set appropriately.
procedure Set_Ravenscar_Profile (N : Node_Id);
-- Activate the set of configuration pragmas and restrictions that
-- make up the Ravenscar Profile. N is the corresponding pragma
-- node, which is used for error messages on any constructs
-- that violate the profile.
--------------------------
-- Check_Ada_83_Warning --
--------------------------
@ -3257,8 +3263,7 @@ package body Sem_Prag is
Val : Uint;
procedure Set_Warning (R : All_Restrictions);
-- If this is a Restriction_Warnings pragma, set warning flag,
-- otherwise flag gets cleared.
-- If this is a Restriction_Warnings pragma, set warning flag
-----------------
-- Set_Warning --
@ -3266,8 +3271,9 @@ package body Sem_Prag is
procedure Set_Warning (R : All_Restrictions) is
begin
Restriction_Warnings (R) :=
Prag_Id = Pragma_Restriction_Warnings;
if Prag_Id = Pragma_Restriction_Warnings then
Restriction_Warnings (R) := True;
end if;
end Set_Warning;
-- Start of processing for Process_Restrictions_Or_Restriction_Warnings
@ -3821,6 +3827,70 @@ package body Sem_Prag is
end Set_Mechanism_Value;
---------------------------
-- Set_Ravenscar_Profile --
---------------------------
-- The tasks to be done here are
-- Set required policies
-- pragma Task_Dispatching_Policy (FIFO_Within_Priorities)
-- pragma Locking_Policy (Ceiling_Locking)
-- Set Detect_Blocking mode ???
-- Set required restrictions (see Restrict.Set_Ravenscar for details)
procedure Set_Ravenscar_Profile (N : Node_Id) is
begin
-- pragma Task_Dispatching_Policy (FIFO_Within_Priorities)
if Task_Dispatching_Policy /= ' '
and then Task_Dispatching_Policy /= 'F'
then
Error_Msg_Sloc := Task_Dispatching_Policy_Sloc;
Error_Pragma ("Profile (Ravenscar) incompatible with policy#");
-- Set the FIFO_Within_Priorities policy, but always
-- preserve System_Location since we like the error
-- message with the run time name.
else
Task_Dispatching_Policy := 'F';
if Task_Dispatching_Policy_Sloc /= System_Location then
Task_Dispatching_Policy_Sloc := Loc;
end if;
end if;
-- pragma Locking_Policy (Ceiling_Locking)
if Locking_Policy /= ' '
and then Locking_Policy /= 'C'
then
Error_Msg_Sloc := Locking_Policy_Sloc;
Error_Pragma ("Profile (Ravenscar) incompatible with policy#");
-- Set the Ceiling_Locking policy, but always preserve
-- System_Location since we like the error message with the
-- run time name.
else
Locking_Policy := 'C';
if Locking_Policy_Sloc /= System_Location then
Locking_Policy_Sloc := Loc;
end if;
end if;
-- ??? Detect_Blocking
-- Set the corresponding restrictions
Set_Ravenscar (N);
end Set_Ravenscar_Profile;
-- Start of processing for Analyze_Pragma
begin
@ -8005,13 +8075,12 @@ package body Sem_Prag is
Check_Arg_Count (1);
Check_Valid_Configuration_Pragma;
Check_No_Identifiers;
Set_Ravenscar (N);
declare
Argx : constant Node_Id := Get_Pragma_Arg (Arg1);
begin
if Chars (Argx) = Name_Ravenscar then
Set_Ravenscar (N);
Set_Ravenscar_Profile (N);
else
Error_Pragma_Arg ("& is not a valid profile", Argx);
end if;
@ -8481,7 +8550,7 @@ package body Sem_Prag is
GNAT_Pragma;
Check_Arg_Count (0);
Check_Valid_Configuration_Pragma;
Set_Ravenscar (N);
Set_Ravenscar_Profile (N);
-------------------------
-- Restricted_Run_Time --
@ -9950,6 +10019,7 @@ package body Sem_Prag is
-- Start of prorcessing for Is_Config_Static_String
begin
Name_Len := 0;
return Add_Config_Static_String (Arg);
end Is_Config_Static_String;
@ -9965,6 +10035,7 @@ package body Sem_Prag is
-- indicates that appearence in that parameter position is significant.
Sig_Flags : constant array (Pragma_Id) of Int :=
(Pragma_AST_Entry => -1,
Pragma_Abort_Defer => -1,
Pragma_Ada_83 => -1,
@ -10095,7 +10166,7 @@ package body Sem_Prag is
Pragma_Thread_Body => +2,
Pragma_Time_Slice => -1,
Pragma_Title => -1,
Pragma_Unchecked_Union => -1,
Pragma_Unchecked_Union => 0,
Pragma_Unimplemented_Unit => -1,
Pragma_Universal_Data => -1,
Pragma_Unreferenced => -1,

View File

@ -3456,7 +3456,9 @@ package body Sem_Util is
-- Done if no more derivations to check
elsif T = T1 then
elsif T = T1
or else T = Etyp
then
return False;
-- Following test catches error cases resulting from prev errors
@ -3471,11 +3473,7 @@ package body Sem_Util is
return False;
end if;
-- Return if no further entries to check
if T = Base_Type (T1) or else T = T1 then
return False;
end if;
T := Base_Type (Etyp);
end loop;
end if;
@ -3927,7 +3925,9 @@ package body Sem_Util is
return Attribute_Name (N) = Name_Input;
when N_Selected_Component =>
return Is_Object_Reference (Selector_Name (N));
return
Is_Object_Reference (Selector_Name (N))
and then Is_Object_Reference (Prefix (N));
when N_Explicit_Dereference =>
return True;

View File

@ -4246,6 +4246,8 @@ package VMS_Data is
-- UPPER_CASE
S_Pretty_Comments : aliased constant S := "/COMMENTS_LAYOUT=" &
"UNTOUCHED " &
"-c0 " &
"DEFAULT " &
"-c1 " &
"STANDARD_INDENT " &
@ -4256,17 +4258,20 @@ package VMS_Data is
"-c4";
-- /COMMENTS_LAYOUT[=layout-option, layout-option, ...]
--
-- Set the comment layout. By default, comments use the GNAT style comment
-- line indentation.
-- layout-option may be one of the following:
-- Set the comment layout. By default, comments use the GNAT style
-- comment line indentation.
--
-- layout-option is be one of the following:
--
-- UNTOUCHED           All the comments remain unchanged
-- DEFAULT (D) GNAT style comment line indentation
-- STANDARD_INDENT Standard comment line indentation
-- GNAT_BEGINNING GNAT style comment beginning
-- REFORMAT Reformat comment blocks
--
-- All combinations of layout options are allowed, except for DEFAULT
-- and STANDARD_INDENT which are mutually exclusive.
-- and STANDARD_INDENT which are mutually exclusive, and also if
-- UNTOUCHED is specified, this must be the only option.
--
-- The difference between "GNAT style comment line indentation" and
-- "standard comment line indentation" is the following: for standard
@ -4492,6 +4497,13 @@ package VMS_Data is
--
-- MIXED_CASE Names are in mixed case.
S_Pretty_No_Backup : aliased constant S := "/NO_BACKUP " &
"-rnb";
-- /REPLACE_NO_BACKUP
--
-- Replace the argument source with the pretty-printed source without
-- creating any backup copy of the argument source.
S_Pretty_No_Labels : aliased constant S := "/NO_MISSED_LABELS " &
"-e";
-- /NO_MISSED_LABELS
@ -4533,7 +4545,8 @@ package VMS_Data is
"LOWER_CASE " &
"-pL " &
"UPPER_CASE " &
-- /PRAGMA_CASING[=pragma-option]
"-pU";
-- /PRAGMA_CASING[=pragma-option]
--
-- Set the case of pragma identifiers. The default is Mixed case.
-- pragma-option may be one of the following:
@ -4541,9 +4554,9 @@ package VMS_Data is
-- MIXED_CASE (D)
-- LOWER_CASE
-- UPPER_CASE
"-pU";
S_Pretty_Project : aliased constant S := "/PROJECT_FILE=<" &
"-P>";
S_Pretty_Project : aliased constant S := "/PROJECT_FILE=<" &
"-P>";
-- /PROJECT_FILE=filename
--
-- Specifies the main project file to be used. The project files rooted
@ -4621,6 +4634,7 @@ package VMS_Data is
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,