From 8e4ca4fcffbe6d3855f67cd02e0bb2a40d62fa10 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 12 Aug 2019 09:01:43 +0000 Subject: [PATCH] [Ada] Crash on illegal left-hand side in assignment of renamed variable This patch fixes a crash on an assignment where the left-hand side is a renaming of a function call that does not involve ceiling priorities. This avoids a compiler crash in some cases, and prevents a useless retrieval and compilation of run-time packages. 2019-08-12 Ed Schonberg gcc/ada/ * sem_util.adb (Is_Expaned_Priority_Attribute): Check whether call comes from a rewritten attribute before comparing name with Get_Ceiling run-time subprogram. gcc/testsuite/ * gnat.dg/renaming15.adb: New testcase. From-SVN: r274305 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_util.adb | 1 + gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/renaming15.adb | 32 ++++++++++++++++++++++++++++ 4 files changed, 43 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/renaming15.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 64f4c6bb9ac..74ceb50653c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-12 Ed Schonberg + + * sem_util.adb (Is_Expaned_Priority_Attribute): Check whether + call comes from a rewritten attribute before comparing name with + Get_Ceiling run-time subprogram. + 2019-08-12 Eric Botcazou * exp_util.ads (Component_May_Be_Bit_Aligned): Small comment diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 42085c7402d..54ac0a41615 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -14669,6 +14669,7 @@ package body Sem_Util is return Nkind (E) = N_Function_Call and then not Configurable_Run_Time_Mode + and then Nkind (Original_Node (E)) = N_Attribute_Reference and then (Entity (Name (E)) = RTE (RE_Get_Ceiling) or else Entity (Name (E)) = RTE (RO_PE_Get_Ceiling)); end Is_Expanded_Priority_Attribute; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ee65d1b4789..9c1bd07b3f9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-08-12 Ed Schonberg + + * gnat.dg/renaming15.adb: New testcase. + 2019-08-12 Eric Botcazou * gnat.dg/slice10.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/renaming15.adb b/gcc/testsuite/gnat.dg/renaming15.adb new file mode 100644 index 00000000000..a0b13cdea81 --- /dev/null +++ b/gcc/testsuite/gnat.dg/renaming15.adb @@ -0,0 +1,32 @@ +-- { dg-do compile } + +with Ada.Containers.Hashed_Maps; +with Ada.Text_IO; + +procedure Renaming15 is + use Ada.Containers; + + subtype String_T is String (1 .. 3); + + function Hash (Aircraft_Id : Integer) return Hash_Type is + (Hash_Type (Aircraft_Id) * (2 ** 31 - 1)); + function Equal (Left, Right : Integer) return Boolean is (Left = Right); + package Radar_Map is new Hashed_Maps (Integer, String_T, Hash, Equal); + + Radars : Radar_Map.Map; + + procedure Change_Elem_Value is + begin + for C in Radars.Iterate loop + declare + E : String_T renames Radar_Map.Element (C); + begin + E := "Xyz"; -- { dg-error "left hand side of assignment must be a variable" } + Ada.Text_IO.Put_Line (E); + end; + end loop; + end Change_Elem_Value; +begin + Radars.Include (1, "jjj"); + Change_Elem_Value; +end Renaming15; -- 2.30.2