From 7fb754a1ad3d542eca7724a944fa54e8bebbbff4 Mon Sep 17 00:00:00 2001 From: Geert Bosch Date: Wed, 12 Dec 2001 00:01:00 +0100 Subject: [PATCH] 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 --- gcc/ada/ChangeLog | 26 +++++++++++++++++++++++++- gcc/ada/freeze.adb | 7 +------ gcc/ada/lib-xref.adb | 11 +++++++++-- gcc/ada/prj.ads | 7 ++++++- gcc/ada/sem_attr.adb | 14 +++++++++++--- gcc/ada/sem_ch12.adb | 14 ++++++++------ 6 files changed, 60 insertions(+), 19 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4424fc425d6..5f65705ee64 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2001-12-11 Ed Schonberg + + * 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 + + * lib-xref.adb (Output_Refs): Make sure pointers are always properly + handled. + +2001-12-11 Ed Schonberg + + * sem_ch12.adb (Analyze_Subprogram_Instantiation): Check for a + renamed unit before checking for recursive instantiations. + +2001-12-11 Emmanuel Briot + + * prj.ads: Add comments for some of the fields. + 2001-12-11 Robert Dewar * 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 -2001-12-11 Richard Kenner +2001-12-11 Robert Dewar * sem_attr.adb: Minor reformatting diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 6f4c4c7c7c1..55a98104f57 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.281 $ +-- $Revision$ -- -- -- 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 -- 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); -- If an object is frozen which has Is_Statically_Allocated set, then -- all referenced types must also be marked with this flag. This routine diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index c49866f4af2..c5b5b7d532c 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -698,8 +698,15 @@ package body Lib.Xref is if Tref /= Etype (Tref) then 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 diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 2eeb5a03c74..d4b47784445 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -86,7 +86,8 @@ package Prj is Value : String_Id := No_String; end case; 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 := (Kind => Undefined, @@ -383,10 +384,14 @@ package Prj is Include_Path : String_Access := null; -- The cached value of ADA_INCLUDE_PATH for this project file. -- 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; -- The cached value of ADA_OBJECTS_PATH for this project file. -- 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; -- The name of the configuration pragmas file, if any. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index c0bc236c822..a8e2306d816 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1555,8 +1555,7 @@ package body Sem_Attr is then Set_Address_Taken (Entity (P)); - elsif ((Ekind (Entity (P)) = E_Task_Type - or else Ekind (Entity (P)) = E_Protected_Type) + elsif (Is_Concurrent_Type (Etype (Entity (P))) and then Etype (Entity (P)) = Base_Type (Entity (P))) or else Ekind (Entity (P)) = E_Package 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 -- and high bound expressions for the index referenced by the attribute -- 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 -- @@ -4016,6 +4016,14 @@ package body Sem_Attr is elsif Is_Scalar_Type (P_Type) then 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 else diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 2f821b1c72b..71604f68c56 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3050,12 +3050,6 @@ package body Sem_Ch12 is elsif In_Open_Scopes (Gen_Unit) then 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 and then Ekind (Gen_Unit) /= E_Generic_Procedure then @@ -3090,6 +3084,14 @@ package body Sem_Ch12 is Set_Entity (Gen_Id, Gen_Unit); 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 Set_Is_Instantiated (Gen_Unit); Generate_Reference (Gen_Unit, N); -- 2.30.2