[Ada] Crash processing Valid_Scalars whose evaluation is always true

The compiler blows up generating code associated with occurrences of attribute
Valid_Scalars whose evaluation is always true. After this patch the following
test compiles fine.

2018-05-23  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* sem_attr.adb (Valid_Scalars): Do not invoke Error_Attr_P to report
	the warning on occurrences of this attribute whose evaluation is always
	true (since that subprogram aborts processing the attribute). In
	addition, replace the node by its boolean result 'True' (required
	because the backend has no knowledge of this attribute).

gcc/testsuite/

	* gnat.dg/valid_scalars1.adb: New testcase.

From-SVN: r260591

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bb3d631a38de2ab20dc2fdb5ba7dd4633be79681..8874e6ad152ccabaa5f7c69b8480325be1d0e0f2 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2018-05-23  Javier Miranda  <miranda@adacore.com>
+
+       * sem_attr.adb (Valid_Scalars): Do not invoke Error_Attr_P to report
+       the warning on occurrences of this attribute whose evaluation is always
+       true (since that subprogram aborts processing the attribute). In
+       addition, replace the node by its boolean result 'True' (required
+       because the backend has no knowledge of this attribute).
+
 2018-05-23  Bob Duff  <duff@adacore.com>
 
        * libgnat/a-convec.adb: (Insert, Insert_Space): Suppress warnings. The

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index a7063d0e25bff6c0170801b0aa37a6f9c8e0ad13..f94cbadc9f813c4f0fb3260eb5e71bc6bc779ff2 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6929,8 +6929,10 @@ package body Sem_Attr is
 
             else
                if not Scalar_Part_Present (P_Type) then
-                  Error_Attr_P
-                    ("??attribute % always True, no scalars to check");
+                  Error_Msg_Name_1 := Aname;
+                  Error_Msg_F
+                    ("??attribute % always True, no scalars to check", P);
+                  Set_Boolean_Result (N, True);
                end if;
 
                --  Attribute 'Valid_Scalars is illegal on unchecked union types

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f0cd8a2cf4a2b64389b153c3e607cdab74c462a1..cd836e893407f2db0cdcbf9bddf004e6df14acff 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-05-23  Javier Miranda  <miranda@adacore.com>
+
+       * gnat.dg/valid_scalars1.adb: New testcase.
+
 2018-05-23  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/iter1.adb, gnat.dg/iter1.ads: New testcase.

diff --git a/gcc/testsuite/gnat.dg/valid_scalars1.adb b/gcc/testsuite/gnat.dg/valid_scalars1.adb
new file mode 100644 (file)
index 0000000..0b01048
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/valid_scalars1.adb
@@ -0,0 +1,11 @@
+--  { dg-do compile }
+--  { dg-options "-gnata -gnatws" }
+
+procedure Valid_Scalars1 is
+   type Ptr is access Integer;
+   V1 : Ptr;
+
+   Check : Boolean := V1'Valid_Scalars;
+begin
+   pragma Assert (Check);
+end;