Skip to content

R
riscv-gcc-1
Commit ec53a6da by Javier Miranda Committed by Arnaud Charlet
Options

itypes.ads, itypes.adb (Create_Null_Excluding_Itype): New subprogram that given… 

itypes.ads, itypes.adb (Create_Null_Excluding_Itype): New subprogram that given an entity T creates and returns an Itype that...

2005-09-01  Javier Miranda  <miranda@adacore.com>

	* itypes.ads, itypes.adb (Create_Null_Excluding_Itype): New subprogram
	that given an entity T creates and returns an Itype that duplicates the
	contents of T. The returned Itype has the null-exclusion
	attribute set to True, and its Etype attribute references T
	to keep the association between the two entities.
	Update copyright notice

	* sem_aggr.adb (Check_Can_Never_Be_Null,
	Aggregate_Constraint_Checks, Resolve_Aggregate,
	Resolve_Array_Aggregate, Resolve_Record_Aggregate): Code cleanup.

	* sem_ch5.adb (Analyze_Assignment): Code cleanup.

From-SVN: r103868
parent 1f5a9324
Showing with 82 additions and 18 deletions
gcc/ada/itypes.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 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- --
......@@ -25,10 +25,8 @@
------------------------------------------------------------------------------
with Atree; use Atree;
with Einfo; use Einfo;
with Opt; use Opt;
with Sem; use Sem;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Stand; use Stand;
......@@ -74,4 +72,40 @@ package body Itypes is
return Typ;
end Create_Itype;
---------------------------------
-- Create_Null_Excluding_Itype --
---------------------------------
function Create_Null_Excluding_Itype
(T : Entity_Id;
Related_Nod : Node_Id;
Scope_Id : Entity_Id := Current_Scope) return Entity_Id
is
I_Typ : Entity_Id;
begin
pragma Assert (Is_Access_Type (T));
I_Typ := Create_Itype (Ekind => E_Access_Subtype,
Related_Nod => Related_Nod,
Scope_Id => Scope_Id);
Set_Directly_Designated_Type (I_Typ,
Directly_Designated_Type (T));
Set_Etype (I_Typ, T);
Init_Size_Align (I_Typ);
Set_Depends_On_Private (I_Typ, Depends_On_Private (T));
Set_Is_Public (I_Typ, Is_Public (T));
Set_From_With_Type (I_Typ, From_With_Type (T));
Set_Is_Access_Constant (I_Typ, Is_Access_Constant (T));
Set_Is_Generic_Type (I_Typ, Is_Generic_Type (T));
Set_Is_Volatile (I_Typ, Is_Volatile (T));
Set_Treat_As_Volatile (I_Typ, Treat_As_Volatile (T));
Set_Is_Atomic (I_Typ, Is_Atomic (T));
Set_Is_Ada_2005 (I_Typ, Is_Ada_2005 (T));
Set_Can_Never_Be_Null (I_Typ);
return I_Typ;
end Create_Null_Excluding_Itype;
end Itypes;
gcc/ada/itypes.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 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- --
......@@ -110,4 +110,32 @@ package Itypes is
-- The Scope_Id parameter specifies the scope of the created type, and
-- is normally the Current_Scope as shown, but can be set otherwise.
---------------------------------
-- Create_Null_Excluding_Itype --
---------------------------------
function Create_Null_Excluding_Itype
(T : Entity_Id;
Related_Nod : Node_Id;
Scope_Id : Entity_Id := Current_Scope) return Entity_Id;
-- Ada 2005 (AI-231): T is an access type and this subprogram creates and
-- returns an internal access-subtype declaration of T that has the null
-- exclusion attribute set to True.
--
-- Usage of null-excluding itypes
-- ------------------------------
--
-- type T1 is access ...
-- type T2 is not null T1;
--
-- type Rec is record
-- Comp : not null T1;
-- end record;
--
-- type Arr is array (...) of not null T1;
--
-- Instead of associating the not-null attribute with the defining ids of
-- these declarations, we generate an internal subtype declaration of T1
-- that has the null exclusion attribute set to true.
end Itypes;
gcc/ada/sem_ch5.adb
......@@ -375,9 +375,7 @@ package body Sem_Ch5 is
T2 := Etype (Rhs);
if Covers (T1, T2) then
null;
else
if not Covers (T1, T2) then
Wrong_Type (Rhs, Etype (Lhs));
return;
end if;
......@@ -448,17 +446,21 @@ package body Sem_Ch5 is
-- Ada 2005 (AI-231)
if Ada_Version >= Ada_05
and then Nkind (Rhs) = N_Null
and then Is_Access_Type (T1)
and then Can_Never_Be_Null (T1)
and then not Assignment_OK (Lhs)
and then ((Is_Entity_Name (Lhs)
and then Can_Never_Be_Null (Entity (Lhs)))
or else Can_Never_Be_Null (Etype (Lhs)))
then
Apply_Compile_Time_Constraint_Error
(N => Lhs,
Msg => "(Ada 2005) NULL not allowed in null-excluding objects?",
Reason => CE_Null_Not_Allowed);
if Nkind (Rhs) = N_Null then
Apply_Compile_Time_Constraint_Error
(N => Rhs,
Msg => "(Ada 2005) NULL not allowed in null-excluding objects?",
Reason => CE_Null_Not_Allowed);
return;
elsif not Can_Never_Be_Null (T2) then
Rewrite (Rhs,
Convert_To (T1, Relocate_Node (Rhs)));
Analyze_And_Resolve (Rhs, T1);
end if;
end if;
if Is_Scalar_Type (T1) then
......@@ -550,7 +552,7 @@ package body Sem_Ch5 is
Ent := Entity (Lhs);
-- Capture value if save to do so
-- Capture value if safe to do so
if Safe_To_Capture_Value (N, Ent) then
Set_Current_Value (Ent, Rhs);
......@@ -1274,7 +1276,7 @@ package body Sem_Ch5 is
-- Start of processing for Process_Bounds
begin
-- Determine expected type of range by analyzing separate copy.
-- Determine expected type of range by analyzing separate copy
Set_Parent (R_Copy, Parent (R));
Pre_Analyze_And_Resolve (R_Copy);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment