From 026733d84e1f13ec9fdfc124d5d727fcce64e91c Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Wed, 23 May 2018 10:23:24 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_attr.adb | 6 ++++-- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/valid_scalars1.adb | 11 +++++++++++ 4 files changed, 27 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/valid_scalars1.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bb3d631..8874e6a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2018-05-23 Javier Miranda + + * 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 * 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 a7063d0..f94cbad 100644 --- 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 f0cd8a2..cd836e8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-05-23 Javier Miranda + + * gnat.dg/valid_scalars1.adb: New testcase. + 2018-05-23 Ed Schonberg * 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 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; -- 2.7.4