+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.
-- 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.
-- 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
-- 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 --
--------------------------
-- 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;
-- 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.
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;
---------------------
begin
Analyze_Context (N);
+ Check_No_Elab_Code_All (N);
-- Make withed units immediately visible. If child unit, make the
-- ultimate parent immediately visible.
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 --
-------------------------------
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
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
-- 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
-- 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;
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;
---------------
projects / gcc.git / commitdiff