+2014-07-31 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch3.adb (Expand_Freeze_Record_Type): Do not build an
+ invariant procedure for an internally generated subtype that is
+ created for an object of a class-wide type.
+
+2014-07-31 Vincent Celier <celier@adacore.com>
+
+ * prj-nmsc.adb, errutil.adb: Make code similar to Errout.
+
+2014-07-31 Gary Dismukes <dismukes@adacore.com>
+
+ * gnat_rm.texi, sem_aux.ads, einfo.ads, sem_util.ads, sem_ch6.adb,
+ exp_disp.adb: Minor reformatting.
+
2014-07-31 Robert Dewar <dewar@adacore.com>
* exp_ch5.adb, sem_ch3.adb, exp_ch7.adb, exp_util.adb, exp_ch9.adb,
-- defined primitives, and 6) secondary dispatch table with predefined
-- primitives. The last entity of this list is an access type declaration
-- used to expand dispatching calls through the primary dispatch table.
--- For a non-tagged record, contains No_Elist.
+-- For an untagged record, contains No_Elist.
-- Actual_Subtype (Node17)
-- Defined in variables, constants, and formal parameters. This is the
-- Class_Wide_Type (Node9)
-- Defined in all type entities. For a tagged type or subtype, returns
-- the corresponding implicitly declared class-wide type. For a
--- class-wide type, returns itself. Set to Empty for non-tagged types.
+-- class-wide type, returns itself. Set to Empty for untagged types.
-- Cloned_Subtype (Node16)
-- Defined in E_Record_Subtype and E_Class_Wide_Subtype entities.
-- Defined in E_Record_Type and E_Record_Subtype entities. Set in library
-- level tagged type entities if we are generating statically allocated
-- dispatch tables. Points to the list of dispatch table wrappers
--- associated with the tagged type. For a non-tagged record, contains
+-- associated with the tagged type. For an untagged record, contains
-- No_Elist.
-- DTC_Entity (Node16)
-- Is_Primitive (Flag218)
-- Defined in overloadable entities and in generic subprograms. Set to
-- indicate that this is a primitive operation of some type, which may
--- be a tagged type or a non-tagged type. Used to verify overriding
+-- be a tagged type or an untagged type. Used to verify overriding
-- indicators in bodies.
-- Is_Primitive_Wrapper (Flag195)
--
-- Rec_Ext.Comp -> Rec_Ext.Parent. ... .Parent.Comp
--
--- In base non-tagged types:
+-- In base untagged types:
-- Always points to itself except for non-girder discriminants, where
-- it points to the girder discriminant it renames.
--
P := P - 1;
Set_Msg_Insertion_Reserved_Word (Text, P);
- -- Tilde: just remove '~' and do not modify the message further
-
- -- This is peculiar, incompatible with errout, and not documented ???
-
elsif C = '~' then
- Set_Msg_Str
- (Text (Text'First .. P - 2) & Text (P .. Text'Last));
- exit;
+ Set_Msg_Str (Error_Msg_String (1 .. Error_Msg_Strlen));
-- Normal character with no special treatment
-- Check whether individual components have a defined invariant, and add
-- the corresponding component invariant checks.
- Insert_Component_Invariant_Checks
- (N, Def_Id, Build_Record_Invariant_Proc (Def_Id, N));
+ -- Do not create an invariant procedure for some internally generated
+ -- subtypes, in particular those created for objects of a class-wide
+ -- type. Such types may have components to which invariant apply, but
+ -- the corresponding checks will be applied when an object of the parent
+ -- type is constructed.
+
+ -- Such objects will show up in a class-wide postcondition, and the
+ -- invariant will be checked, if necessary, upon return from the
+ -- enclosing subprogram.
+
+ if not Is_Class_Wide_Equivalent_Type (Def_Id) then
+ Insert_Component_Invariant_Checks
+ (N, Def_Id, Build_Record_Invariant_Proc (Def_Id, N));
+ end if;
end Expand_Freeze_Record_Type;
------------------------------
-- is frozen, enough must be known about it to build the activation
-- record for it, which requires at least that the size of all
-- parameters be known. Controlling arguments are by-reference,
- -- and therefore the rule only applies to non-tagged types. Typical
+ -- and therefore the rule only applies to untagged types. Typical
-- violation of the rule involves an object declaration that freezes a
-- tagged type, when one of its primitive operations has a type in its
-- profile whose full view has not been analyzed yet. More complex cases
the pragma is a configuration pragma, and applies to all library level
objects with no explicit initialization of potentially persistent types.
-A potentially persistent type is a scalar type, or a non-tagged,
+A potentially persistent type is a scalar type, or an untagged,
non-discriminated record, all of whose components have no explicit
initialization and are themselves of a potentially persistent type,
or an array, all of whose constraints are static, and whose component
developed using SPARK 2005, or in examining legacy code to see how far
it is from meeting SPARK restrictions.
-The list below summarises the checks that are performed when this
+The list below summarizes the checks that are performed when this
restriction is in force:
@itemize @bullet
@item No block statements
@item Modular type modulus must be power of 2
@item Base not allowed on subtype mark
@item Unary operators not allowed on modular types (except not)
-@item Non-tagged record cannot be null
+@item Untagged record cannot be null
@item No class-wide operations
@item Initialization expressions must respect SPARK restrictions
@item Non-static ranges not allowed except in iteration schemes
exception
when Use_Error =>
+
+ -- Output message with name of directory. Note that we
+ -- use the ~ insertion method here in case the name
+ -- has special characters in it.
+
+ Error_Msg_Strlen := Full_Path_Name'Length;
+ Error_Msg_String (1 .. Error_Msg_Strlen) :=
+ Full_Path_Name.all;
Error_Msg
(Data.Flags,
- "~could not create " & Create &
- " directory " & Full_Path_Name.all,
- Location, Project);
+ "could not create " & Create & " directory ~",
+ Location,
+ Project);
end;
end if;
end if;
-- stored discriminants are the same as the actual discriminants of the
-- type, and hence this function is the same as First_Discriminant.
--
- -- For derived non-tagged types that rename discriminants in the root type
+ -- For derived untagged types that rename discriminants in the root type
-- this is the first of the discriminants that occur in the root type. To
-- be precise, in this case stored discriminants are entities attached to
-- the entity chain of the derived type which are a copy of the
Obj_Decl : Node_Id;
begin
- -- This check applies only if we have a subprogram declaration with a
- -- non-tagged record type.
+ -- This check applies only if we have a subprogram declaration with an
+ -- untagged record type.
if Nkind (Decl) /= N_Subprogram_Declaration
or else not Is_Record_Type (Typ)
-- Used to test if AV is an acceptable formal for an OUT or IN OUT formal.
-- Note that the Is_Variable function is not quite the right test because
-- this is a case in which conversions whose expression is a variable (in
- -- the Is_Variable sense) with a non-tagged type target are considered view
+ -- the Is_Variable sense) with an untagged type target are considered view
-- conversions and hence variables.
function Is_Partially_Initialized_Type
function Is_Potentially_Persistent_Type (T : Entity_Id) return Boolean;
-- Determines if type T is a potentially persistent type. A potentially
- -- persistent type is defined (recursively) as a scalar type, a non-tagged
+ -- persistent type is defined (recursively) as a scalar type, an untagged
-- record whose components are all of a potentially persistent type, or an
-- array with all static constraints whose component type is potentially
-- persistent. A private type is potentially persistent if the full type
Use_Original_Node : Boolean := True) return Boolean;
-- Determines if the tree referenced by N represents a variable, i.e. can
-- appear on the left side of an assignment. There is one situation (formal
- -- parameters) in which non-tagged type conversions are also considered
+ -- parameters) in which untagged type conversions are also considered
-- variables, but Is_Variable returns False for such cases, since it has
-- no knowledge of the context. Note that this is the point at which
-- Assignment_OK is checked, and True is returned for any tree thus marked.
projects / thirdparty / gcc.git / commitdiff
