[multiple changes]

2014-08-04  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb, osint.adb, osint.ads: Minor reformatting.

2014-08-04  Yannick Moy  <moy@adacore.com>

	* sem_ch3.adb (Derive_Type_Declaration,
	Process_Discriminants): Remove SPARK-specific legality checks.

2014-08-04  Thomas Quinot  <quinot@adacore.com>

	* g-sechas.ads, g-sechas.adb (HMAC_Initial_Context): New subprogram.
	* gnat_rm.texi (GNAT.MD5/SHA1/SHA224/SHA256/SHA512): Document support
	for HMAC.

From-SVN: r213577

gcc/ada/ChangeLog

@@ -1,3 +1,18 @@
+2014-08-04  Robert Dewar  <dewar@adacore.com>
+
+	* sem_prag.adb, osint.adb, osint.ads: Minor reformatting.
+
+2014-08-04  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch3.adb (Derive_Type_Declaration,
+	Process_Discriminants): Remove SPARK-specific legality checks.
+
+2014-08-04  Thomas Quinot  <quinot@adacore.com>
+
+	* g-sechas.ads, g-sechas.adb (HMAC_Initial_Context): New subprogram.
+	* gnat_rm.texi (GNAT.MD5/SHA1/SHA224/SHA256/SHA512): Document support
+	for HMAC.
+
 2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_ch7.adb (Analyze_Package_Body_Helper): When verifying the

gcc/ada/g-sechas.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2009-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2009-2014, 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- --
@@ -218,8 +218,8 @@ package body GNAT.Secure_Hashes is
       --  the message size in bits (excluding padding).
 
       procedure Final
-        (C          : Context;
+        (C         : Context;
-         Hash_Bits  : out Stream_Element_Array)
+         Hash_Bits : out Stream_Element_Array)
       is
          FC : Context := C;
 
@@ -274,8 +274,73 @@ package body GNAT.Secure_Hashes is
          pragma Assert (FC.M_State.Last = 0);
 
          Hash_State.To_Hash (FC.H_State, Hash_Bits);
