+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.
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;
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);
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
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.
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))));
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;
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,
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)))));
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);
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;
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
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;
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;
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.
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;
--------------------------
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>>
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;
-------------------------
Loc : Source_Ptr;
Nam : Node_Id;
New_Spec : Node_Id;
+ New_Subp : Entity_Id;
-- Start of processing for Instantiate_Formal_Subprogram
-- 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.
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)
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 :=
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
"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?",
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?",
projects / gcc.git / commitdiff