mirror of git://gcc.gnu.org/git/gcc.git
[multiple changes]
2011-08-29 Tristan Gingold <gingold@adacore.com> * a-exstat.adb (String_To_EO): Do no set Cleanup_Flag. * a-exexda.adb (Set_Exception_C_Msg): Ditto. (Set_Exception_Msg): Ditto. * a-exexpr-gcc.adb (Setup_Current_Excep): Ditto. Do not set Private_Data. * a-except.adb, a-except-2005.adb (Save_Occurrence_No_Private): Remove. Use Save_Occurrence instead of Save_Occurrence_No_Private. (Raise_With_Msg): Remove Cleanup_Flag. * a-except.ads, a-except-2005.ads (Exception_Occurrence): Remove Clean_Flag and Private_Data components. 2011-08-29 Yannick Moy <moy@adacore.com> * freeze.adb (Freeze_Record_Type): Ignore packing in Alfa mode, like in CodePeer mode. * sem_ch3.adb (Signed_Integer_Type_Declaration): Correct the generation of an explicitly declared type, so that the base types of the original type and this generated type are the same, and a "type" (not a subtype like previously). * errout.adb (Special_Msg_Delete): Do not issue messages "Size too small" in Alfa mode, like in CodePeer mode. * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Ignore rep clauses in Alfa mode. 2011-08-29 Javier Miranda <miranda@adacore.com> * exp_ch6.ads, exp_ch6.adb (Is_Null_Procedure): Move the spec of this function to the package spec. * sem_ch6.adb (Find_Corresponding_Spec, New_Overloaded_Entity): For internally generated bodies of null procedures locate the internally generated spec enforcing mode conformance. (Is_Interface_Conformant): Ensure that the controlling formal of the primitives match. 2011-08-29 Ed Schonberg <schonberg@adacore.com> * sem_prag.adb (Analyze_Pragma, case Inline): In an instance, do not reject the pragma if it appears to apply to a formal subprogram. 2011-08-29 Ed Schonberg <schonberg@adacore.com> * exp_ch4.adb (Expand_Allocator_Expression): Use consistent name for inner expression, to prevent double evaluation. From-SVN: r178216
This commit is contained in:
Arnaud Charlet
parent
590549fbed
commit
25ebc08558
|
|
@ -1,3 +1,49 @@
|
|||
2011-08-29 Tristan Gingold <gingold@adacore.com>
|
||||
|
||||
* a-exstat.adb (String_To_EO): Do no set Cleanup_Flag.
|
||||
* a-exexda.adb (Set_Exception_C_Msg): Ditto.
|
||||
(Set_Exception_Msg): Ditto.
|
||||
* a-exexpr-gcc.adb (Setup_Current_Excep): Ditto. Do not set
|
||||
Private_Data.
|
||||
* a-except.adb, a-except-2005.adb (Save_Occurrence_No_Private): Remove.
|
||||
Use Save_Occurrence instead of Save_Occurrence_No_Private.
|
||||
(Raise_With_Msg): Remove Cleanup_Flag.
|
||||
* a-except.ads, a-except-2005.ads (Exception_Occurrence): Remove
|
||||
Clean_Flag and Private_Data components.
|
||||
|
||||
2011-08-29 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* freeze.adb (Freeze_Record_Type): Ignore packing in Alfa mode, like
|
||||
in CodePeer mode.
|
||||
* sem_ch3.adb (Signed_Integer_Type_Declaration): Correct the generation
|
||||
of an explicitly declared type, so that the base types of the original
|
||||
type and this generated type are the same, and a "type" (not a subtype
|
||||
like previously).
|
||||
* errout.adb (Special_Msg_Delete): Do not issue messages "Size too
|
||||
small" in Alfa mode, like in CodePeer mode.
|
||||
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Ignore rep
|
||||
clauses in Alfa mode.
|
||||
|
||||
2011-08-29 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* exp_ch6.ads, exp_ch6.adb (Is_Null_Procedure): Move the spec of this
|
||||
function to the package spec.
|
||||
* sem_ch6.adb (Find_Corresponding_Spec, New_Overloaded_Entity): For
|
||||
internally generated bodies of null procedures locate the internally
|
||||
generated spec enforcing mode conformance.
|
||||
(Is_Interface_Conformant): Ensure that the controlling formal of the
|
||||
primitives match.
|
||||
|
||||
2011-08-29 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_prag.adb (Analyze_Pragma, case Inline): In an instance, do not
|
||||
reject the pragma if it appears to apply to a formal subprogram.
|
||||
|
||||
2011-08-29 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_ch4.adb (Expand_Allocator_Expression): Use consistent name for
|
||||
inner expression, to prevent double evaluation.
|
||||
|
||||
2011-08-29 Tristan Gingold <gingold@adacore.com>
|
||||
|
||||
* a-exexpr.adb (Propagate_Exception): Remove all the parameters as
|
||||
|
|
|
|||
|
|
@ -380,18 +380,6 @@ package body Ada.Exceptions is
|
|||
-- the TSD (all fields of this exception occurrence are set). Abort
|
||||
-- is deferred before the reraise operation.
|
||||
|
||||
-- Save_Occurrence variations: As the management of the private data
|
||||
-- attached to occurrences is delicate, whether or not pointers to such
|
||||
-- data has to be copied in various situations is better made explicit.
|
||||
-- The following procedures provide an internal interface to help making
|
||||
-- this explicit.
|
||||
|
||||
procedure Save_Occurrence_No_Private
|
||||
(Target : out Exception_Occurrence;
|
||||
Source : Exception_Occurrence);
|
||||
-- Copy all the components of Source to Target, except the
|
||||
-- Private_Data pointer.
|
||||
|
||||
procedure Transfer_Occurrence
|
||||
(Target : Exception_Occurrence_Access;
|
||||
Source : Exception_Occurrence);
|
||||
|
|
@ -1006,7 +994,6 @@ package body Ada.Exceptions is
|
|||
Excep.Exception_Raised := False;
|
||||
Excep.Id := E;
|
||||
Excep.Num_Tracebacks := 0;
|
||||
Excep.Cleanup_Flag := False;
|
||||
Excep.Pid := Local_Partition_ID;
|
||||
|
||||
-- The following is a common pattern, should be abstracted
|
||||
|
|
@ -1274,7 +1261,7 @@ package body Ada.Exceptions is
|
|||
Abort_Defer.all;
|
||||
end if;
|
||||
|
||||
Save_Occurrence_No_Private (Get_Current_Excep.all.all, X);
|
||||
Save_Occurrence (Get_Current_Excep.all.all, X);
|
||||
Raise_Current_Excep (X.Id);
|
||||
end if;
|
||||
end Reraise_Occurrence;
|
||||
|
|
@ -1289,7 +1276,7 @@ package body Ada.Exceptions is
|
|||
Abort_Defer.all;
|
||||
end if;
|
||||
|
||||
Save_Occurrence_No_Private (Get_Current_Excep.all.all, X);
|
||||
Save_Occurrence (Get_Current_Excep.all.all, X);
|
||||
Raise_Current_Excep (X.Id);
|
||||
end Reraise_Occurrence_Always;
|
||||
|
||||
|
|
@ -1299,7 +1286,7 @@ package body Ada.Exceptions is
|
|||
|
||||
procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence) is
|
||||
begin
|
||||
Save_Occurrence_No_Private (Get_Current_Excep.all.all, X);
|
||||
Save_Occurrence (Get_Current_Excep.all.all, X);
|
||||
Raise_Current_Excep (X.Id);
|
||||
end Reraise_Occurrence_No_Defer;
|
||||
|
||||
|
|
@ -1312,7 +1299,16 @@ package body Ada.Exceptions is
|
|||
Source : Exception_Occurrence)
|
||||
is
|
||||
begin
|
||||
Save_Occurrence_No_Private (Target, Source);
|
||||
Target.Id := Source.Id;
|
||||
Target.Msg_Length := Source.Msg_Length;
|
||||
Target.Num_Tracebacks := Source.Num_Tracebacks;
|
||||
Target.Pid := Source.Pid;
|
||||
|
||||
Target.Msg (1 .. Target.Msg_Length) :=
|
||||
Source.Msg (1 .. Target.Msg_Length);
|
||||
|
||||
Target.Tracebacks (1 .. Target.Num_Tracebacks) :=
|
||||
Source.Tracebacks (1 .. Target.Num_Tracebacks);
|
||||
end Save_Occurrence;
|
||||
|
||||
function Save_Occurrence (Source : Exception_Occurrence) return EOA is
|
||||
|
|
@ -1322,28 +1318,6 @@ package body Ada.Exceptions is
|
|||
return Target;
|
||||
end Save_Occurrence;
|
||||
|
||||
--------------------------------
|
||||
-- Save_Occurrence_No_Private --
|
||||
--------------------------------
|
||||
|
||||
procedure Save_Occurrence_No_Private
|
||||
(Target : out Exception_Occurrence;
|
||||
Source : Exception_Occurrence)
|
||||
is
|
||||
begin
|
||||
Target.Id := Source.Id;
|
||||
Target.Msg_Length := Source.Msg_Length;
|
||||
Target.Num_Tracebacks := Source.Num_Tracebacks;
|
||||
Target.Pid := Source.Pid;
|
||||
Target.Cleanup_Flag := Source.Cleanup_Flag;
|
||||
|
||||
Target.Msg (1 .. Target.Msg_Length) :=
|
||||
Source.Msg (1 .. Target.Msg_Length);
|
||||
|
||||
Target.Tracebacks (1 .. Target.Num_Tracebacks) :=
|
||||
Source.Tracebacks (1 .. Target.Num_Tracebacks);
|
||||
end Save_Occurrence_No_Private;
|
||||
|
||||
-------------------------
|
||||
-- Transfer_Occurrence --
|
||||
-------------------------
|
||||
|
|
@ -1353,7 +1327,7 @@ package body Ada.Exceptions is
|
|||
Source : Exception_Occurrence)
|
||||
is
|
||||
begin
|
||||
Save_Occurrence_No_Private (Target.all, Source);
|
||||
Save_Occurrence (Target.all, Source);
|
||||
end Transfer_Occurrence;
|
||||
|
||||
-------------------
|
||||
|
|
|
|||
|
|
@ -301,13 +301,6 @@ private
|
|||
Msg : String (1 .. Exception_Msg_Max_Length);
|
||||
-- Characters of message
|
||||
|
||||
Cleanup_Flag : Boolean := False;
|
||||
-- The cleanup flag is normally False, it is set True for an exception
|
||||
-- occurrence passed to a cleanup routine, and will still be set True
|
||||
-- when the cleanup routine does a Reraise_Occurrence call using this
|
||||
-- exception occurrence. This is used to avoid recording a bogus trace
|
||||
-- back entry from this reraise call.
|
||||
|
||||
Exception_Raised : Boolean := False;
|
||||
-- Set to true to indicate that this exception occurrence has actually
|
||||
-- been raised. When an exception occurrence is first created, this is
|
||||
|
|
@ -325,11 +318,6 @@ private
|
|||
|
||||
Tracebacks : Tracebacks_Array;
|
||||
-- Stored tracebacks (in Tracebacks (1 .. Num_Tracebacks))
|
||||
|
||||
Private_Data : System.Address := System.Null_Address;
|
||||
-- Field used by low level exception mechanism to store specific data.
|
||||
-- Currently used by the GCC exception mechanism to store a pointer to
|
||||
-- a GNAT_GCC_Exception.
|
||||
end record;
|
||||
|
||||
function "=" (Left, Right : Exception_Occurrence) return Boolean
|
||||
|
|
@ -347,11 +335,9 @@ private
|
|||
Id => null,
|
||||
Msg_Length => 0,
|
||||
Msg => (others => ' '),
|
||||
Cleanup_Flag => False,
|
||||
Exception_Raised => False,
|
||||
Pid => 0,
|
||||
Num_Tracebacks => 0,
|
||||
Tracebacks => (others => TBE.Null_TB_Entry),
|
||||
Private_Data => System.Null_Address);
|
||||
Tracebacks => (others => TBE.Null_TB_Entry));
|
||||
|
||||
end Ada.Exceptions;
|
||||
|
|
|
|||
|
|
@ -341,18 +341,6 @@ package body Ada.Exceptions is
|
|||
-- (all fields of this exception occurrence are set). Abort is deferred
|
||||
-- before the reraise operation.
|
||||
|
||||
-- Save_Occurrence variations: As the management of the private data
|
||||
-- attached to occurrences is delicate, whether or not pointers to such
|
||||
-- data has to be copied in various situations is better made explicit.
|
||||
-- The following procedures provide an internal interface to help making
|
||||
-- this explicit.
|
||||
|
||||
procedure Save_Occurrence_No_Private
|
||||
(Target : out Exception_Occurrence;
|
||||
Source : Exception_Occurrence);
|
||||
-- Copy all the components of Source to Target, except the
|
||||
-- Private_Data pointer.
|
||||
|
||||
procedure Transfer_Occurrence
|
||||
(Target : Exception_Occurrence_Access;
|
||||
Source : Exception_Occurrence);
|
||||
|
|
@ -959,7 +947,6 @@ package body Ada.Exceptions is
|
|||
Excep.Exception_Raised := False;
|
||||
Excep.Id := E;
|
||||
Excep.Num_Tracebacks := 0;
|
||||
Excep.Cleanup_Flag := False;
|
||||
Excep.Pid := Local_Partition_ID;
|
||||
Abort_Defer.all;
|
||||
Raise_Current_Excep (E);
|
||||
|
|
@ -1164,7 +1151,7 @@ package body Ada.Exceptions is
|
|||
begin
|
||||
if X.Id /= null then
|
||||
Abort_Defer.all;
|
||||
Save_Occurrence_No_Private (Get_Current_Excep.all.all, X);
|
||||
Save_Occurrence (Get_Current_Excep.all.all, X);
|
||||
Raise_Current_Excep (X.Id);
|
||||
end if;
|
||||
end Reraise_Occurrence;
|
||||
|
|
@ -1176,7 +1163,7 @@ package body Ada.Exceptions is
|
|||
procedure Reraise_Occurrence_Always (X : Exception_Occurrence) is
|
||||
begin
|
||||
Abort_Defer.all;
|
||||
Save_Occurrence_No_Private (Get_Current_Excep.all.all, X);
|
||||
Save_Occurrence (Get_Current_Excep.all.all, X);
|
||||
Raise_Current_Excep (X.Id);
|
||||
end Reraise_Occurrence_Always;
|
||||
|
||||
|
|
@ -1186,7 +1173,7 @@ package body Ada.Exceptions is
|
|||
|
||||
procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence) is
|
||||
begin
|
||||
Save_Occurrence_No_Private (Get_Current_Excep.all.all, X);
|
||||
Save_Occurrence (Get_Current_Excep.all.all, X);
|
||||
Raise_Current_Excep (X.Id);
|
||||
end Reraise_Occurrence_No_Defer;
|
||||
|
||||
|
|
@ -1199,7 +1186,16 @@ package body Ada.Exceptions is
|
|||
Source : Exception_Occurrence)
|
||||
is
|
||||
begin
|
||||
Save_Occurrence_No_Private (Target, Source);
|
||||
Target.Id := Source.Id;
|
||||
Target.Msg_Length := Source.Msg_Length;
|
||||
Target.Num_Tracebacks := Source.Num_Tracebacks;
|
||||
Target.Pid := Source.Pid;
|
||||
|
||||
Target.Msg (1 .. Target.Msg_Length) :=
|
||||
Source.Msg (1 .. Target.Msg_Length);
|
||||
|
||||
Target.Tracebacks (1 .. Target.Num_Tracebacks) :=
|
||||
Source.Tracebacks (1 .. Target.Num_Tracebacks);
|
||||
end Save_Occurrence;
|
||||
|
||||
function Save_Occurrence (Source : Exception_Occurrence) return EOA is
|
||||
|
|
@ -1209,28 +1205,6 @@ package body Ada.Exceptions is
|
|||
return Target;
|
||||
end Save_Occurrence;
|
||||
|
||||
--------------------------------
|
||||
-- Save_Occurrence_No_Private --
|
||||
--------------------------------
|
||||
|
||||
procedure Save_Occurrence_No_Private
|
||||
(Target : out Exception_Occurrence;
|
||||
Source : Exception_Occurrence)
|
||||
is
|
||||
begin
|
||||
Target.Id := Source.Id;
|
||||
Target.Msg_Length := Source.Msg_Length;
|
||||
Target.Num_Tracebacks := Source.Num_Tracebacks;
|
||||
Target.Pid := Source.Pid;
|
||||
Target.Cleanup_Flag := Source.Cleanup_Flag;
|
||||
|
||||
Target.Msg (1 .. Target.Msg_Length) :=
|
||||
Source.Msg (1 .. Target.Msg_Length);
|
||||
|
||||
Target.Tracebacks (1 .. Target.Num_Tracebacks) :=
|
||||
Source.Tracebacks (1 .. Target.Num_Tracebacks);
|
||||
end Save_Occurrence_No_Private;
|
||||
|
||||
-------------------------
|
||||
-- Transfer_Occurrence --
|
||||
-------------------------
|
||||
|
|
@ -1240,13 +1214,7 @@ package body Ada.Exceptions is
|
|||
Source : Exception_Occurrence)
|
||||
is
|
||||
begin
|
||||
-- Setup Target as an exception to be propagated in the calling task
|
||||
-- (rendezvous-wise), taking care not to clobber the associated private
|
||||
-- data. Target is expected to be a pointer to the calling task's fixed
|
||||
-- TSD occurrence, which is very different from Get_Current_Excep here
|
||||
-- because this subprogram is called from the called task.
|
||||
|
||||
Save_Occurrence_No_Private (Target.all, Source);
|
||||
Save_Occurrence (Target.all, Source);
|
||||
end Transfer_Occurrence;
|
||||
|
||||
-------------------
|
||||
|
|
|
|||
|
|
@ -271,13 +271,6 @@ private
|
|||
Msg : String (1 .. Exception_Msg_Max_Length);
|
||||
-- Characters of message
|
||||
|
||||
Cleanup_Flag : Boolean := False;
|
||||
-- The cleanup flag is normally False, it is set True for an exception
|
||||
-- occurrence passed to a cleanup routine, and will still be set True
|
||||
-- when the cleanup routine does a Reraise_Occurrence call using this
|
||||
-- exception occurrence. This is used to avoid recording a bogus trace
|
||||
-- back entry from this reraise call.
|
||||
|
||||
Exception_Raised : Boolean := False;
|
||||
-- Set to true to indicate that this exception occurrence has actually
|
||||
-- been raised. When an exception occurrence is first created, this is
|
||||
|
|
@ -295,11 +288,6 @@ private
|
|||
|
||||
Tracebacks : Tracebacks_Array;
|
||||
-- Stored tracebacks (in Tracebacks (1 .. Num_Tracebacks))
|
||||
|
||||
Private_Data : System.Address := System.Null_Address;
|
||||
-- Field used by low level exception mechanism to store specific data.
|
||||
-- Currently used by the GCC exception mechanism to store a pointer to
|
||||
-- a GNAT_GCC_Exception.
|
||||
end record;
|
||||
|
||||
function "=" (Left, Right : Exception_Occurrence) return Boolean
|
||||
|
|
@ -317,11 +305,9 @@ private
|
|||
Id => null,
|
||||
Msg_Length => 0,
|
||||
Msg => (others => ' '),
|
||||
Cleanup_Flag => False,
|
||||
Exception_Raised => False,
|
||||
Pid => 0,
|
||||
Num_Tracebacks => 0,
|
||||
Tracebacks => (others => TBE.Null_TB_Entry),
|
||||
Private_Data => System.Null_Address);
|
||||
Tracebacks => (others => TBE.Null_TB_Entry));
|
||||
|
||||
end Ada.Exceptions;
|
||||
|
|
|
|||
|
|
@ -617,7 +617,6 @@ package body Exception_Data is
|
|||
Excep.Num_Tracebacks := 0;
|
||||
Excep.Pid := Local_Partition_ID;
|
||||
Excep.Msg_Length := 0;
|
||||
Excep.Cleanup_Flag := False;
|
||||
|
||||
while To_Ptr (Msg1) (Excep.Msg_Length + 1) /= ASCII.NUL
|
||||
and then Excep.Msg_Length < Exception_Msg_Max_Length
|
||||
|
|
@ -668,7 +667,6 @@ package body Exception_Data is
|
|||
Excep.Id := Id;
|
||||
Excep.Num_Tracebacks := 0;
|
||||
Excep.Pid := Local_Partition_ID;
|
||||
Excep.Cleanup_Flag := False;
|
||||
|
||||
end Set_Exception_Msg;
|
||||
|
||||
|
|
|
|||
|
|
@ -350,11 +350,9 @@ package body Exception_Propagation is
|
|||
|
||||
Excep.Id := Foreign_Exception'Access;
|
||||
Excep.Msg_Length := 0;
|
||||
Excep.Cleanup_Flag := False;
|
||||
Excep.Exception_Raised := True;
|
||||
Excep.Pid := Local_Partition_ID;
|
||||
Excep.Num_Tracebacks := 0;
|
||||
Excep.Private_Data := System.Null_Address;
|
||||
end if;
|
||||
end Setup_Current_Excep;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2011, 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- --
|
||||
|
|
@ -144,8 +144,6 @@ package body Stream_Attributes is
|
|||
return Null_Occurrence;
|
||||
|
||||
else
|
||||
X.Cleanup_Flag := False;
|
||||
|
||||
To := S'First - 2;
|
||||
Next_String;
|
||||
|
||||
|
|
|
|||
|
|
@ -2832,10 +2832,10 @@ package body Errout is
|
|||
|
||||
elsif Msg = "size for& too small, minimum allowed is ^" then
|
||||
|
||||
-- Suppress "size too small" errors in CodePeer mode, since pragma
|
||||
-- Pack is also ignored in this configuration.
|
||||
-- Suppress "size too small" errors in CodePeer mode and ALFA mode,
|
||||
-- since pragma Pack is also ignored in this configuration.
|
||||
|
||||
if CodePeer_Mode then
|
||||
if CodePeer_Mode or ALFA_Mode then
|
||||
return True;
|
||||
|
||||
-- When a size is wrong for a frozen type there is no explicit size
|
||||
|
|
|
|||
|
|
@ -1165,7 +1165,8 @@ package body Exp_Ch4 is
|
|||
Insert_Action (Exp,
|
||||
Make_Subtype_Declaration (Loc,
|
||||
Defining_Identifier => ConstrT,
|
||||
Subtype_Indication => Make_Subtype_From_Expr (Exp, T)));
|
||||
Subtype_Indication =>
|
||||
Make_Subtype_From_Expr (Internal_Exp, T)));
|
||||
Freeze_Itype (ConstrT, Exp);
|
||||
Rewrite (Exp, OK_Convert_To (ConstrT, Internal_Exp));
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -223,10 +223,6 @@ package body Exp_Ch6 is
|
|||
-- reference to the object itself, and the call becomes a call to the
|
||||
-- corresponding protected subprogram.
|
||||
|
||||
function Is_Null_Procedure (Subp : Entity_Id) return Boolean;
|
||||
-- Predicate to recognize stubbed procedures and null procedures, which
|
||||
-- can be inlined unconditionally in all cases.
|
||||
|
||||
procedure Expand_Simple_Function_Return (N : Node_Id);
|
||||
-- Expand simple return from function. In the case where we are returning
|
||||
-- from a function body this is called by Expand_N_Simple_Return_Statement.
|
||||
|
|
|
|||
|
|
@ -119,6 +119,10 @@ package Exp_Ch6 is
|
|||
-- that requires handling as a build-in-place call or is a qualified
|
||||
-- expression applied to such a call; otherwise returns False.
|
||||
|
||||
function Is_Null_Procedure (Subp : Entity_Id) return Boolean;
|
||||
-- Predicate to recognize stubbed procedures and null procedures, which
|
||||
-- can be inlined unconditionally in all cases.
|
||||
|
||||
procedure Make_Build_In_Place_Call_In_Allocator
|
||||
(Allocator : Node_Id;
|
||||
Function_Call : Node_Id);
|
||||
|
|
|
|||
|
|
@ -2246,12 +2246,14 @@ package body Freeze is
|
|||
|
||||
and then RM_Size (Rec) >= Scalar_Component_Total_RM_Size
|
||||
|
||||
-- Never do implicit packing in CodePeer mode since we don't do
|
||||
-- any packing in this mode, since this generates over-complex
|
||||
-- code that confuses CodePeer, and in general, CodePeer does not
|
||||
-- care about the internal representation of objects.
|
||||
-- Never do implicit packing in CodePeer or ALFA modes since
|
||||
-- we don't do any packing in this mode, since this generates
|
||||
-- over-complex code that confuses static analysis, and in
|
||||
-- general, neither CodePeer not GNATprove care about the
|
||||
-- internal representation of objects.
|
||||
|
||||
and then not CodePeer_Mode
|
||||
and then not ALFA_Mode
|
||||
then
|
||||
-- If implicit packing enabled, do it
|
||||
|
||||
|
|
@ -3066,6 +3068,7 @@ package body Freeze is
|
|||
and then not Is_Packed (Root_Type (E))
|
||||
and then not Has_Component_Size_Clause (Root_Type (E))
|
||||
and then not CodePeer_Mode
|
||||
and then not ALFA_Mode
|
||||
then
|
||||
Get_Index_Bounds (First_Index (E), Lo, Hi);
|
||||
|
||||
|
|
|
|||
|
|
@ -2004,9 +2004,10 @@ package body Sem_Ch13 is
|
|||
end if;
|
||||
|
||||
-- Process Ignore_Rep_Clauses option (we also ignore rep clauses in
|
||||
-- CodePeer mode, since they are not relevant in that context).
|
||||
-- CodePeer mode or ALFA mode, since they are not relevant in these
|
||||
-- contexts).
|
||||
|
||||
if Ignore_Rep_Clauses or CodePeer_Mode then
|
||||
if Ignore_Rep_Clauses or CodePeer_Mode or ALFA_Mode then
|
||||
case Id is
|
||||
|
||||
-- The following should be ignored. They do not affect legality
|
||||
|
|
@ -2026,8 +2027,8 @@ package body Sem_Ch13 is
|
|||
Rewrite (N, Make_Null_Statement (Sloc (N)));
|
||||
return;
|
||||
|
||||
-- We do not want too ignore 'Small in CodePeer_Mode, since it
|
||||
-- has an impact on the exact computations performed.
|
||||
-- We do not want too ignore 'Small in CodePeer_Mode or ALFA_Mode,
|
||||
-- since it has an impact on the exact computations performed.
|
||||
|
||||
-- Perhaps 'Small should also not be ignored by
|
||||
-- Ignore_Rep_Clauses ???
|
||||
|
|
|
|||
|
|
@ -19771,14 +19771,14 @@ package body Sem_Ch3 is
|
|||
if ALFA_Mode then
|
||||
|
||||
-- If the range of the type is already symmetric with a possible
|
||||
-- extra negative value, just make the type its own base type.
|
||||
-- extra negative value, leave it this way.
|
||||
|
||||
if UI_Le (Lo_Val, Hi_Val)
|
||||
and then (UI_Eq (Lo_Val, UI_Negate (Hi_Val))
|
||||
or else
|
||||
UI_Eq (Lo_Val, UI_Sub (UI_Negate (Hi_Val), Uint_1)))
|
||||
then
|
||||
Set_Etype (T, T);
|
||||
null;
|
||||
|
||||
else
|
||||
declare
|
||||
|
|
@ -19830,7 +19830,8 @@ package body Sem_Ch3 is
|
|||
High_Bound => Ubound));
|
||||
|
||||
Analyze (Decl);
|
||||
Set_Etype (Implicit_Base, Implicit_Base);
|
||||
Set_Etype (Implicit_Base, Base_Type (Implicit_Base));
|
||||
Set_Etype (T, Base_Type (Implicit_Base));
|
||||
Insert_Before (Parent (Def), Decl);
|
||||
end;
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -6362,7 +6362,19 @@ package body Sem_Ch6 is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
if not Has_Completion (E) then
|
||||
-- Ada 2012 (AI05-0165): For internally generated bodies of
|
||||
-- null procedures locate the internally generated spec. We
|
||||
-- enforce mode conformance since a tagged type may inherit
|
||||
-- from interfaces several null primitives which differ only
|
||||
-- in the mode of the formals.
|
||||
|
||||
if not (Comes_From_Source (E))
|
||||
and then Is_Null_Procedure (E)
|
||||
and then not Mode_Conformant (Designator, E)
|
||||
then
|
||||
null;
|
||||
|
||||
elsif not Has_Completion (E) then
|
||||
if Nkind (N) /= N_Subprogram_Body_Stub then
|
||||
Set_Corresponding_Spec (N, E);
|
||||
end if;
|
||||
|
|
@ -7037,6 +7049,30 @@ package body Sem_Ch6 is
|
|||
Iface : constant Entity_Id := Find_Dispatching_Type (Iface_Prim);
|
||||
Typ : constant Entity_Id := Find_Dispatching_Type (Prim);
|
||||
|
||||
function Controlling_Formal (Prim : Entity_Id) return Entity_Id;
|
||||
-- Return the controlling formal of Prim
|
||||
|
||||
function Controlling_Formal (Prim : Entity_Id) return Entity_Id is
|
||||
E : Entity_Id := First_Entity (Prim);
|
||||
begin
|
||||
while Present (E) loop
|
||||
if Is_Formal (E) and then Is_Controlling_Formal (E) then
|
||||
return E;
|
||||
end if;
|
||||
|
||||
Next_Entity (E);
|
||||
end loop;
|
||||
|
||||
return Empty;
|
||||
end Controlling_Formal;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Iface_Ctrl_F : constant Entity_Id := Controlling_Formal (Iface_Prim);
|
||||
Prim_Ctrl_F : constant Entity_Id := Controlling_Formal (Prim);
|
||||
|
||||
-- Start of processing for Is_Interface_Conformant
|
||||
|
||||
begin
|
||||
pragma Assert (Is_Subprogram (Iface_Prim)
|
||||
and then Is_Subprogram (Prim)
|
||||
|
|
@ -7060,8 +7096,17 @@ package body Sem_Ch6 is
|
|||
then
|
||||
return False;
|
||||
|
||||
-- Case of a procedure, or a function that does not have a controlling
|
||||
-- result (I or access I).
|
||||
-- The mode of the controlling formals must match
|
||||
|
||||
elsif Present (Iface_Ctrl_F)
|
||||
and then Present (Prim_Ctrl_F)
|
||||
and then Ekind (Iface_Ctrl_F) /= Ekind (Prim_Ctrl_F)
|
||||
then
|
||||
return False;
|
||||
|
||||
-- Case of a procedure, or a function whose result type matches the
|
||||
-- result type of the interface primitive, or a function that has no
|
||||
-- controlling result (I or access I).
|
||||
|
||||
elsif Ekind (Iface_Prim) = E_Procedure
|
||||
or else Etype (Prim) = Etype (Iface_Prim)
|
||||
|
|
@ -8254,6 +8299,18 @@ package body Sem_Ch6 is
|
|||
if Scope (E) /= Current_Scope then
|
||||
null;
|
||||
|
||||
-- Ada 2012 (AI05-0165): For internally generated bodies of
|
||||
-- null procedures locate the internally generated spec. We
|
||||
-- enforce mode conformance since a tagged type may inherit
|
||||
-- from interfaces several null primitives which differ only
|
||||
-- in the mode of the formals.
|
||||
|
||||
elsif not Comes_From_Source (S)
|
||||
and then Is_Null_Procedure (S)
|
||||
and then not Mode_Conformant (E, S)
|
||||
then
|
||||
null;
|
||||
|
||||
-- Check if we have type conformance
|
||||
|
||||
elsif Type_Conformant (E, S) then
|
||||
|
|
|
|||
|
|
@ -4694,9 +4694,12 @@ package body Sem_Prag is
|
|||
|
||||
-- Inline is a program unit pragma (RM 10.1.5) and cannot
|
||||
-- appear in a formal part to apply to a formal subprogram.
|
||||
-- Do not apply check within an instance or a formal package
|
||||
-- the test will have been applied to the original generic.
|
||||
|
||||
elsif Nkind (Decl) in N_Formal_Subprogram_Declaration
|
||||
and then List_Containing (Decl) = List_Containing (N)
|
||||
and then not In_Instance
|
||||
then
|
||||
Error_Msg_N
|
||||
("Inline cannot apply to a formal subprogram", N);
|
||||
|
|
|
|||
Loading…
Reference in New Issue