+
+         --  HMAC case: hash outer pad
+
+         if C.KL /= 0 then
+            declare
+               Outer_C : Context;
+               Opad    : Stream_Element_Array :=
+                 (1 .. Stream_Element_Offset (Block_Length) => 16#5c#);
+
+            begin
+               for J in C.Key'Range loop
+                  Opad (J) := Opad (J) xor C.Key (J);
+               end loop;
+
+               Update (Outer_C, Opad);
+               Update (Outer_C, Hash_Bits);
+
+               Final (Outer_C, Hash_Bits);
+            end;
+         end if;
       end Final;
 
+      --------------------------
+      -- HMAC_Initial_Context --
+      --------------------------
+
+      function HMAC_Initial_Context (Key : String) return Context is
+      begin
+         if Key'Length = 0 then
+            raise Constraint_Error with "null key";
+         end if;
+
+         return C : Context (KL => (if Key'Length <= Key_Length'Last
+                                    then Key'Length
+                                    else Stream_Element_Offset (Hash_Length)))
+         do
+            --  Set Key (if longer than block length, first hash it)
+
+            if C.KL = Key'Length then
+               declare
+                  SK : String (1 .. Key'Length);
+                  for SK'Address use C.Key'Address;
+                  pragma Import (Ada, SK);
+               begin
+                  SK := Key;
+               end;
+
+            else
+               C.Key := Digest (Key);
+            end if;
+
+            --  Hash inner pad
+
+            declare
+               Ipad : Stream_Element_Array :=
+                 (1 .. Stream_Element_Offset (Block_Length) => 16#36#);
+
+            begin
+               for J in C.Key'Range loop
+                  Ipad (J) := Ipad (J) xor C.Key (J);
+               end loop;
+
+               Update (C, Ipad);
+            end;
+         end return;
+      end HMAC_Initial_Context;
+
       ------------
       -- Update --
       ------------
@@ -285,11 +350,12 @@ package body GNAT.Secure_Hashes is
          S           : String;
          Fill_Buffer : Fill_Buffer_Access)
       is
-         Last : Natural := S'First - 1;
+         Last : Natural;
 
       begin
          C.M_State.Length := C.M_State.Length + S'Length;
 
+         Last := S'First - 1;
          while Last < S'Last loop
             Fill_Buffer (C.M_State, S, Last + 1, Last);
 

gcc/ada/g-sechas.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2009-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2009-2014, 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- --
@@ -144,6 +144,9 @@ package GNAT.Secure_Hashes is
       --  Initial value of a Context object. May be used to reinitialize
       --  a Context value by simple assignment of this value to the object.
 
+      function HMAC_Initial_Context (Key : String) return Context;
+      --  Initial Context for HMAC computation with the given Key
+
       procedure Update      (C : in out Context; Input : String);
       procedure Wide_Update (C : in out Context; Input : Wide_String);
       procedure Update
@@ -163,7 +166,7 @@ package GNAT.Secure_Hashes is
       --  the hash in binary representation.
 
       function Digest (C : Context) return Binary_Message_Digest;
-      --  Return hash for the data accumulated with C
+      --  Return hash or HMAC for the data accumulated with C
 
       function Digest      (S : String)      return Binary_Message_Digest;
       function Wide_Digest (W : Wide_String) return Binary_Message_Digest;
@@ -178,7 +181,7 @@ package GNAT.Secure_Hashes is
       --  hexadecimal representation.
 
       function Digest (C : Context) return Message_Digest;
-      --  Return hash for the data accumulated with C in hexadecimal
+      --  Return hash or HMAC for the data accumulated with C in hexadecimal
       --  representation.
 
       function Digest      (S : String)               return Message_Digest;
@@ -193,7 +196,15 @@ package GNAT.Secure_Hashes is
       Block_Length : constant Natural := Block_Words * Word_Length;
       --  Length in bytes of a data block
 
-      type Context is record
+      subtype Key_Length is
+        Stream_Element_Offset range 0 .. Stream_Element_Offset (Block_Length);
+
+      --  KL is 0 for a normal hash context, > 0 for HMAC
+
+      type Context (KL : Key_Length := 0) is record
+         Key : Stream_Element_Array (1 .. KL);
+         --  HMAC key
+
          H_State : Hash_State.State (0 .. State_Words - 1) := Initial_State;
          --  Function-specific state
 
@@ -201,7 +212,7 @@ package GNAT.Secure_Hashes is
          --  Function-independent state (block buffer)
       end record;
 
-      Initial_Context : constant Context := (others => <>);
+      Initial_Context : constant Context (KL => 0) := (others => <>);
       --  Initial values are provided by default initialization of Context
 
    end H;

gcc/ada/gnat_rm.texi

@@ -19952,7 +19952,9 @@ a modified version of the Blum-Blum-Shub generator.
 @cindex Message Digest MD5
 
 @noindent
-Implements the MD5 Message-Digest Algorithm as described in RFC 1321.
+Implements the MD5 Message-Digest Algorithm as described in RFC 1321, and
+the HMAC-MD5 message authentication function as described in RFC 2104 and
+FIPS PUB 198.
 
 @node GNAT.Memory_Dump (g-memdum.ads)
 @section @code{GNAT.Memory_Dump} (@file{g-memdum.ads})
@@ -20088,7 +20090,8 @@ port. This is only supported on GNU/Linux and Windows.
 
 @noindent
 Implements the SHA-1 Secure Hash Algorithm as described in FIPS PUB 180-3
-and RFC 3174.
+and RFC 3174, and the HMAC-SHA1 message authentication function as described
+in RFC 2104 and FIPS PUB 198.
 
 @node GNAT.SHA224 (g-sha224.ads)
 @section @code{GNAT.SHA224} (@file{g-sha224.ads})
@@ -20096,7 +20099,9 @@ and RFC 3174.
 @cindex Secure Hash Algorithm SHA-224
 
 @noindent
-Implements the SHA-224 Secure Hash Algorithm as described in FIPS PUB 180-3.
+Implements the SHA-224 Secure Hash Algorithm as described in FIPS PUB 180-3,
+and the HMAC-SHA224 message authentication function as described
+in RFC 2104 and FIPS PUB 198.
 
 @node GNAT.SHA256 (g-sha256.ads)
 @section @code{GNAT.SHA256} (@file{g-sha256.ads})
@@ -20104,7 +20109,9 @@ Implements the SHA-224 Secure Hash Algorithm as described in FIPS PUB 180-3.
 @cindex Secure Hash Algorithm SHA-256
 
 @noindent
-Implements the SHA-256 Secure Hash Algorithm as described in FIPS PUB 180-3.
+Implements the SHA-256 Secure Hash Algorithm as described in FIPS PUB 180-3,
+and the HMAC-SHA256 message authentication function as described
+in RFC 2104 and FIPS PUB 198.
 
 @node GNAT.SHA384 (g-sha384.ads)
 @section @code{GNAT.SHA384} (@file{g-sha384.ads})
@@ -20112,7 +20119,9 @@ Implements the SHA-256 Secure Hash Algorithm as described in FIPS PUB 180-3.
 @cindex Secure Hash Algorithm SHA-384
 
 @noindent
-Implements the SHA-384 Secure Hash Algorithm as described in FIPS PUB 180-3.
+Implements the SHA-384 Secure Hash Algorithm as described in FIPS PUB 180-3,
+and the HMAC-SHA384 message authentication function as described
+in RFC 2104 and FIPS PUB 198.
 
 @node GNAT.SHA512 (g-sha512.ads)
 @section @code{GNAT.SHA512} (@file{g-sha512.ads})
@@ -20120,7 +20129,9 @@ Implements the SHA-384 Secure Hash Algorithm as described in FIPS PUB 180-3.
 @cindex Secure Hash Algorithm SHA-512
 
 @noindent
-Implements the SHA-512 Secure Hash Algorithm as described in FIPS PUB 180-3.
+Implements the SHA-512 Secure Hash Algorithm as described in FIPS PUB 180-3,
+and the HMAC-SHA512 message authentication function as described
+in RFC 2104 and FIPS PUB 198.
 
 @node GNAT.Signals (g-signal.ads)
 @section @code{GNAT.Signals} (@file{g-signal.ads})

gcc/ada/osint.adb

@@ -1174,7 +1174,8 @@ package body Osint is
       T         : File_Type;
       Found     : out File_Name_Type;
       Attr      : access File_Attributes;
-      Full_Name : Boolean := False) is
+      Full_Name : Boolean := False)
+   is
    begin
       Get_Name_String (N);
 
