+2016-06-22 Ed Schonberg <schonberg@adacore.com>
+
+ * einfo.ads, einfo.adb (Is_Actual_Subtype): New flag, defined
+ on subtypes that are created within subprogram bodies to handle
+ unconstrained composite formals.
+ * checks.adb (Apply_Predicate_Check): Do not generate a check on
+ an object whose type is an actual subtype.
+ * sem_ch6.adb (Set_Actual_Subtypes): Do not generate an
+ actual subtype for a formal whose base type is private.
+ Set Is_Actual_Subtype on corresponding entity after analyzing
+ its declaration.
+
+2016-06-22 Justin Squirek <squirek@adacore.com>
+
+ * sem_prag.adb (Check_Expr_Is_OK_Static_Expression): Fix ordering
+ of if-block and add in a condition to test for errors during
+ resolution.
+ * sem_res.adb (Resolution_Failed): Add comment to explain why
+ the type of a node which failed to resolve is set to the desired
+ type instead of Any_Type.
+ * sem_ch8.adb (Analyze_Object_Renaming): Add a check for Any_Type
+ to prevent crashes on Is_Access_Constant.
+
2016-06-22 Hristian Kirtchev <kirtchev@adacore.com>
* lib-xref-spark_specific.adb, checks.adb, sem_ch13.adb: Minor
Check_Expression_Against_Static_Predicate (N, Typ);
- if Is_Entity_Name (N) then
+ if not Expander_Active then
+ return;
+ end if;
+
+ -- For an entity of the type, generate a call to the predicate
+ -- function, unless its type is an actual subtype, which is not
+ -- visible outside of the enclosing subprogram.
+
+ if Is_Entity_Name (N)
+ and then not Is_Actual_Subtype (Typ)
+ then
Insert_Action (N,
Make_Predicate_Check
(Typ, New_Occurrence_Of (Entity (N), Sloc (N))));
-- Has_Inherited_Invariants Flag291
-- Is_Partial_Invariant_Procedure Flag292
+ -- Is_Actual_Subtype Flag293
- -- (unused) Flag293
-- (unused) Flag294
-- (unused) Flag295
-- (unused) Flag296
return Flag69 (Id);
end Is_Access_Constant;
+ function Is_Actual_Subtype (Id : E) return B is
+ begin
+ pragma Assert (Is_Type (Id));
+ return Flag293 (Id);
+ end Is_Actual_Subtype;
+
function Is_Ada_2005_Only (Id : E) return B is
begin
return Flag185 (Id);
Set_Flag69 (Id, V);
end Set_Is_Access_Constant;
+ procedure Set_Is_Actual_Subtype (Id : E; V : B := True) is
+ begin
+ pragma Assert (Is_Type (Id));
+ Set_Flag293 (Id, V);
+ end Set_Is_Actual_Subtype;
+
procedure Set_Is_Ada_2005_Only (Id : E; V : B := True) is
begin
Set_Flag185 (Id, V);
W ("Is_Abstract_Subprogram", Flag19 (Id));
W ("Is_Abstract_Type", Flag146 (Id));
W ("Is_Access_Constant", Flag69 (Id));
+ W ("Is_Actual_Subtype", Flag293 (Id));
W ("Is_Ada_2005_Only", Flag185 (Id));
W ("Is_Ada_2012_Only", Flag199 (Id));
W ("Is_Aliased", Flag15 (Id));
-- Is_Access_Type (synthesized)
-- Applies to all entities, true for access types and subtypes
+-- Is_Actual_Subtype (Flag293)
+-- Defined on all types, true for the generated constrained subtypes
+-- that are built for unconstrained composite actuals.
+
-- Is_Ada_2005_Only (Flag185)
-- Defined in all entities, true if a valid pragma Ada_05 or Ada_2005
-- applies to the entity which specifically names the entity, indicating
function Is_Abstract_Subprogram (Id : E) return B;
function Is_Abstract_Type (Id : E) return B;
function Is_Access_Constant (Id : E) return B;
+ function Is_Actual_Subtype (Id : E) return B;
function Is_Ada_2005_Only (Id : E) return B;
function Is_Ada_2012_Only (Id : E) return B;
function Is_Aliased (Id : E) return B;
procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True);
procedure Set_Is_Abstract_Type (Id : E; V : B := True);
procedure Set_Is_Access_Constant (Id : E; V : B := True);
+ procedure Set_Is_Actual_Subtype (Id : E; V : B := True);
procedure Set_Is_Ada_2005_Only (Id : E; V : B := True);
procedure Set_Is_Ada_2012_Only (Id : E; V : B := True);
procedure Set_Is_Aliased (Id : E; V : B := True);
pragma Inline (Is_Abstract_Subprogram);
pragma Inline (Is_Abstract_Type);
pragma Inline (Is_Access_Constant);
+ pragma Inline (Is_Actual_Subtype);
pragma Inline (Is_Access_Protected_Subprogram_Type);
pragma Inline (Is_Access_Subprogram_Type);
pragma Inline (Is_Access_Type);
pragma Inline (Set_Is_Abstract_Subprogram);
pragma Inline (Set_Is_Abstract_Type);
pragma Inline (Set_Is_Access_Constant);
+ pragma Inline (Set_Is_Actual_Subtype);
pragma Inline (Set_Is_Ada_2005_Only);
pragma Inline (Set_Is_Ada_2012_Only);
pragma Inline (Set_Is_Aliased);
-- At this stage we have an unconstrained type that may need an
-- actual subtype. For sure the actual subtype is needed if we have
- -- an unconstrained array type.
+ -- an unconstrained array type. However, in an instance, the type
+ -- may appear as a subtype of the full view, while the actual is
+ -- in fact private (in which case no actual subtype is needed) so
+ -- check the kind of the base type.
- elsif Is_Array_Type (T) then
+ elsif Is_Array_Type (Base_Type (T)) then
AS_Needed := True;
-- The only other case needing an actual subtype is an unconstrained
-- therefore needs no constraint checks.
Analyze (Decl, Suppress => All_Checks);
+ Set_Is_Actual_Subtype (Defining_Identifier (Decl));
-- We need to freeze manually the generated type when it is
-- inserted anywhere else than in a declarative part.
Resolve (Nam, T);
+ -- Do not perform the legality checks below when the resolution of
+ -- the renaming name failed because the associated type is Any_Type.
+
+ if Etype (Nam) = Any_Type then
+ null;
+
-- Ada 2005 (AI-231): In the case where the type is defined by an
-- access_definition, the renamed entity shall be of an access-to-
-- constant type if and only if the access_definition defines an
-- access-to-constant type. ARM 8.5.1(4)
- if Constant_Present (Access_Definition (N))
+ elsif Constant_Present (Access_Definition (N))
and then not Is_Access_Constant (Etype (Nam))
then
- Error_Msg_N ("(Ada 2005): the renamed object is not "
- & "access-to-constant (RM 8.5.1(6))", N);
+ Error_Msg_N
+ ("(Ada 2005): the renamed object is not access-to-constant "
+ & "(RM 8.5.1(6))", N);
elsif not Constant_Present (Access_Definition (N))
and then Is_Access_Constant (Etype (Nam))
then
- Error_Msg_N ("(Ada 2005): the renamed object is not "
- & "access-to-variable (RM 8.5.1(6))", N);
+ Error_Msg_N
+ ("(Ada 2005): the renamed object is not access-to-variable "
+ & "(RM 8.5.1(6))", N);
end if;
if Is_Access_Subprogram_Type (Etype (Nam)) then
Analyze_And_Resolve (Expr);
end if;
- if Is_OK_Static_Expression (Expr) then
- return;
+ -- An expression cannot be considered static if its resolution failed
+ -- or if it erroneous. Stop the analysis of the related pragma.
- elsif Etype (Expr) = Any_Type then
+ if Etype (Expr) = Any_Type or else Error_Posted (Expr) then
raise Pragma_Exit;
+ elsif Is_OK_Static_Expression (Expr) then
+ return;
+
-- An interesting special case, if we have a string literal and we
-- are in Ada 83 mode, then we allow it even though it will not be
-- flagged as static. This allows the use of Ada 95 pragmas like
then
return;
- -- Static expression that raises Constraint_Error. This has already
- -- been flagged, so just exit from pragma processing.
-
- elsif Is_OK_Static_Expression (Expr) then
- raise Pragma_Exit;
-
-- Finally, we have a real error
else
procedure Resolution_Failed is
begin
Patch_Up_Value (N, Typ);
+
+ -- Set the type to the desired one to minimize cascaded errors. Note
+ -- that this is an approximation and does not work in all cases.
+
Set_Etype (N, Typ);
+
Debug_A_Exit ("resolving ", N, " (done, resolution failed)");
Set_Is_Overloaded (N, False);
projects / gcc.git / commitdiff