Commit 12577815 by Thomas Quinot Committed by Arnaud Charlet

sem_res.adb (Make_Call_Into_Operator): Use First_Subtype for better error…

sem_res.adb (Make_Call_Into_Operator): Use First_Subtype for better error reporting with generic types.

2010-06-22  Thomas Quinot  <quinot@adacore.com>

	* sem_res.adb (Make_Call_Into_Operator): Use First_Subtype for better
	error reporting with generic types.

2010-06-22  Thomas Quinot  <quinot@adacore.com>

	* bindgen.adb, bindusg.adb, gnatbind.adb, gnat_ugn.texi, opt.ads,
	osint-b.adb, osint-b.ads, output.adb, output.ads, switch-b.adb,
	vms_data.ads: Add a new command line switch -A to gnatbind to output
	the list of all ALI files for the partition.

From-SVN: r161153
parent a3da92f9
2010-06-22 Thomas Quinot <quinot@adacore.com>
* sem_res.adb (Make_Call_Into_Operator): Use First_Subtype for better
error reporting with generic types.
2010-06-22 Thomas Quinot <quinot@adacore.com>
* bindgen.adb, bindusg.adb, gnatbind.adb, gnat_ugn.texi, opt.ads,
osint-b.adb, osint-b.ads, output.adb, output.ads, switch-b.adb,
vms_data.ads: Add a new command line switch -A to gnatbind to output
the list of all ALI files for the partition.
2010-06-22 Arnaud Charlet <charlet@adacore.com> 2010-06-22 Arnaud Charlet <charlet@adacore.com>
* s-osinte-vxworks.ads: Fix casing. * s-osinte-vxworks.ads: Fix casing.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1936,6 +1936,10 @@ package body Bindgen is ...@@ -1936,6 +1936,10 @@ package body Bindgen is
WBI (""); WBI ("");
Write_Info_Ada_C ("-- ", "/* ", " BEGIN Object file/option list"); Write_Info_Ada_C ("-- ", "/* ", " BEGIN Object file/option list");
if Object_List_Filename /= null then
Set_List_File (Object_List_Filename.all);
end if;
for E in Elab_Order.First .. Elab_Order.Last loop for E in Elab_Order.First .. Elab_Order.Last loop
-- If not spec that has an associated body, then generate a -- If not spec that has an associated body, then generate a
...@@ -1985,6 +1989,10 @@ package body Bindgen is ...@@ -1985,6 +1989,10 @@ package body Bindgen is
end if; end if;
end loop; end loop;
if Object_List_Filename /= null then
Close_List_File;
end if;
-- Add a "-Ldir" for each directory in the object path -- Add a "-Ldir" for each directory in the object path
for J in 1 .. Nb_Dir_In_Obj_Search_Path loop for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -73,6 +73,10 @@ package body Bindusg is ...@@ -73,6 +73,10 @@ package body Bindusg is
Write_Line (" -a Automatically initialize elaboration " & Write_Line (" -a Automatically initialize elaboration " &
"procedure"); "procedure");
-- Line for -A switch
Write_Line (" -A Give list of ALI files in partition");
-- Line for -b switch -- Line for -b switch
Write_Line (" -b Generate brief messages to stderr " & Write_Line (" -b Generate brief messages to stderr " &
......
...@@ -8028,6 +8028,10 @@ Specify directory to be searched for ALI files. ...@@ -8028,6 +8028,10 @@ Specify directory to be searched for ALI files.
@cindex @option{^-aI^/SOURCE_SEARCH^} (@command{gnatbind}) @cindex @option{^-aI^/SOURCE_SEARCH^} (@command{gnatbind})
Specify directory to be searched for source file. Specify directory to be searched for source file.
@item ^-A^/ALI_LIST^@r{[=}@var{filename}@r{]}
@cindex @option{^-A^/ALI_LIST^} (@command{gnatbind})
Output ALI list (to standard output or to the named file).
@item ^-b^/REPORT_ERRORS=BRIEF^ @item ^-b^/REPORT_ERRORS=BRIEF^
@cindex @option{^-b^/REPORT_ERRORS=BRIEF^} (@command{gnatbind}) @cindex @option{^-b^/REPORT_ERRORS=BRIEF^} (@command{gnatbind})
Generate brief messages to @file{stderr} even if verbose mode set. Generate brief messages to @file{stderr} even if verbose mode set.
...@@ -8180,9 +8184,9 @@ Name the output file @var{file} (default is @file{b~@var{xxx}.adb}). ...@@ -8180,9 +8184,9 @@ Name the output file @var{file} (default is @file{b~@var{xxx}.adb}).
Note that if this option is used, then linking must be done manually, Note that if this option is used, then linking must be done manually,
gnatlink cannot be used. gnatlink cannot be used.
@item ^-O^/OBJECT_LIST^ @item ^-O^/OBJECT_LIST^@r{[=}@var{filename}@r{]}
@cindex @option{^-O^/OBJECT_LIST^} (@command{gnatbind}) @cindex @option{^-O^/OBJECT_LIST^} (@command{gnatbind})
Output object list. Output object list (to standard output or to the named file).
@item ^-p^/PESSIMISTIC_ELABORATION^ @item ^-p^/PESSIMISTIC_ELABORATION^
@cindex @option{^-p^/PESSIMISTIC_ELABORATION^} (@command{gnatbind}) @cindex @option{^-p^/PESSIMISTIC_ELABORATION^} (@command{gnatbind})
......
...@@ -738,7 +738,7 @@ begin ...@@ -738,7 +738,7 @@ begin
Free (Text); Free (Text);
end if; end if;
-- Acquire all information in ALI files that have been read in -- Load ALIs for all dependent units
for Index in ALIs.First .. ALIs.Last loop for Index in ALIs.First .. ALIs.Last loop
Read_Withed_ALIs (Index); Read_Withed_ALIs (Index);
...@@ -750,6 +750,32 @@ begin ...@@ -750,6 +750,32 @@ begin
raise Unrecoverable_Error; raise Unrecoverable_Error;
end if; end if;
-- Output list of ALI files in closure
if Output_ALI_List then
declare
FD : File_Descriptor;
begin
if ALI_List_Filename /= null then
Set_List_File (ALI_List_Filename.all);
end if;
for Index in ALIs.First .. ALIs.Last loop
declare
Full_Afile : constant File_Name_Type :=
Find_File (ALIs.Table (Index).Afile, Library);
begin
Write_Name (Full_Afile);
Write_Eol;
end;
end loop;
if ALI_List_Filename /= null then
Close_List_File;
end if;
end;
end if;
-- Build source file table from the ALI files we have read in -- Build source file table from the ALI files we have read in
Set_Source_Table; Set_Source_Table;
......
...@@ -951,9 +951,17 @@ package Opt is ...@@ -951,9 +951,17 @@ package Opt is
-- GNATBIND -- GNATBIND
-- True if output of list of linker options is requested (-K switch set) -- True if output of list of linker options is requested (-K switch set)
Output_Object_List : Boolean := False; Output_ALI_List : Boolean := False;
ALI_List_Filename : String_Ptr;
-- GNATBIND -- GNATBIND
-- True if output of list of objects is requested (-O switch set) -- True if output of list of ALIs is requested (-A switch set). List is
-- output under the given filename, or standard output if not specified.
Output_Object_List : Boolean := False;
Object_List_Filename : String_Ptr;
-- GNATBIND
-- True if output of list of objects is requested (-O switch set). List is
-- output under the given filename, or standard output if not specified.
Overflow_Checks_Unsuppressed : Boolean := False; Overflow_Checks_Unsuppressed : Boolean := False;
-- GNAT -- GNAT
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -24,10 +24,13 @@ ...@@ -24,10 +24,13 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Opt; use Opt; with Opt; use Opt;
with Output; use Output;
with Targparm; use Targparm; with Targparm; use Targparm;
package body Osint.B is package body Osint.B is
Current_List_File : File_Descriptor := Invalid_FD;
------------------------- -------------------------
-- Close_Binder_Output -- -- Close_Binder_Output --
------------------------- -------------------------
...@@ -45,6 +48,19 @@ package body Osint.B is ...@@ -45,6 +48,19 @@ package body Osint.B is
end Close_Binder_Output; end Close_Binder_Output;
---------------------
-- Close_List_File --
---------------------
procedure Close_List_File is
begin
if Current_List_File /= Invalid_FD then
Close (Current_List_File);
Current_List_File := Invalid_FD;
Set_Standard_Output;
end if;
end Close_List_File;
-------------------------- --------------------------
-- Create_Binder_Output -- -- Create_Binder_Output --
-------------------------- --------------------------
...@@ -65,8 +81,8 @@ package body Osint.B is ...@@ -65,8 +81,8 @@ package body Osint.B is
begin begin
if Output_File_Name /= "" then if Output_File_Name /= "" then
Name_Buffer (Output_File_Name'Range) := Output_File_Name; Name_Buffer (1 .. Output_File_Name'Length) := Output_File_Name;
Name_Buffer (Output_File_Name'Last + 1) := ASCII.NUL; Name_Buffer (Output_File_Name'Length + 1) := ASCII.NUL;
if Typ = 's' then if Typ = 's' then
Name_Buffer (Output_File_Name'Last) := 's'; Name_Buffer (Output_File_Name'Last) := 's';
...@@ -176,6 +192,19 @@ package body Osint.B is ...@@ -176,6 +192,19 @@ package body Osint.B is
Current_File_Name_Index := To; Current_File_Name_Index := To;
end Set_Current_File_Name_Index; end Set_Current_File_Name_Index;
procedure Set_List_File (Filename : String) is
begin
pragma Assert (Current_List_File = Invalid_FD);
Current_List_File := Create_File (Filename, Text);
if Current_List_File = Invalid_FD then
Fail ("cannot create list file: " & Filename);
else
Set_Output (Current_List_File);
end if;
end Set_List_File;
----------------------- -----------------------
-- Write_Binder_Info -- -- Write_Binder_Info --
----------------------- -----------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -44,9 +44,9 @@ package Osint.B is ...@@ -44,9 +44,9 @@ package Osint.B is
-- Binder Output -- -- Binder Output --
------------------- -------------------
-- These routines are used by the binder to generate the C source file -- These routines are used by the binder to generate the C or Ada source
-- containing the binder output. The format of this file is described -- files containing the binder output. The format of these files is
-- in the package Bindfmt. -- described in package Bindgen.
procedure Create_Binder_Output procedure Create_Binder_Output
(Output_File_Name : String; (Output_File_Name : String;
...@@ -81,4 +81,16 @@ package Osint.B is ...@@ -81,4 +81,16 @@ package Osint.B is
procedure Set_Current_File_Name_Index (To : Int); procedure Set_Current_File_Name_Index (To : Int);
-- Set value of Current_File_Name_Index (in private part of Osint) to To -- Set value of Current_File_Name_Index (in private part of Osint) to To
----------------------------------
-- Other binder-generated files --
----------------------------------
procedure Set_List_File (Filename : String);
-- Create Filename as a text output file and set it as the current output
-- (see Output.Set_Output).
procedure Close_List_File;
-- If a specific output file was created by Set_List_File, close it and
-- reset the current output file to standard output.
end Osint.B; end Osint.B;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -29,8 +29,6 @@ ...@@ -29,8 +29,6 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with System.OS_Lib; use System.OS_Lib;
package body Output is package body Output is
Current_FD : File_Descriptor := Standout; Current_FD : File_Descriptor := Standout;
...@@ -228,17 +226,26 @@ package body Output is ...@@ -228,17 +226,26 @@ package body Output is
Special_Output_Proc := P; Special_Output_Proc := P;
end Set_Special_Output; end Set_Special_Output;
------------------------ ----------------
-- Set_Standard_Error -- -- Set_Output --
------------------------ ----------------
procedure Set_Standard_Error is procedure Set_Output (FD : File_Descriptor) is
begin begin
if Special_Output_Proc = null then if Special_Output_Proc = null then
Flush_Buffer; Flush_Buffer;
end if; end if;
Current_FD := Standerr; Current_FD := FD;
end Set_Output;
------------------------
-- Set_Standard_Error --
------------------------
procedure Set_Standard_Error is
begin
Set_Output (Standerr);
end Set_Standard_Error; end Set_Standard_Error;
------------------------- -------------------------
...@@ -247,11 +254,7 @@ package body Output is ...@@ -247,11 +254,7 @@ package body Output is
procedure Set_Standard_Output is procedure Set_Standard_Output is
begin begin
if Special_Output_Proc = null then Set_Output (Standout);
Flush_Buffer;
end if;
Current_FD := Standout;
end Set_Standard_Output; end Set_Standard_Output;
------- -------
......
...@@ -33,6 +33,8 @@ ...@@ -33,6 +33,8 @@
-- writing error messages and informational output. It is also used by the -- writing error messages and informational output. It is also used by the
-- debug source file output routines (see Sprint.Print_Debug_Line). -- debug source file output routines (see Sprint.Print_Debug_Line).
with System.OS_Lib; use System.OS_Lib;
with Hostparm; use Hostparm; with Hostparm; use Hostparm;
with Types; use Types; with Types; use Types;
...@@ -85,6 +87,12 @@ package Output is ...@@ -85,6 +87,12 @@ package Output is
-- has been cancelled. Output to standard output is the default mode -- has been cancelled. Output to standard output is the default mode
-- before any call to either of the Set procedures. -- before any call to either of the Set procedures.
procedure Set_Output (FD : File_Descriptor);
-- Sets subsequent output to appear on the given file descriptor when no
-- special output is in effect. When a special output is in effect,
-- the output will appear on the given file descriptor only after special
-- output has been cancelled.
procedure Indent; procedure Indent;
-- Increases the current indentation level. Whenever a line is written -- Increases the current indentation level. Whenever a line is written
-- (triggered by Eol), an appropriate amount of whitespace is added to the -- (triggered by Eol), an appropriate amount of whitespace is added to the
......
...@@ -1313,7 +1313,7 @@ package body Sem_Res is ...@@ -1313,7 +1313,7 @@ package body Sem_Res is
elsif In_Instance then elsif In_Instance then
null; null;
elsif (Op_Name = Name_Op_Multiply or else Op_Name = Name_Op_Divide) elsif (Op_Name = Name_Op_Multiply or else Op_Name = Name_Op_Divide)
and then Is_Fixed_Point_Type (Etype (Left_Opnd (Op_Node))) and then Is_Fixed_Point_Type (Etype (Left_Opnd (Op_Node)))
and then Is_Fixed_Point_Type (Etype (Right_Opnd (Op_Node))) and then Is_Fixed_Point_Type (Etype (Right_Opnd (Op_Node)))
then then
...@@ -1445,7 +1445,7 @@ package body Sem_Res is ...@@ -1445,7 +1445,7 @@ package body Sem_Res is
null; null;
else else
Error_Msg_NE ("expect type&", N, Typ); Error_Msg_NE ("expect type&", N, First_Subtype (Typ));
end if; end if;
end if; end if;
end if; end if;
......
...@@ -41,10 +41,35 @@ package body Switch.B is ...@@ -41,10 +41,35 @@ package body Switch.B is
Ptr : Integer := Switch_Chars'First; Ptr : Integer := Switch_Chars'First;
C : Character := ' '; C : Character := ' ';
function Get_Optional_Filename return String_Ptr;
-- If current character is '=', return a newly allocated string
-- containing the remainder of the current switch (after the '='), else
-- return null.
function Get_Stack_Size (S : Character) return Int; function Get_Stack_Size (S : Character) return Int;
-- Used for -d and -D to scan stack size including handling k/m. -- Used for -d and -D to scan stack size including handling k/m.
-- S is set to 'd' or 'D' to indicate the switch being scanned. -- S is set to 'd' or 'D' to indicate the switch being scanned.
---------------------------
-- Get_Optional_Filename --
---------------------------
function Get_Optional_Filename return String_Ptr is
Result : String_Ptr;
begin
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
if Ptr = Max then
Bad_Switch (Switch_Chars);
else
Result := new String'(Switch_Chars (Ptr + 1 .. Max));
Ptr := Max + 1;
return Result;
end if;
else
return null;
end if;
end Get_Optional_Filename;
-------------------- --------------------
-- Get_Stack_Size -- -- Get_Stack_Size --
-------------------- --------------------
...@@ -125,7 +150,8 @@ package body Switch.B is ...@@ -125,7 +150,8 @@ package body Switch.B is
when 'A' => when 'A' =>
Ptr := Ptr + 1; Ptr := Ptr + 1;
Ada_Bind_File := True; Output_ALI_List := True;
ALI_List_Filename := Get_Optional_Filename;
-- Processing for b switch -- Processing for b switch
...@@ -144,7 +170,6 @@ package body Switch.B is ...@@ -144,7 +170,6 @@ package body Switch.B is
when 'C' => when 'C' =>
Ptr := Ptr + 1; Ptr := Ptr + 1;
Ada_Bind_File := False; Ada_Bind_File := False;
Write_Line ("warning: gnatbind switch -C is obsolescent"); Write_Line ("warning: gnatbind switch -C is obsolescent");
...@@ -318,6 +343,7 @@ package body Switch.B is ...@@ -318,6 +343,7 @@ package body Switch.B is
when 'O' => when 'O' =>
Ptr := Ptr + 1; Ptr := Ptr + 1;
Output_Object_List := True; Output_Object_List := True;
Object_List_Filename := Get_Optional_Filename;
-- Processing for p switch -- Processing for p switch
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1996-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1996-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -196,6 +196,14 @@ package VMS_Data is ...@@ -196,6 +196,14 @@ package VMS_Data is
-- --
-- Add directories to the project search path. -- Add directories to the project search path.
S_Bind_ALI : aliased constant S := "/ALI_LIST " &
"-A";
-- /NOALI_LIST (D)
-- /ALI_LIST
--
-- Output full names of all the ALI files in the partition. The output is
-- written to SYS$OUTPUT.
S_Bind_Bind : aliased constant S := "/BIND_FILE=" & S_Bind_Bind : aliased constant S := "/BIND_FILE=" &
"ADA " & "ADA " &
"-A " & "-A " &
...@@ -385,7 +393,7 @@ package VMS_Data is ...@@ -385,7 +393,7 @@ package VMS_Data is
-- /NOOBJECT_LIST (D) -- /NOOBJECT_LIST (D)
-- /OBJECT_LIST -- /OBJECT_LIST
-- --
-- Output full names of all the object files that must be linker to -- Output full names of all the object files that must be linked to
-- provide the Ada component of the program. The output is written to -- provide the Ada component of the program. The output is written to
-- SYS$OUTPUT. -- SYS$OUTPUT.
...@@ -669,6 +677,7 @@ package VMS_Data is ...@@ -669,6 +677,7 @@ package VMS_Data is
Bind_Switches : aliased constant Switches := Bind_Switches : aliased constant Switches :=
(S_Bind_Add 'Access, (S_Bind_Add 'Access,
S_Bind_ALI 'Access,
S_Bind_Bind 'Access, S_Bind_Bind 'Access,
S_Bind_Build 'Access, S_Bind_Build 'Access,
S_Bind_Current 'Access, S_Bind_Current 'Access,
......
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