This patch adds information on an illegal definition for a stream procedure,
indicating that the second argument of the procedure must be a first subtype.
Compiling host-msg.ads must yield:
host-msg.ads:11:08: formal of stream operation must be a first subtype
host-msg.ads:12:41: incorrect expression for "Read" attribute
host-msg.ads:16:07: formal of stream operation must be a first subtype
host-msg.ads:17:42: incorrect expression for "Write" attribute
---
with Ada.Streams;
package Host.Msg is
type T_THD441_Connection_Req is new Host.T_Msg with null record;
subtype T_Msg is T_THD441_Connection_Req;
procedure Read_THD441_Connection_Req
(Stream : access Ada.Streams.Root_Stream_Type'Class;
Msg : out T_Msg);
for T_THD441_Connection_Req'Read use Read_THD441_Connection_Req;
procedure Write_THD441_Connection_Req
(Stream : access Ada.Streams.Root_Stream_Type'Class;
Msg : in T_Msg);
for T_THD441_Connection_Req'Write use Write_THD441_Connection_Req;
end Host.Msg;
---
package Host is
type T_Msg is tagged record
Field_1 : Integer;
Field_2 :Integer;
end record;
end Host;
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-04-18 Ed Schonberg <schonb...@adacore.com>
* sem_ch13.adb (Analyze_Stream_TSS_Definition,
Has_Good_Profile): Additional error message to indicate that
the second parameter of the subprogram must be a first subtype.
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 235093)
+++ sem_ch13.adb (working copy)
@@ -3754,15 +3754,21 @@
Is_Read : constant Boolean := (TSS_Nam = TSS_Stream_Read);
-- True for Read attribute, false for other attributes
- function Has_Good_Profile (Subp : Entity_Id) return Boolean;
+ function Has_Good_Profile
+ (Subp : Entity_Id;
+ Report : Boolean := False) return Boolean;
-- Return true if the entity is a subprogram with an appropriate
- -- profile for the attribute being defined.
+ -- profile for the attribute being defined. If result is false and
+ -- Report is True function emits appropriate error.
----------------------
-- Has_Good_Profile --
----------------------
- function Has_Good_Profile (Subp : Entity_Id) return Boolean is
+ function Has_Good_Profile
+ (Subp : Entity_Id;
+ Report : Boolean := False) return Boolean
+ is
F : Entity_Id;
Is_Function : constant Boolean := (TSS_Nam = TSS_Stream_Input);
Expected_Ekind : constant array (Boolean) of Entity_Kind :=
@@ -3837,6 +3843,11 @@
and then not Is_First_Subtype (Typ)
and then not Is_Class_Wide_Type (Typ)
then
+ if Report and not Is_First_Subtype (Typ) then
+ Error_Msg_N
+ ("formal of stream operation must be a first subtype", F);
+ end if;
+
return False;
else
@@ -3885,7 +3896,7 @@
if Is_Entity_Name (Expr) then
if not Is_Overloaded (Expr) then
- if Has_Good_Profile (Entity (Expr)) then
+ if Has_Good_Profile (Entity (Expr), Report => True) then
Subp := Entity (Expr);
end if;
