diff mbox series

[Ada] Missing error on aspects Input and Output

Message ID 20200618091320.GA1969@adacore.com
State New
Headers show
Series [Ada] Missing error on aspects Input and Output | expand

Commit Message

Pierre-Marie de Rodat June 18, 2020, 9:13 a.m. UTC 
The frontend does not report an error on the illegal use of a non
class-wide subprogram with class-wide aspects Input and Output;
similarly it also skips reporting the error when a class-wide subprogram
is used with the non class-wide aspects.  As a consequence of not
reporting these errors at compile time errors are reported at link time
as undefined symbols.

Tested on x86_64-pc-linux-gnu, committed on trunk

2020-06-18  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* sem_ch13.adb (Has_Good_Profile): Enforce strictness in the
	check. Required to detect wrong profiles for Input and Output.
	(Analyze_Stream_TSS_Definition): Minor enhancement in the text
	of the error for class-wide attributes.
diff mbox series

Patch

--- gcc/ada/sem_ch13.adb
+++ gcc/ada/sem_ch13.adb
@@ -5019,33 +5019,14 @@  package body Sem_Ch13 is
 
                Typ := Etype (F);
 
-               --  If the attribute specification comes from an aspect
-               --  specification for a class-wide stream, the parameter must be
-               --  a class-wide type of the entity to which the aspect applies.
-
-               if From_Aspect_Specification (N)
-                 and then Class_Present (Parent (N))
-                 and then Is_Class_Wide_Type (Typ)
-               then
-                  Typ := Etype (Typ);
-               end if;
-
             else
                Typ := Etype (Subp);
             end if;
 
             --  Verify that the prefix of the attribute and the local name for
-            --  the type of the formal match, or one is the class-wide of the
-            --  other, in the case of a class-wide stream operation.
-
-            if Base_Type (Typ) = Base_Type (Ent)
-              or else (Is_Class_Wide_Type (Typ)
-                        and then Typ = Class_Wide_Type (Base_Type (Ent)))
-              or else (Is_Class_Wide_Type (Ent)
-                        and then Ent = Class_Wide_Type (Base_Type (Typ)))
-            then
-               null;
-            else
+            --  the type of the formal match.
+
+            if Base_Type (Typ) /= Base_Type (Ent) then
                return False;
             end if;
 
@@ -5158,7 +5139,13 @@  package body Sem_Ch13 is
 
          else
             Error_Msg_Name_1 := Attr;
-            Error_Msg_N ("incorrect expression for% attribute", Expr);
+
+            if Is_Class_Wide_Type (Base_Type (Ent)) then
+               Error_Msg_N
+                 ("incorrect expression for class-wide% attribute", Expr);
+            else
+               Error_Msg_N ("incorrect expression for% attribute", Expr);
+            end if;
          end if;
       end Analyze_Stream_TSS_Definition;