]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Fri, 18 Jun 2010 15:32:24 +0000 (17:32 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Fri, 18 Jun 2010 15:32:24 +0000 (17:32 +0200)
2010-06-18  Javier Miranda  <miranda@adacore.com>

* exp_cg.adb (Homonym_Suffix_Length): Minor code reorganization.

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

* sprint.ads: Minor reformatting.
* output.ads: Update obsolete comment.

2010-06-18  Ed Schonberg  <schonberg@adacore.com>

* freeze.adb (Build_And_Analyze_Renamed_Body): if the renamed entity is
an external intrinsic operation (e.g. a GCC numeric function) indicate
that the renaming entity has the same characteristics, so a call to it
is properly expanded.

From-SVN: r160999

gcc/ada/ChangeLog
gcc/ada/exp_cg.adb
gcc/ada/freeze.adb
gcc/ada/output.ads
gcc/ada/sprint.ads

index 5e3968ec4808f752b95bff0ea5ded8c0351c725a..30b6acb8661680dde51ac314f186de36b08aa6f0 100644 (file)
@@ -1,3 +1,19 @@
+2010-06-18  Javier Miranda  <miranda@adacore.com>
+
+       * exp_cg.adb (Homonym_Suffix_Length): Minor code reorganization.
+
+2010-06-18  Thomas Quinot  <quinot@adacore.com>
+
+       * sprint.ads: Minor reformatting.
+       * output.ads: Update obsolete comment.
+
+2010-06-18  Ed Schonberg  <schonberg@adacore.com>
+
+       * freeze.adb (Build_And_Analyze_Renamed_Body): if the renamed entity is
+       an external intrinsic operation (e.g. a GCC numeric function) indicate
+       that the renaming entity has the same characteristics, so a call to it
+       is properly expanded.
+
 2010-06-18  Javier Miranda  <miranda@adacore.com>
 
        * exp_cg.adb, exp_cg.ads, exp_disp.adb, gnat1drv.adb: Add initial
index 2b735e34202a08cacb47515b5d8c6c2b222f70db..d207a3c21e16b44124979f2167068d8a26e6817a 100644 (file)
@@ -31,7 +31,7 @@ with Exp_Disp; use Exp_Disp;
 with Exp_Tss;  use Exp_Tss;
 --  with Interfaces.C;
 --  with Interfaces.C_Streams;
---  Why are these commented out ???
+--   Why are these commented out ???
 with Lib;      use Lib;
 with Namet;    use Namet;
 with Opt;      use Opt;
@@ -161,18 +161,16 @@ package body Exp_CG is
 
             --  Prefix "__" followed by number
 
-            elsif Nr < 10 then
-               return Prefix_Length + 1;
-
-            elsif Nr < 100 then
-               return Prefix_Length + 2;
-
-            elsif Nr < 1000 then
-               return Prefix_Length + 3;
-
             else
-               pragma Assert (False);
-               raise Program_Error;
+               declare
+                  Result : Natural := Prefix_Length + 1;
+               begin
+                  while Nr > 10 loop
+                     Result := Result + 1;
+                     Nr := Nr / 10;
+                  end loop;
+                  return Result;
+               end;
             end if;
          end if;
       end Homonym_Suffix_Length;
index 1c24d74a4fb4533e09a9e5dfbcda4d464c15d5ed..289730704cd0c7b78dd06a47ad041d32564f9fe1 100644 (file)
@@ -203,12 +203,44 @@ package body Freeze is
       New_S : Entity_Id;
       After : in out Node_Id)
    is
-      Body_Node : constant Node_Id := Build_Renamed_Body (Decl, New_S);
+      Body_Node :  Node_Id;
+      Intr      : Entity_Id;
+      Body_Decl : constant Node_Id := Unit_Declaration_Node (New_S);
+      Ent       : constant Entity_Id := Defining_Entity (Decl);
+
    begin
-      Insert_After (After, Body_Node);
-      Mark_Rewrite_Insertion (Body_Node);
-      Analyze (Body_Node);
-      After := Body_Node;
+
+      --  if the renamed subprogram is intrinsic, there is no need for a
+      --  wrapper body: we set the alias that will be called and expanded
+      --  which completes the declaration.
+      --  Note that it is legal for a renaming_as_body to rename an intrinsic
+      --  subprogram, as long as the renaming occurs before the new entity
+      --  is frozen. See RM 8.5.4 (5).
+
+      if Nkind (Body_Decl) = N_Subprogram_Renaming_Declaration
+         and then Is_Entity_Name (Name (Body_Decl))
+        and then Is_Intrinsic_Subprogram (Entity (Name (Body_Decl)))
+        and then Present (Interface_Name (Entity (Name (Body_Decl))))
+      then
+         Intr := Entity (Name (Body_Decl));
+         Set_Interface_Name
+           (Intr, Interface_Name (Entity (Name (Body_Decl))));
+         if Present (Alias (Intr)) then
+            Set_Alias (Ent, Alias (Intr));
+         else
+            Set_Alias (Ent, Intr);
+         end if;
+
+         Set_Is_Intrinsic_Subprogram (Ent);
+         Set_Has_Completion (Ent);
+
+      else
+         Body_Node := Build_Renamed_Body (Decl, New_S);
+         Insert_After (After, Body_Node);
+         Mark_Rewrite_Insertion (Body_Node);
+         Analyze (Body_Node);
+         After := Body_Node;
+      end if;
    end Build_And_Analyze_Renamed_Body;
 
    ------------------------
@@ -308,8 +340,8 @@ package body Freeze is
       end if;
 
       --  For simple renamings, subsequent calls can be expanded directly as
-      --  called to the renamed entity. The body must be generated in any case
-      --  for calls they may appear elsewhere.
+      --  calls to the renamed entity. The body must be generated in any case
+      --  for calls that may appear elsewhere.
 
       if (Ekind (Old_S) = E_Function
            or else Ekind (Old_S) = E_Procedure)
@@ -1340,6 +1372,9 @@ package body Freeze is
       --  point at which such functions are constructed (after all types that
       --  might be used in such expressions have been frozen).
 
+      --  For subprograms that are renaming_as_body, we create the wrapper
+      --  bodies as needed.
+
       --  We also add finalization chains to access types whose designated
       --  types are controlled. This is normally done when freezing the type,
       --  but this misses recursive type definitions where the later members
index 7f13dc24b15250af9588c663eed0f95cb07fd885..2df0da661e52702bb511a4045af055d3b0c6d0a0 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          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 --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -29,9 +29,9 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package contains low level output routines used by the compiler
---  for writing error messages and informational output. It is also used
---  by the debug source file output routines (see Sprintf.Print_Eol).
+--  This package contains low level output routines used by the compiler for
+--  writing error messages and informational output. It is also used by the
+--  debug source file output routines (see Sprint.Print_Debug_Line).
 
 with Hostparm; use Hostparm;
 with Types;    use Types;
index 7c2b3cb0a2110d0dd4f0e9e81c00821f7e599177..64fe81ae4c5c7ec7461cd3bca61bf2c065f3f347 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          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 --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -32,6 +32,7 @@
 --  tree may either blow up on a debugging check, or list incorrect source.
 
 with Types; use Types;
+
 package Sprint is
 
    -----------------------