freeze.adb: Make Freeze_Fixed_Point_Type visible, for use in sem_attr.

* freeze.adb: Make Freeze_Fixed_Point_Type visible, for use in
	sem_attr.

	* sem_attr.adb: Simplify previous fix for Address.
	(Set_Bounds): If prefix is a non-frozen fixed-point type, freeze now,
	to avoid anomalies where the bound of the type appears to raise
	constraint error.

	* lib-xref.adb (Output_Refs): Make sure pointers are always properly
	handled.

	* sem_ch12.adb (Analyze_Subprogram_Instantiation): Check for a
	renamed unit before checking for recursive instantiations.

	* prj.ads: Add comments for some of the fields.

From-SVN: r47902
This commit is contained in:
Geert Bosch 2001-12-12 00:01:00 +01:00
parent 0873bafcaa
commit 7fb754a1ad
6 changed files with 60 additions and 19 deletions

View File

@ -1,3 +1,27 @@
2001-12-11 Ed Schonberg <schonber@gnat.com>
* freeze.adb: Make Freeze_Fixed_Point_Type visible, for use in
sem_attr.
* sem_attr.adb: Simplify previous fix for Address.
(Set_Bounds): If prefix is a non-frozen fixed-point type, freeze now,
to avoid anomalies where the bound of the type appears to raise
constraint error.
2001-12-11 Robert Dewar <dewar@gnat.com>
* lib-xref.adb (Output_Refs): Make sure pointers are always properly
handled.
2001-12-11 Ed Schonberg <schonber@gnat.com>
* sem_ch12.adb (Analyze_Subprogram_Instantiation): Check for a
renamed unit before checking for recursive instantiations.
2001-12-11 Emmanuel Briot <briot@gnat.com>
* prj.ads: Add comments for some of the fields.
2001-12-11 Robert Dewar <dewar@gnat.com> 2001-12-11 Robert Dewar <dewar@gnat.com>
* lib-xref.adb (Output_Refs): Don't output type references outside * lib-xref.adb (Output_Refs): Don't output type references outside
@ -23,7 +47,7 @@
* Makefile.in: Added g-diopit.o to GNATRTL_NONTASKING_OBJS * Makefile.in: Added g-diopit.o to GNATRTL_NONTASKING_OBJS
2001-12-11 Richard Kenner <dewar@gnat.com> 2001-12-11 Robert Dewar <dewar@gnat.com>
* sem_attr.adb: Minor reformatting * sem_attr.adb: Minor reformatting

View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.281 $ -- $Revision$
-- -- -- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- -- -- --
@ -105,11 +105,6 @@ package body Freeze is
-- that if a foreign convention is specified, and no specific size -- that if a foreign convention is specified, and no specific size
-- is given, then the size must be at least Integer'Size. -- is given, then the size must be at least Integer'Size.
procedure Freeze_Fixed_Point_Type (Typ : Entity_Id);
-- Freeze fixed point type. For fixed-point types, we have to defer
-- setting the size and bounds till the freeze point, since they are
-- potentially affected by the presence of size and small clauses.
procedure Freeze_Static_Object (E : Entity_Id); procedure Freeze_Static_Object (E : Entity_Id);
-- If an object is frozen which has Is_Statically_Allocated set, then -- If an object is frozen which has Is_Statically_Allocated set, then
-- all referenced types must also be marked with this flag. This routine -- all referenced types must also be marked with this flag. This routine

View File

@ -698,8 +698,15 @@ package body Lib.Xref is
if Tref /= Etype (Tref) then if Tref /= Etype (Tref) then
Tref := First_Subtype (Etype (Tref)); Tref := First_Subtype (Etype (Tref));
Left := '<';
Right := '>'; -- Set brackets for derived type, but don't
-- override pointer case since the fact that
-- something is a pointer is more important
if Left /= '(' then
Left := '<';
Right := '>';
end if;
-- If non-derived ptr, get designated type -- If non-derived ptr, get designated type

View File

