OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2015-05-26  Doug Rupp  <rupp@adacore.com>

	* init.c [vxworks]: Refine previous checkin.

2015-05-26  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Wrap_MA): New function.
	(Expand_N_Op_Expon): Use Wrap_MA.

2015-05-26  Bob Duff  <duff@adacore.com>

	* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
	Do not use secondary stack to return limited records with
	defaulted discriminants. This is an efficiency improvement.
	* exp_ch6.adb, exp_dist.adb, sem_attr.adb, sem_aux.adb, sem_aux.ads,
	sem_ch12.adb, sem_ch3.adb, sem_ch4.adb, sem_ch6.adb, sem_ch7.adb,
	sem_util.adb: Change the sense of Is_Indefinite_Subtype to be
	Is_Definite_Subtype. This is an improvement to readability (the double
	negative in "not Is_Indefinite_Subtype" was slightly confusing). Also
	disallow passing non-[sub]type entities, an unnecessary and slightly
	bug-prone flexibility.

From-SVN: r223679
This commit is contained in:
Arnaud Charlet 2015-05-26 12:35:14 +02:00
parent 596b25f9a1
commit 8349613899
14 changed files with 184 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/ada/ChangeLog
View File

@ -1,3 +1,25 @@
2015-05-26 Doug Rupp <rupp@adacore.com>
* init.c [vxworks]: Refine previous checkin.
2015-05-26 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Wrap_MA): New function.
(Expand_N_Op_Expon): Use Wrap_MA.
2015-05-26 Bob Duff <duff@adacore.com>
* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
Do not use secondary stack to return limited records with
defaulted discriminants. This is an efficiency improvement.
* exp_ch6.adb, exp_dist.adb, sem_attr.adb, sem_aux.adb, sem_aux.ads,
sem_ch12.adb, sem_ch3.adb, sem_ch4.adb, sem_ch6.adb, sem_ch7.adb,
sem_util.adb: Change the sense of Is_Indefinite_Subtype to be
Is_Definite_Subtype. This is an improvement to readability (the double
negative in "not Is_Indefinite_Subtype" was slightly confusing). Also
disallow passing non-[sub]type entities, an unnecessary and slightly
bug-prone flexibility.
2015-05-26 Robert Dewar <dewar@adacore.com>
* sem_aggr.adb (Resolve_Array_Aggregate): Defend against

118
gcc/ada/exp_ch4.adb
View File