@@ -1200,9 +1201,8 @@ package body Osint is
             if T = Config and then Full_Name then
                declare
                   Full_Path : constant String :=
-                           Normalize_Pathname (Get_Name_String (N));
+                                Normalize_Pathname (Get_Name_String (N));
                   Full_Size : constant Natural := Full_Path'Length;
-
                begin
                   Name_Buffer (1 .. Full_Size) := Full_Path;
                   Name_Len := Full_Size;

gcc/ada/osint.ads

@@ -77,6 +77,7 @@ package Osint is
    --  set and the file name ends in ".dg", in which case we look for the
    --  generated file only in the current directory, since that is where it is
    --  always built.
+   --
    --  In the case of configuration files, full path names are needed for some
    --  ASIS queries. The flag Full_Name indicates that the name of the file
    --  should be normalized to include a full path.

gcc/ada/sem_ch3.adb

@@ -15062,17 +15062,6 @@ package body Sem_Ch3 is
 
          else
             Check_SPARK_05_Restriction ("discriminant type is not allowed", N);
-
-            --  The following check is only relevant when SPARK_Mode is on as
-            --  it is not a standard Ada legality rule. A derived type cannot
-            --  have discriminants if the parent type is discriminated.
-
-            if SPARK_Mode = On and then Has_Discriminants (Parent_Type) then
-               SPARK_Msg_N
-                 ("discriminants not allowed if parent type is discriminated",
-                  Defining_Identifier
-                    (First (Discriminant_Specifications (N))));
-            end if;
          end if;
       end if;
 
