Typically an indexing aspect is specified on the private view of a tagged
type. In the unusual case where there is an incomplete view and the aspect
specification appears on the full view, the aspect specification must be
analyzed on the full view rather than the incomplete one, to prevent freezing
anomalies with the class-wide type, which otherwise might be frozen before
the dispatch table for the type is constructed.
Compiling and executing try2.adb must yield:
ab
---
pragma Ada_2012;
with Ada.Text_IO; use Ada.Text_IO;
procedure Try2 is
package Pack is
type T is tagged;
function F (Obj : T; S : String; Pos : Positive) return Character;
type T is tagged null record
with Constant_Indexing => F;
end Pack;
package body Pack is
function F (Obj : T; S : String; Pos : Positive) return Character is
begin
return S (Pos);
end F;
end Pack;
use Pack;
V : T;
begin
Put (V ("abcd", 1));
Put (V ("abcd", 2));
New_Line;
end Try2;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-10-20 Ed Schonberg <[email protected]>
* sem_ch3.adb (Analyze_Full_Type_Declaration): If previous view
is incomplete rather than private, and full type declaration
has aspects, analyze aspects on the full view rather than
the incomplete view, to prevent freezing anomalies with the
class-wide type.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 216469)
+++ sem_ch3.adb (working copy)
@@ -2777,9 +2777,18 @@
-- them to the entity for the type which is currently the partial
-- view, but which is the one that will be frozen.
+ -- In most cases the partial view is a private type, and both views
+ -- appear in different declarative parts. In the unusual case where the
+ -- partial view is incomplete, perform the analysis on the full view,
+ -- to prevent freezing anomalies with the corresponding class-wide type,
+ -- which otherwise might be frozen before the dispatch table is built.
+
if Has_Aspects (N) then
- if Prev /= Def_Id then
+ if Prev /= Def_Id
+ and then Ekind (Prev) /= E_Incomplete_Type
+ then
Analyze_Aspect_Specifications (N, Prev);
+
else
Analyze_Aspect_Specifications (N, Def_Id);
end if;