@ -7580,6 +7580,33 @@ package body Exp_Ch4 is
Etyp : Entity_Id;
Xnode : Node_Id;
function Wrap_MA (Exp : Node_Id) return Node_Id;
-- Given an expression Exp, if the root type is Float or Long_Float,
-- then wrap the expression in a call of Bastyp'Machine, to stop any
-- extra precision. This is done to ensure that X**A = X**B when A is
-- a static constant and B is a variable with the same value. For any
-- other type, the node Exp is returned unchanged.
-------------
-- Wrap_MA --
-------------
function Wrap_MA (Exp : Node_Id) return Node_Id is
Loc : constant Source_Ptr := Sloc (Exp);
begin
if Rtyp = Standard_Float or else Rtyp = Standard_Long_Float then
return
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Machine,
Prefix => New_Occurrence_Of (Bastyp, Loc),
Expressions => New_List (Relocate_Node (Exp)));
else
return Exp;
end if;
end Wrap_MA;
-- Start of processing for Expand_N_Op
begin
Binary_Op_Validity_Checks (N);
@ -7637,7 +7664,7 @@ package body Exp_Ch4 is
-- could fold small negative exponents for the real case, but we
-- can't because we are required to raise Constraint_Error for
-- the case of 0.0 ** (negative) even if Machine_Overflows = False.
-- See ACVC test C4A012B.
-- See ACVC test C4A012B, and it is not worth generating the test.
if Expv >= 0 and then Expv <= 4 then
@ -7666,20 +7693,22 @@ package body Exp_Ch4 is
elsif Expv = 2 then
Xnode :=
Make_Op_Multiply (Loc,
Left_Opnd => Duplicate_Subexpr (Base),
Right_Opnd => Duplicate_Subexpr_No_Checks (Base));
Wrap_MA (
Make_Op_Multiply (Loc,
Left_Opnd => Duplicate_Subexpr (Base),
Right_Opnd => Duplicate_Subexpr_No_Checks (Base)));
-- X ** 3 = X * X * X
elsif Expv = 3 then
Xnode :=
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Op_Multiply (Loc,
Left_Opnd => Duplicate_Subexpr (Base),
Right_Opnd => Duplicate_Subexpr_No_Checks (Base)),
Right_Opnd => Duplicate_Subexpr_No_Checks (Base));
Wrap_MA (
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Op_Multiply (Loc,
Left_Opnd => Duplicate_Subexpr (Base),
Right_Opnd => Duplicate_Subexpr_No_Checks (Base)),
Right_Opnd => Duplicate_Subexpr_No_Checks (Base)));
-- X ** 4 ->
@ -7700,16 +7729,18 @@ package body Exp_Ch4 is
Constant_Present => True,
Object_Definition => New_Occurrence_Of (Typ, Loc),
Expression =>
Make_Op_Multiply (Loc,
Left_Opnd =>
Duplicate_Subexpr (Base),
Right_Opnd =>
Duplicate_Subexpr_No_Checks (Base)))),
Wrap_MA (
Make_Op_Multiply (Loc,
Left_Opnd =>
Duplicate_Subexpr (Base),
Right_Opnd =>
Duplicate_Subexpr_No_Checks (Base))))),
Expression =>
Make_Op_Multiply (Loc,
Left_Opnd => New_Occurrence_Of (Temp, Loc),
Right_Opnd => New_Occurrence_Of (Temp, Loc)));
Wrap_MA (
Make_Op_Multiply (Loc,
Left_Opnd => New_Occurrence_Of (Temp, Loc),
Right_Opnd => New_Occurrence_Of (Temp, Loc))));
end if;
Rewrite (N, Xnode);
@ -7900,10 +7931,10 @@ package body Exp_Ch4 is
if Is_Modular_Integer_Type (Rtyp) then
-- Nonbinary case, we call the special exponentiation routine for
-- the nonbinary case, converting the argument to Long_Long_Integer
-- and passing the modulus value. Then the result is converted back
-- to the base type.
-- Nonbinary modular case, we call the special exponentiation
-- routine for the nonbinary case, converting the argument to
-- Long_Long_Integer and passing the modulus value. Then the
-- result is converted back to the base type.
if Non_Binary_Modulus (Rtyp) then
Rewrite (N,
@ -7916,9 +7947,9 @@ package body Exp_Ch4 is
Make_Integer_Literal (Loc, Modulus (Rtyp)),
Exp))));
-- Binary case, in this case, we call one of two routines, either the
-- unsigned integer case, or the unsigned long long integer case,
-- with a final "and" operation to do the required mod.
-- Binary modular case, in this case, we call one of two routines,
-- either the unsigned integer case, or the unsigned long long
-- integer case, with a final "and" operation to do the required mod.
else
if UI_To_Int (Esize (Rtyp)) <= Standard_Integer_Size then
@ -7986,16 +8017,32 @@ package body Exp_Ch4 is
Rent := RE_Exn_Integer;
end if;
-- Floating-point cases, always done using Long_Long_Float. We do not
-- need separate routines for the overflow case here, since in the case
-- of floating-point, we generate infinities anyway as a rule (either
-- that or we automatically trap overflow), and if there is an infinity
-- generated and a range check is required, the check will fail anyway.
-- Floating-point cases. We do not need separate routines for the
-- overflow case here, since in the case of floating-point, we generate
-- infinities anyway as a rule (either that or we automatically trap
-- overflow), and if there is an infinity generated and a range check
-- is required, the check will fail anyway.
-- Historical note: we used to convert everything to Long_Long_Float
-- and call a single common routine, but this had the undesirable effect
-- of giving different results for small static exponent values and the
-- same dynamic values.
else
pragma Assert (Is_Floating_Point_Type (Rtyp));
Etyp := Standard_Long_Long_Float;
Rent := RE_Exn_Long_Long_Float;
if Rtyp = Standard_Float then
Etyp := Standard_Float;
Rent := RE_Exn_Float;
elsif Rtyp = Standard_Long_Float then
Etyp := Standard_Long_Float;
Rent := RE_Exn_Long_Float;
else
Etyp := Standard_Long_Long_Float;
Rent := RE_Exn_Long_Long_Float;
end if;
end if;
-- Common processing for integer cases and floating-point cases.
@ -8006,9 +8053,10 @@ package body Exp_Ch4 is
and then Rtyp /= Universal_Real
then
Rewrite (N,
Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (Rent), Loc),
Parameter_Associations => New_List (Base, Exp)));
Wrap_MA (
Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (Rent), Loc),
Parameter_Associations => New_List (Base, Exp))));
-- Otherwise we have to introduce conversions (conversions are also
-- required in the universal cases, since the runtime routine is

28
gcc/ada/exp_ch6.adb
View File

@ -8856,6 +8856,7 @@ package body Exp_Ch6 is
Pass_Caller_Acc : Boolean := False;
Res_Decl : Node_Id;
Result_Subt : Entity_Id;
Definite : Boolean; -- True for definite function result subtype
begin
-- Step past qualification or unchecked conversion (the latter can occur
@ -8892,6 +8893,7 @@ package body Exp_Ch6 is
end if;
Result_Subt := Etype (Function_Id);
Definite := Is_Definite_Subtype (Underlying_Type (Result_Subt));
-- Create an access type designating the function's result subtype. We
-- use the type of the original call because it may be a call to an
@ -8912,7 +8914,7 @@ package body Exp_Ch6 is
-- The access type and its accompanying object must be inserted after
-- the object declaration in the constrained case, so that the function
-- call can be passed access to the object. In the unconstrained case,
-- call can be passed access to the object. In the indefinite case,
-- or if the object declaration is for a return object, the access type
-- and object must be inserted before the object, since the object
-- declaration is rewritten to be a renaming of a dereference of the
@ -8920,7 +8922,7 @@ package body Exp_Ch6 is
-- the result object is in a different (transient) scope, so won't
-- cause freezing.
if Is_Constrained (Underlying_Type (Result_Subt))
if Definite
and then not Is_Return_Object (Defining_Identifier (Object_Decl))
then
Insert_After_And_Analyze (Object_Decl, Ptr_Typ_Decl);
@ -8944,7 +8946,7 @@ package body Exp_Ch6 is
-- function, then the implicit build-in-place parameters of the
-- enclosing function are simply passed along to the called function.
-- (Unfortunately, this won't cover the case of extension aggregates
-- where the ancestor part is a build-in-place unconstrained function
-- where the ancestor part is a build-in-place indefinite function
-- call that should be passed along the caller's parameters. Currently
-- those get mishandled by reassigning the result of the call to the
-- aggregate return object, when the call result should really be
@ -8980,7 +8982,7 @@ package body Exp_Ch6 is
Loc),
Pool_Actual => Pool_Actual);
-- Otherwise, if enclosing function has a constrained result subtype,
-- Otherwise, if enclosing function has a definite result subtype,
-- then caller allocation will be used.
else
@ -9010,12 +9012,12 @@ package body Exp_Ch6 is
(Build_In_Place_Formal (Enclosing_Func, BIP_Object_Access),
Loc));
-- In the constrained case, add an implicit actual to the function call
-- In the definite case, add an implicit actual to the function call
-- that provides access to the declared object. An unchecked conversion
-- to the (specific) result type of the function is inserted to handle
-- the case where the object is declared with a class-wide type.
elsif Is_Constrained (Underlying_Type (Result_Subt)) then
elsif Definite then
Caller_Object :=
Make_Unchecked_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Result_Subt, Loc),
@ -9025,12 +9027,12 @@ package body Exp_Ch6 is
-- parameter must be passed indicating that the caller is allocating
-- the result object. This is needed because such a function can be
-- called as a dispatching operation and must be treated similarly
-- to functions with unconstrained result subtypes.
-- to functions with indefinite result subtypes.
Add_Unconstrained_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
-- In other unconstrained cases, pass an indication to do the allocation
-- In other indefinite cases, pass an indication to do the allocation
-- on the secondary stack and set Caller_Object to Empty so that a null
-- value will be passed for the caller's object address. A transient
-- scope is established to ensure eventual cleanup of the result.
@ -9090,11 +9092,11 @@ package body Exp_Ch6 is
Insert_After_And_Analyze (Ptr_Typ_Decl, Res_Decl);
-- If the result subtype of the called function is constrained and
-- is not itself the return expression of an enclosing BIP function,
-- then mark the object as having no initialization.
-- If the result subtype of the called function is definite and is not
-- itself the return expression of an enclosing BIP function, then mark
-- the object as having no initialization.
if Is_Constrained (Underlying_Type (Result_Subt))
if Definite
and then not Is_Return_Object (Defining_Identifier (Object_Decl))
then
-- The related object declaration is encased in a transient block
@ -9118,7 +9120,7 @@ package body Exp_Ch6 is
Set_Expression (Object_Decl, Empty);
Set_No_Initialization (Object_Decl);
-- In case of an unconstrained result subtype, or if the call is the
-- In case of an indefinite result subtype, or if the call is the
-- return expression of an enclosing BIP function, rewrite the object
-- declaration as an object renaming where the renamed object is a
-- dereference of <function_Call>'reference:

