mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-23 15:01:17 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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 2014-11-20 16:17:47 +01:00
parent 7e4f00b47c
commit 596f71394d
12 changed files with 152 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
gcc/ada/ChangeLog
View File

@ -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.

11
gcc/ada/comperr.adb
View File

@ -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;

10
gcc/ada/exp_aggr.adb
View File

@ -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

10
gcc/ada/exp_strm.adb
View File

@ -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))));

7
gcc/ada/gnat1drv.adb
View File

@ -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;

7
gcc/ada/inline.adb
View File

@ -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)))));

8
gcc/ada/par-ch13.adb
View File

@ -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;

21
gcc/ada/par-ch3.adb
View File

@ -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

4
gcc/ada/s-taskin.adb
View File

@ -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;

3
gcc/ada/s-tassta.adb
View File

@ -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;

48
gcc/ada/sem_ch12.adb
View File

@ -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 :=

39
gcc/ada/sem_elab.adb
View File

@ -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?",