+2011-08-04 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_util.ads, sem_unit.adb (Type_Without_Stream_Operation): determine
+ whether a type lacks user-defined Read or Write operations, or has a
+ component that lacks them.
+ * sem_attr.adb (Check_Stream_Attribute): if restriction
+ No_Default_Stream_Attributes is active, verify that all subcomponent
+ types of the target have user-defined stream operations, and report
+ error otherwise.
+ * exp_ch3.adb (Stream_Operqtion_OK): use Type_Without_Stream_Operation.
+ * exp_strm.adb: Build_Elementary_Input_Call,
+ Build_Elementary_Write_Call): remove checks for restriction
+ No_Default_Stream_Attributes, now checked in semantics.
+
+2011-08-04 Vincent Celier <celier@adacore.com>
+
+ * prj-conf.ads, prj-conf.adb (Do_Autoconf): If there is no --RTS
+ switches on the command line, look for all valid --RTS switches in the
+ Builder switches and for each language use the first runtime name found
+ to invoke gprconfig.
+ (Get_Or_Create_Configuration_File): Warn if --RTS is specified on the
+ command line and there is no auto-configuration.
+ (Runtime_Name_Set_For): New function.
+
+2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch7.adb (Build_Object_Declarations): Do not generate the
+ elaborate initialization expression for variable Abort when processing
+ a package body or a declaration.
+ (Create_Finalizer): Propagate the package context when creating the
+ exception-related variables.
+ * exp_ch7.ads (Build_Object_Declarations): New formal parameter
+ For_Package along with usage comment.
+
2011-08-04 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Makefile.in: Clean up targets.
is
Has_Predefined_Or_Specified_Stream_Attribute : Boolean := False;
- function Needs_Elementary_Stream_Operation
- (T : Entity_Id) return Boolean;
- -- AI05-0161 : if the restriction No_Default_Stream_Attributes is active
- -- then we can generate stream subprograms for records that have scalar
- -- subcomponents only if those subcomponents have user-defined stream
- -- subprograms. For elementary types only 'Read and 'Write are needed.
-
- ---------------------------------------
- -- Needs_Elementary_Stream_Operation --
- ---------------------------------------
-
- function Needs_Elementary_Stream_Operation
- (T : Entity_Id) return Boolean
- is
- begin
- if not Restriction_Active (No_Default_Stream_Attributes) then
- return False;
-
- elsif Is_Elementary_Type (T) then
- return No (TSS (T, TSS_Stream_Read))
- or else No (TSS (T, TSS_Stream_Write));
-
- elsif Is_Array_Type (T) then
- return Needs_Elementary_Stream_Operation (Component_Type (T));
-
- elsif Is_Record_Type (T) then
- declare
- Comp : Entity_Id;
-
- begin
- Comp := First_Component (T);
- while Present (Comp) loop
- if Needs_Elementary_Stream_Operation (Etype (Comp)) then
- return True;
- end if;
- Next_Component (Comp);
- end loop;
- return False;
- end;
-
- elsif Is_Private_Type (T)
- and then Present (Full_View (T))
- then
- return Needs_Elementary_Stream_Operation (Full_View (T));
-
- else
- return False;
- end if;
- end Needs_Elementary_Stream_Operation;
-
- -- Start processing for Stream_Operation_OK
-
begin
-- Special case of a limited type extension: a default implementation
-- of the stream attributes Read or Write exists if that attribute
and then not Restriction_Active (No_Dispatch)
and then not No_Run_Time_Mode
and then RTE_Available (RE_Tag)
- and then not Needs_Elementary_Stream_Operation (Typ)
+ and then No (Type_Without_Stream_Operation (Typ))
and then RTE_Available (RE_Root_Stream_Type)
and then not Is_RTE (Typ, RE_Finalization_Collection);
end Stream_Operation_OK;
and then Exceptions_OK
then
Prepend_List_To (Finalizer_Decls,
- Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id));
+ Build_Object_Declarations
+ (Loc, Abort_Id, E_Id, Raised_Id, For_Package));
end if;
-- Create the body of the finalizer
-------------------------------
function Build_Object_Declarations
- (Loc : Source_Ptr;
- Abort_Id : Entity_Id;
- E_Id : Entity_Id;
- Raised_Id : Entity_Id) return List_Id
+ (Loc : Source_Ptr;
+ Abort_Id : Entity_Id;
+ E_Id : Entity_Id;
+ Raised_Id : Entity_Id;
+ For_Package : Boolean := False) return List_Id
is
A_Expr : Node_Id;
E_Decl : Node_Id;
-- does not include routine Raise_From_Controlled_Operation which is the
-- the sole user of flag Abort.
+ -- This is not needed for library-level finalizers as they are called
+ -- by the environment task and cannot be aborted.
+
if Abort_Allowed
and then VM_Target = No_VM
+ and then not For_Package
then
declare
Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'E');
-- the controlling operations.
function Build_Object_Declarations
- (Loc : Source_Ptr;
- Abort_Id : Entity_Id;
- E_Id : Entity_Id;
- Raised_Id : Entity_Id) return List_Id;
+ (Loc : Source_Ptr;
+ Abort_Id : Entity_Id;
+ E_Id : Entity_Id;
+ Raised_Id : Entity_Id;
+ For_Package : Boolean := False) return List_Id;
-- Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Return a
-- list containing the object declarations of boolean flag Abort_Id, the
-- exception occurrence E_Id and boolean flag Raised_Id.
-- Exception_Identity (Get_Current_Excep.all) =
-- Standard'Abort_Signal'Identity;
-- <or>
- -- Abort_Id : constant Boolean := False; -- no abort
+ -- Abort_Id : constant Boolean := False; -- no abort or For_Package
--
-- E_Id : Exception_Occurrence;
-- Raised_Id : Boolean := False;
with Atree; use Atree;
with Einfo; use Einfo;
-with Errout; use Errout;
with Exp_Util; use Exp_Util;
with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
-with Restrict; use Restrict;
-with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem_Aux; use Sem_Aux;
with Sem_Util; use Sem_Util;
Lib_RE : RE_Id;
begin
- Check_Restriction (No_Default_Stream_Attributes, N);
-
- -- Are we sure following messages are issued in -gnatc mode ???
-
- if Restriction_Active (No_Default_Stream_Attributes) then
- Error_Msg_NE
- ("missing user-defined Input for type&", N, Etype (Targ));
- if Nkind (Targ) = N_Selected_Component then
- Error_Msg_NE
- ("\which is a component of type&", N, Etype (Prefix (Targ)));
- end if;
- end if;
-- Check first for Boolean and Character. These are enumeration types,
-- but we treat them specially, since they may require special handling
Libent : Entity_Id;
begin
- Check_Restriction (No_Default_Stream_Attributes, N);
-
- if Restriction_Active (No_Default_Stream_Attributes) then
- Error_Msg_NE
- ("missing user-defined Write for type&", N, Etype (Item));
- if Nkind (Item) = N_Selected_Component then
- Error_Msg_NE
- ("\which is a component of type&", N, Etype (Prefix (Item)));
- end if;
- end if;
-- Compute the size of the stream element. This is either the size of
-- the first subtype or if given the size of the Stream_Size attribute.
end loop;
declare
- Obj_Dir : constant String := Name_Buffer (1 .. Name_Len);
- Switches : Argument_List_Access := Get_Config_Switches;
- Args : Argument_List (1 .. 5);
- Arg_Last : Positive;
+ Obj_Dir : constant String := Name_Buffer (1 .. Name_Len);
+ Config_Switches : Argument_List_Access;
+ Args : Argument_List (1 .. 5);
+ Arg_Last : Positive;
Obj_Dir_Exists : Boolean := True;
end case;
end if;
+ -- If no switch --RTS have been specified on the command line,
+ -- look for --RTS switches in the Builder switches.
+
+ if RTS_Languages.Get_First = No_Name then
+ declare
+ Builder : constant Package_Id :=
+ Value_Of (Name_Builder, Project.Decl.Packages, Shared);
+ Switch_Array_Id : Array_Element_Id;
+ Switch_Array : Array_Element;
+
+ Switch_List : String_List_Id := Nil_String;
+ Switch : String_Element;
+
+ Lang : Name_Id;
+ Lang_Last : Positive;
+
+ begin
+ if Builder /= No_Package then
+ Switch_Array_Id :=
+ Value_Of
+ (Name => Name_Switches,
+ In_Arrays =>
+ Shared.Packages.Table (Builder).Decl.Arrays,
+ Shared => Shared);
+
+ while Switch_Array_Id /= No_Array_Element loop
+ Switch_Array :=
+ Shared.Array_Elements.Table (Switch_Array_Id);
+ Switch_List := Switch_Array.Value.Values;
+
+ while Switch_List /= Nil_String loop
+ Switch :=
+ Shared.String_Elements.Table (Switch_List);
+
+ if Switch.Value /= No_Name then
+ Get_Name_String (Switch.Value);
+
+ if Name_Len >= 7 and then
+ Name_Buffer (1 .. 5) = "--RTS"
+ then
+ if Name_Buffer (6) = '=' then
+ if not Runtime_Name_Set_For (Name_Ada) then
+ Set_Runtime_For
+ (Name_Ada,
+ Name_Buffer (7 .. Name_Len));
+ end if;
+
+ elsif Name_Len > 7 and then
+ Name_Buffer (6) = ':' and then
+ Name_Buffer (7) /= '='
+ then
+ Lang_Last := 7;
+ while Lang_Last < Name_Len and then
+ Name_Buffer (Lang_Last + 1) /= '='
+ loop
+ Lang_Last := Lang_Last + 1;
+ end loop;
+
+ if
+ Name_Buffer (Lang_Last + 1) = '='
+ then
+ declare
+ RTS : constant String :=
+ Name_Buffer (Lang_Last + 2 ..
+ Name_Len);
+ begin
+ Name_Buffer (1 .. Lang_Last - 6)
+ := Name_Buffer (7 .. Lang_Last);
+ Name_Len := Lang_Last - 6;
+ To_Lower
+ (Name_Buffer (1 .. Name_Len));
+ Lang := Name_Find;
+
+ if
+ not Runtime_Name_Set_For (Lang)
+ then
+ Set_Runtime_For (Lang, RTS);
+ end if;
+ end;
+ end if;
+ end if;
+ end if;
+ end if;
+
+ Switch_List := Switch.Next;
+ end loop;
+
+ Switch_Array_Id := Switch_Array.Next;
+ end loop;
+ end if;
+ end;
+ end if;
+
+ -- Get the config switches. This should be done only now, as some
+ -- runtimes may have been found if the Builder switches.
+
+ Config_Switches := Get_Config_Switches;
+
-- Invoke gprconfig
Args (1) := new String'("--batch");
Write_Str (Args (J).all);
end loop;
- for J in Switches'Range loop
+ for J in Config_Switches'Range loop
Write_Char (' ');
- Write_Str (Switches (J).all);
+ Write_Str (Config_Switches (J).all);
end loop;
Write_Eol;
end if;
end if;
- Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & Switches.all,
+ Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
+ Config_Switches.all,
Success);
- Free (Switches);
+ Free (Config_Switches);
Config_File_Path := Locate_Config_File (Args (3).all);
Do_Autoconf;
end if;
+
+ -- If the config file is not auto-generated, warn if there is any --RTS
+ -- switch on the command line.
+
+ elsif RTS_Languages.Get_First /= No_Name and then
+ Opt.Warning_Mode /= Opt.Suppress
+ then
+ Write_Line
+ ("warning: --RTS is taken into account only in auto-configuration");
end if;
-- Parse the configuration file
end if;
end Runtime_Name_For;
+ --------------------------
+ -- Runtime_Name_Set_For --
+ --------------------------
+
+ function Runtime_Name_Set_For (Language : Name_Id) return Boolean is
+ begin
+ return RTS_Languages.Get (Language) /= No_Name;
+ end Runtime_Name_Set_For;
+
---------------------
-- Set_Runtime_For --
---------------------
-- Returns the runtime name for a language. Returns an empty string if no
-- runtime was specified for the language using option --RTS.
+ function Runtime_Name_Set_For (Language : Name_Id) return Boolean;
+ -- Returns True only of Set_Runtime_For has been called for the Language
+
end Prj.Conf;
Check_Restriction (No_Streams, P);
end if;
+ -- AI05-0057: if restriction No_Default_Stream_Attributes is active,
+ -- it is illegal to use a predefined elementary type stream attribute
+ -- either by itself, or more importantly as part of the attribute
+ -- subprogram for a composite type.
+
+ if Restriction_Active (No_Default_Stream_Attributes) then
+ declare
+ T : Entity_Id;
+ begin
+ if Nam = TSS_Stream_Input
+ or else Nam = TSS_Stream_Read
+ then
+ T :=
+ Type_Without_Stream_Operation (P_Type, TSS_Stream_Read);
+ else
+ T :=
+ Type_Without_Stream_Operation (P_Type, TSS_Stream_Write);
+ end if;
+
+ if Present (T) then
+ Check_Restriction (No_Default_Stream_Attributes, N);
+
+ Error_Msg_NE
+ ("missing user-defined Stream Read or Write for type&",
+ N, T);
+ if not Is_Elementary_Type (P_Type) then
+ Error_Msg_NE
+ ("\which is a component of type&", N, P_Type);
+ end if;
+ end if;
+ end;
+ end if;
+
-- Check special case of Exception_Id and Exception_Occurrence which
-- are not allowed for restriction No_Exception_Registration.
with Elists; use Elists;
with Exp_Ch11; use Exp_Ch11;
with Exp_Disp; use Exp_Disp;
-with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Fname; use Fname;
with Freeze; use Freeze;
elsif Is_Record_Type (Btype) then
Component := First_Entity (Btype);
- while Present (Component) loop
+ while Present (Component)
+ and then Comes_From_Source (Component)
+ loop
-- Skip anonymous types generated by constrained components
return Scope_Depth (Enclosing_Dynamic_Scope (Btyp));
end Type_Access_Level;
+ ------------------------------------
+ -- Type_Without_Stream_Operation --
+ ------------------------------------
+
+ function Type_Without_Stream_Operation
+ (T : Entity_Id; Op : TSS_Name_Type := TSS_Null) return Entity_Id
+ is
+ BT : constant Entity_Id := Base_Type (T);
+ Op_Missing : Boolean;
+ begin
+ if not Restriction_Active (No_Default_Stream_Attributes) then
+ return Empty;
+ end if;
+
+ if Is_Elementary_Type (T) then
+ if Op = TSS_Null then
+ Op_Missing :=
+ No (TSS (BT, TSS_Stream_Read))
+ or else No (TSS (BT, TSS_Stream_Write));
+
+ else
+ Op_Missing := No (TSS (BT, Op));
+ end if;
+
+ if Op_Missing then
+ return T;
+
+ else
+ return Empty;
+ end if;
+
+ elsif Is_Array_Type (T) then
+ return Type_Without_Stream_Operation (Component_Type (T), Op);
+
+ elsif Is_Record_Type (T) then
+ declare
+ Comp : Entity_Id;
+ C_Typ : Entity_Id;
+
+ begin
+ Comp := First_Component (T);
+ while Present (Comp) loop
+ C_Typ := Type_Without_Stream_Operation (Etype (Comp), Op);
+ if Present (C_Typ) then
+ return C_Typ;
+ end if;
+
+ Next_Component (Comp);
+ end loop;
+
+ return Empty;
+ end;
+
+ elsif Is_Private_Type (T)
+ and then Present (Full_View (T))
+ then
+ return Type_Without_Stream_Operation (Full_View (T), Op);
+
+ else
+ return Empty;
+ end if;
+ end Type_Without_Stream_Operation;
+
----------------------------
-- Unique_Defining_Entity --
----------------------------
-- Package containing utility procedures used throughout the semantics
with Einfo; use Einfo;
+with Exp_Tss; use Exp_Tss;
with Namet; use Namet;
with Nmake; use Nmake;
with Snames; use Snames;
function Type_Access_Level (Typ : Entity_Id) return Uint;
-- Return the accessibility level of Typ
+ function Type_Without_Stream_Operation
+ (T : Entity_Id; Op : TSS_Name_Type := TSS_Null) return Entity_Id;
+ -- AI05-0161 : if the restriction No_Default_Stream_Attributes is active
+ -- then we cannot generate stream subprograms for composite types with
+ -- elementary subcomponents that lack user-defined stream subprograms.
+ -- This predicate determines whether a type has such an elementary
+ -- subcomponent. If Op is TSS_Null, a type that lacks either Read or Write
+ -- prevents the construction of a composite stream operation. If Op is
+ -- specified we check only for the given stream operation.
+
function Unique_Defining_Entity (N : Node_Id) return Entity_Id;
-- Return the entity which represents declaration N, so that matching
-- declaration and body have the same entity.
projects / gcc.git / commitdiff