OSDN Git Service

2010-10-08 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 8 Oct 2010 12:34:08 +0000 (12:34 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 8 Oct 2010 12:34:08 +0000 (12:34 +0000)
* sem_aggr.adb: Minor reformatting.

2010-10-08  Robert Dewar  <dewar@adacore.com>

* exp_imgv.adb (Expand_Image_Attribute): Handle special calling
sequence for soft hyphen for Character'Image case.
* rtsfind.ads (Image_Character_05): New entry
* s-imgcha.adb (Image_Character_05): New procedurew
* s-imgcha.ads (Image_Character_05): New procedure
* s-imgwch.adb (Image_Wide_Character): Deal with Ada 2005 soft hyphen
case.
* s-valcha.adb (Value_Character): Recognize SOFT_HYPHEN for 16#AD#
* sem_attr.adb (Eval_Attribute, case Width): Handle soft_hyphen name
properly.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165168 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/exp_imgv.adb
gcc/ada/rtsfind.ads
gcc/ada/s-imgcha.adb
gcc/ada/s-imgcha.ads
gcc/ada/s-imgwch.adb
gcc/ada/s-valcha.adb
gcc/ada/sem_aggr.adb
gcc/ada/sem_attr.adb

index 7ddaa66..2b37a3c 100644 (file)
@@ -1,5 +1,22 @@
 2010-10-08  Robert Dewar  <dewar@adacore.com>
 
+       * sem_aggr.adb: Minor reformatting.
+
+2010-10-08  Robert Dewar  <dewar@adacore.com>
+
+       * exp_imgv.adb (Expand_Image_Attribute): Handle special calling
+       sequence for soft hyphen for Character'Image case.
+       * rtsfind.ads (Image_Character_05): New entry
+       * s-imgcha.adb (Image_Character_05): New procedurew
+       * s-imgcha.ads (Image_Character_05): New procedure
+       * s-imgwch.adb (Image_Wide_Character): Deal with Ada 2005 soft hyphen
+       case.
+       * s-valcha.adb (Value_Character): Recognize SOFT_HYPHEN for 16#AD#
+       * sem_attr.adb (Eval_Attribute, case Width): Handle soft_hyphen name
+       properly.
+
+2010-10-08  Robert Dewar  <dewar@adacore.com>
+
        * sem_attr.adb (Eval_Attribute, case Width): Avoid ludicrous long loop
        for case of Wide_[Wide_]Character.
 
index 9c0be21..25bce02 100644 (file)
@@ -306,8 +306,16 @@ package body Exp_Imgv is
          Imid := RE_Image_Boolean;
          Tent := Rtyp;
 
+      --  For standard character, we have to select the version which handles
+      --  soft hyphen correctly, based on the version of Ada in use (ugly!)
+
       elsif Rtyp = Standard_Character then
-         Imid := RE_Image_Character;
+         if Ada_Version < Ada_05 then
+            Imid := RE_Image_Character;
+         else
+            Imid := RE_Image_Character_05;
+         end if;
+
          Tent := Rtyp;
 
       elsif Rtyp = Standard_Wide_Character then
index 177f1fe..ca61bd1 100644 (file)
@@ -800,6 +800,7 @@ package Rtsfind is
      RE_Image_Boolean,                   -- System.Img_Bool
 
      RE_Image_Character,                 -- System.Img_Char
+     RE_Image_Character_05,              -- System.Img_Char
 
      RE_Image_Decimal,                   -- System.Img_Dec
 
@@ -1972,6 +1973,7 @@ package Rtsfind is
      RE_Image_Boolean                    => System_Img_Bool,
 
      RE_Image_Character                  => System_Img_Char,
+     RE_Image_Character_05               => System_Img_Char,
 
      RE_Image_Decimal                    => System_Img_Dec,
 
index 7678bf7..67613dd 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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 --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -158,4 +158,23 @@ package body System.Img_Char is
       end if;
    end Image_Character;
 
+   ------------------------
+   -- Image_Character_05 --
+   ------------------------
+
+   procedure Image_Character_05
+     (V : Character;
+      S : in out String;
+      P : out Natural)
+   is
+      pragma Assert (S'First = 1);
+   begin
+      if V = Character'Val (16#00AD#) then
+         P := 11;
+         S (1 .. P) := "SOFT_HYPHEN";
+      else
+         Image_Character (V, S, P);
+      end if;
+   end Image_Character_05;
+
 end System.Img_Char;
index 2c6b625..6faf2f3 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- --
@@ -42,4 +42,14 @@ package System.Img_Char is
    --  setting the resulting value of P. The caller guarantees that S is
    --  long enough to hold the result, and that S'First is 1.
 
+   procedure Image_Character_05
+     (V : Character;
+      S : in out String;
+      P : out Natural);
+   --  Computes Character'Image (V) and stores the result in S (1 .. P)
+   --  setting the resulting value of P. The caller guarantees that S is
+   --  long enough to hold the result, and that S'First is 1. This version
+   --  is for use in Ada 2005 and beyond, where soft hyphen is a non-graphic
+   --  and results in "SOFT_HYPHEN" as the output.
+
 end System.Img_Char;
index 93ee55d..44cca39 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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 --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -61,6 +61,16 @@ package body System.Img_WChar is
 
          P := 4;
 
+      --  Deal with annoying Ada 95 incompatibility with soft hyphen
+
+      elsif V = Wide_Character'Val (16#00AD#)
+        and then not Ada_2005
+      then
+         P := 3;
+         S (1) := ''';
+         S (2) := Character'Val (16#00AD#);
+         S (3) := ''';
+
       --  Normal case, same as Wide_Wide_Character
 
       else
@@ -83,10 +93,14 @@ package body System.Img_WChar is
       Val : Unsigned_32 := Wide_Wide_Character'Pos (V);
 
    begin
-      --  If in range of standard Character, use Character routine
+      --  If in range of standard Character, use Character routine. Use the
+      --  Ada 2005 version, since either we are called directly in Ada 2005
+      --  mode for Wide_Wide_Character, or this is the Wide_Character case
+      --  which already took care of the Soft_Hyphen glitch.
 
       if Val <= 16#FF# then
-         Image_Character (Character'Val (Wide_Wide_Character'Pos (V)), S, P);
+         Image_Character_05
+           (Character'Val (Wide_Wide_Character'Pos (V)), S, P);
 
       --  Otherwise value returned is Hex_hhhhhhhh
 
