+2009-09-16 Vincent Celier <celier@adacore.com>
+
+ * gprep.adb (Yes_No): New global constant
+ Unix_Line_Terminators: New global Boolean variable
+ (Process_One_File): Create the out file with a "Text_Translation=" form
+ that depends on the use of option -T.
+ (Scan_Command_Line): Add option -T
+ (Usage): Add line for option -T
+
+2009-09-16 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_disp.ads, exp_disp.adb (Is_Predefined_Internal_Operation): New
+ predicate that describes a proper subset of
+ Is_Predefined_Dispatching_Operation and excludes stream operations,
+ which can be overridden by the user.
+ * sem_ch6.adb (Create_Extra_Formals): use
+ Is_Predefined_Internal_Operation, so that stream operations get extra
+ formals.
+ * exp_ch6.adb (Prevent double generation of extra actuals in calls to
+ 'Input, which may be expanded twice, first as a function call and then
+ as a dispatching call.
+
2009-09-16 Thomas Quinot <quinot@adacore.com>
* s-oscons-tmplt.c (Target_OS, Target_Name): New constants.
when N_Attribute_Reference =>
case Get_Attribute_Id (Attribute_Name (Prev_Orig)) is
- -- For X'Access, pass on the level of the prefix X
+ -- For X'Access, pass on the level of the prefix X.
+ -- If the call is a rewritten attribute reference to
+ -- 'Input and the prefix is a tagged type, prevent
+ -- double expansion (once as a function call and once
+ -- as a dispatching call)
when Attribute_Access =>
- Add_Extra_Actual
- (Make_Integer_Literal (Loc,
- Intval =>
- Object_Access_Level (Prefix (Prev_Orig))),
- Extra_Accessibility (Formal));
+ declare
+ Onode : constant Node_Id :=
+ Original_Node (Parent (N));
+ begin
+ if Nkind (Onode) = N_Attribute_Reference
+ and then Attribute_Name (Onode) = Name_Input
+ and then Is_Tagged_Type (Etype (Subp))
+ then
+ null;
+ else
+ Add_Extra_Actual
+ (Make_Integer_Literal (Loc,
+ Intval =>
+ Object_Access_Level
+ (Prefix (Prev_Orig))),
+ Extra_Accessibility (Formal));
+ end if;
+ end;
-- Treat the unchecked attributes as library-level
(Make_Integer_Literal (Loc,
Intval => Type_Access_Level (Etype (Prev))),
Extra_Accessibility (Formal));
-
end case;
end if;
end if;
return False;
end Is_Predefined_Dispatching_Operation;
+ ---------------------------------------
+ -- Is_Predefined_Internal_Operation --
+ ---------------------------------------
+
+ function Is_Predefined_Internal_Operation
+ (E : Entity_Id) return Boolean
+ is
+ TSS_Name : TSS_Name_Type;
+
+ begin
+ if not Is_Dispatching_Operation (E) then
+ return False;
+ end if;
+
+ Get_Name_String (Chars (E));
+
+ -- Most predefined primitives have internally generated names. Equality
+ -- must be treated differently; the predefined operation is recognized
+ -- as a homogeneous binary operator that returns Boolean.
+
+ if Name_Len > TSS_Name_Type'Last then
+ TSS_Name :=
+ TSS_Name_Type
+ (Name_Buffer (Name_Len - TSS_Name'Length + 1 .. Name_Len));
+
+ if Chars (E) = Name_uSize
+ or else Chars (E) = Name_uAlignment
+ or else
+ (Chars (E) = Name_Op_Eq
+ and then Etype (First_Entity (E)) = Etype (Last_Entity (E)))
+ or else Chars (E) = Name_uAssign
+ or else TSS_Name = TSS_Deep_Adjust
+ or else TSS_Name = TSS_Deep_Finalize
+ or else Is_Predefined_Interface_Primitive (E)
+ then
+ return True;
+ end if;
+ end if;
+
+ return False;
+ end Is_Predefined_Internal_Operation;
+
-------------------------------------
-- Is_Predefined_Dispatching_Alias --
-------------------------------------
function Is_Predefined_Dispatching_Operation (E : Entity_Id) return Boolean;
-- Ada 2005 (AI-251): Determines if E is a predefined primitive operation
+ function Is_Predefined_Internal_Operation (E : Entity_Id) return Boolean;
+ -- Similar to the previous one, but excludes stream operations, because
+ -- these may be overridden, and need extra formals, like user-defined
+ -- operations.
+
function Is_Predefined_Interface_Primitive (E : Entity_Id) return Boolean;
-- Ada 2005 (AI-345): Returns True if E is one of the predefined primitives
-- required to implement interfaces.
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2009, 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- --
-- Argument Line Data --
------------------------
+ Unix_Line_Terminators : Boolean := False;
+ -- Set to True with option -T
+
+ type String_Array is array (Boolean) of String_Access;
+ Yes_No : constant String_Array :=
+ (False => new String'("YES"),
+ True => new String'("NO"));
+
Infile_Name : Name_Id := No_Name;
Outfile_Name : Name_Id := No_Name;
Deffile_Name : Name_Id := No_Name;
-- Create the output file (fails if this does not work)
begin
- Create (Text_Outfile, Out_File, Get_Name_String (Outfile_Name));
+ Create
+ (File => Text_Outfile,
+ Mode => Out_File,
+ Name => Get_Name_String (Outfile_Name),
+ Form => "Text_Translation=" &
+ Yes_No (Unix_Line_Terminators).all);
exception
when others =>
loop
begin
- Switch := GNAT.Command_Line.Getopt ("D: b c C r s u v");
+ Switch := GNAT.Command_Line.Getopt ("D: b c C r s T u v");
case Switch is
when 's' =>
Opt.List_Preprocessing_Symbols := True;
+ when 'T' =>
+ Unix_Line_Terminators := True;
+
when 'u' =>
Opt.Undefined_Symbols_Are_False := True;
Write_Line (" -D Associate symbol with value");
Write_Line (" -r Generate Source_Reference pragma");
Write_Line (" -s Print a sorted list of symbol names and values");
+ Write_Line (" -T Use LF as line terminators");
Write_Line (" -u Treat undefined symbols as FALSE");
Write_Line (" -v Verbose mode");
Write_Eol;
-- generated stream attributes do get passed through because extra
-- build-in-place formals are needed in some cases (limited 'Input).
- if Is_Predefined_Dispatching_Operation (E) then
+ if Is_Predefined_Internal_Operation (E) then
goto Test_For_BIP_Extras;
end if;
projects / thirdparty / gcc.git / commitdiff