@ -86,7 +86,8 @@ package Prj is
Value : String_Id := No_String; Value : String_Id := No_String;
end case; end case;
end record; end record;
-- Values for variables and array elements -- Values for variables and array elements.
-- Default is True if the current value is the default one for the variable
Nil_Variable_Value : constant Variable_Value := Nil_Variable_Value : constant Variable_Value :=
(Kind => Undefined, (Kind => Undefined,
@ -383,10 +384,14 @@ package Prj is
Include_Path : String_Access := null; Include_Path : String_Access := null;
-- The cached value of ADA_INCLUDE_PATH for this project file. -- The cached value of ADA_INCLUDE_PATH for this project file.
-- Set by gnatmake (prj.Env.Set_Ada_Paths). -- Set by gnatmake (prj.Env.Set_Ada_Paths).
-- Do not use this field directly outside of the compiler, use
-- Prj.Env.Ada_Source_Path instead.
Objects_Path : String_Access := null; Objects_Path : String_Access := null;
-- The cached value of ADA_OBJECTS_PATH for this project file. -- The cached value of ADA_OBJECTS_PATH for this project file.
-- Set by gnatmake (prj.Env.Set_Ada_Paths). -- Set by gnatmake (prj.Env.Set_Ada_Paths).
-- Do not use this field directly outside of the compiler, use
-- Prj.Env.Ada_Source_Path instead.
Config_File_Name : Name_Id := No_Name; Config_File_Name : Name_Id := No_Name;
-- The name of the configuration pragmas file, if any. -- The name of the configuration pragmas file, if any.

View File

@ -1555,8 +1555,7 @@ package body Sem_Attr is
then then
Set_Address_Taken (Entity (P)); Set_Address_Taken (Entity (P));
elsif ((Ekind (Entity (P)) = E_Task_Type elsif (Is_Concurrent_Type (Etype (Entity (P)))
or else Ekind (Entity (P)) = E_Protected_Type)
and then Etype (Entity (P)) = Base_Type (Entity (P))) and then Etype (Entity (P)) = Base_Type (Entity (P)))
or else Ekind (Entity (P)) = E_Package or else Ekind (Entity (P)) = E_Package
or else Is_Generic_Unit (Entity (P)) or else Is_Generic_Unit (Entity (P))
@ -3740,7 +3739,8 @@ package body Sem_Attr is
-- array subtype. Sets the variables Index_Lo and Index_Hi to the low -- array subtype. Sets the variables Index_Lo and Index_Hi to the low
-- and high bound expressions for the index referenced by the attribute -- and high bound expressions for the index referenced by the attribute
-- designator (i.e. the first index if no expression is present, and -- designator (i.e. the first index if no expression is present, and
-- the N'th index if the value N is present as an expression). -- the N'th index if the value N is present as an expression). Also
-- used for First and Last of scalar types.
--------------- ---------------
-- Aft_Value -- -- Aft_Value --
@ -4016,6 +4016,14 @@ package body Sem_Attr is
elsif Is_Scalar_Type (P_Type) then elsif Is_Scalar_Type (P_Type) then
Ityp := P_Type; Ityp := P_Type;
if Is_Fixed_Point_Type (P_Type)
and then not Is_Frozen (Base_Type (P_Type))
and then Compile_Time_Known_Value (Type_Low_Bound (P_Type))
and then Compile_Time_Known_Value (Type_High_Bound (P_Type))
then
Freeze_Fixed_Point_Type (Base_Type (P_Type));
end if;
-- For array case, get type of proper index -- For array case, get type of proper index
else else

View File

@ -3050,12 +3050,6 @@ package body Sem_Ch12 is
elsif In_Open_Scopes (Gen_Unit) then elsif In_Open_Scopes (Gen_Unit) then
Error_Msg_NE ("instantiation of & within itself", N, Gen_Unit); Error_Msg_NE ("instantiation of & within itself", N, Gen_Unit);
elsif Contains_Instance_Of (Gen_Unit, Current_Scope, Gen_Id) then
Error_Msg_Node_2 := Current_Scope;
Error_Msg_NE
("circular Instantiation: & instantiated in &!", N, Gen_Unit);
Circularity_Detected := True;
elsif K = E_Procedure elsif K = E_Procedure
and then Ekind (Gen_Unit) /= E_Generic_Procedure and then Ekind (Gen_Unit) /= E_Generic_Procedure
then then
@ -3090,6 +3084,14 @@ package body Sem_Ch12 is
Set_Entity (Gen_Id, Gen_Unit); Set_Entity (Gen_Id, Gen_Unit);
end if; end if;
if Contains_Instance_Of (Gen_Unit, Current_Scope, Gen_Id) then
Error_Msg_Node_2 := Current_Scope;
Error_Msg_NE
("circular Instantiation: & instantiated in &!", N, Gen_Unit);
Circularity_Detected := True;
return;
end if;
if In_Extended_Main_Source_Unit (N) then if In_Extended_Main_Source_Unit (N) then
Set_Is_Instantiated (Gen_Unit); Set_Is_Instantiated (Gen_Unit);
Generate_Reference (Gen_Unit, N); Generate_Reference (Gen_Unit, N);