Skip to content

R
riscv-gcc-1
Commit 9e895ab5 by Arnaud Charlet
Options

[multiple changes] 

2009-04-29  Vincent Celier  <celier@adacore.com>

	* sinput-l.adb (Load_File): When preprocessing, set temporarily the
	Source_File_Index_Table entries for the source, to avoid crash when
	reporting an error.

	* gnatcmd.adb (Test_If_Relative_Path): Use
	Makeutl.Test_If_Relative_Path.
	
	* makeutl.adb:(Test_If_Relative_Path): Process switches --RTS= only if
	Including_RTS is True.

	* makeutl.ads (Test_If_Relative_Path): New Boolean parameter
	Including_RTS defaulted to False.

	* sinput.ads, scans.ads, err_vars.ads: Initialize some variables with
	a default value.

2009-04-29  Javier Miranda  <miranda@adacore.com>

	* gnat_ugn.texi: Adding documentation for non-default C++ constructors.

From-SVN: r146967
parent 236fecbf
Showing with 253 additions and 75 deletions
gcc/ada/ChangeLog
2009-04-29 Vincent Celier <celier@adacore.com>
* sinput-l.adb (Load_File): When preprocessing, set temporarily the
Source_File_Index_Table entries for the source, to avoid crash when
reporting an error.
* gnatcmd.adb (Test_If_Relative_Path): Use
Makeutl.Test_If_Relative_Path.
* makeutl.adb:(Test_If_Relative_Path): Process switches --RTS= only if
Including_RTS is True.
* makeutl.ads (Test_If_Relative_Path): New Boolean parameter
Including_RTS defaulted to False.
* sinput.ads, scans.ads, err_vars.ads: Initialize some variables with
a default value.
2009-04-29 Javier Miranda <miranda@adacore.com>
* gnat_ugn.texi: Adding documentation for non-default C++ constructors.
2009-04-29 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Analyze_Object_Declaration): Disable error message
......
gcc/ada/err_vars.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
......@@ -32,22 +32,26 @@ with Uintp; use Uintp;
package Err_Vars is
-- Some variables are initialized so that some tools (such as gprbuild)
-- can be built with -gnatVa and pragma Initialized_Scalars without
-- problems.
------------------
-- Error Counts --
------------------
Serious_Errors_Detected : Nat;
Serious_Errors_Detected : Nat := 0;
-- This is a count of errors that are serious enough to stop expansion,
-- and hence to prevent generation of an object file even if the
-- switch -gnatQ is set. Initialized to zero at the start of compilation.
Total_Errors_Detected : Nat;
Total_Errors_Detected : Nat := 0;
-- Number of errors detected so far. Includes count of serious errors and
-- non-serious errors, so this value is always greater than or equal to the
-- Serious_Errors_Detected value. Initialized to zero at the start of
-- compilation.
Warnings_Detected : Nat;
Warnings_Detected : Nat := 0;
-- Number of warnings detected. Initialized to zero at the start of
-- compilation.
......@@ -75,7 +79,7 @@ package Err_Vars is
-- generated on the instantiation (referring to the template) rather
-- than on the template itself.
Raise_Exception_On_Error : Nat;
Raise_Exception_On_Error : Nat := 0;
-- If this value is non-zero, then any attempt to generate an error
-- message raises the exception Error_Msg_Exception, and the error
-- message is not output. This is used for defending against junk
......
gcc/ada/gnat_ugn.texi
......@@ -2976,6 +2976,7 @@ with a new C++ compiler.
* Interfacing to C++::
* Linking a Mixed C++ & Ada Program::
* A Simple Example::
* Interfacing with C++ constructors::
* Interfacing with C++ at the Class Level::
@end menu
......@@ -3228,6 +3229,176 @@ package Simple_Cpp_Interface is
end Simple_Cpp_Interface;
@end smallexample
@node Interfacing with C++ constructors
@subsection Interfacing with C++ constructors
@noindent
In order to interface with C++ constructors GNAT provides the
@code{pragma CPP_Constructor} (@xref{Interfacing to C++,,,
gnat_rm, GNAT Reference Manual}, for additional information).
In this section we present some common uses of C++ constructors
in mixed-languages programs in GNAT.
Let us assume that we need to interface with the following
C++ class:
@smallexample
@b{class} Root @{
@b{public}:
int a_value;
int b_value;
@b{virtual} int Get_Value ();
Root(); // Default constructor
Root(int v); // 1st non-default constructor
Root(int v, int w); // 2nd non-default constructor
@};
@end smallexample
For this purpose we can write the following package spec (further
information on how to build this spec is available in
@ref{Interfacing with C++ at the Class Level} and
@ref{Generating Ada Bindings for C and C++ headers}).
@smallexample @c ada
with Interfaces.C; use Interfaces.C;
package Pkg_Root is
type Root is tagged limited record
A_Value : int;
B_Value : int;
end record;
pragma Import (CPP, Root);
function Get_Value (Obj : Root) return int;
pragma Import (CPP, Get_Value);
function Constructor return Root'Class;
pragma Cpp_Constructor (Constructor, "_ZN4RootC1Ev");
function Constructor (v : Integer) return Root'Class;
pragma Cpp_Constructor (Constructor, "_ZN4RootC1Ei");
function Constructor (v, w : Integer) return Root'Class;
pragma Cpp_Constructor (Constructor, "_ZN4RootC1Eii");
end Pkg_Root;
@end smallexample
On the Ada side the constructor is represented by a function (whose
name is arbitrary) that returns the classwide type corresponding to
the imported C++ class.
In a declaration of an object whose type is a class imported from C++,
either the default C++ constructor is implicitly called by GNAT, or
else the required C++ constructor must be explicitly called in the
expression that initializes the object. For example:
@smallexample @c ada
Obj1 : Root;
Obj2 : Root := Constructor;
Obj3 : Root := Constructor (v => 10);
Obj4 : Root := Constructor (30, 40);
@end smallexample
The first two declarations are equivalent: in both cases the default C++
constructor is invoked (in the former case the call to the constructor is
implicit, and in the latter case the call is explicit in the object
declaration). @code{Obj3} is initialized by the C++ non-default constructor
that takes an integer argument, and @code{Obj4} is initialized by the
non-default C++ constructor that takes two integers.
Let us derive the imported C++ class in the Ada side. For example:
@smallexample @c ada
type DT is new Root with record
C_Value : Natural := 2009;
end record;
@end smallexample
In this case the components DT inherited from the C++ side must be
initialized by a C++ constructor, and the additional Ada components
of type DT are initialized by GNAT. The initialization of such an
object is done either by default, or by means of a function returning
an aggregate of type DT, or by means of an extended aggregate.
@smallexample @c ada
Obj5 : DT;
Obj6 : DT := Function_Returning_DT (50);
Obj7 : DT := (Constructor (30,40) with (C_Value => 50));
@end smallexample
The declaration of @code{Obj5} invokes the default constructors: the
C++ default constructor of the parent type takes care of the initialization
of the components inherited from Root, and GNAT takes care of the default
initialization of the additional Ada components of type DT (that is,
@code{C_Value} is initialized to value 2009). The order of invocation of
the constructors is consistent with the order of elaboration required by
Ada and C++. That is, the constructor of the parent type is always called
before the constructor of the derived type.
Let us now consider a record that has components whose type is imported
from C++. For example:
@smallexample @c ada
type Rec1 is limited record
Data1 : Root := Constructor (10);
Value : Natural := 1000;
end record;
type Rec2 (D : Integer := 20) is limited record
Rec : Rec1;
Data2 : Root := Constructor (D, 30);
end record;
@end smallexample
The initialization of an object of type @code{Rec2} will call the
non-default C++ constructors specified for the imported components.
For example:
@smallexample @c ada
Obj8 : Rec2 (40);
@end smallexample
Using Ada 2005 we can use limited aggregates to initialize an object
invoking C++ constructors that differ from those specified in the type
declarations. For example:
@smallexample @c ada
Obj9 : Rec2 := (Rec => (Data1 => Constructor (15, 16),
others => <>),
others => <>);
@end smallexample
The above declaration uses an Ada 2005 limited aggregate to
initialize @code{Obj9}, and the C++ constructor that has two integer
arguments is invoked to initialize the @code{Data1} component instead
of the constructor specified in the declaration of type @code{Rec1}. In
Ada 2005 the box in the aggregate indicates that unspecified components
are initialized using the expression (if any) available in the component
declaration. That is, in this case discriminant @code{D} is initialized
to value @code{20}, @code{Value} is initialized to value 1000, and the
non-default C++ constructor that handles two integers takes care of
initializing component @code{Data2} with values @code{20,30}.
In Ada 2005 we can use the extended return statement to build the Ada
equivalent to C++ non-default constructors. For example:
@smallexample @c ada
function Constructor (V : Integer) return Rec2 is
begin
return Obj : Rec2 := (Rec => (Data1 => Constructor (V, 20),
others => <>),
others => <>) do
-- Further actions required for construction of
-- objects of type Rec2
...
end record;
end Constructor;
@end smallexample
In this example the extended return statement construct is used to
build in place the returned object whose components are initialized
by means of a limited aggregate. Any further action associated with
the constructor can be placed inside the construct.
@node Interfacing with C++ at the Class Level
@subsection Interfacing with C++ at the Class Level
@noindent
gcc/ada/gnatcmd.adb
......@@ -26,6 +26,7 @@
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Csets;
with Makeutl;
with MLib.Tgt; use MLib.Tgt;
with MLib.Utl;
with MLib.Fil;
......@@ -1265,61 +1266,8 @@ procedure GNATCmd is
Parent : String)
is
begin
if Switch /= null then
declare
Sw : String (1 .. Switch'Length);
Start : Positive := 1;
begin
Sw := Switch.all;
if Sw (1) = '-' then
if Sw'Length >= 3
and then (Sw (2) = 'A' or else
Sw (2) = 'I' or else
Sw (2) = 'L')
then
Start := 3;
if Sw = "-I-" then
return;
end if;
elsif Sw'Length >= 4
and then (Sw (2 .. 3) = "aL" or else
Sw (2 .. 3) = "aO" or else
Sw (2 .. 3) = "aI")
then
Start := 4;
elsif Sw'Length >= 7
and then Sw (2 .. 6) = "-RTS="
then
Start := 7;
else
return;
end if;
end if;
-- If the path is relative, test if it includes directory
-- information. If it does, prepend Parent to the path.
if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
for J in Start .. Sw'Last loop
if Sw (J) = Directory_Separator then
Switch :=
new String'
(Sw (1 .. Start - 1) &
Parent &
Directory_Separator &
Sw (Start .. Sw'Last));
return;
end if;
end loop;
end if;
end;
end if;
Makeutl.Test_If_Relative_Path
(Switch, Parent, Including_Non_Switch => False, Including_RTS => True);
end Test_If_Relative_Path;
-------------------
......
gcc/ada/makeutl.adb
......@@ -598,7 +598,8 @@ package body Makeutl is
(Switch : in out String_Access;
Parent : String;
Including_L_Switch : Boolean := True;
Including_Non_Switch : Boolean := True)
Including_Non_Switch : Boolean := True;
Including_RTS : Boolean := False)
is
begin
if Switch /= null then
......@@ -628,13 +629,20 @@ package body Makeutl is
then
Start := 4;
elsif Including_RTS
and then Sw'Length >= 7
and then Sw (2 .. 6) = "-RTS="
then
Start := 7;
else
return;
end if;
-- Because relative path arguments to --RTS= may be relative
-- to the search directory prefix, those relative path
-- arguments are not converted.
-- arguments are converted only when they include directory
-- information.
if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
if Parent'Length = 0 then
......@@ -643,6 +651,19 @@ package body Makeutl is
& Sw
& """) are not allowed");
elsif Including_RTS then
for J in Start .. Sw'Last loop
if Sw (J) = Directory_Separator then
Switch :=
new String'
(Sw (1 .. Start - 1) &
Parent &
Directory_Separator &
Sw (Start .. Sw'Last));
return;
end if;
end loop;
else
Switch :=
new String'
......
gcc/ada/makeutl.ads
......@@ -130,12 +130,14 @@ package Makeutl is
(Switch : in out String_Access;
Parent : String;
Including_L_Switch : Boolean := True;
Including_Non_Switch : Boolean := True);
Including_Non_Switch : Boolean := True;
Including_RTS : Boolean := False);
-- Test if Switch is a relative search path switch.
-- If it is, fail if Parent is the empty string, otherwise prepend the path
-- with Parent. This subprogram is only called when using project files.
-- For gnatbind switches, Including_L_Switch is False, because the
-- argument of the -L switch is not a path.
-- argument of the -L switch is not a path. If Including_RTS is True,
-- process also switches --RTS=.
function Path_Or_File_Name (Path : Path_Name_Type) return String;
-- Returns a file name if -df is used, otherwise return a path name
......
gcc/ada/scans.ads
......@@ -344,37 +344,40 @@ package Scans is
-- Note: these variables can only be referenced during the parsing of a
-- file. Reference to any of them from Sem or the expander is wrong.
-- Some of these variables are initialized so that some tools (such as
-- gprbuild) can be built with -gnatVa and pragma Initialized_Scalars
-- without problems.
Scan_Ptr : Source_Ptr;
Scan_Ptr : Source_Ptr := No_Location;
-- Current scan pointer location. After a call to Scan, this points
-- just past the end of the token just scanned.
Token : Token_Type;
Token : Token_Type := No_Token;
-- Type of current token
Token_Ptr : Source_Ptr;
Token_Ptr : Source_Ptr := No_Location;
-- Pointer to first character of current token
Current_Line_Start : Source_Ptr;
Current_Line_Start : Source_Ptr := No_Location;
-- Pointer to first character of line containing current token
Start_Column : Column_Number;
Start_Column : Column_Number := No_Column_Number;
-- Starting column number (zero origin) of the first non-blank character
-- on the line containing the current token. This is used for error
-- recovery circuits which depend on looking at the column line up.
Type_Token_Location : Source_Ptr;
Type_Token_Location : Source_Ptr := No_Location;
-- Within a type declaration, gives the location of the TYPE keyword that
-- opened the type declaration. Used in checking the end column of a record
-- declaration, which can line up either with the TYPE keyword, or with the
-- start of the line containing the RECORD keyword.
Checksum : Word;
Checksum : Word := 0;
-- Used to accumulate a CRC representing the tokens in the source
-- file being compiled. This CRC includes only program tokens, and
-- excludes comments.
First_Non_Blank_Location : Source_Ptr;
First_Non_Blank_Location : Source_Ptr := No_Location;
-- Location of first non-blank character on the line containing the
-- current token (i.e. the location of the character whose column number
-- is stored in Start_Column).
......
gcc/ada/sinput-l.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
......@@ -453,6 +453,11 @@ package body Sinput.L is
-- Preprocess the source if it needs to be preprocessed
if Preprocessing_Needed then
-- Set temporarily the Source_File_Index_Table entries for the
-- source, to avoid crash when reporting an error.
Set_Source_File_Index_Table (X);
if Opt.List_Preprocessing_Symbols then
Get_Name_String (N);
......
gcc/ada/sinput.ads
......@@ -423,8 +423,10 @@ package Sinput is
-- Global Data --
-----------------
Current_Source_File : Source_File_Index;
-- Source_File table index of source file currently being scanned
Current_Source_File : Source_File_Index := No_Source_File;
-- Source_File table index of source file currently being scanned.
-- Initialized so that some tools (such as gprbuild) can be built with
-- -gnatVa and pragma Initialized_Scalars without problems.
Current_Source_Unit : Unit_Number_Type;
-- Unit number of source file currently being scanned. The special value
......
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