[multiple changes]
2016-07-06 Arnaud Charlet <charlet@adacore.com> * lib.adb (Check_Same_Extended_Unit): Complete previous change. * sem_intr.adb (Errint): New parameter Relaxed. Refine previous change to only disable errors selectively. * sem_util.adb: minor style fix in object declaration 2016-07-06 Yannick Moy <moy@adacore.com> * sem_warn.adb (Check_Infinite_Loop_Warning.Find_Var): Special case a call to a volatile function, so that it does not lead to a warning in that case. 2016-07-06 Hristian Kirtchev <kirtchev@adacore.com> * sem_ch12.adb, sem_ch4.adb, sem_ch6.adb: Minor reformatting. 2016-07-06 Hristian Kirtchev <kirtchev@adacore.com> * gnat1drv.adb: Code clean up. Do not emit any code generation errors when the unit is ignored Ghost. 2016-07-06 Ed Schonberg <schonberg@adacore.com> * sem_eval.adb (Check_Non_Static_Context): If the expression is a real literal of a floating point type that is part of a larger expression and is not a static expression, transform it into a machine number now so that the rest of the computation, even if other components are static, is not evaluated with extra precision. 2016-07-06 Javier Miranda <miranda@adacore.com> * sem_ch13.adb (Freeze_Entity_Checks): Undo previous patch and move the needed functionality to Analyze_Freeze_Generic_Entity. (Analyze_Freeze_Generic_Entity): If the entity is not already frozen and has delayed aspects then analyze them. 2016-07-06 Yannick Moy <moy@adacore.com> * sem_prag.adb (Analyze_Pragma.Process_Inline.Set_Inline_Flags): Special case for unanalyzed body entity of ghost expression function. From-SVN: r238050
This commit is contained in:
Arnaud Charlet
parent
6ffe854859
commit
d030f3a451
@ -1,3 +1,46 @@
|
||||
2016-07-06 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* lib.adb (Check_Same_Extended_Unit): Complete previous change.
|
||||
* sem_intr.adb (Errint): New parameter Relaxed. Refine previous
|
||||
change to only disable errors selectively.
|
||||
* sem_util.adb: minor style fix in object declaration
|
||||
|
||||
2016-07-06 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* sem_warn.adb (Check_Infinite_Loop_Warning.Find_Var): Special case a
|
||||
call to a volatile function, so that it does not lead to a warning in
|
||||
that case.
|
||||
|
||||
2016-07-06 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_ch12.adb, sem_ch4.adb, sem_ch6.adb: Minor reformatting.
|
||||
|
||||
2016-07-06 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* gnat1drv.adb: Code clean up. Do not emit any
|
||||
code generation errors when the unit is ignored Ghost.
|
||||
|
||||
2016-07-06 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_eval.adb (Check_Non_Static_Context): If the expression
|
||||
is a real literal of a floating point type that is part of a
|
||||
larger expression and is not a static expression, transform it
|
||||
into a machine number now so that the rest of the computation,
|
||||
even if other components are static, is not evaluated with
|
||||
extra precision.
|
||||
|
||||
2016-07-06 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* sem_ch13.adb (Freeze_Entity_Checks): Undo previous patch and move the
|
||||
needed functionality to Analyze_Freeze_Generic_Entity.
|
||||
(Analyze_Freeze_Generic_Entity): If the entity is not already frozen
|
||||
and has delayed aspects then analyze them.
|
||||
|
||||
2016-07-06 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* sem_prag.adb (Analyze_Pragma.Process_Inline.Set_Inline_Flags):
|
||||
Special case for unanalyzed body entity of ghost expression function.
|
||||
|
||||
2016-07-06 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* sem_ch7.adb (Analyze_Package_Specification): Insert its
|
||||
|
||||
@ -89,15 +89,6 @@ with System.OS_Lib;
|
||||
--------------
|
||||
|
||||
procedure Gnat1drv is
|
||||
Main_Unit_Node : Node_Id;
|
||||
-- Compilation unit node for main unit
|
||||
|
||||
Main_Kind : Node_Kind;
|
||||
-- Kind of main compilation unit node
|
||||
|
||||
Back_End_Mode : Back_End.Back_End_Mode_Type;
|
||||
-- Record back-end mode
|
||||
|
||||
procedure Adjust_Global_Switches;
|
||||
-- There are various interactions between front-end switch settings,
|
||||
-- including debug switch settings and target dependent parameters.
|
||||
@ -105,8 +96,9 @@ procedure Gnat1drv is
|
||||
-- We do it after scanning out all the switches, so that we are not
|
||||
-- depending on the order in which switches appear.
|
||||
|
||||
procedure Check_Bad_Body;
|
||||
-- Called to check if the unit we are compiling has a bad body
|
||||
procedure Check_Bad_Body (Unit_Node : Node_Id; Unit_Kind : Node_Kind);
|
||||
-- Called to check whether a unit described by its compilation unit node
|
||||
-- and kind has a bad body.
|
||||
|
||||
procedure Check_Rep_Info;
|
||||
-- Called when we are not generating code, to check if -gnatR was requested
|
||||
@ -712,10 +704,8 @@ procedure Gnat1drv is
|
||||
-- Check_Bad_Body --
|
||||
--------------------
|
||||
|
||||
procedure Check_Bad_Body is
|
||||
Sname : Unit_Name_Type;
|
||||
Src_Ind : Source_File_Index;
|
||||
Fname : File_Name_Type;
|
||||
procedure Check_Bad_Body (Unit_Node : Node_Id; Unit_Kind : Node_Kind) is
|
||||
Fname : File_Name_Type;
|
||||
|
||||
procedure Bad_Body_Error (Msg : String);
|
||||
-- Issue message for bad body found
|
||||
@ -726,11 +716,16 @@ procedure Gnat1drv is
|
||||
|
||||
procedure Bad_Body_Error (Msg : String) is
|
||||
begin
|
||||
Error_Msg_N (Msg, Main_Unit_Node);
|
||||
Error_Msg_N (Msg, Unit_Node);
|
||||
Error_Msg_File_1 := Fname;
|
||||
Error_Msg_N ("remove incorrect body in file{!", Main_Unit_Node);
|
||||
Error_Msg_N ("remove incorrect body in file{!", Unit_Node);
|
||||
end Bad_Body_Error;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Sname : Unit_Name_Type;
|
||||
Src_Ind : Source_File_Index;
|
||||
|
||||
-- Start of processing for Check_Bad_Body
|
||||
|
||||
begin
|
||||
@ -743,13 +738,13 @@ procedure Gnat1drv is
|
||||
|
||||
-- Check for body not allowed
|
||||
|
||||
if (Main_Kind = N_Package_Declaration
|
||||
and then not Body_Required (Main_Unit_Node))
|
||||
or else (Main_Kind = N_Generic_Package_Declaration
|
||||
and then not Body_Required (Main_Unit_Node))
|
||||
or else Main_Kind = N_Package_Renaming_Declaration
|
||||
or else Main_Kind = N_Subprogram_Renaming_Declaration
|
||||
or else Nkind (Original_Node (Unit (Main_Unit_Node)))
|
||||
if (Unit_Kind = N_Package_Declaration
|
||||
and then not Body_Required (Unit_Node))
|
||||
or else (Unit_Kind = N_Generic_Package_Declaration
|
||||
and then not Body_Required (Unit_Node))
|
||||
or else Unit_Kind = N_Package_Renaming_Declaration
|
||||
or else Unit_Kind = N_Subprogram_Renaming_Declaration
|
||||
or else Nkind (Original_Node (Unit (Unit_Node)))
|
||||
in N_Generic_Instantiation
|
||||
then
|
||||
Sname := Unit_Name (Main_Unit);
|
||||
@ -793,16 +788,16 @@ procedure Gnat1drv is
|
||||
-- be incorrect (we may have misinterpreted a junk spec as not
|
||||
-- needing a body when it really does).
|
||||
|
||||
if Main_Kind = N_Package_Declaration
|
||||
if Unit_Kind = N_Package_Declaration
|
||||
and then Ada_Version = Ada_83
|
||||
and then Operating_Mode = Generate_Code
|
||||
and then Distribution_Stub_Mode /= Generate_Caller_Stub_Body
|
||||
and then not Compilation_Errors
|
||||
then
|
||||
Error_Msg_N
|
||||
("package $$ does not require a body??", Main_Unit_Node);
|
||||
("package $$ does not require a body??", Unit_Node);
|
||||
Error_Msg_File_1 := Fname;
|
||||
Error_Msg_N ("body in file{ will be ignored??", Main_Unit_Node);
|
||||
Error_Msg_N ("body in file{ will be ignored??", Unit_Node);
|
||||
|
||||
-- Ada 95 cases of a body file present when no body is
|
||||
-- permitted. This we consider to be an error.
|
||||
@ -810,15 +805,15 @@ procedure Gnat1drv is
|
||||
else
|
||||
-- For generic instantiations, we never allow a body
|
||||
|
||||
if Nkind (Original_Node (Unit (Main_Unit_Node))) in
|
||||
if Nkind (Original_Node (Unit (Unit_Node))) in
|
||||
N_Generic_Instantiation
|
||||
then
|
||||
Bad_Body_Error
|
||||
("generic instantiation for $$ does not allow a body");
|
||||
|
||||
-- A library unit that is a renaming never allows a body
|
||||
-- A library unit that is a renaming never allows a body
|
||||
|
||||
elsif Main_Kind in N_Renaming_Declaration then
|
||||
elsif Unit_Kind in N_Renaming_Declaration then
|
||||
Bad_Body_Error
|
||||
("renaming declaration for $$ does not allow a body!");
|
||||
|
||||
@ -829,11 +824,11 @@ procedure Gnat1drv is
|
||||
-- body when in fact it does.
|
||||
|
||||
elsif not Compilation_Errors then
|
||||
if Main_Kind = N_Package_Declaration then
|
||||
if Unit_Kind = N_Package_Declaration then
|
||||
Bad_Body_Error
|
||||
("package $$ does not allow a body!");
|
||||
|
||||
elsif Main_Kind = N_Generic_Package_Declaration then
|
||||
elsif Unit_Kind = N_Generic_Package_Declaration then
|
||||
Bad_Body_Error
|
||||
("generic package $$ does not allow a body!");
|
||||
end if;
|
||||
@ -893,9 +888,18 @@ procedure Gnat1drv is
|
||||
if AAMP_On_Target then
|
||||
Sem_Ch13.Validate_Independence;
|
||||
end if;
|
||||
|
||||
end Post_Compilation_Validation_Checks;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Back_End_Mode : Back_End.Back_End_Mode_Type;
|
||||
|
||||
Main_Unit_Kind : Node_Kind;
|
||||
-- Kind of main compilation unit node
|
||||
|
||||
Main_Unit_Node : Node_Id;
|
||||
-- Compilation unit node for main unit
|
||||
|
||||
-- Start of processing for Gnat1drv
|
||||
|
||||
begin
|
||||
@ -1065,8 +1069,9 @@ begin
|
||||
end if;
|
||||
|
||||
Main_Unit_Node := Cunit (Main_Unit);
|
||||
Main_Kind := Nkind (Unit (Main_Unit_Node));
|
||||
Check_Bad_Body;
|
||||
Main_Unit_Kind := Nkind (Unit (Main_Unit_Node));
|
||||
|
||||
Check_Bad_Body (Main_Unit_Node, Main_Unit_Kind);
|
||||
|
||||
-- In CodePeer mode we always delete old SCIL files before regenerating
|
||||
-- new ones, in case of e.g. errors, and also to remove obsolete scilx
|
||||
@ -1159,21 +1164,23 @@ begin
|
||||
-- subunits. Note that we always generate code for all generic units (a
|
||||
-- change from some previous versions of GNAT).
|
||||
|
||||
elsif Main_Kind = N_Subprogram_Body and then not Subunits_Missing then
|
||||
elsif Main_Unit_Kind = N_Subprogram_Body
|
||||
and then not Subunits_Missing
|
||||
then
|
||||
Back_End_Mode := Generate_Object;
|
||||
|
||||
-- We can generate code for a package body unless there are subunits
|
||||
-- missing (note that we always generate code for generic units, which
|
||||
-- is a change from some earlier versions of GNAT).
|
||||
|
||||
elsif Main_Kind = N_Package_Body and then not Subunits_Missing then
|
||||
elsif Main_Unit_Kind = N_Package_Body and then not Subunits_Missing then
|
||||
Back_End_Mode := Generate_Object;
|
||||
|
||||
-- We can generate code for a package declaration or a subprogram
|
||||
-- declaration only if it does not required a body.
|
||||
|
||||
elsif Nkind_In (Main_Kind, N_Package_Declaration,
|
||||
N_Subprogram_Declaration)
|
||||
elsif Nkind_In (Main_Unit_Kind, N_Package_Declaration,
|
||||
N_Subprogram_Declaration)
|
||||
and then
|
||||
(not Body_Required (Main_Unit_Node)
|
||||
or else Distribution_Stub_Mode = Generate_Caller_Stub_Body)
|
||||
@ -1183,8 +1190,8 @@ begin
|
||||
-- We can generate code for a generic package declaration of a generic
|
||||
-- subprogram declaration only if does not require a body.
|
||||
|
||||
elsif Nkind_In (Main_Kind, N_Generic_Package_Declaration,
|
||||
N_Generic_Subprogram_Declaration)
|
||||
elsif Nkind_In (Main_Unit_Kind, N_Generic_Package_Declaration,
|
||||
N_Generic_Subprogram_Declaration)
|
||||
and then not Body_Required (Main_Unit_Node)
|
||||
then
|
||||
Back_End_Mode := Generate_Object;
|
||||
@ -1192,15 +1199,15 @@ begin
|
||||
-- Compilation units that are renamings do not require bodies, so we can
|
||||
-- generate code for them.
|
||||
|
||||
elsif Nkind_In (Main_Kind, N_Package_Renaming_Declaration,
|
||||
N_Subprogram_Renaming_Declaration)
|
||||
elsif Nkind_In (Main_Unit_Kind, N_Package_Renaming_Declaration,
|
||||
N_Subprogram_Renaming_Declaration)
|
||||
then
|
||||
Back_End_Mode := Generate_Object;
|
||||
|
||||
-- Compilation units that are generic renamings do not require bodies
|
||||
-- so we can generate code for them.
|
||||
|
||||
elsif Main_Kind in N_Generic_Renaming_Declaration then
|
||||
elsif Main_Unit_Kind in N_Generic_Renaming_Declaration then
|
||||
Back_End_Mode := Generate_Object;
|
||||
|
||||
-- It is not an error to analyze in CodePeer mode a spec which requires
|
||||
@ -1240,45 +1247,61 @@ begin
|
||||
-- generate code).
|
||||
|
||||
if Back_End_Mode = Skip then
|
||||
Set_Standard_Error;
|
||||
Write_Str ("cannot generate code for file ");
|
||||
Write_Name (Unit_File_Name (Main_Unit));
|
||||
|
||||
if Subunits_Missing then
|
||||
Write_Str (" (missing subunits)");
|
||||
Write_Eol;
|
||||
-- An ignored Ghost unit is rewritten into a null statement because
|
||||
-- it must not produce an ALI or object file. Do not emit any errors
|
||||
-- related to code generation because the unit does not exist.
|
||||
|
||||
-- Force generation of ALI file, for backward compatibility
|
||||
if Main_Unit_Kind = N_Null_Statement
|
||||
and then Is_Ignored_Ghost_Node
|
||||
(Original_Node (Unit (Main_Unit_Node)))
|
||||
then
|
||||
null;
|
||||
|
||||
Opt.Force_ALI_Tree_File := True;
|
||||
|
||||
elsif Main_Kind = N_Subunit then
|
||||
Write_Str (" (subunit)");
|
||||
Write_Eol;
|
||||
|
||||
-- Force generation of ALI file, for backward compatibility
|
||||
|
||||
Opt.Force_ALI_Tree_File := True;
|
||||
|
||||
elsif Main_Kind = N_Subprogram_Declaration then
|
||||
Write_Str (" (subprogram spec)");
|
||||
Write_Eol;
|
||||
|
||||
-- Generic package body in GNAT implementation mode
|
||||
|
||||
elsif Main_Kind = N_Package_Body and then GNAT_Mode then
|
||||
Write_Str (" (predefined generic)");
|
||||
Write_Eol;
|
||||
|
||||
-- Force generation of ALI file, for backward compatibility
|
||||
|
||||
Opt.Force_ALI_Tree_File := True;
|
||||
|
||||
-- Only other case is a package spec
|
||||
-- Otherwise the unit is missing a crucial piece that prevents code
|
||||
-- generation.
|
||||
|
||||
else
|
||||
Write_Str (" (package spec)");
|
||||
Write_Eol;
|
||||
Set_Standard_Error;
|
||||
Write_Str ("cannot generate code for file ");
|
||||
Write_Name (Unit_File_Name (Main_Unit));
|
||||
|
||||
if Subunits_Missing then
|
||||
Write_Str (" (missing subunits)");
|
||||
Write_Eol;
|
||||
|
||||
-- Force generation of ALI file, for backward compatibility
|
||||
|
||||
Opt.Force_ALI_Tree_File := True;
|
||||
|
||||
elsif Main_Unit_Kind = N_Subunit then
|
||||
Write_Str (" (subunit)");
|
||||
Write_Eol;
|
||||
|
||||
-- Force generation of ALI file, for backward compatibility
|
||||
|
||||
Opt.Force_ALI_Tree_File := True;
|
||||
|
||||
elsif Main_Unit_Kind = N_Subprogram_Declaration then
|
||||
Write_Str (" (subprogram spec)");
|
||||
Write_Eol;
|
||||
|
||||
-- Generic package body in GNAT implementation mode
|
||||
|
||||
elsif Main_Unit_Kind = N_Package_Body and then GNAT_Mode then
|
||||
Write_Str (" (predefined generic)");
|
||||
Write_Eol;
|
||||
|
||||
-- Force generation of ALI file, for backward compatibility
|
||||
|
||||
Opt.Force_ALI_Tree_File := True;
|
||||
|
||||
-- Only other case is a package spec
|
||||
|
||||
else
|
||||
Write_Str (" (package spec)");
|
||||
Write_Eol;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Set_Standard_Output;
|
||||
@ -1320,7 +1343,7 @@ begin
|
||||
if Back_End_Mode = Declarations_Only
|
||||
and then
|
||||
(not (Back_Annotate_Rep_Info or Generate_SCIL or GNATprove_Mode)
|
||||
or else Main_Kind = N_Subunit
|
||||
or else Main_Unit_Kind = N_Subunit
|
||||
or else Frontend_Layout_On_Target
|
||||
or else ASIS_GNSA_Mode)
|
||||
then
|
||||
@ -1465,11 +1488,10 @@ begin
|
||||
when Program_Error =>
|
||||
Comperr.Compiler_Abort ("Program_Error");
|
||||
|
||||
-- Assume this is a bug. If it is real, the message will in any case
|
||||
-- say Storage_Error, giving a strong hint.
|
||||
|
||||
when Storage_Error =>
|
||||
|
||||
-- Assume this is a bug. If it is real, the message will in any case
|
||||
-- say Storage_Error, giving a strong hint.
|
||||
|
||||
Comperr.Compiler_Abort ("Storage_Error");
|
||||
|
||||
when Unrecoverable_Error =>
|
||||
@ -1482,7 +1504,7 @@ begin
|
||||
<<End_Of_Program>>
|
||||
null;
|
||||
|
||||
-- The outer exception handles an unrecoverable error
|
||||
-- The outer exception handler handles an unrecoverable error
|
||||
|
||||
exception
|
||||
when Unrecoverable_Error =>
|
||||
|
||||
@ -445,7 +445,14 @@ package body Lib is
|
||||
-- Prevent looping forever
|
||||
|
||||
if Counter > Max_Iterations then
|
||||
raise Program_Error;
|
||||
-- ??? Not quite right, but return a value to be able to generate
|
||||
-- SCIL files and hope for the best.
|
||||
|
||||
if CodePeer_Mode then
|
||||
return No;
|
||||
else
|
||||
raise Program_Error;
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
end Check_Same_Extended_Unit;
|
||||
|
||||
@ -14879,8 +14879,8 @@ package body Sem_Ch12 is
|
||||
and then Is_Global (Entity (Orig_N2_Parent))
|
||||
then
|
||||
N2 := Aux_N2;
|
||||
Set_Associated_Node (Parent (N),
|
||||
Original_Node (Parent (N2)));
|
||||
Set_Associated_Node
|
||||
(Parent (N), Original_Node (Parent (N2)));
|
||||
|
||||
-- Common case
|
||||
|
||||
|
||||
@ -6618,7 +6618,13 @@ package body Sem_Ch13 is
|
||||
-----------------------------------
|
||||
|
||||
procedure Analyze_Freeze_Generic_Entity (N : Node_Id) is
|
||||
E : constant Entity_Id := Entity (N);
|
||||
|
||||
begin
|
||||
if not Is_Frozen (E) and then Has_Delayed_Aspects (E) then
|
||||
Analyze_Aspects_At_Freeze_Point (E);
|
||||
end if;
|
||||
|
||||
Freeze_Entity_Checks (N);
|
||||
end Analyze_Freeze_Generic_Entity;
|
||||
|
||||
@ -10789,20 +10795,10 @@ package body Sem_Ch13 is
|
||||
-- the subtype name in the saved expression so that they will not cause
|
||||
-- trouble in the preanalysis.
|
||||
|
||||
-- Case 1: Generic case. For freezing nodes of types defined in generics
|
||||
-- we must perform the analysis of its aspects; needed to ensure that
|
||||
-- they have the minimum decoration needed by ASIS.
|
||||
-- This is also not needed in the generic case
|
||||
|
||||
if not Non_Generic_Case then
|
||||
if Has_Delayed_Aspects (E) then
|
||||
Push_Scope (Scope (E));
|
||||
Analyze_Aspects_At_Freeze_Point (E);
|
||||
Pop_Scope;
|
||||
end if;
|
||||
|
||||
-- Case 2: Non-generic case
|
||||
|
||||
elsif Has_Delayed_Aspects (E)
|
||||
if Non_Generic_Case
|
||||
and then Has_Delayed_Aspects (E)
|
||||
and then Scope (E) = Current_Scope
|
||||
then
|
||||
-- Retrieve the visibility to the discriminants in order to properly
|
||||
|
||||
@ -3495,11 +3495,11 @@ package body Sem_Ch4 is
|
||||
-- generic
|
||||
-- type Inner_T is private;
|
||||
-- with function Func (Formal : Inner_T) -- (1)
|
||||
-- return ... is <>;
|
||||
-- return ... is <>;
|
||||
|
||||
-- package Inner_Gen is
|
||||
-- function Inner_Func (Formal : Inner_T) -- (2)
|
||||
-- return ... is (Func (Formal));
|
||||
-- return ... is (Func (Formal));
|
||||
-- end Inner_Gen;
|
||||
-- end Outer_Generic;
|
||||
|
||||
@ -3509,15 +3509,15 @@ package body Sem_Ch4 is
|
||||
-- In the example above, the type of parameter
|
||||
-- Inner_Func.Formal at (2) is incompatible with the type of
|
||||
-- Func.Formal at (1) in the context of instantiations
|
||||
-- Outer_Inst and Inner_Inst. In reality both types are
|
||||
-- generic actual subtypes renaming base type Actual_T as
|
||||
-- part of the generic prologues for the instantiations.
|
||||
-- Outer_Inst and Inner_Inst. In reality both types are generic
|
||||
-- actual subtypes renaming base type Actual_T as part of the
|
||||
-- generic prologues for the instantiations.
|
||||
|
||||
-- Recognize this case and add a type conversion to allow
|
||||
-- this kind of generic actual subtype conformance. Note that
|
||||
-- this is done only when the call is non-overloaded because
|
||||
-- the resolution mechanism already has the means to
|
||||
-- disambiguate similar cases.
|
||||
-- Recognize this case and add a type conversion to allow this
|
||||
-- kind of generic actual subtype conformance. Note that this
|
||||
-- is done only when the call is non-overloaded because the
|
||||
-- resolution mechanism already has the means to disambiguate
|
||||
-- similar cases.
|
||||
|
||||
elsif not Is_Overloaded (Name (N))
|
||||
and then Is_Type (Etype (Actual))
|
||||
|
||||
@ -2143,17 +2143,18 @@ package body Sem_Ch6 is
|
||||
-- the subprogram, or to perform conformance checks.
|
||||
|
||||
procedure Analyze_Subprogram_Body_Helper (N : Node_Id) is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Body_Spec : Node_Id := Specification (N);
|
||||
Body_Id : Entity_Id := Defining_Entity (Body_Spec);
|
||||
Prev_Id : constant Entity_Id := Current_Entity_In_Scope (Body_Id);
|
||||
Exch_Views : Elist_Id := No_Elist;
|
||||
Desig_View : Entity_Id := Empty;
|
||||
Conformant : Boolean;
|
||||
HSS : Node_Id;
|
||||
Prot_Typ : Entity_Id := Empty;
|
||||
Spec_Id : Entity_Id;
|
||||
Spec_Decl : Node_Id := Empty;
|
||||
Body_Spec : Node_Id := Specification (N);
|
||||
Body_Id : Entity_Id := Defining_Entity (Body_Spec);
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Prev_Id : constant Entity_Id := Current_Entity_In_Scope (Body_Id);
|
||||
|
||||
Conformant : Boolean;
|
||||
Desig_View : Entity_Id := Empty;
|
||||
Exch_Views : Elist_Id := No_Elist;
|
||||
HSS : Node_Id;
|
||||
Prot_Typ : Entity_Id := Empty;
|
||||
Spec_Decl : Node_Id := Empty;
|
||||
Spec_Id : Entity_Id;
|
||||
|
||||
Last_Real_Spec_Entity : Entity_Id := Empty;
|
||||
-- When we analyze a separate spec, the entity chain ends up containing
|
||||
|
||||
@ -445,11 +445,24 @@ package body Sem_Eval is
|
||||
-- that an infinity will result.
|
||||
|
||||
if not Is_Static_Expression (N) then
|
||||
if Is_Floating_Point_Type (T)
|
||||
and then Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True)
|
||||
then
|
||||
Error_Msg_N
|
||||
("??float value out of range, infinity will be generated", N);
|
||||
if Is_Floating_Point_Type (T) then
|
||||
if Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True) then
|
||||
Error_Msg_N
|
||||
("??float value out of range, infinity will be generated", N);
|
||||
|
||||
-- The literal may be the result of constant-folding of a non-
|
||||
-- static subexpression of a larger expression (e.g. a conversion
|
||||
-- of a non-static variable whose value happens to be known). At
|
||||
-- this point we must reduce the value of the subexpression to a
|
||||
-- machine number (RM 4.9 (38/2)).
|
||||
|
||||
elsif Nkind (N) = N_Real_Literal
|
||||
and then Nkind (Parent (N)) in N_Subexpr
|
||||
then
|
||||
Rewrite (N, New_Copy (N));
|
||||
Set_Realval
|
||||
(N, Machine (Base_Type (T), Realval (N), Round_Even, N));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
return;
|
||||
|
||||
@ -62,11 +62,14 @@ package body Sem_Intr is
|
||||
-- as for Check_Intrinsic_Subprogram (i.e. the entity of the subprogram
|
||||
-- declaration, and the node for the pragma argument, used for messages).
|
||||
|
||||
procedure Errint (Msg : String; S : Node_Id; N : Node_Id);
|
||||
procedure Errint
|
||||
(Msg : String; S : Node_Id; N : Node_Id; Relaxed : Boolean := False);
|
||||
-- Post error message for bad intrinsic, the message itself is posted
|
||||
-- on the appropriate spec node and another message is placed on the
|
||||
-- pragma itself, referring to the spec. S is the node in the spec on
|
||||
-- which the message is to be placed, and N is the pragma argument node.
|
||||
-- Relaxed is True if the message should not be emitted in
|
||||
-- Relaxed_RM_Semantics mode.
|
||||
|
||||
------------------------------
|
||||
-- Check_Exception_Function --
|
||||
@ -432,7 +435,7 @@ package body Sem_Intr is
|
||||
then
|
||||
Errint
|
||||
("first argument for shift must have size 8, 16, 32 or 64",
|
||||
Ptyp1, N);
|
||||
Ptyp1, N, Relaxed => True);
|
||||
return;
|
||||
|
||||
elsif Non_Binary_Modulus (Typ1) then
|
||||
@ -450,7 +453,7 @@ package body Sem_Intr is
|
||||
then
|
||||
Errint
|
||||
("modular type for shift must have modulus of 2'*'*8, "
|
||||
& "2'*'*16, 2'*'*32, or 2'*'*64", Ptyp1, N);
|
||||
& "2'*'*16, 2'*'*32, or 2'*'*64", Ptyp1, N, Relaxed => True);
|
||||
|
||||
elsif Etype (Arg1) /= Etype (E) then
|
||||
Errint
|
||||
@ -465,12 +468,13 @@ package body Sem_Intr is
|
||||
-- Errint --
|
||||
------------
|
||||
|
||||
procedure Errint (Msg : String; S : Node_Id; N : Node_Id) is
|
||||
procedure Errint
|
||||
(Msg : String; S : Node_Id; N : Node_Id; Relaxed : Boolean := False) is
|
||||
begin
|
||||
-- Ignore errors on Intrinsic in Relaxed_RM_Semantics mode where we can
|
||||
-- be more liberal.
|
||||
|
||||
if not Relaxed_RM_Semantics then
|
||||
if not (Relaxed and Relaxed_RM_Semantics) then
|
||||
Error_Msg_N (Msg, S);
|
||||
Error_Msg_N ("incorrect intrinsic subprogram, see spec", N);
|
||||
end if;
|
||||
|
||||
@ -9080,6 +9080,14 @@ package body Sem_Prag is
|
||||
Ghost_Id := Subp;
|
||||
end if;
|
||||
|
||||
-- Do not issue an error on an unanalyzed subprogram body entity.
|
||||
-- It may lead to spurious errors on unanalyzed body entities of
|
||||
-- expression functions, which are not yet marked as ghost, yet
|
||||
-- identified as the Corresponding_Body of the ghost declaration.
|
||||
|
||||
elsif Ekind (Subp) = E_Void then
|
||||
null;
|
||||
|
||||
-- Otherwise the subprogram is non-Ghost. It is illegal to mix
|
||||
-- references to Ghost and non-Ghost entities (SPARK RM 6.9).
|
||||
|
||||
|
||||
@ -11500,7 +11500,7 @@ package body Sem_Util is
|
||||
------------------------------------------
|
||||
|
||||
procedure Inspect_Deferred_Constant_Completion (Decls : List_Id) is
|
||||
Decl : Node_Id;
|
||||
Decl : Node_Id;
|
||||
|
||||
begin
|
||||
Decl := First (Decls);
|
||||
|
||||
@ -314,6 +314,11 @@ package body Sem_Warn is
|
||||
elsif Is_Suspicious_Function_Name (Entity (Name (N))) then
|
||||
return;
|
||||
|
||||
-- Forget it if function is marked Volatile_Function
|
||||
|
||||
elsif Is_Volatile_Function (Entity (Name (N))) then
|
||||
return;
|
||||
|
||||
-- Forget it if warnings are suppressed on function entity
|
||||
|
||||
elsif Has_Warnings_Off (Entity (Name (N))) then
|
||||
|
||||
Loading…
Reference in New Issue
Block a user