[multiple changes]
2014-11-20 Robert Dewar <dewar@adacore.com> * s-tassta.adb, exp_aggr.adb, s-taskin.adb, exp_strm.adb: Minor reformatting. * comperr.adb (Compiler_Abort): New wording for bug box. * par-ch13.adb: Minor reformatting. * par-ch3.adb (P_Identifier_Declarations): Handle aspect specifications given before initialization expression in object declaration cleanly. * gnat1drv.adb (Adjust_Global_Switches): Make sure static elaboration mode is set if we are operating in SPARK mode. * sem_ch12.adb (Analyze_Package_Instantiation): Make sure static elab mode is set if we are in SPARK mode. (Analyze_Subprogram_Instantiation): ditto. (Set_Instance_Env): ditto. * sem_elab.adb (Check_A_Call): In SPARK mode, we require Elaborate_All in the case of a call during elaboration to a subprogram in another unit. 2014-11-20 Ed Schonberg <schonberg@adacore.com> * inline.adb (Can_Split_Unconstrained_Function, Build_Procedure): Copy parameter type rather than creating reference to the entity, to capture class-wide reference, whose name is not retrieved by visibility. From-SVN: r217874
This commit is contained in:
Arnaud Charlet
parent
7e4f00b47c
commit
596f71394d
|
|
@ -1,3 +1,29 @@
|
|||
2014-11-20 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* s-tassta.adb, exp_aggr.adb, s-taskin.adb, exp_strm.adb: Minor
|
||||
reformatting.
|
||||
* comperr.adb (Compiler_Abort): New wording for bug box.
|
||||
* par-ch13.adb: Minor reformatting.
|
||||
* par-ch3.adb (P_Identifier_Declarations): Handle aspect
|
||||
specifications given before initialization expression in object
|
||||
declaration cleanly.
|
||||
* gnat1drv.adb (Adjust_Global_Switches): Make sure static
|
||||
elaboration mode is set if we are operating in SPARK mode.
|
||||
* sem_ch12.adb (Analyze_Package_Instantiation): Make
|
||||
sure static elab mode is set if we are in SPARK mode.
|
||||
(Analyze_Subprogram_Instantiation): ditto.
|
||||
(Set_Instance_Env): ditto.
|
||||
* sem_elab.adb (Check_A_Call): In SPARK mode, we require
|
||||
Elaborate_All in the case of a call during elaboration to a
|
||||
subprogram in another unit.
|
||||
|
||||
2014-11-20 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* inline.adb (Can_Split_Unconstrained_Function,
|
||||
Build_Procedure): Copy parameter type rather than creating
|
||||
reference to the entity, to capture class-wide reference, whose
|
||||
name is not retrieved by visibility.
|
||||
|
||||
2014-11-20 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* s-taspri-solaris.ads: Replace 64 by long_long_integer'size.
|
||||
|
|
|
|||
|
|
@ -367,21 +367,16 @@ package body Comperr is
|
|||
End_Line;
|
||||
|
||||
Write_Str
|
||||
("| Include the exact gcc or gnatmake command " &
|
||||
"that you entered.");
|
||||
("| Include the exact command that you entered.");
|
||||
End_Line;
|
||||
|
||||
Write_Str
|
||||
("| Also include sources listed below in gnatchop format");
|
||||
End_Line;
|
||||
|
||||
Write_Str
|
||||
("| (concatenated together with no headers between files).");
|
||||
("| Also include sources listed below.");
|
||||
End_Line;
|
||||
|
||||
if not Is_FSF_Version then
|
||||
Write_Str
|
||||
("| Use plain ASCII or MIME attachment.");
|
||||
("| Use plain ASCII or MIME attachment(s).");
|
||||
End_Line;
|
||||
end if;
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -2125,10 +2125,10 @@ package body Exp_Aggr is
|
|||
|
||||
Btype := Base_Type (Typ);
|
||||
while Is_Derived_Type (Btype)
|
||||
and then (Present (Stored_Constraint (Btype))
|
||||
or else
|
||||
(In_Aggr_Type
|
||||
and then Present (Stored_Constraint (Typ))))
|
||||
and then
|
||||
(Present (Stored_Constraint (Btype))
|
||||
or else
|
||||
(In_Aggr_Type and then Present (Stored_Constraint (Typ))))
|
||||
loop
|
||||
Parent_Type := Etype (Btype);
|
||||
|
||||
|
|
@ -2155,7 +2155,7 @@ package body Exp_Aggr is
|
|||
Discr_Val := First_Elmt (Stored_Constraint (Typ));
|
||||
end if;
|
||||
|
||||
while Present (Discr_Val) and Present (Disc) loop
|
||||
while Present (Discr_Val) and then Present (Disc) loop
|
||||
|
||||
-- Only those discriminants of the parent that are not
|
||||
-- renamed by discriminants of the derived type need to
|
||||
|
|
|
|||
|
|
@ -966,10 +966,10 @@ package body Exp_Strm is
|
|||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => Stms));
|
||||
|
||||
-- If Typ has controlled components (i.e. if it is classwide
|
||||
-- or Has_Controlled), or components constrained using the discriminants
|
||||
-- of Typ, then we need to ensure that all component assignments
|
||||
-- are performed on an object that has been appropriately constrained
|
||||
-- If Typ has controlled components (i.e. if it is classwide or
|
||||
-- Has_Controlled), or components constrained using the discriminants
|
||||
-- of Typ, then we need to ensure that all component assignments are
|
||||
-- performed on an object that has been appropriately constrained
|
||||
-- prior to being initialized. To this effect, we wrap the component
|
||||
-- assignments in a block where V is a constrained temporary.
|
||||
|
||||
|
|
@ -979,7 +979,7 @@ package body Exp_Strm is
|
|||
Object_Definition =>
|
||||
Make_Subtype_Indication (Loc,
|
||||
Subtype_Mark => New_Occurrence_Of (Base_Type (Typ), Loc),
|
||||
Constraint =>
|
||||
Constraint =>
|
||||
Make_Index_Or_Discriminant_Constraint (Loc,
|
||||
Constraints => Cstr))));
|
||||
|
||||
|
|
|
|||
|
|
@ -368,11 +368,8 @@ procedure Gnat1drv is
|
|||
|
||||
Suppress_Options.Suppress := (others => False);
|
||||
|
||||
-- Turn off dynamic elaboration checks: generates inconsistencies in
|
||||
-- trees between specs compiled as part of a main unit or as part of
|
||||
-- a with-clause.
|
||||
|
||||
-- Comment is incomplete, SPARK semantics rely on static mode no???
|
||||
-- Turn off dynamic elaboration checks. SPARK mode depends on the
|
||||
-- use of the static elaboration mode.
|
||||
|
||||
Dynamic_Elaboration_Checks := False;
|
||||
|
||||
|
|
|
|||
|
|
@ -1736,6 +1736,11 @@ package body Inline is
|
|||
Parameter_Type => Param_Type));
|
||||
|
||||
Formal := First_Formal (Spec_Id);
|
||||
|
||||
-- Note that we copy the parameter type rather than creating
|
||||
-- a reference to it, because it may be a class-wide entity
|
||||
-- that will not be retrieved by name.
|
||||
|
||||
while Present (Formal) loop
|
||||
Append_To (Formal_List,
|
||||
Make_Parameter_Specification (Loc,
|
||||
|
|
@ -1747,7 +1752,7 @@ package body Inline is
|
|||
Null_Exclusion_Present =>
|
||||
Null_Exclusion_Present (Parent (Formal)),
|
||||
Parameter_Type =>
|
||||
New_Occurrence_Of (Etype (Formal), Loc),
|
||||
New_Copy_Tree (Parameter_Type (Parent (Formal))),
|
||||
Expression =>
|
||||
Copy_Separate_Tree (Expression (Parent (Formal)))));
|
||||
|
||||
|
|
|
|||
|
|
@ -568,8 +568,7 @@ package body Ch13 is
|
|||
then
|
||||
Scan; -- past identifier
|
||||
|
||||
-- Attempt to detect ' or => following a potential aspect
|
||||
-- mark.
|
||||
-- Attempt to detect ' or => following potential aspect mark
|
||||
|
||||
if Token = Tok_Apostrophe or else Token = Tok_Arrow then
|
||||
Restore_Scan_State (Scan_State);
|
||||
|
|
@ -580,14 +579,13 @@ package body Ch13 is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- The construct following the current aspect is not an
|
||||
-- aspect.
|
||||
-- Construct following the current aspect is not an aspect
|
||||
|
||||
Restore_Scan_State (Scan_State);
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Must be terminator character
|
||||
-- Require semicolon if caller expects to scan this out
|
||||
|
||||
if Semicolon then
|
||||
T_Semicolon;
|
||||
|
|
|
|||
|
|
@ -1858,7 +1858,26 @@ package body Ch3 is
|
|||
end if;
|
||||
|
||||
Set_Defining_Identifier (Decl_Node, Idents (Ident));
|
||||
P_Aspect_Specifications (Decl_Node);
|
||||
P_Aspect_Specifications (Decl_Node, Semicolon => False);
|
||||
|
||||
-- Allow initialization expression to follow aspects (note that in
|
||||
-- this case P_Aspect_Specifications already issued an error msg).
|
||||
|
||||
if Token = Tok_Colon_Equal then
|
||||
if Is_Non_Empty_List (Aspect_Specifications (Decl_Node)) then
|
||||
Error_Msg
|
||||
("aspect specifications must come after initialization "
|
||||
& "expression",
|
||||
Sloc (First (Aspect_Specifications (Decl_Node))));
|
||||
end if;
|
||||
|
||||
Set_Expression (Decl_Node, Init_Expr_Opt);
|
||||
Set_Has_Init_Expression (Decl_Node);
|
||||
end if;
|
||||
|
||||
-- Now scan out the semicolon, which we deferred above
|
||||
|
||||
T_Semicolon;
|
||||
|
||||
if List_OK then
|
||||
if Ident < Num_Idents then
|
||||
|
|
|
|||
|
|
@ -110,6 +110,10 @@ package body System.Tasking is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- Note that use of an aggregate here for this assignment
|
||||
-- would be illegal, because Common_ATCB is limited because
|
||||
-- Task_Primitives.Private_Data is limited.
|
||||
|
||||
T.Common.Parent := Parent;
|
||||
T.Common.Base_Priority := Base_Priority;
|
||||
T.Common.Base_CPU := Base_CPU;
|
||||
|
|
|
|||
|
|
@ -662,6 +662,9 @@ package body System.Tasking.Stages is
|
|||
T.Common.Task_Image_Len := Len;
|
||||
end if;
|
||||
|
||||
-- Note: we used to have code here to initialize T.Commmon.Domain, but
|
||||
-- that is not needed, since this is initialized in System.Tasking.
|
||||
|
||||
Unlock (Self_ID);
|
||||
Unlock_RTS;
|
||||
|
||||
|
|
|
|||
|
|
@ -4455,6 +4455,10 @@ package body Sem_Ch12 is
|
|||
SPARK_Mode_Pragma := Save_SMP;
|
||||
Style_Check := Save_Style_Check;
|
||||
|
||||
if SPARK_Mode = On then
|
||||
Dynamic_Elaboration_Checks := False;
|
||||
end if;
|
||||
|
||||
-- Check that if N is an instantiation of System.Dim_Float_IO or
|
||||
-- System.Dim_Integer_IO, the formal type has a dimension system.
|
||||
|
||||
|
|
@ -4491,6 +4495,10 @@ package body Sem_Ch12 is
|
|||
SPARK_Mode := Save_SM;
|
||||
SPARK_Mode_Pragma := Save_SMP;
|
||||
Style_Check := Save_Style_Check;
|
||||
|
||||
if SPARK_Mode = On then
|
||||
Dynamic_Elaboration_Checks := False;
|
||||
end if;
|
||||
end Analyze_Package_Instantiation;
|
||||
|
||||
--------------------------
|
||||
|
|
@ -5346,6 +5354,11 @@ package body Sem_Ch12 is
|
|||
Ignore_Pragma_SPARK_Mode := Save_IPSM;
|
||||
SPARK_Mode := Save_SM;
|
||||
SPARK_Mode_Pragma := Save_SMP;
|
||||
|
||||
if SPARK_Mode = On then
|
||||
Dynamic_Elaboration_Checks := False;
|
||||
end if;
|
||||
|
||||
end if;
|
||||
|
||||
<<Leave>>
|
||||
|
|
@ -5366,6 +5379,10 @@ package body Sem_Ch12 is
|
|||
Ignore_Pragma_SPARK_Mode := Save_IPSM;
|
||||
SPARK_Mode := Save_SM;
|
||||
SPARK_Mode_Pragma := Save_SMP;
|
||||
|
||||
if SPARK_Mode = On then
|
||||
Dynamic_Elaboration_Checks := False;
|
||||
end if;
|
||||
end Analyze_Subprogram_Instantiation;
|
||||
|
||||
-------------------------
|
||||
|
|
@ -9748,6 +9765,7 @@ package body Sem_Ch12 is
|
|||
Loc : Source_Ptr;
|
||||
Nam : Node_Id;
|
||||
New_Spec : Node_Id;
|
||||
New_Subp : Entity_Id;
|
||||
|
||||
-- Start of processing for Instantiate_Formal_Subprogram
|
||||
|
||||
|
|
@ -9763,10 +9781,10 @@ package body Sem_Ch12 is
|
|||
-- Create new entity for the actual (New_Copy_Tree does not), and
|
||||
-- indicate that it is an actual.
|
||||
|
||||
Set_Defining_Unit_Name
|
||||
(New_Spec, Make_Defining_Identifier (Loc, Chars (Formal_Sub)));
|
||||
Set_Ekind (Defining_Unit_Name (New_Spec), Ekind (Analyzed_S));
|
||||
Set_Is_Generic_Actual_Subprogram (Defining_Unit_Name (New_Spec));
|
||||
New_Subp := Make_Defining_Identifier (Loc, Chars (Formal_Sub));
|
||||
Set_Ekind (New_Subp, Ekind (Analyzed_S));
|
||||
Set_Is_Generic_Actual_Subprogram (New_Subp);
|
||||
Set_Defining_Unit_Name (New_Spec, New_Subp);
|
||||
|
||||
-- Create new entities for the each of the formals in the specification
|
||||
-- of the renaming declaration built for the actual.
|
||||
|
|
@ -10208,7 +10226,21 @@ package body Sem_Ch12 is
|
|||
begin
|
||||
Typ := Get_Instance_Of (Formal_Type);
|
||||
|
||||
Freeze_Before (Instantiation_Node, Typ);
|
||||
-- If the actual appears in the current or an enclosing scope,
|
||||
-- use its type directly. This is relevant if it has an actual
|
||||
-- subtype that is distinct from its nominal one. This cannot
|
||||
-- be done in general because the type of the actual may
|
||||
-- depend on other actuals, and only be fully determined when
|
||||
-- the enclosing instance is analyzed.
|
||||
|
||||
if Present (Etype (Actual))
|
||||
and then Is_Constr_Subt_For_U_Nominal (Etype (Actual))
|
||||
then
|
||||
Freeze_Before (Instantiation_Node, Etype (Actual));
|
||||
|
||||
else
|
||||
Freeze_Before (Instantiation_Node, Typ);
|
||||
end if;
|
||||
|
||||
-- If the actual is an aggregate, perform name resolution on
|
||||
-- its components (the analysis of an aggregate does not do it)
|
||||
|
|
@ -14424,6 +14456,12 @@ package body Sem_Ch12 is
|
|||
|
||||
SPARK_Mode := Save_SPARK_Mode;
|
||||
SPARK_Mode_Pragma := Save_SPARK_Mode_Pragma;
|
||||
|
||||
-- Make sure dynamic elaboration checks are off in SPARK Mode
|
||||
|
||||
if SPARK_Mode = On then
|
||||
Dynamic_Elaboration_Checks := False;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Current_Instantiated_Parent :=
|
||||
|
|
|
|||
|
|
@ -915,23 +915,31 @@ package body Sem_Elab is
|
|||
and then not Elaboration_Checks_Suppressed (Ent)
|
||||
and then not Suppress_Elaboration_Warnings (E_Scope)
|
||||
and then not Elaboration_Checks_Suppressed (E_Scope)
|
||||
and then (Elab_Warnings or Elab_Info_Messages)
|
||||
and then ((Elab_Warnings or Elab_Info_Messages)
|
||||
or else SPARK_Mode = On)
|
||||
and then Generate_Warnings
|
||||
then
|
||||
-- Instantiation case
|
||||
|
||||
if Inst_Case then
|
||||
Elab_Warning
|
||||
("instantiation of& may raise Program_Error?l?",
|
||||
"info: instantiation of& during elaboration?$?", Ent);
|
||||
if SPARK_Mode = On then
|
||||
Error_Msg_NE
|
||||
("instantiation of & during elaboration in SPARK mode",
|
||||
N, Ent);
|
||||
|
||||
else
|
||||
Elab_Warning
|
||||
("instantiation of & may raise Program_Error?l?",
|
||||
"info: instantiation of & during elaboration?$?", Ent);
|
||||
end if;
|
||||
|
||||
-- Indirect call case, info message only in static elaboration
|
||||
-- case, because the attribute reference itself cannot raise an
|
||||
-- exception.
|
||||
-- exception. Note that SPARK does not permit indirect calls.
|
||||
|
||||
elsif Access_Case then
|
||||
Elab_Warning
|
||||
("", "info: access to& during elaboration?$?", Ent);
|
||||
("", "info: access to & during elaboration?$?", Ent);
|
||||
|
||||
-- Subprogram call case
|
||||
|
||||
|
|
@ -945,6 +953,10 @@ package body Sem_Elab is
|
|||
"info: implicit call to & during elaboration?$?",
|
||||
Ent);
|
||||
|
||||
elsif SPARK_Mode = On then
|
||||
Error_Msg_NE
|
||||
("call to & during elaboration in SPARK mode", N, Ent);
|
||||
|
||||
else
|
||||
Elab_Warning
|
||||
("call to & may raise Program_Error?l?",
|
||||
|
|
@ -955,12 +967,25 @@ package body Sem_Elab is
|
|||
|
||||
Error_Msg_Qual_Level := Nat'Last;
|
||||
|
||||
if Nkind (N) in N_Subprogram_Instantiation then
|
||||
-- Case of Elaborate_All not present and required, for SPARK this
|
||||
-- is an error, so give an error message.
|
||||
|
||||
if SPARK_Mode = On then
|
||||
Error_Msg_NE
|
||||
("\Elaborate_All pragma required for&", N, W_Scope);
|
||||
|
||||
-- Otherwise we generate an implicit pragma. For a subprogram
|
||||
-- instantiation, Elaborate is good enough, since no transitive
|
||||
-- call is possible at elaboration time in this case.
|
||||
|
||||
elsif Nkind (N) in N_Subprogram_Instantiation then
|
||||
Elab_Warning
|
||||
("\missing pragma Elaborate for&?l?",
|
||||
"\implicit pragma Elaborate for& generated?$?",
|
||||
W_Scope);
|
||||
|
||||
-- For all other cases, we need an implicit Elaborate_All
|
||||
|
||||
else
|
||||
Elab_Warning
|
||||
("\missing pragma Elaborate_All for&?l?",
|
||||
|
|
|
|||
Loading…
Reference in New Issue