4
gcc/ada/exp_dist.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -5437,7 +5437,7 @@ package body Exp_Dist is
return Out_Present (Parameter)
and then Has_Discriminants (Etyp)
and then not Is_Constrained (Etyp)
and then not Is_Indefinite_Subtype (Etyp);
and then Is_Definite_Subtype (Etyp);
end Need_Extra_Constrained;
------------------------------------

8
gcc/ada/init.c
View File

@ -1702,7 +1702,7 @@ __gnat_install_handler ()
#include <signal.h>
#include <taskLib.h>
#if defined (i386) || defined (__i386__)
#if (defined (i386) || defined (__i386__)) && !defined (VTHREADS)
#include <sysLib.h>
#endif
@ -1898,7 +1898,7 @@ __gnat_map_signal (int sig, siginfo_t *si ATTRIBUTE_UNUSED,
Raise_From_Signal_Handler (exception, msg);
}
#if defined (i386) || defined (__i386__)
#if (defined (i386) || defined (__i386__)) && !defined (VTHREADS)
extern void
__gnat_vxsim_error_handler (int sig, siginfo_t *si, void *sc);
@ -1929,7 +1929,7 @@ __gnat_error_handler (int sig, siginfo_t *si, void *sc)
necessary. This only incurs a few extra instructions and a tiny
amount of extra stack usage. */
#if defined (i386) || defined (__i386__)
#if (defined (i386) || defined (__i386__)) && !defined (VTHREADS)
/* On x86, the vxsim signal context is subtly different and is processeed
by a handler compiled especially for vxsim. */
@ -2021,7 +2021,7 @@ __gnat_install_handler (void)
trap_0_entry->inst_fourth = 0xa1480000;
#endif
#if defined (i386) || defined (__i386__)
#if (defined (i386) || defined (__i386__)) && !defined (VTHREADS)
/* By experiment, found that sysModel () returns the following string
prefix for vxsim when running on Linux and Windows. */
model = sysModel ();