@@ -18038,44 +18027,29 @@ package body Sem_Ch3 is
             end if;
          end if;
 
-         --  The following checks are only relevant when SPARK_Mode is on as
+         --  Handling of discriminants that are access types
-         --  they are not standard Ada legality rules.
 
-         if SPARK_Mode = On then
+         if Is_Access_Type (Discr_Type) then
-            if Is_Access_Type (Discr_Type) then
-               SPARK_Msg_N
-                 ("discriminant cannot have an access type",
-                  Discriminant_Type (Discr));
 
-            elsif not Is_Discrete_Type (Discr_Type) then
+            --  Ada 2005 (AI-230): Access discriminant allowed in non-
-               SPARK_Msg_N
+            --  limited record types
-                 ("discriminant must have a discrete type",
+
-                  Discriminant_Type (Discr));
+            if Ada_Version < Ada_2005 then
+               Check_Access_Discriminant_Requires_Limited
+                 (Discr, Discriminant_Type (Discr));
             end if;
 
-         --  Normal Ada rules
+            if Ada_Version = Ada_83 and then Comes_From_Source (Discr) then
-
-         else
-            if Is_Access_Type (Discr_Type) then
-
-               --  Ada 2005 (AI-230): Access discriminant allowed in non-
-               --  limited record types
-
-               if Ada_Version < Ada_2005 then
-                  Check_Access_Discriminant_Requires_Limited
-                    (Discr, Discriminant_Type (Discr));
-               end if;
-
-               if Ada_Version = Ada_83 and then Comes_From_Source (Discr) then
-                  Error_Msg_N
-                    ("(Ada 83) access discriminant not allowed", Discr);
-               end if;
-
-            elsif not Is_Discrete_Type (Discr_Type) then
                Error_Msg_N
-                 ("discriminants must have a discrete or access type",
+                 ("(Ada 83) access discriminant not allowed", Discr);
-                  Discriminant_Type (Discr));
             end if;
+
+         --  If not access type, must be a discrete type
+
+         elsif not Is_Discrete_Type (Discr_Type) then
+            Error_Msg_N
+              ("discriminants must have a discrete or access type",
+               Discriminant_Type (Discr));
          end if;
 
          Set_Etype (Defining_Identifier (Discr), Discr_Type);
@@ -18085,8 +18059,8 @@ package body Sem_Ch3 is
          --  expression of the discriminant; the default expression must be of
          --  the type of the discriminant. (RM 3.7.1) Since this expression is
          --  a default expression, we do the special preanalysis, since this
-         --  expression does not freeze (see "Handling of Default and Per-
+         --  expression does not freeze (see section "Handling of Default and
-         --  Object Expressions" in spec of package Sem).
+         --  Per-Object Expressions" in spec of package Sem).
 
          if Present (Expression (Discr)) then
             Preanalyze_Spec_Expression (Expression (Discr), Discr_Type);

gcc/ada/sem_prag.adb

@@ -19359,7 +19359,7 @@ package body Sem_Prag is
                   elsif not Comes_From_Source (Stmt)
                     and then
                       (Nkind (Stmt) /= N_Subprogram_Declaration
-                         or else No (Generic_Parent (Specification (Stmt))))
+                        or else No (Generic_Parent (Specification (Stmt))))
                   then
                      null;