aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2009-04-24 15:31:46 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2009-04-24 15:31:46 +0200
commita7a3cf5c105dc2252ffe84546ce161eff31d0ad9 (patch)
treeda97e37aa293ac609c71934f607369838d66319e
parent2324b3fd3862e466c3098c17eeb06b056f1d16ee (diff)
downloadgcc-a7a3cf5c105dc2252ffe84546ce161eff31d0ad9.zip
gcc-a7a3cf5c105dc2252ffe84546ce161eff31d0ad9.tar.gz
gcc-a7a3cf5c105dc2252ffe84546ce161eff31d0ad9.tar.bz2
[multiple changes]
2009-04-24 Ed Schonberg <schonberg@adacore.com> * sem_res.adb: additional optimization to inhibit creation of redundant transient scopes. 2009-04-24 Bob Duff <duff@adacore.com> * rtsfind.ads: Minor comment fix 2009-04-24 Emmanuel Briot <briot@adacore.com> * prj-proc.adb, prj-nmsc.adb (Find_Ada_Sources, Get_Path_Name_And_Record_Ada_Sources): merged, since these were basically doing the same work (for explicit or implicit sources). (Find_Explicit_Sources): renamed to Find_Sources to better reflect its role. Rewritten to share some code (testing that all explicit sources have been found) between ada_only and multi_language modes. 2009-04-24 Jerome Lambourg <lambourg@adacore.com> * sem_prag.adb (Check_Form_Of_Interface_Name): Allow space in Ext_Name for CLI imported types. (Analyze_Pragma): Allow CIL or Java imported functions returning access-to-subprogram types. From-SVN: r146720
-rw-r--r--gcc/ada/ChangeLog25
-rw-r--r--gcc/ada/prj-nmsc.adb479
-rw-r--r--gcc/ada/prj-proc.adb3
-rw-r--r--gcc/ada/rtsfind.ads4
-rw-r--r--gcc/ada/sem_prag.adb23
-rw-r--r--gcc/ada/sem_res.adb44
6 files changed, 267 insertions, 311 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index be36f83..383d65c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,28 @@
+2009-04-24 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_res.adb: additional optimization to inhibit creation of
+ redundant transient scopes.
+
+2009-04-24 Bob Duff <duff@adacore.com>
+
+ * rtsfind.ads: Minor comment fix
+
+2009-04-24 Emmanuel Briot <briot@adacore.com>
+
+ * prj-proc.adb, prj-nmsc.adb (Find_Ada_Sources,
+ Get_Path_Name_And_Record_Ada_Sources): merged, since these were
+ basically doing the same work (for explicit or implicit sources).
+ (Find_Explicit_Sources): renamed to Find_Sources to better reflect its
+ role. Rewritten to share some code (testing that all explicit sources
+ have been found) between ada_only and multi_language modes.
+
+2009-04-24 Jerome Lambourg <lambourg@adacore.com>
+
+ * sem_prag.adb (Check_Form_Of_Interface_Name): Allow space in Ext_Name
+ for CLI imported types.
+ (Analyze_Pragma): Allow CIL or Java imported functions returning
+ access-to-subprogram types.
+
2009-04-24 Emmanuel Briot <briot@adacore.com>
* make.adb, prj.adb, prj.ads, makeutl.adb, makeutl.ads:
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 3928fc1..bc0cc31 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -351,13 +351,17 @@ package body Prj.Nmsc is
-- Debug_Name is the name representing the list, and is used for debug
-- output only.
- procedure Get_Path_Names_And_Record_Ada_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Current_Dir : String);
- -- Find the path names of the source files in the Source_Names table
- -- in the source directories and record those that are Ada sources.
+ procedure Find_Ada_Sources
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Current_Dir : String;
+ Explicit_Sources_Only : Boolean);
+ -- Find all Ada sources by traversing all source directories.
+ -- If Explicit_Sources_Only is True, then the sources found must belong to
+ -- the list of sources specified explicitly in the project file.
+ -- If Explicit_Sources_Only is False, then all sources matching the naming
+ -- scheme are recorded.
function Compute_Directory_Last (Dir : String) return Natural;
-- Return the index of the last significant character in Dir. This is used
@@ -372,15 +376,6 @@ package body Prj.Nmsc is
-- Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use
-- Error_Report.
- procedure Find_Ada_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Current_Dir : String);
- -- Find all the Ada sources in all of the source directories of a project
- -- Current_Dir should represent the current directory, and is passed for
- -- efficiency to avoid system calls to recompute it.
-
procedure Search_Directories
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
@@ -468,16 +463,15 @@ package body Prj.Nmsc is
-- Get the list of sources from a text file and put them in hash table
-- Source_Names.
- procedure Find_Explicit_Sources
+ procedure Find_Sources
(Current_Dir : String;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data);
-- Process the Source_Files and Source_List_File attributes, and store
-- the list of source files into the Source_Names htable.
- --
- -- Lang indicates which language is being processed when in Ada_Only mode
- -- (all languages are processed anyway when in Multi_Language mode).
+ -- When these attributes are not defined, find all files matching the
+ -- naming schemes in the source directories.
procedure Compute_Unit_Name
(File_Name : File_Name_Type;
@@ -5395,131 +5389,6 @@ package body Prj.Nmsc is
Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree);
end Error_Msg;
- ----------------------
- -- Find_Ada_Sources --
- ----------------------
-
- procedure Find_Ada_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Current_Dir : String)
- is
- Source_Dir : String_List_Id := Data.Source_Dirs;
- Element : String_Element;
- Dir : Dir_Type;
- Current_Source : String_List_Id := Nil_String;
- Source_Recorded : Boolean := False;
-
- begin
- if Current_Verbosity = High then
- Write_Line ("Looking for sources:");
- end if;
-
- -- For each subdirectory
-
- while Source_Dir /= Nil_String loop
- begin
- Source_Recorded := False;
- Element := In_Tree.String_Elements.Table (Source_Dir);
- if Element.Value /= No_Name then
- Get_Name_String (Element.Display_Value);
-
- declare
- Source_Directory : constant String :=
- Name_Buffer (1 .. Name_Len) & Directory_Separator;
- Dir_Last : constant Natural :=
- Compute_Directory_Last (Source_Directory);
-
- begin
- if Current_Verbosity = High then
- Write_Attr ("Source_Dir", Source_Directory);
- end if;
-
- -- We look at every entry in the source directory
-
- Open (Dir,
- Source_Directory (Source_Directory'First .. Dir_Last));
-
- loop
- Read (Dir, Name_Buffer, Name_Len);
-
- if Current_Verbosity = High then
- Write_Str (" Checking ");
- Write_Line (Name_Buffer (1 .. Name_Len));
- end if;
-
- exit when Name_Len = 0;
-
- declare
- File_Name : constant File_Name_Type := Name_Find;
-
- -- ??? We could probably optimize the following call:
- -- we need to resolve links only once for the
- -- directory itself, and then do a single call to
- -- readlink() for each file. Unfortunately that would
- -- require a change in Normalize_Pathname so that it
- -- has the option of not resolving links for its
- -- Directory parameter, only for Name.
-
- Path : constant String :=
- Normalize_Pathname
- (Name => Name_Buffer (1 .. Name_Len),
- Directory =>
- Source_Directory
- (Source_Directory'First .. Dir_Last),
- Resolve_Links =>
- Opt.Follow_Links_For_Files,
- Case_Sensitive => True);
-
- Path_Name : Path_Name_Type;
-
- begin
- Name_Len := Path'Length;
- Name_Buffer (1 .. Name_Len) := Path;
- Path_Name := Name_Find;
-
- -- We attempt to register it as a source. However,
- -- there is no error if the file does not contain a
- -- valid source. But there is an error if we have a
- -- duplicate unit name.
-
- Record_Ada_Source
- (File_Name => File_Name,
- Path_Name => Path_Name,
- Project => Project,
- In_Tree => In_Tree,
- Data => Data,
- Location => No_Location,
- Current_Source => Current_Source,
- Source_Recorded => Source_Recorded,
- Current_Dir => Current_Dir);
- end;
- end loop;
-
- Close (Dir);
- end;
- end if;
-
- exception
- when Directory_Error =>
- null;
- end;
-
- if Source_Recorded then
- In_Tree.String_Elements.Table (Source_Dir).Flag :=
- True;
- end if;
-
- Source_Dir := Element.Next;
- end loop;
-
- if Current_Verbosity = High then
- Write_Line ("end Looking for sources.");
- end if;
-
- end Find_Ada_Sources;
-
--------------------------------
-- Free_Ada_Naming_Exceptions --
--------------------------------
@@ -7021,11 +6890,11 @@ package body Prj.Nmsc is
end if;
end Find_Excluded_Sources;
- ---------------------------
- -- Find_Explicit_Sources --
- ---------------------------
+ ------------------
+ -- Find_Sources --
+ ------------------
- procedure Find_Explicit_Sources
+ procedure Find_Sources
(Current_Dir : String;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
@@ -7042,6 +6911,7 @@ package body Prj.Nmsc is
Data.Decl.Attributes,
In_Tree);
Name_Loc : Name_Location;
+ Has_Explicit_Sources : Boolean;
begin
pragma Assert (Sources.Kind = List, "Source_Files is not a list");
@@ -7142,10 +7012,7 @@ package body Prj.Nmsc is
Current := Element.Next;
end loop;
- if Get_Mode = Ada_Only then
- Get_Path_Names_And_Record_Ada_Sources
- (Project, In_Tree, Data, Current_Dir);
- end if;
+ Has_Explicit_Sources := True;
end;
-- If we have no Source_Files attribute, check the Source_List_File
@@ -7162,6 +7029,8 @@ package body Prj.Nmsc is
(File_Name_Type (Source_List_File.Value), Data.Directory.Name);
begin
+ Has_Explicit_Sources := True;
+
if Source_File_Path_Name'Length = 0 then
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Source_List_File.Value);
@@ -7174,13 +7043,6 @@ package body Prj.Nmsc is
Get_Sources_From_File
(Source_File_Path_Name, Source_List_File.Location,
Project, In_Tree);
-
- if Get_Mode = Ada_Only then
- -- Look in the source directories to find those sources
-
- Get_Path_Names_And_Record_Ada_Sources
- (Project, In_Tree, Data, Current_Dir);
- end if;
end if;
end;
@@ -7189,69 +7051,83 @@ package body Prj.Nmsc is
-- specified. Find all the files that satisfy the naming
-- scheme in all the source directories.
- if Get_Mode = Ada_Only then
- Find_Ada_Sources (Project, In_Tree, Data, Current_Dir);
- end if;
+ Has_Explicit_Sources := False;
end if;
- if Get_Mode = Multi_Language then
+ if Get_Mode = Ada_Only then
+ Find_Ada_Sources
+ (Project, In_Tree, Data, Current_Dir,
+ Explicit_Sources_Only => Has_Explicit_Sources);
+
+ else
Search_Directories
(Project, In_Tree, Data,
For_All_Sources =>
Sources.Default and then Source_List_File.Default);
+ end if;
- -- Check if all exceptions have been found.
- -- For Ada, it is an error if an exception is not found.
- -- For other language, the source is simply removed.
-
- declare
- Source : Source_Id;
- Iter : Source_Iterator;
+ -- Check if all exceptions have been found.
+ -- For Ada, it is an error if an exception is not found.
+ -- For other language, the source is simply removed.
- begin
- Iter := For_Each_Source (In_Tree, Project);
- loop
- Source := Prj.Element (Iter);
- exit when Source = No_Source;
+ declare
+ Source : Source_Id;
+ Iter : Source_Iterator;
- if Source.Naming_Exception
- and then Source.Path = No_Path_Information
- then
- if Source.Unit /= No_Name then
- Error_Msg_Name_1 := Name_Id (Source.Display_File);
- Error_Msg_Name_2 := Name_Id (Source.Unit);
- Error_Msg
- (Project, In_Tree,
- "source file %% for unit %% not found",
- No_Location);
- end if;
+ begin
+ Iter := For_Each_Source (In_Tree, Project);
+ loop
+ Source := Prj.Element (Iter);
+ exit when Source = No_Source;
- Remove_Source (Source, No_Source);
+ if Source.Naming_Exception
+ and then Source.Path = No_Path_Information
+ then
+ if Source.Unit /= No_Name then
+ Error_Msg_Name_1 := Name_Id (Source.Display_File);
+ Error_Msg_Name_2 := Name_Id (Source.Unit);
+ Error_Msg
+ (Project, In_Tree,
+ "source file %% for unit %% not found",
+ No_Location);
end if;
- Next (Iter);
- end loop;
- end;
+ Remove_Source (Source, No_Source);
+ end if;
+
+ Next (Iter);
+ end loop;
+ end;
- -- Check that all sources in Source_Files or the file
- -- Source_List_File has been found.
+ -- It is an error if a source file name in a source list or in a
+ -- source list file is not found.
+ if Has_Explicit_Sources then
declare
- Name_Loc : Name_Location;
-
+ NL : Name_Location;
+ First_Error : Boolean := True;
begin
- Name_Loc := Source_Names.Get_First;
- while Name_Loc /= No_Name_Location loop
- if (not Name_Loc.Except) and then (not Name_Loc.Found) then
- Error_Msg_Name_1 := Name_Id (Name_Loc.Name);
- Error_Msg
- (Project,
- In_Tree,
- "file %% not found",
- Name_Loc.Location);
+ NL := Source_Names.Get_First;
+ while NL /= No_Name_Location loop
+ if not NL.Found then
+ Err_Vars.Error_Msg_File_1 := NL.Name;
+
+ if First_Error then
+ Error_Msg
+ (Project, In_Tree,
+ "source file { cannot be found",
+ NL.Location);
+ First_Error := False;
+
+ else
+ Error_Msg
+ (Project, In_Tree,
+ "\source file { cannot be found",
+ NL.Location);
+ end if;
end if;
- Name_Loc := Source_Names.Get_Next;
+ NL := Source_Names.Get_Next;
end loop;
end;
end if;
@@ -7266,141 +7142,148 @@ package body Prj.Nmsc is
(Project, "Ada", In_Tree, Source_List_File.Location);
end if;
end if;
+ end Find_Sources;
- end Find_Explicit_Sources;
-
- -------------------------------------------
- -- Get_Path_Names_And_Record_Ada_Sources --
- -------------------------------------------
+ ----------------------
+ -- Find_Ada_Sources --
+ ----------------------
- procedure Get_Path_Names_And_Record_Ada_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Current_Dir : String)
+ procedure Find_Ada_Sources
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Current_Dir : String;
+ Explicit_Sources_Only : Boolean)
is
Source_Dir : String_List_Id;
Element : String_Element;
- Path : Path_Name_Type;
Dir : Dir_Type;
- Name : File_Name_Type;
- Canonical_Name : File_Name_Type;
- Name_Str : String (1 .. 1_024);
- Last : Natural := 0;
- NL : Name_Location;
Current_Source : String_List_Id := Nil_String;
- First_Error : Boolean := True;
- Source_Recorded : Boolean := False;
+ Dir_Has_Source : Boolean := False;
+ NL : Name_Location;
begin
+ if Current_Verbosity = High then
+ Write_Line ("Looking for Ada sources:");
+ end if;
+
-- We look in all source directories for the file names in the hash
-- table Source_Names.
Source_Dir := Data.Source_Dirs;
while Source_Dir /= Nil_String loop
- Source_Recorded := False;
+ Dir_Has_Source := False;
Element := In_Tree.String_Elements.Table (Source_Dir);
declare
Dir_Path : constant String :=
- Get_Name_String (Element.Display_Value);
+ Get_Name_String (Element.Display_Value) & Directory_Separator;
+ Dir_Last : constant Natural := Compute_Directory_Last (Dir_Path);
begin
if Current_Verbosity = High then
- Write_Str ("checking directory """);
- Write_Str (Dir_Path);
- Write_Line ("""");
+ Write_Line ("checking directory """ & Dir_Path & """");
end if;
- Open (Dir, Dir_Path);
+ -- Look for all files in the current source directory
- loop
- Read (Dir, Name_Str, Last);
- exit when Last = 0;
+ Open (Dir, Dir_Path (Dir_Path'First .. Dir_Last));
- Name_Len := Last;
- Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
- Name := Name_Find;
+ loop
+ Read (Dir, Name_Buffer, Name_Len);
+ exit when Name_Len = 0;
- if Osint.File_Names_Case_Sensitive then
- Canonical_Name := Name;
- else
- Canonical_Case_File_Name (Name_Str (1 .. Last));
- Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
- Canonical_Name := Name_Find;
+ if Current_Verbosity = High then
+ Write_Line (" Checking " & Name_Buffer (1 .. Name_Len));
end if;
- NL := Source_Names.Get (Canonical_Name);
+ declare
+ Name : constant File_Name_Type := Name_Find;
+ Canonical_Name : File_Name_Type;
+
+ -- ??? We could probably optimize the following call:
+ -- we need to resolve links only once for the
+ -- directory itself, and then do a single call to
+ -- readlink() for each file. Unfortunately that would
+ -- require a change in Normalize_Pathname so that it
+ -- has the option of not resolving links for its
+ -- Directory parameter, only for Name.
+
+ Path : constant String :=
+ Normalize_Pathname
+ (Name => Name_Buffer (1 .. Name_Len),
+ Directory => Dir_Path (Dir_Path'First .. Dir_Last),
+ Resolve_Links => Opt.Follow_Links_For_Files,
+ Case_Sensitive => True);
+
+ Path_Name : Path_Name_Type;
+ To_Record : Boolean := False;
+ Location : Source_Ptr;
- if NL /= No_Name_Location and then not NL.Found then
- NL.Found := True;
- Source_Names.Set (Canonical_Name, NL);
- Name_Len := Dir_Path'Length;
- Name_Buffer (1 .. Name_Len) := Dir_Path;
+ begin
+ -- If the file was listed in the explicit list of sources,
+ -- mark it as such (since we'll need to report an error when
+ -- an explicit source was not found)
+
+ if Explicit_Sources_Only then
+ Canonical_Name := Canonical_Case_File_Name
+ (Name_Id (Name));
+ NL := Source_Names.Get (Canonical_Name);
+ To_Record := NL /= No_Name_Location and then not NL.Found;
+ if To_Record then
+ NL.Found := True;
+ Location := NL.Location;
+ Source_Names.Set (Canonical_Name, NL);
+ end if;
- if Name_Buffer (Name_Len) /= Directory_Separator then
- Add_Char_To_Name_Buffer (Directory_Separator);
+ else
+ To_Record := True;
+ Location := No_Location;
end if;
- Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
- Path := Name_Find;
+ if To_Record then
+ Name_Len := Path'Length;
+ Name_Buffer (1 .. Name_Len) := Path;
+ Path_Name := Name_Find;
- if Current_Verbosity = High then
- Write_Str (" found ");
- Write_Line (Get_Name_String (Name));
- end if;
+ if Current_Verbosity = High then
+ Write_Line (" recording " & Get_Name_String (Name));
+ end if;
- -- Register the source if it is an Ada compilation unit
-
- Record_Ada_Source
- (File_Name => Name,
- Path_Name => Path,
- Project => Project,
- In_Tree => In_Tree,
- Data => Data,
- Location => NL.Location,
- Current_Source => Current_Source,
- Source_Recorded => Source_Recorded,
- Current_Dir => Current_Dir);
- end if;
+ -- Register the source if it is an Ada compilation unit
+
+ Record_Ada_Source
+ (File_Name => Name,
+ Path_Name => Path_Name,
+ Project => Project,
+ In_Tree => In_Tree,
+ Data => Data,
+ Location => Location,
+ Current_Source => Current_Source,
+ Source_Recorded => Dir_Has_Source,
+ Current_Dir => Current_Dir);
+ end if;
+ end;
end loop;
Close (Dir);
+
+ exception
+ when others =>
+ Close (Dir);
+ raise;
end;
- if Source_Recorded then
- In_Tree.String_Elements.Table (Source_Dir).Flag :=
- True;
+ if Dir_Has_Source then
+ In_Tree.String_Elements.Table (Source_Dir).Flag := True;
end if;
Source_Dir := Element.Next;
end loop;
- -- It is an error if a source file name in a source list or
- -- in a source list file is not found.
-
- NL := Source_Names.Get_First;
- while NL /= No_Name_Location loop
- if not NL.Found then
- Err_Vars.Error_Msg_File_1 := NL.Name;
-
- if First_Error then
- Error_Msg
- (Project, In_Tree,
- "source file { cannot be found",
- NL.Location);
- First_Error := False;
-
- else
- Error_Msg
- (Project, In_Tree,
- "\source file { cannot be found",
- NL.Location);
- end if;
- end if;
-
- NL := Source_Names.Get_Next;
- end loop;
- end Get_Path_Names_And_Record_Ada_Sources;
+ if Current_Verbosity = High then
+ Write_Line ("End looking for sources");
+ end if;
+ end Find_Ada_Sources;
-------------------------------
-- Check_File_Naming_Schemes --
@@ -8230,7 +8113,7 @@ package body Prj.Nmsc is
Load_Naming_Exceptions (Project, In_Tree);
end if;
- Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data);
+ Find_Sources (Current_Dir, Project, In_Tree, Data);
Mark_Excluded_Sources;
if Get_Mode = Multi_Language then
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index 03d5220..078c592 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -2391,8 +2391,7 @@ package body Prj.Proc is
Extending2 := Extending;
while Extending2 /= No_Project loop
- if In_Tree.Projects.Table (Extending2).Ada_Sources /=
- Nil_String
+ if Has_Ada_Sources (In_Tree.Projects.Table (Extending2))
and then
In_Tree.Projects.Table
(Extending2).Object_Directory.Name = Obj_Dir
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 95b717f..5439f4e 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- 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- --
@@ -2922,7 +2922,7 @@ package Rtsfind is
-- Returns True if the given Nam is an Expanded Name, whose Prefix is Ada,
-- and whose selector is either Text_IO.xxx or Wide_Text_IO.xxx or
-- Wide_Wide_Text_IO.xxx, where xxx is one of the subpackages of Text_IO
- -- that is specially handled as described above for Text_IO_Kludge.
+ -- that is specially handled as described below for Text_IO_Kludge.
function RTE (E : RE_Id) return Entity_Id;
-- Given the entity defined in the above tables, as identified by the
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index cdbd9e3..daa607b 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3929,20 +3929,21 @@ package body Sem_Prag is
if not In_Character_Range (C)
- -- For all cases except external names on CLI target,
+ -- For all cases except CLI target,
-- commas, spaces and slashes are dubious (in CLI, we use
- -- spaces and commas in external names to specify assembly
- -- version and public key, while slashes can be used in
- -- names to mark nested classes).
+ -- commas and backslashes in external names to specify
+ -- assembly version and public key, while slashes and spaces
+ -- can be used in names to mark nested classes and
+ -- valuetypes).
or else ((not Ext_Name_Case or else VM_Target /= CLI_Target)
- and then (Get_Character (C) = ' '
- or else
- Get_Character (C) = ','
+ and then (Get_Character (C) = ','
or else
Get_Character (C) = '\'))
or else (VM_Target /= CLI_Target
- and then Get_Character (C) = '/')
+ and then (Get_Character (C) = ' '
+ or else
+ Get_Character (C) = '/'))
then
Error_Msg
("?interface name contains illegal character",
@@ -8249,6 +8250,10 @@ package body Sem_Prag is
and then
(Is_Value_Type (Etype (Def_Id))
or else
+ (Ekind (Etype (Def_Id)) = E_Access_Subprogram_Type
+ and then
+ Atree.Convention (Etype (Def_Id)) = Convention)
+ or else
(Ekind (Etype (Def_Id)) in Access_Kind
and then
(Atree.Convention
@@ -8271,7 +8276,7 @@ package body Sem_Prag is
pragma Assert (Convention = Convention_CIL);
Error_Pragma_Arg
("pragma% requires function returning a " &
- "'CIL access type", Arg1);
+ "'C'I'L access type", Arg1);
end if;
end if;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 11bce01..a3976bb 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -2668,6 +2668,12 @@ package body Sem_Res is
-- common type. Used to enforce the restrictions on array conversions
-- of AI95-00246.
+ function Static_Concatenation (N : Node_Id) return Boolean;
+ -- Predicate to determine whether an actual that is a concatenation
+ -- will be evaluated statically and does not need a transient scope.
+ -- This must be determined before the actual is resolved and expanded
+ -- because if needed the transient scope must be introduced earlier.
+
--------------------------
-- Check_Argument_Order --
--------------------------
@@ -3014,6 +3020,43 @@ package body Sem_Res is
return Root_Type (Base_Type (FT1)) = Root_Type (Base_Type (FT2));
end Same_Ancestor;
+ --------------------------
+ -- Static_Concatenation --
+ --------------------------
+
+ function Static_Concatenation (N : Node_Id) return Boolean is
+ begin
+ if Nkind (N) /= N_Op_Concat
+ or else Etype (N) /= Standard_String
+ then
+ return False;
+
+ elsif Nkind (Left_Opnd (N)) = N_String_Literal then
+ return Static_Concatenation (Right_Opnd (N));
+
+ elsif Is_Entity_Name (Left_Opnd (N)) then
+ declare
+ Ent : constant Entity_Id := Entity (Left_Opnd (N));
+
+ begin
+ if Ekind (Ent) = E_Constant
+ and then Present (Constant_Value (Ent))
+ and then Is_Static_Expression (Constant_Value (Ent))
+ then
+ return Static_Concatenation (Right_Opnd (N));
+ else
+ return False;
+ end if;
+ end;
+
+ elsif Static_Concatenation (Left_Opnd (N)) then
+ return Static_Concatenation (Right_Opnd (N));
+
+ else
+ return False;
+ end if;
+ end Static_Concatenation;
+
-- Start of processing for Resolve_Actuals
begin
@@ -3184,6 +3227,7 @@ package body Sem_Res is
and then
not (Is_Intrinsic_Subprogram (Nam)
and then Chars (Nam) = Name_Asm)
+ and then not Static_Concatenation (A)
then
Establish_Transient_Scope (A, False);
Resolve (A, Etype (F));