index a2ef121..8dddcf5 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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 --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -65,6 +65,10 @@ package body System.Val_Char is
             end if;
          end loop;
 
+         if S (F .. L) = "SOFT_HYPHEN" then
+            return Character'Val (16#AD#);
+         end if;
+
          raise Constraint_Error;
       end if;
    end Value_Character;
index 5a02199..5574f65 100644 (file)
@@ -3654,10 +3654,11 @@ package body Sem_Aggr is
                           (Aggr       : Node_Id;
                            Assoc_List : List_Id)
                         is
-                           Aggr_Type  : constant Entity_Id :=
-                             Base_Type (Etype (Aggr));
-                           Def_Node   : constant Node_Id :=
-                             Type_Definition (Declaration_Node (Aggr_Type));
+                           Aggr_Type : constant Entity_Id :=
+                                         Base_Type (Etype (Aggr));
+                           Def_Node  : constant Node_Id :=
+                                         Type_Definition
+                                           (Declaration_Node (Aggr_Type));
 
                            Comp       : Node_Id;
                            Comp_Elmt  : Elmt_Id;
@@ -3666,7 +3667,7 @@ package body Sem_Aggr is
                            Errors     : Boolean;
 
                            procedure Process_Component (Comp : Entity_Id);
-                           --  Add one component with a box association  to the
+                           --  Add one component with a box association to the
                            --  inner aggregate, and recurse if component is
                            --  itself composite.
 
@@ -3702,7 +3703,6 @@ package body Sem_Aggr is
                            end Process_Component;
 
                         begin
-
                            --  The component type may be a variant type, so
                            --  collect the components that are ruled by the
                            --  known values of the discriminants.
@@ -3734,7 +3734,6 @@ package body Sem_Aggr is
                            --  No variant part, iterate over all components
 
                            else
-
                               Comp := First_Component (Etype (Aggr));
                               while Present (Comp) loop
                                  Process_Component (Comp);
@@ -3753,15 +3752,16 @@ package body Sem_Aggr is
                            end if;
                         end Propagate_Discriminants;
 
-                        --  Start of processing for Capture_Discriminants
+                     --  Start of processing for Capture_Discriminants
 
                      begin
                         Expr := Make_Aggregate (Loc, New_List, New_List);
                         Set_Etype (Expr, Ctyp);
 
-                        --  If the enclosing type has discriminants, they
-                        --  have been collected in the aggregate earlier, and
-                        --  they may appear as constraints of subcomponents.
+                        --  If the enclosing type has discriminants, they have
+                        --  been collected in the aggregate earlier, and they
+                        --  may appear as constraints of subcomponents.
+
                         --  Similarly if this component has discriminants, they
                         --  might in turn be propagated to their components.
 
@@ -3771,7 +3771,7 @@ package body Sem_Aggr is
 
                         elsif Has_Discriminants (Ctyp) then
                            Add_Discriminant_Values
-                              (Expr,  Component_Associations (Expr));
+                              (Expr, Component_Associations (Expr));
                            Propagate_Discriminants
                               (Expr, Component_Associations (Expr));
 
index 5302ebb..8d052c0 100644 (file)
@@ -7413,7 +7413,6 @@ package body Sem_Attr is
 
                            --  No need to compute this more than once!
 
-                           W := Int'Max (W, 12);
                            exit;
 
                         else
@@ -7427,13 +7426,11 @@ package body Sem_Attr is
                            case C is
                               when Reserved_128 | Reserved_129 |
                                    Reserved_132 | Reserved_153
-
                                 => Wt := 12;
 
                               when BS | HT | LF | VT | FF | CR |
                                    SO | SI | EM | FS | GS | RS |
                                    US | RI | MW | ST | PM
-
                                 => Wt := 2;
 
                               when NUL | SOH | STX | ETX | EOT |
@@ -7445,13 +7442,20 @@ package body Sem_Attr is
                                    SS2 | SS3 | DCS | PU1 | PU2 |
                                    STS | CCH | SPA | EPA | SOS |
                                    SCI | CSI | OSC | APC
-
                                 => Wt := 3;
 
                               when Space .. Tilde |
                                    No_Break_Space .. LC_Y_Diaeresis
-
-                                => Wt := 3;
+                                =>
+                                 --  Special case of soft hyphen in Ada 2005
+
+                                 if C = Character'Val (16#AD#)
+                                   and then Ada_Version >= Ada_05
+                                 then
+                                    Wt := 11;
+                                 else
+                                    Wt := 3;
+                                 end if;
                            end case;
 
                            W := Int'Max (W, Wt);