[Ada] Don't accept illegal (e.g., Integer'(null)) generic actuals

Sem_Util.Wrong_Type usually emits an error message, but in some cases it
does not. The code which prevents emitting an error message was going
too far in some cases, causing illegal constructs to be accepted. For
example, a qualified expression such as Integer'(null) might be passed
in as an actual parameter in an instantiation of a generic and generate
no error message.

Running this command:

  gcc -c inst.ads

On the following sources:

package Inst is
   type Ptr is new Integer;

   generic
      type TElement is private;
      NonDefini : TElement;
   package ArbMgr is
   end ArbMgr;

   package Pack is new ArbMgr (Ptr, Ptr'(null));

   procedure Dummy;
end Inst;

Should produce the following output:

  inst.ads:10:42: expected type "Ptr" defined at line 2
  inst.ads:10:42: found an access type
  compilation abandoned due to previous error

2019-09-17  Steve Baird  <baird@adacore.com>

gcc/ada/

	* sem_util.adb (Wrong_Type): In deciding to suppress a message,
	it is not enough for In_Instance to be True; in addition,
	In_Generic_Actual (Expr) must be False.
	* sem_type.adb (In_Generic_Actual): Fix bug where traversal of
	parents skips every other node.

From-SVN: r275786

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index baf17ca06667818a0b1f79cee37f2e50321cddd1..32d35b9257d028c27ed048a0dea5caa341d73186 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2019-09-17  Steve Baird  <baird@adacore.com>
+
+       * sem_util.adb (Wrong_Type): In deciding to suppress a message,
+       it is not enough for In_Instance to be True; in addition,
+       In_Generic_Actual (Expr) must be False.
+       * sem_type.adb (In_Generic_Actual): Fix bug where traversal of
+       parents skips every other node.
+
 2019-09-17  Claire Dross  <dross@adacore.com>
 
        * sem_spark.adb (Get_Observed_Or_Borrowed_Expr): If the

diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index fee9c5e449106213c1ccf0b8f315ecccdc093d69..fc5052421cf0bebd854c8c529d191fb6e561c3ba 100644 (file)
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -2849,7 +2849,7 @@ package body Sem_Type is
          return False;
 
       else
-         return In_Generic_Actual (Parent (Par));
+         return In_Generic_Actual (Par);
       end if;
    end In_Generic_Actual;
 

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index b7d28953267c36909061d06c120ded75f4934944..99cdb8da0eb08c8b2892eda42e587fa73fd1c942 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -26689,7 +26689,7 @@ package body Sem_Util is
          return;
 
       --  In  an instance, there is an ongoing problem with completion of
-      --  type derived from private types. Their structure is what Gigi
+      --  types derived from private types. Their structure is what Gigi
       --  expects, but the  Etype is the parent type rather than the
       --  derived private type itself. Do not flag error in this case. The
       --  private completion is an entity without a parent, like an Itype.
@@ -26700,7 +26700,17 @@ package body Sem_Util is
       --  same reason: inserted body may be outside of the original package
       --  and only partial views are visible at the point of insertion.
 
-      elsif In_Instance or else In_Inlined_Body then
+      --  If In_Generic_Actual (Expr) is True then we cannot assume that
+      --  the successful semantic analysis of the generic guarantees anything
+      --  useful about type checking of this instance, so we ignore
+      --  In_Instance in that case. There may be cases where this is not
+      --  right (the symptom would probably be rejecting something
+      --  that ought to be accepted) but we don't currently have any
+      --  concrete examples of this.
+
+      elsif (In_Instance and then not In_Generic_Actual (Expr))
+        or else In_Inlined_Body
+      then
          if Etype (Etype (Expr)) = Etype (Expected_Type)
            and then
              (Has_Private_Declaration (Expected_Type)