+2011-11-21 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch6.adb (Is_Public_Subprogram_For): New procedure
+ (Process_PPCs): Invariants only apply to public subprograms.
+
+2011-11-21 Robert Dewar <dewar@adacore.com>
+
+ * sem_util.adb, sem_util.ads, sem_attr.adb, restrict.adb,
+ restrict.ads: Fix for No_Implicit_Aliasing in the renames case.
+
+2011-11-21 Robert Dewar <dewar@adacore.com>
+
+ * a-finali.ads: Use pragma Pure_12 for this unit
+ * aspects.adb: Add aspect Pure_12
+ * aspects.ads: Add aspect Pure_12
+ * opt.ads: Add note on Pure_12
+ * par-prag.adb: Add dummy entry for Pure_12
+ * sem_prag.adb: Implement Pure_12 pragma
+ * snames.ads-tmpl: Add Entry for Pure_12
+
+2011-11-21 Sergey Rybin <rybin@adacore.com frybin>
+
+ * vms_data.ads: Add qualifiers for new gnatpp options
+ '--call_threshold' and '--par_threshold".
+ * gnat_ugn.texi: Add description for new gnatpp options
+ '--call_threshold' and '--par_threshold".
+
+2011-11-21 Robert Dewar <dewar@adacore.com>
+
+ * lib.ads: Minor reformatting.
+
+2011-11-21 Robert Dewar <dewar@adacore.com>
+
+ * lib-load.ads: Add comment.
+
2011-11-21 Gary Dismukes <dismukes@adacore.com>
* sem_elab.adb: Minor reformatting
------------------------------------------------------------------------------
pragma Warnings (Off);
--- System.Finalization_Root does not have category Remote_Types, but we
--- allow it anyway.
with System.Finalization_Root;
pragma Warnings (On);
package Ada.Finalization is
+ pragma Pure_12;
+ -- Ada.Finalization is declared pure in Ada 2012 (AI05-0212)
+
pragma Preelaborate;
pragma Remote_Types;
+ -- The above apply in versions of Ada before Ada 2012
type Controlled is abstract tagged private;
pragma Preelaborable_Initialization (Controlled);
Aspect_Preelaborate_05 => Aspect_Preelaborate_05,
Aspect_Pure => Aspect_Pure,
Aspect_Pure_05 => Aspect_Pure_05,
+ Aspect_Pure_12 => Aspect_Pure_12,
Aspect_Remote_Call_Interface => Aspect_Remote_Call_Interface,
Aspect_Remote_Types => Aspect_Remote_Types,
Aspect_Shared_Passive => Aspect_Shared_Passive,
Aspect_Preelaborate_05, -- GNAT
Aspect_Pure,
Aspect_Pure_05, -- GNAT
+ Aspect_Pure_12, -- GNAT
Aspect_Remote_Call_Interface,
Aspect_Remote_Types,
Aspect_Shared_Passive,
Aspect_Compiler_Unit => True,
Aspect_Preelaborate_05 => True,
Aspect_Pure_05 => True,
+ Aspect_Pure_12 => True,
Aspect_Universal_Data => True,
Aspect_Ada_2005 => True,
Aspect_Ada_2012 => True,
Aspect_Priority => Name_Priority,
Aspect_Pure => Name_Pure,
Aspect_Pure_05 => Name_Pure_05,
+ Aspect_Pure_12 => Name_Pure_12,
Aspect_Pure_Function => Name_Pure_Function,
Aspect_Read => Name_Read,
Aspect_Remote_Call_Interface => Name_Remote_Call_Interface,
value is 10).
If @var{nnn} is 0, an additional indentation level is
used for @b{case} alternatives and variants regardless of their number.
+
+@item ^--call_threshold=@var{nnn}^/MAX_ACT=@var{nnn}^
+@cindex @option{^--call_threshold^/MAX_ACT^} (@command{gnatpp})
+If the number of parameter associations is greater than @var{nnn} and if at
+least one association uses named notation, start each association from
+a new line. If @var{nnn} is 0, no check for the number of associations
+is made, this is the default.
+
+@item ^--par_threshold=@var{nnn}^/MAX_PAR=@var{nnn}^
+@cindex @option{^--par_threshold^/MAX_PAR^} (@command{gnatpp})
+If the number of parameter specifications is greater than @var{nnn}
+(or equal to @var{nnn} in case of a function), start each specification from
+a new line. The default for @var{nnn} is 3.
@end table
@node Setting the Source Search Path
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--
-- PMES indicates the required setting of Parsing_Main_Extended_Unit during
-- loading of the unit. This flag is saved and restored over the call.
+ -- Note: PMES is false for the subunit case, which seems wrong???
procedure Change_Main_Unit_To_Spec;
-- This procedure is called if the main unit file contains a No_Body pragma
-- its subunits (considered recursively). Units for which this enquiry
-- returns True are those for which code will be generated. Nodes from
-- instantiations are included in the extended main unit for this call.
- -- If the main unit is itself a subunit, then the extended main unit
+ -- If the main unit is itself a subunit, then the extended main code unit
-- includes its parent unit, and the parent unit spec if it is separate.
function In_Extended_Main_Code_Unit (Loc : Source_Ptr) return Boolean;
-- returns True are those for which code will be generated. This differs
-- from In_Extended_Main_Code_Unit only in that instantiations are not
-- included for the purposes of this call. If the main unit is itself
- -- a subunit, then the extended main unit includes its parent unit,
+ -- a subunit, then the extended main source unit includes its parent unit,
-- and the parent unit spec if it is separate.
function In_Extended_Main_Source_Unit (Loc : Source_Ptr) return Boolean;
-- or internal units, so it reflects the Ada version explicitly set
-- using configuration pragmas or compiler switches (or if neither
-- appears, it remains set to Ada_Version_Default). This is used in
- -- the rare cases (notably for pragmas Preelaborate_05 and Pure_05)
+ -- the rare cases (notably for pragmas Preelaborate_05 and Pure_05/12)
-- where in the run-time we want the explicit version set.
Ada_Version_Runtime : Ada_Version_Type := Ada_2012;
Pragma_Psect_Object |
Pragma_Pure |
Pragma_Pure_05 |
+ Pragma_Pure_12 |
Pragma_Pure_Function |
Pragma_Queuing_Policy |
Pragma_Relative_Deadline |
end if;
end Check_SPARK_Restriction;
+ --------------------------------
+ -- Check_No_Implicit_Aliasing --
+ --------------------------------
+
+ procedure Check_No_Implicit_Aliasing (Obj : Node_Id) is
+ E : Entity_Id;
+
+ begin
+ -- If restriction not active, nothing to check
+
+ if not Restriction_Active (No_Implicit_Aliasing) then
+ return;
+ end if;
+
+ -- If we have an entity name, check entity
+
+ if Is_Entity_Name (Obj) then
+ E := Entity (Obj);
+
+ -- Restriction applies to entities that are objects
+
+ if Is_Object (E) then
+ if Is_Aliased (E) then
+ return;
+
+ elsif Present (Renamed_Object (E)) then
+ Check_No_Implicit_Aliasing (Renamed_Object (E));
+ return;
+ end if;
+
+ -- If we don't have an object, then it's OK
+
+ else
+ return;
+ end if;
+
+ -- For selected component, check selector
+
+ elsif Nkind (Obj) = N_Selected_Component then
+ Check_No_Implicit_Aliasing (Selector_Name (Obj));
+ return;
+
+ -- Indexed component is OK if aliased components
+
+ elsif Nkind (Obj) = N_Indexed_Component then
+ if Has_Aliased_Components (Etype (Prefix (Obj)))
+ or else
+ (Is_Access_Type (Etype (Prefix (Obj)))
+ and then Has_Aliased_Components
+ (Designated_Type (Etype (Prefix (Obj)))))
+ then
+ return;
+ end if;
+
+ -- For type conversion, check converted expression
+
+ elsif Nkind_In (Obj, N_Unchecked_Type_Conversion, N_Type_Conversion) then
+ Check_No_Implicit_Aliasing (Expression (Obj));
+ return;
+
+ -- Explicit dereference is always OK
+
+ elsif Nkind (Obj) = N_Explicit_Dereference then
+ return;
+ end if;
+
+ -- If we fall through, then we have an aliased view that does not meet
+ -- the rules for being explicitly aliased, so issue restriction msg.
+
+ Check_Restriction (No_Implicit_Aliasing, Obj);
+ end Check_No_Implicit_Aliasing;
+
-----------------------------------------
-- Check_Implicit_Dynamic_Code_Allowed --
-----------------------------------------
-- Same as Check_SPARK_Restriction except there is a continuation message
-- Msg2 following the initial message Msg1.
+ procedure Check_No_Implicit_Aliasing (Obj : Node_Id);
+ -- Obj is a node for which Is_Aliased_View is True, which is being used in
+ -- a context (e.g. 'Access) where no implicit aliasing is allowed if the
+ -- restriction No_Implicit_Aliasing is set. This procedure checks for the
+ -- case where the restriction is active and Obj does not meet the required
+ -- rules for avoiding implicit aliases, and issues a restriction message.
+
procedure Check_Implicit_Dynamic_Code_Allowed (N : Node_Id);
-- Tests to see if dynamic code generation (dynamically generated
-- trampolines, in particular) is allowed by the current restrictions
and then not In_Instance
and then not In_Inlined_Body
then
- if Restriction_Check_Required (No_Implicit_Aliasing) then
- Error_Attr_P
- ("prefix of % attribute must be explicitly aliased");
- else
- Error_Attr_P
- ("prefix of % attribute must be aliased");
- end if;
+ Error_Attr_P ("prefix of % attribute must be aliased");
+ Check_No_Implicit_Aliasing (P);
end if;
end Analyze_Access_Attribute;
if Restriction_Check_Required (No_Implicit_Aliasing) then
if not Is_Aliased_View (P) then
Check_Restriction (No_Implicit_Aliasing, P);
+ else
+ Check_No_Implicit_Aliasing (P);
end if;
end if;
and then In_Private_Part (Current_Scope)
then
Priv_Decls :=
- Private_Declarations (
- Specification (Unit_Declaration_Node (Current_Scope)));
+ Private_Declarations
+ (Specification (Unit_Declaration_Node (Current_Scope)));
return In_Package_Body (Current_Scope)
or else
(Is_List_Member (Decl)
- and then List_Containing (Decl) = Priv_Decls)
+ and then List_Containing (Decl) = Priv_Decls)
or else (Nkind (Parent (Decl)) = N_Package_Specification
- and then not
- Is_Compilation_Unit
- (Defining_Entity (Parent (Decl)))
- and then List_Containing (Parent (Parent (Decl)))
- = Priv_Decls);
+ and then not
+ Is_Compilation_Unit
+ (Defining_Entity (Parent (Decl)))
+ and then List_Containing (Parent (Parent (Decl))) =
+ Priv_Decls);
else
return False;
end if;
-- or IN OUT parameters of the subprogram, or (for a function) if the
-- return value has an invariant.
+ function Is_Public_Subprogram_For (T : Entity_Id) return Boolean;
+ -- T is the entity for a private type for which invariants are defined.
+ -- This function returns True if the procedure corresponding to the
+ -- value of Designator is a public procedure from the point of view of
+ -- this type (i.e. its spec is in the visible part of the package that
+ -- contains the declaration of the private type). A True value means
+ -- that an invariant check is required (for an IN OUT parameter, or
+ -- the returned value of a function.
+
--------------
-- Grab_PPC --
--------------
return False;
end Invariants_Or_Predicates_Present;
+ ------------------------------
+ -- Is_Public_Subprogram_For --
+ ------------------------------
+
+ -- The type T is a private type, its declaration is therefore in
+ -- the list of public declarations of some package. The test for a
+ -- public subprogram is that its declaration is in this same list
+ -- of declarations for the same package (note that all the public
+ -- declarations are in one list, and all the private declarations
+ -- in another, so this deals with the public/private distinction).
+
+ function Is_Public_Subprogram_For (T : Entity_Id) return Boolean is
+ DD : constant Node_Id := Unit_Declaration_Node (Designator);
+ -- The subprogram declaration for the subprogram in question
+
+ TL : constant List_Id :=
+ Visible_Declarations
+ (Specification (Unit_Declaration_Node (Scope (T))));
+ -- The list of declarations containing the private declaration of
+ -- the type. We know it is a private type, so we know its scope is
+ -- the package in question, and we know it must be in the visible
+ -- declarations of this package.
+
+ begin
+ -- If the subprogram declaration is not a list member, it must be
+ -- an Init_Proc, in which case we want to consider it to be a
+ -- public subprogram, since we do get initializations to deal with.
+
+ if not Is_List_Member (DD) then
+ return True;
+
+ -- Otherwise we test whether the subprogram is declared in the
+ -- visible declarations of the package containing the type.
+
+ else
+ return TL = List_Containing (DD);
+ end if;
+ end Is_Public_Subprogram_For;
+
-- Start of processing for Process_PPCs
begin
Parameter_Type => New_Occurrence_Of (Ftyp, Loc),
Defining_Identifier => Rent));
- -- Add invariant call if returning type with invariants
+ -- Add invariant call if returning type with invariants and
+ -- this is a public function, i.e. a function declared in the
+ -- visible part of the package defining the private type.
if Has_Invariants (Etype (Rent))
and then Present (Invariant_Procedure (Etype (Rent)))
+ and then Is_Public_Subprogram_For (Etype (Rent))
then
Append_To (Plist,
Make_Invariant_Call (New_Occurrence_Of (Rent, Loc)));
if Has_Invariants (Ftype)
and then Present (Invariant_Procedure (Ftype))
+ and then Is_Public_Subprogram_For (Ftype)
then
Append_To (Plist,
Make_Invariant_Call
end if;
end Pure_05;
+ -------------
+ -- Pure_12 --
+ -------------
+
+ -- pragma Pure_12 [(library_unit_NAME)];
+
+ -- This pragma is useable only in GNAT_Mode, where it is used like
+ -- pragma Pure but it is only effective in Ada 2012 mode (otherwise
+ -- it is ignored). It may be used after a pragma Preelaborate, in
+ -- which case it overrides the effect of the pragma Preelaborate.
+ -- This is used to implement AI05-0212 which recategorizes some
+ -- run-time packages in Ada 2012 mode.
+
+ when Pragma_Pure_12 => Pure_12 : declare
+ Ent : Entity_Id;
+
+ begin
+ GNAT_Pragma;
+ Check_Valid_Library_Unit_Pragma;
+
+ if not GNAT_Mode then
+ Error_Pragma ("pragma% only available in GNAT mode");
+ end if;
+
+ if Nkind (N) = N_Null_Statement then
+ return;
+ end if;
+
+ -- This is one of the few cases where we need to test the value of
+ -- Ada_Version_Explicit rather than Ada_Version (which is always
+ -- set to Ada_2012 in a predefined unit), we need to know the
+ -- explicit version set to know if this pragma is active.
+
+ if Ada_Version_Explicit >= Ada_2012 then
+ Ent := Find_Lib_Unit_Name;
+ Set_Is_Preelaborated (Ent, False);
+ Set_Is_Pure (Ent);
+ Set_Suppress_Elaboration_Warnings (Ent);
+ end if;
+ end Pure_12;
+
-------------------
-- Pure_Function --
-------------------
Pragma_Psect_Object => -1,
Pragma_Pure => -1,
Pragma_Pure_05 => -1,
+ Pragma_Pure_12 => -1,
Pragma_Pure_Function => -1,
Pragma_Queuing_Policy => -1,
Pragma_Ravenscar => -1,
if Is_Entity_Name (Obj) then
E := Entity (Obj);
- if Is_Object (E) and then not Is_Aliased (E) then
- Check_Restriction (No_Implicit_Aliasing, Obj);
- end if;
-
return
(Is_Object (E)
and then
function Is_Aliased_View (Obj : Node_Id) return Boolean;
-- Determine if Obj is an aliased view, i.e. the name of an object to which
- -- 'Access or 'Unchecked_Access can apply. Note that the implementation
- -- takes the No_Implicit_Aiasing restriction into account.
+ -- 'Access or 'Unchecked_Access can apply. Note that this routine uses the
+ -- rules of the language, it does not take into account the restriction
+ -- No_Implicit_Aliasing, so it can return True if the restriction is active
+ -- and Obj violates the restriction. The caller is responsible for calling
+ -- Restrict.Check_No_Implicit_Aliasing if True is returned, but there is a
+ -- requirement for obeying the restriction in the call context.
function Is_Ancestor_Package
(E1 : Entity_Id;
Name_Psect_Object : constant Name_Id := N + $; -- VMS
Name_Pure : constant Name_Id := N + $;
Name_Pure_05 : constant Name_Id := N + $; -- GNAT
+ Name_Pure_12 : constant Name_Id := N + $; -- GNAT
Name_Pure_Function : constant Name_Id := N + $; -- GNAT
Name_Relative_Deadline : constant Name_Id := N + $; -- Ada 05
Name_Remote_Call_Interface : constant Name_Id := N + $;
Pragma_Psect_Object,
Pragma_Pure,
Pragma_Pure_05,
+ Pragma_Pure_12,
Pragma_Pure_Function,
Pragma_Relative_Deadline,
Pragma_Remote_Call_Interface,
--
-- Set the maximum line length, nnn from 32 ..256. The default is 79.
+ S_Pretty_Maxact : aliased constant S := "/MAX_ACT=#" &
+ "--call_threshold=#";
+ -- /MAX_ACT=nnn
+ --
+ -- If the number of parameter associations is greater than nnn and if at
+ -- least one association uses named notation, start each association from
+ -- a new line
+
S_Pretty_Maxind : aliased constant S := "/MAX_INDENT=#" &
"-T#";
-- /MAX_INDENT=nnn
-- If nnn is zero, an additional indentation level is used for any
-- number of case alternatives and variants.
+ S_Pretty_Maxpar : aliased constant S := "/MAX_PAR=#" &
+ "--par_threshold=#";
+ -- /MAX_PAR=nnn
+ --
+ -- If the number of parameter specifications is greater than nnn (or equal
+ -- to nnn in case of a function), start each specification from a new line.
+ -- The default value is 3.
+
S_Pretty_Mess : aliased constant S := "/MESSAGES_PROJECT_FILE=" &
"DEFAULT " &
"-vP0 " &
S_Pretty_Indent 'Access,
S_Pretty_Keyword 'Access,
S_Pretty_Maxlen 'Access,
+ S_Pretty_Maxact 'Access,
S_Pretty_Maxind 'Access,
+ S_Pretty_Maxpar 'Access,
S_Pretty_Mess 'Access,
S_Pretty_Names 'Access,
S_Pretty_No_Labels 'Access,
projects / gcc.git / commitdiff