summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gcc/ada/ChangeLog17
-rw-r--r--gcc/ada/exp_imgv.adb10
-rw-r--r--gcc/ada/rtsfind.ads2
-rw-r--r--gcc/ada/s-imgcha.adb21
-rw-r--r--gcc/ada/s-imgcha.ads12
-rw-r--r--gcc/ada/s-imgwch.adb20
-rw-r--r--gcc/ada/s-valcha.adb6
-rw-r--r--gcc/ada/sem_aggr.adb24
-rw-r--r--gcc/ada/sem_attr.adb16
9 files changed, 103 insertions, 25 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7ddaa66dc46..2b37a3cc7dd 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.
diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index 9c0be21634e..25bce023c17 100644
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -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
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 177f1feb5a2..ca61bd120a6 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -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,
diff --git a/gcc/ada/s-imgcha.adb b/gcc/ada/s-imgcha.adb
index 7678bf7205a..67613ddbd48 100644
--- a/gcc/ada/s-imgcha.adb
+++ b/gcc/ada/s-imgcha.adb
@@ -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;
diff --git a/gcc/ada/s-imgcha.ads b/gcc/ada/s-imgcha.ads
index 2c6b62539e2..6faf2f30971 100644
--- a/gcc/ada/s-imgcha.ads
+++ b/gcc/ada/s-imgcha.ads
@@ -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;
diff --git a/gcc/ada/s-imgwch.adb b/gcc/ada/s-imgwch.adb
index 93ee55d99d2..44cca399624 100644
--- a/gcc/ada/s-imgwch.adb
+++ b/gcc/ada/s-imgwch.adb
@@ -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
diff --git a/gcc/ada/s-valcha.adb b/gcc/ada/s-valcha.adb
index a2ef1210ec4..8dddcf58403 100644
--- a/gcc/ada/s-valcha.adb
+++ b/gcc/ada/s-valcha.adb
@@ -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;
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 5a021991883..5574f658d7f 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -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));
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 5302ebb8492..8d052c0e533 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -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);