This fixes a problem with B test ND11001. There were actually three
problems reported
a) Bad use of Default_Component_Value, but this had already been
previously fixed.
b) Bad use of Invariant'Class, fixed as part of this patch
c) Failure to detect bad aspect on null body. This was actually
an issue of not detecting this after a previous error (i.e. a
B test splitting issue), but as part of this patch, this error
is now properly caught even if there are previous errors, which
avoids the need to split the test.
The following shows the three reported cases properly caught
and diagnosed (compiled with -gnatq -gnatld7 -gnatj55):
1. procedure BadAsp is
2. package P1 is
3. type Arr is private with
|
>>> aspect Default_Component_Value can only
apply to an array of scalar components
4. Default_Component_Value => 1;
5. private
6. type Arr is array (1 .. 10) of Integer;
7. end;
8.
9. package P2 is
10. type Rec is private with
11. Type_Invariant'Class => True;
|
>>> Type_Invariant'Class cannot be specified
for "Rec", can only be specified for a
tagged type
12. private
13. type Rec is null record;
14. end;
15.
16. package p3 is
17. type Priv is tagged null record;
18. procedure Prim1 (A : in out Priv);
19. end;
20.
21. package body P3 is
22. procedure Prim1 (A : in out Priv) is null
23. with Post'Class => True;
|
>>> aspect specification must appear in
subprogram declaration
24. end;
25.
26. begin
27. null;
28. end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-07-31 Robert Dewar <de...@adacore.com>
* freeze.adb (Freeze_Entity): Check for error of
Type_Invariant'Class applied to a untagged type.
* sem_ch6.adb (Analyze_Null_Procedure): Unconditionally rewrite
as null body, so that we perform error checks even if expansion
is off.
Index: freeze.adb
===================================================================
--- freeze.adb (revision 213289)
+++ freeze.adb (working copy)
@@ -4537,6 +4537,24 @@
return No_List;
end if;
+ -- Check for error of Type_Invariant'Class applied to a untagged type
+ -- (check delayed to freeze time when full type is available).
+
+ declare
+ Prag : constant Node_Id := Get_Pragma (E, Pragma_Invariant);
+ begin
+ if Present (Prag)
+ and then Class_Present (Prag)
+ and then not Is_Tagged_Type (E)
+ then
+ Error_Msg_NE
+ ("Type_Invariant''Class cannot be specified for &",
+ Prag, E);
+ Error_Msg_N
+ ("\can only be specified for a tagged type", Prag);
+ end if;
+ end;
+
-- Deal with special cases of freezing for subtype
if E /= Base_Type (E) then
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 213300)
+++ sem_ch6.adb (working copy)
@@ -1391,19 +1391,14 @@
end if;
else
- -- The null procedure is a completion
+ -- The null procedure is a completion. We unconditionally rewrite
+ -- this as a null body (even if expansion is not active), because
+ -- there are various error checks that are applied on this body
+ -- when it is analyzed (e.g. correct aspect placement).
Is_Completion := True;
-
- if Expander_Active then
- Rewrite (N, Null_Body);
- Analyze (N);
-
- else
- Designator := Analyze_Subprogram_Specification (Spec);
- Set_Has_Completion (Designator);
- Set_Has_Completion (Prev);
- end if;
+ Rewrite (N, Null_Body);
+ Analyze (N);
end if;
end Analyze_Null_Procedure;
