[multiple changes]
2014-08-01 Robert Dewar <dewar@adacore.com> * opt.ads (No_Elab_Code_All_Pragma): New global variable. * sem_ch10.adb (Check_No_Elab_Code_All): New procedure (Analyze_Compilation_Unit): Call Check_No_Elab_Code_All (Analyze_Subunit_Context): Call Check_No_Elab_Code_All. * sem_prag.adb (Analyze_Pragma, case No_Elaboration_Code_All): Remove code for checking with's, now in sem_ch10.adb, set Opt.No_Elab_Code_All_Pragma. 2014-08-01 Eric Botcazou <ebotcazou@adacore.com> * sem_ch3.adb (Copy_And_Build): Copy the declaration for access types as well and adjust the subtype mark if there are no constraints. 2014-08-01 Robert Dewar <dewar@adacore.com> * sem_eval.adb (Test_In_Range): Return Unknown if error posted. From-SVN: r213478
This commit is contained in:
Arnaud Charlet
parent
316e3a13c6
commit
8bef7ba92c
@ -1,3 +1,23 @@
|
||||
2014-08-01 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* opt.ads (No_Elab_Code_All_Pragma): New global variable.
|
||||
* sem_ch10.adb (Check_No_Elab_Code_All): New procedure
|
||||
(Analyze_Compilation_Unit): Call Check_No_Elab_Code_All
|
||||
(Analyze_Subunit_Context): Call Check_No_Elab_Code_All.
|
||||
* sem_prag.adb (Analyze_Pragma, case No_Elaboration_Code_All):
|
||||
Remove code for checking with's, now in sem_ch10.adb, set
|
||||
Opt.No_Elab_Code_All_Pragma.
|
||||
|
||||
2014-08-01 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Copy_And_Build): Copy the declaration for
|
||||
access types as well and adjust the subtype mark if there are
|
||||
no constraints.
|
||||
|
||||
2014-08-01 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_eval.adb (Test_In_Range): Return Unknown if error posted.
|
||||
|
||||
2014-08-01 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch3.adb, einfo.ads, exp_ch4.adb: Code clean ups.
|
||||
|
||||
@ -705,10 +705,6 @@ package Opt is
|
||||
-- True if a pragma Discard_Names appeared as a configuration pragma for
|
||||
-- the current compilation unit.
|
||||
|
||||
GNAT_Mode : Boolean := False;
|
||||
-- GNAT
|
||||
-- True if compiling in GNAT system mode (-gnatg switch)
|
||||
|
||||
Identifier_Character_Set : Character;
|
||||
-- GNAT
|
||||
-- This variable indicates the character set to be used for identifiers.
|
||||
@ -1042,6 +1038,11 @@ package Opt is
|
||||
-- Undefined_Symbols_Are_False. Useful to perform a syntax check on all
|
||||
-- branches of #if constructs.
|
||||
|
||||
No_Elab_Code_All_Pragma : Node_Id := Empty;
|
||||
-- Set to point to a No_Elaboration_Code_All pragma or aspect encountered
|
||||
-- in the spec of the extended main unit. Used to determine if we need to
|
||||
-- do special tests for violation of this aspect.
|
||||
|
||||
No_Main_Subprogram : Boolean := False;
|
||||
-- GNATMAKE, GNATBIND
|
||||
-- Set to True if compilation/binding of a program without main
|
||||
@ -2088,6 +2089,70 @@ package Opt is
|
||||
-- appropriately licensed unit to declare this as a Table failed with
|
||||
-- various elaboration circularities. Memory is getting cheap these days!
|
||||
|
||||
---------------
|
||||
-- GNAT_Mode --
|
||||
---------------
|
||||
|
||||
GNAT_Mode : Boolean := False;
|
||||
-- GNAT
|
||||
-- True if compiling in GNAT system mode (-gnatg switch)
|
||||
|
||||
-- Setting this switch has the following effects
|
||||
|
||||
-- The identifier character set is set to 'n' (7-bit ASCII)
|
||||
|
||||
-- Pragma Extend_System is ignored
|
||||
|
||||
-- Warning_Mode is set to Treat_As_Error (-gnatwe)
|
||||
|
||||
-- Standard style checks are set (See Set_GNAT_Style_Check_Options)
|
||||
|
||||
-- Standard warnings are turned on (see Set_GNAT_Mode_Warnings)
|
||||
|
||||
-- The Ada version is set to Ada 2012
|
||||
|
||||
-- Task priorities are always allowed to be in the range Any_Priority
|
||||
|
||||
-- Overflow checks are suppressed, overflow checking set to strict mode
|
||||
|
||||
-- ALI files are always generated for predefined generic packages
|
||||
|
||||
-- Obsolescent feature warnings are suppressed
|
||||
|
||||
-- Recompilation of children of GNAT, System, Ada, Interfaces is allowed
|
||||
|
||||
-- The Scalar_Storage_Order attribute applies to generic types
|
||||
|
||||
-- Categorization errors are treated as warnings rather than errors
|
||||
|
||||
-- Statements in preelaborated units give warnings rather than errors
|
||||
|
||||
-- Private objects are allowed in preelaborated units
|
||||
|
||||
-- Non-static constants in preelaborated units give warnings not errors
|
||||
|
||||
-- The warning about component size being ignored is suppressed
|
||||
|
||||
-- The warning about size clauses being ignored is suppressed
|
||||
|
||||
-- Initializing limited types gives a warning rather than an error
|
||||
|
||||
-- Copying of limited objects is allowed
|
||||
|
||||
-- Returning objects of limited types is allowed
|
||||
|
||||
-- All entities are considered known to Known_But_Invisible
|
||||
|
||||
-- Non-static call in preelaborated unit give a warning, not an error
|
||||
|
||||
-- Warnings on possible elaboration errors are suppressed
|
||||
|
||||
-- Warning about packing being ignored is suppressed
|
||||
|
||||
-- Warnings in internal units are not suppressed (they normally are)
|
||||
|
||||
-- The only special comment sequence allowed is --!
|
||||
|
||||
--------------------------
|
||||
-- Private Declarations --
|
||||
--------------------------
|
||||
@ -2146,4 +2211,7 @@ private
|
||||
-- Indicates which version of gcc is in use (3 = 3.x, 4 = 4.x). Note that
|
||||
-- gcc 2.8.1 (which used to be a value of 2) is no longer supported.
|
||||
|
||||
-------------------------
|
||||
-- Effect of GNAT_Mode --
|
||||
-------------------------
|
||||
end Opt;
|
||||
|
||||
@ -87,6 +87,10 @@ package body Sem_Ch10 is
|
||||
-- Check whether the source for the body of a compilation unit must be
|
||||
-- included in a standalone library.
|
||||
|
||||
procedure Check_No_Elab_Code_All (N : Node_Id);
|
||||
-- Carries out possible tests for violation of No_Elab_Code all for withed
|
||||
-- units in the Context_Items of unit N.
|
||||
|
||||
procedure Check_Private_Child_Unit (N : Node_Id);
|
||||
-- If a with_clause mentions a private child unit, the compilation unit
|
||||
-- must be a member of the same family, as described in 10.1.2.
|
||||
@ -1279,6 +1283,13 @@ package body Sem_Ch10 is
|
||||
|
||||
Pop_Scope;
|
||||
end if;
|
||||
|
||||
-- If No_Elaboration_Code_All was encountered, this is where we do the
|
||||
-- transitive test of with'ed units to make sure they have the aspect.
|
||||
-- This is delayed till the end of analyzing the compilation unit to
|
||||
-- ensure that the pragma/aspect, if present, has been analyzed.
|
||||
|
||||
Check_No_Elab_Code_All (N);
|
||||
end Analyze_Compilation_Unit;
|
||||
|
||||
---------------------
|
||||
@ -2061,6 +2072,7 @@ package body Sem_Ch10 is
|
||||
|
||||
begin
|
||||
Analyze_Context (N);
|
||||
Check_No_Elab_Code_All (N);
|
||||
|
||||
-- Make withed units immediately visible. If child unit, make the
|
||||
-- ultimate parent immediately visible.
|
||||
@ -6055,6 +6067,41 @@ package body Sem_Ch10 is
|
||||
Set_Limited_View_Installed (Spec);
|
||||
end Build_Limited_Views;
|
||||
|
||||
----------------------------
|
||||
-- Check_No_Elab_Code_All --
|
||||
----------------------------
|
||||
|
||||
procedure Check_No_Elab_Code_All (N : Node_Id) is
|
||||
begin
|
||||
if Present (No_Elab_Code_All_Pragma)
|
||||
and then In_Extended_Main_Source_Unit (N)
|
||||
and then Present (Context_Items (N))
|
||||
then
|
||||
declare
|
||||
CL : constant List_Id := Context_Items (N);
|
||||
CI : Node_Id;
|
||||
|
||||
begin
|
||||
CI := First (CL);
|
||||
while Present (CI) loop
|
||||
if Nkind (CI) = N_With_Clause
|
||||
and then not
|
||||
No_Elab_Code_All (Get_Source_Unit (Library_Unit (CI)))
|
||||
then
|
||||
Error_Msg_Sloc := Sloc (No_Elab_Code_All_Pragma);
|
||||
Error_Msg_N
|
||||
("violation of No_Elaboration_Code_All#", CI);
|
||||
Error_Msg_NE
|
||||
("\unit& does not have No_Elaboration_Code_All",
|
||||
CI, Entity (Name (CI)));
|
||||
end if;
|
||||
|
||||
Next (CI);
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
end Check_No_Elab_Code_All;
|
||||
|
||||
-------------------------------
|
||||
-- Check_Body_Needed_For_SAL --
|
||||
-------------------------------
|
||||
|
||||
@ -6614,21 +6614,38 @@ package body Sem_Ch3 is
|
||||
Full_Parent := Underlying_Full_View (Full_Parent);
|
||||
end if;
|
||||
|
||||
-- For record, access and most enumeration types, derivation from
|
||||
-- the full view requires a fully-fledged declaration. In the other
|
||||
-- cases, just use an itype.
|
||||
|
||||
if Ekind (Full_Parent) in Record_Kind
|
||||
or else Ekind (Full_Parent) in Access_Kind
|
||||
or else
|
||||
(Ekind (Full_Parent) in Enumeration_Kind
|
||||
and then not Is_Standard_Character_Type (Full_Parent)
|
||||
and then not Is_Generic_Type (Root_Type (Full_Parent)))
|
||||
then
|
||||
-- Copy declaration to provide a completion for what is a private
|
||||
-- declaration. Indicate that full view is internally generated.
|
||||
-- Copy and adjust declaration to provide a completion for what
|
||||
-- is originally a private declaration. Indicate that full view
|
||||
-- is internally generated.
|
||||
|
||||
Full_N := New_Copy_Tree (N);
|
||||
Full_Der := New_Copy (Derived_Type);
|
||||
Set_Comes_From_Source (Full_N, False);
|
||||
Set_Comes_From_Source (Full_Der, False);
|
||||
Set_Defining_Identifier (Full_N, Full_Der);
|
||||
Set_Parent (Full_Der, Full_N);
|
||||
Set_Defining_Identifier (Full_N, Full_Der);
|
||||
|
||||
-- If there are no constraints, adjust the subtype mark
|
||||
|
||||
if Nkind (Subtype_Indication (Type_Definition (Full_N))) /=
|
||||
N_Subtype_Indication
|
||||
then
|
||||
Set_Subtype_Indication
|
||||
(Type_Definition (Full_N),
|
||||
New_Occurrence_Of (Full_Parent, Sloc (Full_N)));
|
||||
end if;
|
||||
|
||||
Insert_After (N, Full_N);
|
||||
|
||||
-- Build full view of derived type from full view of parent which
|
||||
@ -6649,7 +6666,8 @@ package body Sem_Ch3 is
|
||||
end if;
|
||||
|
||||
else
|
||||
Build_Derived_Enumeration_Type (Full_N, Full_Parent, Full_Der);
|
||||
Build_Derived_Type
|
||||
(Full_N, Full_Parent, Full_Der, True, Derive_Subps => False);
|
||||
end if;
|
||||
|
||||
-- The full declaration has been introduced into the tree and
|
||||
|
||||
@ -6079,13 +6079,19 @@ package body Sem_Eval is
|
||||
-- to get the information in the variable case as well.
|
||||
|
||||
begin
|
||||
-- If an error was posted on expression, then return Unknown, we do not
|
||||
-- want cascaded errors based on some false analysis of a junk node.
|
||||
|
||||
if Error_Posted (N) then
|
||||
return Unknown;
|
||||
|
||||
-- Expression that raises constraint error is an odd case. We certainly
|
||||
-- do not want to consider it to be in range. It might make sense to
|
||||
-- consider it always out of range, but this causes incorrect error
|
||||
-- messages about static expressions out of range. So we just return
|
||||
-- Unknown, which is always safe.
|
||||
|
||||
if Raises_Constraint_Error (N) then
|
||||
elsif Raises_Constraint_Error (N) then
|
||||
return Unknown;
|
||||
|
||||
-- Universal types have no range limits, so always in range
|
||||
|
||||
@ -16284,9 +16284,6 @@ package body Sem_Prag is
|
||||
-- pragma No_Elaboration_Code_All;
|
||||
|
||||
when Pragma_No_Elaboration_Code_All => NECA : declare
|
||||
CL : constant List_Id := Context_Items (Cunit (Current_Sem_Unit));
|
||||
CI : Node_Id;
|
||||
|
||||
begin
|
||||
GNAT_Pragma;
|
||||
Check_Valid_Library_Unit_Pragma;
|
||||
@ -16318,25 +16315,11 @@ package body Sem_Prag is
|
||||
Set_Restriction (No_Elaboration_Code, N);
|
||||
Add_To_Config_Boolean_Restrictions (No_Elaboration_Code);
|
||||
|
||||
-- Here is where we check that the context clause for the current
|
||||
-- unit does not have any bad with's with respect to NECA rules.
|
||||
-- If in main extended unit, activate transitive with test
|
||||
|
||||
CI := First (CL);
|
||||
while Present (CI) loop
|
||||
if Nkind (CI) = N_With_Clause
|
||||
and then not
|
||||
No_Elab_Code_All (Get_Source_Unit (Library_Unit (CI)))
|
||||
then
|
||||
Error_Msg_Sloc := Sloc (CI);
|
||||
Error_Msg_N
|
||||
("violation of No_Elaboration_Code_All#", N);
|
||||
Error_Msg_NE
|
||||
("\unit& does not have No_Elaboration_Code_All",
|
||||
N, Entity (Name (CI)));
|
||||
end if;
|
||||
|
||||
Next (CI);
|
||||
end loop;
|
||||
if In_Extended_Main_Source_Unit (N) then
|
||||
Opt.No_Elab_Code_All_Pragma := N;
|
||||
end if;
|
||||
end NECA;
|
||||
|
||||
---------------
|
||||
|
||||
Loading…
Reference in New Issue
Block a user