From 50cff36721cc8783eb7ac2b350dc200688f8e0da Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Wed, 26 Mar 2008 08:39:04 +0100 Subject: [PATCH] exp_ch5.adb (Expand_N_Extended_Return_Statement): Suppress generation of a heap allocator for a limited unconstrained function... 2008-03-26 Gary Dismukes * exp_ch5.adb (Expand_N_Extended_Return_Statement): Suppress generation of a heap allocator for a limited unconstrained function return when resstriction No_Allocators is active. (Analyze_Allocator): The restriction No_Allocators is now only checked on allocators that have Comes_From_Source set, as per RM-H.4(7). * sem_ch4.adb (Expand_N_Extended_Return_Statement): Suppress generation of a heap allocator for a limited unconstrained function return when resstriction No_Allocators is active. (Analyze_Allocator): The restriction No_Allocators is now only checked on allocators that have Comes_From_Source set, as per RM-H.4(7). (Has_Fixed_Op): If the name in a function call is Standard."*" and the operands are fixed-point types, the universal_fixed predefined operation is used, regardless of whether the operand type (s) have a primitive operation of the same name. From-SVN: r133563 --- gcc/ada/exp_ch5.adb | 26 +++++++++++++++++++++++++- gcc/ada/sem_ch4.adb | 23 +++++++++++++++++++++-- 2 files changed, 46 insertions(+), 3 deletions(-) diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index e8619a152d1..24e7a7f08a1 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -2792,6 +2792,30 @@ package body Exp_Ch5 is SS_Allocator := New_Copy_Tree (Heap_Allocator); end if; + -- If the No_Allocators restriction is active, then only + -- an allocator for secondary stack allocation is needed. + + if Restriction_Active (No_Allocators) then + SS_Allocator := Heap_Allocator; + Heap_Allocator := Make_Null (Loc); + + -- Otherwise the heap allocator may be needed, so we + -- make another allocator for secondary stack allocation. + + else + SS_Allocator := New_Copy_Tree (Heap_Allocator); + + -- The heap allocator is marked Comes_From_Source + -- since it corresponds to an explicit user-written + -- allocator (that is, it will only be executed on + -- behalf of callers that call the function as + -- initialization for such an allocator). This + -- prevents errors when No_Implicit_Heap_Allocation + -- is in force. + + Set_Comes_From_Source (Heap_Allocator, True); + end if; + -- The allocator is returned on the secondary stack. We -- don't do this on VM targets, since the SS is not used. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 49a1699be51..e3d45f9e942 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -356,7 +356,12 @@ package body Sem_Ch4 is Type_Id : Entity_Id; begin - Check_Restriction (No_Allocators, N); + -- In accordance with H.4(7), the No_Allocators restriction only applies + -- to user-written allocators. + + if Comes_From_Source (N) then + Check_Restriction (No_Allocators, N); + end if; if Nkind (E) = N_Qualified_Expression then Acc_Type := Create_Itype (E_Allocator_Type, N); @@ -3811,6 +3816,10 @@ package body Sem_Ch4 is -- predefined operator. Used to implement Ada 2005 AI-264, to make -- such operators more visible and therefore useful. + -- If the name of the operation is an expanded name with prefix + -- Standard, the predefined universal fixed operator is available, + -- as specified by AI-420 (RM 4.5.5 (19.1/2)). + function Specific_Type (T1, T2 : Entity_Id) return Entity_Id; -- Get specific type (i.e. non-universal type if there is one) @@ -3825,6 +3834,16 @@ package body Sem_Ch4 is F2 : Entity_Id; begin + -- If the universal_fixed operation is given explicitly the rule + -- concerning primitive operations of the type do not apply. + + if Nkind (N) = N_Function_Call + and then Nkind (Name (N)) = N_Expanded_Name + and then Entity (Prefix (Name (N))) = Standard_Standard + then + return False; + end if; + -- The operation is treated as primitive if it is declared in the -- same scope as the type, and therefore on the same entity chain. -- 2.30.2