4
gcc/ada/sem_attr.adb
View File

@ -2477,7 +2477,7 @@ package body Sem_Attr is
null;
elsif Is_Generic_Type (Entity (P)) then
if not Is_Indefinite_Subtype (Entity (P)) then
if Is_Definite_Subtype (Entity (P)) then
Error_Attr_P
("prefix of % attribute must be indefinite generic type");
end if;
@ -7929,7 +7929,7 @@ package body Sem_Attr is
when Attribute_Definite =>
Rewrite (N, New_Occurrence_Of (
Boolean_Literals (not Is_Indefinite_Subtype (P_Entity)), Loc));
Boolean_Literals (Is_Definite_Subtype (P_Entity)), Loc));
Analyze_And_Resolve (N, Standard_Boolean);
-----------

62
gcc/ada/sem_aux.adb
View File

@ -964,6 +964,36 @@ package body Sem_Aux is
end if;
end Is_By_Reference_Type;
---------------------------
-- Is_Definite_Subtype --
---------------------------
function Is_Definite_Subtype (T : Entity_Id) return Boolean is
pragma Assert (Is_Type (T));
K : constant Entity_Kind := Ekind (T);
begin
if Is_Constrained (T) then
return True;
elsif K in Array_Kind
or else K in Class_Wide_Kind
or else Has_Unknown_Discriminants (T)
then
return False;
-- Known discriminants: definite if there are default values. Note that
-- if any discriminant has a default, they all do.
elsif Has_Discriminants (T) then
return Present
(Discriminant_Default_Value (First_Discriminant (T)));
else
return True;
end if;
end Is_Definite_Subtype;
---------------------
-- Is_Derived_Type --
---------------------
@ -1075,38 +1105,6 @@ package body Sem_Aux is
end if;
end Is_Immutably_Limited_Type;
---------------------------
-- Is_Indefinite_Subtype --
---------------------------
function Is_Indefinite_Subtype (Ent : Entity_Id) return Boolean is
K : constant Entity_Kind := Ekind (Ent);
begin
if Is_Constrained (Ent) then
return False;
elsif K in Array_Kind
or else K in Class_Wide_Kind
or else Has_Unknown_Discriminants (Ent)
then
return True;
-- Known discriminants: indefinite if there are no default values
elsif K in Record_Kind
or else Is_Incomplete_Or_Private_Type (Ent)
or else Is_Concurrent_Type (Ent)
then
return (Has_Discriminants (Ent)
and then
No (Discriminant_Default_Value (First_Discriminant (Ent))));
else
return False;
end if;
end Is_Indefinite_Subtype;
---------------------
-- Is_Limited_Type --
---------------------

12
gcc/ada/sem_aux.ads
View File

@ -315,11 +315,13 @@ package Sem_Aux is
-- used to set the visibility of generic formals of a generic package
-- declared with a box or with partial parameterization.
function Is_Indefinite_Subtype (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Determines if given entity is an unconstrained array
-- type or subtype, a discriminated record type or subtype with no initial
-- discriminant values or a class wide type or subtype and returns True if
-- so. False for other type entities, or any entities that are not types.
function Is_Definite_Subtype (T : Entity_Id) return Boolean;
-- T is a type entity. Returns True if T is a definite subtype.
-- Indefinite subtypes are unconstrained arrays, unconstrained
-- discriminated types without defaulted discriminants, class-wide types,
-- and types with unknown discriminants. Definite subtypes are all others
-- (elementary, constrained composites (including the case of records
-- without discriminants), and types with defaulted discriminants).
function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean;
-- Implements definition in Ada 2012 RM-7.5 (8.1/3). This differs from the

10
gcc/ada/sem_ch12.adb
View File

@ -11869,12 +11869,12 @@ package body Sem_Ch12 is
-- It should not be necessary to check for unknown discriminants on
-- Formal, but for some reason Has_Unknown_Discriminants is false for
-- A_Gen_T, so Is_Indefinite_Subtype incorrectly returns False. This
-- A_Gen_T, so Is_Definite_Subtype incorrectly returns True. This
-- needs fixing. ???
if not Is_Indefinite_Subtype (A_Gen_T)
if Is_Definite_Subtype (A_Gen_T)
and then not Unknown_Discriminants_Present (Formal)
and then Is_Indefinite_Subtype (Act_T)
and then not Is_Definite_Subtype (Act_T)
then
Error_Msg_N ("actual subtype must be constrained", Actual);
Abandon_Instantiation (Actual);
@ -12371,8 +12371,8 @@ package body Sem_Ch12 is
("actual for & must have preelaborable initialization", Actual,
Gen_T);
elsif Is_Indefinite_Subtype (Act_T)
and then not Is_Indefinite_Subtype (A_Gen_T)
elsif not Is_Definite_Subtype (Act_T)
and then Is_Definite_Subtype (A_Gen_T)
and then Ada_Version >= Ada_95
then
Error_Msg_NE

13
gcc/ada/sem_ch3.adb
View File

@ -2023,7 +2023,7 @@ package body Sem_Ch3 is
-- The parent type may be a private view with unknown discriminants,
-- and thus unconstrained. Regular components must be constrained.
if Is_Indefinite_Subtype (T) and then Chars (Id) /= Name_uParent then
if not Is_Definite_Subtype (T) and then Chars (Id) /= Name_uParent then
if Is_Class_Wide_Type (T) then
Error_Msg_N
("class-wide subtype with unknown discriminants" &
@ -3936,7 +3936,7 @@ package body Sem_Ch3 is
-- Case of unconstrained type
if Is_Indefinite_Subtype (T) then
if not Is_Definite_Subtype (T) then
-- In SPARK, a declaration of unconstrained type is allowed
-- only for constants of type string.
@ -4263,7 +4263,8 @@ package body Sem_Ch3 is
and then Is_Record_Type (T)
and then not Is_Constrained (T)
and then Has_Discriminants (T)
and then (Ada_Version < Ada_2005 or else Is_Indefinite_Subtype (T))
and then (Ada_Version < Ada_2005
or else not Is_Definite_Subtype (T))
then
Set_Actual_Subtype (Id, Build_Default_Subtype (T, N));
end if;
@ -5730,7 +5731,7 @@ package body Sem_Ch3 is
-- that all the indexes are unconstrained but we still need to make sure
-- that the element type is constrained.
if Is_Indefinite_Subtype (Element_Type) then
if not Is_Definite_Subtype (Element_Type) then
Error_Msg_N
("unconstrained element type in array declaration",
Subtype_Indication (Component_Def));
@ -19568,8 +19569,8 @@ package body Sem_Ch3 is
-- not completed with an unconstrained type. A separate error message
-- is produced if the full type has defaulted discriminants.
if not Is_Indefinite_Subtype (Priv_T)
and then Is_Indefinite_Subtype (Full_T)
if Is_Definite_Subtype (Priv_T)
and then not Is_Definite_Subtype (Full_T)
then
Error_Msg_Sloc := Sloc (Parent (Priv_T));
Error_Msg_NE

4
gcc/ada/sem_ch4.adb
View File

@ -688,7 +688,7 @@ package body Sem_Ch4 is
-- had errors on analyzing the allocator, since in that case these
-- are probably cascaded errors.
if Is_Indefinite_Subtype (Type_Id)
if not Is_Definite_Subtype (Type_Id)
and then Serious_Errors_Detected = Sav_Errs
then
-- The build-in-place machinery may produce an allocator when
@ -698,7 +698,7 @@ package body Sem_Ch4 is
-- because the allocator is marked as coming from source.
if Present (Underlying_Type (Type_Id))
and then not Is_Indefinite_Subtype (Underlying_Type (Type_Id))
and then Is_Definite_Subtype (Underlying_Type (Type_Id))
and then not Comes_From_Source (Parent (N))
then
null;

2
gcc/ada/sem_ch6.adb
View File

@ -6825,7 +6825,7 @@ package body Sem_Ch6 is
if Has_Discriminants (Formal_Type)
and then not Is_Constrained (Formal_Type)
and then not Is_Indefinite_Subtype (Formal_Type)
and then Is_Definite_Subtype (Formal_Type)
and then (Ada_Version < Ada_2012
or else No (Underlying_Type (Formal_Type))
or else not

4
gcc/ada/sem_ch7.adb
View File

@ -2905,8 +2905,8 @@ package body Sem_Ch7 is
-- The following test may be redundant, as this is already
-- diagnosed in sem_ch3. ???
if Is_Indefinite_Subtype (Full)
and then not Is_Indefinite_Subtype (Id)
if not Is_Definite_Subtype (Full)
and then Is_Definite_Subtype (Id)
then
Error_Msg_Sloc := Sloc (Parent (Id));
Error_Msg_NE

4
gcc/ada/sem_util.adb
View File

@ -11204,7 +11204,7 @@ package body Sem_Util is
-- Ada 2005 (AI-363): In Ada 2005 an aliased object can be mutable
if not Is_Constrained (Prefix_Type)
and then (not Is_Indefinite_Subtype (Prefix_Type)
and then (Is_Definite_Subtype (Prefix_Type)
or else
(Is_Generic_Type (Prefix_Type)
and then Ekind (Current_Scope) = E_Generic_Package
@ -16871,7 +16871,7 @@ package body Sem_Util is
-- for declaring an object. It might be possible to relax this in the
-- future, e.g. by declaring the maximum possible space for the type.
elsif Is_Indefinite_Subtype (Typ) then
elsif not Is_Definite_Subtype (Typ) then
return True;
-- Functions returning tagged types may dispatch on result so their